master 7fe8844: Use a fringe mark in bookmark instead of a whole background line

[Lars Ingebrigtsen]

branch: master
commit 7fe88446c30279285e3171091189b3d1af697c05
Author: Lars Ingebrigtsen <larsi@gnus.org>
Commit: Lars Ingebrigtsen <larsi@gnus.org>

    Use a fringe mark in bookmark instead of a whole background line
    
    * lisp/bookmark.el (bookmark-face): Adjust colors.
    (bookmark-fringe-mark): New bitmap.
    (bookmark--fontify): Use a fringe instead of marking the whole line.
    (bookmark--unfontify): Adjust to remove.
    (bookmark--jump-via): Ditto.
    (bookmark-set-fringe-mark): Renamed from bookmark-fontify.
    (bookmark--set-fringe-mark, bookmark--remove-fringe-mark): Renamed
    from --*fontify.  Callers adjusted.
---
 etc/NEWS         |  7 +++----
 lisp/bookmark.el | 51 +++++++++++++++++++++++++++------------------------
 2 files changed, 30 insertions(+), 28 deletions(-)

diff --git a/etc/NEWS b/etc/NEWS
index ba7dc16..50538a1 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -1285,10 +1285,9 @@ the variables 'bookmark-bmenu-use-header-line' and
 'bookmark-bmenu-inline-header-height' are now declared obsolete.
 
 ---
-*** New user option 'bookmark-fontify'.
-If non-nil, setting a bookmark will colorize the current line with
-'bookmark-face', and jumping to a bookmark will colorize the line the
-bookmark was set on.
+*** New user option 'bookmark-set-fringe-mark'.
+If non-nil, setting a bookmark will set a fringe mark on the current
+line, and jumping to a bookmark will also set this mark.
 
 ---
 *** New user option 'bookmark-menu-confirm-deletion'.
diff --git a/lisp/bookmark.el b/lisp/bookmark.el
index b340d37..719fc98 100644
--- a/lisp/bookmark.el
+++ b/lisp/bookmark.el
@@ -173,10 +173,8 @@ A non-nil value may result in truncated bookmark names."
   "Time before `bookmark-bmenu-search' updates the display."
   :type  'number)
 
-(defcustom bookmark-fontify t
-  "Whether to colorize a bookmarked line.
-If non-nil, setting a bookmark will colorize the current line with
-`bookmark-face'."
+(defcustom bookmark-set-fringe-mark t
+  "Whether to set a fringe mark at bookmarked lines."
   :type  'boolean
   :version "28.1")
 
@@ -189,16 +187,16 @@ If non-nil, setting a bookmark will colorize the current 
line with
 (defface bookmark-face
   '((((class grayscale)
       (background light))
-     :background "DimGray")
+     :foreground "DimGray")
     (((class grayscale)
       (background dark))
-     :background "LightGray")
+     :foreground "LightGray")
     (((class color)
       (background light))
-     :foreground "White" :background "DarkOrange1")
+     :background "White" :foreground "DarkOrange1")
     (((class color)
       (background dark))
-     :foreground "Black" :background "DarkOrange1"))
+     :background "Black" :foreground "DarkOrange1"))
   "Face used to highlight current line."
   :version "28.1")
 
@@ -455,18 +453,23 @@ In other words, return all information but the name."
 (defvar bookmark-history nil
   "The history list for bookmark functions.")
 
-(defun bookmark--fontify ()
+(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-fontify'."
-  (let ((bm (make-overlay (point-at-bol)
-                          (min (point-max) (1+ (point-at-eol))))))
+See user option `bookmark-set-fringe-mark'."
+  (let ((bm (make-overlay (point-at-bol) (point-at-bol))))
     (overlay-put bm 'category 'bookmark)
-    (overlay-put bm 'face 'bookmark-face)))
+    (overlay-put bm 'before-string
+                 (propertize
+                  "x" 'display
+                  `(left-fringe bookmark-fringe-mark bookmark-face)))))
 
-(defun bookmark--unfontify (bm)
+(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-fontify'."
+See user option `bookmark-set-fringe'."
   (let ((filename (cdr (assq 'filename bm)))
         (pos (cdr (assq 'position bm)))
         overlays found temp)
@@ -475,7 +478,7 @@ See user option `bookmark-fontify'."
       (dolist (buf (buffer-list))
         (with-current-buffer buf
           (when (equal filename buffer-file-name)
-            (setq overlays (overlays-at pos))
+            (setq overlays (overlays-in pos pos))
             (while (and (not found) (setq temp (pop overlays)))
               (when (eq 'bookmark (overlay-get temp 'category))
                 (delete-overlay (setq found temp))))))))))
@@ -565,8 +568,8 @@ 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-fontify
-            (bookmark--unfontify bm))
+          (when bookmark-set-fringe-mark
+            (bookmark--remove-fringe-mark bm))
           ;; Modify using the new (NAME . ALIST) format.
           (setcdr bm alist))
 
@@ -882,8 +885,8 @@ 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-fontify
-             (bookmark--fontify))))
+           (when bookmark-set-fringe-mark
+             (bookmark--set-fringe-mark))))
     (setq bookmark-yank-point nil)
     (setq bookmark-current-buffer nil)))
 
@@ -1152,14 +1155,14 @@ 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-fontify
-    (let ((overlays (overlays-at (point)))
+  (when bookmark-set-fringe-mark
+    (let ((overlays (overlays-in (point) (point)))
           temp found)
       (while (and (not found) (setq temp (pop overlays)))
         (when (eq 'bookmark (overlay-get temp 'category))
           (setq found t)))
       (unless found
-        (bookmark--fontify))))
+        (bookmark--set-fringe-mark))))
   (run-hooks 'bookmark-after-jump-hook)
   (if bookmark-automatically-show-annotations
       ;; if there is an annotation for this bookmark,
@@ -1423,7 +1426,7 @@ probably because we were called from there."
   (bookmark-maybe-historicize-string bookmark-name)
   (bookmark-maybe-load-default-file)
   (let ((will-go (bookmark-get-bookmark bookmark-name 'noerror)))
-    (bookmark--unfontify will-go)
+    (bookmark--remove-fringe-mark will-go)
     (setq bookmark-alist (delq will-go bookmark-alist))
     ;; Added by db, nil bookmark-current-bookmark if the last
     ;; occurrence has been deleted