which-key.el (113330B)
1 ;;; which-key.el --- Display available keybindings in popup -*- lexical-binding: t; -*- 2 3 ;; Copyright (C) 2017-2021 Free Software Foundation, Inc. 4 5 ;; Author: Justin Burkett <justin@burkett.cc> 6 ;; Maintainer: Justin Burkett <justin@burkett.cc> 7 ;; URL: https://github.com/justbur/emacs-which-key 8 ;; Version: 3.6.0 9 ;; Keywords: 10 ;; Package-Requires: ((emacs "24.4")) 11 12 ;; This program is free software; you can redistribute it and/or modify 13 ;; it under the terms of the GNU General Public License as published by 14 ;; the Free Software Foundation, either version 3 of the License, or 15 ;; (at your option) any later version. 16 17 ;; This program is distributed in the hope that it will be useful, 18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 20 ;; GNU General Public License for more details. 21 22 ;; You should have received a copy of the GNU General Public License 23 ;; along with this program. If not, see <http://www.gnu.org/licenses/>. 24 25 ;;; Commentary: 26 27 ;; which-key provides the minor mode which-key-mode for Emacs. The mode displays 28 ;; the key bindings following your currently entered incomplete command (a 29 ;; prefix) in a popup. For example, after enabling the minor mode if you enter 30 ;; C-x and wait for the default of 1 second the minibuffer will expand with all 31 ;; of the available key bindings that follow C-x (or as many as space allows 32 ;; given your settings). This includes prefixes like C-x 8 which are shown in a 33 ;; different face. Screenshots of what the popup will look like along with 34 ;; information about additional features can be found at 35 ;; https://github.com/justbur/emacs-which-key. 36 ;; 37 38 ;;; Code: 39 40 (require 'cl-lib) 41 (require 'button) 42 (require 'regexp-opt) 43 44 ;; For compiler 45 (defvar evil-operator-shortcut-map) 46 (defvar evil-operator-state-map) 47 (defvar evil-motion-state-map) 48 (defvar golden-ratio-mode) 49 (declare-function evil-get-command-property "ext:evil-common.el") 50 51 ;;; Options 52 53 (defgroup which-key nil 54 "Customization options for which-key-mode" 55 :group 'help 56 :prefix "which-key-") 57 58 (defcustom which-key-idle-delay 1.0 59 "Delay (in seconds) for which-key buffer to popup. 60 This variable should be set before activating `which-key-mode'. 61 62 A value of zero might lead to issues, so a non-zero value is 63 recommended 64 (see https://github.com/justbur/emacs-which-key/issues/134)." 65 :group 'which-key 66 :type 'float) 67 68 (defcustom which-key-idle-secondary-delay nil 69 "Once the which-key buffer shows once for a key sequence reduce 70 the idle time to this amount (in seconds). This makes it possible 71 to shorten the delay for subsequent popups in the same key 72 sequence. The default is for this value to be nil, which disables 73 this behavior." 74 :group 'which-key 75 :type '(choice float (const :tag "Disabled" nil))) 76 77 (defcustom which-key-echo-keystrokes (if (and echo-keystrokes 78 (> (+ echo-keystrokes 0.01) 79 which-key-idle-delay)) 80 (/ (float which-key-idle-delay) 4) 81 echo-keystrokes) 82 "Value to use for `echo-keystrokes'. 83 This only applies if `which-key-popup-type' is minibuffer or 84 `which-key-show-prefix' is echo. It needs to be less than 85 `which-key-idle-delay' or else the keystroke echo will erase the 86 which-key popup." 87 :group 'which-key 88 :type 'float) 89 90 (defcustom which-key-max-description-length 27 91 "Truncate the description of keys to this length. 92 Also adds \"..\". If nil, disable any truncation." 93 :group 'which-key 94 :type '(choice integer (const :tag "Disable truncation" nil))) 95 96 (defcustom which-key-min-column-description-width 0 97 "Every column should at least have this width." 98 :group 'which-key 99 :type 'integer) 100 101 (defcustom which-key-add-column-padding 0 102 "Additional padding (number of spaces) to add to the left of 103 each key column." 104 :group 'which-key 105 :type 'integer) 106 107 (defcustom which-key-unicode-correction 3 108 "Correction for wide unicode characters. 109 Since we measure width in terms of the number of characters, 110 Unicode characters that are wider than ASCII characters throw off 111 the calculation for available width in the which-key buffer. This 112 variable allows you to adjust for the wide unicode characters by 113 artificially reducing the available width in the buffer. 114 115 The default of 3 means allow for the total extra width 116 contributed by any wide unicode characters to be up to one 117 additional ASCII character in the which-key buffer. Increase this 118 number if you are seeing characters get cutoff on the right side 119 of the which-key popup." 120 :group 'which-key 121 :type 'integer) 122 123 (defcustom which-key-dont-use-unicode nil 124 "If non-nil, don't use any unicode characters in default setup." 125 :group 'which-key 126 :type 'boolean) 127 128 (defcustom which-key-separator 129 (if which-key-dont-use-unicode " : " " → ") 130 "Separator to use between key and description. Default is \" → 131 \", unless `which-key-dont-use-unicode' is non nil, in which case 132 the default is \" : \"." 133 :group 'which-key 134 :type 'string) 135 136 (defcustom which-key-ellipsis 137 (if which-key-dont-use-unicode ".." "…") 138 "Ellipsis to use when truncating. Default is \"…\", unless 139 `which-key-dont-use-unicode' is non nil, in which case 140 the default is \"..\"." 141 :group 'which-key 142 :type 'string) 143 144 145 (defcustom which-key-prefix-prefix "+" 146 "String to insert in front of prefix commands (i.e., commands 147 that represent a sub-map). Default is \"+\"." 148 :group 'which-key 149 :type 'string) 150 151 (defcustom which-key-compute-remaps nil 152 "If non-nil, show remapped command if a command has been 153 remapped given the currently active keymaps." 154 :group 'which-key 155 :type 'boolean) 156 157 (defcustom which-key-replacement-alist 158 (delq nil 159 `(((nil . "which-key-show-next-page-no-cycle") . (nil . "wk next pg")) 160 ,@(unless which-key-dont-use-unicode 161 '((("<left>") . ("←")) 162 (("<right>") . ("→")))) 163 (("<\\([[:alnum:]-]+\\)>") . ("\\1")))) 164 "Association list to determine how to manipulate descriptions 165 of key bindings in the which-key popup. Each element of the list 166 is a nested cons cell with the format 167 168 \(MATCH CONS . REPLACEMENT\). 169 170 The MATCH CONS determines when a replacement should occur and 171 REPLACEMENT determines how the replacement should occur. Each may 172 have the format \(KEY REGEXP . BINDING REGEXP\). For the 173 replacement to apply the key binding must match both the KEY 174 REGEXP and the BINDING REGEXP. A value of nil in either position 175 can be used to match every possibility. The replacement is 176 performed by using `replace-regexp-in-string' on the KEY REGEXP 177 from the MATCH CONS and REPLACEMENT when it is a cons cell, and 178 then similarly for the BINDING REGEXP. A nil value in the BINDING 179 REGEXP position cancels the replacement. For example, the entry 180 181 \(\(nil . \"Prefix Command\"\) . \(nil . \"prefix\"\)\) 182 183 matches any binding with the descriptions \"Prefix Command\" and 184 replaces the description with \"prefix\", ignoring the 185 corresponding key. 186 187 REPLACEMENT may also be a function taking a cons cell 188 \(KEY . BINDING\) and producing a new corresponding cons cell. 189 190 If REPLACEMENT is anything other than a cons cell \(and non nil\) 191 the key binding is ignored by which-key. 192 193 Finally, you can multiple replacements to occur for a given key 194 binding by setting `which-key-allow-multiple-replacements' to a 195 non-nil value." 196 :group 'which-key 197 :type '(alist :key-type (cons (choice regexp (const nil)) 198 (choice regexp (const nil))) 199 :value-type (cons (choice string (const nil)) 200 (choice string (const nil))))) 201 202 (defcustom which-key-allow-multiple-replacements nil 203 "Allow a key binding to match and be modified by multiple 204 elements in `which-key-replacement-alist' if non-nil. When nil, 205 only the first match is used to perform replacements from 206 `which-key-replacement-alist'." 207 :group 'which-key 208 :type 'boolean) 209 210 (defcustom which-key-show-docstrings nil 211 "If non-nil, show each command's docstring next to the command 212 in the which-key buffer. This will only display the docstring up 213 to the first line break. If you set this variable to the symbol 214 docstring-only, then the command's name with be omitted. You 215 probably also want to adjust `which-key-max-description-length' 216 at the same time if you use this feature." 217 :group 'which-key 218 :type '(radio 219 (const :tag "Do not show docstrings" nil) 220 (const :tag "Add docstring to command names" t) 221 (const :tag "Replace command name with docstring" docstring-only))) 222 223 (defcustom which-key-highlighted-command-list '() 224 "A list of strings and/or cons cells used to highlight certain 225 commands. If the element is a string, assume it is a regexp 226 pattern for matching command names and use 227 `which-key-highlighted-command-face' for any matching names. If 228 the element is a cons cell, it should take the form (regexp . 229 face to apply)." 230 :group 'which-key 231 :type '(repeat (choice string (cons regexp face)))) 232 233 (defcustom which-key-special-keys '() 234 "These keys will automatically be truncated to one character 235 and have `which-key-special-key-face' applied to them. This is 236 disabled by default. Try this to see the effect. 237 238 \(setq which-key-special-keys '(\"SPC\" \"TAB\" \"RET\" \"ESC\" \"DEL\")\)" 239 :group 'which-key 240 :type '(repeat string)) 241 242 (defcustom which-key-buffer-name " *which-key*" 243 "Name of which-key buffer." 244 :group 'which-key 245 :type 'string) 246 247 (defcustom which-key-show-prefix 'echo 248 "Whether to and where to display the current prefix sequence 249 Possible choices are echo for echo area (the default), left, top 250 and nil. Nil turns the feature off." 251 :group 'which-key 252 :type '(radio (const :tag "Left of the keys" left) 253 (const :tag "In the first line" top) 254 (const :tag "In the last line" bottom) 255 (const :tag "In the echo area" echo) 256 (const :tag "In the mode-line" mode-line) 257 (const :tag "Hide" nil))) 258 259 (defcustom which-key-popup-type 'side-window 260 "Supported types are minibuffer, side-window, frame, and custom" 261 :group 'which-key 262 :type '(radio (const :tag "Show in minibuffer" minibuffer) 263 (const :tag "Show in side window" side-window) 264 (const :tag "Show in popup frame" frame) 265 (const :tag "Use your custom display functions" custom))) 266 267 (defcustom which-key-min-display-lines 1 268 "Minimum number of horizontal lines to display in the which-key buffer" 269 :group 'which-key 270 :type 'integer) 271 272 (defcustom which-key-max-display-columns nil 273 "Maximum number of columns to display in the which-key buffer 274 nil means don't impose a maximum." 275 :group 'which-key 276 :type '(choice integer (const :tag "Unbounded" nil))) 277 278 (defcustom which-key-side-window-location 'bottom 279 "Location of which-key popup when `which-key-popup-type' is side-window. 280 Should be one of top, bottom, left or right. You can also specify 281 a list of two locations, like (right bottom). In this case, the 282 first location is tried. If there is not enough room, the second 283 location is tried." 284 :group 'which-key 285 :type '(radio (const right) 286 (const bottom) 287 (const left) 288 (const top) 289 (const (right bottom)) 290 (const (bottom right)))) 291 292 (defcustom which-key-side-window-slot 0 293 "The `slot' to use for `display-buffer-in-side-window' when 294 `which-key-popup-type' is 'side-window. Quoting from the 295 docstring of `display-buffer-in-side-window', 296 297 ‘slot’ if non-nil, specifies the window slot where to display 298 BUFFER. A value of zero or nil means use the middle slot on the 299 specified side. A negative value means use a slot 300 preceding (that is, above or on the left of) the middle slot. A 301 positive value means use a slot following (that is, below or on 302 the right of) the middle slot. The default is zero." 303 :group 'which-key 304 :type 'integer) 305 306 (defcustom which-key-side-window-max-width 0.333 307 "Maximum width of which-key popup when type is side-window 308 This variable can also be a number between 0 and 1. In that case, 309 it denotes a percentage out of the frame's width." 310 :group 'which-key 311 :type 'float) 312 313 (defcustom which-key-side-window-max-height 0.25 314 "Maximum height of which-key popup when type is side-window 315 This variable can also be a number between 0 and 1. In that case, it denotes 316 a percentage out of the frame's height." 317 :group 'which-key 318 :type 'float) 319 320 (defcustom which-key-frame-max-width 60 321 "Maximum width of which-key popup when type is frame." 322 :group 'which-key 323 :type 'integer) 324 325 (defcustom which-key-frame-max-height 20 326 "Maximum height of which-key popup when type is frame." 327 :group 'which-key 328 :type 'integer) 329 330 (defcustom which-key-allow-imprecise-window-fit (not (display-graphic-p)) 331 "If non-nil allow which-key to use a less intensive method of 332 fitting the popup window to the buffer. If you are noticing lag 333 when the which-key popup displays turning this on may help. 334 335 See https://github.com/justbur/emacs-which-key/issues/130 336 and https://github.com/justbur/emacs-which-key/issues/225." 337 :group 'which-key 338 :type 'boolean) 339 340 (defcustom which-key-show-remaining-keys nil 341 "Show remaining keys in last slot, when keys are hidden." 342 :group 'which-key 343 :type '(radio (const :tag "Yes" t) 344 (const :tag "No" nil))) 345 346 (defcustom which-key-sort-order 'which-key-key-order 347 "If nil, do not resort the output from 348 `describe-buffer-bindings' which groups by mode. Ordering options 349 are 350 351 1. `which-key-key-order': by key (default) 352 2. `which-key-key-order-alpha': by key using alphabetical order 353 3. `which-key-description-order': by description 354 4. `which-key-prefix-then-key-order': prefix (no prefix first) then key 355 5. `which-key-local-then-key-order': local binding then key 356 357 See the README and the docstrings for those functions for more 358 information." 359 :group 'which-key 360 :type '(choice (function-item which-key-key-order) 361 (function-item which-key-key-order-alpha) 362 (function-item which-key-description-order) 363 (function-item which-key-prefix-then-key-order) 364 (function-item which-key-local-then-key-order))) 365 366 (defcustom which-key-sort-uppercase-first t 367 "If non-nil, uppercase comes before lowercase in sorting 368 function chosen in `which-key-sort-order'. Otherwise, the order 369 is reversed." 370 :group 'which-key 371 :type 'boolean) 372 373 (defcustom which-key-paging-prefixes '() 374 "Enable paging for these prefixes." 375 :group 'which-key 376 :type '(repeat string)) 377 378 (defcustom which-key-paging-key "<f5>" 379 "Key to use for changing pages. Bound after each of the 380 prefixes in `which-key-paging-prefixes'" 381 :group 'which-key 382 :type 'string) 383 384 ;; (defcustom which-key-undo-key nil 385 ;; "Key (string) to use for undoing keypresses. Bound recursively 386 ;; in each of the maps in `which-key-undo-keymaps'." 387 ;; :group 'which-key 388 ;; :type 'string) 389 390 ;; (defcustom which-key-undo-keymaps '() 391 ;; "Keymaps in which to bind `which-key-undo-key'" 392 ;; :group 'which-key 393 ;; :type '(repeat symbol)) 394 395 (defcustom which-key-use-C-h-commands t 396 "Use C-h (or whatever `help-char' is set to) for paging if 397 non-nil. Normally C-h after a prefix calls 398 `describe-prefix-bindings'. This changes that command to a 399 which-key paging command when which-key-mode is active." 400 :group 'which-key 401 :type 'boolean) 402 403 (defcustom which-key-show-early-on-C-h nil 404 "Show the which-key buffer before if C-h (or whatever 405 `help-char' is set to) is pressed in the middle of a prefix 406 before the which-key buffer would normally be triggered through 407 the idle delay. If combined with the following settings, 408 which-key will effectively only show when triggered \"manually\" 409 using C-h. 410 411 \(setq `which-key-idle-delay' 10000) 412 \(setq `which-key-idle-secondary-delay' 0.05) 413 414 Note that `which-key-idle-delay' should be set before turning on 415 `which-key-mode'. " 416 :group 'which-key 417 :type 'boolean) 418 419 (defcustom which-key-is-verbose nil 420 "Whether to warn about potential mistakes in configuration." 421 :group 'which-key 422 :type 'boolean) 423 424 (defcustom which-key-preserve-window-configuration nil 425 "If non-nil, save window configuration before which-key buffer is shown 426 and restore it after which-key buffer is hidden. It prevents which-key from 427 changing window position of visible buffers. 428 Only takken into account when popup type is side-window." 429 :group 430 'which-key 431 :type 'boolean) 432 433 (defvar which-key-C-h-map 434 (let ((map (make-sparse-keymap))) 435 (dolist (bind `(("\C-a" . which-key-abort) 436 ("a" . which-key-abort) 437 ("\C-d" . which-key-toggle-docstrings) 438 ("d" . which-key-toggle-docstrings) 439 (,(vector help-char) . which-key-show-standard-help) 440 ("h" . which-key-show-standard-help) 441 ("\C-n" . which-key-show-next-page-cycle) 442 ("n" . which-key-show-next-page-cycle) 443 ("\C-p" . which-key-show-previous-page-cycle) 444 ("p" . which-key-show-previous-page-cycle) 445 ("\C-u" . which-key-undo-key) 446 ("u" . which-key-undo-key) 447 ("1" . which-key-digit-argument) 448 ("2" . which-key-digit-argument) 449 ("3" . which-key-digit-argument) 450 ("4" . which-key-digit-argument) 451 ("5" . which-key-digit-argument) 452 ("6" . which-key-digit-argument) 453 ("7" . which-key-digit-argument) 454 ("8" . which-key-digit-argument) 455 ("9" . which-key-digit-argument))) 456 (define-key map (car bind) (cdr bind))) 457 map) 458 "Keymap for C-h commands.") 459 460 (defvar which-key--paging-functions '(which-key-C-h-dispatch 461 which-key-manual-update 462 which-key-turn-page 463 which-key-show-next-page-cycle 464 which-key-show-next-page-no-cycle 465 which-key-show-previous-page-cycle 466 which-key-show-previous-page-no-cycle 467 which-key-undo-key 468 which-key-undo)) 469 470 (defvar which-key-persistent-popup nil 471 "Whether or not to disable `which-key--hide-popup'.") 472 473 (defcustom which-key-hide-alt-key-translations t 474 "Hide key translations using Alt key if non nil. 475 These translations are not relevant most of the times since a lot 476 of terminals issue META modifier for the Alt key. 477 478 See http://www.gnu.org/software/emacs/manual/html_node/emacs/Modifier-Keys.html" 479 :group 'which-key 480 :type 'boolean) 481 482 (defcustom which-key-delay-functions nil 483 "A list of functions that may decide whether to delay the 484 which-key popup based on the current incomplete key 485 sequence. Each function in the list is run with two arguments, 486 the current key sequence as produced by `key-description' and the 487 length of the key sequence. If the popup should be delayed based 488 on that key sequence, the function should return the delay time 489 in seconds. Returning nil means no delay. The first function in 490 this list to return a value is the value that is used. 491 492 The delay time is effectively added to the normal 493 `which-key-idle-delay'." 494 :group 'which-key 495 :type '(repeat function)) 496 497 (defcustom which-key-allow-regexps nil 498 "A list of regexp strings to use to filter key sequences. 499 When non-nil, for a key sequence to trigger the which-key popup 500 it must match one of the regexps in this list. The format of the 501 key sequences is what is produced by `key-description'." 502 :group 'which-key 503 :type '(repeat regexp)) 504 505 (defcustom which-key-inhibit-regexps nil 506 "Similar to `which-key-allow-regexps', a list of regexp strings 507 to use to filter key sequences. When non-nil, for a key sequence 508 to trigger the which-key popup it cannot match one of the regexps 509 in this list. The format of the key sequences is what is produced 510 by `key-description'." 511 :group 'which-key 512 :type '(repeat regexp)) 513 514 (defcustom which-key-show-transient-maps nil 515 "Show keymaps created by `set-transient-map' when applicable. 516 517 More specifically, detect when `overriding-terminal-local-map' is 518 set (this is the keymap used by `set-transient-map') and display 519 it." 520 :group 'which-key 521 :type 'boolean) 522 523 (make-obsolete-variable 524 'which-key-enable-extended-define-key 525 "which-key-enable-extended-define-key is obsolete and has no effect." 526 "2021-06-21") 527 528 ;; Hooks 529 (defcustom which-key-init-buffer-hook '() 530 "Hook run when which-key buffer is initialized." 531 :group 'which-key 532 :type 'hook) 533 534 ;;;; Faces 535 536 (defgroup which-key-faces nil 537 "Faces for which-key-mode" 538 :group 'which-key 539 :prefix "which-key-") 540 541 (defface which-key-key-face 542 '((t . (:inherit font-lock-constant-face))) 543 "Face for which-key keys" 544 :group 'which-key-faces) 545 546 (defface which-key-separator-face 547 '((t . (:inherit font-lock-comment-face))) 548 "Face for the separator (default separator is an arrow)" 549 :group 'which-key-faces) 550 551 (defface which-key-note-face 552 '((t . (:inherit which-key-separator-face))) 553 "Face for notes or hints occasionally provided" 554 :group 'which-key-faces) 555 556 (defface which-key-command-description-face 557 '((t . (:inherit font-lock-function-name-face))) 558 "Face for the key description when it is a command" 559 :group 'which-key-faces) 560 561 (defface which-key-local-map-description-face 562 '((t . (:inherit which-key-command-description-face))) 563 "Face for the key description when it is found in `current-local-map'" 564 :group 'which-key-faces) 565 566 (defface which-key-highlighted-command-face 567 '((t . (:inherit which-key-command-description-face :underline t))) 568 "Default face for the command description when it is a command 569 and it matches a string in `which-key-highlighted-command-list'." 570 :group 'which-key-faces) 571 572 (defface which-key-group-description-face 573 '((t . (:inherit font-lock-keyword-face))) 574 "Face for the key description when it is a group or prefix" 575 :group 'which-key-faces) 576 577 (defface which-key-special-key-face 578 '((t . (:inherit which-key-key-face :inverse-video t :weight bold))) 579 "Face for special keys (SPC, TAB, RET)" 580 :group 'which-key-faces) 581 582 (defface which-key-docstring-face 583 '((t . (:inherit which-key-note-face))) 584 "Face for docstrings" 585 :group 'which-key-faces) 586 587 ;;;; Custom popup 588 589 (defcustom which-key-custom-popup-max-dimensions-function nil 590 "Variable to hold a custom max-dimensions function. 591 Will be passed the width of the active window and is expected to 592 return the maximum height in lines and width in characters of the 593 which-key popup in the form a cons cell (height . width)." 594 :group 'which-key 595 :type '(choice function (const nil))) 596 597 (defcustom which-key-custom-hide-popup-function nil 598 "Variable to hold a custom hide-popup function. 599 It takes no arguments and the return value is ignored." 600 :group 'which-key 601 :type '(choice function (const nil))) 602 603 (defcustom which-key-custom-show-popup-function nil 604 "Variable to hold a custom show-popup function. 605 Will be passed the required dimensions in the form (height . 606 width) in lines and characters respectively. The return value is 607 ignored." 608 :group 'which-key 609 :type '(choice function (const nil))) 610 611 (defcustom which-key-lighter " WK" 612 "Minor mode lighter to use in the mode-line." 613 :group 'which-key 614 :type 'string) 615 616 (defvar which-key-inhibit nil 617 "Prevent which-key from popping up momentarily by setting this 618 to a non-nil value for the execution of a command. Like this 619 620 \(let \(\(which-key-inhibit t\)\) 621 ...\)") 622 623 (defvar which-key-keymap-history nil 624 "History of keymap selections in functions like 625 `which-key-show-keymap'.") 626 627 ;;; Internal Vars 628 629 (defvar which-key--buffer nil 630 "Internal: Holds reference to which-key buffer.") 631 (defvar which-key--timer nil 632 "Internal: Holds reference to open window timer.") 633 (defvar which-key--secondary-timer-active nil 634 "Internal: Non-nil if the secondary timer is active.") 635 (defvar which-key--paging-timer nil 636 "Internal: Holds reference to timer for paging.") 637 (defvar which-key--frame nil 638 "Internal: Holds reference to which-key frame. 639 Used when `which-key-popup-type' is frame.") 640 (defvar which-key--echo-keystrokes-backup nil 641 "Internal: Backup the initial value of `echo-keystrokes'.") 642 (defvar which-key--prefix-help-cmd-backup nil 643 "Internal: Backup the value of `prefix-help-command'.") 644 (defvar which-key--last-try-2-loc nil 645 "Internal: Last location of side-window when two locations 646 used.") 647 (defvar which-key--automatic-display nil 648 "Internal: Non-nil if popup was triggered with automatic 649 update.") 650 (defvar which-key--debug-buffer-name nil 651 "If non-nil, use this buffer for debug messages.") 652 (defvar which-key--multiple-locations nil) 653 (defvar which-key--inhibit-next-operator-popup nil) 654 (defvar which-key--prior-show-keymap-args nil) 655 (defvar which-key--previous-frame-size nil) 656 (defvar which-key--prefix-title-alist nil) 657 (defvar which-key--evil-keys-regexp (eval-when-compile 658 (regexp-opt '("-state")))) 659 (defvar which-key--ignore-non-evil-keys-regexp 660 (eval-when-compile 661 (regexp-opt '("mouse-" "wheel-" "remap" "drag-" "scroll-bar" 662 "select-window" "switch-frame" "which-key")))) 663 (defvar which-key--ignore-keys-regexp 664 (eval-when-compile 665 (regexp-opt '("mouse-" "wheel-" "remap" "drag-" "scroll-bar" 666 "select-window" "switch-frame" "-state" 667 "which-key")))) 668 669 (defvar which-key--pages-obj nil) 670 (cl-defstruct which-key--pages 671 pages 672 height 673 widths 674 keys/page 675 page-nums 676 num-pages 677 total-keys 678 prefix 679 prefix-title) 680 681 (defvar which-key--saved-window-configuration nil) 682 683 (defun which-key--rotate (list n) 684 (let* ((len (length list)) 685 (n (if (< n 0) (+ len n) n)) 686 (n (mod n len))) 687 (append (last list (- len n)) (butlast list (- len n))))) 688 689 (defun which-key--pages-set-current-page (pages-obj n) 690 (setf (which-key--pages-pages pages-obj) 691 (which-key--rotate (which-key--pages-pages pages-obj) n)) 692 (setf (which-key--pages-widths pages-obj) 693 (which-key--rotate (which-key--pages-widths pages-obj) n)) 694 (setf (which-key--pages-keys/page pages-obj) 695 (which-key--rotate (which-key--pages-keys/page pages-obj) n)) 696 (setf (which-key--pages-page-nums pages-obj) 697 (which-key--rotate (which-key--pages-page-nums pages-obj) n)) 698 pages-obj) 699 700 (defsubst which-key--on-first-page () 701 (= (which-key--pages-page-nums which-key--pages-obj) 1)) 702 703 (defsubst which-key--on-last-page () 704 (= (which-key--pages-page-nums which-key--pages-obj) 705 (which-key--pages-num-pages which-key--pages-obj))) 706 707 (defsubst which-key--current-prefix () 708 (and which-key--pages-obj 709 (which-key--pages-prefix which-key--pages-obj))) 710 711 (defmacro which-key--debug-message (&rest msg) 712 `(when which-key--debug-buffer-name 713 (let ((buf (get-buffer-create which-key--debug-buffer-name)) 714 (fmt-msg (format ,@msg))) 715 (with-current-buffer buf 716 (goto-char (point-max)) 717 (insert "\n" fmt-msg "\n"))))) 718 719 (defsubst which-key--safe-lookup-key (keymap key) 720 "Version of `lookup-key' that allows KEYMAP to be nil. 721 Also convert numeric results of `lookup-key' to nil. KEY is not 722 checked." 723 (when (keymapp keymap) 724 (let ((result (lookup-key keymap key))) 725 (when (and result (not (numberp result))) 726 result)))) 727 728 ;;; Third-party library support 729 ;;;; Evil 730 731 (defvar evil-state nil) 732 733 (defcustom which-key-allow-evil-operators (boundp 'evil-this-operator) 734 "Allow popup to show for evil operators. 735 The popup is normally inhibited in the middle of commands, but 736 setting this to non-nil will override this behavior for evil 737 operators." 738 :group 'which-key 739 :type 'boolean) 740 741 (defcustom which-key-show-operator-state-maps nil 742 "Experimental: Try to show the right keys following an evil 743 command that reads a motion, such as \"y\", \"d\" and \"c\" from 744 normal state. This is experimental, because there might be some 745 valid keys missing and it might be showing some invalid keys." 746 :group 'which-key 747 :type 'boolean) 748 749 ;;;; God-mode 750 751 (defvar which-key--god-mode-support-enabled nil 752 "Support god-mode if non-nil. This is experimental, 753 so you need to explicitly opt-in for now. Please report any 754 problems at github.") 755 756 (defvar which-key--god-mode-key-string nil 757 "Holds key string to use for god-mode support.") 758 759 (defun which-key--god-mode-lookup-command-advice (orig-fun arg1 &rest args) 760 (setq which-key--god-mode-key-string arg1) 761 (unwind-protect 762 (apply orig-fun arg1 args) 763 (when (bound-and-true-p which-key-mode) 764 (which-key--hide-popup)))) 765 766 (defun which-key-enable-god-mode-support (&optional disable) 767 "Enable support for god-mode if non-nil. 768 This is experimental, so you need to explicitly opt-in for 769 now. Please report any problems at github. If DISABLE is non-nil 770 disable support." 771 (interactive "P") 772 (setq which-key--god-mode-support-enabled (null disable)) 773 (if disable 774 (advice-remove 'god-mode-lookup-command 775 #'which-key--god-mode-lookup-command-advice) 776 (advice-add 'god-mode-lookup-command :around 777 #'which-key--god-mode-lookup-command-advice))) 778 779 ;;; Mode 780 781 ;;;###autoload 782 (define-minor-mode which-key-mode 783 "Toggle which-key-mode." 784 :global t 785 :lighter which-key-lighter 786 :keymap (let ((map (make-sparse-keymap))) 787 (mapc 788 (lambda (prefix) 789 (define-key map 790 (kbd (concat prefix " " which-key-paging-key)) 791 #'which-key-C-h-dispatch)) 792 which-key-paging-prefixes) 793 map) 794 (if which-key-mode 795 (progn 796 (setq which-key--echo-keystrokes-backup echo-keystrokes) 797 (when (or (eq which-key-show-prefix 'echo) 798 (eq which-key-popup-type 'minibuffer)) 799 (which-key--setup-echo-keystrokes)) 800 (unless (member prefix-help-command which-key--paging-functions) 801 (setq which-key--prefix-help-cmd-backup prefix-help-command)) 802 (when (or which-key-use-C-h-commands 803 which-key-show-early-on-C-h) 804 (setq prefix-help-command #'which-key-C-h-dispatch)) 805 (when which-key-show-remaining-keys 806 (add-hook 'pre-command-hook #'which-key--lighter-restore)) 807 (add-hook 'pre-command-hook #'which-key--hide-popup) 808 (add-hook 'window-size-change-functions 809 #'which-key--hide-popup-on-frame-size-change) 810 (which-key--start-timer)) 811 (setq echo-keystrokes which-key--echo-keystrokes-backup) 812 (when which-key--prefix-help-cmd-backup 813 (setq prefix-help-command which-key--prefix-help-cmd-backup)) 814 (when which-key-show-remaining-keys 815 (remove-hook 'pre-command-hook #'which-key--lighter-restore)) 816 (remove-hook 'pre-command-hook #'which-key--hide-popup) 817 (remove-hook 'window-size-change-functions 818 #'which-key--hide-popup-on-frame-size-change) 819 (which-key--stop-timer))) 820 821 (defun which-key--init-buffer () 822 "Initialize which-key buffer" 823 (unless (buffer-live-p which-key--buffer) 824 (setq which-key--buffer (get-buffer-create which-key-buffer-name)) 825 (with-current-buffer which-key--buffer 826 ;; suppress confusing minibuffer message 827 (let (message-log-max) 828 (toggle-truncate-lines 1) 829 (message "")) 830 (setq-local cursor-type nil) 831 (setq-local cursor-in-non-selected-windows nil) 832 (setq-local mode-line-format nil) 833 (setq-local header-line-format nil) 834 (setq-local word-wrap nil) 835 (setq-local show-trailing-whitespace nil) 836 (run-hooks 'which-key-init-buffer-hook)))) 837 838 (defun which-key--setup-echo-keystrokes () 839 "Reduce `echo-keystrokes' if necessary (it will interfere if 840 it's set too high)." 841 (when (and echo-keystrokes 842 (> (abs (- echo-keystrokes which-key-echo-keystrokes)) 0.000001)) 843 (if (> which-key-idle-delay which-key-echo-keystrokes) 844 (setq echo-keystrokes which-key-echo-keystrokes) 845 (setq which-key-echo-keystrokes (/ (float which-key-idle-delay) 4) 846 echo-keystrokes which-key-echo-keystrokes)))) 847 848 (defun which-key-remove-default-unicode-chars () 849 "Use of `which-key-dont-use-unicode' is preferred to this 850 function, but it's included here in case someone cannot set that 851 variable early enough in their configuration, if they are using a 852 starter kit for example." 853 (when (string-equal which-key-separator " → ") 854 (setq which-key-separator " : "))) 855 856 ;;; Default configuration functions for use by users. 857 858 ;;;###autoload 859 (defun which-key-setup-side-window-right () 860 "Apply suggested settings for side-window that opens on right." 861 (interactive) 862 (setq which-key-popup-type 'side-window 863 which-key-side-window-location 'right 864 which-key-show-prefix 'top)) 865 866 ;;;###autoload 867 (defun which-key-setup-side-window-right-bottom () 868 "Apply suggested settings for side-window that opens on right 869 if there is space and the bottom otherwise." 870 (interactive) 871 (setq which-key-popup-type 'side-window 872 which-key-side-window-location '(right bottom) 873 which-key-show-prefix 'top)) 874 875 ;;;###autoload 876 (defun which-key-setup-side-window-bottom () 877 "Apply suggested settings for side-window that opens on bottom." 878 (interactive) 879 (which-key--setup-echo-keystrokes) 880 (setq which-key-popup-type 'side-window 881 which-key-side-window-location 'bottom 882 which-key-show-prefix 'echo)) 883 884 ;;;###autoload 885 (defun which-key-setup-minibuffer () 886 "Apply suggested settings for minibuffer. 887 Do not use this setup if you use the paging commands. Instead use 888 `which-key-setup-side-window-bottom', which is nearly identical 889 but more functional." 890 (interactive) 891 (which-key--setup-echo-keystrokes) 892 (setq which-key-popup-type 'minibuffer 893 which-key-show-prefix 'left)) 894 895 ;;; Helper functions to modify replacement lists. 896 897 ;;;###autoload 898 (defun which-key-add-keymap-based-replacements (keymap key replacement &rest more) 899 "Replace the description of KEY using REPLACEMENT in KEYMAP. 900 KEY should take a format suitable for use in `kbd'. REPLACEMENT 901 should be a cons cell of the form \(STRING . COMMAND\) for each 902 REPLACEMENT, where STRING is the replacement string and COMMAND 903 is a symbol corresponding to the intended command to be 904 replaced. COMMAND can be nil if the binding corresponds to a key 905 prefix. An example is 906 907 \(which-key-add-keymap-based-replacements global-map 908 \"C-x w\" '\(\"Save as\" . write-file\)\). 909 910 For backwards compatibility, REPLACEMENT can also be a string, 911 but the above format is preferred, and the option to use a string 912 for REPLACEMENT will eventually be removed." 913 (while key 914 (let ((def 915 (cond 916 ((consp replacement) replacement) 917 ((stringp replacement) 918 (cons replacement 919 (or (which-key--safe-lookup-key keymap (kbd key)) 920 (make-sparse-keymap)))) 921 (t 922 (user-error "replacement is neither a cons cell or a string"))))) 923 (define-key keymap (kbd key) def)) 924 (setq key (pop more) 925 replacement (pop more)))) 926 (put 'which-key-add-keymap-based-replacements 'lisp-indent-function 'defun) 927 928 ;;;###autoload 929 (defun which-key-add-key-based-replacements 930 (key-sequence replacement &rest more) 931 "Replace the description of KEY-SEQUENCE with REPLACEMENT. 932 KEY-SEQUENCE is a string suitable for use in `kbd'. REPLACEMENT 933 may either be a string, as in 934 935 \(which-key-add-key-based-replacements \"C-x 1\" \"maximize\"\) 936 937 a cons of two strings as in 938 939 \(which-key-add-key-based-replacements \"C-x 8\" 940 '(\"unicode\" . \"Unicode keys\")\) 941 942 or a function that takes a \(KEY . BINDING\) cons and returns a 943 replacement. 944 945 In the second case, the second string is used to provide a longer 946 name for the keys under a prefix. 947 948 MORE allows you to specifcy additional KEY REPLACEMENT pairs. All 949 replacements are added to `which-key-replacement-alist'." 950 ;; TODO: Make interactive 951 (while key-sequence 952 ;; normalize key sequences before adding 953 (let ((key-seq (key-description (kbd key-sequence))) 954 (replace (or (and (functionp replacement) replacement) 955 (car-safe replacement) 956 replacement))) 957 (push (cons (cons (concat "\\`" (regexp-quote key-seq) "\\'") nil) 958 (if (functionp replace) replace (cons nil replace))) 959 which-key-replacement-alist) 960 (when (and (not (functionp replacement)) (consp replacement)) 961 (push (cons key-seq (cdr-safe replacement)) 962 which-key--prefix-title-alist))) 963 (setq key-sequence (pop more) replacement (pop more)))) 964 (put 'which-key-add-key-based-replacements 'lisp-indent-function 'defun) 965 966 ;;;###autoload 967 (defun which-key-add-major-mode-key-based-replacements 968 (mode key-sequence replacement &rest more) 969 "Functions like `which-key-add-key-based-replacements'. 970 The difference is that MODE specifies the `major-mode' that must 971 be active for KEY-SEQUENCE and REPLACEMENT (MORE contains 972 addition KEY-SEQUENCE REPLACEMENT pairs) to apply." 973 ;; TODO: Make interactive 974 (when (not (symbolp mode)) 975 (error "MODE should be a symbol corresponding to a value of major-mode")) 976 (let ((mode-alist 977 (or (cdr-safe (assq mode which-key-replacement-alist)) (list))) 978 (title-mode-alist 979 (or (cdr-safe (assq mode which-key--prefix-title-alist)) (list)))) 980 (while key-sequence 981 ;; normalize key sequences before adding 982 (let ((key-seq (key-description (kbd key-sequence))) 983 (replace (or (and (functionp replacement) replacement) 984 (car-safe replacement) 985 replacement))) 986 (push (cons (cons (concat "\\`" (regexp-quote key-seq) "\\'") nil) 987 (if (functionp replace) replace (cons nil replace))) 988 mode-alist) 989 (when (and (not (functionp replacement)) (consp replacement)) 990 (push (cons key-seq (cdr-safe replacement)) 991 title-mode-alist))) 992 (setq key-sequence (pop more) replacement (pop more))) 993 (if (assq mode which-key-replacement-alist) 994 (setcdr (assq mode which-key-replacement-alist) mode-alist) 995 (push (cons mode mode-alist) which-key-replacement-alist)) 996 (if (assq mode which-key--prefix-title-alist) 997 (setcdr (assq mode which-key--prefix-title-alist) title-mode-alist) 998 (push (cons mode title-mode-alist) which-key--prefix-title-alist)))) 999 (put 'which-key-add-major-mode-key-based-replacements 1000 'lisp-indent-function 'defun) 1001 1002 (defun which-key-define-key-recursively (map key def &optional at-root) 1003 "Recursively bind KEY in MAP to DEF on every level of MAP except the first. 1004 If AT-ROOT is non-nil the binding is also placed at the root of MAP." 1005 (when at-root (define-key map key def)) 1006 (map-keymap 1007 (lambda (_ev df) 1008 (when (keymapp df) 1009 (which-key-define-key-recursively df key def t))) 1010 map)) 1011 1012 ;;; Functions for computing window sizes 1013 1014 (defun which-key--text-width-to-total (text-width) 1015 "Convert window text-width to window total-width. 1016 TEXT-WIDTH is the desired text width of the window. The function 1017 calculates what total width is required for a window in the 1018 selected to have a text-width of TEXT-WIDTH columns. The 1019 calculation considers possible fringes and scroll bars. This 1020 function assumes that the desired window has the same character 1021 width as the frame." 1022 (let ((char-width (frame-char-width))) 1023 (+ text-width 1024 (/ (frame-fringe-width) char-width) 1025 (/ (frame-scroll-bar-width) char-width) 1026 (if (which-key--char-enlarged-p) 1 0) 1027 ;; add padding to account for possible wide (unicode) characters 1028 3))) 1029 1030 (defun which-key--total-width-to-text (total-width) 1031 "Convert window total-width to window text-width. 1032 TOTAL-WIDTH is the desired total width of the window. The function calculates 1033 what text width fits such a window. The calculation considers possible fringes 1034 and scroll bars. This function assumes that the desired window has the same 1035 character width as the frame." 1036 (let ((char-width (frame-char-width))) 1037 (- total-width 1038 (/ (frame-fringe-width) char-width) 1039 (/ (frame-scroll-bar-width) char-width) 1040 (if (which-key--char-enlarged-p) 1 0) 1041 ;; add padding to account for possible wide (unicode) characters 1042 3))) 1043 1044 (defun which-key--char-enlarged-p (&optional _frame) 1045 (> (frame-char-width) 1046 (/ (float (frame-pixel-width)) (window-total-width (frame-root-window))))) 1047 1048 (defun which-key--char-reduced-p (&optional _frame) 1049 (< (frame-char-width) 1050 (/ (float (frame-pixel-width)) (window-total-width (frame-root-window))))) 1051 1052 (defun which-key--char-exact-p (&optional _frame) 1053 (= (frame-char-width) 1054 (/ (float (frame-pixel-width)) (window-total-width (frame-root-window))))) 1055 1056 (defun which-key--width-or-percentage-to-width (width-or-percentage) 1057 "Return window total width. 1058 If WIDTH-OR-PERCENTAGE is a whole number, return it unchanged. Otherwise, it 1059 should be a percentage (a number between 0 and 1) out of the frame's width. 1060 More precisely, it should be a percentage out of the frame's root window's 1061 total width." 1062 (if (wholenump width-or-percentage) 1063 width-or-percentage 1064 (round (* width-or-percentage (window-total-width (frame-root-window)))))) 1065 1066 (defun which-key--height-or-percentage-to-height (height-or-percentage) 1067 "Return window total height. 1068 If HEIGHT-OR-PERCENTAGE is a whole number, return it unchanged. Otherwise, it 1069 should be a percentage (a number between 0 and 1) out of the frame's height. 1070 More precisely, it should be a percentage out of the frame's root window's 1071 total height." 1072 (if (wholenump height-or-percentage) 1073 height-or-percentage 1074 (round (* height-or-percentage (window-total-height (frame-root-window)))))) 1075 1076 (defun which-key--frame-size-changed-p () 1077 "Non-nil if a change in frame size is detected." 1078 (let ((new-size (cons (frame-width) (frame-height)))) 1079 (cond ((null which-key--previous-frame-size) 1080 (setq which-key--previous-frame-size new-size) 1081 nil) 1082 ((not (equal which-key--previous-frame-size new-size)) 1083 (setq which-key--previous-frame-size new-size))))) 1084 1085 ;;; Show/hide which-key buffer 1086 1087 (defun which-key--hide-popup () 1088 "This function is called to hide the which-key buffer." 1089 (unless (or which-key-persistent-popup 1090 (member real-this-command which-key--paging-functions)) 1091 (setq which-key--last-try-2-loc nil) 1092 (setq which-key--pages-obj nil) 1093 (setq which-key--automatic-display nil) 1094 (setq which-key--prior-show-keymap-args nil) 1095 (when (and which-key-idle-secondary-delay which-key--secondary-timer-active) 1096 (which-key--start-timer)) 1097 (which-key--lighter-restore) 1098 (which-key--hide-popup-ignore-command))) 1099 1100 (defun which-key--hide-popup-ignore-command () 1101 "Version of `which-key--hide-popup' without the check of 1102 `real-this-command'." 1103 (cl-case which-key-popup-type 1104 ;; Not necessary to hide minibuffer 1105 ;; (minibuffer (which-key--hide-buffer-minibuffer)) 1106 (side-window (which-key--hide-buffer-side-window)) 1107 (frame (which-key--hide-buffer-frame)) 1108 (custom (funcall which-key-custom-hide-popup-function)))) 1109 1110 (defun which-key--hide-popup-on-frame-size-change (&optional _) 1111 "Hide which-key popup if the frame is resized (to trigger a new popup)." 1112 (when (which-key--frame-size-changed-p) 1113 (which-key--hide-popup))) 1114 1115 (defun which-key--hide-buffer-side-window () 1116 "Hide which-key buffer when side-window popup is used." 1117 (when (buffer-live-p which-key--buffer) 1118 ;; in case which-key buffer was shown in an existing window, `quit-window' 1119 ;; will re-show the previous buffer, instead of closing the window 1120 (quit-windows-on which-key--buffer) 1121 (when (and which-key-preserve-window-configuration 1122 which-key--saved-window-configuration) 1123 (set-window-configuration which-key--saved-window-configuration) 1124 (setq which-key--saved-window-configuration nil)))) 1125 1126 (defun which-key--hide-buffer-frame () 1127 "Hide which-key buffer when frame popup is used." 1128 (when (frame-live-p which-key--frame) 1129 (delete-frame which-key--frame))) 1130 1131 (defun which-key--popup-showing-p () 1132 (and (bufferp which-key--buffer) 1133 (or (window-live-p (get-buffer-window which-key--buffer)) 1134 (let ((window (get-buffer-window which-key--buffer t))) 1135 (and (window-live-p window) 1136 (frame-visible-p (window-frame window))))))) 1137 1138 (defun which-key--show-popup (act-popup-dim) 1139 "Show the which-key buffer. 1140 ACT-POPUP-DIM includes the dimensions, (height . width) of the 1141 buffer text to be displayed in the popup. Return nil if no window 1142 is shown, or if there is no need to start the closing timer." 1143 (when (and (> (car act-popup-dim) 0) 1144 (> (cdr act-popup-dim) 0)) 1145 (cl-case which-key-popup-type 1146 ;; Not called for minibuffer 1147 ;; (minibuffer (which-key--show-buffer-minibuffer act-popup-dim)) 1148 (side-window (which-key--show-buffer-side-window act-popup-dim)) 1149 (frame (which-key--show-buffer-frame act-popup-dim)) 1150 (custom (funcall which-key-custom-show-popup-function act-popup-dim))))) 1151 1152 (defun which-key--fit-buffer-to-window-horizontally 1153 (&optional window &rest params) 1154 "Slightly modified version of `fit-buffer-to-window'. 1155 Use &rest params because `fit-buffer-to-window' has a different 1156 call signature in different emacs versions" 1157 (let ((fit-window-to-buffer-horizontally t) 1158 (window-min-height 1)) 1159 (apply #'fit-window-to-buffer window params))) 1160 1161 (defun which-key--show-buffer-side-window (act-popup-dim) 1162 "Show which-key buffer when popup type is side-window." 1163 (when (and which-key-preserve-window-configuration 1164 (not which-key--saved-window-configuration)) 1165 (setq which-key--saved-window-configuration (current-window-configuration))) 1166 (let* ((height (car act-popup-dim)) 1167 (width (cdr act-popup-dim)) 1168 (alist 1169 (if which-key-allow-imprecise-window-fit 1170 `((window-width . ,(which-key--text-width-to-total width)) 1171 (window-height . ,height) 1172 (side . ,which-key-side-window-location) 1173 (slot . ,which-key-side-window-slot)) 1174 `((window-width . which-key--fit-buffer-to-window-horizontally) 1175 (window-height . (lambda (w) (fit-window-to-buffer w nil 1))) 1176 (side . ,which-key-side-window-location) 1177 (slot . ,which-key-side-window-slot))))) 1178 ;; Previously used `display-buffer-in-major-side-window' here, but 1179 ;; apparently that is meant to be an internal function. See emacs bug #24828 1180 ;; and advice given there. 1181 (cond 1182 ((eq which-key--multiple-locations t) 1183 ;; possibly want to switch sides in this case so we can't reuse the window 1184 (delete-windows-on which-key--buffer) 1185 (display-buffer-in-side-window which-key--buffer alist)) 1186 ((get-buffer-window which-key--buffer) 1187 (display-buffer-reuse-window which-key--buffer alist)) 1188 (t 1189 (display-buffer-in-side-window which-key--buffer alist))))) 1190 1191 (defun which-key--show-buffer-frame (act-popup-dim) 1192 "Show which-key buffer when popup type is frame." 1193 (let* (;(orig-window (selected-window)) 1194 (frame-height (+ (car act-popup-dim) 1195 (if (with-current-buffer which-key--buffer 1196 mode-line-format) 1197 1 1198 0))) 1199 ;; without adding 2, frame sometimes isn't wide enough for the buffer. 1200 ;; this is probably because of the fringes. however, setting fringes 1201 ;; sizes to 0 (instead of adding 2) didn't always make the frame wide 1202 ;; enough. don't know why it is so. 1203 (frame-width (+ (cdr act-popup-dim) 2)) 1204 (new-window (if (and (frame-live-p which-key--frame) 1205 (eq which-key--buffer 1206 (window-buffer 1207 (frame-root-window which-key--frame)))) 1208 (which-key--show-buffer-reuse-frame 1209 frame-height frame-width) 1210 (which-key--show-buffer-new-frame 1211 frame-height frame-width)))) 1212 (when new-window 1213 ;; display successful 1214 (setq which-key--frame (window-frame new-window)) 1215 new-window))) 1216 1217 (defun which-key--show-buffer-new-frame (frame-height frame-width) 1218 "Helper for `which-key--show-buffer-frame'." 1219 (let* ((frame-params `((height . ,frame-height) 1220 (width . ,frame-width) 1221 ;; tell the window manager to respect the given sizes 1222 (user-size . t) 1223 ;; which-key frame doesn't need a minibuffer 1224 (minibuffer . nil) 1225 (name . "which-key") 1226 ;; no need for scroll bars in which-key frame 1227 (vertical-scroll-bars . nil) 1228 ;; (left-fringe . 0) 1229 ;; (right-fringe . 0) 1230 ;; (right-divider-width . 0) 1231 ;; make sure frame is visible 1232 (visibility . t))) 1233 (alist `((pop-up-frame-parameters . ,frame-params))) 1234 (orig-frame (selected-frame)) 1235 (new-window (display-buffer-pop-up-frame which-key--buffer alist))) 1236 (when new-window 1237 ;; display successful 1238 (redirect-frame-focus (window-frame new-window) orig-frame) 1239 new-window))) 1240 1241 (defun which-key--show-buffer-reuse-frame (frame-height frame-width) 1242 "Helper for `which-key--show-buffer-frame'." 1243 (let ((window 1244 (display-buffer-reuse-window 1245 which-key--buffer `((reusable-frames . ,which-key--frame))))) 1246 (when window 1247 ;; display successful 1248 (set-frame-size (window-frame window) frame-width frame-height) 1249 window))) 1250 1251 ;;; Max dimension of available window functions 1252 1253 (defun which-key--popup-max-dimensions () 1254 "Dimesion functions should return the maximum possible (height 1255 . width) of the intended popup. SELECTED-WINDOW-WIDTH is the 1256 width of currently active window, not the which-key buffer 1257 window." 1258 (cl-case which-key-popup-type 1259 (minibuffer (which-key--minibuffer-max-dimensions)) 1260 (side-window (which-key--side-window-max-dimensions)) 1261 (frame (which-key--frame-max-dimensions)) 1262 (custom (funcall which-key-custom-popup-max-dimensions-function 1263 (window-width))))) 1264 1265 (defun which-key--minibuffer-max-dimensions () 1266 "Return max-dimensions of minibuffer (height . width). 1267 Measured in lines and characters respectively." 1268 (cons 1269 ;; height 1270 (if (floatp max-mini-window-height) 1271 (floor (* (frame-text-lines) 1272 max-mini-window-height)) 1273 max-mini-window-height) 1274 ;; width 1275 (max 0 (- (frame-text-cols) which-key-unicode-correction)))) 1276 1277 (defun which-key--side-window-max-dimensions () 1278 "Return max-dimensions of the side-window popup (height . 1279 width) in lines and characters respectively." 1280 (cons 1281 ;; height 1282 (if (member which-key-side-window-location '(left right)) 1283 ;; 1 is a kludge to make sure there is no overlap 1284 (- (frame-height) (window-text-height (minibuffer-window)) 1) 1285 ;; (window-mode-line-height which-key--window)) 1286 ;; FIXME: change to something like 1287 ;; (min which-*-height (calculate-max-height)) 1288 (which-key--height-or-percentage-to-height 1289 which-key-side-window-max-height)) 1290 ;; width 1291 (max 0 1292 (- (if (member which-key-side-window-location '(left right)) 1293 (which-key--total-width-to-text 1294 (which-key--width-or-percentage-to-width 1295 which-key-side-window-max-width)) 1296 (which-key--total-width-to-text 1297 (which-key--width-or-percentage-to-width 1298 1.0))) 1299 which-key-unicode-correction)))) 1300 1301 (defun which-key--frame-max-dimensions () 1302 "Return max-dimensions of the frame popup (height . 1303 width) in lines and characters respectively." 1304 (cons which-key-frame-max-height which-key-frame-max-width)) 1305 1306 ;;; Sorting functions 1307 1308 (defun which-key--string< (a b &optional alpha) 1309 (let ((da (downcase a)) 1310 (db (downcase b))) 1311 (cond 1312 ((and alpha (not which-key-sort-uppercase-first)) 1313 (if (string-equal da db) 1314 (not (string-lessp a b)) 1315 (string-lessp da db))) 1316 ((and alpha which-key-sort-uppercase-first) 1317 (if (string-equal da db) 1318 (string-lessp a b) 1319 (string-lessp da db))) 1320 ((not which-key-sort-uppercase-first) 1321 (let ((aup (not (string-equal da a))) 1322 (bup (not (string-equal db b)))) 1323 (if (eq aup bup) 1324 (string-lessp a b) 1325 bup))) 1326 (t (string-lessp a b))))) 1327 1328 (defun which-key--key-description< (a b &optional alpha) 1329 "Sorting function used for `which-key-key-order' and 1330 `which-key-key-order-alpha'." 1331 (save-match-data 1332 (let* ((a (which-key--extract-key a)) 1333 (b (which-key--extract-key b)) 1334 (rngrgxp "^\\([^ ]+\\) \\.\\. [^ ]+") 1335 (a (if (string-match rngrgxp a) (match-string 1 a) a)) 1336 (b (if (string-match rngrgxp b) (match-string 1 b) b)) 1337 (aem? (string-equal a "")) 1338 (bem? (string-equal b "")) 1339 (a1? (= 1 (length a))) 1340 (b1? (= 1 (length b))) 1341 (srgxp "^\\(RET\\|SPC\\|TAB\\|DEL\\|LFD\\|ESC\\|NUL\\)") 1342 (asp? (string-match-p srgxp a)) 1343 (bsp? (string-match-p srgxp b)) 1344 (prrgxp "^\\(M\\|C\\|S\\|A\\|H\\|s\\)-") 1345 (apr? (string-match-p prrgxp a)) 1346 (bpr? (string-match-p prrgxp b)) 1347 (afn? (string-match-p "<f[0-9]+>" a)) 1348 (bfn? (string-match-p "<f[0-9]+>" b))) 1349 (cond ((or aem? bem?) (and aem? (not bem?))) 1350 ((and asp? bsp?) 1351 (if (string-equal (substring a 0 3) (substring b 0 3)) 1352 (which-key--key-description< 1353 (substring a 3) (substring b 3) alpha) 1354 (which-key--string< a b alpha))) 1355 ((or asp? bsp?) asp?) 1356 ((and a1? b1?) (which-key--string< a b alpha)) 1357 ((or a1? b1?) a1?) 1358 ((and afn? bfn?) 1359 (< (string-to-number 1360 (replace-regexp-in-string "<f\\([0-9]+\\)>" "\\1" a)) 1361 (string-to-number 1362 (replace-regexp-in-string "<f\\([0-9]+\\)>" "\\1" b)))) 1363 ((or afn? bfn?) afn?) 1364 ((and apr? bpr?) 1365 (if (string-equal (substring a 0 2) (substring b 0 2)) 1366 (which-key--key-description< 1367 (substring a 2) (substring b 2) alpha) 1368 (which-key--string< a b alpha))) 1369 ((or apr? bpr?) apr?) 1370 (t (which-key--string< a b alpha)))))) 1371 1372 (defsubst which-key-key-order-alpha (acons bcons) 1373 "Order key descriptions A and B. 1374 Order is lexicographic within a \"class\", where the classes and 1375 the ordering of classes are listed below. 1376 1377 special (SPC,TAB,...) < single char < mod (C-,M-,...) < other. 1378 Sorts single characters alphabetically with lowercase coming 1379 before upper." 1380 (which-key--key-description< (car acons) (car bcons) t)) 1381 1382 (defsubst which-key-key-order (acons bcons) 1383 "Order key descriptions A and B. 1384 Order is lexicographic within a \"class\", where the classes and 1385 the ordering of classes are listed below. 1386 1387 special (SPC,TAB,...) < single char < mod (C-,M-,...) < other." 1388 (which-key--key-description< (car acons) (car bcons))) 1389 1390 (defsubst which-key-description-order (acons bcons) 1391 "Order descriptions of A and B. 1392 Uses `string-lessp' after applying lowercase." 1393 (string-lessp (downcase (cdr acons)) (downcase (cdr bcons)))) 1394 1395 (defsubst which-key--group-p (description) 1396 (or (string-equal description "prefix") 1397 (string-match-p "^group:" description) 1398 (keymapp (intern description)))) 1399 1400 (defun which-key-prefix-then-key-order (acons bcons) 1401 "Order first by whether A and/or B is a prefix with no prefix 1402 coming before a prefix. Within these categories order using 1403 `which-key-key-order'." 1404 (let ((apref? (which-key--group-p (cdr acons))) 1405 (bpref? (which-key--group-p (cdr bcons)))) 1406 (if (not (eq apref? bpref?)) 1407 (and (not apref?) bpref?) 1408 (which-key-key-order acons bcons)))) 1409 1410 (defun which-key-prefix-then-key-order-reverse (acons bcons) 1411 "Order first by whether A and/or B is a prefix with prefix 1412 coming before a prefix. Within these categories order using 1413 `which-key-key-order'." 1414 (let ((apref? (which-key--group-p (cdr acons))) 1415 (bpref? (which-key--group-p (cdr bcons)))) 1416 (if (not (eq apref? bpref?)) 1417 (and apref? (not bpref?)) 1418 (which-key-key-order acons bcons)))) 1419 1420 (defun which-key-local-then-key-order (acons bcons) 1421 "Order first by whether A and/or B is a local binding with 1422 local bindings coming first. Within these categories order using 1423 `which-key-key-order'." 1424 (let ((aloc? (which-key--local-binding-p acons)) 1425 (bloc? (which-key--local-binding-p bcons))) 1426 (if (not (eq aloc? bloc?)) 1427 (and aloc? (not bloc?)) 1428 (which-key-key-order acons bcons)))) 1429 1430 ;;; Functions for retrieving and formatting keys 1431 1432 (defsubst which-key--string-width (maybe-string) 1433 "If MAYBE-STRING is a string use `which-key--string-width' o/w return 0." 1434 (if (stringp maybe-string) (string-width maybe-string) 0)) 1435 1436 (defsubst which-key--butlast-string (str) 1437 (mapconcat #'identity (butlast (split-string str)) " ")) 1438 1439 (defun which-key--match-replacement (key-binding replacement) 1440 ;; these are mode specific ones to ignore. The mode specific case is 1441 ;; handled in the selection of alist 1442 (when (and (consp key-binding) (not (symbolp (car replacement)))) 1443 (let ((key-regexp (caar replacement)) 1444 (binding-regexp (cdar replacement)) 1445 case-fold-search) 1446 (and (or (null key-regexp) 1447 (string-match-p key-regexp 1448 (car key-binding))) 1449 (or (null binding-regexp) 1450 (string-match-p binding-regexp 1451 (cdr key-binding))))))) 1452 1453 (defsubst which-key--replace-in-binding (key-binding repl) 1454 (cond ((or (not (consp repl)) (null (cdr repl))) 1455 key-binding) 1456 ((functionp (cdr repl)) 1457 (funcall (cdr repl) key-binding)) 1458 ((consp (cdr repl)) 1459 (cons 1460 (cond ((and (caar repl) (cadr repl)) 1461 (replace-regexp-in-string 1462 (caar repl) (cadr repl) (car key-binding) t)) 1463 ((cadr repl) (cadr repl)) 1464 (t (car key-binding))) 1465 (cond ((and (cdar repl) (cddr repl)) 1466 (replace-regexp-in-string 1467 (cdar repl) (cddr repl) (cdr key-binding) t)) 1468 ((cddr repl) (cddr repl)) 1469 (t (cdr key-binding))))))) 1470 1471 (defun which-key--replace-in-repl-list-once (key-binding repls) 1472 (cl-dolist (repl repls) 1473 (when (which-key--match-replacement key-binding repl) 1474 (cl-return `(replaced . ,(which-key--replace-in-binding key-binding repl)))))) 1475 1476 (defun which-key--replace-in-repl-list-many (key-binding repls) 1477 (let (found) 1478 (dolist (repl repls) 1479 (when (which-key--match-replacement key-binding repl) 1480 (setq found 't) 1481 (setq key-binding (which-key--replace-in-binding key-binding repl)))) 1482 (when found `(replaced . ,key-binding)))) 1483 1484 (defun which-key--maybe-replace (key-binding) 1485 "Use `which-key--replacement-alist' to maybe replace KEY-BINDING. 1486 KEY-BINDING is a cons cell of the form \(KEY . BINDING\) each of 1487 which are strings. KEY is of the form produced by `key-binding'." 1488 (let* ((replacer (if which-key-allow-multiple-replacements 1489 #'which-key--replace-in-repl-list-many 1490 #'which-key--replace-in-repl-list-once))) 1491 (pcase 1492 (apply replacer 1493 (list key-binding 1494 (cdr-safe (assq major-mode which-key-replacement-alist)))) 1495 (`(replaced . ,repl) 1496 (if which-key-allow-multiple-replacements 1497 (pcase (apply replacer (list repl which-key-replacement-alist)) 1498 (`(replaced . ,repl) repl) 1499 ('() repl)) 1500 repl)) 1501 ('() 1502 (pcase (apply replacer (list key-binding which-key-replacement-alist)) 1503 (`(replaced . ,repl) repl) 1504 ('() key-binding)))))) 1505 1506 (defsubst which-key--current-key-list (&optional key-str) 1507 (append (listify-key-sequence (which-key--current-prefix)) 1508 (when key-str 1509 (listify-key-sequence (kbd key-str))))) 1510 1511 (defsubst which-key--current-key-string (&optional key-str) 1512 (key-description (which-key--current-key-list key-str))) 1513 1514 (defun which-key--local-binding-p (keydesc) 1515 (eq (which-key--safe-lookup-key 1516 (current-local-map) (kbd (which-key--current-key-string (car keydesc)))) 1517 (intern (cdr keydesc)))) 1518 1519 (defun which-key--map-binding-p (map keydesc) 1520 "Does MAP contain KEYDESC = (key . binding)?" 1521 (or 1522 (when (bound-and-true-p evil-state) 1523 (let ((lookup 1524 (which-key--safe-lookup-key 1525 map 1526 (kbd (which-key--current-key-string 1527 (format "<%s-state> %s" evil-state (car keydesc))))))) 1528 (or (eq lookup (intern (cdr keydesc))) 1529 (and (keymapp lookup) (string= (cdr keydesc) "Prefix Command"))))) 1530 (let ((lookup 1531 (which-key--safe-lookup-key 1532 map (kbd (which-key--current-key-string (car keydesc)))))) 1533 (or (eq lookup (intern (cdr keydesc))) 1534 (and (keymapp lookup) (string= (cdr keydesc) "Prefix Command")))))) 1535 1536 (defun which-key--maybe-get-prefix-title (keys) 1537 "KEYS is a string produced by `key-description'. 1538 A title is possibly returned using 1539 `which-key--prefix-title-alist'. An empty string is returned if 1540 no title exists." 1541 (cond 1542 ((not (string-equal keys "")) 1543 (let* ((title-res 1544 (cdr-safe (assoc-string keys which-key--prefix-title-alist))) 1545 (repl-res 1546 (cdr-safe (which-key--maybe-replace (cons keys "")))) 1547 (binding (key-binding (kbd keys))) 1548 (alternate (when (and binding (symbolp binding)) 1549 (symbol-name binding)))) 1550 (cond (title-res title-res) 1551 ((not (string-equal repl-res "")) repl-res) 1552 ((and (eq which-key-show-prefix 'echo) alternate) 1553 alternate) 1554 ((and (member which-key-show-prefix '(bottom top mode-line)) 1555 (eq which-key-side-window-location 'bottom) 1556 echo-keystrokes) 1557 (if alternate alternate 1558 (concat "Following " keys))) 1559 (t "")))) 1560 (t ""))) 1561 1562 (defun which-key--propertize (string &rest properties) 1563 "Version of `propertize' that checks type of STRING." 1564 (when (stringp string) 1565 (apply #'propertize string properties))) 1566 1567 (defun which-key--propertize-key (key) 1568 "Add a face to KEY. 1569 If KEY contains any \"special keys\" defined in 1570 `which-key-special-keys' then truncate and add the corresponding 1571 `which-key-special-key-face'." 1572 (let ((key-w-face (which-key--propertize key 'face 'which-key-key-face)) 1573 (regexp (concat "\\(" 1574 (mapconcat #'identity which-key-special-keys 1575 "\\|") 1576 "\\)")) 1577 case-fold-search) 1578 (save-match-data 1579 (if (and which-key-special-keys 1580 (string-match regexp key)) 1581 (let ((beg (match-beginning 0)) (end (match-end 0))) 1582 (concat (substring key-w-face 0 beg) 1583 (which-key--propertize (substring key-w-face beg (1+ beg)) 1584 'face 'which-key-special-key-face) 1585 (substring key-w-face end 1586 (which-key--string-width key-w-face)))) 1587 key-w-face)))) 1588 1589 (defsubst which-key--truncate-description (desc) 1590 "Truncate DESC description to `which-key-max-description-length'." 1591 (let* ((last-face (get-text-property (1- (length desc)) 'face desc)) 1592 (dots (which-key--propertize which-key-ellipsis 'face last-face))) 1593 (if (and which-key-max-description-length 1594 (> (length desc) which-key-max-description-length)) 1595 (concat (substring desc 0 which-key-max-description-length) dots) 1596 desc))) 1597 1598 (defun which-key--highlight-face (description) 1599 "Return the highlight face for DESCRIPTION if it has one." 1600 (let (face) 1601 (dolist (el which-key-highlighted-command-list) 1602 (unless face 1603 (cond ((consp el) 1604 (when (string-match-p (car el) description) 1605 (setq face (cdr el)))) 1606 ((stringp el) 1607 (when (string-match-p el description) 1608 (setq face 'which-key-highlighted-command-face))) 1609 (t 1610 (message "which-key: warning: element %s of \ 1611 which-key-highlighted-command-list is not a string or a cons 1612 cell" el))))) 1613 face)) 1614 1615 (defun which-key--propertize-description 1616 (description group local hl-face &optional original-description) 1617 "Add face to DESCRIPTION where the face chosen depends on 1618 whether the description represents a group or a command. Also 1619 make some minor adjustments to the description string, like 1620 removing a \"group:\" prefix. 1621 1622 ORIGINAL-DESCRIPTION is the description given by 1623 `describe-buffer-bindings'." 1624 (when description 1625 (let* ((desc description) 1626 (desc (if (string-match-p "^group:" desc) 1627 (substring desc 6) desc)) 1628 (desc (if group (concat which-key-prefix-prefix desc) desc))) 1629 (make-text-button 1630 desc nil 1631 'face (cond (hl-face hl-face) 1632 (group 'which-key-group-description-face) 1633 (local 'which-key-local-map-description-face) 1634 (t 'which-key-command-description-face)) 1635 'help-echo (cond 1636 ((and original-description 1637 (fboundp (intern original-description)) 1638 (documentation (intern original-description)) 1639 ;; tooltip-mode doesn't exist in emacs-nox 1640 (boundp 'tooltip-mode) tooltip-mode) 1641 (documentation (intern original-description))) 1642 ((and original-description 1643 (fboundp (intern original-description)) 1644 (documentation (intern original-description)) 1645 (let* ((doc (documentation 1646 (intern original-description))) 1647 (str (replace-regexp-in-string "\n" " " doc)) 1648 (max (floor (* (frame-width) 0.8)))) 1649 (if (> (length str) max) 1650 (concat (substring str 0 max) "...") 1651 str))))))))) 1652 1653 (defun which-key--extract-key (key-str) 1654 "Pull the last key (or key range) out of KEY-STR." 1655 (save-match-data 1656 (let ((key-range-regexp "\\`.*\\([^ \t]+ \\.\\. [^ \t]+\\)\\'")) 1657 (if (string-match key-range-regexp key-str) 1658 (match-string 1 key-str) 1659 (car (last (split-string key-str " "))))))) 1660 1661 (defun which-key--maybe-add-docstring (current original) 1662 "Maybe concat a docstring to CURRENT and return result. 1663 Specifically, do this if ORIGINAL is a command with a docstring 1664 and `which-key-show-docstrings' is non-nil. If 1665 `which-key-show-docstrings' is the symbol docstring-only, just 1666 return the docstring." 1667 (let* ((orig-sym (intern original)) 1668 (doc (when (commandp orig-sym) 1669 (documentation orig-sym))) 1670 (doc (when doc 1671 (replace-regexp-in-string 1672 (concat "^\\(?::" 1673 (regexp-opt '("around" "override" 1674 "after" "after-until" "after-while" 1675 "before" "before-until" "before-while" 1676 "filter-args" "filter-return")) 1677 " advice: [^\n]+\n" 1678 "\\)+\n") 1679 "" doc))) 1680 (docstring (when doc 1681 (which-key--propertize (car (split-string doc "\n")) 1682 'face 'which-key-docstring-face)))) 1683 (cond ((not (and which-key-show-docstrings docstring)) 1684 current) 1685 ((eq which-key-show-docstrings 'docstring-only) 1686 docstring) 1687 (t 1688 (format "%s %s" current docstring))))) 1689 1690 (defun which-key--format-and-replace (unformatted &optional preserve-full-key) 1691 "Take a list of (key . desc) cons cells in UNFORMATTED, add 1692 faces and perform replacements according to the three replacement 1693 alists. Returns a list (key separator description)." 1694 (let ((sep-w-face 1695 (which-key--propertize which-key-separator 1696 'face 'which-key-separator-face)) 1697 (local-map (current-local-map)) 1698 new-list) 1699 (dolist (key-binding unformatted) 1700 (let* ((keys (car key-binding)) 1701 (orig-desc (cdr key-binding)) 1702 (group (which-key--group-p orig-desc)) 1703 (local (eq (which-key--safe-lookup-key local-map (kbd keys)) 1704 (intern orig-desc))) 1705 (hl-face (which-key--highlight-face orig-desc)) 1706 (key-binding (which-key--maybe-replace key-binding)) 1707 (final-desc (which-key--propertize-description 1708 (cdr key-binding) group local hl-face orig-desc))) 1709 (when final-desc 1710 (setq final-desc 1711 (which-key--truncate-description 1712 (which-key--maybe-add-docstring final-desc orig-desc)))) 1713 (when (consp key-binding) 1714 (push 1715 (list (which-key--propertize-key 1716 (if preserve-full-key 1717 (car key-binding) 1718 (which-key--extract-key (car key-binding)))) 1719 sep-w-face 1720 final-desc) 1721 new-list)))) 1722 (nreverse new-list))) 1723 1724 (defun which-key--compute-binding (binding) 1725 "Replace BINDING with remapped binding if it exists. 1726 1727 Requires `which-key-compute-remaps' to be non-nil" 1728 (let (remap) 1729 (if (and which-key-compute-remaps 1730 (setq remap (command-remapping binding))) 1731 (copy-sequence (symbol-name remap)) 1732 (copy-sequence (symbol-name binding))))) 1733 1734 (defun which-key--get-menu-item-binding (def) 1735 "Retrieve binding for menu-item" 1736 ;; see `keymap--menu-item-binding' 1737 (let* ((binding (nth 2 def)) 1738 (plist (nthcdr 3 def)) 1739 (filter (plist-get plist :filter))) 1740 (if filter (funcall filter binding) binding))) 1741 1742 (defun which-key--get-keymap-bindings-1 1743 (keymap start &optional prefix filter all ignore-commands) 1744 "See `which-key--get-keymap-bindings'." 1745 (let ((bindings start) 1746 (prefix-map (if prefix (lookup-key keymap prefix) keymap))) 1747 (when (keymapp prefix-map) 1748 (map-keymap 1749 (lambda (ev def) 1750 (let* ((key (vconcat prefix (list ev))) 1751 (key-desc (key-description key))) 1752 (cond 1753 ((assoc key-desc bindings)) 1754 ((and (listp ignore-commands) (symbolp def) (memq def ignore-commands))) 1755 ((or (string-match-p 1756 which-key--ignore-non-evil-keys-regexp key-desc) 1757 (eq ev 'menu-bar))) 1758 ((and (keymapp def) 1759 (string-match-p which-key--evil-keys-regexp key-desc))) 1760 ((and (keymapp def) 1761 (or all 1762 ;; event 27 is escape, so this will pick up meta 1763 ;; bindings and hopefully not too much more 1764 (and (numberp ev) (= ev 27)))) 1765 (setq bindings 1766 (which-key--get-keymap-bindings-1 1767 keymap bindings key nil all ignore-commands))) 1768 (def 1769 (let* ((def (if (eq 'menu-item (car-safe def)) 1770 (which-key--get-menu-item-binding def) 1771 def)) 1772 (binding 1773 (cons key-desc 1774 (cond 1775 ((symbolp def) (which-key--compute-binding def)) 1776 ((keymapp def) "prefix") 1777 ((eq 'lambda (car-safe def)) "lambda") 1778 ((eq 'closure (car-safe def)) "closure") 1779 ((stringp def) def) 1780 ((vectorp def) (key-description def)) 1781 ((and (consp def) 1782 ;; looking for (STRING . DEFN) 1783 (stringp (car def))) 1784 (concat (when (keymapp (cdr-safe def)) 1785 "group:") 1786 (car def))) 1787 (t "unknown"))))) 1788 (when (or (null filter) 1789 (and (functionp filter) 1790 (funcall filter binding))) 1791 (push binding bindings))))))) 1792 prefix-map)) 1793 bindings)) 1794 1795 (defun which-key--get-keymap-bindings 1796 (keymap &optional start prefix filter all evil) 1797 "Retrieve top-level bindings from KEYMAP. 1798 PREFIX limits bindings to those starting with this key 1799 sequence. START is a list of existing bindings to add to. If ALL 1800 is non-nil, recursively retrieve all bindings below PREFIX. If 1801 EVIL is non-nil, extract active evil bidings." 1802 (let ((bindings start) 1803 (ignore '(self-insert-command ignore ignore-event company-ignore)) 1804 (evil-map 1805 (when (and evil (bound-and-true-p evil-local-mode)) 1806 (lookup-key keymap (kbd (format "<%s-state>" evil-state)))))) 1807 (when (keymapp evil-map) 1808 (setq bindings (which-key--get-keymap-bindings-1 1809 evil-map bindings prefix filter all ignore))) 1810 (which-key--get-keymap-bindings-1 1811 keymap bindings prefix filter all ignore))) 1812 1813 (defun which-key--get-current-bindings (&optional prefix filter) 1814 "Generate a list of current active bindings." 1815 (let (bindings) 1816 (dolist (map (current-active-maps t) bindings) 1817 (when (cdr map) 1818 (setq bindings 1819 (which-key--get-keymap-bindings 1820 map bindings prefix filter)))))) 1821 1822 (defun which-key--get-bindings (&optional prefix keymap filter recursive) 1823 "Collect key bindings. 1824 If KEYMAP is nil, collect from current buffer using the current 1825 key sequence as a prefix. Otherwise, collect from KEYMAP. FILTER 1826 is a function to use to filter the bindings. If RECURSIVE is 1827 non-nil, then bindings are collected recursively for all prefixes." 1828 (let* ((unformatted 1829 (cond ((keymapp keymap) 1830 (which-key--get-keymap-bindings 1831 keymap nil prefix filter recursive)) 1832 (keymap 1833 (error "%s is not a keymap" keymap)) 1834 (t 1835 (which-key--get-current-bindings prefix filter))))) 1836 (when which-key-sort-order 1837 (setq unformatted 1838 (sort unformatted which-key-sort-order))) 1839 (which-key--format-and-replace unformatted recursive))) 1840 1841 ;;; Functions for laying out which-key buffer pages 1842 1843 (defun which-key--normalize-columns (columns) 1844 "Pad COLUMNS to the same length using empty strings." 1845 (let ((max-len (cl-reduce (lambda (a x) (max a (length x))) columns 1846 :initial-value 0))) 1847 (mapcar 1848 (lambda (c) 1849 (if (< (length c) max-len) 1850 (append c (make-list (- max-len (length c)) "")) 1851 c)) 1852 columns))) 1853 1854 (defsubst which-key--join-columns (columns) 1855 "Transpose columns into rows, concat rows into lines and rows into page." 1856 (let* ((padded (which-key--normalize-columns (nreverse columns))) 1857 (rows (apply #'cl-mapcar #'list padded))) 1858 (mapconcat (lambda (row) (mapconcat #'identity row " ")) rows "\n"))) 1859 1860 (defsubst which-key--max-len (keys index &optional initial-value) 1861 "Internal function for finding the max length of the INDEX 1862 element in each list element of KEYS." 1863 (cl-reduce 1864 (lambda (x y) (max x (which-key--string-width (nth index y)))) 1865 keys :initial-value (if initial-value initial-value 0))) 1866 1867 (defun which-key--pad-column (col-keys) 1868 "Take a column of (key separator description) COL-KEYS, 1869 calculate the max width in the column and pad all cells out to 1870 that width." 1871 (let* ((col-key-width (+ which-key-add-column-padding 1872 (which-key--max-len col-keys 0))) 1873 (col-sep-width (which-key--max-len col-keys 1)) 1874 (col-desc-width (which-key--max-len 1875 col-keys 2 which-key-min-column-description-width)) 1876 (col-width (+ 1 col-key-width col-sep-width col-desc-width))) 1877 (cons col-width 1878 (mapcar (lambda (k) 1879 (format (concat "%" (int-to-string col-key-width) 1880 "s%s%-" (int-to-string col-desc-width) "s") 1881 (nth 0 k) (nth 1 k) (nth 2 k))) 1882 col-keys)))) 1883 1884 (defun which-key--partition-list (n list) 1885 "Partition LIST into N-sized sublists." 1886 (let (res) 1887 (while list 1888 (setq res (cons (cl-subseq list 0 (min n (length list))) res) 1889 list (nthcdr n list))) 1890 (nreverse res))) 1891 1892 (defun which-key--list-to-pages (keys avl-lines avl-width) 1893 "Convert list of KEYS to columns based on dimensions AVL-LINES and AVL-WIDTH. 1894 Returns a `which-key--pages' object that holds the page strings, 1895 as well as metadata." 1896 (let ((cols-w-widths (mapcar #'which-key--pad-column 1897 (which-key--partition-list avl-lines keys))) 1898 (page-width 0) (n-pages 0) (n-keys 0) (n-columns 0) 1899 page-cols pages page-widths keys/page col) 1900 (if (> (apply #'max (mapcar #'car cols-w-widths)) avl-width) 1901 ;; give up if no columns fit 1902 nil 1903 (while cols-w-widths 1904 ;; start new page 1905 (cl-incf n-pages) 1906 (setq col (pop cols-w-widths)) 1907 (setq page-cols (list (cdr col))) 1908 (setq page-width (car col)) 1909 (setq n-keys (length (cdr col))) 1910 (setq n-columns 1) 1911 ;; add additional columns as long as they fit 1912 (while (and cols-w-widths 1913 (or (null which-key-max-display-columns) 1914 (< n-columns which-key-max-display-columns)) 1915 (<= (+ (caar cols-w-widths) page-width) avl-width)) 1916 (setq col (pop cols-w-widths)) 1917 (push (cdr col) page-cols) 1918 (cl-incf page-width (car col)) 1919 (cl-incf n-keys (length (cdr col))) 1920 (cl-incf n-columns)) 1921 (push (which-key--join-columns page-cols) pages) 1922 (push n-keys keys/page) 1923 (push page-width page-widths)) 1924 (make-which-key--pages 1925 :pages (nreverse pages) 1926 :height (if (> n-pages 1) avl-lines (min avl-lines n-keys)) 1927 :widths (nreverse page-widths) 1928 :keys/page (reverse keys/page) 1929 :page-nums (number-sequence 1 n-pages) 1930 :num-pages n-pages 1931 :total-keys (apply #'+ keys/page))))) 1932 1933 (defun which-key--create-pages-1 1934 (keys available-lines available-width &optional min-lines vertical) 1935 "Create page strings using `which-key--list-to-pages'. 1936 Will try to find the best number of rows and columns using the 1937 given dimensions and the length and widths of ITEMS. Use VERTICAL 1938 if the ITEMS are laid out vertically and the number of columns 1939 should be minimized." 1940 (let ((result (which-key--list-to-pages 1941 keys available-lines available-width)) 1942 (min-lines (or min-lines 0)) 1943 found prev-result) 1944 (if (or (null result) 1945 vertical 1946 (> (which-key--pages-num-pages result) 1) 1947 (= 1 available-lines)) 1948 result 1949 ;; simple search for a fitting page 1950 (while (and (> available-lines min-lines) 1951 (not found)) 1952 (setq available-lines (- available-lines 1) 1953 prev-result result 1954 result (which-key--list-to-pages 1955 keys available-lines available-width) 1956 found (> (which-key--pages-num-pages result) 1))) 1957 (if found prev-result result)))) 1958 1959 (defun which-key--create-pages (keys &optional prefix-keys prefix-title) 1960 "Create page strings using `which-key--list-to-pages'. 1961 Will try to find the best number of rows and columns using the 1962 given dimensions and the length and wdiths of KEYS. SEL-WIN-WIDTH 1963 is the width of the live window." 1964 (let* ((max-dims (which-key--popup-max-dimensions)) 1965 (max-lines (car max-dims)) 1966 (max-width (cdr max-dims)) 1967 (prefix-desc (key-description prefix-keys)) 1968 (full-prefix (which-key--full-prefix prefix-desc)) 1969 (prefix (when (eq which-key-show-prefix 'left) 1970 (+ 2 (which-key--string-width full-prefix)))) 1971 (prefix-top-bottom (member which-key-show-prefix '(bottom top))) 1972 (avl-lines (if prefix-top-bottom (- max-lines 1) max-lines)) 1973 (min-lines (min avl-lines which-key-min-display-lines)) 1974 (avl-width (if prefix (- max-width prefix) max-width)) 1975 (vertical (and (eq which-key-popup-type 'side-window) 1976 (member which-key-side-window-location '(left right)))) 1977 result) 1978 (setq result 1979 (which-key--create-pages-1 1980 keys avl-lines avl-width min-lines vertical)) 1981 (when (and result 1982 (> (which-key--pages-num-pages result) 0)) 1983 (setf (which-key--pages-prefix result) prefix-keys) 1984 (setf (which-key--pages-prefix-title result) 1985 (or prefix-title 1986 (which-key--maybe-get-prefix-title 1987 (key-description prefix-keys)))) 1988 (when (and (= (which-key--pages-num-pages result) 1) 1989 (> which-key-min-display-lines 1990 (which-key--pages-height result))) 1991 ;; result is shorter than requested, so we artificially increase the 1992 ;; height. See #325. Note this only has an effect if 1993 ;; `which-key-allow-imprecise-window-fit' is non-nil. 1994 (setf (which-key--pages-height result) which-key-min-display-lines)) 1995 (which-key--debug-message "Frame height: %s 1996 Minibuffer height: %s 1997 Max dimensions: (%s,%s) 1998 Available for bindings: (%s,%s) 1999 Actual lines: %s" (frame-height) (window-text-height (minibuffer-window)) 2000 max-lines max-width avl-lines avl-width (which-key--pages-height result)) 2001 result))) 2002 2003 (defun which-key--lighter-status () 2004 "Possibly show number of keys and total in the mode line." 2005 (when which-key-show-remaining-keys 2006 (let ((n-shown (car (which-key--pages-keys/page which-key--pages-obj))) 2007 (n-tot (which-key--pages-total-keys which-key--pages-obj))) 2008 (setcar (cdr (assq 'which-key-mode minor-mode-alist)) 2009 (format " WK: %s/%s keys" n-shown n-tot))))) 2010 2011 (defun which-key--lighter-restore () 2012 "Restore the lighter for which-key." 2013 (when which-key-show-remaining-keys 2014 (setcar (cdr (assq 'which-key-mode minor-mode-alist)) 2015 which-key-lighter))) 2016 2017 (defun which-key--echo (text) 2018 "Echo TEXT to minibuffer without logging." 2019 (let (message-log-max) 2020 (message "%s" text))) 2021 2022 (defun which-key--next-page-hint (prefix-keys) 2023 "Return string for next page hint." 2024 (let* ((paging-key (concat prefix-keys " " which-key-paging-key)) 2025 (paging-key-bound (eq 'which-key-C-h-dispatch 2026 (key-binding (kbd paging-key)))) 2027 (key (key-description (vector help-char))) 2028 (key (if paging-key-bound 2029 (concat key " or " which-key-paging-key) 2030 key))) 2031 (when (and which-key-use-C-h-commands 2032 (not (equal (vector help-char) 2033 (vconcat (kbd prefix-keys))))) 2034 (which-key--propertize (format "[%s paging/help]" key) 2035 'face 'which-key-note-face)))) 2036 2037 (eval-and-compile 2038 (if (fboundp 'universal-argument--description) 2039 (defalias 'which-key--universal-argument--description 2040 #'universal-argument--description) 2041 (defun which-key--universal-argument--description () 2042 ;; Backport of the definition of universal-argument--description in 2043 ;; emacs25 on 2015-12-04 2044 (when prefix-arg 2045 (concat "C-u" 2046 (pcase prefix-arg 2047 (`(-) " -") 2048 (`(,(and (pred integerp) n)) 2049 (let ((str "")) 2050 (while (and (> n 4) (= (mod n 4) 0)) 2051 (setq str (concat str " C-u")) 2052 (setq n (/ n 4))) 2053 (if (= n 4) str (format " %s" prefix-arg)))) 2054 (_ (format " %s" prefix-arg)))))))) 2055 2056 (defun which-key--full-prefix (prefix-keys &optional -prefix-arg dont-prop-keys) 2057 "Return a description of the full key sequence up to now, 2058 including prefix arguments." 2059 (let* ((left (eq which-key-show-prefix 'left)) 2060 (prefix-arg (if -prefix-arg -prefix-arg prefix-arg)) 2061 (str (concat 2062 (which-key--universal-argument--description) 2063 (when prefix-arg " ") 2064 prefix-keys)) 2065 (dash (if (and (not (string= prefix-keys "")) 2066 (null left)) "-" ""))) 2067 (if (or (eq which-key-show-prefix 'echo) dont-prop-keys) 2068 (concat str dash) 2069 (concat (which-key--propertize-key str) 2070 (which-key--propertize dash 'face 'which-key-key-face))))) 2071 2072 (defun which-key--get-popup-map () 2073 "Generate transient-map for use in the top level binding display." 2074 (unless which-key--automatic-display 2075 (let ((map (make-sparse-keymap))) 2076 (define-key map (kbd which-key-paging-key) #'which-key-C-h-dispatch) 2077 (when which-key-use-C-h-commands 2078 ;; Show next page even when C-h is pressed 2079 (define-key map (vector help-char) #'which-key-C-h-dispatch)) 2080 map))) 2081 2082 (defun which-key--process-page (pages-obj) 2083 "Add information to the basic list of key bindings, including 2084 if applicable the current prefix, the name of the current prefix, 2085 and a page count." 2086 (let* ((page (car (which-key--pages-pages pages-obj))) 2087 (height (which-key--pages-height pages-obj)) 2088 (n-pages (which-key--pages-num-pages pages-obj)) 2089 (page-n (car (which-key--pages-page-nums pages-obj))) 2090 (prefix-desc (key-description (which-key--pages-prefix pages-obj))) 2091 (prefix-title (which-key--pages-prefix-title pages-obj)) 2092 (full-prefix (which-key--full-prefix prefix-desc)) 2093 (nxt-pg-hint (which-key--next-page-hint prefix-desc)) 2094 ;; not used in left case 2095 (status-line 2096 (concat (which-key--propertize prefix-title 'face 'which-key-note-face) 2097 (when (< 1 n-pages) 2098 (which-key--propertize (format " (%s of %s)" page-n n-pages) 2099 'face 'which-key-note-face))))) 2100 (pcase which-key-show-prefix 2101 (`left 2102 (let* ((page-cnt (which-key--propertize (format "%s/%s" page-n n-pages) 2103 'face 'which-key-separator-face)) 2104 (first-col-width (+ 2 (max (which-key--string-width full-prefix) 2105 (which-key--string-width page-cnt)))) 2106 (prefix (format (concat "%-" (int-to-string first-col-width) "s") 2107 full-prefix)) 2108 (page-cnt (if (> n-pages 1) 2109 (format 2110 (concat "%-" (int-to-string first-col-width) "s") 2111 page-cnt) 2112 (make-string first-col-width 32))) 2113 lines first-line new-end) 2114 (if (= 1 height) 2115 (cons (concat prefix page) nil) 2116 (setq lines (split-string page "\n") 2117 first-line (concat prefix (car lines) "\n" page-cnt) 2118 new-end (concat "\n" (make-string first-col-width 32))) 2119 (cons 2120 (concat first-line (mapconcat #'identity (cdr lines) new-end)) 2121 nil)))) 2122 (`top 2123 (cons 2124 (concat (when (or (= 0 echo-keystrokes) 2125 (not (eq which-key-side-window-location 'bottom))) 2126 (concat full-prefix " ")) 2127 status-line " " nxt-pg-hint "\n" page) 2128 nil)) 2129 (`bottom 2130 (cons 2131 (concat page "\n" 2132 (when (or (= 0 echo-keystrokes) 2133 (not (eq which-key-side-window-location 'bottom))) 2134 (concat full-prefix " ")) 2135 status-line " " nxt-pg-hint) 2136 nil)) 2137 (`echo 2138 (cons page 2139 (lambda () 2140 (which-key--echo 2141 (concat full-prefix (when prefix-desc " ") 2142 status-line (when status-line " ") 2143 nxt-pg-hint))))) 2144 (`mode-line 2145 (cons page 2146 (lambda () 2147 (with-current-buffer which-key--buffer 2148 (setq-local mode-line-format 2149 (concat " " full-prefix 2150 " " status-line 2151 " " nxt-pg-hint)))))) 2152 (_ (cons page nil))))) 2153 2154 (defun which-key--show-page (&optional n) 2155 "Show current page. 2156 N changes the current page to the Nth page relative to the 2157 current one." 2158 (which-key--init-buffer) ;; in case it was killed 2159 (let ((prefix-keys (which-key--current-key-string)) 2160 golden-ratio-mode) 2161 (if (null which-key--pages-obj) 2162 (message "%s- which-key can't show keys: There is not \ 2163 enough space based on your settings and frame size." prefix-keys) 2164 (when n 2165 (setq which-key--pages-obj 2166 (which-key--pages-set-current-page which-key--pages-obj n))) 2167 (let ((page-echo (which-key--process-page which-key--pages-obj)) 2168 (height (which-key--pages-height which-key--pages-obj)) 2169 (width (car (which-key--pages-widths which-key--pages-obj)))) 2170 (which-key--lighter-status) 2171 (if (eq which-key-popup-type 'minibuffer) 2172 (which-key--echo (car page-echo)) 2173 (with-current-buffer which-key--buffer 2174 (erase-buffer) 2175 (insert (car page-echo)) 2176 (goto-char (point-min))) 2177 (when (cdr page-echo) (funcall (cdr page-echo))) 2178 (which-key--show-popup (cons height width))))) 2179 ;; used for paging at top-level 2180 (if (fboundp 'set-transient-map) 2181 (set-transient-map (which-key--get-popup-map)) 2182 (with-no-warnings 2183 (set-temporary-overlay-map (which-key--get-popup-map)))))) 2184 2185 ;;; Paging functions 2186 2187 ;;;###autoload 2188 (defun which-key-reload-key-sequence (&optional key-seq) 2189 "Simulate entering the key sequence KEY-SEQ. 2190 KEY-SEQ should be a list of events as produced by 2191 `listify-key-sequence'. If nil, KEY-SEQ defaults to 2192 `which-key--current-key-list'. Any prefix arguments that were 2193 used are reapplied to the new key sequence." 2194 (let* ((key-seq (or key-seq (which-key--current-key-list))) 2195 (next-event (mapcar (lambda (ev) (cons t ev)) key-seq))) 2196 (setq prefix-arg current-prefix-arg 2197 unread-command-events next-event))) 2198 2199 (defun which-key-turn-page (delta) 2200 "Show the next page of keys." 2201 (which-key-reload-key-sequence) 2202 (if which-key--last-try-2-loc 2203 (let ((which-key-side-window-location which-key--last-try-2-loc) 2204 (which-key--multiple-locations t)) 2205 (which-key--show-page delta)) 2206 (which-key--show-page delta)) 2207 (which-key--start-paging-timer)) 2208 2209 ;;;###autoload 2210 (defun which-key-show-standard-help (&optional _) 2211 "Call the command in `which-key--prefix-help-cmd-backup'. 2212 Usually this is `describe-prefix-bindings'." 2213 (interactive) 2214 (let ((which-key-inhibit t) 2215 (popup-showing (which-key--popup-showing-p))) 2216 (which-key--hide-popup-ignore-command) 2217 (cond ((and (eq which-key--prefix-help-cmd-backup 2218 'describe-prefix-bindings) 2219 ;; If the popup is not showing, we call 2220 ;; `describe-prefix-bindings' directly. 2221 popup-showing) 2222 ;; This is essentially what `describe-prefix-bindings' does. We can't 2223 ;; use this function directly, because the prefix will not be correct 2224 ;; when we enter using `which-key-C-h-dispatch'. 2225 (describe-bindings (kbd (which-key--current-key-string)))) 2226 ((functionp which-key--prefix-help-cmd-backup) 2227 (funcall which-key--prefix-help-cmd-backup))))) 2228 2229 ;;;###autoload 2230 (defun which-key-show-next-page-no-cycle () 2231 "Show next page of keys unless on the last page, in which case 2232 call `which-key-show-standard-help'." 2233 (interactive) 2234 (let ((which-key-inhibit t)) 2235 (if (which-key--on-last-page) 2236 (which-key-show-standard-help) 2237 (which-key-turn-page 1)))) 2238 2239 ;;;###autoload 2240 (defun which-key-show-previous-page-no-cycle () 2241 "Show previous page of keys unless on the first page, in which 2242 case do nothing." 2243 (interactive) 2244 (let ((which-key-inhibit t)) 2245 (unless (which-key--on-first-page) 2246 (which-key-turn-page -1)))) 2247 2248 ;;;###autoload 2249 (defun which-key-show-next-page-cycle (&optional _) 2250 "Show the next page of keys, cycling from end to beginning 2251 after last page." 2252 (interactive) 2253 (let ((which-key-inhibit t)) 2254 (which-key-turn-page 1))) 2255 2256 ;;;###autoload 2257 (defun which-key-show-previous-page-cycle (&optional _) 2258 "Show the previous page of keys, cycling from beginning to end 2259 after first page." 2260 (interactive) 2261 (let ((which-key-inhibit t)) 2262 (which-key-turn-page -1))) 2263 2264 ;;;###autoload 2265 (defun which-key-show-top-level (&optional _) 2266 "Show top-level bindings." 2267 (interactive) 2268 (which-key--create-buffer-and-show nil nil nil "Top-level bindings")) 2269 2270 ;;;###autoload 2271 (defun which-key-show-major-mode (&optional all) 2272 "Show top-level bindings in the map of the current major mode. 2273 2274 This function will also detect evil bindings made using 2275 `evil-define-key' in this map. These bindings will depend on the 2276 current evil state. " 2277 (interactive "P") 2278 (let ((map-sym (intern (format "%s-map" major-mode)))) 2279 (if (and (boundp map-sym) (keymapp (symbol-value map-sym))) 2280 (which-key--show-keymap 2281 "Major-mode bindings" 2282 (symbol-value map-sym) 2283 (apply-partially #'which-key--map-binding-p (symbol-value map-sym)) 2284 all) 2285 (message "which-key: No map named %s" map-sym)))) 2286 2287 ;;;###autoload 2288 (defun which-key-show-full-major-mode () 2289 "Show all bindings in the map of the current major mode. 2290 2291 This function will also detect evil bindings made using 2292 `evil-define-key' in this map. These bindings will depend on the 2293 current evil state. " 2294 (interactive) 2295 (which-key-show-major-mode t)) 2296 2297 ;;;###autoload 2298 (defun which-key-dump-bindings (prefix buffer-name) 2299 "Dump bindings from PREFIX into buffer named BUFFER-NAME. 2300 2301 PREFIX should be a string suitable for `kbd'." 2302 (interactive "sPrefix: \nB") 2303 (let* ((buffer (get-buffer-create buffer-name)) 2304 (keys (which-key--get-bindings (kbd prefix)))) 2305 (with-current-buffer buffer 2306 (point-max) 2307 (save-excursion 2308 (dolist (key keys) 2309 (insert (apply #'format "%s%s%s\n" key))))) 2310 (switch-to-buffer-other-window buffer))) 2311 2312 ;;;###autoload 2313 (defun which-key-undo-key (&optional _) 2314 "Undo last keypress and force which-key update." 2315 (interactive) 2316 (let* ((key-lst (butlast (which-key--current-key-list))) 2317 (which-key-inhibit t)) 2318 (cond (which-key--prior-show-keymap-args 2319 (if (keymapp (cdr (car-safe which-key--prior-show-keymap-args))) 2320 (let ((args (pop which-key--prior-show-keymap-args))) 2321 (which-key--show-keymap (car args) (cdr args))) 2322 (which-key--hide-popup))) 2323 (key-lst 2324 (which-key-reload-key-sequence key-lst) 2325 (which-key--create-buffer-and-show (apply #'vector key-lst))) 2326 (t (setq which-key--automatic-display nil) 2327 (which-key-show-top-level))))) 2328 (defalias 'which-key-undo #'which-key-undo-key) 2329 2330 (defun which-key-abort (&optional _) 2331 "Abort key sequence." 2332 (interactive) 2333 (let ((which-key-inhibit t)) 2334 (which-key--hide-popup-ignore-command) 2335 (keyboard-quit))) 2336 2337 (defun which-key-digit-argument (key) 2338 "Version of `digit-argument' for use in `which-key-C-h-map'." 2339 (interactive) 2340 (let ((last-command-event (string-to-char key))) 2341 (digit-argument key)) 2342 (let ((current-prefix-arg prefix-arg)) 2343 (which-key-reload-key-sequence))) 2344 2345 (defun which-key-toggle-docstrings (&optional _) 2346 "Toggle the display of docstrings." 2347 (interactive) 2348 (unless (eq which-key-show-docstrings 'docstring-only) 2349 (setq which-key-show-docstrings (null which-key-show-docstrings))) 2350 (which-key-reload-key-sequence) 2351 (which-key--create-buffer-and-show (which-key--current-prefix))) 2352 2353 ;;;###autoload 2354 (defun which-key-C-h-dispatch () 2355 "Dispatch C-h commands by looking up key in 2356 `which-key-C-h-map'. This command is always accessible (from any 2357 prefix) if `which-key-use-C-h-commands' is non nil." 2358 (interactive) 2359 (cond ((and (not (which-key--popup-showing-p)) 2360 which-key-show-early-on-C-h) 2361 (let ((current-prefix 2362 (butlast 2363 (listify-key-sequence (which-key--this-command-keys))))) 2364 (which-key-reload-key-sequence current-prefix) 2365 (if which-key-idle-secondary-delay 2366 (which-key--start-timer which-key-idle-secondary-delay t) 2367 (which-key--start-timer 0.05 t)))) 2368 ((not (which-key--popup-showing-p)) 2369 (which-key-show-standard-help)) 2370 (t 2371 (if (not (which-key--popup-showing-p)) 2372 (which-key-show-standard-help) 2373 (let* ((prefix-keys (which-key--current-key-string)) 2374 (full-prefix (which-key--full-prefix prefix-keys current-prefix-arg t)) 2375 (prompt (concat (when (string-equal prefix-keys "") 2376 (which-key--propertize 2377 (concat " " 2378 (which-key--pages-prefix-title 2379 which-key--pages-obj)) 2380 'face 'which-key-note-face)) 2381 full-prefix 2382 (which-key--propertize 2383 (substitute-command-keys 2384 (concat 2385 " \\<which-key-C-h-map>" 2386 " \\[which-key-show-next-page-cycle]" 2387 which-key-separator "next-page," 2388 " \\[which-key-show-previous-page-cycle]" 2389 which-key-separator "previous-page," 2390 " \\[which-key-undo-key]" 2391 which-key-separator "undo-key," 2392 " \\[which-key-toggle-docstrings]" 2393 which-key-separator "toggle-docstrings," 2394 " \\[which-key-show-standard-help]" 2395 which-key-separator "help," 2396 " \\[which-key-abort]" 2397 which-key-separator "abort" 2398 " 1..9" 2399 which-key-separator "digit-arg")) 2400 'face 'which-key-note-face))) 2401 (key (let ((key (read-key prompt))) 2402 (if (numberp key) 2403 (string key) 2404 (vector key)))) 2405 (cmd (lookup-key which-key-C-h-map key)) 2406 (which-key-inhibit t)) 2407 (if cmd (funcall cmd key) (which-key-turn-page 0))))))) 2408 2409 ;;; Update 2410 2411 (defun which-key--any-match-p (regexps string) 2412 "Non-nil if any of REGEXPS match STRING." 2413 (catch 'match 2414 (dolist (regexp regexps) 2415 (when (string-match-p regexp string) 2416 (throw 'match t))))) 2417 2418 (defun which-key--try-2-side-windows 2419 (bindings prefix-keys prefix-title loc1 loc2 &rest _ignore) 2420 "Try to show BINDINGS (PAGE-N) in LOC1 first. 2421 2422 Only if no bindings fit fallback to LOC2." 2423 (let (pages1) 2424 (let ((which-key-side-window-location loc1) 2425 (which-key--multiple-locations t)) 2426 (setq pages1 (which-key--create-pages 2427 bindings prefix-keys prefix-title))) 2428 (if pages1 2429 (progn 2430 (setq which-key--pages-obj pages1) 2431 (let ((which-key-side-window-location loc1) 2432 (which-key--multiple-locations t)) 2433 (which-key--show-page)) 2434 loc1) 2435 (let ((which-key-side-window-location loc2) 2436 (which-key--multiple-locations t)) 2437 (setq which-key--pages-obj 2438 (which-key--create-pages bindings prefix-keys prefix-title)) 2439 (which-key--show-page) 2440 loc2)))) 2441 2442 (defun which-key--read-keymap () 2443 "Read keymap symbol from minibuffer." 2444 (intern 2445 (completing-read "Keymap: " obarray 2446 (lambda (m) 2447 (and (boundp m) 2448 (keymapp (symbol-value m)) 2449 (not (equal (symbol-value m) 2450 (make-sparse-keymap))))) 2451 t 2452 (let ((sym (symbol-at-point))) 2453 (and (boundp sym) 2454 (keymapp (symbol-value sym)) 2455 (symbol-name sym))) 2456 'which-key-keymap-history))) 2457 2458 ;;;###autoload 2459 (defun which-key-show-keymap (keymap &optional no-paging) 2460 "Show the top-level bindings in KEYMAP using which-key. 2461 KEYMAP is selected interactively from all available keymaps. 2462 2463 If NO-PAGING is non-nil, which-key will not intercept subsequent 2464 keypresses for the paging functionality." 2465 (interactive (list (which-key--read-keymap))) 2466 (which-key--show-keymap (symbol-name keymap) 2467 (symbol-value keymap) 2468 nil nil no-paging)) 2469 2470 ;;;###autoload 2471 (defun which-key-show-full-keymap (keymap) 2472 "Show all bindings in KEYMAP using which-key. 2473 KEYMAP is selected interactively from all available keymaps." 2474 (interactive (list (which-key--read-keymap))) 2475 (which-key--show-keymap (symbol-name keymap) 2476 (symbol-value keymap) 2477 nil t)) 2478 2479 ;;;###autoload 2480 (defun which-key-show-minor-mode-keymap (&optional all) 2481 "Show the top-level bindings in KEYMAP using which-key. 2482 KEYMAP is selected interactively by mode in 2483 `minor-mode-map-alist'." 2484 (interactive) 2485 (let ((mode-sym 2486 (intern 2487 (completing-read 2488 "Minor Mode: " 2489 (mapcar #'car 2490 (cl-remove-if-not 2491 (lambda (entry) 2492 (and (symbol-value (car entry)) 2493 (not (equal (cdr entry) (make-sparse-keymap))))) 2494 minor-mode-map-alist)) 2495 nil t nil 'which-key-keymap-history)))) 2496 (which-key--show-keymap (symbol-name mode-sym) 2497 (cdr (assq mode-sym minor-mode-map-alist)) 2498 all))) 2499 ;;;###autoload 2500 (defun which-key-show-full-minor-mode-keymap () 2501 "Show all bindings in KEYMAP using which-key. 2502 KEYMAP is selected interactively by mode in 2503 `minor-mode-map-alist'." 2504 (interactive) 2505 (which-key-show-minor-mode-keymap t)) 2506 2507 (defun which-key--show-keymap 2508 (keymap-name keymap &optional prior-args all no-paging filter) 2509 (when prior-args (push prior-args which-key--prior-show-keymap-args)) 2510 (let ((bindings (which-key--get-bindings nil keymap filter all))) 2511 (if (= (length bindings) 0) 2512 (message "which-key: No bindings found in %s" keymap-name) 2513 (cond ((listp which-key-side-window-location) 2514 (setq which-key--last-try-2-loc 2515 (apply #'which-key--try-2-side-windows 2516 bindings nil keymap-name 2517 which-key-side-window-location))) 2518 (t (setq which-key--pages-obj 2519 (which-key--create-pages bindings nil keymap-name)) 2520 (which-key--show-page))) 2521 (unless no-paging 2522 (let* ((key (read-key)) 2523 (key-desc (key-description (list key))) 2524 (next-def (lookup-key keymap (vector key)))) 2525 (cond ((and which-key-use-C-h-commands 2526 (numberp key) (= key help-char)) 2527 (which-key-C-h-dispatch)) 2528 ((keymapp next-def) 2529 (which-key--hide-popup-ignore-command) 2530 (which-key--show-keymap 2531 (concat keymap-name " " key-desc) 2532 next-def 2533 (cons keymap-name keymap))) 2534 (t (which-key--hide-popup)))))))) 2535 2536 (defun which-key--evil-operator-filter (binding) 2537 (let ((def (intern (cdr binding)))) 2538 (and (functionp def) 2539 (not (evil-get-command-property def :suppress-operator))))) 2540 2541 (defun which-key--show-evil-operator-keymap () 2542 (if which-key--inhibit-next-operator-popup 2543 (setq which-key--inhibit-next-operator-popup nil) 2544 (let ((keymap 2545 (make-composed-keymap (list evil-operator-shortcut-map 2546 evil-operator-state-map 2547 evil-motion-state-map)))) 2548 (when (keymapp keymap) 2549 (let ((formatted-keys 2550 (which-key--get-bindings 2551 nil keymap #'which-key--evil-operator-filter))) 2552 (cond ((= (length formatted-keys) 0) 2553 (message "which-key: Keymap empty")) 2554 ((listp which-key-side-window-location) 2555 (setq which-key--last-try-2-loc 2556 (apply #'which-key--try-2-side-windows 2557 formatted-keys nil "evil operator/motion keys" 2558 which-key-side-window-location))) 2559 (t (setq which-key--pages-obj 2560 (which-key--create-pages 2561 formatted-keys 2562 nil "evil operator/motion keys")) 2563 (which-key--show-page))))) 2564 (let* ((key (read-key))) 2565 (when (member key '(?f ?F ?t ?T ?`)) 2566 ;; these keys trigger commands that read the next char manually 2567 (setq which-key--inhibit-next-operator-popup t)) 2568 (cond ((and which-key-use-C-h-commands (numberp key) (= key help-char)) 2569 (which-key-C-h-dispatch)) 2570 ((and (numberp key) (= key ?\C-\[)) 2571 (which-key--hide-popup) 2572 (keyboard-quit)) 2573 (t 2574 (which-key--hide-popup) 2575 (setq unread-command-events (vector key)))))))) 2576 2577 (defun which-key--create-buffer-and-show 2578 (&optional prefix-keys from-keymap filter prefix-title) 2579 "Fill `which-key--buffer' with key descriptions and reformat. 2580 Finally, show the buffer." 2581 (let ((start-time (current-time)) 2582 (formatted-keys (which-key--get-bindings 2583 prefix-keys from-keymap filter)) 2584 (prefix-desc (key-description prefix-keys))) 2585 (cond ((= (length formatted-keys) 0) 2586 (message "%s- which-key: There are no keys to show" prefix-desc)) 2587 ((listp which-key-side-window-location) 2588 (setq which-key--last-try-2-loc 2589 (apply #'which-key--try-2-side-windows 2590 formatted-keys prefix-keys prefix-title 2591 which-key-side-window-location))) 2592 (t (setq which-key--pages-obj 2593 (which-key--create-pages 2594 formatted-keys prefix-keys prefix-title)) 2595 (which-key--show-page))) 2596 (which-key--debug-message 2597 "On prefix \"%s\" which-key took %.0f ms." prefix-desc 2598 (* 1000 (float-time (time-since start-time)))))) 2599 2600 (defun which-key--this-command-keys () 2601 "Version of `this-single-command-keys' corrected for key-chords and god-mode." 2602 (let ((this-command-keys (this-single-command-keys))) 2603 (when (and (vectorp this-command-keys) 2604 (> (length this-command-keys) 0) 2605 (eq (aref this-command-keys 0) 'key-chord) 2606 (bound-and-true-p key-chord-mode)) 2607 (setq this-command-keys (this-single-command-raw-keys))) 2608 (when (and which-key--god-mode-support-enabled 2609 (bound-and-true-p god-local-mode) 2610 (eq this-command 'god-mode-self-insert)) 2611 (setq this-command-keys (when which-key--god-mode-key-string 2612 (kbd which-key--god-mode-key-string)))) 2613 this-command-keys)) 2614 2615 (defun which-key--update () 2616 "Function run by timer to possibly trigger 2617 `which-key--create-buffer-and-show'." 2618 (let ((prefix-keys (which-key--this-command-keys)) 2619 delay-time) 2620 (cond ((and (> (length prefix-keys) 0) 2621 (or (keymapp (key-binding prefix-keys)) 2622 ;; Some keymaps are stored here like iso-transl-ctl-x-8-map 2623 (keymapp (which-key--safe-lookup-key 2624 key-translation-map prefix-keys)) 2625 ;; just in case someone uses one of these 2626 (keymapp (which-key--safe-lookup-key 2627 function-key-map prefix-keys))) 2628 (not which-key-inhibit) 2629 (or (null which-key-allow-regexps) 2630 (which-key--any-match-p 2631 which-key-allow-regexps (key-description prefix-keys))) 2632 (or (null which-key-inhibit-regexps) 2633 (not 2634 (which-key--any-match-p 2635 which-key-inhibit-regexps (key-description prefix-keys)))) 2636 ;; Do not display the popup if a command is currently being 2637 ;; executed 2638 (or (and which-key-allow-evil-operators 2639 (bound-and-true-p evil-this-operator)) 2640 (and which-key--god-mode-support-enabled 2641 (bound-and-true-p god-local-mode) 2642 (eq this-command 'god-mode-self-insert)) 2643 (null this-command))) 2644 (when (and (not (equal prefix-keys (which-key--current-prefix))) 2645 (or (null which-key-delay-functions) 2646 (null (setq delay-time 2647 (run-hook-with-args-until-success 2648 'which-key-delay-functions 2649 (key-description prefix-keys) 2650 (length prefix-keys)))) 2651 (sit-for delay-time))) 2652 (setq which-key--automatic-display t) 2653 (which-key--create-buffer-and-show prefix-keys) 2654 (when (and which-key-idle-secondary-delay 2655 (not which-key--secondary-timer-active)) 2656 (which-key--start-timer which-key-idle-secondary-delay t)))) 2657 ((and which-key-show-transient-maps 2658 ;; Assuming that if this is not true we're in 2659 ;; `which-key-show-top-level', which would then be overwritten. 2660 (> (length prefix-keys) 0) 2661 (keymapp overriding-terminal-local-map) 2662 ;; basic test for it being a hydra 2663 (not (eq (lookup-key overriding-terminal-local-map "\C-u") 2664 'hydra--universal-argument))) 2665 (which-key--create-buffer-and-show 2666 nil overriding-terminal-local-map)) 2667 ((and which-key-show-operator-state-maps 2668 (bound-and-true-p evil-state) 2669 (eq evil-state 'operator) 2670 (not (which-key--popup-showing-p))) 2671 (which-key--show-evil-operator-keymap)) 2672 (which-key--automatic-display 2673 (which-key--hide-popup))))) 2674 2675 ;;; Timers 2676 2677 (defun which-key--start-timer (&optional delay secondary) 2678 "Activate idle timer to trigger `which-key--update'." 2679 (which-key--stop-timer) 2680 (setq which-key--secondary-timer-active secondary) 2681 (setq which-key--timer 2682 (run-with-idle-timer (or delay which-key-idle-delay) 2683 t #'which-key--update))) 2684 2685 (defun which-key--stop-timer () 2686 "Deactivate idle timer for `which-key--update'." 2687 (when which-key--timer (cancel-timer which-key--timer))) 2688 2689 (defun which-key--start-paging-timer () 2690 "Activate timer to restart which-key after paging." 2691 (when which-key--paging-timer (cancel-timer which-key--paging-timer)) 2692 (which-key--stop-timer) 2693 (setq which-key--paging-timer 2694 (run-with-idle-timer 2695 0.2 t (lambda () 2696 (when (or (not (member real-last-command 2697 which-key--paging-functions)) 2698 (and (< 0 (length (this-single-command-keys))) 2699 (not (equal (which-key--current-prefix) 2700 (which-key--this-command-keys))))) 2701 (cancel-timer which-key--paging-timer) 2702 (if which-key-idle-secondary-delay 2703 ;; we haven't executed a command yet so the secandary 2704 ;; timer is more relevant here 2705 (which-key--start-timer which-key-idle-secondary-delay t) 2706 (which-key--start-timer))))))) 2707 2708 (provide 'which-key) 2709 ;;; which-key.el ends here