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