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.

diff --git a/doc/lispref/text.texi b/doc/lispref/text.texi
index a27d6f88c2a857904ab4a4671df7d23ccfd2d32b..b7377d3156d05e655f790e9e41366aba4f561384 100644 (file)
--- 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 69c3e16b560da4be50feed6a0085793277611d2c..9e9ed6cb87f8d333e4d1594e0f76549fbf5fdce3 100644 (file)
--- 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 e20719f7a0f28390af9a5d7d441552106d5378a3..02f05ccb04122fdffda0f1aee82a79d6474dc10e 100644 (file)
--- 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))