[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
feature/completions-customs e06c4039c2: Improve the cursor-face feature.
From: |
Jimmy Aguilar Mena |
Subject: |
feature/completions-customs e06c4039c2: Improve the cursor-face feature. |
Date: |
Sun, 13 Mar 2022 21:44:51 -0400 (EDT) |
branch: feature/completions-customs
commit e06c4039c2d77f5cacb8c2a76e310e4a2e041fbc
Author: Jimmy Aguilar Mena <spacibba@aol.com>
Commit: Jimmy Aguilar Mena <spacibba@aol.com>
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 a27d6f88c2..b7377d3156 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 69c3e16b56..9e9ed6cb87 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 e20719f7a0..02f05ccb04 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))
[Prev in Thread] |
Current Thread |
[Next in Thread] |
- feature/completions-customs e06c4039c2: Improve the cursor-face feature.,
Jimmy Aguilar Mena <=