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).

diff --git a/doc/lispref/customize.texi b/doc/lispref/customize.texi
index 528421bf3b40e730a26b7eafab2222f4719192ec..6ba35cffffe176cccbacf3d3668d81147315f533 100644 (file)
--- 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 96079dc106ae0d53a97494b031a1b8e36179ba50..d336cda674353a5eded1a36e04ecbb107cb9d8d0 100644 (file)
--- 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 c982684d3a93088ba92e17351a918a00e3618e4f..5d87bc9e2eb47fb74d75ec5a7b9a9e67b90123ee 100644 (file)
--- 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 d0893e932b436b82183d36137fdc977e3f27211e..7466be32b45c1544f523673fca45b83319543a4f 100644 (file)
--- 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 edc09f3199fff232c1551038ab7de7f2691b45aa..d5bae8f66f8622041537bdd7e31bb1d855f65352 100644 (file)
--- 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 657a73772d5695a8496393d8a97183d5b3699808..0c88501298f29c4f5b676b45a5a1b3ffe641faf5 100644 (file)
--- 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 bf0b5fde761613a300a49343d4111465d3739c49..5d7c8dca9983313ed87549c904493a20bf28e0c4 100644 (file)
--- 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 },