Add new special text attribute cursor-face

Reuse the functions for highlight region.
* lisp/simple.el (redisplay-unhighlight-overlay-function) :
(redisplay-highlight-overlay-function) : New functions from previous
lambda
(redisplay-unhighlight-region-function) :
(redisplay-highlight-region-function) : Redefined with the new functions.
(redisplay--update-cursor-property-highlight) : New function for
pre-redisplay-functions.

diff --git a/doc/lispref/text.texi b/doc/lispref/text.texi
index 7897adeb0535db9447b156d37fc24b6e861c476d..a27d6f88c2a857904ab4a4671df7d23ccfd2d32b 100644 (file)
--- a/doc/lispref/text.texi
+++ b/doc/lispref/text.texi
@@ -3551,6 +3551,11 @@ that alter the text size (e.g., @code{:height}, @code{:weight}, and
 @code{:slant}).  Those attributes are always the same as for the
 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.
+
 @item fontified
 @kindex fontified @r{(text property)}
 This property says whether the text is ready for display.  If

diff --git a/etc/NEWS b/etc/NEWS
index c374a5b999f435de66470e36996c2d4846d810da..22ba84f084bba36fd8e2a5b84c45abc22fca2a56 100644 (file)
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -1260,6 +1260,11 @@ property.
 ** New 'min-width' 'display' property.
 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.
+
 +++
 ** New event type 'touch-end'.
 This event is sent whenever the user's finger moves off the mouse

diff --git a/lisp/simple.el b/lisp/simple.el
index accc119e2b3903a70478aee1f406a0c45b2da06d..cc356addb9730ad822a24b674fa061e542682e13 100644 (file)
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -6482,27 +6482,35 @@ An example is a rectangular region handled as a list of
 separate contiguous regions for each line."
   (cdr (region-bounds)))
 
-(defvar redisplay-unhighlight-region-function
-  (lambda (rol) (when (overlayp rol) (delete-overlay rol))))
-
-(defvar redisplay-highlight-region-function
-  (lambda (start end window rol)
-    (if (not (overlayp rol))
-        (let ((nrol (make-overlay start end)))
-          (funcall redisplay-unhighlight-region-function rol)
-          (overlay-put nrol 'window window)
-          (overlay-put nrol 'face 'region)
-          ;; Normal priority so that a large region doesn't hide all the
-          ;; overlays within it, but high secondary priority so that if it
-          ;; ends/starts in the middle of a small overlay, that small overlay
-          ;; won't hide the region's boundaries.
-          (overlay-put nrol 'priority '(nil . 100))
-          nrol)
-      (unless (and (eq (overlay-buffer rol) (current-buffer))
-                   (eq (overlay-start rol) start)
-                   (eq (overlay-end rol) end))
-        (move-overlay rol start end (current-buffer)))
-      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
+  "Function to remove the region-highlight overlay.")
+
+(defun redisplay-highlight-overlay-function (start end window rol face)
+  "Update the overlay ROL in WINDOW with FACE in range START-END."
+  (if (not (overlayp rol))
+      (let ((nrol (make-overlay start end)))
+        (funcall redisplay-unhighlight-region-function rol)
+        (overlay-put nrol 'window window)
+        (overlay-put nrol 'face face)
+        ;; Normal priority so that a large region doesn't hide all the
+        ;; overlays within it, but high secondary priority so that if it
+        ;; ends/starts in the middle of a small overlay, that small overlay
+        ;; won't hide the region's boundaries.
+        (overlay-put nrol 'priority '(nil . 100))
+        nrol)
+    (unless (eq (overlay-get rol 'face) face)
+      (overlay-put rol 'face face))
+    (unless (and (eq (overlay-buffer rol) (current-buffer))
+                 (eq (overlay-start rol) start)
+                 (eq (overlay-end rol) end))
+      (move-overlay rol start end (current-buffer)))
+    rol))
+
+(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
@@ -6525,12 +6533,31 @@ The overlay is returned by the function.")
              (end   (max pt mark))
              (new
               (funcall redisplay-highlight-region-function
-                       start end window rol)))
+                       start end window rol 'region)))
         (unless (equal new rol)
-          (set-window-parameter window 'internal-region-overlay
-                                new))))))
-
-(defvar pre-redisplay-functions (list #'redisplay--update-region-highlight)
+          (set-window-parameter window 'internal-region-overlay new))))))
+
+(defun redisplay--update-cursor-property-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)))))
+
+(defvar pre-redisplay-functions (list #'redisplay--update-cursor-property-highlight
+                                      #'redisplay--update-region-highlight)
   "Hook run just before redisplay.
 It is called in each window that is to be redisplayed.  It takes one argument,
 which is the window that will be redisplayed.  When run, the `current-buffer'