master b87400c78b: Make the bookmark fringe icon look like a bookmark

[Jim Porter]

branch: master
commit b87400c78b047d242ae188c46c621e0e8a8e69b2
Author: Jim Porter <jporterbugs@gmail.com>
Commit: Jim Porter <jporterbugs@gmail.com>

    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 (bug#56896).
---
 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 @@ The value must be a valid color name.  The widget provides 
completion
 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 @@ Used to indicate buffer boundaries.
 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 c982684d3a..5d87bc9e2e 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -2013,6 +2013,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 @@ A non-nil value may result in truncated bookmark names."
   "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 @@ A non-nil value may result in truncated bookmark names."
      :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 @@ In other words, return all information but the name."
 (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 @@ See user option `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 @@ old one."
         ;; 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 @@ still there, in order, if the topmost one is ever deleted."
            ;; 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 @@ and then show any annotations for this bookmark."
     (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 @@ restoring it to the state of a face that has never been 
customized."
     (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 @@
   (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 @@ If BITMAP already exists, the existing definition is 
replaced."
     ;; 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 left_curly_arrow_bits[] = {
 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 @@ static struct fringe_bitmap standard_bitmaps[] =
   { 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 },