From 7fe88446c30279285e3171091189b3d1af697c05 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Mon, 13 Sep 2021 13:35:53 +0200 Subject: [PATCH] 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 ba7dc164bea..50538a168aa 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 b340d379b3f..719fc98f768 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 -- 2.39.2