From e06c4039c2d77f5cacb8c2a76e310e4a2e041fbc Mon Sep 17 00:00:00 2001 From: Jimmy Aguilar Mena Date: Mon, 14 Mar 2022 02:38:46 +0100 Subject: [PATCH] Improve the cursor-face feature. Use a minor mode to reduce potential performance issues. * lisp/simple.el (cursor-face-highlight-mode) : New minor mode (completion-setup-function) : Use the new minor mode cursor-face-highlight-mode in completions. (redisplay--unhighlight-overlay-function) : Add -- to the name (redisplay--highlight-overlay-function) : Make the face parameter optional and add -- in the name. --- doc/lispref/text.texi | 7 ++++-- etc/NEWS | 2 +- lisp/simple.el | 55 ++++++++++++++++++++++++++----------------- 3 files changed, 39 insertions(+), 25 deletions(-) diff --git a/doc/lispref/text.texi b/doc/lispref/text.texi index a27d6f88c2a..b7377d3156d 100644 --- a/doc/lispref/text.texi +++ b/doc/lispref/text.texi @@ -3553,8 +3553,11 @@ unhighlighted text. @item cursor-face @kindex cursor-face @r{(text property)} -This property is similar to @code{mouse-face} but is used when the -cursor is on or near the character. +This property is similar to @code{mouse-face} but the face is used the +cursor (instead of mouse) is on or near the character. Near has the +same meaning than in @code{mouse-face} and the highlight only takes +effect if the mode @code{cursor-face-highlight-mode} is enabled; +otherwise no highlight is performed. @item fontified @kindex fontified @r{(text property)} diff --git a/etc/NEWS b/etc/NEWS index 69c3e16b560..9e9ed6cb87f 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1264,7 +1264,7 @@ This allows setting a minimum display width for a region of text. +++ ** New 'cursor-face 'text' property. This uses cursor-face instead of the default face when cursor is on or -near the character. +near the character and 'cursor-face-highlight-mode' is enabled. +++ ** New event type 'touch-end'. diff --git a/lisp/simple.el b/lisp/simple.el index e20719f7a0f..02f05ccb041 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -6482,15 +6482,17 @@ An example is a rectangular region handled as a list of separate contiguous regions for each line." (cdr (region-bounds))) -(defun redisplay-unhighlight-overlay-function (rol) +(defun redisplay--unhighlight-overlay-function (rol) "If ROL is an overlay, call ``delete-overlay''." (when (overlayp rol) (delete-overlay rol))) -(defvar redisplay-unhighlight-region-function #'redisplay-unhighlight-overlay-function +(defvar redisplay-unhighlight-region-function + #'redisplay--unhighlight-overlay-function "Function to remove the region-highlight overlay.") -(defun redisplay-highlight-overlay-function (start end window rol face) +(defun redisplay--highlight-overlay-function (start end window rol &optional face) "Update the overlay ROL in WINDOW with FACE in range START-END." + (unless face (setq face 'region)) (if (not (overlayp rol)) (let ((nrol (make-overlay start end))) (funcall redisplay-unhighlight-region-function rol) @@ -6510,7 +6512,8 @@ separate contiguous regions for each line." (move-overlay rol start end (current-buffer))) rol)) -(defvar redisplay-highlight-region-function #'redisplay-highlight-overlay-function +(defvar redisplay-highlight-region-function + #'redisplay--highlight-overlay-function "Function to move the region-highlight overlay. This function is called with four parameters, START, END, WINDOW and OVERLAY. If OVERLAY is nil, a new overlay is created. In @@ -6533,28 +6536,33 @@ The overlay is returned by the function.") (end (max pt mark)) (new (funcall redisplay-highlight-region-function - start end window rol 'region))) + start end window rol))) (unless (equal new rol) (set-window-parameter window 'internal-region-overlay new)))))) +(define-minor-mode cursor-face-highlight-mode + "When enabled the cursor-face property is respected.") + (defun redisplay--update-cursor-face-highlight (window) - "This highlights the overlay used to highlight text with cursor-face." - (let ((rol (window-parameter window 'internal-cursor-face-overlay)) - (pt) (value) (cursor-face)) - (if (and (or (eq window (selected-window)) - (and (window-minibuffer-p) - (eq window (minibuffer-selected-window)))) - (setq pt (window-point window)) - (setq value (get-text-property pt 'cursor-face)) - ;; extra code needed here for when passing plists - (setq cursor-face (if (facep value) value))) - (let* ((start (previous-single-property-change (1+ pt) 'cursor-face nil (point-min))) - (end (next-single-property-change pt 'cursor-face nil (point-max))) - (new (redisplay-highlight-overlay-function start end window rol cursor-face))) - (unless (equal new rol) - (set-window-parameter window 'internal-cursor-face-overlay new))) - (if rol - (redisplay-unhighlight-overlay-function rol))))) + "Highlights the overlay used to highlight text with cursor-face." + (when cursor-face-highlight-mode + (let ((rol (window-parameter window 'internal-cursor-face-overlay))) + (if-let (((or (eq window (selected-window)) + (and (window-minibuffer-p) + (eq window (minibuffer-selected-window))))) + (pt (window-point window)) + (value (get-text-property pt 'cursor-face)) + ;; Extra code needed here for when passing plists. + (cursor-face (if (facep value) value))) + (let* ((start (previous-single-property-change + (1+ pt) 'cursor-face nil (point-min))) + (end (next-single-property-change + pt 'cursor-face nil (point-max))) + (new (redisplay--highlight-overlay-function + start end window rol cursor-face))) + (unless (equal new rol) + (set-window-parameter window 'internal-cursor-face-overlay new))) + (redisplay--unhighlight-overlay-function rol))))) (defvar pre-redisplay-functions (list #'redisplay--update-cursor-face-highlight #'redisplay--update-region-highlight) @@ -9379,6 +9387,9 @@ Called from `temp-buffer-show-hook'." (if base-dir (setq default-directory base-dir)) (when completion-tab-width (setq tab-width completion-tab-width)) + ;; Maybe enable cursor completions-highlight. + (when completions-highlight-face + (cursor-face-highlight-mode 1)) ;; Maybe insert help string. (when completion-show-help (goto-char (point-min)) -- 2.39.2