Subject: bug#48179: bookmark-fontify [PATCH]

From: Boruch Baum <[email-masked]>
Date: Mon, 3 May 2021 05:58:28 -0400

On 2021-05-03 11:19, Lars Ingebrigtsen wrote:
> Boruch Baum <[email-masked]> writes:
>
> > I thought I did base the patch on yesterday's gnu.org cgit version...
> > Here's what the on-line log is showing me...
> >
> >    Age                  Commit message (Expand)                    Author       Files Lines
> > 2020-09-07 Use format-prompt in read-file-name calls that     Lars Ingebrigtsen 1     -3/+3
> >            have a default
>
> There's been half a dozen commits to bookmark.el after that one, so I
> think your Emacs is out of date.  The latest is

It's not *my* emacs. I only have access to debian emacs locally; the
data I gave you was from the URL I had for the on-line cgit repository
for emacs, at gnu.org. Here's a second patch, based upon hopefully the
most current URL, and with the additional jump code.

--
hkp://keys.gnupg.net
CA45 09B5 5351 7C11 A9D1  7286 0036 9E45 1595 8BC0
diff --git a/bookmark.el b/bookmark.el
index 98797a0..af91a6e 100644
--- a/bookmark.el
+++ b/bookmark.el
@@ -167,12 +167,29 @@ 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")
+
 ;; 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 "27.2")

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

@@ -427,6 +444,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 +867,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 +1138,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 +1409,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