* bug#67479: [PATCH] Facilitate using Completion Preview with the mouse
@ 2023-11-27 7:41 Eshel Yaron via Bug reports for GNU Emacs, the Swiss army knife of text editors
2023-12-02 12:55 ` Eli Zaretskii
0 siblings, 1 reply; 2+ messages in thread
From: Eshel Yaron via Bug reports for GNU Emacs, the Swiss army knife of text editors @ 2023-11-27 7:41 UTC (permalink / raw)
To: 67479
[-- 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
^ permalink raw reply related [flat|nested] 2+ messages in thread
* bug#67479: [PATCH] Facilitate using Completion Preview with the mouse
2023-11-27 7:41 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
@ 2023-12-02 12:55 ` Eli Zaretskii
0 siblings, 0 replies; 2+ messages in thread
From: Eli Zaretskii @ 2023-12-02 12:55 UTC (permalink / raw)
To: Eshel Yaron; +Cc: 67479-done
> 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.
^ permalink raw reply [flat|nested] 2+ messages in thread
end of thread, other threads:[~2023-12-02 12:55 UTC | newest]
Thread overview: 2+ messages (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2023-11-27 7:41 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
2023-12-02 12:55 ` Eli Zaretskii
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/emacs.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).