From c83034e2cc4d29a7ab4a84761a107c53bad6cde8 Mon Sep 17 00:00:00 2001 From: Jim Porter 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