Subject: bookmark-fontify [PATCH]

From: Boruch Baum <[email-masked]>
Date: Sun, 2 May 2021 20:13:58 -0400

The attached patch adds a feature to bookmark.el to colorize a
bookmark's line, making it easily observable. The idea was adopted from
package bm.el, available on MELPA. I was able to test this on Emacs 27,
but there seem to have been some changes in snapshot to make it
difficult to use that version of bookmark.el on my Emacs 27, so please
verify that I performed the migration properly.

OFF-TOPIC, but related: I've posted a pull-request to package bm.el
adding to it a feature to make context-based suggestions for default
bookmark annotations[1]. If Emacs wants that for package bookmark.el it
should be possible to submit a parallel patch.

[1] https://github.com/Boruch-Baum/emacs-bm/commit/dc1d8ad7eea64d94c345f3ed3885eefd8ec72d65

--
hkp://keys.gnupg.net
CA45 09B5 5351 7C11 A9D1  7286 0036 9E45 1595 8BC0
diff --git a/bookmark.el b/bookmark.el
index 206c872..197678d 100644
--- a/bookmark.el
+++ b/bookmark.el
@@ -165,11 +165,28 @@ 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 bookmark's line.
+See face `bookmark-face'."
+  :type  'boolean
+  :version "27.2")
+
 (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 "27.2")

 ;;; No user-serviceable parts beyond this point.

@@ -418,6 +435,31 @@ In other words, return all information but the name."
   "Set the rear-context-string of BOOKMARK-NAME-OR-RECORD to STRING."
   (bookmark-prop-set bookmark-name-or-record 'rear-context-string string))

+(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-get-handler (bookmark-name-or-record)
   "Return the handler function for BOOKMARK-NAME-OR-RECORD, or nil if none."
@@ -824,7 +866,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)))

@@ -1349,6 +1393,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