config

Personal configuration.
git clone git://code.dwrz.net/config
Log | Files | Refs

which-key.el (116465B)


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