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.

diff --git a/etc/NEWS b/etc/NEWS
index c5e61a56eacfbafdc5c411e6e04230113406af84..33bd8b73b592e8015df0aa364a5c5277cfd2a7b3 100644 (file)
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -1081,16 +1081,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 98797a0de2a3cfa91a9b65718611694c2c0052d3..4e717a7dc0561d79fe1a418e244db16fd4f12efb 100644 (file)
--- 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