unofficial mirror of bug-gnu-emacs@gnu.org 
 help / color / mirror / code / Atom feed
From: Jim Porter <jporterbugs@gmail.com>
To: Eli Zaretskii <eliz@gnu.org>, Lars Ingebrigtsen <larsi@gnus.org>
Cc: 56896@debbugs.gnu.org
Subject: bug#56896: 29.0.50; [PATCH] Make the bookmark fringe icon look like a bookmark
Date: Thu, 4 Aug 2022 21:41:56 -0700	[thread overview]
Message-ID: <7566691d-090e-f380-b395-4d2aa2fdebdb@gmail.com> (raw)
In-Reply-To: <83edxw4hzn.fsf@gnu.org>

[-- Attachment #1: Type: text/plain, Size: 1758 bytes --]

On 8/3/2022 11:53 PM, Eli Zaretskii wrote:
>> Cc: 56896@debbugs.gnu.org
>> From: Jim Porter <jporterbugs@gmail.com>
>> Date: Wed, 3 Aug 2022 20:24:24 -0700
>>
>> Finally, I adjusted the names of a couple bookmark variables and let
>> users specify a bitmap (or nil) for 'bookmark-fringe-mark'. Note that
>> changing this (via Customize or not) doesn't force an update of
>> already-set bookmark fringe marks. That would be nice to have, but I'd
>> need to study the code quite a bit more to figure out how to do this.
> 
> I think we should fix this aspect, yes.  So please do try to find the
> way of doing it with some kind of :set function.

Ok, I figured out a way to do this. I added a proxy object 
('bookmark--fringe-mark') that I can dynamically set the 'fringe' 
property on, and then the :set function will update that and the display 
code will Just Work. Well, so long as a redisplay is triggered, but I 
think happens when you set options via Customize? It worked in my tests, 
anyway.

This method feels kind of hacky, but I can't think of a better way, and 
it's certainly more feasible than trying to find all the fringe markers 
manually. (Given that code can define custom bookmark handler functions, 
I'm not even sure that would have been possible...)

> If there's a detailed enough description in the manual(s), the NEWS
> entry can be quite short, just mentioning the new capabilities and
> variables.  If you don't think this is manual-worthy, the NEWS entry
> should be a bit more detailed.  But don't worry about that, we will
> get to it when you submit the actual text for NEWS.

I added some documentation and a NEWS entry for the user-facing part of 
this (the new option). There might be room to add more documentation though.

[-- Attachment #2: 0001-Make-the-bookmark-fringe-icon-look-like-a-bookmark.patch --]
[-- Type: text/plain, Size: 9627 bytes --]

From 1b3ff7578d1eaaa6c20e457a42def46ea4f3108b Mon Sep 17 00:00:00 2001
From: Jim Porter <jporterbugs@gmail.com>
Date: Tue, 2 Aug 2022 11:40:43 -0700
Subject: [PATCH] Make the bookmark fringe icon look like a bookmark

* src/fringe.c (large_circle_bits): New variable.
(standard_bitmaps): Add large_circle_bits.

* lisp/fringe.el (fringe-bitmaps): Add 'large-circle'.

* lisp/cus-edit.el (widget-fringe-bitmap-prompt-value-history): New
variable.
(fringe-bitmap): New widget.

* lisp/bookmark.el (bookmark-set-fringe-mark): Obsolete in favor of...
(bookmark-fringe-mark): ... this.
(bookmark-fringe-mark): Rename this fringe bitmap to...
(bookmark-mark): ... and change it to look like a bookmark.
(bookmark--fringe-mark): New variable.
(bookmark-face): Don't set the ':background' of the face.  Instead,
set ':distant-foreground'.
(bookmark--set-fringe-mark, bookmark-store, bookmark--jump-via):
Consult the 'bookmark-fringe-mark' option.

* doc/lispref/customize.texi (Simple Types): Document 'fringe-bitmap'
type.

* doc/lispref/display.texi (Fringe Bitmaps): Mention 'large-circle'.

* etc/NEWS: Announce this change.
---
 doc/lispref/customize.texi |  4 ++++
 doc/lispref/display.texi   |  1 +
 etc/NEWS                   |  5 ++++
 lisp/bookmark.el           | 49 ++++++++++++++++++++++++++------------
 lisp/cus-edit.el           | 21 ++++++++++++++++
 lisp/fringe.el             |  1 +
 src/fringe.c               | 15 ++++++++++++
 7 files changed, 81 insertions(+), 15 deletions(-)

diff --git a/doc/lispref/customize.texi b/doc/lispref/customize.texi
index 528421bf3b..6ba35cffff 100644
--- a/doc/lispref/customize.texi
+++ b/doc/lispref/customize.texi
@@ -672,6 +672,10 @@ Simple Types
 for color names, as well as a sample and a button for selecting a
 color name from a list of color names shown in a @file{*Colors*}
 buffer.
+
+@item fringe-bitmap
+The value must be a valid fringe bitmap name.  The widget provides
+completion.
 @end table
 
 @node Composite Types
diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi
index ace67fbedb..48f46b4cb6 100644
--- a/doc/lispref/display.texi
+++ b/doc/lispref/display.texi
@@ -4626,6 +4626,7 @@ Fringe Bitmaps
 Used for different types of fringe cursors.
 
 @item @code{exclamation-mark}, @code{question-mark}
+@itemx @code{large-circle}
 Not used by core Emacs features.
 @end table
 
diff --git a/etc/NEWS b/etc/NEWS
index b88fb63662..219e8124fe 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -1979,6 +1979,11 @@ recently set.
 *** When editing a bookmark annotation, 'C-c C-k' will now cancel.
 It is bound to the new command 'bookmark-edit-annotation-cancel'.
 
+---
+*** New option 'bookmark-fringe-mark'.
+This option controls the bitmap used to indicate bookmarks in the
+fringe (or 'nil' to disable showing this marker).
+
 ** Exif
 
 ---
diff --git a/lisp/bookmark.el b/lisp/bookmark.el
index 30a03e0431..0bdf3bcc58 100644
--- a/lisp/bookmark.el
+++ b/lisp/bookmark.el
@@ -181,10 +181,32 @@ bookmark-search-delay
   "Time before `bookmark-bmenu-search' updates the display."
   :type  'number)
 
-(defcustom bookmark-set-fringe-mark t
-  "Whether to set a fringe mark at bookmarked lines."
-  :type  'boolean
-  :version "28.1")
+(define-fringe-bitmap 'bookmark-mark
+  [#b01111110
+   #b01111110
+   #b01111110
+   #b01111110
+   #b01111110
+   #b01111110
+   #b01100110
+   #b01000010])
+
+(defvar bookmark--fringe-mark nil
+  "A proxy object to use when setting the bookmark fringe mark.
+This holds a `fringe' property that can be updated in-place to
+dynamically change the bitmap used for marking bookmarks.")
+
+(define-obsolete-variable-alias 'bookmark-set-fringe-mark
+  'bookmark-fringe-mark "29.1")
+
+(defcustom bookmark-fringe-mark 'bookmark-mark
+  "The fringe bitmap to mark bookmarked lines with.
+If nil, don't display a mark on the fringe."
+  :type '(choice (const nil) fringe-bitmap)
+  :set (lambda (symbol value)
+         (set symbol value)
+         (put 'bookmark--fringe-mark 'fringe (get value 'fringe)))
+  :version "29.1")
 
 ;; FIXME: No longer used.  Should be declared obsolete or removed.
 (defface bookmark-menu-heading
@@ -201,10 +223,10 @@ bookmark-face
      :foreground "LightGray")
     (((class color)
       (background light))
-     :background "White" :foreground "DarkOrange1")
+     :foreground "DarkOrange1" :distant-foreground "DarkOrange3")
     (((class color)
       (background dark))
-     :background "Black" :foreground "DarkOrange1"))
+     :foreground "DarkOrange1" :distant-foreground "Orange1"))
   "Face used to highlight current line."
   :version "28.1")
 
@@ -482,24 +504,21 @@ bookmark-update-last-modified
 (defvar bookmark-history nil
   "The history list for bookmark functions.")
 
-(define-fringe-bitmap 'bookmark-fringe-mark
-  "\x3c\x7e\xff\xff\xff\xff\x7e\x3c")
-
 (defun bookmark--set-fringe-mark ()
   "Apply a colorized overlay to the bookmarked location.
-See user option `bookmark-set-fringe-mark'."
+See user option `bookmark-fringe-mark'."
   (let ((bm (make-overlay (point-at-bol) (1+ (point-at-bol)))))
     (overlay-put bm 'category 'bookmark)
     (overlay-put bm 'evaporate t)
     (overlay-put bm 'before-string
                  (propertize
                   "x" 'display
-                  `(left-fringe bookmark-fringe-mark bookmark-face)))))
+                  `(left-fringe bookmark--fringe-mark bookmark-face)))))
 
 (defun bookmark--remove-fringe-mark (bm)
   "Remove a bookmark's colorized overlay.
 BM is a bookmark as returned from function `bookmark-get-bookmark'.
-See user option `bookmark-set-fringe'."
+See user option `bookmark-fringe-mark'."
   (let ((filename (cdr (assq 'filename bm)))
         (pos (cdr (assq 'position bm)))
         overlays found temp)
@@ -615,7 +634,7 @@ bookmark-store
         ;; no prefix arg means just overwrite old bookmark.
         (let ((bm (bookmark-get-bookmark stripped-name)))
           ;; First clean up if previously location was fontified.
-          (when bookmark-set-fringe-mark
+          (when bookmark-fringe-mark
             (bookmark--remove-fringe-mark bm))
           ;; Modify using the new (NAME . ALIST) format.
           (setcdr bm alist))
@@ -931,7 +950,7 @@ bookmark-set-internal
            ;; Ask for an annotation buffer for this bookmark
            (when bookmark-use-annotations
              (bookmark-edit-annotation str))
-           (when bookmark-set-fringe-mark
+           (when bookmark-fringe-mark
              (bookmark--set-fringe-mark))))
     (setq bookmark-yank-point nil)
     (setq bookmark-current-buffer nil)))
@@ -1213,7 +1232,7 @@ bookmark--jump-via
     (if win (set-window-point win (point))))
   ;; FIXME: we used to only run bookmark-after-jump-hook in
   ;; `bookmark-jump' itself, but in none of the other commands.
-  (when bookmark-set-fringe-mark
+  (when bookmark-fringe-mark
     (let ((overlays (overlays-in (point-at-bol) (1+ (point-at-bol))))
           temp found)
       (while (and (not found) (setq temp (pop overlays)))
diff --git a/lisp/cus-edit.el b/lisp/cus-edit.el
index edc09f3199..ca26922c30 100644
--- a/lisp/cus-edit.el
+++ b/lisp/cus-edit.el
@@ -4286,6 +4286,27 @@ custom-hook-convert-widget
     (widget-put widget :args args)
     widget))
 
+;;; The `fringe-bitmap' Widget.
+
+(defvar widget-fringe-bitmap-prompt-value-history nil
+  "History of input to `widget-fringe-bitmap-prompt-value'.")
+
+(define-widget 'fringe-bitmap 'symbol
+  "A Lisp fringe bitmap name"
+  :format "%v"
+  :tag "Fringe bitmap"
+  :match (lambda (_widget value) (fringe-bitmap-p value))
+  :completions (apply-partially #'completion-table-with-predicate
+                                obarray #'fringe-bitmap-p 'strict)
+  :prompt-match 'fringe-bitmap-p
+  :prompt-history 'widget-face-prompt-value-history
+  :validate (lambda (widget)
+	      (unless (fringe-bitmap-p (widget-value widget))
+		(widget-put widget
+			    :error (format "Invalid fringe bitmap: %S"
+					   (widget-value widget)))
+		widget)))
+
 ;;; The `custom-group-link' Widget.
 
 (define-widget 'custom-group-link 'link
diff --git a/lisp/fringe.el b/lisp/fringe.el
index 657a73772d..da6812e68d 100644
--- a/lisp/fringe.el
+++ b/lisp/fringe.el
@@ -46,6 +46,7 @@ fringe
   (let ((bitmaps '(question-mark exclamation-mark
 		   left-arrow right-arrow up-arrow down-arrow
 		   left-curly-arrow right-curly-arrow
+		   large-circle
 		   left-triangle right-triangle
 		   top-left-angle top-right-angle
 		   bottom-left-angle bottom-right-angle
diff --git a/src/fringe.c b/src/fringe.c
index bf0b5fde76..5d7c8dca99 100644
--- a/src/fringe.c
+++ b/src/fringe.c
@@ -209,6 +209,20 @@
 static unsigned short right_curly_arrow_bits[] = {
    0x3c, 0x3e, 0x03, 0x27, 0x3f, 0x3e, 0x3c, 0x3e};
 
+/* Large circle bitmap.  */
+/*
+  ........
+  ..xxxx..
+  .xxxxxx.
+  xxxxxxxx
+  xxxxxxxx
+  .xxxxxx.
+  ..xxxx..
+  ........
+*/
+static unsigned short large_circle_bits[] = {
+  0x3c, 0x7e, 0xff, 0xff, 0xff, 0xff, 0x7e, 0x3c};
+
 /* Reverse Overlay arrow bitmap.  A triangular arrow.  */
 /*
   ......xx
@@ -454,6 +468,7 @@ #define FRBITS(bits)  bits, STANDARD_BITMAP_HEIGHT (bits)
   { FRBITS (down_arrow_bits),         8, 0, ALIGN_BITMAP_BOTTOM, 0 },
   { FRBITS (left_curly_arrow_bits),   8, 0, ALIGN_BITMAP_CENTER, 0 },
   { FRBITS (right_curly_arrow_bits),  8, 0, ALIGN_BITMAP_CENTER, 0 },
+  { FRBITS (large_circle_bits),       8, 0, ALIGN_BITMAP_CENTER, 0 },
   { FRBITS (left_triangle_bits),      8, 0, ALIGN_BITMAP_CENTER, 0 },
   { FRBITS (right_triangle_bits),     8, 0, ALIGN_BITMAP_CENTER, 0 },
   { FRBITS (top_left_angle_bits),     8, 0, ALIGN_BITMAP_TOP,    0 },
-- 
2.25.1


  parent reply	other threads:[~2022-08-05  4:41 UTC|newest]

Thread overview: 16+ messages / expand[flat|nested]  mbox.gz  Atom feed  top
2022-08-02 19:13 bug#56896: 29.0.50; [PATCH] Make the bookmark fringe icon look like a bookmark Jim Porter
2022-08-02 19:18 ` Eli Zaretskii
2022-08-02 20:05   ` Jim Porter
2022-08-03  2:28     ` Eli Zaretskii
2022-08-04  3:24       ` Jim Porter
2022-08-04  6:53         ` Eli Zaretskii
2022-08-04  6:57           ` Lars Ingebrigtsen
2022-08-05  4:41           ` Jim Porter [this message]
2022-08-13 21:59             ` bug#56896: 29.0.50; [PATCHv3] " Jim Porter
2022-08-15  6:44               ` Lars Ingebrigtsen
2022-08-16  4:17                 ` Jim Porter
2022-08-21 16:23                 ` Juri Linkov
2022-08-02 20:10   ` bug#56896: 29.0.50; [PATCH] " Drew Adams
2022-08-03  2:23 ` Po Lu via Bug reports for GNU Emacs, the Swiss army knife of text editors
2022-08-03  2:42   ` Jim Porter
2022-08-03  4:31     ` Po Lu via Bug reports for GNU Emacs, the Swiss army knife of text editors

Reply instructions:

You may reply publicly to this message via plain-text email
using any one of the following methods:

* Save the following mbox file, import it into your mail client,
  and reply-to-all from there: mbox

  Avoid top-posting and favor interleaved quoting:
  https://en.wikipedia.org/wiki/Posting_style#Interleaved_style

  List information: https://www.gnu.org/software/emacs/

* Reply using the --to, --cc, and --in-reply-to
  switches of git-send-email(1):

  git send-email \
    --in-reply-to=7566691d-090e-f380-b395-4d2aa2fdebdb@gmail.com \
    --to=jporterbugs@gmail.com \
    --cc=56896@debbugs.gnu.org \
    --cc=eliz@gnu.org \
    --cc=larsi@gnus.org \
    /path/to/YOUR_REPLY

  https://kernel.org/pub/software/scm/git/docs/git-send-email.html

* If your mail client supports setting the In-Reply-To header
  via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line before the message body.
Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/emacs.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).