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