master ab6cb65: Fontify lines when setting a bookmark

[Lars Ingebrigtsen]

branch: master
commit ab6cb65cb2b6d11a7b690dfcea8d98611290fad9
Author: Boruch Baum <boruch_baum@gmx.com>
Commit: Lars Ingebrigtsen <larsi@gnus.org>

    Fontify lines when setting a bookmark
    
    * lisp/bookmark.el (bookmark-fontify): New user option (bug#48179).
    (bookmark-face): New face.
    (bookmark--fontify, bookmark--unfontify): New functions.
    (bookmark-set-internal, bookmark--jump-via, bookmark-delete): Use
    them.
---
 etc/NEWS         | 35 ++++++++++++++++++++-------------
 lisp/bookmark.el | 60 +++++++++++++++++++++++++++++++++++++++++++++++++++++++-
 2 files changed, 80 insertions(+), 15 deletions(-)

diff --git a/etc/NEWS b/etc/NEWS
index c5e61a5..33bd8b7 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -1082,16 +1082,6 @@ defaulting to active region when used interactively.
 ** The old non-SMIE indentation of 'sh-mode' has been removed.
 
 ---
-** The 'list-bookmarks' menu is now based on 'tabulated-list-mode'.
-The interactive bookmark list will now benefit from features in
-'tabulated-list-mode' like sorting columns or changing column width.
-
-Support for the optional "inline" header line, allowing for a header
-without using 'header-line-format', has been dropped.  Consequently,
-the variables 'bookmark-bmenu-use-header-line' and
-'bookmark-bmenu-inline-header-height' are now declared obsolete.
-
----
 ** The sb-image.el library is now marked obsolete.
 This file was a compatibility kludge which is no longer needed.
 
@@ -1114,6 +1104,27 @@ To customize obsolete user options, use 
'customize-option' or
 They will be used automatically instead of the old icons.  If Emacs is
 built without SVG support, the old icons will be used instead.
 
+** Bookmarks
+
+*** Bookmarks can now be targets for new tabs.
+When the bookmark.el library is loaded, a customize choice is added
+to 'tab-bar-new-tab-choice' for new tabs to show the bookmark list.
+
+---
+*** The 'list-bookmarks' menu is now based on 'tabulated-list-mode'.
+The interactive bookmark list will now benefit from features in
+'tabulated-list-mode' like sorting columns or changing column width.
+
+Support for the optional "inline" header line, allowing for a header
+without using 'header-line-format', has been dropped.  Consequently,
+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'.
+
+
 ** Edebug
 
 *** Obsoletions
@@ -2194,10 +2205,6 @@ The width now depends of the width of the window, but 
will never be
 wider than the length of the longest buffer name, except that it will
 never be narrower than 19 characters.
 
-*** Bookmarks can now be targets for new tabs.
-When the bookmark.el library is loaded, a customize choice is added
-to 'tab-bar-new-tab-choice' for new tabs to show the bookmark list.
-
 ---
 *** Movement commands in 'gomoku-mode' are fixed.
 'gomoku-move-sw' and 'gomoku-move-ne' now work correctly, and
diff --git a/lisp/bookmark.el b/lisp/bookmark.el
index 98797a0..4e717a7 100644
--- a/lisp/bookmark.el
+++ b/lisp/bookmark.el
@@ -167,12 +167,34 @@ 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 wil colorize the current line with
+`bookmark-face'."
+  :type  'boolean
+  :version "28.1")
+
 ;; FIXME: No longer used.  Should be declared obsolete or removed.
 (defface bookmark-menu-heading
   '((t (:inherit font-lock-type-face)))
   "Face used to highlight the heading in bookmark menu buffers."
   :version "22.1")
 
+(defface bookmark-face
+  '((((class grayscale)
+      (background light))
+     (:background "DimGray"))
+    (((class grayscale)
+      (background dark))
+     (:background "LightGray"))
+    (((class color)
+      (background light))
+     (:foreground "White" :background "DarkOrange1"))
+    (((class color)
+      (background dark))
+     (:foreground "Black" :background "DarkOrange1")))
+  "Face used to highlight current line."
+  :version "28.2")
 
 ;;; No user-serviceable parts beyond this point.
 
@@ -427,6 +449,31 @@ In other words, return all information but the name."
 (defvar bookmark-history nil
   "The history list for bookmark functions.")
 
+(defun bookmark--fontify ()
+  "Apply a colorized overlay to the bookmarked location.
+See defcustom variable `bookmark-fontify'."
+  (let ((bm (make-overlay (point-at-bol)
+                          (min (point-max) (+ 1 (point-at-eol))))))
+    (overlay-put bm 'category 'bookmark)
+    (overlay-put bm 'face 'bookmark-face)))
+
+(defun bookmark--unfontify (bm)
+  "Remove a bookmark's colorized overlay.
+BM is a bookmark as returned from function `bookmark-get-bookmark'.
+See defcustom variable `bookmark-fontify'."
+  (let ((filename (assq 'filename bm))
+        (pos      (assq 'position bm))
+        (buffers  (buffer-list))
+        buf overlays found temp)
+    (when filename (setq filename (expand-file-name (cdr filename))))
+    (when pos (setq pos (cdr pos)))
+    (while (setq buf (pop buffers))
+      (with-current-buffer buf
+        (when (equal filename buffer-file-name)
+          (setq overlays (overlays-at pos))
+          (while (and (not found) (setq temp (pop overlays)))
+            (when (eq 'bookmark (overlay-get temp 'category))
+              (delete-overlay (setq found temp)))))))))
 
 (defun bookmark-completing-read (prompt &optional default)
   "Prompting with PROMPT, read a bookmark name in completion.
@@ -825,7 +872,9 @@ 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))))
+             (bookmark-edit-annotation str))
+           (when bookmark-fontify
+             (bookmark--fontify))))
     (setq bookmark-yank-point nil)
     (setq bookmark-current-buffer nil)))
 
@@ -1094,6 +1143,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)))
+          temp found)
+      (while (and (not found) (setq temp (pop overlays)))
+        (when (eq 'bookmark (overlay-get temp 'category))
+          (setq found t)))
+      (unless found
+        (bookmark--fontify))))
   (run-hooks 'bookmark-after-jump-hook)
   (if bookmark-automatically-show-annotations
       ;; if there is an annotation for this bookmark,
@@ -1357,6 +1414,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)
     (setq bookmark-alist (delq will-go bookmark-alist))
     ;; Added by db, nil bookmark-current-bookmark if the last
     ;; occurrence has been deleted