bug#67479: [PATCH] Facilitate using Completion Preview with the mouse

bug#67479: [PATCH] Facilitate using Completion Preview with the mouse

[Eshel Yaron via Bug reports for GNU Emacs, the Swiss army knife of text editors]

[-- Attachment #1: Type: text/plain, Size: 165 bytes --]

Tags: patch

This patch makes Completion Preview mode more convenient, and useful,
when you're working with one hand on a mouse or similar device.


Thanks,

Eshel


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-Facilitate-using-Completion-Preview-with-the-mouse.patch --]
[-- Type: text/patch, Size: 7038 bytes --]

From 2a1f17d183d1b72faf6a37a272c18a5766189006 Mon Sep 17 00:00:00 2001
From: Eshel Yaron <me@eshelyaron.com>
Date: Sun, 26 Nov 2023 17:00:32 +0100
Subject: [PATCH] Facilitate using Completion Preview with the mouse

Allow users to accept the completion suggestion by clicking on it, and
to cycle between completion suggestions by scrolling (with a mouse
wheel or a trackpad) over the preview.

Also display a message by default when cycling to inform the user
about the index of the current suggestion out of the available total.

* lisp/completion-preview.el (completion-preview-highlight): New face.
(completion-preview-message-format): New user option.
(completion-preview--mouse-map): New keymap.
(completion-preview--try-table, completion-preview--show)
(completion-preview-next-candidate): Apply 'keymap' and 'mouse-face'
properties to completion preview string.
(completion-preview--internal-commands): Add 'mwheel-scroll'.  This
prevents incidental scrolls outside of the preview from dismissing the
preview when you actually want to cycle it.
(completion-preview--active-p): New function.  Use it as a
'completion-predicate' symbol property for commands that should only
be used when the preview is shown to otherwise exclude these commands
from M-x completion candidates.
---
 lisp/completion-preview.el | 66 ++++++++++++++++++++++++++++++++++----
 1 file changed, 60 insertions(+), 6 deletions(-)

diff --git a/lisp/completion-preview.el b/lisp/completion-preview.el
index 039a330bc84..1d5f1253702 100644
--- a/lisp/completion-preview.el
+++ b/lisp/completion-preview.el
@@ -83,6 +83,22 @@ completion-preview-minimum-symbol-length
   :type 'natnum
   :version "30.1")
 
+(defcustom completion-preview-message-format
+  "Completion suggestion %i out of %n"
+  "Message to show after cycling the completion preview suggestion.
+
+If the value is a string, `completion-preview-next-candidate' and
+`completion-preview-prev-candidate' display this string in the
+echo area, after substituting \"%i\" with the 1-based index of
+the completion suggestion that the preview is showing, and \"%n\"
+with the total number of available completion suggestions for the
+text around point.
+
+If this option is nil, these commands do not display any message."
+  :type '(choice (string :tag "Message format")
+                 (const :tag "No message" nil))
+  :version "30.1")
+
 (defvar completion-preview-sort-function #'minibuffer--sort-by-length-alpha
   "Sort function to use for choosing a completion candidate to preview.")
 
@@ -100,6 +116,11 @@ completion-preview-exact
   "Face for exact completion preview overlay."
   :version "30.1")
 
+(defface completion-preview-highlight
+  '((t :inherit highlight))
+  "Face for highlighting the completion preview when the mouse is over it."
+  :version "30.1")
+
 (defvar-keymap completion-preview-active-mode-map
   :doc "Keymap for Completion Preview Active mode."
   "C-i" #'completion-preview-insert
@@ -107,11 +128,26 @@ completion-preview-active-mode-map
   ;; "M-p" #'completion-preview-prev-candidate
   )
 
+(defvar-keymap completion-preview--mouse-map
+  :doc "Keymap for mouse clicks on the completion preview."
+  "<down-mouse-1>" #'completion-preview-insert
+  "C-<down-mouse-1>" #'completion-at-point
+  "<down-mouse-2>" #'completion-at-point
+  (format "<%s>" mouse-wheel-up-event)             #'completion-preview-prev-candidate
+  (format "<%s>" mouse-wheel-up-alternate-event)   #'completion-preview-prev-candidate
+  (format "<%s>" mouse-wheel-down-event)           #'completion-preview-next-candidate
+  (format "<%s>" mouse-wheel-down-alternate-event) #'completion-preview-next-candidate)
+
 (defvar-local completion-preview--overlay nil)
 
 (defvar completion-preview--internal-commands
-  '(completion-preview-next-candidate completion-preview-prev-candidate)
-  "List of commands that manipulate the completion preview.")
+  '(completion-preview-next-candidate
+    completion-preview-prev-candidate
+    ;; Don't dismiss or update the preview when the user scrolls.
+    mwheel-scroll)
+  "List of commands that manipulate the completion preview.
+
+Completion Preview mode avoids updating the preview after these commands.")
 
 (defsubst completion-preview--internal-command-p ()
   "Return non-nil if `this-command' manipulates the completion preview."
@@ -194,7 +230,9 @@ completion-preview--try-table
           (list (propertize (substring (car sorted) (length prefix))
                             'face (if (cdr sorted)
                                       'completion-preview
-                                    'completion-preview-exact))
+                                    'completion-preview-exact)
+                            'mouse-face 'completion-preview-highlight
+                            'keymap completion-preview--mouse-map)
                 (+ beg base) end sorted
                 (substring string 0 base) exit-fn))))))
 
@@ -255,7 +293,9 @@ completion-preview--show
           ;; The previous preview is still applicable, update it.
           (overlay-put (completion-preview--make-overlay
                         cur (propertize (substring cand (- cur beg))
-                                        'face face))
+                                        'face face
+                                        'mouse-face 'completion-preview-highlight
+                                        'keymap completion-preview--mouse-map))
                        'completion-preview-end cur)
         ;; The previous preview is no longer applicable, hide it.
         (completion-preview-active-mode -1))))
@@ -318,10 +358,24 @@ completion-preview-next-candidate
       (let ((aft (propertize (substring str (- pos beg))
                              'face (if (< 1 len)
                                        'completion-preview
-                                     'completion-preview-exact))))
+                                     'completion-preview-exact)
+                             'mouse-face 'completion-preview-highlight
+                             'keymap completion-preview--mouse-map)))
         (add-text-properties 0 1 '(cursor 1) aft)
         (overlay-put completion-preview--overlay 'completion-preview-index new)
-        (overlay-put completion-preview--overlay 'after-string aft)))))
+        (overlay-put completion-preview--overlay 'after-string aft))
+      (when completion-preview-message-format
+        (message (format-spec completion-preview-message-format
+                              `((?i . ,(1+ new)) (?n . ,len))))))))
+
+(defun completion-preview--active-p (_symbol buffer)
+  "Check if the completion preview is currently shown in BUFFER."
+  (buffer-local-value 'completion-preview-active-mode buffer))
+
+(dolist (cmd '(completion-preview-insert
+               completion-preview-prev-candidate
+               completion-preview-next-candidate))
+  (put cmd 'completion-predicate #'completion-preview--active-p))
 
 ;;;###autoload
 (define-minor-mode completion-preview-mode
-- 
2.42.0

bug#67479: [PATCH] Facilitate using Completion Preview with the mouse

[Eli Zaretskii]

> Date: Mon, 27 Nov 2023 08:41:56 +0100
> From:  Eshel Yaron via "Bug reports for GNU Emacs,
>  the Swiss army knife of text editors" <bug-gnu-emacs@gnu.org>
> 
> This patch makes Completion Preview mode more convenient, and useful,
> when you're working with one hand on a mouse or similar device.

Thanks, installed on master, and closing the bug.