bug#56896: 29.0.50; [PATCHv3] Make the bookmark fringe icon look like a bookmark

[Jim Porter <jporterbugs@gmail.com>]

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

On 8/4/2022 9:41 PM, Jim Porter wrote:
> 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...)

Here's a better version of this patch. Rather than a proxy object, it 
just sets the 'fringe' property on the defcustom, which the rest of the 
bookmark code can then use like a "regular" fringe bitmap (essentially, 
it's just an alias to a real fringe bitmap). I also added a 
'fringe-custom-set-bitmap' function that anyone can use as a :set function.

This should be general enough that it could be used wherever anyone 
wants to allow users to use Customize to change the fringe bitmap that 
gets used for a particular purpose. Potentially, it could even be used 
for *every* use of a fringe bitmap. That would let users pick icons they 
like for a particular purpose based on their general description (e.g. 
'right-triangle'), but they could also independently adjust the bitmaps 
(e.g. redefining all the fringe bitmaps to be larger for high DPI 
monitors). For the latter case, maybe users could download a package 
from ELPA to do that.

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

From c83034e2cc4d29a7ab4a84761a107c53bad6cde8 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'.
(fringe-custom-set-bitmap): New function.

* 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-face): Don't set the ':background' of the face.  Instead,
set ':distant-foreground'.
(bookmark--set-fringe-mark, bookmark--remove-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           | 40 +++++++++++++++++++++++++-------------
 lisp/cus-edit.el           | 21 ++++++++++++++++++++
 lisp/fringe.el             | 12 ++++++++++++
 src/fringe.c               | 15 ++++++++++++++
 7 files changed, 84 insertions(+), 14 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 96079dc106..d336cda674 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 e2bccca4a8..f41398e5b0 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -2011,6 +2011,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 d0893e932b..7466be32b4 100644
--- a/lisp/bookmark.el
+++ b/lisp/bookmark.el
@@ -181,10 +181,25 @@ 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])
+
+(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 #'fringe-custom-set-bitmap
+  :version "29.1")
 
 ;; FIXME: No longer used.  Should be declared obsolete or removed.
 (defface bookmark-menu-heading
@@ -201,10 +216,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,12 +497,9 @@ 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)
@@ -499,7 +511,7 @@ bookmark--set-fringe-mark
 (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 +627,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 +943,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 +1225,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..d5bae8f66f 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..0c88501298 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
@@ -324,6 +325,17 @@ fringe-columns
     ;; The real implementation is in src/fringe.c.
     ))
 
+(defun fringe-custom-set-bitmap (symbol value)
+  "Set SYMBOL to a fringe bitmap VALUE.
+This sets the `fringe' property on SYMBOL to match that of VALUE,
+and then force all windows to be updated on the next redisplay.
+You should use this for the :set parameter for customization
+options to pick a fringe bitmap."
+  (prog1
+      (set symbol value)
+    (put symbol 'fringe (get value 'fringe))
+    (force-window-update)))
+
 (provide 'fringe)
 
 ;;; fringe.el ends here
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