config

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

which-key.el (117316B)


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