From 594447807990a6591eab6cca10c58117c0141309 Mon Sep 17 00:00:00 2001 From: Iqbal Ansari Date: Sun, 9 Apr 2017 23:19:57 +0530 Subject: [PATCH 1/5] Do not hide which-key popups for mouse events occurring inside the popups --- which-key.el | 23 ++++++++++++++++++++++- 1 file changed, 22 insertions(+), 1 deletion(-) diff --git a/which-key.el b/which-key.el index 825e1cb..36c35af 100644 --- a/which-key.el +++ b/which-key.el @@ -941,9 +941,30 @@ total height." ;;; Show/hide which-key buffer +(defun which-key--mouse-event-inside-which-key-p (event) + "Determine if the mouse EVENT occurred inside which-key buffer." + ;; TODO: How to handle 'custom popup types + (cl-case which-key-popup-type + ;; Emacs hides the minibuffer by default, I have not found a way to disable + ;; that temporarily yet, as such the case below does not really help + (minibuffer (minibufferp (window-buffer (posn-window (event-start event))))) + (side-window (and (buffer-live-p which-key--buffer) + (equal (posn-window (event-start event)) + (get-buffer-window which-key--buffer)))) + (frame (and (frame-live-p which-key--frame) + (equal (window-frame (posn-window (event-start event))) + (get-buffer-window which-key--frame)))))) + (defun which-key--hide-popup () "This function is called to hide the which-key buffer." - (unless (member real-this-command which-key--paging-functions) + (unless (or (member real-this-command which-key--paging-functions) + ;; Do not hide the popup the if the last event was a mouse + ;; event and was inside which-key popup + (and (or (mouse-event-p last-command-event) + ;; 'mwheel-scroll events are not recognized as mouse + ;; events + (equal real-this-command 'mwheel-scroll)) + (which-key--mouse-event-inside-which-key-p last-command-event))) (setq which-key--current-page-n nil which-key--current-prefix nil which-key--using-top-level nil From 8748df298d69833f0d02eb22976a7afb6c92c85c Mon Sep 17 00:00:00 2001 From: Iqbal Ansari Date: Sun, 9 Apr 2017 23:25:42 +0530 Subject: [PATCH 2/5] Consider mouse events in timer to restart which-key popups --- which-key.el | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/which-key.el b/which-key.el index 36c35af..d9570c1 100644 --- a/which-key.el +++ b/which-key.el @@ -2289,7 +2289,10 @@ Finally, show the buffer." (setq which-key--paging-timer (run-with-idle-timer 0.2 t (lambda () - (when (or (not (member real-last-command which-key--paging-functions)) + (when (or (not (or (member real-last-command which-key--paging-functions) + (and (or (mouse-event-p last-command-event) + (equal real-last-command 'mwheel-scroll)) + (which-key--mouse-event-inside-which-key-p last-command-event)))) (and (< 0 (length (this-single-command-keys))) (not (equal which-key--current-prefix (this-single-command-keys))))) From 53420a185c372af2a2c8724d475684382e665dd0 Mon Sep 17 00:00:00 2001 From: Iqbal Ansari Date: Sun, 9 Apr 2017 23:35:15 +0530 Subject: [PATCH 3/5] Allowing navigating which key pages using mouse wheel --- which-key.el | 23 ++++++++++++++++++++++- 1 file changed, 22 insertions(+), 1 deletion(-) diff --git a/which-key.el b/which-key.el index d9570c1..17a015e 100644 --- a/which-key.el +++ b/which-key.el @@ -410,8 +410,10 @@ prefixes in `which-key-paging-prefixes'" (defvar which-key--paging-functions '(which-key-C-h-dispatch which-key-turn-page which-key-show-next-page-cycle + which-key-show-next-page-cycle-mouse which-key-show-next-page-no-cycle which-key-show-previous-page-cycle + which-key-show-previous-page-cycle-mouse which-key-show-previous-page-no-cycle which-key-undo-key which-key-undo)) @@ -1023,7 +1025,13 @@ is shown, or if there is no need to start the closing timer." ;; (minibuffer (which-key--show-buffer-minibuffer act-popup-dim)) (side-window (which-key--show-buffer-side-window act-popup-dim)) (frame (which-key--show-buffer-frame act-popup-dim)) - (custom (funcall which-key-custom-show-popup-function act-popup-dim))))) + (custom (funcall which-key-custom-show-popup-function act-popup-dim))) + + (when (and (bufferp which-key--buffer) + (buffer-live-p which-key--buffer)) + (with-current-buffer which-key--buffer + (setq-local mwheel-scroll-up-function 'which-key-show-next-page-cycle-mouse) + (setq-local mwheel-scroll-down-function 'which-key-show-previous-page-cycle-mouse))))) (defun which-key--fit-buffer-to-window-horizontally (&optional window &rest params) "Slightly modified version of `fit-buffer-to-window'. @@ -1964,6 +1972,19 @@ case do nothing." (which-key-turn-page 0) (which-key-turn-page -1)))) +(defun which-key-show-next-page-cycle-mouse (event) + "Show the next page of keys, cycling from end to beginning +after last page." + (interactive "e") + (which-key-show-next-page-cycle)) + +(defun which-key-show-previous-page-cycle-mouse (event) + + "Show the previous page of keys, cycling from end to beginning +after last page." + (interactive "e") + (which-key-show-previous-page-cycle)) + ;;;###autoload (defun which-key-show-next-page-cycle () "Show the next page of keys, cycling from end to beginning From 3965739b33046fc78b768552b7ea3b1f3949c1ac Mon Sep 17 00:00:00 2001 From: Iqbal Ansari Date: Fri, 14 Apr 2017 20:01:11 +0530 Subject: [PATCH 4/5] Do not hide popup for unhandled mouse events --- which-key.el | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) diff --git a/which-key.el b/which-key.el index 17a015e..074a664 100644 --- a/which-key.el +++ b/which-key.el @@ -966,7 +966,13 @@ total height." ;; 'mwheel-scroll events are not recognized as mouse ;; events (equal real-this-command 'mwheel-scroll)) - (which-key--mouse-event-inside-which-key-p last-command-event))) + (which-key--mouse-event-inside-which-key-p last-command-event)) + ;; The mouse event was not handled by Emacs + (and (not this-command) + (string-prefix-p "mouse-" + ;; Using prin1-to-string since it can handle + ;; all kinds of values returned by `event-basic-type' + (prin1-to-string (event-basic-type last-command-event))))) (setq which-key--current-page-n nil which-key--current-prefix nil which-key--using-top-level nil From d077c45d965ed400d2659a362828ff45dbc463c7 Mon Sep 17 00:00:00 2001 From: Iqbal Ansari Date: Sun, 28 Jan 2018 21:28:52 +0530 Subject: [PATCH 5/5] Set keybindings for scrolling using the mouse in the popups --- which-key.el | 25 ++++++++++++++++--------- 1 file changed, 16 insertions(+), 9 deletions(-) diff --git a/which-key.el b/which-key.el index 074a664..49be931 100644 --- a/which-key.el +++ b/which-key.el @@ -966,13 +966,8 @@ total height." ;; 'mwheel-scroll events are not recognized as mouse ;; events (equal real-this-command 'mwheel-scroll)) - (which-key--mouse-event-inside-which-key-p last-command-event)) - ;; The mouse event was not handled by Emacs - (and (not this-command) - (string-prefix-p "mouse-" - ;; Using prin1-to-string since it can handle - ;; all kinds of values returned by `event-basic-type' - (prin1-to-string (event-basic-type last-command-event))))) + (which-key--mouse-event-inside-which-key-p last-command-event))) + (setq which-key--current-page-n nil which-key--current-prefix nil which-key--using-top-level nil @@ -981,6 +976,7 @@ total height." which-key--current-show-keymap-name nil which-key--prior-show-keymap-args nil which-key--on-last-page nil) + (when (and which-key-idle-secondary-delay which-key--secondary-timer-active) (which-key--start-timer)) @@ -1032,12 +1028,12 @@ is shown, or if there is no need to start the closing timer." (side-window (which-key--show-buffer-side-window act-popup-dim)) (frame (which-key--show-buffer-frame act-popup-dim)) (custom (funcall which-key-custom-show-popup-function act-popup-dim))) - (when (and (bufferp which-key--buffer) (buffer-live-p which-key--buffer)) (with-current-buffer which-key--buffer (setq-local mwheel-scroll-up-function 'which-key-show-next-page-cycle-mouse) - (setq-local mwheel-scroll-down-function 'which-key-show-previous-page-cycle-mouse))))) + (setq-local mwheel-scroll-down-function 'which-key-show-previous-page-cycle-mouse))) + (which-key--setup-popup-mouse-scrolling-map))) (defun which-key--fit-buffer-to-window-horizontally (&optional window &rest params) "Slightly modified version of `fit-buffer-to-window'. @@ -1807,6 +1803,17 @@ including prefix arguments." (concat (which-key--propertize-key str) (propertize dash 'face 'which-key-key-face))))) +(defun which-key--setup-popup-mouse-scrolling-map () + "Generate map to be used to scroll the popup." + (when which-key--current-prefix + (let ((prefix (key-description which-key--current-prefix))) + (local-set-key (kbd (format "%s " prefix)) #'mwheel-scroll) + (local-set-key (kbd (format "%s " prefix)) #'mwheel-scroll) + + (with-current-buffer which-key--buffer + (local-set-key (kbd (format "%s " prefix)) #'mwheel-scroll) + (local-set-key (kbd (format "%s " prefix)) #'mwheel-scroll))))) + (defun which-key--get-popup-map () "Generate transient-map for use in the top level binding display." (unless which-key--current-prefix