From: Jimmy Aguilar Mena <spacibba@aol.com>
Date: Thu, 10 Mar 2022 13:36:02 +0000 (+0100)
Subject: Add new mode completions-highlight-mode.
X-Git-Tag: emacs-29.0.90~1931^2~1002^2~19
X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=e683e60fad69914eb0c33c9ad83b819b160fd5a2;p=emacs.git

Add new mode completions-highlight-mode.
---

diff --git a/doc/emacs/mini.texi b/doc/emacs/mini.texi
index eb2bfce136a..afacb9c7cde 100644
--- a/doc/emacs/mini.texi
+++ b/doc/emacs/mini.texi
@@ -665,6 +665,11 @@ mode, header line and a bottom divider, if any.  For a more complex
 control of the Completion window display properties you can use
 @code{display-buffer-alist} (@pxref{Buffer Display Action Alists}).
 
+@vindex completions-highlight-mode
+When the mode @{completions-highlight-mode} is active the candidate
+under the cursor is highlighted when the completion window is
+selected.  The mode uses the face @code{completions-highlight}.
+
 @node Minibuffer History
 @section Minibuffer History
 @cindex minibuffer history
diff --git a/etc/NEWS b/etc/NEWS
index 5a0d6c8fdbd..05f219ca03e 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -565,6 +565,9 @@ some completion is made.
 *** New user option 'completions-max-height'.
 This option limits the height of the "*Completions*" buffer.
 
+*** New mode completions-highlight.
+This mode highlights the current candidate in the *Completions* buffer
+with the completions-highlight face.
 
 ** Isearch and Replace
 
diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el
index cd0c274765f..148ba7a8730 100644
--- a/lisp/minibuffer.el
+++ b/lisp/minibuffer.el
@@ -2138,6 +2138,52 @@ candidates."
   (run-hooks 'completion-setup-hook)
   nil)
 
+
+(defface completions-highlight
+  '((t :inherit highlight :extend t))
+  "Default face for highlighting the current line in Hl-Line mode."
+  :version "29.1")
+
+(defvar completions--overlay nil
+  "Overlay to use when `completions-highlight-mode' is enabled.")
+
+(defun completions-highlight--delete ()
+  "Highlight current candidate in *Completions* when ``completions-highlight''."
+  (when (overlayp completions--overlay)
+    (delete-overlay completions--overlay)))
+
+(defun completions-highlight--highlight ()
+  "Highlight current candidate if point in a candidate."
+  (let* ((point (point))
+         (hpoint (or (and (get-text-property point 'mouse-face) point)
+                     (and (> point 1) (get-text-property (1- point) 'mouse-face) (1- point)))))
+    (when hpoint
+      (move-overlay completions--overlay
+                    (previous-single-property-change (1+ hpoint) 'mouse-face nil (point-min))
+                    (next-single-property-change hpoint 'mouse-face nil (point-max))))))
+
+(defun completions-highlight--setup-hook ()
+  "Function to call when enabling the `completion-highlight-mode' mode.
+It is called when showing the *Completions* buffer."
+  (with-current-buffer "*Completions*"
+    (completions-highlight--highlight)
+    (add-hook 'pre-command-hook #'completions-highlight--delete nil t)
+    (add-hook 'post-command-hook #'completions-highlight--highlight nil t)))
+
+;;;###autoload
+(define-minor-mode completions-highlight-mode
+  "Completion highlight mode to enable candidates highlight in the minibuffer."
+  :global t
+  :group 'minibuffer
+  (cond
+   (completions-highlight-mode
+    (setq completions--overlay (make-overlay 0 0))
+    (overlay-put completions--overlay 'face 'completions-highlight)
+    (add-hook 'completion-setup-hook #'completions-highlight--setup-hook t))
+   (t
+    (remove-hook 'completion-setup-hook #'completions-highlight--setup-hook)))
+  (completions-highlight--delete))
+
 (defvar completion-extra-properties nil
   "Property list of extra properties of the current completion job.
 These include: