Subject: bug#67479: closed (Re: bug#67479: [PATCH] Facilitate using Completion Preview with the mouse)

From: [email-masked] (GNU bug Tracking System)
Date: Sat, 02 Dec 2023 12:56:02 +0000

Your bug report

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

which was filed against the emacs package, has been closed.

The explanation is attached below, along with your original report.
If you require more details, please reply to [email-masked].

-- 
67479: https://debbugs.gnu.org/cgi/bugreport.cgi?bug=67479
GNU Bug Tracking System
Contact [email-masked] with problems

Subject: Re: bug#67479: [PATCH] Facilitate using Completion Preview with the mouse
From: Eli Zaretskii <[email-masked]>
To: Eshel Yaron <[email-masked]>
Cc: [email-masked]
Date: Sat, 02 Dec 2023 14:55:08 +0200
List-Id: <debbugs-submit.debbugs.gnu.org>

> 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" <[email-masked]>
> 
> 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.

Subject: [PATCH] Facilitate using Completion Preview with the mouse
From: Eshel Yaron <[email-masked]>
To: [email-masked]
Date: Mon, 27 Nov 2023 08:41:56 +0100
List-Id: <debbugs-submit.debbugs.gnu.org>

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

>From 2a1f17d183d1b72faf6a37a272c18a5766189006 Mon Sep 17 00:00:00 2001
From: Eshel Yaron <[email-masked]>
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