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