diff options
author | dickmao <dick.r.chiang@gmail.com> | 2022-03-20 11:34:56 -0400 |
---|---|---|
committer | Lars Ingebrigtsen <larsi@gnus.org> | 2022-03-21 16:07:18 +0100 |
commit | 0a094fb65ca1392231ef8176f89f936e39f3296e (patch) | |
tree | 12149a218d15e0861f764b990e3b7b6252e9d202 /lisp/hl-line.el | |
parent | bd5d136777ef30f36807c7e690413846ed38fce1 (diff) | |
download | emacs-0a094fb65ca1392231ef8176f89f936e39f3296e.tar.gz |
Rewrite hl-line-mode
The fashion of dual global and minor modes, each managing a replica of
state, has long been outmoded by globalized minor modes (nee
easy-mmode-define-global-mode) around the turn of the century.
* lisp/calendar/todo-mode.el (todo-toggle-item-highlighting,
todo-hl-line-range, todo-modes-set-2): Adapt to new
hl-line-highlight-hook.
* lisp/hl-line.el (hl-line-overlay): Rename hl-line--overlay.
(global-hl-line-overlay, global-hl-line-overlays,
global-hl-line-sticky-flag, hl-line-overlay-buffer,
hl-line-range-function): Obsolesce.
(hl-line--overlay): Erstwhile hl-line-overlay.
(hl-line, hl-line-face): Consolidate.
(hl-line-sticky-flag): Say less (Gen Z Hospital).
(hl-line-overlay-priority): Make this a custom.
(hl-line-highlight-hook): Prefer hook over specialized
hl-line-range-function.
(hl-line-mode): Say less (Gen Z Hospital).
(hl-line-make-overlay): Remove
(hl-line-highlight, hl-line-unhighlight): Rewrite.
(hl-line-maybe-unhighlight): Remove.
(hl-line-turn-on): Necessary for globalized minor mode.
(global-hl-line-mode, global-hl-line-highlight,
global-hl-line-highlight-all, global-hl-line-unhighlight,
global-hl-line-maybe-unhighlight, global-hl-line-unhighlight-all):
Prefer globalized minor mode.
(hl-line-move, hl-line-unload-function): Remove.
* test/lisp/calendar/todo-mode-tests.el (todo-test-item-highlighting,
todo-test-done-items-separator06-bol,
todo-test-done-items-separator06-eol,
todo-test-done-items-separator07): Adapt to consolidated face.
Diffstat (limited to 'lisp/hl-line.el')
-rw-r--r-- | lisp/hl-line.el | 297 |
1 files changed, 63 insertions, 234 deletions
diff --git a/lisp/hl-line.el b/lisp/hl-line.el index 8e60ddf6b07..daa24c4fbf3 100644 --- a/lisp/hl-line.el +++ b/lisp/hl-line.el @@ -24,274 +24,103 @@ ;;; Commentary: -;; Provides a local minor mode (toggled by M-x hl-line-mode) and -;; a global minor mode (toggled by M-x global-hl-line-mode) to -;; highlight, on a suitable terminal, the line on which point is. The -;; global mode highlights the current line in the selected window only -;; (except when the minibuffer window is selected). This was -;; implemented to satisfy a request for a feature of Lesser Editors. -;; The local mode is sticky: it highlights the line about the buffer's -;; point even if the buffer's window is not selected. Caveat: the -;; buffer's point might be different from the point of a non-selected -;; window. Set the variable `hl-line-sticky-flag' to nil to make the -;; local mode behave like the global mode. - -;; You probably don't really want to use the global mode; if the -;; cursor is difficult to spot, try changing its color, relying on -;; `blink-cursor-mode' or both. The hookery used might affect -;; response noticeably on a slow machine. The local mode may be -;; useful in non-editing buffers such as Gnus or PCL-CVS though. - -;; An overlay is used. In the non-sticky cases, this overlay is -;; active only on the selected window. A hook is added to -;; `post-command-hook' to activate the overlay and move it to the line -;; about point. - -;; You could make variable `global-hl-line-mode' buffer-local and set -;; it to nil to avoid highlighting specific buffers, when the global -;; mode is used. - -;; By default the whole line is highlighted. The range of highlighting -;; can be changed by defining an appropriate function as the -;; buffer-local value of `hl-line-range-function'. - ;;; Code: -(defvar-local hl-line-overlay nil - "Overlay used by Hl-Line mode to highlight the current line.") +(make-obsolete-variable 'hl-line-overlay nil "29.1") +(make-obsolete-variable 'global-hl-line-overlay nil "29.1") +(make-obsolete-variable 'global-hl-line-overlays nil "29.1") +(make-obsolete-variable 'global-hl-line-sticky-flag nil "29.1") +(make-obsolete-variable 'hl-line-overlay-buffer nil "29.1") +(make-obsolete-variable 'hl-line-range-function nil "29.1") -(defvar-local global-hl-line-overlay nil - "Overlay used by Global-Hl-Line mode to highlight the current line.") +(defvar-local hl-line--overlay nil + "Keep state else scan entire buffer in `post-command-hook'.") -(defvar global-hl-line-overlays nil - "Overlays used by Global-Hl-Line mode in various buffers. -Global-Hl-Line keeps displaying one overlay in each buffer -when `global-hl-line-sticky-flag' is non-nil.") +;; 1. define-minor-mode creates buffer-local hl-line--overlay +;; 2. overlay wiped by kill-all-local-variables +;; 3. post-command-hook dupes overlay +;; Solution: prevent step 2. +(put 'hl-line--overlay 'permanent-local t) (defgroup hl-line nil "Highlight the current line." :version "21.1" :group 'convenience) -(defface hl-line - '((t :inherit highlight :extend t)) - "Default face for highlighting the current line in Hl-Line mode." +(defface hl-line-face '((t :inherit highlight :extend t)) + "Default face for highlighting the current line in hl-line-mode." :version "22.1" :group 'hl-line) -(defcustom hl-line-face 'hl-line - "Face with which to highlight the current line in Hl-Line mode." - :type 'face - :group 'hl-line - :set (lambda (symbol value) - (set symbol value) - (dolist (buffer (buffer-list)) - (with-current-buffer buffer - (when (overlayp hl-line-overlay) - (overlay-put hl-line-overlay 'face hl-line-face)))) - (when (overlayp global-hl-line-overlay) - (overlay-put global-hl-line-overlay 'face hl-line-face)))) - (defcustom hl-line-sticky-flag t - "Non-nil means the HL-Line mode highlight appears in all windows. -Otherwise Hl-Line mode will highlight only in the selected -window. Setting this variable takes effect the next time you use -the command `hl-line-mode' to turn Hl-Line mode on. - -This variable has no effect in Global Highlight Line mode. -For that, use `global-hl-line-sticky-flag'." + "Non-nil to preserve highlighting overlay when focus leaves window." :type 'boolean :version "22.1" + :group 'hl-line + :set (lambda (symbol value) + (set-default symbol value) + (unless value + (let ((selected (window-buffer (selected-window)))) + (dolist (buffer (buffer-list)) + (unless (eq buffer selected) + (with-current-buffer buffer + (hl-line-unhighlight)))))))) + +(defcustom hl-line-overlay-priority -50 + "Priority used on the overlay used by hl-line." + :type 'integer + :version "22.1" :group 'hl-line) -(defcustom global-hl-line-sticky-flag nil - "Non-nil means the Global HL-Line mode highlight appears in all windows. -Otherwise Global Hl-Line mode will highlight only in the selected -window. Setting this variable takes effect the next time you use -the command `global-hl-line-mode' to turn Global Hl-Line mode on." - :type 'boolean - :version "24.1" +(defcustom hl-line-highlight-hook nil + "After hook for `hl-line-highlight'. +Currently used in calendar/todo-mode." + :type 'hook :group 'hl-line) -(defvar hl-line-range-function nil - "If non-nil, function to call to return highlight range. -The function of no args should return a cons cell; its car value -is the beginning position of highlight and its cdr value is the -end position of highlight in the buffer. -It should return nil if there's no region to be highlighted. - -This variable is expected to be made buffer-local by modes.") - -(defvar hl-line-overlay-buffer nil - "Most recently visited buffer in which Hl-Line mode is enabled.") - -(defvar hl-line-overlay-priority -50 - "Priority used on the overlay used by hl-line.") - ;;;###autoload (define-minor-mode hl-line-mode - "Toggle highlighting of the current line (Hl-Line mode). - -Hl-Line mode is a buffer-local minor mode. If -`hl-line-sticky-flag' is non-nil, Hl-Line mode highlights the -line about the buffer's point in all windows. Caveat: the -buffer's point might be different from the point of a -non-selected window. Hl-Line mode uses the function -`hl-line-highlight' on `post-command-hook' in this case. - -When `hl-line-sticky-flag' is nil, Hl-Line mode highlights the -line about point in the selected window only." + "Toggle highlighting of the current line." :group 'hl-line (if hl-line-mode (progn - ;; In case `kill-all-local-variables' is called. - (add-hook 'change-major-mode-hook #'hl-line-unhighlight nil t) (hl-line-highlight) - (setq hl-line-overlay-buffer (current-buffer)) + (add-hook 'change-major-mode-hook #'hl-line-unhighlight nil t) (add-hook 'post-command-hook #'hl-line-highlight nil t)) (remove-hook 'post-command-hook #'hl-line-highlight t) - (hl-line-unhighlight) - (remove-hook 'change-major-mode-hook #'hl-line-unhighlight t))) - -(defun hl-line-make-overlay () - (let ((ol (make-overlay (point) (point)))) - (overlay-put ol 'priority hl-line-overlay-priority) ;(bug#16192) - (overlay-put ol 'face hl-line-face) - ol)) - -(defun hl-line-highlight () - "Activate the Hl-Line overlay on the current line." - (if hl-line-mode ; Might be changed outside the mode function. - (progn - (unless (overlayp hl-line-overlay) - (setq hl-line-overlay (hl-line-make-overlay))) ; To be moved. - (overlay-put hl-line-overlay - 'window (unless hl-line-sticky-flag (selected-window))) - (hl-line-move hl-line-overlay) - (hl-line-maybe-unhighlight)) - (hl-line-unhighlight))) + (remove-hook 'change-major-mode-hook #'hl-line-unhighlight t) + (let (hl-line-sticky-flag) + (hl-line-unhighlight)))) (defun hl-line-unhighlight () - "Deactivate the Hl-Line overlay on the current line." - (when (overlayp hl-line-overlay) - (delete-overlay hl-line-overlay) - (setq hl-line-overlay nil))) + (unless hl-line-sticky-flag + (when hl-line--overlay + (delete-overlay hl-line--overlay) + (setq hl-line--overlay nil)))) -(defun hl-line-maybe-unhighlight () - "Maybe deactivate the Hl-Line overlay on the current line. -Specifically, when `hl-line-sticky-flag' is nil deactivate all -such overlays in all buffers except the current one." - (let ((hlob hl-line-overlay-buffer) - (curbuf (current-buffer))) - (when (and (buffer-live-p hlob) - (not hl-line-sticky-flag) - (not (eq curbuf hlob)) - (not (minibufferp))) - (with-current-buffer hlob - (hl-line-unhighlight))) - (when (and (overlayp hl-line-overlay) - (eq (overlay-buffer hl-line-overlay) curbuf)) - (setq hl-line-overlay-buffer curbuf)))) +(defun hl-line-highlight () + (unless (minibufferp) + (unless hl-line--overlay + (setq hl-line--overlay + (let ((ol (make-overlay (point) (point)))) + (prog1 ol + (overlay-put ol 'priority hl-line-overlay-priority) + (overlay-put ol 'face 'hl-line-face))))) + (move-overlay hl-line--overlay + (line-beginning-position) + (line-beginning-position 2)) + (run-hooks 'hl-line-highlight-hook))) + +(defun hl-line-turn-on () + (unless (minibufferp) + (let (inhibit-quit) + (hl-line-mode 1)))) ;;;###autoload -(define-minor-mode global-hl-line-mode - "Toggle line highlighting in all buffers (Global Hl-Line mode). - -If `global-hl-line-sticky-flag' is non-nil, Global Hl-Line mode -highlights the line about the current buffer's point in all live -windows. - -Global-Hl-Line mode uses the function `global-hl-line-highlight' -on `post-command-hook'." - :global t +(define-globalized-minor-mode global-hl-line-mode + hl-line-mode hl-line-turn-on :group 'hl-line - (if global-hl-line-mode - (progn - ;; In case `kill-all-local-variables' is called. - (add-hook 'change-major-mode-hook #'global-hl-line-unhighlight) - (global-hl-line-highlight-all) - (add-hook 'post-command-hook #'global-hl-line-highlight)) - (global-hl-line-unhighlight-all) - (remove-hook 'post-command-hook #'global-hl-line-highlight) - (remove-hook 'change-major-mode-hook #'global-hl-line-unhighlight))) - -(defun global-hl-line-highlight () - "Highlight the current line in the current window." - (when global-hl-line-mode ; Might be changed outside the mode function. - (unless (window-minibuffer-p) - (unless (overlayp global-hl-line-overlay) - (setq global-hl-line-overlay (hl-line-make-overlay))) ; To be moved. - (unless (member global-hl-line-overlay global-hl-line-overlays) - (push global-hl-line-overlay global-hl-line-overlays)) - (overlay-put global-hl-line-overlay 'window - (unless global-hl-line-sticky-flag - (selected-window))) - (hl-line-move global-hl-line-overlay) - (global-hl-line-maybe-unhighlight)))) - -(defun global-hl-line-highlight-all () - "Highlight the current line in all live windows." - (walk-windows (lambda (w) - (with-current-buffer (window-buffer w) - (global-hl-line-highlight))) - nil t)) - -(defun global-hl-line-unhighlight () - "Deactivate the Global-Hl-Line overlay on the current line." - (when (overlayp global-hl-line-overlay) - (delete-overlay global-hl-line-overlay) - (setq global-hl-line-overlay nil))) - -(defun global-hl-line-maybe-unhighlight () - "Maybe deactivate the Global-Hl-Line overlay on the current line. -Specifically, when `global-hl-line-sticky-flag' is nil deactivate -all such overlays in all buffers except the current one." - (mapc (lambda (ov) - (let ((ovb (overlay-buffer ov))) - (when (and (not global-hl-line-sticky-flag) - (bufferp ovb) - (not (eq ovb (current-buffer))) - (not (minibufferp))) - (with-current-buffer ovb - (global-hl-line-unhighlight))))) - global-hl-line-overlays)) - -(defun global-hl-line-unhighlight-all () - "Deactivate all Global-Hl-Line overlays." - (mapc (lambda (ov) - (let ((ovb (overlay-buffer ov))) - (when (bufferp ovb) - (with-current-buffer ovb - (global-hl-line-unhighlight))))) - global-hl-line-overlays) - (setq global-hl-line-overlays nil)) - -(defun hl-line-move (overlay) - "Move the Hl-Line overlay. -If `hl-line-range-function' is non-nil, move the OVERLAY to the position -where the function returns. If `hl-line-range-function' is nil, fill -the line including the point by OVERLAY." - (let (tmp b e) - (if hl-line-range-function - (setq tmp (funcall hl-line-range-function) - b (car tmp) - e (cdr tmp)) - (setq tmp t - b (line-beginning-position) - e (line-beginning-position 2))) - (if tmp - (move-overlay overlay b e) - (move-overlay overlay 1 1)))) - -(defun hl-line-unload-function () - "Unload the Hl-Line library." - (global-hl-line-mode -1) - (save-current-buffer - (dolist (buffer (buffer-list)) - (set-buffer buffer) - (when hl-line-mode (hl-line-mode -1)))) - ;; continue standard unloading - nil) + :version "29.1") (provide 'hl-line) |