From: Philip Kaludercic Date: Sat, 15 Jun 2024 12:44:06 +0000 (+0200) Subject: Merge remote-tracking branch 'github-which-key/master' X-Git-Tag: archive/raspbian/1%30.1+1-3+rpi1^2~2^2~20^2~983^2~10 X-Git-Url: https://dgit.raspbian.org/?a=commitdiff_plain;h=f1c06968eeac0b8caa39d385f436985dc448f40c;p=emacs.git Merge remote-tracking branch 'github-which-key/master' --- f1c06968eeac0b8caa39d385f436985dc448f40c diff --cc lisp/which-key.el index 00000000000,00000000000..f53226ee969 new file mode 100644 --- /dev/null +++ b/lisp/which-key.el @@@ -1,0 -1,0 +1,2810 @@@ ++;;; which-key.el --- Display available keybindings in popup -*- lexical-binding: t; -*- ++ ++;; Copyright (C) 2017-2024 Free Software Foundation, Inc. ++ ++;; Author: Justin Burkett ++;; Maintainer: Justin Burkett ++;; 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 . ++ ++;;; 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 ++ '((("") . ("←")) ++ (("") . ("→")))) ++ (("<\\([[: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 "" ++ "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-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 "" a)) ++ (bfn? (string-match-p "" 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 "" "\\1" a)) ++ (string-to-number ++ (replace-regexp-in-string "" "\\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 diff --cc test/lisp/which-key-tests.el index 00000000000,00000000000..1f2b1965ec3 new file mode 100644 --- /dev/null +++ b/test/lisp/which-key-tests.el @@@ -1,0 -1,0 +1,267 @@@ ++;;; which-key-tests.el --- Tests for which-key.el -*- lexical-binding: t; -*- ++ ++;; Copyright (C) 2017-2021 Free Software Foundation, Inc. ++ ++;; Author: Justin Burkett ++;; Maintainer: Justin Burkett ++ ++;; 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 . ++ ++;;; Commentary: ++ ++;; Tests for which-key.el ++ ++;;; Code: ++ ++(require 'which-key) ++(require 'ert) ++ ++(ert-deftest which-key-test--keymap-based-bindings () ++ (let ((map (make-sparse-keymap)) ++ (prefix-map (make-sparse-keymap))) ++ (define-key prefix-map "x" #'ignore) ++ (define-key map "\C-a" 'complete) ++ (define-key map "\C-b" prefix-map) ++ (which-key-add-keymap-based-replacements map ++ "C-a" '("mycomplete" . complete) ++ "C-b" "mymap" ++ "C-c" "mymap2") ++ (define-key map "\C-ca" 'foo) ++ (should (equal ++ (which-key--get-keymap-bindings map) ++ '(("C-a" . "mycomplete") ++ ("C-b" . "group:mymap") ++ ("C-c" . "group:mymap2")))))) ++ ++(ert-deftest which-key-test--named-prefix-keymap () ++ (define-prefix-command 'which-key-test--named-map) ++ (let ((map (make-sparse-keymap))) ++ (define-key map "\C-a" 'which-key-test--named-map) ++ (should (equal ++ (which-key--get-keymap-bindings map) ++ '(("C-a" . "which-key-test--named-map")))))) ++ ++(ert-deftest which-key-test--prefix-declaration () ++ "Test `which-key-declare-prefixes' and ++`which-key-declare-prefixes-for-mode'. See Bug #109." ++ (let* ((major-mode 'test-mode) ++ which-key-replacement-alist) ++ (which-key-add-key-based-replacements ++ "SPC C-c" '("complete" . "complete title") ++ "SPC C-k" "cancel") ++ (which-key-add-major-mode-key-based-replacements 'test-mode ++ "C-c C-c" '("complete" . "complete title") ++ "C-c C-k" "cancel") ++ (should (equal ++ (which-key--maybe-replace '("SPC C-k" . "")) ++ '("SPC C-k" . "cancel"))) ++ (should (equal ++ (which-key--maybe-replace '("C-c C-c" . "")) ++ '("C-c C-c" . "complete"))))) ++ ++(ert-deftest which-key-test--maybe-replace () ++ "Test `which-key--maybe-replace'. See #154" ++ (let ((which-key-replacement-alist ++ '((("C-c [a-d]" . nil) . ("C-c a" . "c-c a")) ++ (("C-c .+" . nil) . ("C-c *" . "c-c *")))) ++ (test-mode-1 't) ++ (test-mode-2 'nil) ++ which-key-allow-multiple-replacements) ++ (which-key-add-key-based-replacements ++ "C-c ." "test ." ++ "SPC ." "SPC ." ++ "C-c \\" "regexp quoting" ++ "C-c [" "bad regexp" ++ "SPC t1" (lambda (kb) ++ (cons (car kb) ++ (if test-mode-1 ++ "[x] test mode" ++ "[ ] test mode"))) ++ "SPC t2" (lambda (kb) ++ (cons (car kb) ++ (if test-mode-2 ++ "[x] test mode" ++ "[ ] test mode")))) ++ (should (equal ++ (which-key--maybe-replace '("C-c g" . "test")) ++ '("C-c *" . "c-c *"))) ++ (should (equal ++ (which-key--maybe-replace '("C-c b" . "test")) ++ '("C-c a" . "c-c a"))) ++ (should (equal ++ (which-key--maybe-replace '("C-c ." . "not test .")) ++ '("C-c ." . "test ."))) ++ (should (not ++ (equal ++ (which-key--maybe-replace '("C-c +" . "not test .")) ++ '("C-c ." . "test .")))) ++ (should (equal ++ (which-key--maybe-replace '("C-c [" . "orig bad regexp")) ++ '("C-c [" . "bad regexp"))) ++ (should (equal ++ (which-key--maybe-replace '("C-c \\" . "pre quoting")) ++ '("C-c \\" . "regexp quoting"))) ++ ;; see #155 ++ (should (equal ++ (which-key--maybe-replace '("SPC . ." . "don't replace")) ++ '("SPC . ." . "don't replace"))) ++ (should (equal ++ (which-key--maybe-replace '("SPC t 1" . "test mode")) ++ '("SPC t 1" . "[x] test mode"))) ++ (should (equal ++ (which-key--maybe-replace '("SPC t 2" . "test mode")) ++ '("SPC t 2" . "[ ] test mode"))))) ++ ++(ert-deftest which-key-test--maybe-replace-multiple () ++ "Test `which-key-allow-multiple-replacements'. See #156." ++ (let ((which-key-replacement-alist ++ '(((nil . "helm") . (nil . "HLM")) ++ ((nil . "projectile") . (nil . "PRJTL")))) ++ (which-key-allow-multiple-replacements t)) ++ (should (equal ++ (which-key--maybe-replace '("C-c C-c" . "helm-x")) ++ '("C-c C-c" . "HLM-x"))) ++ (should (equal ++ (which-key--maybe-replace '("C-c C-c" . "projectile-x")) ++ '("C-c C-c" . "PRJTL-x"))) ++ (should (equal ++ (which-key--maybe-replace '("C-c C-c" . "helm-projectile-x")) ++ '("C-c C-c" . "HLM-PRJTL-x"))))) ++ ++(ert-deftest which-key-test--key-extraction () ++ "Test `which-key--extract-key'. See #161." ++ (should (equal (which-key--extract-key "SPC a") "a")) ++ (should (equal (which-key--extract-key "C-x a") "a")) ++ (should (equal (which-key--extract-key " b a") "a")) ++ (should (equal (which-key--extract-key " a .. c") "a .. c")) ++ (should (equal (which-key--extract-key "M-a a .. c") "a .. c"))) ++ ++(ert-deftest which-key-test--get-keymap-bindings () ++ (skip-unless (require 'evil nil t)) ++ (defvar evil-local-mode) ++ (defvar evil-state) ++ (declare-function evil-define-key* "ext:evil") ++ (let ((map (make-sparse-keymap)) ++ (evil-local-mode t) ++ (evil-state 'normal) ++ which-key-replacement-alist) ++ (define-key map [which-key-a] '(which-key "blah")) ++ (define-key map "b" #'ignore) ++ (define-key map "c" "c") ++ (define-key map "dd" "dd") ++ (define-key map "eee" "eee") ++ (define-key map "f" [123 45 6]) ++ (define-key map (kbd "M-g g") "M-gg") ++ (evil-define-key* 'normal map (kbd "C-h") "C-h-normal") ++ (evil-define-key* 'insert map (kbd "C-h") "C-h-insert") ++ (should (equal ++ (sort (which-key--get-keymap-bindings map) ++ (lambda (a b) (string-lessp (car a) (car b)))) ++ '(("M-g" . "prefix") ++ ("c" . "c") ++ ("d" . "prefix") ++ ("e" . "prefix") ++ ("f" . "{ - C-f")))) ++ (should (equal ++ (sort (which-key--get-keymap-bindings map nil nil nil nil t) ++ (lambda (a b) (string-lessp (car a) (car b)))) ++ '(("C-h" . "C-h-normal") ++ ("M-g" . "prefix") ++ ("c" . "c") ++ ("d" . "prefix") ++ ("e" . "prefix") ++ ("f" . "{ - C-f")))) ++ (should (equal ++ (sort (which-key--get-keymap-bindings map nil nil nil t) ++ (lambda (a b) (string-lessp (car a) (car b)))) ++ '(("M-g g" . "M-gg") ++ ("c" . "c") ++ ("d d" . "dd") ++ ("e e e" . "eee") ++ ("f" . "{ - C-f")))))) ++ ++(ert-deftest which-key-test--nil-replacement () ++ (let ((which-key-replacement-alist ++ '(((nil . "winum-select-window-[1-9]") . t)))) ++ (should (equal ++ (which-key--maybe-replace '("C-c C-c" . "winum-select-window-1")) ++ '())))) ++ ++(ert-deftest which-key-test--key-sorting () ++ (let ((keys '(("a" . "z") ++ ("A" . "Z") ++ ("b" . "y") ++ ("B" . "Y") ++ ("p" . "prefix") ++ ("SPC" . "x") ++ ("C-a" . "w")))) ++ (let ((which-key-sort-uppercase-first t)) ++ (should ++ (equal ++ (mapcar #'car (sort (copy-sequence keys) #'which-key-key-order)) ++ '("SPC" "A" "B" "a" "b" "p" "C-a")))) ++ (let (which-key-sort-uppercase-first) ++ (should ++ (equal ++ (mapcar #'car (sort (copy-sequence keys) #'which-key-key-order)) ++ '("SPC" "a" "b" "p" "A" "B" "C-a")))) ++ (let ((which-key-sort-uppercase-first t)) ++ (should ++ (equal ++ (mapcar #'car (sort (copy-sequence keys) #'which-key-key-order-alpha)) ++ '("SPC" "A" "a" "B" "b" "p" "C-a")))) ++ (let (which-key-sort-uppercase-first) ++ (should ++ (equal ++ (mapcar #'car (sort (copy-sequence keys) #'which-key-key-order-alpha)) ++ '("SPC" "a" "A" "b" "B" "p" "C-a")))) ++ (let ((which-key-sort-uppercase-first t)) ++ (should ++ (equal ++ (mapcar #'car (sort (copy-sequence keys) ++ #'which-key-prefix-then-key-order)) ++ '("SPC" "A" "B" "a" "b" "C-a" "p")))) ++ (let (which-key-sort-uppercase-first) ++ (should ++ (equal ++ (mapcar #'car (sort (copy-sequence keys) ++ #'which-key-prefix-then-key-order)) ++ '("SPC" "a" "b" "A" "B" "C-a" "p")))) ++ (let ((which-key-sort-uppercase-first t)) ++ (should ++ (equal ++ (mapcar 'car (sort (copy-sequence keys) ++ #'which-key-prefix-then-key-order-reverse)) ++ '("p" "SPC" "A" "B" "a" "b" "C-a")))) ++ (let (which-key-sort-uppercase-first) ++ (should ++ (equal ++ (mapcar #'car (sort (copy-sequence keys) ++ #'which-key-prefix-then-key-order-reverse)) ++ '("p" "SPC" "a" "b" "A" "B" "C-a")))) ++ (let ((which-key-sort-uppercase-first t)) ++ (should ++ (equal ++ (mapcar #'car (sort (copy-sequence keys) ++ #'which-key-description-order)) ++ '("p" "C-a" "SPC" "b" "B" "a" "A")))) ++ (let (which-key-sort-uppercase-first) ++ (should ++ (equal ++ (mapcar #'car (sort (copy-sequence keys) ++ #'which-key-description-order)) ++ '("p" "C-a" "SPC" "b" "B" "a" "A")))))) ++ ++(provide 'which-key-tests) ++;;; which-key-tests.el ends here