config

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

which-key.el (117858B)


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