1
0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2024-11-25 07:28:20 +00:00

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.
This commit is contained in:
Lars Ingebrigtsen 2021-09-13 13:35:53 +02:00
parent f5db710367
commit 7fe88446c3
2 changed files with 32 additions and 30 deletions

View File

@ -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'.

View File

@ -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 ()
"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))))))
(overlay-put bm 'category 'bookmark)
(overlay-put bm 'face 'bookmark-face)))
(define-fringe-bitmap 'bookmark-fringe-mark
"\x3c\x7e\xff\xff\xff\xff\x7e\x3c")
(defun bookmark--unfontify (bm)
(defun bookmark--set-fringe-mark ()
"Apply a colorized overlay to the bookmarked location.
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 'before-string
(propertize
"x" 'display
`(left-fringe bookmark-fringe-mark bookmark-face)))))
(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