branch: master
commit fb09d75ea1fb655ddc4e043590ea1378454f8792
Merge: 81c4a3d ff79dff
Author: Justin Burkett <jus...@burkett.cc>
Commit: Justin Burkett <jus...@burkett.cc>
Merge commit 'ff79dfff66f880885c5893dd6fd05dc51173a476'
---
packages/which-key/which-key-tests.el | 23 +
packages/which-key/which-key.el | 810 +++++++++++++++++++++-------------
2 files changed, 520 insertions(+), 313 deletions(-)
diff --git a/packages/which-key/which-key-tests.el
b/packages/which-key/which-key-tests.el
index 5c17ab7..3e75d6f 100644
--- a/packages/which-key/which-key-tests.el
+++ b/packages/which-key/which-key-tests.el
@@ -122,5 +122,28 @@
(should (equal (which-key--extract-key "<left> a .. c") "a .. c"))
(should (equal (which-key--extract-key "M-a a .. c") "a .. c")))
+(ert-deftest which-key-test--get-keymap-bindings ()
+ (let ((map (make-sparse-keymap))
+ which-key-replacement-alist)
+ (define-key map [which-key-a] '(which-key "blah"))
+ (define-key map "b" 'ignore)
+ (define-key map "c" "c")
+ (define-key map "dd" "dd")
+ (define-key map "eee" "eee")
+ (should (equal
+ (sort (which-key--get-keymap-bindings map)
+ (lambda (a b) (string-lessp (car a) (car b))))
+ '(("b" . "ignore")
+ ("c" . "c")
+ ("d" . "Prefix Command")
+ ("e" . "Prefix Command"))))
+ (should (equal
+ (sort (which-key--get-keymap-bindings map t)
+ (lambda (a b) (string-lessp (car a) (car b))))
+ '(("b" . "ignore")
+ ("c" . "c")
+ ("d d" . "dd")
+ ("e e e" . "eee"))))))
+
(provide 'which-key-tests)
;;; which-key-tests.el ends here
diff --git a/packages/which-key/which-key.el b/packages/which-key/which-key.el
index f973c19..09effbc 100644
--- a/packages/which-key/which-key.el
+++ b/packages/which-key/which-key.el
@@ -5,7 +5,7 @@
;; Author: Justin Burkett <jus...@burkett.cc>
;; Maintainer: Justin Burkett <jus...@burkett.cc>
;; URL: https://github.com/justbur/emacs-which-key
-;; Version: 3.1.0
+;; Version: 3.3.0
;; Keywords:
;; Package-Requires: ((emacs "24.4"))
@@ -69,7 +69,7 @@ to shorten the delay for subsequent popups in the same key
sequence. The default is for this value to be nil, which disables
this behavior."
:group 'which-key
- :type 'float)
+ :type '(choice float (const :tag "Disabled" nil)))
(defcustom which-key-echo-keystrokes (if (and echo-keystrokes
(> (+ echo-keystrokes 0.01)
@@ -88,7 +88,7 @@ which-key popup."
"Truncate the description of keys to this length.
Also adds \"..\". If nil, disable any truncation."
:group 'which-key
- :type 'integer)
+ :type '(choice integer (const :tag "Disable truncation" nil)))
(defcustom which-key-add-column-padding 0
"Additional padding (number of spaces) to add to the left of
@@ -115,7 +115,7 @@ of the which-key popup."
(defcustom which-key-dont-use-unicode nil
"If non-nil, don't use any unicode characters in default setup."
:group 'which-key
- :type 'integer)
+ :type 'boolean)
(defcustom which-key-separator
(if which-key-dont-use-unicode " : " " → ")
@@ -189,10 +189,10 @@ Finally, you can multiple replacements to occur for a
given key
binding by setting `which-key-allow-multiple-replacements' to a
non-nil value."
:group 'which-key
- :type '(alist :key-type (cons (choice regexp nil)
- (choice regexp nil))
- :value-type (cons (choice string nil)
- (choice string nil))))
+ :type '(alist :key-type (cons (choice regexp (const nil))
+ (choice regexp (const nil)))
+ :value-type (cons (choice string (const nil))
+ (choice string (const nil)))))
(when (bound-and-true-p which-key-key-replacement-alist)
(mapc
@@ -215,6 +215,19 @@ only the first match is used to perform replacements from
:group 'which-key
:type 'boolean)
+(defcustom which-key-show-docstrings nil
+ "If non-nil, show each command's docstring next to the command
+in the which-key buffer. This will only display the docstring up
+to the first line break. If you set this variable to the symbol
+docstring-only, then the command's name with be omitted. You
+probably also want to adjust `which-key-max-description-length'
+at the same time if you use this feature."
+ :group 'which-key
+ :type '(radio
+ (const :tag "Do not show docstrings" nil)
+ (const :tag "Add docstring to command names" t)
+ (const :tag "Replace command name with docstring" docstring-only)))
+
(defcustom which-key-highlighted-command-list '()
"A list of strings and/or cons cells used to highlight certain
commands. If the element is a string, assume it is a regexp
@@ -269,7 +282,7 @@ and nil. Nil turns the feature off."
"The maximum number of columns to display in the which-key
buffer. nil means don't impose a maximum."
:group 'which-key
- :type 'integer)
+ :type '(choice integer (const :tag "Unbounded" nil)))
(defcustom which-key-side-window-location 'bottom
"Location of which-key popup when `which-key-popup-type' is side-window.
@@ -405,6 +418,8 @@ prefixes in `which-key-paging-prefixes'"
(let ((map (make-sparse-keymap)))
(dolist (bind '(("\C-a" . which-key-abort)
("a" . which-key-abort)
+ ("\C-d" . which-key-toggle-docstrings)
+ ("d" . which-key-toggle-docstrings)
("\C-h" . which-key-show-standard-help)
("h" . which-key-show-standard-help)
("\C-n" . which-key-show-next-page-cycle)
@@ -412,7 +427,16 @@ prefixes in `which-key-paging-prefixes'"
("\C-p" . which-key-show-previous-page-cycle)
("p" . which-key-show-previous-page-cycle)
("\C-u" . which-key-undo-key)
- ("u" . which-key-undo-key)))
+ ("u" . which-key-undo-key)
+ ("1" . which-key-digit-argument)
+ ("2" . which-key-digit-argument)
+ ("3" . which-key-digit-argument)
+ ("4" . which-key-digit-argument)
+ ("5" . which-key-digit-argument)
+ ("6" . which-key-digit-argument)
+ ("7" . which-key-digit-argument)
+ ("8" . which-key-digit-argument)
+ ("9" . which-key-digit-argument)))
(define-key map (car bind) (cdr bind)))
map)
"Keymap for C-h commands.")
@@ -548,6 +572,11 @@ and it matches a string in
`which-key-highlighted-command-list'."
"Face for special keys (SPC, TAB, RET)"
:group 'which-key-faces)
+(defface which-key-docstring-face
+ '((t . (:inherit which-key-note-face)))
+ "Face for docstrings"
+ :group 'which-key-faces)
+
;;;; Custom popup
(defcustom which-key-custom-popup-max-dimensions-function nil
@@ -556,13 +585,13 @@ Will be passed the width of the active window and is
expected to
return the maximum height in lines and width in characters of the
which-key popup in the form a cons cell (height . width)."
:group 'which-key
- :type 'function)
+ :type '(choice function (const nil)))
(defcustom which-key-custom-hide-popup-function nil
"Variable to hold a custom hide-popup function.
It takes no arguments and the return value is ignored."
:group 'which-key
- :type 'function)
+ :type '(choice function (const nil)))
(defcustom which-key-custom-show-popup-function nil
"Variable to hold a custom show-popup function.
@@ -570,7 +599,7 @@ Will be passed the required dimensions in the form (height .
width) in lines and characters respectively. The return value is
ignored."
:group 'which-key
- :type 'function)
+ :type '(choice function (const nil)))
(defcustom which-key-lighter " WK"
"Minor mode lighter to use in the mode-line."
@@ -605,32 +634,73 @@ Used when `which-key-popup-type' is frame.")
"Internal: Backup the initial value of `echo-keystrokes'.")
(defvar which-key--prefix-help-cmd-backup nil
"Internal: Backup the value of `prefix-help-command'.")
-(defvar which-key--pages-plist nil
- "Internal: Holds page objects")
-(defvar which-key--current-prefix nil
- "Internal: Holds current prefix")
-(defvar which-key--current-page-n nil
- "Internal: Current pages of showing buffer. Nil means no buffer
-showing.")
-(defvar which-key--on-last-page nil
- "Internal: Non-nil if showing last page.")
(defvar which-key--last-try-2-loc nil
"Internal: Last location of side-window when two locations
used.")
+(defvar which-key--automatic-display nil
+ "Internal: Non-nil if popup was triggered with automatic
+update.")
(defvar which-key--multiple-locations nil)
-(defvar which-key--using-top-level nil)
-(defvar which-key--using-show-keymap nil)
-(defvar which-key--using-show-operator-keymap nil)
(defvar which-key--inhibit-next-operator-popup nil)
-(defvar which-key--current-show-keymap-name nil)
(defvar which-key--prior-show-keymap-args nil)
(defvar which-key--previous-frame-size nil)
(defvar which-key--prefix-title-alist nil)
(defvar which-key--debug nil)
+(defvar which-key--evil-keys-regexp (eval-when-compile
+ (regexp-opt '("-state"))))
+(defvar which-key--ignore-non-evil-keys-regexp
+ (eval-when-compile
+ (regexp-opt '("mouse-" "wheel-" "remap" "drag-" "scroll-bar"
+ "select-window" "switch-frame" "which-key-"))))
+(defvar which-key--ignore-keys-regexp
+ (eval-when-compile
+ (regexp-opt '("mouse-" "wheel-" "remap" "drag-" "scroll-bar"
+ "select-window" "switch-frame" "-state"
+ "which-key-"))))
(make-obsolete-variable 'which-key-prefix-name-alist nil "2016-10-05")
(make-obsolete-variable 'which-key-prefix-title-alist nil "2016-10-05")
+(defvar which-key--pages-obj nil)
+(cl-defstruct which-key--pages
+ pages
+ height
+ widths
+ keys/page
+ page-nums
+ num-pages
+ total-keys
+ prefix
+ prefix-title)
+
+(defun which-key--rotate (list n)
+ (let* ((len (length list))
+ (n (if (< n 0) (+ len n) n))
+ (n (mod n len)))
+ (append (last list (- len n)) (butlast list (- len n)))))
+
+(defun which-key--pages-set-current-page (pages-obj n)
+ (setf (which-key--pages-pages pages-obj)
+ (which-key--rotate (which-key--pages-pages pages-obj) n))
+ (setf (which-key--pages-widths pages-obj)
+ (which-key--rotate (which-key--pages-widths pages-obj) n))
+ (setf (which-key--pages-keys/page pages-obj)
+ (which-key--rotate (which-key--pages-keys/page pages-obj) n))
+ (setf (which-key--pages-page-nums pages-obj)
+ (which-key--rotate (which-key--pages-page-nums pages-obj) n))
+ pages-obj)
+
+(defsubst which-key--on-first-page ()
+ (= (which-key--pages-page-nums which-key--pages-obj) 1))
+
+(defsubst which-key--on-last-page ()
+ (= (which-key--pages-page-nums which-key--pages-obj)
+ (which-key--pages-num-pages which-key--pages-obj)))
+
+(defsubst which-key--current-prefix ()
+ (when which-key--pages-obj
+ (which-key--pages-prefix which-key--pages-obj)))
+
;;; Third-party library support
;;;; Evil
@@ -712,7 +782,7 @@ problems at github. If DISABLE is non-nil disable support."
(add-hook 'pre-command-hook #'which-key--hide-popup)
(add-hook 'focus-out-hook #'which-key--stop-timer)
(add-hook 'focus-in-hook #'which-key--start-timer)
- (add-hook 'window-configuration-change-hook
+ (add-hook 'window-size-change-functions
'which-key--hide-popup-on-frame-size-change)
(which-key--start-timer))
(setq echo-keystrokes which-key--echo-keystrokes-backup)
@@ -723,7 +793,7 @@ problems at github. If DISABLE is non-nil disable support."
(remove-hook 'pre-command-hook #'which-key--hide-popup)
(remove-hook 'focus-out-hook #'which-key--stop-timer)
(remove-hook 'focus-in-hook #'which-key--start-timer)
- (remove-hook 'window-configuration-change-hook
+ (remove-hook 'window-size-change-functions
'which-key--hide-popup-on-frame-size-change)
(which-key--stop-timer)))
@@ -999,14 +1069,10 @@ total height."
(defun which-key--hide-popup ()
"This function is called to hide the which-key buffer."
(unless (member real-this-command which-key--paging-functions)
- (setq which-key--current-page-n nil
- which-key--current-prefix nil
- which-key--using-top-level nil
- which-key--using-show-keymap nil
- which-key--using-show-operator-keymap nil
- which-key--current-show-keymap-name nil
- which-key--prior-show-keymap-args nil
- which-key--on-last-page nil)
+ (setq which-key--last-try-2-loc nil)
+ (setq which-key--pages-obj nil)
+ (setq which-key--automatic-display nil)
+ (setq which-key--prior-show-keymap-args nil)
(when (and which-key-idle-secondary-delay
which-key--secondary-timer-active)
(which-key--start-timer))
@@ -1026,7 +1092,7 @@ total height."
(frame (which-key--hide-buffer-frame))
(custom (funcall which-key-custom-hide-popup-function))))
-(defun which-key--hide-popup-on-frame-size-change ()
+(defun which-key--hide-popup-on-frame-size-change (&optional _)
"Hide which-key popup if the frame is resized (to trigger a new
popup)."
(when (which-key--frame-size-changed-p)
@@ -1358,9 +1424,9 @@ local bindings coming first. Within these categories
order using
(throw 'res res)))))))
(nreverse res)))
-(defun which-key--get-pseudo-binding (key-binding)
+(defun which-key--get-pseudo-binding (key-binding &optional prefix)
(let* ((pseudo-binding
- (key-binding (which-key--pseudo-key (kbd (car key-binding)) t)))
+ (key-binding (which-key--pseudo-key (kbd (car key-binding)) prefix)))
(pseudo-binding (when pseudo-binding (cadr pseudo-binding)))
(pseudo-desc (when pseudo-binding (car pseudo-binding)))
(pseudo-def (when pseudo-binding (cdr pseudo-binding)))
@@ -1373,11 +1439,11 @@ local bindings coming first. Within these categories
order using
(eq pseudo-def real-def))
(cons (car key-binding) pseudo-desc))))
-(defun which-key--maybe-replace (key-binding)
+(defun which-key--maybe-replace (key-binding &optional prefix)
"Use `which-key--replacement-alist' to maybe replace KEY-BINDING.
KEY-BINDING is a cons cell of the form \(KEY . BINDING\) each of
which are strings. KEY is of the form produced by `key-binding'."
- (let* ((pseudo-binding (which-key--get-pseudo-binding key-binding)))
+ (let* ((pseudo-binding (which-key--get-pseudo-binding key-binding prefix)))
(if pseudo-binding
pseudo-binding
(let* ((mode-res (which-key--get-replacements key-binding t))
@@ -1403,7 +1469,7 @@ which are strings. KEY is of the form produced by
`key-binding'."
(t (cdr key-binding))))))))))))
(defsubst which-key--current-key-list (&optional key-str)
- (append (listify-key-sequence which-key--current-prefix)
+ (append (listify-key-sequence (which-key--current-prefix))
(when key-str
(listify-key-sequence (kbd key-str)))))
@@ -1416,24 +1482,29 @@ which are strings. KEY is of the form produced by
`key-binding'."
(intern (cdr keydesc))))
(defun which-key--map-binding-p (map keydesc)
+ "Does MAP contain KEYDESC = (key . binding)?"
(or
(when (bound-and-true-p evil-state)
- (eq (which-key--safe-lookup-key
- map
- (kbd (which-key--current-key-string
- (format "<%s-state> %s" evil-state (car keydesc)))))
- (intern (cdr keydesc))))
- (eq (which-key--safe-lookup-key
- map (kbd (which-key--current-key-string (car keydesc))))
- (intern (cdr keydesc)))))
-
-(defun which-key--pseudo-key (key &optional use-current-prefix)
+ (let ((lookup
+ (which-key--safe-lookup-key
+ map
+ (kbd (which-key--current-key-string
+ (format "<%s-state> %s" evil-state (car keydesc)))))))
+ (or (eq lookup (intern (cdr keydesc)))
+ (and (keymapp lookup) (string= (cdr keydesc) "Prefix Command")))))
+ (let ((lookup
+ (which-key--safe-lookup-key
+ map (kbd (which-key--current-key-string (car keydesc))))))
+ (or (eq lookup (intern (cdr keydesc)))
+ (and (keymapp lookup) (string= (cdr keydesc) "Prefix Command"))))))
+
+(defun which-key--pseudo-key (key &optional prefix)
"Replace the last key in the sequence KEY by a special symbol
in order for which-key to allow looking up a description for the key."
(let* ((seq (listify-key-sequence key))
(final (intern (format "which-key-%s" (key-description (last seq))))))
- (if use-current-prefix
- (vconcat (which-key--current-key-list) (list final))
+ (if prefix
+ (vconcat prefix (list final))
(vconcat (butlast seq) (list final)))))
(defun which-key--maybe-get-prefix-title (keys)
@@ -1460,17 +1531,19 @@ no title exists."
(if alternate alternate
(concat "Following " keys)))
(t ""))))
- (which-key--using-top-level which-key--using-top-level)
- (which-key--current-show-keymap-name
- which-key--current-show-keymap-name)
- (t "")))
+ (t "")))
+
+(defun which-key--propertize (string &rest properties)
+ "Version of `propertize' that checks type of STRING."
+ (when (stringp string)
+ (apply #'propertize string properties)))
(defun which-key--propertize-key (key)
"Add a face to KEY.
If KEY contains any \"special keys\" defined in
`which-key-special-keys' then truncate and add the corresponding
`which-key-special-key-face'."
- (let ((key-w-face (propertize key 'face 'which-key-key-face))
+ (let ((key-w-face (which-key--propertize key 'face 'which-key-key-face))
(regexp (concat "\\("
(mapconcat 'identity which-key-special-keys
"\\|") "\\)"))
@@ -1480,7 +1553,7 @@ If KEY contains any \"special keys\" defined in
(string-match regexp key))
(let ((beg (match-beginning 0)) (end (match-end 0)))
(concat (substring key-w-face 0 beg)
- (propertize (substring key-w-face beg (1+ beg))
+ (which-key--propertize (substring key-w-face beg (1+ beg))
'face 'which-key-special-key-face)
(substring key-w-face end
(which-key--string-width key-w-face))))
@@ -1488,10 +1561,12 @@ If KEY contains any \"special keys\" defined in
(defsubst which-key--truncate-description (desc)
"Truncate DESC description to `which-key-max-description-length'."
- (if (and which-key-max-description-length
- (> (length desc) which-key-max-description-length))
- (concat (substring desc 0 which-key-max-description-length) "..")
- desc))
+ (let* ((last-face (get-text-property (1- (length desc)) 'face desc))
+ (dots (which-key--propertize ".." 'face last-face)))
+ (if (and which-key-max-description-length
+ (> (length desc) which-key-max-description-length))
+ (concat (substring desc 0 which-key-max-description-length) dots)
+ desc)))
(defun which-key--highlight-face (description)
"Return the highlight face for DESCRIPTION if it has one."
@@ -1519,34 +1594,35 @@ removing a \"group:\" prefix.
ORIGINAL-DESCRIPTION is the description given by
`describe-buffer-bindings'."
- (let* ((desc description)
- (desc (if (string-match-p "^group:" desc)
- (substring desc 6) desc))
- (desc (if group (concat which-key-prefix-prefix desc) desc))
- (desc (which-key--truncate-description desc)))
- (make-text-button desc nil
- 'face (cond (hl-face hl-face)
- (group 'which-key-group-description-face)
- (local 'which-key-local-map-description-face)
- (t 'which-key-command-description-face))
- 'help-echo (cond
- ((and original-description
- (fboundp (intern original-description))
- (documentation (intern original-description))
- ;; tooltip-mode doesn't exist in emacs-nox
- (boundp 'tooltip-mode) tooltip-mode)
- (documentation (intern original-description)))
- ((and original-description
- (fboundp (intern original-description))
- (documentation (intern original-description))
- (let* ((doc (documentation
- (intern original-description)))
- (str (replace-regexp-in-string "\n" " " doc))
- (max (floor (* (frame-width) 0.8))))
- (if (> (length str) max)
- (concat (substring str 0 max) "...")
- str))))))
- desc))
+ (when description
+ (let* ((desc description)
+ (desc (if (string-match-p "^group:" desc)
+ (substring desc 6) desc))
+ (desc (if group (concat which-key-prefix-prefix desc) desc)))
+ (make-text-button
+ desc nil
+ 'face (cond (hl-face hl-face)
+ (group 'which-key-group-description-face)
+ (local 'which-key-local-map-description-face)
+ (t 'which-key-command-description-face))
+ 'help-echo (cond
+ ((and original-description
+ (fboundp (intern original-description))
+ (documentation (intern original-description))
+ ;; tooltip-mode doesn't exist in emacs-nox
+ (boundp 'tooltip-mode) tooltip-mode)
+ (documentation (intern original-description)))
+ ((and original-description
+ (fboundp (intern original-description))
+ (documentation (intern original-description))
+ (let* ((doc (documentation
+ (intern original-description)))
+ (str (replace-regexp-in-string "\n" " " doc))
+ (max (floor (* (frame-width) 0.8))))
+ (if (> (length str) max)
+ (concat (substring str 0 max) "...")
+ str))))))
+ desc)))
(defun which-key--extract-key (key-str)
"Pull the last key (or key range) out of KEY-STR."
@@ -1556,12 +1632,32 @@ ORIGINAL-DESCRIPTION is the description given by
(match-string 1 key-str)
(car (last (split-string key-str " ")))))))
-(defun which-key--format-and-replace (unformatted)
+(defun which-key--maybe-add-docstring (current original)
+ "Maybe concat a docstring to CURRENT and return result.
+Specifically, do this if ORIGINAL is a command with a docstring
+and `which-key-show-docstrings' is non-nil. If
+`which-key-show-docstrings' is the symbol docstring-only, just
+return the docstring."
+ (let* ((orig-sym (intern original))
+ (doc (when (commandp orig-sym)
+ (documentation orig-sym)))
+ (docstring (when doc
+ (which-key--propertize (car (split-string doc "\n"))
+ 'face
'which-key-docstring-face))))
+ (cond ((not (and which-key-show-docstrings docstring))
+ current)
+ ((eq which-key-show-docstrings 'docstring-only)
+ docstring)
+ (t
+ (format "%s %s" current docstring)))))
+
+(defun which-key--format-and-replace (unformatted &optional prefix
preserve-full-key)
"Take a list of (key . desc) cons cells in UNFORMATTED, add
faces and perform replacements according to the three replacement
alists. Returns a list (key separator description)."
(let ((sep-w-face
- (propertize which-key-separator 'face 'which-key-separator-face))
+ (which-key--propertize which-key-separator
+ 'face 'which-key-separator-face))
(local-map (current-local-map))
new-list)
(dolist (key-binding unformatted)
@@ -1569,35 +1665,76 @@ alists. Returns a list (key separator description)."
(orig-desc (cdr key-binding))
(group (which-key--group-p orig-desc))
;; At top-level prefix is nil
- (keys (if which-key--current-prefix
- (concat (which-key--current-key-string) " " key)
+ (keys (if prefix
+ (concat (key-description prefix) " " key)
key))
(local (eq (which-key--safe-lookup-key local-map (kbd keys))
(intern orig-desc)))
(hl-face (which-key--highlight-face orig-desc))
- (key-binding (which-key--maybe-replace (cons keys orig-desc))))
+ (key-binding (which-key--maybe-replace (cons keys orig-desc)
prefix))
+ (final-desc (which-key--propertize-description
+ (cdr key-binding) group local hl-face orig-desc)))
+ (when final-desc
+ (setq final-desc
+ (which-key--truncate-description
+ (which-key--maybe-add-docstring final-desc orig-desc))))
(when (consp key-binding)
(push
(list (which-key--propertize-key
- (which-key--extract-key (car key-binding)))
+ (if preserve-full-key
+ (car key-binding)
+ (which-key--extract-key (car key-binding))))
sep-w-face
- (which-key--propertize-description
- (cdr key-binding) group local hl-face orig-desc))
+ final-desc)
new-list))))
(nreverse new-list)))
-(defun which-key--get-keymap-bindings (keymap)
- "Retrieve top-level bindings from KEYMAP."
+(defun which-key--get-keymap-bindings (keymap &optional all prefix)
+ "Retrieve top-level bindings from KEYMAP.
+If ALL is non-nil, get all bindings, not just the top-level
+ones. PREFIX is for internal use and should not be used."
(let (bindings)
(map-keymap
(lambda (ev def)
- (cl-pushnew
- (cons (key-description (list ev))
- (cond ((keymapp def) "Prefix Command")
- ((symbolp def) (copy-sequence (symbol-name def)))
- ((eq 'lambda (car-safe def)) "lambda")
- (t (format "%s" def))))
- bindings :test (lambda (a b) (string= (car a) (car b)))))
+ (let* ((key (append prefix (list ev)))
+ (key-desc (key-description key)))
+ (cond ((or (string-match-p
+ which-key--ignore-non-evil-keys-regexp key-desc)
+ (eq ev 'menu-bar)))
+ ;; extract evil keys corresponding to current state
+ ((and (keymapp def)
+ (boundp 'evil-state)
+ (bound-and-true-p evil-local-mode)
+ (string-match-p (format "<%s-state>$" evil-state)
key-desc))
+ (setq bindings
+ ;; this function keeps the latter of the two duplicates
+ ;; which will be the evil binding
+ (cl-remove-duplicates
+ (append bindings
+ (which-key--get-keymap-bindings def all prefix))
+ :test (lambda (a b) (string= (car a) (car b))))))
+ ((and (keymapp def)
+ (string-match-p which-key--evil-keys-regexp key-desc)))
+ ((and (keymapp def)
+ (or all
+ ;; event 27 is escape, so this will pick up meta
+ ;; bindings and hopefully not too much more
+ (and (numberp ev) (= ev 27))))
+ (setq bindings
+ (append bindings
+ (which-key--get-keymap-bindings def t key))))
+ (t
+ (when def
+ (cl-pushnew
+ (cons key-desc
+ (cond
+ ((keymapp def) "Prefix Command")
+ ((symbolp def) (copy-sequence (symbol-name def)))
+ ((eq 'lambda (car-safe def)) "lambda")
+ ((eq 'menu-item (car-safe def)) "menu-item")
+ ((stringp def) def)
+ (t "unknown")))
+ bindings :test (lambda (a b) (string= (car a) (car
b)))))))))
keymap)
bindings))
@@ -1611,17 +1748,12 @@ Requires `which-key-compute-remaps' to be non-nil"
(copy-sequence (symbol-name remap))
binding)))
-(defun which-key--get-current-bindings ()
+(defun which-key--get-current-bindings (&optional prefix)
"Generate a list of current active bindings."
- (let ((key-str-qt (regexp-quote (key-description which-key--current-prefix)))
+ (let ((key-str-qt (regexp-quote (key-description prefix)))
(buffer (current-buffer))
(ignore-bindings '("self-insert-command" "ignore"
"ignore-event" "company-ignore"))
- (ignore-keys-regexp
- (eval-when-compile
- (regexp-opt '("mouse-" "wheel-" "remap" "drag-" "scroll-bar"
- "select-window" "switch-frame" "-state"
- "which-key-"))))
(ignore-sections-regexp
(eval-when-compile
(regexp-opt '("Key translations" "Function key map translations"
@@ -1629,7 +1761,7 @@ Requires `which-key-compute-remaps' to be non-nil"
(with-temp-buffer
(setq-local indent-tabs-mode t)
(setq-local tab-width 8)
- (describe-buffer-bindings buffer which-key--current-prefix)
+ (describe-buffer-bindings buffer prefix)
(goto-char (point-min))
(let ((header-p (not (= (char-after) ?\f)))
bindings header)
@@ -1644,8 +1776,7 @@ Requires `which-key-compute-remaps' to be non-nil"
((= (char-after) ?\f)
(setq header-p t))
((looking-at "^[ \t]*$"))
- ((or (not (string-match-p ignore-sections-regexp header))
- which-key--current-prefix)
+ ((or (not (string-match-p ignore-sections-regexp header)) prefix)
(let ((binding-start (save-excursion
(and (re-search-forward "\t+" nil t)
(match-end 0))))
@@ -1659,15 +1790,15 @@ Requires `which-key-compute-remaps' to be non-nil"
(save-match-data
(cond
((member binding ignore-bindings))
- ((string-match-p ignore-keys-regexp key))
- ((and which-key--current-prefix
+ ((string-match-p which-key--ignore-keys-regexp key))
+ ((and prefix
(string-match (format "^%s[ \t]\\([^ \t]+\\)[ \t]+$"
key-str-qt) key))
(unless (assoc-string (match-string 1 key) bindings)
(push (cons (match-string 1 key)
(which-key--compute-binding binding))
bindings)))
- ((and which-key--current-prefix
+ ((and prefix
(string-match
(format
"^%s[ \t]\\([^ \t]+\\) \\.\\. %s[ \t]\\([^ \t]+\\)[
\t]+$"
@@ -1688,16 +1819,25 @@ Requires `which-key-compute-remaps' to be non-nil"
(forward-line))
(nreverse bindings)))))
-(defun which-key--get-formatted-key-bindings (&optional bindings filter)
- "Uses `describe-buffer-bindings' to collect the key bindings in
-BUFFER that follow the key sequence KEY-SEQ."
- (let* ((unformatted (if bindings bindings
(which-key--get-current-bindings))))
+(defun which-key--get-bindings (&optional prefix keymap filter recursive)
+ "Collect key bindings.
+If KEYMAP is nil, collect from current buffer using the current
+key sequence as a prefix. Otherwise, collect from KEYMAP. FILTER
+is a function to use to filter the bindings. If RECURSIVE is
+non-nil, then bindings are collected recursively for all prefixes."
+ (let* ((unformatted
+ (cond ((keymapp keymap)
+ (which-key--get-keymap-bindings keymap recursive))
+ (keymap
+ (error "%s is not a keymap" keymap))
+ (t
+ (which-key--get-current-bindings prefix)))))
(when filter
(setq unformatted (cl-remove-if-not filter unformatted)))
(when which-key-sort-order
(setq unformatted
(sort unformatted which-key-sort-order)))
- (which-key--format-and-replace unformatted)))
+ (which-key--format-and-replace unformatted prefix recursive)))
;;; Functions for laying out which-key buffer pages
@@ -1751,16 +1891,15 @@ that width."
(defun which-key--list-to-pages (keys avl-lines avl-width)
"Convert list of KEYS to columns based on dimensions AVL-LINES and AVL-WIDTH.
-Returns a plist that holds the page strings, as well as
-metadata."
+Returns a `which-key--pages' object that holds the page strings,
+as well as metadata."
(let ((cols-w-widths (mapcar #'which-key--pad-column
(which-key--partition-list avl-lines keys)))
(page-width 0) (n-pages 0) (n-keys 0) (n-columns 0)
page-cols pages page-widths keys/page col)
(if (> (apply #'max (mapcar #'car cols-w-widths)) avl-width)
;; give up if no columns fit
- (list :pages nil :page-height 0 :page-widths '(0)
- :keys/page '(0) :n-pages 0 :tot-keys 0)
+ nil
(while cols-w-widths
;; start new page
(cl-incf n-pages)
@@ -1782,10 +1921,14 @@ metadata."
(push (which-key--join-columns page-cols) pages)
(push n-keys keys/page)
(push page-width page-widths))
- (list :pages (nreverse pages) :page-height avl-lines
- :page-widths (nreverse page-widths)
- :keys/page (reverse keys/page) :n-pages n-pages
- :tot-keys (apply #'+ keys/page)))))
+ (make-which-key--pages
+ :pages (nreverse pages)
+ :height avl-lines
+ :widths (nreverse page-widths)
+ :keys/page (reverse keys/page)
+ :page-nums (number-sequence 1 n-pages)
+ :num-pages n-pages
+ :total-keys (apply #'+ keys/page)))))
(defun which-key--create-pages-1
(keys available-lines available-width &optional min-lines vertical)
@@ -1798,8 +1941,9 @@ should be minimized."
keys available-lines available-width))
(min-lines (or min-lines 0))
found prev-result)
- (if (or vertical
- (> (plist-get result :n-pages) 1)
+ (if (or (null result)
+ vertical
+ (> (which-key--pages-num-pages result) 1)
(= 1 available-lines))
result
;; simple search for a fitting page
@@ -1809,10 +1953,10 @@ should be minimized."
prev-result result
result (which-key--list-to-pages
keys available-lines available-width)
- found (> (plist-get result :n-pages) 1)))
+ found (> (which-key--pages-num-pages result) 1)))
(if found prev-result result))))
-(defun which-key--create-pages (keys)
+(defun which-key--create-pages (keys &optional prefix-keys prefix-title)
"Create page strings using `which-key--list-to-pages'.
Will try to find the best number of rows and columns using the
given dimensions and the length and wdiths of KEYS. SEL-WIN-WIDTH
@@ -1820,8 +1964,8 @@ is the width of the live window."
(let* ((max-dims (which-key--popup-max-dimensions))
(max-lines (car max-dims))
(max-width (cdr max-dims))
- (prefix-keys-desc (key-description which-key--current-prefix))
- (full-prefix (which-key--full-prefix prefix-keys-desc))
+ (prefix-desc (key-description prefix-keys))
+ (full-prefix (which-key--full-prefix prefix-desc))
(prefix (when (eq which-key-show-prefix 'left)
(+ 2 (which-key--string-width full-prefix))))
(prefix-top-bottom (member which-key-show-prefix '(bottom top)))
@@ -1829,14 +1973,25 @@ is the width of the live window."
(min-lines (min avl-lines which-key-min-display-lines))
(avl-width (if prefix (- max-width prefix) max-width))
(vertical (and (eq which-key-popup-type 'side-window)
- (member which-key-side-window-location '(left
right)))))
- (which-key--create-pages-1 keys avl-lines avl-width min-lines vertical)))
-
-(defun which-key--lighter-status (page-n)
+ (member which-key-side-window-location '(left right))))
+ result)
+ (setq result
+ (which-key--create-pages-1
+ keys avl-lines avl-width min-lines vertical))
+ (when (and result
+ (> (which-key--pages-num-pages result) 0))
+ (setf (which-key--pages-prefix result) prefix-keys)
+ (setf (which-key--pages-prefix-title result)
+ (or prefix-title
+ (which-key--maybe-get-prefix-title
+ (key-description prefix-keys))))
+ result)))
+
+(defun which-key--lighter-status ()
"Possibly show number of keys and total in the mode line."
(when which-key-show-remaining-keys
- (let ((n-shown (nth page-n (plist-get which-key--pages-plist :keys/page)))
- (n-tot (plist-get which-key--pages-plist :tot-keys)))
+ (let ((n-shown (car (which-key--pages-keys/page which-key--pages-obj)))
+ (n-tot (which-key--pages-total-keys which-key--pages-obj)))
(setcar (cdr (assq 'which-key-mode minor-mode-alist))
(format " WK: %s/%s keys" n-shown n-tot)))))
@@ -1857,12 +2012,9 @@ is the width of the live window."
(paging-key-bound (eq 'which-key-C-h-dispatch
(key-binding (kbd paging-key))))
(key (if paging-key-bound which-key-paging-key "C-h")))
- (when (and which-key-use-C-h-commands
- (or which-key--using-show-operator-keymap
- (not (and which-key-allow-evil-operators
- (bound-and-true-p evil-this-operator)))))
- (propertize (format "[%s paging/help]" key)
- 'face 'which-key-note-face))))
+ (when which-key-use-C-h-commands
+ (which-key--propertize (format "[%s paging/help]" key)
+ 'face 'which-key-note-face))))
(eval-and-compile
(if (fboundp 'universal-argument--description)
@@ -1892,16 +2044,16 @@ including prefix arguments."
(which-key--universal-argument--description)
(when prefix-arg " ")
prefix-keys))
- (dash (if (and which-key--current-prefix
+ (dash (if (and (not (string= prefix-keys ""))
(null left)) "-" "")))
(if (or (eq which-key-show-prefix 'echo) dont-prop-keys)
(concat str dash)
(concat (which-key--propertize-key str)
- (propertize dash 'face 'which-key-key-face)))))
+ (which-key--propertize dash 'face 'which-key-key-face)))))
(defun which-key--get-popup-map ()
"Generate transient-map for use in the top level binding display."
- (unless which-key--current-prefix
+ (unless which-key--automatic-display
(let ((map (make-sparse-keymap)))
(define-key map (kbd which-key-paging-key) #'which-key-C-h-dispatch)
(when which-key-use-C-h-commands
@@ -1909,29 +2061,28 @@ including prefix arguments."
(define-key map (kbd "C-h") #'which-key-C-h-dispatch))
map)))
-(defun which-key--process-page (page-n pages-plist)
+(defun which-key--process-page (pages-obj)
"Add information to the basic list of key bindings, including
if applicable the current prefix, the name of the current prefix,
and a page count."
- (let* ((page (nth page-n (plist-get pages-plist :pages)))
- (height (plist-get pages-plist :page-height))
- (n-pages (plist-get pages-plist :n-pages))
- (prefix-keys (key-description which-key--current-prefix))
- (full-prefix (which-key--full-prefix prefix-keys))
- (nxt-pg-hint (which-key--next-page-hint prefix-keys))
+ (let* ((page (car (which-key--pages-pages pages-obj)))
+ (height (which-key--pages-height pages-obj))
+ (n-pages (which-key--pages-num-pages pages-obj))
+ (page-n (car (which-key--pages-page-nums pages-obj)))
+ (prefix-desc (key-description (which-key--pages-prefix pages-obj)))
+ (prefix-title (which-key--pages-prefix-title pages-obj))
+ (full-prefix (which-key--full-prefix prefix-desc))
+ (nxt-pg-hint (which-key--next-page-hint prefix-desc))
;; not used in left case
(status-line
- (concat (propertize (which-key--maybe-get-prefix-title
- (which-key--current-key-string))
- 'face 'which-key-note-face)
+ (concat (which-key--propertize prefix-title 'face
'which-key-note-face)
(when (< 1 n-pages)
- (propertize (format " (%s of %s)"
- (1+ page-n) n-pages)
- 'face 'which-key-note-face)))))
+ (which-key--propertize (format " (%s of %s)" page-n
n-pages)
+ 'face 'which-key-note-face)))))
(pcase which-key-show-prefix
(`left
- (let* ((page-cnt (propertize (format "%s/%s" (1+ page-n) n-pages)
- 'face 'which-key-separator-face))
+ (let* ((page-cnt (which-key--propertize (format "%s/%s" page-n n-pages)
+ 'face
'which-key-separator-face))
(first-col-width (+ 2 (max (which-key--string-width full-prefix)
(which-key--string-width page-cnt))))
(prefix (format (concat "%-" (int-to-string first-col-width) "s")
@@ -1969,7 +2120,7 @@ and a page count."
(cons page
(lambda ()
(which-key--echo
- (concat full-prefix (when prefix-keys " ")
+ (concat full-prefix (when prefix-desc " ")
status-line (when status-line " ")
nxt-pg-hint)))))
(`mode-line
@@ -1982,23 +2133,22 @@ and a page count."
" " nxt-pg-hint))))))
(_ (cons page nil)))))
-(defun which-key--show-page (n)
- "Show page N, starting from 0."
+(defun which-key--show-page (&optional n)
+ "Show current page. N changes the current page to the Nth page
+relative to the current one."
(which-key--init-buffer) ;; in case it was killed
- (let ((n-pages (plist-get which-key--pages-plist :n-pages))
- (prefix-keys (key-description which-key--current-prefix))
- page-n golden-ratio-mode)
- (if (= 0 n-pages)
+ (let ((prefix-keys (which-key--current-key-string))
+ golden-ratio-mode)
+ (if (null which-key--pages-obj)
(message "%s- which-key can't show keys: There is not \
enough space based on your settings and frame size." prefix-keys)
- (setq page-n (mod n n-pages))
- (setq which-key--current-page-n page-n)
- (when (= n-pages (1+ n)) (setq which-key--on-last-page t))
- (let ((page-echo (which-key--process-page page-n which-key--pages-plist))
- (height (plist-get which-key--pages-plist :page-height))
- (width
- (nth page-n (plist-get which-key--pages-plist :page-widths))))
- (which-key--lighter-status page-n)
+ (when n
+ (setq which-key--pages-obj
+ (which-key--pages-set-current-page which-key--pages-obj n)))
+ (let ((page-echo (which-key--process-page which-key--pages-obj))
+ (height (which-key--pages-height which-key--pages-obj))
+ (width (car (which-key--pages-widths which-key--pages-obj))))
+ (which-key--lighter-status)
(if (eq which-key-popup-type 'minibuffer)
(which-key--echo (car page-echo))
(with-current-buffer which-key--buffer
@@ -2016,29 +2166,29 @@ enough space based on your settings and frame size."
prefix-keys)
;;; Paging functions
;;;###autoload
-(defun which-key-reload-key-sequence (key-seq)
+(defun which-key-reload-key-sequence (&optional key-seq)
"Simulate entering the key sequence KEY-SEQ.
KEY-SEQ should be a list of events as produced by
-`listify-key-sequence'. Any prefix arguments that were used are
-reapplied to the new key sequence."
- (let ((next-event (mapcar (lambda (ev) (cons t ev)) key-seq)))
+`listify-key-sequence'. If nil, KEY-SEQ defaults to
+`which-key--current-key-list'. Any prefix arguments that were
+used are reapplied to the new key sequence."
+ (let* ((key-seq (or key-seq (which-key--current-key-list)))
+ (next-event (mapcar (lambda (ev) (cons t ev)) key-seq)))
(setq prefix-arg current-prefix-arg
unread-command-events next-event)))
(defun which-key-turn-page (delta)
"Show the next page of keys."
- (let ((next-page (if which-key--current-page-n
- (+ which-key--current-page-n delta) 0)))
- (which-key-reload-key-sequence (which-key--current-key-list))
- (if which-key--last-try-2-loc
- (let ((which-key-side-window-location which-key--last-try-2-loc)
- (which-key--multiple-locations t))
- (which-key--show-page next-page))
- (which-key--show-page next-page))
- (which-key--start-paging-timer)))
+ (which-key-reload-key-sequence)
+ (if which-key--last-try-2-loc
+ (let ((which-key-side-window-location which-key--last-try-2-loc)
+ (which-key--multiple-locations t))
+ (which-key--show-page delta))
+ (which-key--show-page delta))
+ (which-key--start-paging-timer))
;;;###autoload
-(defun which-key-show-standard-help ()
+(defun which-key-show-standard-help (&optional _)
"Call the command in `which-key--prefix-help-cmd-backup'.
Usually this is `describe-prefix-bindings'."
(interactive)
@@ -2058,8 +2208,7 @@ Usually this is `describe-prefix-bindings'."
call `which-key-show-standard-help'."
(interactive)
(let ((which-key-inhibit t))
- (if (and which-key--current-page-n
- which-key--on-last-page)
+ (if (which-key--on-last-page)
(which-key-show-standard-help)
(which-key-turn-page 1))))
@@ -2069,13 +2218,11 @@ call `which-key-show-standard-help'."
case do nothing."
(interactive)
(let ((which-key-inhibit t))
- (if (and which-key--current-page-n
- (eq which-key--current-page-n 0))
- (which-key-turn-page 0)
+ (unless (which-key--on-first-page)
(which-key-turn-page -1))))
;;;###autoload
-(defun which-key-show-next-page-cycle ()
+(defun which-key-show-next-page-cycle (&optional _)
"Show the next page of keys, cycling from end to beginning
after last page."
(interactive)
@@ -2083,7 +2230,7 @@ after last page."
(which-key-turn-page 1)))
;;;###autoload
-(defun which-key-show-previous-page-cycle ()
+(defun which-key-show-previous-page-cycle (&optional _)
"Show the previous page of keys, cycling from beginning to end
after first page."
(interactive)
@@ -2091,11 +2238,10 @@ after first page."
(which-key-turn-page -1)))
;;;###autoload
-(defun which-key-show-top-level ()
+(defun which-key-show-top-level (&optional _)
"Show top-level bindings."
(interactive)
- (setq which-key--using-top-level "Top-level bindings")
- (which-key--create-buffer-and-show nil))
+ (which-key--create-buffer-and-show nil nil nil "Top-level bindings"))
;;;###autoload
(defun which-key-show-major-mode ()
@@ -2105,20 +2251,21 @@ This function will also detect evil bindings made using
`evil-define-key' in this map. These bindings will depend on the
current evil state. "
(interactive)
- (setq which-key--using-top-level "Major-mode bindings")
(let ((map-sym (intern (format "%s-map" major-mode))))
(if (and (boundp map-sym) (keymapp (symbol-value map-sym)))
(which-key--create-buffer-and-show
- nil nil (apply-partially #'which-key--map-binding-p (symbol-value
map-sym)))
+ nil nil
+ (apply-partially #'which-key--map-binding-p (symbol-value map-sym))
+ "Major-mode bindings")
(message "which-key: No map named %s" map-sym))))
;;;###autoload
-(defun which-key-undo-key ()
+(defun which-key-undo-key (&optional _)
"Undo last keypress and force which-key update."
(interactive)
(let* ((key-lst (butlast (which-key--current-key-list)))
(which-key-inhibit t))
- (cond ((stringp which-key--current-show-keymap-name)
+ (cond (which-key--prior-show-keymap-args
(if (keymapp (cdr (car-safe which-key--prior-show-keymap-args)))
(let ((args (pop which-key--prior-show-keymap-args)))
(which-key--show-keymap (car args) (cdr args)))
@@ -2126,16 +2273,33 @@ current evil state. "
(key-lst
(which-key-reload-key-sequence key-lst)
(which-key--create-buffer-and-show (apply #'vector key-lst)))
- (t (which-key-show-top-level)))))
+ (t (setq which-key--automatic-display nil)
+ (which-key-show-top-level)))))
(defalias 'which-key-undo 'which-key-undo-key)
-(defun which-key-abort ()
+(defun which-key-abort (&optional _)
"Abort key sequence."
(interactive)
(let ((which-key-inhibit t))
(which-key--hide-popup-ignore-command)
(keyboard-quit)))
+(defun which-key-digit-argument (key)
+ "Version of `digit-argument' for use in `which-key-C-h-map'."
+ (interactive)
+ (let ((last-command-event (string-to-char key)))
+ (digit-argument key))
+ (let ((current-prefix-arg prefix-arg))
+ (which-key-reload-key-sequence)))
+
+(defun which-key-toggle-docstrings (&optional _)
+ "Toggle the display of docstrings."
+ (interactive)
+ (unless (eq which-key-show-docstrings 'docstring-only)
+ (setq which-key-show-docstrings (null which-key-show-docstrings)))
+ (which-key-reload-key-sequence)
+ (which-key--create-buffer-and-show (which-key--current-prefix)))
+
;;;###autoload
(defun which-key-C-h-dispatch ()
"Dispatch C-h commands by looking up key in
@@ -2144,16 +2308,16 @@ prefix) if `which-key-use-C-h-commands' is non nil."
(interactive)
(if (not (which-key--popup-showing-p))
(which-key-show-standard-help)
- (let* ((prefix-keys (key-description which-key--current-prefix))
+ (let* ((prefix-keys (which-key--current-key-string))
(full-prefix (which-key--full-prefix prefix-keys current-prefix-arg
t))
(prompt (concat (when (string-equal prefix-keys "")
- (propertize
+ (which-key--propertize
(concat " "
- (or which-key--current-show-keymap-name
- "Top-level bindings"))
+ (which-key--pages-prefix-title
+ which-key--pages-obj))
'face 'which-key-note-face))
full-prefix
- (propertize
+ (which-key--propertize
(substitute-command-keys
(concat
" \\<which-key-C-h-map>"
@@ -2163,15 +2327,19 @@ prefix) if `which-key-use-C-h-commands' is non nil."
which-key-separator "previous-page,"
" \\[which-key-undo-key]"
which-key-separator "undo-key,"
+ " \\[which-key-toggle-docstrings]"
+ which-key-separator "toggle-docstrings,"
" \\[which-key-show-standard-help]"
which-key-separator "help,"
" \\[which-key-abort]"
- which-key-separator "abort"))
+ which-key-separator "abort"
+ " 1..9"
+ which-key-separator "digit-arg"))
'face 'which-key-note-face)))
(key (string (read-key prompt)))
(cmd (lookup-key which-key-C-h-map key))
(which-key-inhibit t))
- (if cmd (funcall cmd) (which-key-turn-page 0)))))
+ (if cmd (funcall cmd key) (which-key-turn-page 0)))))
;;; Update
@@ -2182,44 +2350,64 @@ prefix) if `which-key-use-C-h-commands' is non nil."
(when (string-match-p regexp string)
(throw 'match t)))))
-(defun which-key--try-2-side-windows (keys page-n loc1 loc2 &rest _ignore)
- "Try to show KEYS (PAGE-N) in LOC1 first.
+(defun which-key--try-2-side-windows
+ (bindings prefix-keys prefix-title loc1 loc2 &rest _ignore)
+ "Try to show BINDINGS (PAGE-N) in LOC1 first.
-Only if no keys fit fallback to LOC2."
+Only if no bindings fit fallback to LOC2."
(let (pages1)
(let ((which-key-side-window-location loc1)
(which-key--multiple-locations t))
- (setq pages1 (which-key--create-pages keys)))
- (if (< 0 (plist-get pages1 :n-pages))
+ (setq pages1 (which-key--create-pages
+ bindings prefix-keys prefix-title)))
+ (if pages1
(progn
- (setq which-key--pages-plist pages1)
+ (setq which-key--pages-obj pages1)
(let ((which-key-side-window-location loc1)
(which-key--multiple-locations t))
- (which-key--show-page page-n))
+ (which-key--show-page))
loc1)
(let ((which-key-side-window-location loc2)
(which-key--multiple-locations t))
- (setq which-key--pages-plist
- (which-key--create-pages keys))
- (which-key--show-page page-n)
+ (setq which-key--pages-obj
+ (which-key--create-pages bindings prefix-keys prefix-title))
+ (which-key--show-page)
loc2))))
-(defun which-key-show-keymap ()
+(defun which-key--read-keymap ()
+ "Read keymap symbol from minibuffer."
+ (intern
+ (completing-read "Keymap: " obarray
+ (lambda (m)
+ (and (boundp m)
+ (keymapp (symbol-value m))
+ (not (equal (symbol-value m)
+ (make-sparse-keymap)))))
+ t
+ (let ((sym (symbol-at-point)))
+ (and (boundp sym)
+ (keymapp (symbol-value sym))
+ (symbol-name sym)))
+ 'which-key-keymap-history)))
+
+;;;###autoload
+(defun which-key-show-keymap (keymap)
"Show the top-level bindings in KEYMAP using which-key. KEYMAP
is selected interactively from all available keymaps."
- (interactive)
- (let ((keymap-sym (intern
- (completing-read
- "Keymap: " obarray
- (lambda (m)
- (and (boundp m)
- (keymapp (symbol-value m))
- (not (equal (symbol-value m)
- (make-sparse-keymap)))))
- t nil 'which-key-keymap-history))))
- (which-key--show-keymap (symbol-name keymap-sym)
- (symbol-value keymap-sym))))
+ (interactive (list (which-key--read-keymap)))
+ (which-key--show-keymap (symbol-name keymap)
+ (symbol-value keymap)))
+
+;;;###autoload
+(defun which-key-show-full-keymap (keymap)
+ "Show all bindings in KEYMAP using which-key. KEYMAP is
+selected interactively from all available keymaps."
+ (interactive (list (which-key--read-keymap)))
+ (which-key--show-keymap (symbol-name keymap)
+ (symbol-value keymap)
+ nil t))
+;;;###autoload
(defun which-key-show-minor-mode-keymap ()
"Show the top-level bindings in KEYMAP using which-key. KEYMAP
is selected interactively by mode in `minor-mode-map-alist'."
@@ -2238,32 +2426,28 @@ is selected interactively by mode in
`minor-mode-map-alist'."
(which-key--show-keymap (symbol-name mode-sym)
(cdr (assq mode-sym minor-mode-map-alist)))))
-(defun which-key--show-keymap (keymap-name keymap &optional prior-args)
- (setq which-key--current-prefix nil
- which-key--current-show-keymap-name keymap-name
- which-key--using-show-keymap t)
+(defun which-key--show-keymap (keymap-name keymap &optional prior-args all)
(when prior-args (push prior-args which-key--prior-show-keymap-args))
- (when (keymapp keymap)
- (let ((formatted-keys (which-key--get-formatted-key-bindings
- (which-key--get-keymap-bindings keymap))))
- (cond ((= (length formatted-keys) 0)
- (message "which-key: Keymap empty"))
- ((listp which-key-side-window-location)
+ (let ((bindings (which-key--get-bindings nil keymap nil all)))
+ (if (= (length bindings) 0)
+ (message "which-key: No bindings found in %s" keymap-name)
+ (cond ((listp which-key-side-window-location)
(setq which-key--last-try-2-loc
(apply #'which-key--try-2-side-windows
- formatted-keys 0 which-key-side-window-location)))
- (t (setq which-key--pages-plist
- (which-key--create-pages formatted-keys))
- (which-key--show-page 0)))))
- (let* ((key (key-description (list (read-key))))
- (next-def (lookup-key keymap (kbd key))))
- (cond ((and which-key-use-C-h-commands (string= "C-h" key))
- (which-key-C-h-dispatch))
- ((keymapp next-def)
- (which-key--hide-popup-ignore-command)
- (which-key--show-keymap (concat keymap-name " " key) next-def
- (cons keymap-name keymap)))
- (t (which-key--hide-popup)))))
+ bindings nil keymap-name
+ which-key-side-window-location)))
+ (t (setq which-key--pages-obj
+ (which-key--create-pages bindings nil keymap-name))
+ (which-key--show-page)))
+ (let* ((key (key-description (list (read-key))))
+ (next-def (lookup-key keymap (kbd key))))
+ (cond ((and which-key-use-C-h-commands (string= "C-h" key))
+ (which-key-C-h-dispatch))
+ ((keymapp next-def)
+ (which-key--hide-popup-ignore-command)
+ (which-key--show-keymap (concat keymap-name " " key) next-def
+ (cons keymap-name keymap)))
+ (t (which-key--hide-popup)))))))
(defun which-key--evil-operator-filter (binding)
(let ((def (intern (cdr binding))))
@@ -2277,25 +2461,25 @@ is selected interactively by mode in
`minor-mode-map-alist'."
(make-composed-keymap (list evil-operator-shortcut-map
evil-operator-state-map
evil-motion-state-map))))
- (setq which-key--current-prefix nil
- which-key--current-show-keymap-name "evil operator/motion keys"
- which-key--using-show-operator-keymap t)
(when (keymapp keymap)
- (let ((formatted-keys (which-key--get-formatted-key-bindings
- (which-key--get-keymap-bindings keymap)
- #'which-key--evil-operator-filter)))
+ (let ((formatted-keys
+ (which-key--get-bindings
+ nil keymap #'which-key--evil-operator-filter)))
(cond ((= (length formatted-keys) 0)
(message "which-key: Keymap empty"))
((listp which-key-side-window-location)
(setq which-key--last-try-2-loc
(apply #'which-key--try-2-side-windows
- formatted-keys 0
which-key-side-window-location)))
- (t (setq which-key--pages-plist
- (which-key--create-pages formatted-keys))
- (which-key--show-page 0)))))
+ formatted-keys nil "evil operator/motion keys"
+ which-key-side-window-location)))
+ (t (setq which-key--pages-obj
+ (which-key--create-pages
+ formatted-keys
+ nil "evil operator/motion keys"))
+ (which-key--show-page)))))
(let* ((key (key-description (list (read-key)))))
- (when (string= key "`")
- ;; evil-goto-mark reads the next char manually
+ (when (member key '("f" "F" "t" "T" "`"))
+ ;; these keys trigger commands that read the next char manually
(setq which-key--inhibit-next-operator-popup t))
(cond ((and which-key-use-C-h-commands (string= "C-h" key))
(which-key-C-h-dispatch))
@@ -2306,38 +2490,35 @@ is selected interactively by mode in
`minor-mode-map-alist'."
(which-key--hide-popup)
(setq unread-command-events (listify-key-sequence key))))))))
-(defun which-key--create-buffer-and-show (&optional prefix-keys from-keymap
filter)
+(defun which-key--create-buffer-and-show
+ (&optional prefix-keys from-keymap filter prefix-title)
"Fill `which-key--buffer' with key descriptions and reformat.
Finally, show the buffer."
- (setq which-key--current-prefix prefix-keys
- which-key--last-try-2-loc nil)
(let ((start-time (when which-key--debug (current-time)))
- (formatted-keys (which-key--get-formatted-key-bindings
- (when from-keymap
- (which-key--get-keymap-bindings from-keymap))
- filter))
- (prefix-keys (key-description which-key--current-prefix)))
+ (formatted-keys (which-key--get-bindings
+ prefix-keys from-keymap filter))
+ (prefix-desc (key-description prefix-keys)))
(cond ((= (length formatted-keys) 0)
- (message "%s- which-key: There are no keys to show" prefix-keys))
+ (message "%s- which-key: There are no keys to show" prefix-desc))
((listp which-key-side-window-location)
(setq which-key--last-try-2-loc
(apply #'which-key--try-2-side-windows
- formatted-keys 0 which-key-side-window-location)))
- (t (setq which-key--pages-plist
- (which-key--create-pages formatted-keys))
- (which-key--show-page 0)))
+ formatted-keys prefix-keys prefix-title
+ which-key-side-window-location)))
+ (t (setq which-key--pages-obj
+ (which-key--create-pages
+ formatted-keys prefix-keys prefix-title))
+ (which-key--show-page)))
(when which-key--debug
- (message "On prefix \"%s\" which-key took %.0f ms." prefix-keys
+ (message "On prefix \"%s\" which-key took %.0f ms." prefix-desc
(* 1000 (float-time (time-since start-time)))))))
-(defun which-key--update ()
- "Function run by timer to possibly trigger
-`which-key--create-buffer-and-show'."
- (let ((prefix-keys (this-single-command-keys))
- delay-time)
- (when (and (equal prefix-keys [key-chord])
+(defun which-key--this-command-keys ()
+ "Version of `this-single-command-keys' corrected for key-chords and
god-mode."
+ (let ((this-command-keys (this-single-command-keys)))
+ (when (and (equal this-command-keys [key-chord])
(bound-and-true-p key-chord-mode))
- (setq prefix-keys
+ (setq this-command-keys
(condition-case nil
(let ((rkeys (recent-keys)))
(vector 'key-chord
@@ -2354,8 +2535,15 @@ Finally, show the buffer."
(when (and which-key--god-mode-support-enabled
(bound-and-true-p god-local-mode)
(eq this-command 'god-mode-self-insert))
- (setq prefix-keys (when which-key--god-mode-key-string
+ (setq this-command-keys (when which-key--god-mode-key-string
(kbd which-key--god-mode-key-string))))
+ this-command-keys))
+
+(defun which-key--update ()
+ "Function run by timer to possibly trigger
+`which-key--create-buffer-and-show'."
+ (let ((prefix-keys (which-key--this-command-keys))
+ delay-time)
(cond ((and (> (length prefix-keys) 0)
(or (keymapp (key-binding prefix-keys))
;; Some keymaps are stored here like iso-transl-ctl-x-8-map
@@ -2380,7 +2568,7 @@ Finally, show the buffer."
(bound-and-true-p god-local-mode)
(eq this-command 'god-mode-self-insert))
(null this-command)))
- (when (and (not (equal prefix-keys which-key--current-prefix))
+ (when (and (not (equal prefix-keys (which-key--current-prefix)))
(or (null which-key-delay-functions)
(null (setq delay-time
(run-hook-with-args-until-success
@@ -2388,6 +2576,7 @@ Finally, show the buffer."
(key-description prefix-keys)
(length prefix-keys))))
(sit-for delay-time)))
+ (setq which-key--automatic-display t)
(which-key--create-buffer-and-show prefix-keys)
(when (and which-key-idle-secondary-delay
(not which-key--secondary-timer-active))
@@ -2402,12 +2591,9 @@ Finally, show the buffer."
((and which-key-show-operator-state-maps
(bound-and-true-p evil-state)
(eq evil-state 'operator)
- (not which-key--using-show-operator-keymap))
+ (not (which-key--popup-showing-p)))
(which-key--show-evil-operator-keymap))
- ((and which-key--current-page-n
- (not which-key--using-top-level)
- (not which-key--using-show-operator-keymap)
- (not which-key--using-show-keymap))
+ (which-key--automatic-display
(which-key--hide-popup)))))
;;; Timers
@@ -2436,10 +2622,8 @@ Finally, show the buffer."
(when (or (not (member real-last-command
which-key--paging-functions))
(and (< 0 (length (this-single-command-keys)))
- (not (equal which-key--current-prefix
- (this-single-command-keys)))))
- (setq which-key--current-page-n nil
- which-key--on-last-page nil)
+ (not (equal (which-key--current-prefix)
+ (which-key--this-command-keys)))))
(cancel-timer which-key--paging-timer)
(which-key--start-timer))))))
