feature/completions-customs fd7bde612a 3/3: Add new special text attribute cursor-face

[Jimmy Aguilar Mena]

branch: feature/completions-customs
commit fd7bde612ab7a027651ffa29cb390aeb67679d8b
Author: Jimmy Aguilar Mena <spacibba@aol.com>
Commit: Jimmy Aguilar Mena <spacibba@aol.com>

    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.
---
 doc/lispref/text.texi |  5 ++++
 etc/NEWS              |  5 ++++
 lisp/simple.el        | 79 ++++++++++++++++++++++++++++++++++-----------------
 3 files changed, 63 insertions(+), 26 deletions(-)

diff --git a/doc/lispref/text.texi b/doc/lispref/text.texi
index 7897adeb05..a27d6f88c2 100644
--- 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 c374a5b999..22ba84f084 100644
--- 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 accc119e2b..cc356addb9 100644
--- 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'