mirror/emacs
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2024-11-29 07:58:28 +00:00
Code Issues Releases Activity

Improve the cursor-face feature.

Browse Source 
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.
This commit is contained in:
Jimmy Aguilar Mena 2022-03-14 02:38:46 +01:00
parent 7380b6f0ad
commit e06c4039c2
3 changed files with 39 additions and 25 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
doc/lispref/text.texi
View File

@ -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)}

2
etc/NEWS
View File

@ -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'.

55
lisp/simple.el
View File

@ -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))