From 3391ae8fc41b7e2f8c216f7dc6b231f58fae744f 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'. * 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): Consult the 'bookmark-fringe-mark' option. --- lisp/bookmark.el | 33 ++++++++++++++++++++++----------- lisp/cus-edit.el | 21 +++++++++++++++++++++ lisp/fringe.el | 1 + src/fringe.c | 15 +++++++++++++++ 4 files changed, 59 insertions(+), 11 deletions(-) diff --git a/lisp/bookmark.el b/lisp/bookmark.el index 30a03e0431..76c7b7df5d 100644 --- a/lisp/bookmark.el +++ b/lisp/bookmark.el @@ -181,10 +181,14 @@ 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-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) + :version "29.1") ;; FIXME: No longer used. Should be declared obsolete or removed. (defface bookmark-menu-heading @@ -201,10 +205,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 +486,31 @@ 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") +(define-fringe-bitmap 'bookmark-mark + [#b01111110 + #b01111110 + #b01111110 + #b01111110 + #b01111110 + #b01111110 + #b01100110 + #b01000010]) (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) 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