--- /dev/null
--- /dev/null
++;;; which-key.el --- Display available keybindings in popup -*- lexical-binding: t; -*-
++
++;; Copyright (C) 2017-2024 Free Software Foundation, Inc.
++
++;; Author: Justin Burkett <justin@burkett.cc>
++;; Maintainer: Justin Burkett <justin@burkett.cc>
++;; Version: 3.6.0
++;; Keywords:
++;; Package-Requires: ((emacs "24.4"))
++
++;; This program is free software; you can redistribute it and/or modify
++;; it under the terms of the GNU General Public License as published by
++;; the Free Software Foundation, either version 3 of the License, or
++;; (at your option) any later version.
++
++;; This program is distributed in the hope that it will be useful,
++;; but WITHOUT ANY WARRANTY; without even the implied warranty of
++;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
++;; GNU General Public License for more details.
++
++;; You should have received a copy of the GNU General Public License
++;; along with this program. If not, see <http://www.gnu.org/licenses/>.
++
++;;; Commentary:
++
++;; which-key provides the minor mode which-key-mode for Emacs. The mode displays
++;; the key bindings following your currently entered incomplete command (a
++;; prefix) in a popup. For example, after enabling the minor mode if you enter
++;; C-x and wait for the default of 1 second the minibuffer will expand with all
++;; of the available key bindings that follow C-x (or as many as space allows
++;; given your settings). This includes prefixes like C-x 8 which are shown in a
++;; different face. Screenshots of what the popup will look like along with
++;; information about additional features can be found at
++;; https://github.com/justbur/emacs-which-key.
++;;
++
++;;; Code:
++
++(require 'cl-lib)
++(require 'button)
++(require 'regexp-opt)
++
++;; For compiler
++(defvar evil-operator-shortcut-map)
++(defvar evil-operator-state-map)
++(defvar evil-motion-state-map)
++(defvar golden-ratio-mode)
++(declare-function evil-get-command-property "ext:evil-common.el")
++
++;;; Options
++
++(defgroup which-key nil
++ "Customization options for which-key-mode."
++ :group 'help
++ :prefix "which-key-")
++
++(defcustom which-key-idle-delay 1.0
++ "Delay (in seconds) for which-key buffer to popup.
++This variable should be set before activating `which-key-mode'.
++
++A value of zero might lead to issues, so a non-zero value is
++recommended
++(see https://github.com/justbur/emacs-which-key/issues/134)."
++ :type 'float
++ :version "1.0")
++
++(defcustom which-key-idle-secondary-delay nil
++ "Seconds to wait for which-key to pop up after initial display.
++This makes it possible to shorten the delay for subsequent popups
++in the same key sequence. The default is for this value to be
++nil, which disables this behavior."
++ :type '(choice float (const :tag "Disabled" nil))
++ :version "1.0")
++
++(defcustom which-key-echo-keystrokes (if (and echo-keystrokes
++ (> (+ echo-keystrokes 0.01)
++ which-key-idle-delay))
++ (/ (float which-key-idle-delay) 4)
++ echo-keystrokes)
++ "Value to use for `echo-keystrokes'.
++This only applies if `which-key-popup-type' is minibuffer or
++`which-key-show-prefix' is echo. It needs to be less than
++`which-key-idle-delay' or else the keystroke echo will erase the
++which-key popup."
++ :type 'float
++ :version "1.0")
++
++(defcustom which-key-max-description-length 27
++ "Truncate the description of keys to this length.
++Either nil (no truncation), an integer (truncate after that many
++characters), a float (use that fraction of the available width),
++or a function, which takes one argument, the available width in
++characters, and whose return value has one of the types mentioned
++before. Truncation is done using `which-key-ellipsis'."
++ :type '(choice (const :tag "Disable truncation" nil)
++ (integer :tag "Width in characters")
++ (float :tag "Use fraction of available width")
++ function)
++ :version "1.0")
++
++(defcustom which-key-min-column-description-width 0
++ "Every column should at least have this width."
++ :type 'natnum
++ :version "1.0")
++
++(defcustom which-key-add-column-padding 0
++ "Additional spaces to add to the left of each key column."
++ :type 'integer
++ :version "1.0")
++
++(defcustom which-key-unicode-correction 3
++ "Correction for wide unicode characters.
++Since we measure width in terms of the number of characters,
++Unicode characters that are wider than ASCII characters throw off
++the calculation for available width in the which-key buffer. This
++variable allows you to adjust for the wide unicode characters by
++artificially reducing the available width in the buffer.
++
++The default of 3 means allow for the total extra width
++contributed by any wide unicode characters to be up to one
++additional ASCII character in the which-key buffer. Increase this
++number if you are seeing characters get cutoff on the right side
++of the which-key popup."
++ :type 'integer
++ :version "1.0")
++
++(defcustom which-key-dont-use-unicode nil
++ "If non-nil, don't use any unicode characters in default setup.
++For affected settings, see `which-key-replacement-alist', `which-key-ellipsis'
++`which-key-separator'."
++ :type 'boolean
++ :version "1.0")
++
++(defcustom which-key-separator
++ (if which-key-dont-use-unicode " : " " → ")
++ "Separator to use between key and description.
++Default is \" → \", unless `which-key-dont-use-unicode' is non
++nil, in which case the default is \" : \"."
++ :type 'string
++ :version "1.0")
++
++(defcustom which-key-ellipsis
++ (if which-key-dont-use-unicode ".." "…")
++ "Ellipsis to use when truncating.
++Default is \"…\", unless `which-key-dont-use-unicode' is non nil,
++in which case the default is \"..\". This can also be the empty
++string to truncate without using any ellipsis."
++ :type 'string
++ :version "1.0")
++
++(defcustom which-key-prefix-prefix "+"
++ "Prefix string to indicate a key bound to a keymap.
++Default is \"+\"."
++ :type 'string
++ :version "1.0")
++
++(defcustom which-key-compute-remaps nil
++ "If non-nil, show remapped commands.
++This applies to commands that have been remapped given the
++currently active keymaps."
++ :type 'boolean
++ :version "1.0")
++
++(defcustom which-key-replacement-alist
++ `(((nil . "which-key-show-next-page-no-cycle") . (nil . "wk next pg"))
++ ,@(unless which-key-dont-use-unicode
++ '((("<left>") . ("←"))
++ (("<right>") . ("→"))))
++ (("<\\([[:alnum:]-]+\\)>") . ("\\1")))
++ "ALIST for manipulating display of binding descriptions.
++Each element of the list is a nested cons cell with the format
++
++\(MATCH CONS . REPLACEMENT\).
++
++The MATCH CONS determines when a replacement should occur and
++REPLACEMENT determines how the replacement should occur. Each may
++have the format \(KEY REGEXP . BINDING REGEXP\). For the
++replacement to apply the key binding must match both the KEY
++REGEXP and the BINDING REGEXP. A value of nil in either position
++can be used to match every possibility. The replacement is
++performed by using `replace-regexp-in-string' on the KEY REGEXP
++from the MATCH CONS and REPLACEMENT when it is a cons cell, and
++then similarly for the BINDING REGEXP. A nil value in the BINDING
++REGEXP position cancels the replacement. For example, the entry
++
++\(\(nil . \"Prefix Command\"\) . \(nil . \"prefix\"\)\)
++
++matches any binding with the descriptions \"Prefix Command\" and
++replaces the description with \"prefix\", ignoring the
++corresponding key.
++
++REPLACEMENT may also be a function taking a cons cell
++\(KEY . BINDING\) and producing a new corresponding cons cell.
++
++If REPLACEMENT is anything other than a cons cell \(and non nil\)
++the key binding is ignored by which-key.
++
++Finally, you can multiple replacements to occur for a given key
++binding by setting `which-key-allow-multiple-replacements' to a
++non-nil value."
++ :type '(alist :key-type (cons (choice regexp (const nil))
++ (choice regexp (const nil)))
++ :value-type (cons (choice string (const nil))
++ (choice string (const nil))))
++ :version "1.0")
++
++(defcustom which-key-allow-multiple-replacements nil
++ "Allow a key binding to be modified by multiple elements.
++When non-nil, this allows a single key binding to match multiple
++patterns in `which-key-replacement-alist'. When nil, only the
++first match is used to perform replacements from
++`which-key-replacement-alist'."
++ :type 'boolean
++ :version "1.0")
++
++(defcustom which-key-show-docstrings nil
++ "If non-nil, show each command's docstring in the which-key popup.
++This will only display the docstring up to the first line
++break. If you set this variable to the symbol docstring-only,
++then the command's name with be omitted. You probably also want
++to adjust `which-key-max-description-length' at the same time if
++you use this feature."
++ :type '(radio
++ (const :tag "Do not show docstrings" nil)
++ (const :tag "Add docstring to command names" t)
++ (const :tag "Replace command name with docstring" docstring-only))
++ :version "1.0")
++
++(defcustom which-key-highlighted-command-list '()
++ "Rules used to highlight certain commands.
++If the element is a string, assume it is a regexp pattern for
++matching command names and use
++`which-key-highlighted-command-face' for any matching names. If
++the element is a cons cell, it should take the form (regexp .
++face to apply)."
++ :type '(repeat (choice string (cons regexp face)))
++ :version "1.0")
++
++(defcustom which-key-special-keys '()
++ "These keys will automatically be truncated to one character.
++They also have `which-key-special-key-face' applied to them. This
++is disabled by default. An example configuration is
++
++\(setq which-key-special-keys \\='(\"SPC\" \"TAB\" \"RET\" \"ESC\" \"DEL\")\)"
++ :type '(repeat string)
++ :version "1.0")
++
++(defcustom which-key-buffer-name " *which-key*"
++ "Name of which-key buffer."
++ :type 'string
++ :version "1.0")
++
++(defcustom which-key-show-prefix 'echo
++ "Whether to and where to display the current prefix sequence.
++Possible choices are echo for echo area (the default), left, top
++and nil. Nil turns the feature off."
++ :type '(radio (const :tag "Left of the keys" left)
++ (const :tag "In the first line" top)
++ (const :tag "In the last line" bottom)
++ (const :tag "In the echo area" echo)
++ (const :tag "In the mode-line" mode-line)
++ (const :tag "Hide" nil))
++ :version "1.0")
++
++(defcustom which-key-popup-type 'side-window
++ "Supported types are minibuffer, side-window, frame, and custom."
++ :type '(radio (const :tag "Show in minibuffer" minibuffer)
++ (const :tag "Show in side window" side-window)
++ (const :tag "Show in popup frame" frame)
++ (const :tag "Use your custom display functions" custom))
++ :version "1.0")
++
++(defcustom which-key-min-display-lines 1
++ "Minimum number of horizontal lines to display in the which-key buffer."
++ :type 'integer
++ :version "1.0")
++
++(defcustom which-key-max-display-columns nil
++ "Maximum number of columns to display in the which-key buffer.
++A value of nil means don't impose a maximum."
++ :type '(choice integer (const :tag "Unbounded" nil))
++ :version "1.0")
++
++(defcustom which-key-side-window-location 'bottom
++ "Location of which-key popup when `which-key-popup-type' is side-window.
++Should be one of top, bottom, left or right. You can also specify
++a list of two locations, like (right bottom). In this case, the
++first location is tried. If there is not enough room, the second
++location is tried."
++ :type '(radio (const right)
++ (const bottom)
++ (const left)
++ (const top)
++ (const (right bottom))
++ (const (bottom right)))
++ :version "1.0")
++
++(defcustom which-key-side-window-slot 0
++ "The `slot' to use for `display-buffer-in-side-window'.
++This applies when `which-key-popup-type' is `side-window'.
++Quoting from the docstring of `display-buffer-in-side-window',
++
++`slot' if non-nil, specifies the window slot where to display
++BUFFER. A value of zero or nil means use the middle slot on the
++specified side. A negative value means use a slot
++preceding (that is, above or on the left of) the middle slot. A
++positive value means use a slot following (that is, below or on
++the right of) the middle slot. The default is zero."
++ :type 'integer
++ :version "1.0")
++
++(defcustom which-key-side-window-max-width 0.333
++ "Maximum width of which-key popup when type is side-window.
++This variable can also be a number between 0 and 1. In that case,
++it denotes a percentage out of the frame's width."
++ :type 'float
++ :version "1.0")
++
++(defcustom which-key-side-window-max-height 0.25
++ "Maximum height of which-key popup when type is side-window.
++This variable can also be a number between 0 and 1. In that case, it denotes
++a percentage out of the frame's height."
++ :type 'float
++ :version "1.0")
++
++(defcustom which-key-frame-max-width 60
++ "Maximum width of which-key popup when type is frame."
++ :type 'natnum
++ :version "1.0")
++
++(defcustom which-key-frame-max-height 20
++ "Maximum height of which-key popup when type is frame."
++ :type 'natnum
++ :version "1.0")
++
++(defcustom which-key-allow-imprecise-window-fit (not (display-graphic-p))
++ "Allow which-key to use a simpler method for resizing the popup.
++If you are noticing lag when the which-key popup displays turning
++this on may help.
++
++See https://github.com/justbur/emacs-which-key/issues/130
++and https://github.com/justbur/emacs-which-key/issues/225."
++ :type 'boolean
++ :version "1.0")
++
++(defcustom which-key-show-remaining-keys nil
++ "Show remaining keys in last slot, when keys are hidden."
++ :type '(radio (const :tag "Yes" t)
++ (const :tag "No" nil))
++ :version "1.0")
++
++(defcustom which-key-sort-order #'which-key-key-order
++ "Order in which the key bindings are sorted.
++If nil, do not resort the output from `describe-buffer-bindings'
++which groups by mode. Ordering options
++are
++
++1. `which-key-key-order': by key (default)
++2. `which-key-key-order-alpha': by key using alphabetical order
++3. `which-key-description-order': by description
++4. `which-key-prefix-then-key-order': prefix (no prefix first) then key
++5. `which-key-local-then-key-order': local binding then key
++
++See the README and the docstrings for those functions for more
++information."
++ :type '(choice (function-item which-key-key-order)
++ (function-item which-key-key-order-alpha)
++ (function-item which-key-description-order)
++ (function-item which-key-prefix-then-key-order)
++ (function-item which-key-local-then-key-order))
++ :version "1.0")
++
++(defcustom which-key-sort-uppercase-first t
++ "If non-nil, uppercase comes before lowercase in sorting.
++This applies to the function chosen in
++`which-key-sort-order'. Otherwise, the order is reversed."
++ :type 'boolean
++ :version "1.0")
++
++(defcustom which-key-paging-prefixes '()
++ "Enable paging for these prefixes."
++ :type '(repeat string)
++ :version "1.0")
++
++(defcustom which-key-paging-key "<f5>"
++ "Key to use for changing pages.
++Bound after each of the prefixes in `which-key-paging-prefixes'"
++ :type 'string
++ :version "1.0")
++
++;; (defcustom which-key-undo-key nil
++;; "Key (string) to use for undoing keypresses. Bound recursively
++;; in each of the maps in `which-key-undo-keymaps'."
++;; :group 'which-key
++;; :type 'string)
++
++;; (defcustom which-key-undo-keymaps '()
++;; "Keymaps in which to bind `which-key-undo-key'"
++;; :group 'which-key
++;; :type '(repeat symbol))
++
++(defcustom which-key-use-C-h-commands t
++ "Use C-h (`help-char') for paging if non-nil.
++Normally `help-char' after a prefix calls
++`describe-prefix-bindings'. This changes that command to a
++which-key paging command when which-key-mode is active."
++ :type 'boolean
++ :version "1.0")
++
++(defcustom which-key-show-early-on-C-h nil
++ "Allow C-h (`help-char') to trigger which-key popup before timer.
++Show the which-key buffer if `help-char' is pressed in the middle
++of a prefix before the which-key buffer would normally be
++triggered by the time. If combined with the following settings,
++which-key will effectively only show when triggered \"manually\"
++using C-h.
++
++\(setq `which-key-idle-delay' 10000)
++\(setq `which-key-idle-secondary-delay' 0.05)
++
++Note that `which-key-idle-delay' should be set before turning on
++`which-key-mode'."
++ :type 'boolean
++ :version "1.0")
++
++(defcustom which-key-is-verbose nil
++ "Whether to warn about potential mistakes in configuration."
++ :type 'boolean
++ :version "1.0")
++
++(defcustom which-key-preserve-window-configuration nil
++ "Save and restore window configuration around which-key popup display.
++If non-nil, save window configuration before which-key buffer is
++shown and restore it after which-key buffer is hidden. It
++prevents which-key from changing window position of visible
++buffers. Only takken into account when popup type is
++side-window."
++ :type 'boolean
++ :version "1.0")
++
++(defvar which-key-C-h-map-prompt
++ (concat " \\<which-key-C-h-map>"
++ " \\[which-key-show-next-page-cycle]"
++ which-key-separator "next-page,"
++ " \\[which-key-show-previous-page-cycle]"
++ which-key-separator "previous-page,"
++ " \\[which-key-undo-key]"
++ which-key-separator "undo-key,"
++ " \\[which-key-toggle-docstrings]"
++ which-key-separator "toggle-docstrings,"
++ " \\[which-key-show-standard-help]"
++ which-key-separator "help,"
++ " \\[which-key-abort]"
++ which-key-separator "abort"
++ " 1..9"
++ which-key-separator "digit-arg")
++ "Prompt to display when invoking `which-key-C-h-map'.
++This string is fed into `substitute-command-keys'")
++
++(defvar which-key-C-h-map
++ (let ((map (make-sparse-keymap)))
++ (dolist (bind `(("\C-a" . which-key-abort)
++ ("a" . which-key-abort)
++ ("\C-d" . which-key-toggle-docstrings)
++ ("d" . which-key-toggle-docstrings)
++ (,(vector help-char) . which-key-show-standard-help)
++ ("h" . which-key-show-standard-help)
++ ("\C-n" . which-key-show-next-page-cycle)
++ ("n" . which-key-show-next-page-cycle)
++ ("\C-p" . which-key-show-previous-page-cycle)
++ ("p" . which-key-show-previous-page-cycle)
++ ("\C-u" . which-key-undo-key)
++ ("u" . which-key-undo-key)
++ ("1" . which-key-digit-argument)
++ ("2" . which-key-digit-argument)
++ ("3" . which-key-digit-argument)
++ ("4" . which-key-digit-argument)
++ ("5" . which-key-digit-argument)
++ ("6" . which-key-digit-argument)
++ ("7" . which-key-digit-argument)
++ ("8" . which-key-digit-argument)
++ ("9" . which-key-digit-argument)))
++ (define-key map (car bind) (cdr bind)))
++ map)
++ "Keymap for C-h commands.")
++
++(defvar which-key--paging-functions
++ (list #'which-key-C-h-dispatch
++ #'which-key-turn-page
++ #'which-key-show-next-page-cycle
++ #'which-key-show-next-page-no-cycle
++ #'which-key-show-previous-page-cycle
++ #'which-key-show-previous-page-no-cycle
++ #'which-key-undo-key
++ #'which-key-undo))
++
++(defvar which-key-persistent-popup nil
++ "Whether or not to disable `which-key--hide-popup'.")
++
++(defcustom which-key-hide-alt-key-translations t
++ "Hide key translations using Alt key if non nil.
++These translations are not relevant most of the times since a lot
++of terminals issue META modifier for the Alt key.
++
++See Info node `(emacs)Modifier Keys'."
++ :type 'boolean
++ :version "1.0")
++
++(defcustom which-key-delay-functions nil
++ "List of functions that may delay the which-key popup.
++A list of functions that may decide whether to delay the
++which-key popup based on the current incomplete key
++sequence. Each function in the list is run with two arguments,
++the current key sequence as produced by `key-description' and the
++length of the key sequence. If the popup should be delayed based
++on that key sequence, the function should return the delay time
++in seconds. Returning nil means no delay. The first function in
++this list to return a value is the value that is used.
++
++The delay time is effectively added to the normal
++`which-key-idle-delay'."
++ :type '(repeat function)
++ :version "1.0")
++
++(defcustom which-key-allow-regexps nil
++ "A list of regexp strings to use to filter key sequences.
++When non-nil, for a key sequence to trigger the which-key popup
++it must match one of the regexps in this list. The format of the
++key sequences is what is produced by `key-description'."
++ :type '(repeat regexp)
++ :version "1.0")
++
++(defcustom which-key-inhibit-regexps nil
++ "A list of regexp strings to use to filter key sequences.
++When non-nil, for a key sequence to trigger the which-key popup
++it cannot match one of the regexps in this list. The format of
++the key sequences is what is produced by `key-description'."
++ :type '(repeat regexp)
++ :version "1.0")
++
++(defcustom which-key-show-transient-maps nil
++ "Show keymaps created by `set-transient-map' when applicable.
++
++More specifically, detect when `overriding-terminal-local-map' is
++set (this is the keymap used by `set-transient-map') and display
++it."
++ :type 'boolean
++ :version "1.0")
++
++(make-obsolete-variable
++ 'which-key-enable-extended-define-key
++ "which-key-enable-extended-define-key is obsolete and has no effect."
++ "2021-06-21")
++
++;; Hooks
++(defcustom which-key-init-buffer-hook '()
++ "Hook run when which-key buffer is initialized."
++ :type 'hook
++ :version "1.0")
++
++;;;; Faces
++
++(defgroup which-key-faces nil
++ "Faces for which-key-mode"
++ :group 'which-key
++ :prefix "which-key-")
++
++(defface which-key-key-face
++ '((t . (:inherit font-lock-constant-face)))
++ "Face for which-key keys"
++ :group 'which-key-faces
++ :version "1.0")
++
++(defface which-key-separator-face
++ '((t . (:inherit font-lock-comment-face)))
++ "Face for the separator (default separator is an arrow)"
++ :group 'which-key-faces
++ :version "1.0")
++
++(defface which-key-note-face
++ '((t . (:inherit which-key-separator-face)))
++ "Face for notes or hints occasionally provided"
++ :group 'which-key-faces
++ :version "1.0")
++
++(defface which-key-command-description-face
++ '((t . (:inherit font-lock-function-name-face)))
++ "Face for the key description when it is a command"
++ :group 'which-key-faces
++ :version "1.0")
++
++(defface which-key-local-map-description-face
++ '((t . (:inherit which-key-command-description-face)))
++ "Face for the key description when it is found in `current-local-map'"
++ :group 'which-key-faces
++ :version "1.0")
++
++(defface which-key-highlighted-command-face
++ '((t . (:inherit which-key-command-description-face :underline t)))
++ "Default face for the command description when it is a command
++and it matches a string in `which-key-highlighted-command-list'."
++ :group 'which-key-faces
++ :version "1.0")
++
++(defface which-key-group-description-face
++ '((t . (:inherit font-lock-keyword-face)))
++ "Face for the key description when it is a group or prefix."
++ :group 'which-key-faces
++ :version "1.0")
++
++(defface which-key-special-key-face
++ '((t . (:inherit which-key-key-face :inverse-video t :weight bold)))
++ "Face for special keys (SPC, TAB, RET)"
++ :group 'which-key-faces
++ :version "1.0")
++
++(defface which-key-docstring-face
++ '((t . (:inherit which-key-note-face)))
++ "Face for docstrings."
++ :group 'which-key-faces
++ :version "1.0")
++
++;;;; Custom popup
++
++(defcustom which-key-custom-popup-max-dimensions-function nil
++ "Set a custom max-dimensions function.
++Will be passed the width of the active window and is expected to
++return the maximum height in lines and width in characters of the
++which-key popup in the form a cons cell (height . width)."
++ :group 'which-key
++ :type '(choice function (const nil))
++ :version "1.0")
++
++(defcustom which-key-custom-hide-popup-function nil
++ "Set a custom hide-popup function.
++It takes no arguments and the return value is ignored."
++ :group 'which-key
++ :type '(choice function (const nil))
++ :version "1.0")
++
++(defcustom which-key-custom-show-popup-function nil
++ "Set a custom show-popup function.
++Will be passed the required dimensions in the form (height .
++width) in lines and characters respectively. The return value is
++ignored."
++ :group 'which-key
++ :type '(choice function (const nil))
++ :version "1.0")
++
++(defcustom which-key-lighter " WK"
++ "Minor mode lighter to use in the mode-line."
++ :group 'which-key
++ :type 'string
++ :version "1.0")
++
++(defvar which-key-inhibit nil
++ "Prevent which-key from popping up momentarily.
++This can be used by setting this to a non-nil value for the
++execution of a command, as in
++
++\(let \(\(which-key-inhibit t\)\)
++...\)")
++
++(defcustom which-key-inhibit-display-hook nil
++ "Hook run before display of which-key popup.
++Each function in the hook is run before displaying the which-key
++popup. If any function returns a non-nil value, the popup will
++not display."
++ :group 'which-key
++ :type 'hook
++ :version "1.0")
++
++(defvar which-key-keymap-history nil
++ "History of keymap selections.
++Used in functions like `which-key-show-keymap'.")
++
++;;; Internal Vars
++
++(defvar which-key--buffer nil
++ "Holds reference to which-key buffer.")
++(defvar which-key--timer nil
++ "Holds reference to open window timer.")
++(defvar which-key--secondary-timer-active nil
++ "Non-nil if the secondary timer is active.")
++(defvar which-key--paging-timer nil
++ "Holds reference to timer for paging.")
++(defvar which-key--frame nil
++ "Holds reference to which-key frame.
++Used when `which-key-popup-type' is frame.")
++(defvar which-key--echo-keystrokes-backup nil
++ "Backup the initial value of `echo-keystrokes'.")
++(defvar which-key--prefix-help-cmd-backup nil
++ "Backup the value of `prefix-help-command'.")
++(defvar which-key--last-try-2-loc nil
++ "Last location of side-window when two locations used.")
++(defvar which-key--automatic-display nil
++ "Non-nil if popup was triggered with automatic update.")
++(defvar which-key--debug-buffer-name nil
++ "If non-nil, use this buffer for debug messages.")
++(defvar which-key--multiple-locations nil)
++(defvar which-key--inhibit-next-operator-popup nil)
++(defvar which-key--prior-show-keymap-args nil)
++(defvar which-key--previous-frame-size nil)
++(defvar which-key--prefix-title-alist nil)
++(defvar which-key--evil-keys-regexp (eval-when-compile
++ (regexp-opt '("-state"))))
++(defvar which-key--ignore-non-evil-keys-regexp
++ (regexp-opt '("mouse-" "wheel-" "remap" "drag-" "scroll-bar"
++ "select-window" "switch-frame" "which-key")))
++(defvar which-key--ignore-keys-regexp
++ (regexp-opt '("mouse-" "wheel-" "remap" "drag-" "scroll-bar"
++ "select-window" "switch-frame" "-state"
++ "which-key")))
++
++(defvar which-key--pages-obj nil)
++(cl-defstruct which-key--pages
++ pages
++ height
++ widths
++ keys/page
++ page-nums
++ num-pages
++ total-keys
++ prefix
++ prefix-title)
++
++(defvar which-key--saved-window-configuration nil)
++
++(defun which-key--rotate (list n)
++ (let* ((len (length list))
++ (n (- len (mod n len))))
++ (append (last list n) (butlast list n))))
++
++(defun which-key--pages-set-current-page (pages-obj n)
++ (setf (which-key--pages-pages pages-obj)
++ (which-key--rotate (which-key--pages-pages pages-obj) n))
++ (setf (which-key--pages-widths pages-obj)
++ (which-key--rotate (which-key--pages-widths pages-obj) n))
++ (setf (which-key--pages-keys/page pages-obj)
++ (which-key--rotate (which-key--pages-keys/page pages-obj) n))
++ (setf (which-key--pages-page-nums pages-obj)
++ (which-key--rotate (which-key--pages-page-nums pages-obj) n))
++ pages-obj)
++
++(defsubst which-key--on-first-page ()
++ (= (which-key--pages-page-nums which-key--pages-obj) 1))
++
++(defsubst which-key--on-last-page ()
++ (= (which-key--pages-page-nums which-key--pages-obj)
++ (which-key--pages-num-pages which-key--pages-obj)))
++
++(defsubst which-key--current-prefix ()
++ (and which-key--pages-obj
++ (which-key--pages-prefix which-key--pages-obj)))
++
++(defmacro which-key--debug-message (&rest msg)
++ `(when which-key--debug-buffer-name
++ (let ((buf (get-buffer-create which-key--debug-buffer-name))
++ (fmt-msg (format ,@msg)))
++ (with-current-buffer buf
++ (goto-char (point-max))
++ (insert "\n" fmt-msg "\n")))))
++
++(defsubst which-key--safe-lookup-key (keymap key)
++ "Version of `lookup-key' that allows KEYMAP to be nil.
++Also convert numeric results of `lookup-key' to nil. KEY is not
++checked."
++ (when (keymapp keymap)
++ (let ((result (lookup-key keymap key)))
++ (when (and result (not (numberp result)))
++ result))))
++
++(defsubst which-key--safe-lookup-key-description (keymap key)
++ "Version of `lookup-key' that allows KEYMAP to be nil.
++Also convert numeric results of `lookup-key' to nil. KEY
++should be formatted as an input for `kbd'."
++ (let ((key (ignore-errors (kbd key))))
++ (when (and key (keymapp keymap))
++ (let ((result (lookup-key keymap key)))
++ (when (and result (not (numberp result)))
++ result)))))
++
++;;; Third-party library support
++
++(defun which-key--this-command-keys ()
++ "Version of `this-single-command-keys' corrected for key-chords."
++ (let ((this-command-keys (this-single-command-keys)))
++ (when (and (vectorp this-command-keys)
++ (> (length this-command-keys) 0)
++ (eq (aref this-command-keys 0) 'key-chord)
++ (bound-and-true-p key-chord-mode))
++ (setq this-command-keys (this-single-command-raw-keys)))
++ this-command-keys))
++
++(defcustom which-key-this-command-keys-function #'which-key--this-command-keys
++ "Function used to retrieve current key sequence.
++The purpose of allowing this variable to be customized is to
++allow which-key to support packages that insert non-standard
++`keys' into the key sequence being read by emacs."
++ :group 'which-key
++ :type 'function
++ :version "1.0")
++
++
++;;;; Evil
++
++(defvar evil-state nil)
++
++(defcustom which-key-allow-evil-operators (boundp 'evil-this-operator)
++ "Allow popup to show for evil operators.
++The popup is normally inhibited in the middle of commands, but
++setting this to non-nil will override this behavior for evil
++operators."
++ :group 'which-key
++ :type 'boolean
++ :version "1.0")
++
++(defcustom which-key-show-operator-state-maps nil
++ "Show the keys following an evil command that reads a motion.
++These are commands typically mapped to keys such as \"y\", \"d\"
++and \"c\" from normal state. This is experimental, because there
++might be some valid keys missing and it might be showing some
++invalid keys."
++ :group 'which-key
++ :type 'boolean
++ :version "1.0")
++
++(defun which-key-evil-this-operator-p ()
++ (and which-key-allow-evil-operators
++ (bound-and-true-p evil-this-operator)))
++
++(add-hook 'which-key-inhibit-display-hook
++ #'which-key-evil-this-operator-p)
++
++;;;; God-mode
++
++(defvar which-key--god-mode-support-enabled nil
++ "Support god-mode if non-nil.")
++
++(defvar which-key--god-mode-key-string nil
++ "String to use for god-mode support.")
++
++(defun which-key--god-mode-lookup-command-advice (orig-fun arg1 &rest args)
++ (setq which-key--god-mode-key-string arg1)
++ (unwind-protect
++ (apply orig-fun arg1 args)
++ (when (bound-and-true-p which-key-mode)
++ (which-key--hide-popup))))
++
++(defun which-key--god-mode-this-command-keys ()
++ "Version of `this-single-command-keys' corrected for god-mode."
++ (let ((this-command-keys (this-single-command-keys)))
++ (when (and which-key--god-mode-support-enabled
++ (bound-and-true-p god-local-mode)
++ (eq this-command 'god-mode-self-insert))
++ (setq this-command-keys (when which-key--god-mode-key-string
++ (kbd which-key--god-mode-key-string))))
++ this-command-keys))
++
++(defun which-key-god-mode-self-insert-p ()
++ (and which-key--god-mode-support-enabled
++ (bound-and-true-p god-local-mode)
++ (eq this-command 'god-mode-self-insert)))
++
++(defun which-key-enable-god-mode-support (&optional disable)
++ "Enable support for god-mode if non-nil.
++This is experimental, so you need to explicitly opt-in for
++now. Please report any problems at github. If DISABLE is non-nil
++disable support."
++ (interactive "P")
++ (setq which-key--god-mode-support-enabled (null disable))
++ (if disable
++ (progn
++ (advice-remove 'god-mode-lookup-command
++ #'which-key--god-mode-lookup-command-advice)
++ (remove-function which-key-this-command-keys-function
++ #'which-key--god-mode-this-command-keys)
++ (remove-hook 'which-key-inhibit-display-hook
++ #'which-key-god-mode-self-insert-p))
++ (advice-add 'god-mode-lookup-command :around
++ #'which-key--god-mode-lookup-command-advice)
++ (add-function :override which-key-this-command-keys-function
++ #'which-key--god-mode-this-command-keys)
++ (add-hook 'which-key-inhibit-display-hook
++ #'which-key-god-mode-self-insert-p)))
++
++;;; Mode
++
++;;;###autoload
++(define-minor-mode which-key-mode
++ "Toggle which-key-mode."
++ :global t
++ :group 'which-key
++ :lighter which-key-lighter
++ :keymap (let ((map (make-sparse-keymap)))
++ (mapc
++ (lambda (prefix)
++ (define-key map
++ (kbd (concat prefix " " which-key-paging-key))
++ #'which-key-C-h-dispatch))
++ which-key-paging-prefixes)
++ map)
++ (if which-key-mode
++ (progn
++ (setq which-key--echo-keystrokes-backup echo-keystrokes)
++ (when (or (eq which-key-show-prefix 'echo)
++ (eq which-key-popup-type 'minibuffer))
++ (which-key--setup-echo-keystrokes))
++ (unless (member prefix-help-command which-key--paging-functions)
++ (setq which-key--prefix-help-cmd-backup prefix-help-command))
++ (when (or which-key-use-C-h-commands
++ which-key-show-early-on-C-h)
++ (setq prefix-help-command #'which-key-C-h-dispatch))
++ (when which-key-show-remaining-keys
++ (add-hook 'pre-command-hook #'which-key--lighter-restore))
++ (add-hook 'pre-command-hook #'which-key--hide-popup)
++ (add-hook 'window-size-change-functions
++ #'which-key--hide-popup-on-frame-size-change)
++ (which-key--start-timer))
++ (setq echo-keystrokes which-key--echo-keystrokes-backup)
++ (when which-key--prefix-help-cmd-backup
++ (setq prefix-help-command which-key--prefix-help-cmd-backup))
++ (when which-key-show-remaining-keys
++ (remove-hook 'pre-command-hook #'which-key--lighter-restore))
++ (remove-hook 'pre-command-hook #'which-key--hide-popup)
++ (remove-hook 'window-size-change-functions
++ #'which-key--hide-popup-on-frame-size-change)
++ (which-key--stop-timer)))
++
++(defun which-key--init-buffer ()
++ "Initialize which-key buffer"
++ (unless (buffer-live-p which-key--buffer)
++ (setq which-key--buffer (get-buffer-create which-key-buffer-name))
++ (with-current-buffer which-key--buffer
++ ;; suppress confusing minibuffer message
++ (let (message-log-max)
++ (toggle-truncate-lines 1)
++ (message ""))
++ (setq-local cursor-type nil)
++ (setq-local cursor-in-non-selected-windows nil)
++ (setq-local mode-line-format nil)
++ (setq-local header-line-format nil)
++ (setq-local word-wrap nil)
++ (setq-local show-trailing-whitespace nil)
++ (run-hooks 'which-key-init-buffer-hook))))
++
++(defun which-key--setup-echo-keystrokes ()
++ "Reduce `echo-keystrokes' if necessary.
++It will interfere if set too high."
++ (when (and echo-keystrokes
++ (> (abs (- echo-keystrokes which-key-echo-keystrokes)) 0.000001))
++ (if (> which-key-idle-delay which-key-echo-keystrokes)
++ (setq echo-keystrokes which-key-echo-keystrokes)
++ (setq which-key-echo-keystrokes (/ (float which-key-idle-delay) 4)
++ echo-keystrokes which-key-echo-keystrokes))))
++
++(defun which-key-remove-default-unicode-chars ()
++ "Remove default unicode chars from settings.
++Use of `which-key-dont-use-unicode' is preferred to this
++function, but it's included here in case someone cannot set that
++variable early enough in their configuration, if they are using a
++starter kit for example."
++ (when (string-equal which-key-separator " → ")
++ (setq which-key-separator " : ")))
++
++;;; Default configuration functions for use by users.
++
++;;;###autoload
++(defun which-key-setup-side-window-right ()
++ "Set up side-window on right."
++ (interactive)
++ (setq which-key-popup-type 'side-window
++ which-key-side-window-location 'right
++ which-key-show-prefix 'top))
++
++;;;###autoload
++(defun which-key-setup-side-window-right-bottom ()
++ "Set up side-window on right if space allows.
++Otherwise, use bottom."
++ (interactive)
++ (setq which-key-popup-type 'side-window
++ which-key-side-window-location '(right bottom)
++ which-key-show-prefix 'top))
++
++;;;###autoload
++(defun which-key-setup-side-window-bottom ()
++ "Set up side-window that opens on bottom."
++ (interactive)
++ (which-key--setup-echo-keystrokes)
++ (setq which-key-popup-type 'side-window
++ which-key-side-window-location 'bottom
++ which-key-show-prefix 'echo))
++
++;;;###autoload
++(defun which-key-setup-minibuffer ()
++ "Set up minibuffer display.
++Do not use this setup if you use the paging commands. Instead use
++`which-key-setup-side-window-bottom', which is nearly identical
++but more functional."
++ (interactive)
++ (which-key--setup-echo-keystrokes)
++ (setq which-key-popup-type 'minibuffer
++ which-key-show-prefix 'left))
++
++;;; Helper functions to modify replacement lists.
++
++;;;###autoload
++(defun which-key-add-keymap-based-replacements (keymap key replacement &rest more)
++ "Replace the description of KEY using REPLACEMENT in KEYMAP.
++KEY should take a format suitable for use in `kbd'. REPLACEMENT
++should be a cons cell of the form \(STRING . COMMAND\) for each
++REPLACEMENT, where STRING is the replacement string and COMMAND
++is a symbol corresponding to the intended command to be
++replaced. COMMAND can be nil if the binding corresponds to a key
++prefix. An example is
++
++\(which-key-add-keymap-based-replacements global-map
++ \"C-x w\" \\='\(\"Save as\" . write-file\)\).
++
++For backwards compatibility, REPLACEMENT can also be a string,
++but the above format is preferred, and the option to use a string
++for REPLACEMENT will eventually be removed."
++ (declare (indent defun))
++ (while key
++ (let ((def
++ (cond
++ ((consp replacement) replacement)
++ ((stringp replacement)
++ (cons replacement
++ (or (which-key--safe-lookup-key-description keymap key)
++ (make-sparse-keymap))))
++ (t
++ (user-error "Replacement is neither a cons cell or a string")))))
++ (define-key keymap (kbd key) def))
++ (setq key (pop more)
++ replacement (pop more))))
++
++;;;###autoload
++(defun which-key-add-key-based-replacements
++ (key-sequence replacement &rest more)
++ "Replace the description of KEY-SEQUENCE with REPLACEMENT.
++KEY-SEQUENCE is a string suitable for use in `kbd'. REPLACEMENT
++may either be a string, as in
++
++\(which-key-add-key-based-replacements \"C-x 1\" \"maximize\"\)
++
++a cons of two strings as in
++
++\(which-key-add-key-based-replacements \"C-x 8\"
++ \\='(\"unicode\" . \"Unicode keys\")\)
++
++or a function that takes a \(KEY . BINDING\) cons and returns a
++replacement.
++
++In the second case, the second string is used to provide a longer
++name for the keys under a prefix.
++
++MORE allows you to specifcy additional KEY REPLACEMENT pairs. All
++replacements are added to `which-key-replacement-alist'."
++ ;; TODO: Make interactive
++ (while key-sequence
++ ;; normalize key sequences before adding
++ (let ((key-seq (key-description (kbd key-sequence)))
++ (replace (or (and (functionp replacement) replacement)
++ (car-safe replacement)
++ replacement)))
++ (push (cons (cons (concat "\\`" (regexp-quote key-seq) "\\'") nil)
++ (if (functionp replace) replace (cons nil replace)))
++ which-key-replacement-alist)
++ (when (and (not (functionp replacement)) (consp replacement))
++ (push (cons key-seq (cdr-safe replacement))
++ which-key--prefix-title-alist)))
++ (setq key-sequence (pop more) replacement (pop more))))
++(put 'which-key-add-key-based-replacements 'lisp-indent-function 'defun)
++
++;;;###autoload
++(defun which-key-add-major-mode-key-based-replacements
++ (mode key-sequence replacement &rest more)
++ "Functions like `which-key-add-key-based-replacements'.
++The difference is that MODE specifies the `major-mode' that must
++be active for KEY-SEQUENCE and REPLACEMENT (MORE contains
++addition KEY-SEQUENCE REPLACEMENT pairs) to apply."
++ (declare (indent defun))
++ ;; TODO: Make interactive
++ (when (not (symbolp mode))
++ (error "`%S' should be a symbol corresponding to a value of major-mode" mode))
++ (let ((mode-alist
++ (or (cdr-safe (assq mode which-key-replacement-alist)) (list)))
++ (title-mode-alist
++ (or (cdr-safe (assq mode which-key--prefix-title-alist)) (list))))
++ (while key-sequence
++ ;; normalize key sequences before adding
++ (let ((key-seq (key-description (kbd key-sequence)))
++ (replace (or (and (functionp replacement) replacement)
++ (car-safe replacement)
++ replacement)))
++ (push (cons (cons (concat "\\`" (regexp-quote key-seq) "\\'") nil)
++ (if (functionp replace) replace (cons nil replace)))
++ mode-alist)
++ (when (and (not (functionp replacement)) (consp replacement))
++ (push (cons key-seq (cdr-safe replacement))
++ title-mode-alist)))
++ (setq key-sequence (pop more) replacement (pop more)))
++ (if (assq mode which-key-replacement-alist)
++ (setcdr (assq mode which-key-replacement-alist) mode-alist)
++ (push (cons mode mode-alist) which-key-replacement-alist))
++ (if (assq mode which-key--prefix-title-alist)
++ (setcdr (assq mode which-key--prefix-title-alist) title-mode-alist)
++ (push (cons mode title-mode-alist) which-key--prefix-title-alist))))
++
++(defun which-key-define-key-recursively (map key def &optional at-root)
++ "Recursively bind KEY in MAP to DEF on every level of MAP except the first.
++If AT-ROOT is non-nil the binding is also placed at the root of MAP."
++ (when at-root (define-key map key def))
++ (map-keymap
++ (lambda (_ev df)
++ (when (keymapp df)
++ (which-key-define-key-recursively df key def t)))
++ map))
++
++;;; Functions for computing window sizes
++
++(defun which-key--text-width-to-total (text-width)
++ "Convert window TEXT-WIDTH to window total-width.
++TEXT-WIDTH is the desired text width of the window. The function
++calculates what total width is required for a window in the
++selected to have a text-width of TEXT-WIDTH columns. The
++calculation considers possible fringes and scroll bars. This
++function assumes that the desired window has the same character
++width as the frame."
++ (let ((char-width (frame-char-width)))
++ (+ text-width
++ (/ (frame-fringe-width) char-width)
++ (/ (frame-scroll-bar-width) char-width)
++ (if (which-key--char-enlarged-p) 1 0)
++ ;; add padding to account for possible wide (unicode) characters
++ 3)))
++
++(defun which-key--total-width-to-text (total-width)
++ "Convert window TOTAL-WIDTH to window text-width.
++TOTAL-WIDTH is the desired total width of the window. The function calculates
++what text width fits such a window. The calculation considers possible fringes
++and scroll bars. This function assumes that the desired window has the same
++character width as the frame."
++ (let ((char-width (frame-char-width)))
++ (- total-width
++ (/ (frame-fringe-width) char-width)
++ (/ (frame-scroll-bar-width) char-width)
++ (if (which-key--char-enlarged-p) 1 0)
++ ;; add padding to account for possible wide (unicode) characters
++ 3)))
++
++(defun which-key--char-enlarged-p (&optional _frame)
++ (> (frame-char-width)
++ (/ (float (frame-pixel-width)) (window-total-width (frame-root-window)))))
++
++(defun which-key--char-reduced-p (&optional _frame)
++ (< (frame-char-width)
++ (/ (float (frame-pixel-width)) (window-total-width (frame-root-window)))))
++
++(defun which-key--char-exact-p (&optional _frame)
++ (= (frame-char-width)
++ (/ (float (frame-pixel-width)) (window-total-width (frame-root-window)))))
++
++(defun which-key--width-or-percentage-to-width (width-or-percentage)
++ "Return window total width.
++If WIDTH-OR-PERCENTAGE is a whole number, return it unchanged. Otherwise, it
++should be a percentage (a number between 0 and 1) out of the frame's width.
++More precisely, it should be a percentage out of the frame's root window's
++total width."
++ (if (natnump width-or-percentage)
++ width-or-percentage
++ (round (* width-or-percentage (window-total-width (frame-root-window))))))
++
++(defun which-key--height-or-percentage-to-height (height-or-percentage)
++ "Return window total height.
++If HEIGHT-OR-PERCENTAGE is a whole number, return it unchanged. Otherwise, it
++should be a percentage (a number between 0 and 1) out of the frame's height.
++More precisely, it should be a percentage out of the frame's root window's
++total height."
++ (if (natnump height-or-percentage)
++ height-or-percentage
++ (round (* height-or-percentage (window-total-height (frame-root-window))))))
++
++(defun which-key--frame-size-changed-p ()
++ "Non-nil if a change in frame size is detected."
++ (let ((new-size (cons (frame-width) (frame-height))))
++ (cond ((null which-key--previous-frame-size)
++ (setq which-key--previous-frame-size new-size)
++ nil)
++ ((not (equal which-key--previous-frame-size new-size))
++ (setq which-key--previous-frame-size new-size)))))
++
++;;; Show/hide which-key buffer
++
++(defun which-key--hide-popup ()
++ "This function is called to hide the which-key buffer."
++ (unless (or which-key-persistent-popup
++ (member real-this-command which-key--paging-functions))
++ (setq which-key--last-try-2-loc nil)
++ (setq which-key--pages-obj nil)
++ (setq which-key--automatic-display nil)
++ (setq which-key--prior-show-keymap-args nil)
++ (when (and which-key-idle-secondary-delay which-key--secondary-timer-active)
++ (which-key--start-timer))
++ (which-key--lighter-restore)
++ (which-key--hide-popup-ignore-command)))
++
++(defun which-key--hide-popup-ignore-command ()
++ "`which-key--hide-popup' without the check of `real-this-command'."
++ (cl-case which-key-popup-type
++ ;; Not necessary to hide minibuffer
++ ;; (minibuffer (which-key--hide-buffer-minibuffer))
++ (side-window (which-key--hide-buffer-side-window))
++ (frame (which-key--hide-buffer-frame))
++ (custom (funcall which-key-custom-hide-popup-function))))
++
++(defun which-key--hide-popup-on-frame-size-change (&optional _)
++ "Hide which-key popup if the frame is resized (to trigger a new popup)."
++ (when (which-key--frame-size-changed-p)
++ (which-key--hide-popup)))
++
++(defun which-key--hide-buffer-side-window ()
++ "Hide which-key buffer when side-window popup is used."
++ (when (buffer-live-p which-key--buffer)
++ ;; in case which-key buffer was shown in an existing window, `quit-window'
++ ;; will re-show the previous buffer, instead of closing the window
++ (quit-windows-on which-key--buffer)
++ (when (and which-key-preserve-window-configuration
++ which-key--saved-window-configuration)
++ (set-window-configuration which-key--saved-window-configuration)
++ (setq which-key--saved-window-configuration nil))))
++
++(defun which-key--hide-buffer-frame ()
++ "Hide which-key buffer when frame popup is used."
++ (when (frame-live-p which-key--frame)
++ (delete-frame which-key--frame)))
++
++(defun which-key--popup-showing-p ()
++ (and (bufferp which-key--buffer)
++ (or (window-live-p (get-buffer-window which-key--buffer))
++ (let ((window (get-buffer-window which-key--buffer t)))
++ (and (window-live-p window)
++ (frame-visible-p (window-frame window)))))))
++
++(defun which-key--show-popup (act-popup-dim)
++ "Show the which-key buffer.
++ACT-POPUP-DIM includes the dimensions, (height . width) of the
++buffer text to be displayed in the popup. Return nil if no window
++is shown, or if there is no need to start the closing timer."
++ (when (and (> (car act-popup-dim) 0)
++ (> (cdr act-popup-dim) 0))
++ (cl-case which-key-popup-type
++ ;; Not called for minibuffer
++ ;; (minibuffer (which-key--show-buffer-minibuffer act-popup-dim))
++ (side-window (which-key--show-buffer-side-window act-popup-dim))
++ (frame (which-key--show-buffer-frame act-popup-dim))
++ (custom (funcall which-key-custom-show-popup-function act-popup-dim)))))
++
++(defun which-key--fit-buffer-to-window-horizontally
++ (&optional window &rest params)
++ "Slightly modified version of `fit-buffer-to-window'.
++Use &rest params because `fit-buffer-to-window' has a different
++call signature in different emacs versions"
++ (let ((fit-window-to-buffer-horizontally t)
++ (window-min-height 1))
++ (apply #'fit-window-to-buffer window params)))
++
++(defun which-key--show-buffer-side-window (act-popup-dim)
++ "Show which-key buffer when popup type is side-window."
++ (when (and which-key-preserve-window-configuration
++ (not which-key--saved-window-configuration))
++ (setq which-key--saved-window-configuration (current-window-configuration)))
++ (let* ((height (car act-popup-dim))
++ (width (cdr act-popup-dim))
++ (alist
++ (if which-key-allow-imprecise-window-fit
++ `((window-width . ,(which-key--text-width-to-total width))
++ (window-height . ,height)
++ (side . ,which-key-side-window-location)
++ (slot . ,which-key-side-window-slot))
++ `((window-width . which-key--fit-buffer-to-window-horizontally)
++ (window-height . (lambda (w) (fit-window-to-buffer w nil 1)))
++ (side . ,which-key-side-window-location)
++ (slot . ,which-key-side-window-slot)))))
++ (which-key--debug-message "Allow imprecise fit: %s
++Display window alist: %s"
++ which-key-allow-imprecise-window-fit
++ alist)
++ ;; Previously used `display-buffer-in-major-side-window' here, but
++ ;; apparently that is meant to be an internal function. See emacs bug #24828
++ ;; and advice given there.
++ (cond
++ ((eq which-key--multiple-locations t)
++ ;; possibly want to switch sides in this case so we can't reuse the window
++ (delete-windows-on which-key--buffer)
++ (display-buffer-in-side-window which-key--buffer alist))
++ ((get-buffer-window which-key--buffer)
++ (display-buffer-reuse-window which-key--buffer alist))
++ (t
++ (display-buffer-in-side-window which-key--buffer alist)))))
++
++(defun which-key--show-buffer-frame (act-popup-dim)
++ "Show which-key buffer when popup type is frame."
++ (let* (;(orig-window (selected-window))
++ (frame-height (+ (car act-popup-dim)
++ (if (with-current-buffer which-key--buffer
++ mode-line-format)
++ 1
++ 0)))
++ ;; without adding 2, frame sometimes isn't wide enough for the buffer.
++ ;; this is probably because of the fringes. however, setting fringes
++ ;; sizes to 0 (instead of adding 2) didn't always make the frame wide
++ ;; enough. don't know why it is so.
++ (frame-width (+ (cdr act-popup-dim) 2))
++ (new-window (if (and (frame-live-p which-key--frame)
++ (eq which-key--buffer
++ (window-buffer
++ (frame-root-window which-key--frame))))
++ (which-key--show-buffer-reuse-frame
++ frame-height frame-width)
++ (which-key--show-buffer-new-frame
++ frame-height frame-width))))
++ (when new-window
++ ;; display successful
++ (setq which-key--frame (window-frame new-window))
++ new-window)))
++
++(defun which-key--show-buffer-new-frame (frame-height frame-width)
++ "Helper for `which-key--show-buffer-frame'."
++ (let* ((frame-params `((height . ,frame-height)
++ (width . ,frame-width)
++ ;; tell the window manager to respect the given sizes
++ (user-size . t)
++ ;; which-key frame doesn't need a minibuffer
++ (minibuffer . nil)
++ (name . "which-key")
++ ;; no need for scroll bars in which-key frame
++ (vertical-scroll-bars . nil)
++ ;; (left-fringe . 0)
++ ;; (right-fringe . 0)
++ ;; (right-divider-width . 0)
++ ;; make sure frame is visible
++ (visibility . t)))
++ (alist `((pop-up-frame-parameters . ,frame-params)))
++ (orig-frame (selected-frame))
++ (new-window (display-buffer-pop-up-frame which-key--buffer alist)))
++ (when new-window
++ ;; display successful
++ (redirect-frame-focus (window-frame new-window) orig-frame)
++ new-window)))
++
++(defun which-key--show-buffer-reuse-frame (frame-height frame-width)
++ "Helper for `which-key--show-buffer-frame'."
++ (let ((window
++ (display-buffer-reuse-window
++ which-key--buffer `((reusable-frames . ,which-key--frame)))))
++ (when window
++ ;; display successful
++ (set-frame-size (window-frame window) frame-width frame-height)
++ window)))
++
++;;; Max dimension of available window functions
++
++(defun which-key--popup-max-dimensions ()
++ "Return maximum dimension available for popup.
++Dimension functions should return the maximum possible (height
++. width) of the intended popup. SELECTED-WINDOW-WIDTH is the
++width of currently active window, not the which-key buffer
++window."
++ (cl-ecase which-key-popup-type
++ (minibuffer (which-key--minibuffer-max-dimensions))
++ (side-window (which-key--side-window-max-dimensions))
++ (frame (which-key--frame-max-dimensions))
++ (custom (funcall which-key-custom-popup-max-dimensions-function
++ (window-width)))))
++
++(defun which-key--minibuffer-max-dimensions ()
++ "Return max-dimensions of minibuffer (height . width).
++Measured in lines and characters respectively."
++ (cons
++ ;; height
++ (if (floatp max-mini-window-height)
++ (floor (* (frame-text-lines)
++ max-mini-window-height))
++ max-mini-window-height)
++ ;; width
++ (max 0 (- (frame-text-cols) which-key-unicode-correction))))
++
++(defun which-key--side-window-max-dimensions ()
++ "Return max-dimensions of the side-window popup.
++The return value should be (height . width) in lines and
++characters respectively."
++ (cons
++ ;; height
++ (if (member which-key-side-window-location '(left right))
++ ;; 1 is a kludge to make sure there is no overlap
++ (- (frame-height) (window-text-height (minibuffer-window)) 1)
++ ;; (window-mode-line-height which-key--window))
++ ;; FIXME: change to something like
++ ;; (min which-*-height (calculate-max-height))
++ (which-key--height-or-percentage-to-height
++ which-key-side-window-max-height))
++ ;; width
++ (max 0
++ (- (if (memq which-key-side-window-location '(left right))
++ (which-key--total-width-to-text
++ (which-key--width-or-percentage-to-width
++ which-key-side-window-max-width))
++ (which-key--total-width-to-text
++ (which-key--width-or-percentage-to-width
++ 1.0)))
++ which-key-unicode-correction))))
++
++(defun which-key--frame-max-dimensions ()
++ "Return max-dimensions of the frame popup.
++The return value should be (height . width) in lines and
++characters respectively."
++ (cons which-key-frame-max-height which-key-frame-max-width))
++
++;;; Sorting functions
++
++(defun which-key--string< (a b &optional alpha)
++ (let ((da (downcase a))
++ (db (downcase b)))
++ (cond
++ ((and alpha (not which-key-sort-uppercase-first))
++ (if (string-equal da db)
++ (not (string-lessp a b))
++ (string-lessp da db)))
++ ((and alpha which-key-sort-uppercase-first)
++ (if (string-equal da db)
++ (string-lessp a b)
++ (string-lessp da db)))
++ ((not which-key-sort-uppercase-first)
++ (let ((aup (not (string-equal da a)))
++ (bup (not (string-equal db b))))
++ (if (eq aup bup)
++ (string-lessp a b)
++ bup)))
++ (t (string-lessp a b)))))
++
++(defun which-key--key-description< (a b &optional alpha)
++ "Key sorting function.
++Used for `which-key-key-order' and `which-key-key-order-alpha'."
++ (save-match-data
++ (let* ((a (which-key--extract-key a))
++ (b (which-key--extract-key b))
++ (rngrgxp "^\\([^ ]+\\) \\.\\. [^ ]+")
++ (a (if (string-match rngrgxp a) (match-string 1 a) a))
++ (b (if (string-match rngrgxp b) (match-string 1 b) b))
++ (aem? (string-equal a ""))
++ (bem? (string-equal b ""))
++ (a1? (= 1 (length a)))
++ (b1? (= 1 (length b)))
++ (srgxp "^\\(RET\\|SPC\\|TAB\\|DEL\\|LFD\\|ESC\\|NUL\\)")
++ (asp? (string-match-p srgxp a))
++ (bsp? (string-match-p srgxp b))
++ (prrgxp "^\\(M\\|C\\|S\\|A\\|H\\|s\\)-")
++ (apr? (string-match-p prrgxp a))
++ (bpr? (string-match-p prrgxp b))
++ (afn? (string-match-p "<f[0-9]+>" a))
++ (bfn? (string-match-p "<f[0-9]+>" b)))
++ (cond ((or aem? bem?) (and aem? (not bem?)))
++ ((and asp? bsp?)
++ (if (string-equal (substring a 0 3) (substring b 0 3))
++ (which-key--key-description<
++ (substring a 3) (substring b 3) alpha)
++ (which-key--string< a b alpha)))
++ ((or asp? bsp?) asp?)
++ ((and a1? b1?) (which-key--string< a b alpha))
++ ((or a1? b1?) a1?)
++ ((and afn? bfn?)
++ (< (string-to-number
++ (replace-regexp-in-string "<f\\([0-9]+\\)>" "\\1" a))
++ (string-to-number
++ (replace-regexp-in-string "<f\\([0-9]+\\)>" "\\1" b))))
++ ((or afn? bfn?) afn?)
++ ((and apr? bpr?)
++ (if (string-equal (substring a 0 2) (substring b 0 2))
++ (which-key--key-description<
++ (substring a 2) (substring b 2) alpha)
++ (which-key--string< a b alpha)))
++ ((or apr? bpr?) apr?)
++ (t (which-key--string< a b alpha))))))
++
++(defsubst which-key-key-order-alpha (acons bcons)
++ "Order key descriptions A and B.
++Order is lexicographic within a \"class\", where the classes and
++the ordering of classes are listed below.
++
++special (SPC,TAB,...) < single char < mod (C-,M-,...) < other.
++Sorts single characters alphabetically with lowercase coming
++before upper."
++ (which-key--key-description< (car acons) (car bcons) t))
++
++(defsubst which-key-key-order (acons bcons)
++ "Order key descriptions A and B.
++Order is lexicographic within a \"class\", where the classes and
++the ordering of classes are listed below.
++
++special (SPC,TAB,...) < single char < mod (C-,M-,...) < other."
++ (which-key--key-description< (car acons) (car bcons)))
++
++(defsubst which-key-description-order (acons bcons)
++ "Order descriptions of A and B.
++Uses `string-lessp' after applying lowercase."
++ (string-lessp (downcase (cdr acons)) (downcase (cdr bcons))))
++
++(defsubst which-key--group-p (description)
++ (or (string-equal description "prefix")
++ (string-match-p "^group:" description)
++ (keymapp (intern description))))
++
++(defun which-key-prefix-then-key-order (acons bcons)
++ "Order prefixes before non-prefixes.
++Within these categories order using `which-key-key-order'."
++ (let ((apref? (which-key--group-p (cdr acons)))
++ (bpref? (which-key--group-p (cdr bcons))))
++ (if (not (eq apref? bpref?))
++ (and (not apref?) bpref?)
++ (which-key-key-order acons bcons))))
++
++(defun which-key-prefix-then-key-order-reverse (acons bcons)
++ "Order prefixes before non-prefixes.
++Within these categories order using `which-key-key-order'."
++ (let ((apref? (which-key--group-p (cdr acons)))
++ (bpref? (which-key--group-p (cdr bcons))))
++ (if (not (eq apref? bpref?))
++ (and apref? (not bpref?))
++ (which-key-key-order acons bcons))))
++
++(defun which-key-local-then-key-order (acons bcons)
++ "Order local bindings before non-local ones.
++Within these categories order using `which-key-key-order'."
++ (let ((aloc? (which-key--local-binding-p acons))
++ (bloc? (which-key--local-binding-p bcons)))
++ (if (not (eq aloc? bloc?))
++ (and aloc? (not bloc?))
++ (which-key-key-order acons bcons))))
++
++;;; Functions for retrieving and formatting keys
++
++(defsubst which-key--string-width (maybe-string)
++ "If MAYBE-STRING is a string use `which-key--string-width' o/w return 0."
++ (if (stringp maybe-string) (string-width maybe-string) 0))
++
++(defsubst which-key--butlast-string (str)
++ (string-join (butlast (split-string str)) " "))
++
++(defun which-key--match-replacement (key-binding replacement)
++ ;; these are mode specific ones to ignore. The mode specific case is
++ ;; handled in the selection of alist
++ (when (and (consp key-binding) (not (symbolp (car replacement))))
++ (let ((key-regexp (caar replacement))
++ (binding-regexp (cdar replacement))
++ (case-fold-search nil))
++ (and (or (null key-regexp)
++ (string-match-p key-regexp
++ (car key-binding)))
++ (or (null binding-regexp)
++ (string-match-p binding-regexp
++ (cdr key-binding)))))))
++
++(defsubst which-key--replace-in-binding (key-binding repl)
++ (cond ((or (not (consp repl)) (null (cdr repl)))
++ key-binding)
++ ((functionp (cdr repl))
++ (funcall (cdr repl) key-binding))
++ ((consp (cdr repl))
++ (cons
++ (cond ((and (caar repl) (cadr repl))
++ (replace-regexp-in-string
++ (caar repl) (cadr repl) (car key-binding) t))
++ ((cadr repl) (cadr repl))
++ (t (car key-binding)))
++ (cond ((and (cdar repl) (cddr repl))
++ (replace-regexp-in-string
++ (cdar repl) (cddr repl) (cdr key-binding) t))
++ ((cddr repl) (cddr repl))
++ (t (cdr key-binding)))))))
++
++(defun which-key--replace-in-repl-list-once (key-binding repls)
++ (cl-dolist (repl repls)
++ (when (which-key--match-replacement key-binding repl)
++ (cl-return `(replaced . ,(which-key--replace-in-binding key-binding repl))))))
++
++(defun which-key--replace-in-repl-list-many (key-binding repls)
++ (let (found)
++ (dolist (repl repls)
++ (when (which-key--match-replacement key-binding repl)
++ (setq found t)
++ (setq key-binding (which-key--replace-in-binding key-binding repl))))
++ (when found `(replaced . ,key-binding))))
++
++(defun which-key--maybe-replace (key-binding)
++ "Use `which-key--replacement-alist' to maybe replace KEY-BINDING.
++KEY-BINDING is a cons cell of the form \(KEY . BINDING\) each of
++which are strings. KEY is of the form produced by `key-binding'."
++ (let* ((replacer (if which-key-allow-multiple-replacements
++ #'which-key--replace-in-repl-list-many
++ #'which-key--replace-in-repl-list-once)))
++ (pcase
++ (apply replacer
++ (list key-binding
++ (cdr-safe (assq major-mode which-key-replacement-alist))))
++ (`(replaced . ,repl)
++ (if which-key-allow-multiple-replacements
++ (pcase (apply replacer (list repl which-key-replacement-alist))
++ (`(replaced . ,repl) repl)
++ ('() repl))
++ repl))
++ ('()
++ (pcase (apply replacer (list key-binding which-key-replacement-alist))
++ (`(replaced . ,repl) repl)
++ ('() key-binding))))))
++
++(defsubst which-key--current-key-list (&optional key-str)
++ (append (listify-key-sequence (which-key--current-prefix))
++ (when key-str
++ (listify-key-sequence (kbd key-str)))))
++
++(defsubst which-key--current-key-string (&optional key-str)
++ (key-description (which-key--current-key-list key-str)))
++
++(defun which-key--local-binding-p (keydesc)
++ (eq (which-key--safe-lookup-key-description
++ (current-local-map)
++ (which-key--current-key-string (car keydesc)))
++ (intern (cdr keydesc))))
++
++(defun which-key--map-binding-p (map keydesc)
++ "Does MAP contain KEYDESC = (key . binding)?"
++ (or
++ (when (bound-and-true-p evil-state)
++ (let ((lookup
++ (which-key--safe-lookup-key-description
++ map
++ (which-key--current-key-string
++ (format "<%s-state> %s" evil-state (car keydesc))))))
++ (or (eq lookup (intern (cdr keydesc)))
++ (and (keymapp lookup) (string= (cdr keydesc) "Prefix Command")))))
++ (let ((lookup
++ (which-key--safe-lookup-key-description
++ map (which-key--current-key-string (car keydesc)))))
++ (or (eq lookup (intern (cdr keydesc)))
++ (and (keymapp lookup) (string= (cdr keydesc) "Prefix Command"))))))
++
++(defun which-key--maybe-get-prefix-title (keys)
++ "KEYS is a string produced by `key-description'.
++A title is possibly returned using
++`which-key--prefix-title-alist'. An empty string is returned if
++no title exists."
++ (cond
++ ((not (string-equal keys ""))
++ (let* ((title-res
++ (cdr-safe (assoc-string keys which-key--prefix-title-alist)))
++ (repl-res
++ (cdr-safe (which-key--maybe-replace (cons keys ""))))
++ (binding (key-binding (kbd keys)))
++ (alternate (when (and binding (symbolp binding))
++ (symbol-name binding))))
++ (cond (title-res title-res)
++ ((not (string-empty-p repl-res)) repl-res)
++ ((and (eq which-key-show-prefix 'echo) alternate)
++ alternate)
++ ((and (member which-key-show-prefix '(bottom top mode-line))
++ (eq which-key-side-window-location 'bottom)
++ echo-keystrokes)
++ (if alternate alternate
++ (concat "Following " keys)))
++ (t ""))))
++ (t "")))
++
++(defun which-key--propertize (string &rest properties)
++ "Version of `propertize' that checks type of STRING."
++ (when (stringp string)
++ (apply #'propertize string properties)))
++
++(defun which-key--propertize-key (key)
++ "Add a face to KEY.
++If KEY contains any \"special keys\" defined in
++`which-key-special-keys' then truncate and add the corresponding
++`which-key-special-key-face'."
++ (let ((key-w-face (which-key--propertize key 'face 'which-key-key-face))
++ (regexp (concat "\\("
++ (mapconcat #'identity which-key-special-keys
++ "\\|")
++ "\\)"))
++ (case-fold-search nil))
++ (save-match-data
++ (if (and which-key-special-keys
++ (string-match regexp key))
++ (let ((beg (match-beginning 0)) (end (match-end 0)))
++ (concat (substring key-w-face 0 beg)
++ (which-key--propertize (substring key-w-face beg (1+ beg))
++ 'face 'which-key-special-key-face)
++ (substring key-w-face end
++ (which-key--string-width key-w-face))))
++ key-w-face))))
++
++(defsubst which-key--truncate-description (desc avl-width)
++ "Truncate DESC description to `which-key-max-description-length'."
++ (let* ((max which-key-max-description-length)
++ (max (cl-etypecase max
++ (null nil)
++ (integer max)
++ (float (truncate (* max avl-width)))
++ (function (let ((val (funcall max avl-width)))
++ (if (floatp val) (truncate val) val))))))
++ (if (and max (> (length desc) max))
++ (let ((dots (and (not (equal which-key-ellipsis ""))
++ (which-key--propertize
++ which-key-ellipsis 'face
++ (get-text-property (1- (length desc)) 'face desc)))))
++ (if dots
++ (concat (substring desc 0 (- max (length dots))) dots)
++ (substring desc 0 max)))
++ desc)))
++
++(defun which-key--highlight-face (description)
++ "Return the highlight face for DESCRIPTION if it has one."
++ (let (face)
++ (dolist (el which-key-highlighted-command-list)
++ (unless face
++ (cond ((consp el)
++ (when (string-match-p (car el) description)
++ (setq face (cdr el))))
++ ((stringp el)
++ (when (string-match-p el description)
++ (setq face 'which-key-highlighted-command-face)))
++ (t
++ (message "which-key: warning: element %s of \
++which-key-highlighted-command-list is not a string or a cons
++cell" el)))))
++ face))
++
++(defun which-key--propertize-description
++ (description group local hl-face &optional original-description)
++ "Add face to DESCRIPTION.
++The face chosen depends on whether the description represents a
++group or a command. Also make some minor adjustments to the
++description string, like removing a \"group:\" prefix.
++
++ORIGINAL-DESCRIPTION is the description given by
++`describe-buffer-bindings'."
++ (when description
++ (let* ((desc description)
++ (desc (if (string-match-p "^group:" desc)
++ (substring desc 6) desc))
++ (desc (if group (concat which-key-prefix-prefix desc) desc)))
++ (make-text-button
++ desc nil
++ 'face (cond (hl-face hl-face)
++ (group 'which-key-group-description-face)
++ (local 'which-key-local-map-description-face)
++ (t 'which-key-command-description-face))
++ 'help-echo (cond
++ ((and original-description
++ (fboundp (intern original-description))
++ (documentation (intern original-description))
++ ;; tooltip-mode doesn't exist in emacs-nox
++ (boundp 'tooltip-mode) tooltip-mode)
++ (documentation (intern original-description)))
++ ((and original-description
++ (fboundp (intern original-description))
++ (documentation (intern original-description))
++ (let* ((doc (documentation
++ (intern original-description)))
++ (str (replace-regexp-in-string "\n" " " doc))
++ (max (floor (* (frame-width) 0.8))))
++ (if (> (length str) max)
++ (concat (substring str 0 max) "...")
++ str)))))))))
++
++(defun which-key--extract-key (key-str)
++ "Pull the last key (or key range) out of KEY-STR."
++ (save-match-data
++ (let ((key-range-regexp "\\`.*\\([^ \t]+ \\.\\. [^ \t]+\\)\\'"))
++ (if (string-match key-range-regexp key-str)
++ (match-string 1 key-str)
++ (car (last (split-string key-str " ")))))))
++
++(defun which-key--maybe-add-docstring (current original)
++ "Maybe concat a docstring to CURRENT and return result.
++Specifically, do this if ORIGINAL is a command with a docstring
++and `which-key-show-docstrings' is non-nil. If
++`which-key-show-docstrings' is the symbol docstring-only, just
++return the docstring."
++ (let* ((orig-sym (intern original))
++ (doc (when (commandp orig-sym)
++ (documentation orig-sym)))
++ (doc (when doc
++ (replace-regexp-in-string
++ (concat "^\\(?::"
++ (regexp-opt '("around" "override"
++ "after" "after-until" "after-while"
++ "before" "before-until" "before-while"
++ "filter-args" "filter-return"))
++ " advice: [^\n]+\n"
++ "\\)+\n")
++ "" doc)))
++ (docstring (when doc
++ (which-key--propertize (car (split-string doc "\n"))
++ 'face 'which-key-docstring-face))))
++ (cond ((not (and which-key-show-docstrings docstring))
++ current)
++ ((eq which-key-show-docstrings 'docstring-only)
++ docstring)
++ (t
++ (format "%s %s" current docstring)))))
++
++(defun which-key--format-and-replace (unformatted &optional preserve-full-key)
++ "Make list of key bindings with separators and descriptions.
++Take a list of (key . desc) cons cells in UNFORMATTED, add
++faces and perform replacements according to the three replacement
++alists. Returns a list (key separator description)."
++ (let ((sep-w-face
++ (which-key--propertize which-key-separator
++ 'face 'which-key-separator-face))
++ (local-map (current-local-map))
++ (avl-width (cdr (which-key--popup-max-dimensions)))
++ new-list)
++ (dolist (key-binding unformatted)
++ (let* ((keys (car key-binding))
++ (orig-desc (cdr key-binding))
++ (group (which-key--group-p orig-desc))
++ (local (eq (which-key--safe-lookup-key-description
++ local-map keys)
++ (intern orig-desc)))
++ (hl-face (which-key--highlight-face orig-desc))
++ (key-binding (which-key--maybe-replace key-binding))
++ (final-desc (which-key--propertize-description
++ (cdr key-binding) group local hl-face orig-desc)))
++ (when final-desc
++ (setq final-desc
++ (which-key--truncate-description
++ (which-key--maybe-add-docstring final-desc orig-desc)
++ avl-width)))
++ (when (consp key-binding)
++ (push
++ (list (which-key--propertize-key
++ (if preserve-full-key
++ (car key-binding)
++ (which-key--extract-key (car key-binding))))
++ sep-w-face
++ final-desc)
++ new-list))))
++ (nreverse new-list)))
++
++(defun which-key--compute-binding (binding)
++ "Replace BINDING with remapped binding if it exists.
++Requires `which-key-compute-remaps' to be non-nil."
++ (copy-sequence (symbol-name
++ (or (and which-key-compute-remaps
++ (command-remapping binding))
++ binding))))
++
++(defun which-key--get-menu-item-binding (def)
++ "Retrieve binding for menu-item"
++ ;; see `keymap--menu-item-binding'
++ (let* ((binding (nth 2 def))
++ (plist (nthcdr 3 def))
++ (filter (plist-get plist :filter)))
++ (if filter (funcall filter binding) binding)))
++
++(defun which-key--get-keymap-bindings-1
++ (keymap start &optional prefix filter all ignore-commands)
++ "See `which-key--get-keymap-bindings'."
++ (let ((bindings start)
++ (prefix-map (if prefix (lookup-key keymap prefix) keymap)))
++ (when (keymapp prefix-map)
++ (map-keymap
++ (lambda (ev def)
++ (let* ((key (vconcat prefix (list ev)))
++ (key-desc (key-description key)))
++ (cond
++ ((assoc key-desc bindings))
++ ((and (listp ignore-commands) (symbolp def) (memq def ignore-commands)))
++ ((or (string-match-p
++ which-key--ignore-non-evil-keys-regexp key-desc)
++ (eq ev 'menu-bar)))
++ ((and (keymapp def)
++ (string-match-p which-key--evil-keys-regexp key-desc)))
++ ((and (keymapp def)
++ (or all
++ ;; event 27 is escape, so this will pick up meta
++ ;; bindings and hopefully not too much more
++ (eql ev 27)))
++ (setq bindings
++ (which-key--get-keymap-bindings-1
++ keymap bindings key nil all ignore-commands)))
++ (def
++ (let* ((def (if (eq 'menu-item (car-safe def))
++ (which-key--get-menu-item-binding def)
++ def))
++ (binding
++ (cons key-desc
++ (cond
++ ((symbolp def) (which-key--compute-binding def))
++ ((keymapp def) "prefix")
++ ((functionp def)
++ (cond
++ ((eq 'lambda (car-safe def)) "lambda")
++ ((eq 'closure (car-safe def)) "closure")
++ (t "function")))
++ ((stringp def) def)
++ ((vectorp def) (key-description def))
++ ((and (consp def)
++ ;; looking for (STRING . DEFN)
++ (stringp (car def)))
++ (concat (when (keymapp (cdr-safe def))
++ "group:")
++ (car def)))
++ (t "unknown")))))
++ (when (or (null filter)
++ (and (functionp filter)
++ (funcall filter binding)))
++ (push binding bindings)))))))
++ prefix-map))
++ bindings))
++
++(defun which-key--get-keymap-bindings
++ (keymap &optional start prefix filter all evil)
++ "Retrieve top-level bindings from KEYMAP.
++PREFIX limits bindings to those starting with this key
++sequence. START is a list of existing bindings to add to. If ALL
++is non-nil, recursively retrieve all bindings below PREFIX. If
++EVIL is non-nil, extract active evil bidings."
++ (let ((bindings start)
++ (ignore '(self-insert-command ignore ignore-event company-ignore))
++ (evil-map
++ (when (and evil (bound-and-true-p evil-local-mode))
++ (lookup-key keymap (kbd (format "<%s-state>" evil-state))))))
++ (when (keymapp evil-map)
++ (setq bindings (which-key--get-keymap-bindings-1
++ evil-map bindings prefix filter all ignore)))
++ (which-key--get-keymap-bindings-1
++ keymap bindings prefix filter all ignore)))
++
++(defun which-key--get-current-bindings (&optional prefix filter)
++ "Generate a list of current active bindings."
++ (let (bindings)
++ (dolist (map (current-active-maps t) bindings)
++ (when (cdr map)
++ (setq bindings
++ (which-key--get-keymap-bindings
++ map bindings prefix filter))))))
++
++(defun which-key--get-bindings (&optional prefix keymap filter recursive)
++ "Collect key bindings.
++If KEYMAP is nil, collect from current buffer using the current
++key sequence as a prefix. Otherwise, collect from KEYMAP. FILTER
++is a function to use to filter the bindings. If RECURSIVE is
++non-nil, then bindings are collected recursively for all prefixes."
++ (let* ((unformatted
++ (cond ((keymapp keymap)
++ (which-key--get-keymap-bindings
++ keymap nil prefix filter recursive))
++ (keymap
++ (error "%s is not a keymap" keymap))
++ (t
++ (which-key--get-current-bindings prefix filter)))))
++ (when which-key-sort-order
++ (setq unformatted
++ (sort unformatted which-key-sort-order)))
++ (which-key--format-and-replace unformatted recursive)))
++
++;;; Functions for laying out which-key buffer pages
++
++(defun which-key--normalize-columns (columns)
++ "Pad COLUMNS to the same length using empty strings."
++ (let ((max-len (cl-reduce (lambda (a x) (max a (length x))) columns
++ :initial-value 0)))
++ (mapcar
++ (lambda (c)
++ (if (< (length c) max-len)
++ (append c (make-list (- max-len (length c)) ""))
++ c))
++ columns)))
++
++(defsubst which-key--join-columns (columns)
++ "Transpose columns into rows, concat rows into lines and rows into page."
++ (let* ((padded (which-key--normalize-columns (nreverse columns)))
++ (rows (apply #'cl-mapcar #'list padded)))
++ (mapconcat (lambda (row) (mapconcat #'identity row " ")) rows "\n")))
++
++(defsubst which-key--max-len (keys index &optional initial-value)
++ "Find the max length of the INDEX element in each of KEYS."
++ (cl-reduce
++ (lambda (x y) (max x (which-key--string-width (nth index y))))
++ keys :initial-value (if initial-value initial-value 0)))
++
++(defun which-key--pad-column (col-keys avl-width)
++ "Pad cells of COL-KEYS to AVL-WIDTH.
++Take a column of (key separator description) COL-KEYS,
++calculate the max width in the column and pad all cells out to
++that width."
++ (let* ((col-key-width (+ which-key-add-column-padding
++ (which-key--max-len col-keys 0)))
++ (col-sep-width (which-key--max-len col-keys 1))
++ (avl-width (- avl-width col-key-width col-sep-width))
++ (col-desc-width (min avl-width
++ (which-key--max-len
++ col-keys 2
++ which-key-min-column-description-width)))
++ (col-width (+ col-key-width col-sep-width col-desc-width))
++ (col-format (concat "%" (int-to-string col-key-width)
++ "s%s%-" (int-to-string col-desc-width) "s")))
++ (cons col-width
++ (mapcar (lambda (k) (apply #'format col-format k))
++ col-keys))))
++
++(defun which-key--partition-list (n list)
++ "Partition LIST into N-sized sublists."
++ (let (res)
++ (while list
++ (setq res (cons (cl-subseq list 0 (min n (length list))) res)
++ list (nthcdr n list)))
++ (nreverse res)))
++
++(defun which-key--list-to-pages (keys avl-lines avl-width)
++ "Convert list of KEYS to columns based on dimensions AVL-LINES and AVL-WIDTH.
++Returns a `which-key--pages' object that holds the page strings,
++as well as metadata."
++ (let ((cols-w-widths (mapcar (lambda (c) (which-key--pad-column c avl-width))
++ (which-key--partition-list avl-lines keys)))
++ (page-width 0) (n-pages 0) (n-keys 0) (n-columns 0)
++ page-cols pages page-widths keys/page col)
++ (if (> (apply #'max (mapcar #'car cols-w-widths)) avl-width)
++ ;; give up if no columns fit
++ nil
++ (while cols-w-widths
++ ;; start new page
++ (cl-incf n-pages)
++ (setq col (pop cols-w-widths))
++ (setq page-cols (list (cdr col)))
++ (setq page-width (car col))
++ (setq n-keys (length (cdr col)))
++ (setq n-columns 1)
++ ;; add additional columns as long as they fit
++ (while (and cols-w-widths
++ (or (null which-key-max-display-columns)
++ (< n-columns which-key-max-display-columns))
++ (<= (+ page-width 1 (caar cols-w-widths)) avl-width))
++ (setq col (pop cols-w-widths))
++ (push (cdr col) page-cols)
++ (cl-incf page-width (1+ (car col)))
++ (cl-incf n-keys (length (cdr col)))
++ (cl-incf n-columns))
++ (push (which-key--join-columns page-cols) pages)
++ (push n-keys keys/page)
++ (push page-width page-widths))
++ (make-which-key--pages
++ :pages (nreverse pages)
++ :height (if (> n-pages 1) avl-lines (min avl-lines n-keys))
++ :widths (nreverse page-widths)
++ :keys/page (reverse keys/page)
++ :page-nums (number-sequence 1 n-pages)
++ :num-pages n-pages
++ :total-keys (apply #'+ keys/page)))))
++
++(defun which-key--create-pages-1
++ (keys available-lines available-width &optional min-lines vertical)
++ "Create page strings using `which-key--list-to-pages'.
++Will try to find the best number of rows and columns using the
++given dimensions and the length and widths of ITEMS. Use VERTICAL
++if the ITEMS are laid out vertically and the number of columns
++should be minimized."
++ (let ((result (which-key--list-to-pages
++ keys available-lines available-width))
++ (min-lines (or min-lines 0))
++ found prev-result)
++ (if (or (null result)
++ vertical
++ (> (which-key--pages-num-pages result) 1)
++ (= 1 available-lines))
++ result
++ ;; simple search for a fitting page
++ (while (and (> available-lines min-lines)
++ (not found))
++ (setq available-lines (cl-decf available-lines)
++ prev-result result
++ result (which-key--list-to-pages
++ keys available-lines available-width)
++ found (> (which-key--pages-num-pages result) 1)))
++ (if found prev-result result))))
++
++(defun which-key--create-pages (keys &optional prefix-keys prefix-title)
++ "Create page strings using `which-key--list-to-pages'.
++Will try to find the best number of rows and columns using the
++given dimensions and the length and wdiths of KEYS. SEL-WIN-WIDTH
++is the width of the live window."
++ (let* ((max-dims (which-key--popup-max-dimensions))
++ (max-lines (car max-dims))
++ (max-width (cdr max-dims))
++ (prefix-desc (key-description prefix-keys))
++ (full-prefix (which-key--full-prefix prefix-desc))
++ (prefix (when (eq which-key-show-prefix 'left)
++ (+ 2 (which-key--string-width full-prefix))))
++ (prefix-top-bottom (member which-key-show-prefix '(bottom top)))
++ (avl-lines (if prefix-top-bottom (- max-lines 1) max-lines))
++ (min-lines (min avl-lines which-key-min-display-lines))
++ (avl-width (if prefix (- max-width prefix) max-width))
++ (vertical (or (and (eq which-key-popup-type 'side-window)
++ (member which-key-side-window-location '(left right)))
++ (eq which-key-max-display-columns 1)))
++ result)
++ (setq result
++ (which-key--create-pages-1
++ keys avl-lines avl-width min-lines vertical))
++ (when (and result
++ (> (which-key--pages-num-pages result) 0))
++ (setf (which-key--pages-prefix result) prefix-keys)
++ (setf (which-key--pages-prefix-title result)
++ (or prefix-title
++ (which-key--maybe-get-prefix-title
++ (key-description prefix-keys))))
++ (when prefix-top-bottom
++ ;; Add back the line earlier reserved for the page information.
++ (setf (which-key--pages-height result) max-lines))
++ (when (and (= (which-key--pages-num-pages result) 1)
++ (> which-key-min-display-lines
++ (which-key--pages-height result)))
++ ;; result is shorter than requested, so we artificially increase the
++ ;; height. See #325. Note this only has an effect if
++ ;; `which-key-allow-imprecise-window-fit' is non-nil.
++ (setf (which-key--pages-height result) which-key-min-display-lines))
++ (which-key--debug-message "Frame height: %s
++Frame pixel width: %s
++Frame char width: %s
++Frame width: %s
++Which-key initial width: %s
++Which-key adjusted width: %s
++Minibuffer height: %s
++Max dimensions: (%s, %s)
++Available for bindings: (%s, %s)
++Popup type info: (%s, %s, %s)
++Computed page widths: %s
++Actual lines: %s"
++ (frame-height)
++ (frame-pixel-width)
++ (frame-char-width)
++ (window-total-width (frame-root-window))
++ (which-key--width-or-percentage-to-width
++ which-key-side-window-max-width)
++ (which-key--total-width-to-text
++ (which-key--width-or-percentage-to-width
++ which-key-side-window-max-width))
++ (window-text-height (minibuffer-window))
++ max-lines
++ max-width
++ avl-lines
++ avl-width
++ which-key-popup-type
++ which-key-side-window-location
++ which-key-side-window-max-width
++ (which-key--pages-widths result)
++ (which-key--pages-height result))
++ result)))
++
++(defun which-key--lighter-status ()
++ "Possibly show number of keys and total in the mode line."
++ (when which-key-show-remaining-keys
++ (let ((n-shown (car (which-key--pages-keys/page which-key--pages-obj)))
++ (n-tot (which-key--pages-total-keys which-key--pages-obj)))
++ (setcar (cdr (assq 'which-key-mode minor-mode-alist))
++ (format " WK: %s/%s keys" n-shown n-tot)))))
++
++(defun which-key--lighter-restore ()
++ "Restore the lighter for which-key."
++ (when which-key-show-remaining-keys
++ (setcar (cdr (assq 'which-key-mode minor-mode-alist))
++ which-key-lighter)))
++
++(defun which-key--echo (text)
++ "Echo TEXT to minibuffer without logging."
++ (let (message-log-max)
++ (message "%s" text)))
++
++(defun which-key--next-page-hint (prefix-keys)
++ "Return string for next page hint."
++ (let* ((paging-key (concat prefix-keys " " which-key-paging-key))
++ (paging-key-bound (eq 'which-key-C-h-dispatch
++ (key-binding (kbd paging-key))))
++ (key (key-description (vector help-char)))
++ (key (if paging-key-bound
++ (concat key " or " which-key-paging-key)
++ key)))
++ (when (and which-key-use-C-h-commands
++ (not (equal (vector help-char)
++ (vconcat (kbd prefix-keys)))))
++ (which-key--propertize (format "[%s paging/help]" key)
++ 'face 'which-key-note-face))))
++
++(defun which-key--full-prefix (prefix-keys &optional -prefix-arg dont-prop-keys)
++ "Return a description of the full key sequence up to now.
++Include prefix arguments."
++ (let* ((left (eq which-key-show-prefix 'left))
++ (prefix-arg (if -prefix-arg -prefix-arg prefix-arg))
++ (str (concat
++ (universal-argument--description)
++ (when prefix-arg " ")
++ prefix-keys))
++ (dash (if (and (not (string= prefix-keys ""))
++ (null left)) "-" "")))
++ (if (or (eq which-key-show-prefix 'echo) dont-prop-keys)
++ (concat str dash)
++ (concat (which-key--propertize-key str)
++ (which-key--propertize dash 'face 'which-key-key-face)))))
++
++(defun which-key--get-popup-map ()
++ "Generate transient-map for use in the top level binding display."
++ (unless which-key--automatic-display
++ (let ((map (make-sparse-keymap)))
++ (define-key map (kbd which-key-paging-key) #'which-key-C-h-dispatch)
++ (when which-key-use-C-h-commands
++ ;; Show next page even when C-h is pressed
++ (define-key map (vector help-char) #'which-key-C-h-dispatch))
++ map)))
++
++(defun which-key--process-page (pages-obj)
++ "Add information to the basic list of key bindings.
++Include, if applicable, the current prefix, the name of the current
++prefix, and a page count."
++ (let* ((page (car (which-key--pages-pages pages-obj)))
++ (height (which-key--pages-height pages-obj))
++ (n-pages (which-key--pages-num-pages pages-obj))
++ (page-n (car (which-key--pages-page-nums pages-obj)))
++ (prefix-desc (key-description (which-key--pages-prefix pages-obj)))
++ (prefix-title (which-key--pages-prefix-title pages-obj))
++ (full-prefix (which-key--full-prefix prefix-desc))
++ (nxt-pg-hint (which-key--next-page-hint prefix-desc))
++ ;; not used in left case
++ (status-line
++ (concat (which-key--propertize prefix-title 'face 'which-key-note-face)
++ (when (< 1 n-pages)
++ (which-key--propertize (format " (%s of %s)" page-n n-pages)
++ 'face 'which-key-note-face)))))
++ (pcase which-key-show-prefix
++ (`left
++ (let* ((page-cnt (which-key--propertize (format "%s/%s" page-n n-pages)
++ 'face 'which-key-separator-face))
++ (first-col-width (+ 2 (max (which-key--string-width full-prefix)
++ (which-key--string-width page-cnt))))
++ (prefix (format (concat "%-" (int-to-string first-col-width) "s")
++ full-prefix))
++ (page-cnt (if (> n-pages 1)
++ (format
++ (concat "%-" (int-to-string first-col-width) "s")
++ page-cnt)
++ (make-string first-col-width 32)))
++ lines first-line new-end)
++ (if (= 1 height)
++ (cons (concat prefix page) nil)
++ (setq lines (split-string page "\n")
++ first-line (concat prefix (car lines) "\n" page-cnt)
++ new-end (concat "\n" (make-string first-col-width 32)))
++ (cons
++ (concat first-line (mapconcat #'identity (cdr lines) new-end))
++ nil))))
++ (`top
++ (cons
++ (concat (when (or (= 0 echo-keystrokes)
++ (not (eq which-key-side-window-location 'bottom)))
++ (concat full-prefix " "))
++ status-line " " nxt-pg-hint "\n" page)
++ nil))
++ (`bottom
++ (cons
++ (concat page "\n"
++ (when (or (= 0 echo-keystrokes)
++ (not (eq which-key-side-window-location 'bottom)))
++ (concat full-prefix " "))
++ status-line " " nxt-pg-hint)
++ nil))
++ (`echo
++ (cons page
++ (lambda ()
++ (which-key--echo
++ (concat full-prefix (when prefix-desc " ")
++ status-line (when status-line " ")
++ nxt-pg-hint)))))
++ (`mode-line
++ (cons page
++ (lambda ()
++ (with-current-buffer which-key--buffer
++ (setq-local mode-line-format
++ (concat " " full-prefix
++ " " status-line
++ " " nxt-pg-hint))))))
++ (_ (cons page nil)))))
++
++(defun which-key--show-page (&optional n)
++ "Show current page.
++N changes the current page to the Nth page relative to the
++current one."
++ (which-key--init-buffer) ;; in case it was killed
++ (let ((prefix-keys (which-key--current-key-string))
++ golden-ratio-mode)
++ (if (null which-key--pages-obj)
++ (message "%s- which-key can't show keys: There is not \
++enough space based on your settings and frame size." prefix-keys)
++ (when n
++ (setq which-key--pages-obj
++ (which-key--pages-set-current-page which-key--pages-obj n)))
++ (let ((page-echo (which-key--process-page which-key--pages-obj))
++ (height (which-key--pages-height which-key--pages-obj))
++ (width (car (which-key--pages-widths which-key--pages-obj))))
++ (which-key--lighter-status)
++ (if (eq which-key-popup-type 'minibuffer)
++ (which-key--echo (car page-echo))
++ (with-current-buffer which-key--buffer
++ (erase-buffer)
++ (insert (car page-echo))
++ (goto-char (point-min)))
++ (when (cdr page-echo) (funcall (cdr page-echo)))
++ (which-key--show-popup (cons height width)))))
++ ;; used for paging at top-level
++ (if (fboundp 'set-transient-map)
++ (set-transient-map (which-key--get-popup-map))
++ (with-no-warnings
++ (set-temporary-overlay-map (which-key--get-popup-map))))))
++
++;;; Paging functions
++
++;;;###autoload
++(defun which-key-reload-key-sequence (&optional key-seq)
++ "Simulate entering the key sequence KEY-SEQ.
++KEY-SEQ should be a list of events as produced by
++`listify-key-sequence'. If nil, KEY-SEQ defaults to
++`which-key--current-key-list'. Any prefix arguments that were
++used are reapplied to the new key sequence."
++ (let* ((key-seq (or key-seq (which-key--current-key-list)))
++ (next-event (mapcar (lambda (ev) (cons t ev)) key-seq)))
++ (setq prefix-arg current-prefix-arg
++ unread-command-events next-event)))
++
++(defun which-key-turn-page (delta)
++ "Show the next page of keys."
++ (which-key-reload-key-sequence)
++ (if which-key--last-try-2-loc
++ (let ((which-key-side-window-location which-key--last-try-2-loc)
++ (which-key--multiple-locations t))
++ (which-key--show-page delta))
++ (which-key--show-page delta))
++ (which-key--start-paging-timer))
++
++;;;###autoload
++(defun which-key-show-standard-help (&optional _)
++ "Call the command in `which-key--prefix-help-cmd-backup'.
++Usually this is `describe-prefix-bindings'."
++ (interactive)
++ (let ((which-key-inhibit t)
++ (popup-showing (which-key--popup-showing-p)))
++ (which-key--hide-popup-ignore-command)
++ (cond ((and (eq which-key--prefix-help-cmd-backup
++ 'describe-prefix-bindings)
++ ;; If the popup is not showing, we call
++ ;; `describe-prefix-bindings' directly.
++ popup-showing)
++ ;; This is essentially what `describe-prefix-bindings' does. We can't
++ ;; use this function directly, because the prefix will not be correct
++ ;; when we enter using `which-key-C-h-dispatch'.
++ (describe-bindings (kbd (which-key--current-key-string))))
++ ((functionp which-key--prefix-help-cmd-backup)
++ (funcall which-key--prefix-help-cmd-backup)))))
++
++;;;###autoload
++(defun which-key-show-next-page-no-cycle ()
++ "Show next page of keys or `which-key-show-standard-help'."
++ (interactive)
++ (let ((which-key-inhibit t))
++ (if (which-key--on-last-page)
++ (which-key-show-standard-help)
++ (which-key-turn-page 1))))
++
++;;;###autoload
++(defun which-key-show-previous-page-no-cycle ()
++ "Show previous page of keys if one exists."
++ (interactive)
++ (let ((which-key-inhibit t))
++ (unless (which-key--on-first-page)
++ (which-key-turn-page -1))))
++
++;;;###autoload
++(defun which-key-show-next-page-cycle (&optional _)
++ "Show the next page of keys, cycling from end to beginning."
++ (interactive)
++ (let ((which-key-inhibit t))
++ (which-key-turn-page 1)))
++
++;;;###autoload
++(defun which-key-show-previous-page-cycle (&optional _)
++ "Show the previous page of keys, cycling from beginning to end."
++ (interactive)
++ (let ((which-key-inhibit t))
++ (which-key-turn-page -1)))
++
++;;;###autoload
++(defun which-key-show-top-level (&optional _)
++ "Show top-level bindings."
++ (interactive)
++ (which-key--create-buffer-and-show nil nil nil "Top-level bindings"))
++
++;;;###autoload
++(defun which-key-show-major-mode (&optional all)
++ "Show top-level bindings in the map of the current major mode.
++This function will also detect evil bindings made using
++`evil-define-key' in this map. These bindings will depend on the
++current evil state. "
++ (interactive "P")
++ (let ((map-sym (intern (format "%s-map" major-mode))))
++ (if (and (boundp map-sym) (keymapp (symbol-value map-sym)))
++ (which-key--show-keymap
++ "Major-mode bindings"
++ (symbol-value map-sym)
++ (apply-partially #'which-key--map-binding-p (symbol-value map-sym))
++ all)
++ (message "which-key: No map named %s" map-sym))))
++
++;;;###autoload
++(defun which-key-show-full-major-mode ()
++ "Show all bindings in the map of the current major mode.
++This function will also detect evil bindings made using
++`evil-define-key' in this map. These bindings will depend on the
++current evil state. "
++ (interactive)
++ (which-key-show-major-mode t))
++
++;;;###autoload
++(defun which-key-dump-bindings (prefix buffer-name)
++ "Dump bindings from PREFIX into buffer named BUFFER-NAME.
++PREFIX should be a string suitable for `kbd'."
++ (interactive "sPrefix: \nB")
++ (let* ((buffer (get-buffer-create buffer-name))
++ (keys (which-key--get-bindings (kbd prefix))))
++ (with-current-buffer buffer
++ (point-max)
++ (save-excursion
++ (dolist (key keys)
++ (insert (apply #'format "%s%s%s\n" key)))))
++ (switch-to-buffer-other-window buffer)))
++
++;;;###autoload
++(defun which-key-undo-key (&optional _)
++ "Undo last keypress and force which-key update."
++ (interactive)
++ (let* ((key-lst (butlast (which-key--current-key-list)))
++ (which-key-inhibit t))
++ (cond (which-key--prior-show-keymap-args
++ (if (keymapp (cdr (car-safe which-key--prior-show-keymap-args)))
++ (let ((args (pop which-key--prior-show-keymap-args)))
++ (which-key--show-keymap (car args) (cdr args)))
++ (which-key--hide-popup)))
++ (key-lst
++ (which-key-reload-key-sequence key-lst)
++ (which-key--create-buffer-and-show (apply #'vector key-lst)))
++ (t (setq which-key--automatic-display nil)
++ (which-key-show-top-level)))))
++(defalias 'which-key-undo #'which-key-undo-key)
++
++(defun which-key-abort (&optional _)
++ "Abort key sequence."
++ (interactive)
++ (let ((which-key-inhibit t))
++ (which-key--hide-popup-ignore-command)
++ (keyboard-quit)))
++
++(defun which-key-digit-argument (key)
++ "Version of `digit-argument' for use in `which-key-C-h-map'."
++ (interactive)
++ (let ((last-command-event (string-to-char key)))
++ (digit-argument key))
++ (let ((current-prefix-arg prefix-arg))
++ (which-key-reload-key-sequence)))
++
++(defun which-key-toggle-docstrings (&optional _)
++ "Toggle the display of docstrings."
++ (interactive)
++ (unless (eq which-key-show-docstrings 'docstring-only)
++ (setq which-key-show-docstrings (null which-key-show-docstrings)))
++ (which-key-reload-key-sequence)
++ (which-key--create-buffer-and-show (which-key--current-prefix)))
++
++;;;###autoload
++(defun which-key-C-h-dispatch ()
++ "Dispatch C-h commands by looking up key in `which-key-C-h-map'.
++This command is always accessible (from any prefix) if
++`which-key-use-C-h-commands' is non nil."
++ (interactive)
++ (cond ((and (not (which-key--popup-showing-p))
++ which-key-show-early-on-C-h)
++ (let ((current-prefix
++ (butlast
++ (listify-key-sequence
++ (funcall which-key-this-command-keys-function)))))
++ (which-key-reload-key-sequence current-prefix)
++ (if which-key-idle-secondary-delay
++ (which-key--start-timer which-key-idle-secondary-delay t)
++ (which-key--start-timer 0.05 t))))
++ ((not (which-key--popup-showing-p))
++ (which-key-show-standard-help))
++ (t
++ (if (not (which-key--popup-showing-p))
++ (which-key-show-standard-help)
++ (let* ((prefix-keys (which-key--current-key-string))
++ (full-prefix (which-key--full-prefix prefix-keys current-prefix-arg t))
++ (prompt (concat (when (string-equal prefix-keys "")
++ (which-key--propertize
++ (concat " "
++ (which-key--pages-prefix-title
++ which-key--pages-obj))
++ 'face 'which-key-note-face))
++ full-prefix
++ (which-key--propertize
++ (substitute-command-keys
++ which-key-C-h-map-prompt)
++ 'face 'which-key-note-face)))
++ (key (let ((key (read-key prompt)))
++ (if (numberp key)
++ (string key)
++ (vector key))))
++ (cmd (lookup-key which-key-C-h-map key))
++ (which-key-inhibit t))
++ (if cmd (funcall cmd key) (which-key-turn-page 0)))))))
++
++;;; Update
++
++(defun which-key--any-match-p (regexps string)
++ "Non-nil if any of REGEXPS match STRING."
++ (catch 'match
++ (dolist (regexp regexps)
++ (when (string-match-p regexp string)
++ (throw 'match t)))))
++
++(defun which-key--try-2-side-windows
++ (bindings prefix-keys prefix-title loc1 loc2 &rest _ignore)
++ "Try to show BINDINGS (PAGE-N) in LOC1 first.
++Only if no bindings fit fallback to LOC2."
++ (let (pages1)
++ (let ((which-key-side-window-location loc1)
++ (which-key--multiple-locations t))
++ (setq pages1 (which-key--create-pages
++ bindings prefix-keys prefix-title)))
++ (if pages1
++ (progn
++ (setq which-key--pages-obj pages1)
++ (let ((which-key-side-window-location loc1)
++ (which-key--multiple-locations t))
++ (which-key--show-page))
++ loc1)
++ (let ((which-key-side-window-location loc2)
++ (which-key--multiple-locations t))
++ (setq which-key--pages-obj
++ (which-key--create-pages bindings prefix-keys prefix-title))
++ (which-key--show-page)
++ loc2))))
++
++(defun which-key--read-keymap ()
++ "Read keymap symbol from minibuffer."
++ (intern
++ (completing-read "Keymap: " obarray
++ (lambda (m)
++ (and (boundp m)
++ (keymapp (symbol-value m))
++ (not (equal (symbol-value m)
++ (make-sparse-keymap)))))
++ t
++ (let ((sym (symbol-at-point)))
++ (and (boundp sym)
++ (keymapp (symbol-value sym))
++ (symbol-name sym)))
++ 'which-key-keymap-history)))
++
++;;;###autoload
++(defun which-key-show-keymap (keymap &optional no-paging)
++ "Show the top-level bindings in KEYMAP using which-key.
++KEYMAP is selected interactively from all available keymaps.
++
++If NO-PAGING is non-nil, which-key will not intercept subsequent
++keypresses for the paging functionality."
++ (interactive (list (which-key--read-keymap)))
++ (which-key--show-keymap (symbol-name keymap)
++ (symbol-value keymap)
++ nil nil no-paging))
++
++;;;###autoload
++(defun which-key-show-full-keymap (keymap)
++ "Show all bindings in KEYMAP using which-key.
++KEYMAP is selected interactively from all available keymaps."
++ (interactive (list (which-key--read-keymap)))
++ (which-key--show-keymap (symbol-name keymap)
++ (symbol-value keymap)
++ nil t))
++
++;;;###autoload
++(defun which-key-show-minor-mode-keymap (&optional all)
++ "Show the top-level bindings in KEYMAP using which-key.
++KEYMAP is selected interactively by mode in
++`minor-mode-map-alist'."
++ (interactive)
++ (let ((mode-sym
++ (intern
++ (completing-read
++ "Minor Mode: "
++ (mapcar #'car
++ (cl-remove-if-not
++ (lambda (entry)
++ (and (symbol-value (car entry))
++ (not (equal (cdr entry) (make-sparse-keymap)))))
++ minor-mode-map-alist))
++ nil t nil 'which-key-keymap-history))))
++ (which-key--show-keymap (symbol-name mode-sym)
++ (cdr (assq mode-sym minor-mode-map-alist))
++ all)))
++;;;###autoload
++(defun which-key-show-full-minor-mode-keymap ()
++ "Show all bindings in KEYMAP using which-key.
++KEYMAP is selected interactively by mode in
++`minor-mode-map-alist'."
++ (interactive)
++ (which-key-show-minor-mode-keymap t))
++
++(defun which-key--show-keymap
++ (keymap-name keymap &optional prior-args all no-paging filter)
++ (when prior-args (push prior-args which-key--prior-show-keymap-args))
++ (let ((bindings (which-key--get-bindings nil keymap filter all)))
++ (if (null bindings)
++ (message "which-key: No bindings found in %s" keymap-name)
++ (cond ((listp which-key-side-window-location)
++ (setq which-key--last-try-2-loc
++ (apply #'which-key--try-2-side-windows
++ bindings nil keymap-name
++ which-key-side-window-location)))
++ (t (setq which-key--pages-obj
++ (which-key--create-pages bindings nil keymap-name))
++ (which-key--show-page)))
++ (unless no-paging
++ (let* ((key (read-key))
++ (key-desc (key-description (list key)))
++ (next-def (lookup-key keymap (vector key))))
++ (cond ((and which-key-use-C-h-commands
++ (numberp key) (= key help-char))
++ (which-key-C-h-dispatch))
++ ((keymapp next-def)
++ (which-key--hide-popup-ignore-command)
++ (which-key--show-keymap
++ (concat keymap-name " " key-desc)
++ next-def
++ (cons keymap-name keymap)))
++ (t (which-key--hide-popup))))))))
++
++(defun which-key--evil-operator-filter (binding)
++ (let ((def (intern (cdr binding))))
++ (and (functionp def)
++ (not (evil-get-command-property def :suppress-operator)))))
++
++(defun which-key--show-evil-operator-keymap ()
++ (if which-key--inhibit-next-operator-popup
++ (setq which-key--inhibit-next-operator-popup nil)
++ (let ((keymap
++ (make-composed-keymap (list evil-operator-shortcut-map
++ evil-operator-state-map
++ evil-motion-state-map))))
++ (when (keymapp keymap)
++ (let ((formatted-keys
++ (which-key--get-bindings
++ nil keymap #'which-key--evil-operator-filter)))
++ (cond ((null formatted-keys)
++ (message "which-key: Keymap empty"))
++ ((listp which-key-side-window-location)
++ (setq which-key--last-try-2-loc
++ (apply #'which-key--try-2-side-windows
++ formatted-keys nil "evil operator/motion keys"
++ which-key-side-window-location)))
++ (t (setq which-key--pages-obj
++ (which-key--create-pages
++ formatted-keys
++ nil "evil operator/motion keys"))
++ (which-key--show-page)))))
++ (let ((key (read-key)))
++ (when (memq key '(?f ?F ?t ?T ?`))
++ ;; these keys trigger commands that read the next char manually
++ (setq which-key--inhibit-next-operator-popup t))
++ (cond ((and which-key-use-C-h-commands (numberp key) (= key help-char))
++ (which-key-C-h-dispatch))
++ ((and (numberp key) (= key ?\C-\[))
++ (which-key--hide-popup)
++ (keyboard-quit))
++ (t
++ (which-key--hide-popup)
++ (setq unread-command-events (vector key))))))))
++
++(defun which-key--create-buffer-and-show
++ (&optional prefix-keys from-keymap filter prefix-title)
++ "Fill `which-key--buffer' with key descriptions and reformat.
++Finally, show the buffer."
++ (let ((start-time (current-time))
++ (formatted-keys (which-key--get-bindings
++ prefix-keys from-keymap filter))
++ (prefix-desc (key-description prefix-keys)))
++ (cond ((null formatted-keys)
++ (message "%s- which-key: There are no keys to show" prefix-desc))
++ ((listp which-key-side-window-location)
++ (setq which-key--last-try-2-loc
++ (apply #'which-key--try-2-side-windows
++ formatted-keys prefix-keys prefix-title
++ which-key-side-window-location)))
++ (t (setq which-key--pages-obj
++ (which-key--create-pages
++ formatted-keys prefix-keys prefix-title))
++ (which-key--show-page)))
++ (which-key--debug-message
++ "On prefix \"%s\" which-key took %.0f ms." prefix-desc
++ (* 1000 (float-time (time-since start-time))))))
++
++(defun which-key--update ()
++ "Function run by timer to possibly trigger `which-key--create-buffer-and-show'."
++ (let ((prefix-keys (funcall which-key-this-command-keys-function))
++ delay-time)
++ (cond ((and (> (length prefix-keys) 0)
++ (or (keymapp (key-binding prefix-keys))
++ ;; Some keymaps are stored here like iso-transl-ctl-x-8-map
++ (keymapp (which-key--safe-lookup-key
++ key-translation-map prefix-keys))
++ ;; just in case someone uses one of these
++ (keymapp (which-key--safe-lookup-key
++ function-key-map prefix-keys)))
++ (not which-key-inhibit)
++ (or (null which-key-allow-regexps)
++ (which-key--any-match-p
++ which-key-allow-regexps (key-description prefix-keys)))
++ (or (null which-key-inhibit-regexps)
++ (not
++ (which-key--any-match-p
++ which-key-inhibit-regexps (key-description prefix-keys))))
++ ;; Do not display the popup if a command is currently being
++ ;; executed
++ (or (run-hook-with-args-until-success
++ 'which-key-inhibit-display-hook)
++ (null this-command))
++ (let ((max-dim (which-key--popup-max-dimensions)))
++ (> (min (car-safe max-dim) (cdr-safe max-dim)) 0)))
++ (when (and (not (equal prefix-keys (which-key--current-prefix)))
++ (or (null which-key-delay-functions)
++ (null (setq delay-time
++ (run-hook-with-args-until-success
++ 'which-key-delay-functions
++ (key-description prefix-keys)
++ (length prefix-keys))))
++ (sit-for delay-time)))
++ (setq which-key--automatic-display t)
++ (which-key--create-buffer-and-show prefix-keys)
++ (when (and which-key-idle-secondary-delay
++ (not which-key--secondary-timer-active))
++ (which-key--start-timer which-key-idle-secondary-delay t))))
++ ((and which-key-show-transient-maps
++ ;; Assuming that if this is not true we're in
++ ;; `which-key-show-top-level', which would then be overwritten.
++ (> (length prefix-keys) 0)
++ (keymapp overriding-terminal-local-map)
++ ;; basic test for it being a hydra
++ (not (eq (lookup-key overriding-terminal-local-map "\C-u")
++ 'hydra--universal-argument)))
++ (which-key--create-buffer-and-show
++ nil overriding-terminal-local-map))
++ ((and which-key-show-operator-state-maps
++ (bound-and-true-p evil-state)
++ (eq evil-state 'operator)
++ (not (which-key--popup-showing-p)))
++ (which-key--show-evil-operator-keymap))
++ (which-key--automatic-display
++ (which-key--hide-popup)))))
++
++;;; Timers
++
++(defun which-key--start-timer (&optional delay secondary)
++ "Activate idle timer to trigger `which-key--update'."
++ (which-key--stop-timer)
++ (setq which-key--secondary-timer-active secondary)
++ (setq which-key--timer
++ (run-with-idle-timer (or delay which-key-idle-delay)
++ t #'which-key--update)))
++
++(defun which-key--stop-timer ()
++ "Deactivate idle timer for `which-key--update'."
++ (when which-key--timer (cancel-timer which-key--timer)))
++
++(defun which-key--start-paging-timer ()
++ "Activate timer to restart which-key after paging."
++ (when which-key--paging-timer (cancel-timer which-key--paging-timer))
++ (which-key--stop-timer)
++ (setq which-key--paging-timer
++ (run-with-idle-timer
++ 0.2 t (lambda ()
++ (when (or (not (member real-last-command
++ which-key--paging-functions))
++ (and (< 0 (length (this-single-command-keys)))
++ (not (equal (which-key--current-prefix)
++ (funcall which-key-this-command-keys-function)))))
++ (cancel-timer which-key--paging-timer)
++ (if which-key-idle-secondary-delay
++ ;; we haven't executed a command yet so the secandary
++ ;; timer is more relevant here
++ (which-key--start-timer which-key-idle-secondary-delay t)
++ (which-key--start-timer)))))))
++
++(provide 'which-key)
++;;; which-key.el ends here
projects / emacs.git / commitdiff