dotemacs

My Emacs configuration
git clone git://git.entf.net/dotemacs
Log | Files | Refs | LICENSE

transient.el (162740B)


      1 ;;; transient.el --- Transient commands  -*- lexical-binding:t -*-
      2 
      3 ;; Copyright (C) 2018-2023 Free Software Foundation, Inc.
      4 
      5 ;; Author: Jonas Bernoulli <jonas@bernoul.li>
      6 ;; Homepage: https://github.com/magit/transient
      7 ;; Keywords: extensions
      8 
      9 ;; Package-Version: 0.4.0
     10 ;; Package-Requires: ((emacs "25.1") (compat "29.1.4.1"))
     11 
     12 ;; SPDX-License-Identifier: GPL-3.0-or-later
     13 
     14 ;; This file is part of GNU Emacs.
     15 
     16 ;; GNU Emacs is free software: you can redistribute it and/or modify
     17 ;; it under the terms of the GNU General Public License as published
     18 ;; by the Free Software Foundation, either version 3 of the License,
     19 ;; or (at your option) any later version.
     20 ;;
     21 ;; GNU Emacs is distributed in the hope that it will be useful,
     22 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
     23 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
     24 ;; GNU General Public License for more details.
     25 ;;
     26 ;; You should have received a copy of the GNU General Public License
     27 ;; along with this program.  If not, see <https://www.gnu.org/licenses/>.
     28 
     29 ;;; Commentary:
     30 
     31 ;; Taking inspiration from prefix keys and prefix arguments, Transient
     32 ;; implements a similar abstraction involving a prefix command, infix
     33 ;; arguments and suffix commands.  We could call this abstraction a
     34 ;; "transient command", but because it always involves at least two
     35 ;; commands (a prefix and a suffix) we prefer to call it just a
     36 ;; "transient".
     37 
     38 ;; When the user calls a transient prefix command, then a transient
     39 ;; (temporary) keymap is activated, which binds the transient's infix
     40 ;; and suffix commands, and functions that control the transient state
     41 ;; are added to `pre-command-hook' and `post-command-hook'.  The
     42 ;; available suffix and infix commands and their state are shown in
     43 ;; the echo area until the transient is exited by invoking a suffix
     44 ;; command.
     45 
     46 ;; Calling an infix command causes its value to be changed, possibly
     47 ;; by reading a new value in the minibuffer.
     48 
     49 ;; Calling a suffix command usually causes the transient to be exited
     50 ;; but suffix commands can also be configured to not exit the
     51 ;; transient state.
     52 
     53 ;;; Code:
     54 
     55 (require 'cl-lib)
     56 (require 'compat)
     57 (require 'eieio)
     58 (require 'edmacro)
     59 (require 'format-spec)
     60 (require 'seq)
     61 
     62 (eval-when-compile (require 'subr-x))
     63 
     64 (declare-function info "info" (&optional file-or-node buffer))
     65 (declare-function Man-find-section "man" (section))
     66 (declare-function Man-next-section "man" (n))
     67 (declare-function Man-getpage-in-background "man" (topic))
     68 
     69 (defvar display-line-numbers) ; since Emacs 26.1
     70 (defvar Man-notify-method)
     71 
     72 (defmacro transient--with-emergency-exit (&rest body)
     73   (declare (indent defun))
     74   `(condition-case err
     75        (let ((debugger #'transient--exit-and-debug))
     76          ,(macroexp-progn body))
     77      ((debug error)
     78       (transient--emergency-exit)
     79       (signal (car err) (cdr err)))))
     80 
     81 (defun transient--exit-and-debug (&rest args)
     82   (transient--emergency-exit)
     83   (apply #'debug args))
     84 
     85 ;;; Options
     86 
     87 (defgroup transient nil
     88   "Transient commands."
     89   :group 'extensions)
     90 
     91 (defcustom transient-show-popup t
     92   "Whether to show the current transient in a popup buffer.
     93 \\<transient-map>
     94 - If t, then show the popup as soon as a transient prefix command
     95   is invoked.
     96 
     97 - If nil, then do not show the popup unless the user explicitly
     98   requests it, by pressing \\[transient-show] or a prefix key.
     99 
    100 - If a number, then delay displaying the popup and instead show
    101   a brief one-line summary.  If zero or negative, then suppress
    102   even showing that summary and display the pressed key only.
    103 
    104   Show the popup when the user explicitly requests it by pressing
    105   \\[transient-show] or a prefix key.  Unless zero, then also show the popup
    106   after that many seconds of inactivity (using the absolute value)."
    107   :package-version '(transient . "0.1.0")
    108   :group 'transient
    109   :type '(choice (const  :tag "instantly" t)
    110                  (const  :tag "on demand" nil)
    111                  (const  :tag "on demand (no summary)" 0)
    112                  (number :tag "after delay" 1)))
    113 
    114 (defcustom transient-enable-popup-navigation t
    115   "Whether navigation commands are enabled in the transient popup.
    116 
    117 While a transient is active the transient popup buffer is not the
    118 current buffer, making it necessary to use dedicated commands to
    119 act on that buffer itself.  If this is non-nil, then the following
    120 bindings are available:
    121 
    122 \\<transient-popup-navigation-map>\
    123 - \\[transient-backward-button] moves the cursor to the previous suffix.
    124 - \\[transient-forward-button] moves the cursor to the next suffix.
    125 - \\[transient-push-button] invokes the suffix the cursor is on.
    126 \\<transient-button-map>\
    127 - \\`<mouse-1>' and \\`<mouse-2>' invoke the clicked on suffix.
    128 \\<transient-popup-navigation-map>\
    129 - \\[transient-isearch-backward]\
    130  and \\[transient-isearch-forward] start isearch in the popup buffer.
    131 
    132 \\`<mouse-1>' and \\`<mouse-2>' are bound in `transient-push-button'.
    133 All other bindings are in `transient-popup-navigation-map'.
    134 
    135 By default \\`M-RET' is bound to `transient-push-button', instead of
    136 \\`RET', because if a transient allows the invocation of non-suffixes
    137 then it is likely that you would want \\`RET' to do what it would do
    138 if no transient were active."
    139   :package-version '(transient . "0.4.0")
    140   :group 'transient
    141   :type 'boolean)
    142 
    143 (defcustom transient-display-buffer-action
    144   '(display-buffer-in-side-window
    145     (side . bottom)
    146     (dedicated . t)
    147     (inhibit-same-window . t)
    148     (window-parameters (no-other-window . t)))
    149   "The action used to display the transient popup buffer.
    150 
    151 The transient popup buffer is displayed in a window using
    152 
    153   (display-buffer BUFFER transient-display-buffer-action)
    154 
    155 The value of this option has the form (FUNCTION . ALIST),
    156 where FUNCTION is a function or a list of functions.  Each such
    157 function should accept two arguments: a buffer to display and an
    158 alist of the same form as ALIST.  See info node `(elisp)Choosing
    159 Window' for details.
    160 
    161 The default is:
    162 
    163   (display-buffer-in-side-window
    164     (side . bottom)
    165     (dedicated . t)
    166     (inhibit-same-window . t)
    167     (window-parameters (no-other-window . t)))
    168 
    169 This displays the window at the bottom of the selected frame.
    170 Another useful FUNCTION is `display-buffer-below-selected', which
    171 is what `magit-popup' used by default.  For more alternatives see
    172 info node `(elisp)Display Action Functions' and info node
    173 `(elisp)Buffer Display Action Alists'.
    174 
    175 Note that the buffer that was current before the transient buffer
    176 is shown should remain the current buffer.  Many suffix commands
    177 act on the thing at point, if appropriate, and if the transient
    178 buffer became the current buffer, then that would change what is
    179 at point.  To that effect `inhibit-same-window' ensures that the
    180 selected window is not used to show the transient buffer.
    181 
    182 It may be possible to display the window in another frame, but
    183 whether that works in practice depends on the window-manager.
    184 If the window manager selects the new window (Emacs frame),
    185 then that unfortunately changes which buffer is current.
    186 
    187 If you change the value of this option, then you might also
    188 want to change the value of `transient-mode-line-format'."
    189   :package-version '(transient . "0.3.0")
    190   :group 'transient
    191   :type '(cons (choice function (repeat :tag "Functions" function))
    192                alist))
    193 
    194 (defcustom transient-mode-line-format 'line
    195   "The mode-line format for the transient popup buffer.
    196 
    197 If nil, then the buffer has no mode-line.  If the buffer is not
    198 displayed right above the echo area, then this probably is not
    199 a good value.
    200 
    201 If `line' (the default), then the buffer also has no mode-line,
    202 but a thin line is drawn instead, using the background color of
    203 the face `transient-separator'.  Termcap frames cannot display
    204 thin lines and therefore fallback to treating `line' like nil.
    205 
    206 Otherwise this can be any mode-line format.
    207 See `mode-line-format' for details."
    208   :package-version '(transient . "0.2.0")
    209   :group 'transient
    210   :type '(choice (const :tag "hide mode-line" nil)
    211                  (const :tag "substitute thin line" line)
    212                  (const :tag "name of prefix command"
    213                         ("%e" mode-line-front-space
    214                          mode-line-buffer-identification))
    215                  (sexp  :tag "custom mode-line format")))
    216 
    217 (defcustom transient-show-common-commands nil
    218   "Whether to show common transient suffixes in the popup buffer.
    219 
    220 These commands are always shown after typing the prefix key
    221 \"C-x\" when a transient command is active.  To toggle the value
    222 of this variable use \"C-x t\" when a transient is active."
    223   :package-version '(transient . "0.1.0")
    224   :group 'transient
    225   :type 'boolean)
    226 
    227 (defcustom transient-read-with-initial-input nil
    228   "Whether to use the last history element as initial minibuffer input."
    229   :package-version '(transient . "0.2.0")
    230   :group 'transient
    231   :type 'boolean)
    232 
    233 (defcustom transient-highlight-mismatched-keys nil
    234   "Whether to highlight keys that do not match their argument.
    235 
    236 This only affects infix arguments that represent command-line
    237 arguments.  When this option is non-nil, then the key binding
    238 for infix argument are highlighted when only a long argument
    239 \(e.g. \"--verbose\") is specified but no shor-thand (e.g \"-v\").
    240 In the rare case that a short-hand is specified but does not
    241 match the key binding, then it is highlighted differently.
    242 
    243 The highlighting is done using `transient-mismatched-key'
    244 and `transient-nonstandard-key'."
    245   :package-version '(transient . "0.1.0")
    246   :group 'transient
    247   :type 'boolean)
    248 
    249 (defcustom transient-highlight-higher-levels nil
    250   "Whether to highlight suffixes on higher levels.
    251 
    252 This is primarily intended for package authors.
    253 
    254 When non-nil then highlight the description of suffixes whose
    255 level is above 4, the default of `transient-default-level'.
    256 Assuming you have set that variable to 7, this highlights all
    257 suffixes that won't be available to users without them making
    258 the same customization."
    259   :package-version '(transient . "0.3.6")
    260   :group 'transient
    261   :type 'boolean)
    262 
    263 (defcustom transient-substitute-key-function nil
    264   "Function used to modify key bindings.
    265 
    266 This function is called with one argument, the prefix object,
    267 and must return a key binding description, either the existing
    268 key description it finds in the `key' slot, or a substitution.
    269 
    270 This is intended to let users replace certain prefix keys.  It
    271 could also be used to make other substitutions, but that is
    272 discouraged.
    273 
    274 For example, \"=\" is hard to reach using my custom keyboard
    275 layout, so I substitute \"(\" for that, which is easy to reach
    276 using a layout optimized for Lisp.
    277 
    278   (setq transient-substitute-key-function
    279         (lambda (obj)
    280           (let ((key (oref obj key)))
    281             (if (string-match \"\\\\`\\\\(=\\\\)[a-zA-Z]\" key)
    282                 (replace-match \"(\" t t key 1)
    283               key)))))"
    284   :package-version '(transient . "0.1.0")
    285   :group 'transient
    286   :type '(choice (const :tag "Transform no keys (nil)" nil) function))
    287 
    288 (defcustom transient-semantic-coloring nil
    289   "Whether to color prefixes and suffixes in Hydra-like fashion.
    290 This feature is experimental.
    291 
    292 If non-nil, then the key binding of each suffix is colorized to
    293 indicate whether it exits the transient state or not.  The color
    294 of the prefix is indicated using the line that is drawn when the
    295 value of `transient-mode-line-format' is `line'.
    296 
    297 For more information about how Hydra uses colors see
    298 https://github.com/abo-abo/hydra#color and
    299 https://oremacs.com/2015/02/19/hydra-colors-reloaded."
    300   :package-version '(transient . "0.3.0")
    301   :group 'transient
    302   :type 'boolean)
    303 
    304 (defcustom transient-detect-key-conflicts nil
    305   "Whether to detect key binding conflicts.
    306 
    307 Conflicts are detected when a transient prefix command is invoked
    308 and results in an error, which prevents the transient from being
    309 used."
    310   :package-version '(transient . "0.1.0")
    311   :group 'transient
    312   :type 'boolean)
    313 
    314 (defcustom transient-align-variable-pitch nil
    315   "Whether to align columns pixel-wise in the popup buffer.
    316 
    317 If this is non-nil, then columns are aligned pixel-wise to
    318 support variable-pitch fonts.  Keys are not aligned, so you
    319 should use a fixed-pitch font for the `transient-key' face.
    320 Other key faces inherit from that face unless a theme is
    321 used that breaks that relationship.
    322 
    323 This option is intended for users who use a variable-pitch
    324 font for the `default' face.
    325 
    326 Also see `transient-force-fixed-pitch'."
    327   :package-version '(transient . "0.4.0")
    328   :group 'transient
    329   :type 'boolean)
    330 
    331 (defcustom transient-force-fixed-pitch nil
    332   "Whether to force use of monospaced font in the popup buffer.
    333 
    334 Even if you use a proportional font for the `default' face,
    335 you might still want to use a monospaced font in transient's
    336 popup buffer.  Setting this option to t causes `default' to
    337 be remapped to `fixed-pitch' in that buffer.
    338 
    339 Also see `transient-align-variable-pitch'."
    340   :package-version '(transient . "0.2.0")
    341   :group 'transient
    342   :type 'boolean)
    343 
    344 (defcustom transient-force-single-column nil
    345   "Whether to force use of a single column to display suffixes.
    346 
    347 This might be useful for users with low vision who use large
    348 text and might otherwise have to scroll in two dimensions."
    349   :package-version '(transient . "0.3.6")
    350   :group 'transient
    351   :type 'boolean)
    352 
    353 (defcustom transient-hide-during-minibuffer-read nil
    354   "Whether to hide the transient buffer while reading in the minibuffer."
    355   :package-version '(transient . "0.4.0")
    356   :group 'transient
    357   :type 'boolean)
    358 
    359 (defconst transient--default-child-level 1)
    360 
    361 (defconst transient--default-prefix-level 4)
    362 
    363 (defcustom transient-default-level transient--default-prefix-level
    364   "Control what suffix levels are made available by default.
    365 
    366 Each suffix command is placed on a level and each prefix command
    367 has a level, which controls which suffix commands are available.
    368 Integers between 1 and 7 (inclusive) are valid levels.
    369 
    370 The levels of individual transients and/or their individual
    371 suffixes can be changed individually, by invoking the prefix and
    372 then pressing \"C-x l\".
    373 
    374 The default level for both transients and their suffixes is 4.
    375 This option only controls the default for transients.  The default
    376 suffix level is always 4.  The author of a transient should place
    377 certain suffixes on a higher level if they expect that it won't be
    378 of use to most users, and they should place very important suffixes
    379 on a lower level so that they remain available even if the user
    380 lowers the transient level.
    381 
    382 \(Magit currently places nearly all suffixes on level 4 and lower
    383 levels are not used at all yet.  So for the time being you should
    384 not set a lower level here and using a higher level might not
    385 give you as many additional suffixes as you hoped.)"
    386   :package-version '(transient . "0.1.0")
    387   :group 'transient
    388   :type '(choice (const :tag "1 - fewest suffixes" 1)
    389                  (const 2)
    390                  (const 3)
    391                  (const :tag "4 - default" 4)
    392                  (const 5)
    393                  (const 6)
    394                  (const :tag "7 - most suffixes" 7)))
    395 
    396 (defcustom transient-levels-file
    397   (locate-user-emacs-file "transient/levels.el")
    398   "File used to save levels of transients and their suffixes."
    399   :package-version '(transient . "0.1.0")
    400   :group 'transient
    401   :type 'file)
    402 
    403 (defcustom transient-values-file
    404   (locate-user-emacs-file "transient/values.el")
    405   "File used to save values of transients."
    406   :package-version '(transient . "0.1.0")
    407   :group 'transient
    408   :type 'file)
    409 
    410 (defcustom transient-history-file
    411   (locate-user-emacs-file "transient/history.el")
    412   "File used to save history of transients and their infixes."
    413   :package-version '(transient . "0.1.0")
    414   :group 'transient
    415   :type 'file)
    416 
    417 (defcustom transient-history-limit 10
    418   "Number of history elements to keep when saving to file."
    419   :package-version '(transient . "0.1.0")
    420   :group 'transient
    421   :type 'integer)
    422 
    423 (defcustom transient-save-history t
    424   "Whether to save history of transient commands when exiting Emacs."
    425   :package-version '(transient . "0.1.0")
    426   :group 'transient
    427   :type 'boolean)
    428 
    429 ;;; Faces
    430 
    431 (defgroup transient-faces nil
    432   "Faces used by Transient."
    433   :group 'transient)
    434 
    435 (defface transient-heading '((t :inherit font-lock-keyword-face))
    436   "Face used for headings."
    437   :group 'transient-faces)
    438 
    439 (defface transient-key '((t :inherit font-lock-builtin-face))
    440   "Face used for keys."
    441   :group 'transient-faces)
    442 
    443 (defface transient-argument '((t :inherit font-lock-warning-face))
    444   "Face used for enabled arguments."
    445   :group 'transient-faces)
    446 
    447 (defface transient-value '((t :inherit font-lock-string-face))
    448   "Face used for values."
    449   :group 'transient-faces)
    450 
    451 (defface transient-inactive-argument '((t :inherit shadow))
    452   "Face used for inactive arguments."
    453   :group 'transient-faces)
    454 
    455 (defface transient-inactive-value '((t :inherit shadow))
    456   "Face used for inactive values."
    457   :group 'transient-faces)
    458 
    459 (defface transient-unreachable '((t :inherit shadow))
    460   "Face used for suffixes unreachable from the current prefix sequence."
    461   :group 'transient-faces)
    462 
    463 (defface transient-active-infix '((t :inherit secondary-selection))
    464   "Face used for the infix for which the value is being read."
    465   :group 'transient-faces)
    466 
    467 (defface transient-unreachable-key '((t :inherit (transient-key shadow)))
    468   "Face used for keys unreachable from the current prefix sequence."
    469   :group 'transient-faces)
    470 
    471 (defface transient-nonstandard-key '((t :underline t))
    472   "Face optionally used to highlight keys conflicting with short-argument.
    473 Also see option `transient-highlight-mismatched-keys'."
    474   :group 'transient-faces)
    475 
    476 (defface transient-mismatched-key '((t :underline t))
    477   "Face optionally used to highlight keys without a short-argument.
    478 Also see option `transient-highlight-mismatched-keys'."
    479   :group 'transient-faces)
    480 
    481 (defface transient-inapt-suffix '((t :inherit shadow :italic t))
    482   "Face used for suffixes that are inapt at this time."
    483   :group 'transient-faces)
    484 
    485 (defface transient-enabled-suffix
    486   '((t :background "green" :foreground "black" :weight bold))
    487   "Face used for enabled levels while editing suffix levels.
    488 See info node `(transient)Enabling and Disabling Suffixes'."
    489   :group 'transient-faces)
    490 
    491 (defface transient-disabled-suffix
    492   '((t :background "red" :foreground "black" :weight bold))
    493   "Face used for disabled levels while editing suffix levels.
    494 See info node `(transient)Enabling and Disabling Suffixes'."
    495   :group 'transient-faces)
    496 
    497 (defface transient-higher-level '((t :underline t))
    498   "Face optionally used to highlight suffixes on higher levels.
    499 Also see option `transient-highlight-higher-levels'."
    500   :group 'transient-faces)
    501 
    502 (defface transient-separator
    503   `((((class color) (background light))
    504      ,@(and (>= emacs-major-version 27) '(:extend t))
    505      :background "grey80")
    506     (((class color) (background  dark))
    507      ,@(and (>= emacs-major-version 27) '(:extend t))
    508      :background "grey30"))
    509   "Face used to draw line below transient popup window.
    510 This is only used if `transient-mode-line-format' is `line'.
    511 Only the background color is significant."
    512   :group 'transient-faces)
    513 
    514 (defgroup transient-color-faces
    515   '((transient-semantic-coloring custom-variable))
    516   "Faces used by Transient for Hydra-like command coloring.
    517 These faces are only used if `transient-semantic-coloring'
    518 \(which see) is non-nil."
    519   :group 'transient-faces)
    520 
    521 (defface transient-red
    522   '((t :inherit transient-key :foreground "red"))
    523   "Face used for red prefixes and suffixes."
    524   :group 'transient-color-faces)
    525 
    526 (defface transient-blue
    527   '((t :inherit transient-key :foreground "blue"))
    528   "Face used for blue prefixes and suffixes."
    529   :group 'transient-color-faces)
    530 
    531 (defface transient-amaranth
    532   '((t :inherit transient-key :foreground "#E52B50"))
    533   "Face used for amaranth prefixes."
    534   :group 'transient-color-faces)
    535 
    536 (defface transient-pink
    537   '((t :inherit transient-key :foreground "#FF6EB4"))
    538   "Face used for pink prefixes."
    539   :group 'transient-color-faces)
    540 
    541 (defface transient-teal
    542   '((t :inherit transient-key :foreground "#367588"))
    543   "Face used for teal prefixes."
    544   :group 'transient-color-faces)
    545 
    546 (defface transient-purple
    547   '((t :inherit transient-key :foreground "#a020f0"))
    548   "Face used for purple prefixes.
    549 
    550 This is an addition to the colors supported by Hydra.  It is
    551 used by suffixes that quit the current prefix but return to
    552 the previous prefix."
    553   :group 'transient-color-faces)
    554 
    555 ;;; Persistence
    556 
    557 (defun transient--read-file-contents (file)
    558   (with-demoted-errors "Transient error: %S"
    559     (and (file-exists-p file)
    560          (with-temp-buffer
    561            (insert-file-contents file)
    562            (read (current-buffer))))))
    563 
    564 (defun transient--pp-to-file (list file)
    565   (make-directory (file-name-directory file) t)
    566   (setq list (cl-sort (copy-sequence list) #'string< :key #'car))
    567   (with-temp-file file
    568     (let ((print-level nil)
    569           (print-length nil))
    570       (pp list (current-buffer)))))
    571 
    572 (defvar transient-values
    573   (transient--read-file-contents transient-values-file)
    574   "Values of transient commands.
    575 The value of this variable persists between Emacs sessions
    576 and you usually should not change it manually.")
    577 
    578 (defun transient-save-values ()
    579   (transient--pp-to-file transient-values transient-values-file))
    580 
    581 (defvar transient-levels
    582   (transient--read-file-contents transient-levels-file)
    583   "Levels of transient commands.
    584 The value of this variable persists between Emacs sessions
    585 and you usually should not change it manually.")
    586 
    587 (defun transient-save-levels ()
    588   (transient--pp-to-file transient-levels transient-levels-file))
    589 
    590 (defvar transient-history
    591   (transient--read-file-contents transient-history-file)
    592   "History of transient commands and infix arguments.
    593 The value of this variable persists between Emacs sessions
    594 \(unless `transient-save-history' is nil) and you usually
    595 should not change it manually.")
    596 
    597 (defun transient-save-history ()
    598   (setq transient-history
    599         (cl-sort (mapcar (pcase-lambda (`(,key . ,val))
    600                            (cons key (seq-take (delete-dups val)
    601                                                transient-history-limit)))
    602                          transient-history)
    603                  #'string< :key #'car))
    604   (transient--pp-to-file transient-history transient-history-file))
    605 
    606 (defun transient-maybe-save-history ()
    607   "Save the value of `transient-history'.
    608 If `transient-save-history' is nil, then do nothing."
    609   (when transient-save-history
    610     (transient-save-history)))
    611 
    612 (unless noninteractive
    613   (add-hook 'kill-emacs-hook #'transient-maybe-save-history))
    614 
    615 ;;; Classes
    616 ;;;; Prefix
    617 
    618 (defclass transient-prefix ()
    619   ((prototype   :initarg :prototype)
    620    (command     :initarg :command)
    621    (level       :initarg :level)
    622    (variable    :initarg :variable    :initform nil)
    623    (init-value  :initarg :init-value)
    624    (value) (default-value :initarg :value)
    625    (scope       :initarg :scope       :initform nil)
    626    (history     :initarg :history     :initform nil)
    627    (history-pos :initarg :history-pos :initform 0)
    628    (history-key :initarg :history-key :initform nil)
    629    (show-help   :initarg :show-help   :initform nil)
    630    (info-manual :initarg :info-manual :initform nil)
    631    (man-page    :initarg :man-page    :initform nil)
    632    (transient-suffix     :initarg :transient-suffix     :initform nil)
    633    (transient-non-suffix :initarg :transient-non-suffix :initform nil)
    634    (incompatible         :initarg :incompatible         :initform nil)
    635    (suffix-description   :initarg :suffix-description)
    636    (variable-pitch       :initarg :variable-pitch       :initform nil)
    637    (unwind-suffix        :documentation "Internal use." :initform nil))
    638   "Transient prefix command.
    639 
    640 Each transient prefix command consists of a command, which is
    641 stored in a symbol's function slot and an object, which is
    642 stored in the `transient--prefix' property of the same symbol.
    643 
    644 When a transient prefix command is invoked, then a clone of that
    645 object is stored in the global variable `transient--prefix' and
    646 the prototype is stored in the clone's `prototype' slot.")
    647 
    648 ;;;; Suffix
    649 
    650 (defclass transient-child ()
    651   ((level
    652     :initarg :level
    653     :initform (symbol-value 'transient--default-child-level)
    654     :documentation "Enable if level of prefix is equal or greater.")
    655    (if
    656     :initarg :if
    657     :initform nil
    658     :documentation "Enable if predicate returns non-nil.")
    659    (if-not
    660     :initarg :if-not
    661     :initform nil
    662     :documentation "Enable if predicate returns nil.")
    663    (if-non-nil
    664     :initarg :if-non-nil
    665     :initform nil
    666     :documentation "Enable if variable's value is non-nil.")
    667    (if-nil
    668     :initarg :if-nil
    669     :initform nil
    670     :documentation "Enable if variable's value is nil.")
    671    (if-mode
    672     :initarg :if-mode
    673     :initform nil
    674     :documentation "Enable if major-mode matches value.")
    675    (if-not-mode
    676     :initarg :if-not-mode
    677     :initform nil
    678     :documentation "Enable if major-mode does not match value.")
    679    (if-derived
    680     :initarg :if-derived
    681     :initform nil
    682     :documentation "Enable if major-mode derives from value.")
    683    (if-not-derived
    684     :initarg :if-not-derived
    685     :initform nil
    686     :documentation "Enable if major-mode does not derive from value."))
    687   "Abstract superclass for group and suffix classes.
    688 
    689 It is undefined what happens if more than one `if*' predicate
    690 slot is non-nil."
    691   :abstract t)
    692 
    693 (defclass transient-suffix (transient-child)
    694   ((key         :initarg :key)
    695    (command     :initarg :command)
    696    (transient   :initarg :transient)
    697    (format      :initarg :format      :initform " %k %d")
    698    (description :initarg :description :initform nil)
    699    (show-help   :initarg :show-help   :initform nil)
    700    (inapt                             :initform nil)
    701    (inapt-if
    702     :initarg :inapt-if
    703     :initform nil
    704     :documentation "Inapt if predicate returns non-nil.")
    705    (inapt-if-not
    706     :initarg :inapt-if-not
    707     :initform nil
    708     :documentation "Inapt if predicate returns nil.")
    709    (inapt-if-non-nil
    710     :initarg :inapt-if-non-nil
    711     :initform nil
    712     :documentation "Inapt if variable's value is non-nil.")
    713    (inapt-if-nil
    714     :initarg :inapt-if-nil
    715     :initform nil
    716     :documentation "Inapt if variable's value is nil.")
    717    (inapt-if-mode
    718     :initarg :inapt-if-mode
    719     :initform nil
    720     :documentation "Inapt if major-mode matches value.")
    721    (inapt-if-not-mode
    722     :initarg :inapt-if-not-mode
    723     :initform nil
    724     :documentation "Inapt if major-mode does not match value.")
    725    (inapt-if-derived
    726     :initarg :inapt-if-derived
    727     :initform nil
    728     :documentation "Inapt if major-mode derives from value.")
    729    (inapt-if-not-derived
    730     :initarg :inapt-if-not-derived
    731     :initform nil
    732     :documentation "Inapt if major-mode does not derive from value."))
    733   "Superclass for suffix command.")
    734 
    735 (defclass transient-infix (transient-suffix)
    736   ((transient                         :initform t)
    737    (argument    :initarg :argument)
    738    (shortarg    :initarg :shortarg)
    739    (value                             :initform nil)
    740    (init-value  :initarg :init-value)
    741    (unsavable   :initarg :unsavable   :initform nil)
    742    (multi-value :initarg :multi-value :initform nil)
    743    (always-read :initarg :always-read :initform nil)
    744    (allow-empty :initarg :allow-empty :initform nil)
    745    (history-key :initarg :history-key :initform nil)
    746    (reader      :initarg :reader      :initform nil)
    747    (prompt      :initarg :prompt      :initform nil)
    748    (choices     :initarg :choices     :initform nil)
    749    (format                            :initform " %k %d (%v)"))
    750   "Transient infix command."
    751   :abstract t)
    752 
    753 (defclass transient-argument (transient-infix) ()
    754   "Abstract superclass for infix arguments."
    755   :abstract t)
    756 
    757 (defclass transient-switch (transient-argument) ()
    758   "Class used for command-line argument that can be turned on and off.")
    759 
    760 (defclass transient-option (transient-argument) ()
    761   "Class used for command-line argument that can take a value.")
    762 
    763 (defclass transient-variable (transient-infix)
    764   ((variable    :initarg :variable)
    765    (format                            :initform " %k %d %v"))
    766   "Abstract superclass for infix commands that set a variable."
    767   :abstract t)
    768 
    769 (defclass transient-switches (transient-argument)
    770   ((argument-format  :initarg :argument-format)
    771    (argument-regexp  :initarg :argument-regexp))
    772   "Class used for sets of mutually exclusive command-line switches.")
    773 
    774 (defclass transient-files (transient-option) ()
    775   ((key         :initform "--")
    776    (argument    :initform "--")
    777    (multi-value :initform rest)
    778    (reader      :initform transient-read-files))
    779   "Class used for the \"--\" argument or similar.
    780 All remaining arguments are treated as files.
    781 They become the value of this argument.")
    782 
    783 ;;;; Group
    784 
    785 (defclass transient-group (transient-child)
    786   ((suffixes       :initarg :suffixes       :initform nil)
    787    (hide           :initarg :hide           :initform nil)
    788    (description    :initarg :description    :initform nil)
    789    (setup-children :initarg :setup-children)
    790    (pad-keys       :initarg :pad-keys))
    791   "Abstract superclass of all group classes."
    792   :abstract t)
    793 
    794 (defclass transient-column (transient-group) ()
    795   "Group class that displays each element on a separate line.")
    796 
    797 (defclass transient-row (transient-group) ()
    798   "Group class that displays all elements on a single line.")
    799 
    800 (defclass transient-columns (transient-group) ()
    801   "Group class that displays elements organized in columns.
    802 Direct elements have to be groups whose elements have to be
    803 commands or strings.  Each subgroup represents a column.
    804 This class takes care of inserting the subgroups' elements.")
    805 
    806 (defclass transient-subgroups (transient-group) ()
    807   "Group class that wraps other groups.
    808 
    809 Direct elements have to be groups whose elements have to be
    810 commands or strings.  This group inserts an empty line between
    811 subgroups.  The subgroups are responsible for displaying their
    812 elements themselves.")
    813 
    814 ;;; Define
    815 
    816 (defmacro transient-define-prefix (name arglist &rest args)
    817   "Define NAME as a transient prefix command.
    818 
    819 ARGLIST are the arguments that command takes.
    820 DOCSTRING is the documentation string and is optional.
    821 
    822 These arguments can optionally be followed by key-value pairs.
    823 Each key has to be a keyword symbol, either `:class' or a keyword
    824 argument supported by the constructor of that class.  The
    825 `transient-prefix' class is used if the class is not specified
    826 explicitly.
    827 
    828 GROUPs add key bindings for infix and suffix commands and specify
    829 how these bindings are presented in the popup buffer.  At least
    830 one GROUP has to be specified.  See info node `(transient)Binding
    831 Suffix and Infix Commands'.
    832 
    833 The BODY is optional.  If it is omitted, then ARGLIST is also
    834 ignored and the function definition becomes:
    835 
    836   (lambda ()
    837     (interactive)
    838     (transient-setup \\='NAME))
    839 
    840 If BODY is specified, then it must begin with an `interactive'
    841 form that matches ARGLIST, and it must call `transient-setup'.
    842 It may however call that function only when some condition is
    843 satisfied; that is one of the reason why you might want to use
    844 an explicit BODY.
    845 
    846 All transients have a (possibly nil) value, which is exported
    847 when suffix commands are called, so that they can consume that
    848 value.  For some transients it might be necessary to have a sort
    849 of secondary value, called a scope.  Such a scope would usually
    850 be set in the commands `interactive' form and has to be passed
    851 to the setup function:
    852 
    853   (transient-setup \\='NAME nil nil :scope SCOPE)
    854 
    855 \(fn NAME ARGLIST [DOCSTRING] [KEYWORD VALUE]... GROUP... [BODY...])"
    856   (declare (debug ( &define name lambda-list
    857                     [&optional lambda-doc]
    858                     [&rest keywordp sexp]
    859                     [&rest vectorp]
    860                     [&optional ("interactive" interactive) def-body]))
    861            (indent defun)
    862            (doc-string 3))
    863   (pcase-let ((`(,class ,slots ,suffixes ,docstr ,body)
    864                (transient--expand-define-args args arglist)))
    865     `(progn
    866        (defalias ',name
    867          ,(if body
    868               `(lambda ,arglist ,@body)
    869             `(lambda ()
    870                (interactive)
    871                (transient-setup ',name))))
    872        (put ',name 'interactive-only t)
    873        (put ',name 'function-documentation ,docstr)
    874        (put ',name 'transient--prefix
    875             (,(or class 'transient-prefix) :command ',name ,@slots))
    876        (put ',name 'transient--layout
    877             (list ,@(cl-mapcan (lambda (s) (transient--parse-child name s))
    878                                suffixes))))))
    879 
    880 (defmacro transient-define-suffix (name arglist &rest args)
    881   "Define NAME as a transient suffix command.
    882 
    883 ARGLIST are the arguments that the command takes.
    884 DOCSTRING is the documentation string and is optional.
    885 
    886 These arguments can optionally be followed by key-value pairs.
    887 Each key has to be a keyword symbol, either `:class' or a
    888 keyword argument supported by the constructor of that class.
    889 The `transient-suffix' class is used if the class is not
    890 specified explicitly.
    891 
    892 The BODY must begin with an `interactive' form that matches
    893 ARGLIST.  The infix arguments are usually accessed by using
    894 `transient-args' inside `interactive'.
    895 
    896 \(fn NAME ARGLIST [DOCSTRING] [KEYWORD VALUE]... BODY...)"
    897   (declare (debug ( &define name lambda-list
    898                     [&optional lambda-doc]
    899                     [&rest keywordp sexp]
    900                     ("interactive" interactive)
    901                     def-body))
    902            (indent defun)
    903            (doc-string 3))
    904   (pcase-let ((`(,class ,slots ,_ ,docstr ,body)
    905                (transient--expand-define-args args arglist)))
    906     `(progn
    907        (defalias ',name (lambda ,arglist ,@body))
    908        (put ',name 'interactive-only t)
    909        (put ',name 'function-documentation ,docstr)
    910        (put ',name 'transient--suffix
    911             (,(or class 'transient-suffix) :command ',name ,@slots)))))
    912 
    913 (defmacro transient-define-infix (name arglist &rest args)
    914   "Define NAME as a transient infix command.
    915 
    916 ARGLIST is always ignored and reserved for future use.
    917 DOCSTRING is the documentation string and is optional.
    918 
    919 The key-value pairs are mandatory.  All transient infix commands
    920 are equal to each other (but not eq), so it is meaningless to
    921 define an infix command without also setting at least `:class'
    922 and one other keyword (which it is depends on the used class,
    923 usually `:argument' or `:variable').
    924 
    925 Each key has to be a keyword symbol, either `:class' or a keyword
    926 argument supported by the constructor of that class.  The
    927 `transient-switch' class is used if the class is not specified
    928 explicitly.
    929 
    930 The function definitions is always:
    931 
    932    (lambda ()
    933      (interactive)
    934      (let ((obj (transient-suffix-object)))
    935        (transient-infix-set obj (transient-infix-read obj)))
    936      (transient--show))
    937 
    938 `transient-infix-read' and `transient-infix-set' are generic
    939 functions.  Different infix commands behave differently because
    940 the concrete methods are different for different infix command
    941 classes.  In rare case the above command function might not be
    942 suitable, even if you define your own infix command class.  In
    943 that case you have to use `transient-define-suffix' to define
    944 the infix command and use t as the value of the `:transient'
    945 keyword.
    946 
    947 \(fn NAME ARGLIST [DOCSTRING] [KEYWORD VALUE]...)"
    948   (declare (debug ( &define name lambda-list
    949                     [&optional lambda-doc]
    950                     [&rest keywordp sexp]))
    951            (indent defun)
    952            (doc-string 3))
    953   (pcase-let ((`(,class ,slots ,_ ,docstr ,_)
    954                (transient--expand-define-args args arglist)))
    955     `(progn
    956        (defalias ',name ,(transient--default-infix-command))
    957        (put ',name 'interactive-only t)
    958        (put ',name 'command-modes (list 'not-a-mode))
    959        (put ',name 'function-documentation ,docstr)
    960        (put ',name 'transient--suffix
    961             (,(or class 'transient-switch) :command ',name ,@slots)))))
    962 
    963 (defalias 'transient-define-argument #'transient-define-infix
    964   "Define NAME as a transient infix command.
    965 
    966 Only use this alias to define an infix command that actually
    967 sets an infix argument.  To define a infix command that, for
    968 example, sets a variable, use `transient-define-infix' instead.
    969 
    970 \(fn NAME ARGLIST [DOCSTRING] [KEYWORD VALUE]...)")
    971 
    972 (defun transient--expand-define-args (args &optional arglist)
    973   (unless (listp arglist)
    974     (error "Mandatory ARGLIST is missing"))
    975   (let (class keys suffixes docstr)
    976     (when (stringp (car args))
    977       (setq docstr (pop args)))
    978     (while (keywordp (car args))
    979       (let ((k (pop args))
    980             (v (pop args)))
    981         (if (eq k :class)
    982             (setq class v)
    983           (push k keys)
    984           (push v keys))))
    985     (while (let ((arg (car args)))
    986              (or (vectorp arg)
    987                  (and arg (symbolp arg))))
    988       (push (pop args) suffixes))
    989     (list (if (eq (car-safe class) 'quote)
    990               (cadr class)
    991             class)
    992           (nreverse keys)
    993           (nreverse suffixes)
    994           docstr
    995           args)))
    996 
    997 (defun transient--parse-child (prefix spec)
    998   (cl-etypecase spec
    999     (symbol  (let ((value (symbol-value spec)))
   1000                (if (and (listp value)
   1001                         (or (listp (car value))
   1002                             (vectorp (car value))))
   1003                    (cl-mapcan (lambda (s) (transient--parse-child prefix s)) value)
   1004                  (transient--parse-child prefix value))))
   1005     (vector  (and-let* ((c (transient--parse-group  prefix spec))) (list c)))
   1006     (list    (and-let* ((c (transient--parse-suffix prefix spec))) (list c)))
   1007     (string  (list spec))))
   1008 
   1009 (defun transient--parse-group (prefix spec)
   1010   (setq spec (append spec nil))
   1011   (cl-symbol-macrolet
   1012       ((car (car spec))
   1013        (pop (pop spec)))
   1014     (let (level class args)
   1015       (when (integerp car)
   1016         (setq level pop))
   1017       (when (stringp car)
   1018         (setq args (plist-put args :description pop)))
   1019       (while (keywordp car)
   1020         (let ((key pop)
   1021               (val pop))
   1022           (cond ((eq key :class)
   1023                  (setq class (macroexp-quote val)))
   1024                 ((or (symbolp val)
   1025                      (and (listp val) (not (eq (car val) 'lambda))))
   1026                  (setq args (plist-put args key (macroexp-quote val))))
   1027                 ((setq args (plist-put args key val))))))
   1028       (list 'vector
   1029             (or level transient--default-child-level)
   1030             (or class
   1031                 (if (vectorp car)
   1032                     (quote 'transient-columns)
   1033                   (quote 'transient-column)))
   1034             (and args (cons 'list args))
   1035             (cons 'list
   1036                   (cl-mapcan (lambda (s) (transient--parse-child prefix s))
   1037                              spec))))))
   1038 
   1039 (defun transient--parse-suffix (prefix spec)
   1040   (let (level class args)
   1041     (cl-symbol-macrolet
   1042         ((car (car spec))
   1043          (pop (pop spec)))
   1044       (when (integerp car)
   1045         (setq level pop))
   1046       (when (or (stringp car)
   1047                 (vectorp car))
   1048         (setq args (plist-put args :key pop)))
   1049       (cond
   1050        ((or (stringp car)
   1051             (and (eq (car-safe car) 'lambda)
   1052                  (not (commandp car))))
   1053         (setq args (plist-put args :description pop)))
   1054        ((and (symbolp car)
   1055              (not (keywordp car))
   1056              (not (commandp car))
   1057              (commandp (cadr spec)))
   1058         (setq args (plist-put args :description (macroexp-quote pop)))))
   1059       (cond
   1060        ((keywordp car)
   1061         (error "Need command, got `%s'" car))
   1062        ((symbolp car)
   1063         (setq args (plist-put args :command (macroexp-quote pop))))
   1064        ((and (commandp car)
   1065              (not (stringp car)))
   1066         (let ((cmd pop)
   1067               (sym (intern
   1068                     (format "transient:%s:%s"
   1069                             prefix
   1070                             (let ((desc (plist-get args :description)))
   1071                               (if (and desc (or (stringp desc) (symbolp desc)))
   1072                                   desc
   1073                                 (plist-get args :key)))))))
   1074           (setq args (plist-put args :command
   1075                                 `(defalias ',sym ,(macroexp-quote cmd))))))
   1076        ((or (stringp car)
   1077             (and car (listp car)))
   1078         (let ((arg pop))
   1079           (cl-typecase arg
   1080             (list
   1081              (setq args (plist-put args :shortarg (car  arg)))
   1082              (setq args (plist-put args :argument (cadr arg)))
   1083              (setq arg  (cadr arg)))
   1084             (string
   1085              (when-let ((shortarg (transient--derive-shortarg arg)))
   1086                (setq args (plist-put args :shortarg shortarg)))
   1087              (setq args (plist-put args :argument arg))))
   1088           (setq args (plist-put args :command
   1089                                 (list 'quote (intern (format "transient:%s:%s"
   1090                                                              prefix arg)))))
   1091           (cond ((and car (not (keywordp car)))
   1092                  (setq class 'transient-option)
   1093                  (setq args (plist-put args :reader (macroexp-quote pop))))
   1094                 ((not (string-suffix-p "=" arg))
   1095                  (setq class 'transient-switch))
   1096                 (t
   1097                  (setq class 'transient-option)))))
   1098        (t
   1099         (error "Needed command or argument, got %S" car)))
   1100       (while (keywordp car)
   1101         (let ((key pop)
   1102               (val pop))
   1103           (cond ((eq key :class) (setq class val))
   1104                 ((eq key :level) (setq level val))
   1105                 ((eq (car-safe val) '\,)
   1106                  (setq args (plist-put args key (cadr val))))
   1107                 ((or (symbolp val)
   1108                      (and (listp val) (not (eq (car val) 'lambda))))
   1109                  (setq args (plist-put args key (macroexp-quote val))))
   1110                 ((setq args (plist-put args key val)))))))
   1111     (unless (plist-get args :key)
   1112       (when-let ((shortarg (plist-get args :shortarg)))
   1113         (setq args (plist-put args :key shortarg))))
   1114     (list 'list
   1115           (or level transient--default-child-level)
   1116           (macroexp-quote (or class 'transient-suffix))
   1117           (cons 'list args))))
   1118 
   1119 (defun transient--default-infix-command ()
   1120   (cons 'lambda
   1121         '(()
   1122           (interactive)
   1123           (let ((obj (transient-suffix-object)))
   1124             (transient-infix-set obj (transient-infix-read obj)))
   1125           (transient--show))))
   1126 
   1127 (defun transient--ensure-infix-command (obj)
   1128   (let ((cmd (oref obj command)))
   1129     (unless (or (commandp cmd)
   1130                 (get cmd 'transient--infix-command))
   1131       (if (or (cl-typep obj 'transient-switch)
   1132               (cl-typep obj 'transient-option))
   1133           (put cmd 'transient--infix-command
   1134                (transient--default-infix-command))
   1135         ;; This is not an anonymous infix argument.
   1136         (when (transient--use-suffix-p obj)
   1137           (error "Suffix %s is not defined or autoloaded as a command" cmd))))))
   1138 
   1139 (defun transient--derive-shortarg (arg)
   1140   (save-match-data
   1141     (and (string-match "\\`\\(-[a-zA-Z]\\)\\(\\'\\|=\\)" arg)
   1142          (match-string 1 arg))))
   1143 
   1144 (defun transient-parse-suffix (prefix suffix)
   1145   "Parse SUFFIX, to be added to PREFIX.
   1146 PREFIX is a prefix command, a symbol.
   1147 SUFFIX is a suffix command or a group specification (of
   1148   the same forms as expected by `transient-define-prefix').
   1149 Intended for use in a group's `:setup-children' function."
   1150   (eval (car (transient--parse-child prefix suffix))))
   1151 
   1152 (defun transient-parse-suffixes (prefix suffixes)
   1153   "Parse SUFFIXES, to be added to PREFIX.
   1154 PREFIX is a prefix command, a symbol.
   1155 SUFFIXES is a list of suffix command or a group specification
   1156   (of the same forms as expected by `transient-define-prefix').
   1157 Intended for use in a group's `:setup-children' function."
   1158   (mapcar (apply-partially #'transient-parse-suffix prefix) suffixes))
   1159 
   1160 ;;; Edit
   1161 
   1162 (defun transient--insert-suffix (prefix loc suffix action &optional keep-other)
   1163   (let* ((suf (cl-etypecase suffix
   1164                 (vector (transient--parse-group  prefix suffix))
   1165                 (list   (transient--parse-suffix prefix suffix))
   1166                 (string suffix)))
   1167          (mem (transient--layout-member loc prefix))
   1168          (elt (car mem)))
   1169     (setq suf (eval suf))
   1170     (cond
   1171      ((not mem)
   1172       (message "Cannot insert %S into %s; %s not found"
   1173                suffix prefix loc))
   1174      ((or (and (vectorp suffix) (not (vectorp elt)))
   1175           (and (listp   suffix) (vectorp elt))
   1176           (and (stringp suffix) (vectorp elt)))
   1177       (message "Cannot place %S into %s at %s; %s"
   1178                suffix prefix loc
   1179                "suffixes and groups cannot be siblings"))
   1180      (t
   1181       (when-let* ((bindingp (listp suf))
   1182                   (key (transient--spec-key suf))
   1183                   (conflict (car (transient--layout-member key prefix)))
   1184                   (conflictp
   1185                    (and (not (and (eq action 'replace)
   1186                                   (eq conflict elt)))
   1187                         (or (not keep-other)
   1188                             (eq (plist-get (nth 2 suf) :command)
   1189                                 (plist-get (nth 2 conflict) :command)))
   1190                         (equal (transient--suffix-predicate suf)
   1191                                (transient--suffix-predicate conflict)))))
   1192         (transient-remove-suffix prefix key))
   1193       (cl-ecase action
   1194         (insert  (setcdr mem (cons elt (cdr mem)))
   1195                  (setcar mem suf))
   1196         (append  (setcdr mem (cons suf (cdr mem))))
   1197         (replace (setcar mem suf)))))))
   1198 
   1199 ;;;###autoload
   1200 (defun transient-insert-suffix (prefix loc suffix &optional keep-other)
   1201   "Insert a SUFFIX into PREFIX before LOC.
   1202 PREFIX is a prefix command, a symbol.
   1203 SUFFIX is a suffix command or a group specification (of
   1204   the same forms as expected by `transient-define-prefix').
   1205 LOC is a command, a key vector, a key description (a string
   1206   as returned by `key-description'), or a coordination list
   1207   (whose last element may also be a command or key).
   1208 Remove a conflicting binding unless optional KEEP-OTHER is
   1209   non-nil.
   1210 See info node `(transient)Modifying Existing Transients'."
   1211   (declare (indent defun))
   1212   (transient--insert-suffix prefix loc suffix 'insert keep-other))
   1213 
   1214 ;;;###autoload
   1215 (defun transient-append-suffix (prefix loc suffix &optional keep-other)
   1216   "Insert a SUFFIX into PREFIX after LOC.
   1217 PREFIX is a prefix command, a symbol.
   1218 SUFFIX is a suffix command or a group specification (of
   1219   the same forms as expected by `transient-define-prefix').
   1220 LOC is a command, a key vector, a key description (a string
   1221   as returned by `key-description'), or a coordination list
   1222   (whose last element may also be a command or key).
   1223 Remove a conflicting binding unless optional KEEP-OTHER is
   1224   non-nil.
   1225 See info node `(transient)Modifying Existing Transients'."
   1226   (declare (indent defun))
   1227   (transient--insert-suffix prefix loc suffix 'append keep-other))
   1228 
   1229 ;;;###autoload
   1230 (defun transient-replace-suffix (prefix loc suffix)
   1231   "Replace the suffix at LOC in PREFIX with SUFFIX.
   1232 PREFIX is a prefix command, a symbol.
   1233 SUFFIX is a suffix command or a group specification (of
   1234   the same forms as expected by `transient-define-prefix').
   1235 LOC is a command, a key vector, a key description (a string
   1236   as returned by `key-description'), or a coordination list
   1237   (whose last element may also be a command or key).
   1238 See info node `(transient)Modifying Existing Transients'."
   1239   (declare (indent defun))
   1240   (transient--insert-suffix prefix loc suffix 'replace))
   1241 
   1242 ;;;###autoload
   1243 (defun transient-remove-suffix (prefix loc)
   1244   "Remove the suffix or group at LOC in PREFIX.
   1245 PREFIX is a prefix command, a symbol.
   1246 LOC is a command, a key vector, a key description (a string
   1247   as returned by `key-description'), or a coordination list
   1248   (whose last element may also be a command or key).
   1249 See info node `(transient)Modifying Existing Transients'."
   1250   (declare (indent defun))
   1251   (transient--layout-member loc prefix 'remove))
   1252 
   1253 (defun transient-get-suffix (prefix loc)
   1254   "Return the suffix or group at LOC in PREFIX.
   1255 PREFIX is a prefix command, a symbol.
   1256 LOC is a command, a key vector, a key description (a string
   1257   as returned by `key-description'), or a coordination list
   1258   (whose last element may also be a command or key).
   1259 See info node `(transient)Modifying Existing Transients'."
   1260   (if-let ((mem (transient--layout-member loc prefix)))
   1261       (car mem)
   1262     (error "%s not found in %s" loc prefix)))
   1263 
   1264 (defun transient-suffix-put (prefix loc prop value)
   1265   "Edit the suffix at LOC in PREFIX, setting PROP to VALUE.
   1266 PREFIX is a prefix command, a symbol.
   1267 SUFFIX is a suffix command or a group specification (of
   1268   the same forms as expected by `transient-define-prefix').
   1269 LOC is a command, a key vector, a key description (a string
   1270   as returned by `key-description'), or a coordination list
   1271   (whose last element may also be a command or key).
   1272 See info node `(transient)Modifying Existing Transients'."
   1273   (let ((suf (transient-get-suffix prefix loc)))
   1274     (setf (elt suf 2)
   1275           (plist-put (elt suf 2) prop value))))
   1276 
   1277 (defun transient--layout-member (loc prefix &optional remove)
   1278   (let ((val (or (get prefix 'transient--layout)
   1279                  (error "%s is not a transient command" prefix))))
   1280     (when (listp loc)
   1281       (while (integerp (car loc))
   1282         (let* ((children (if (vectorp val) (aref val 3) val))
   1283                (mem (transient--nthcdr (pop loc) children)))
   1284           (if (and remove (not loc))
   1285               (let ((rest (delq (car mem) children)))
   1286                 (if (vectorp val)
   1287                     (aset val 3 rest)
   1288                   (put prefix 'transient--layout rest))
   1289                 (setq val nil))
   1290             (setq val (if loc (car mem) mem)))))
   1291       (setq loc (car loc)))
   1292     (if loc
   1293         (transient--layout-member-1 (transient--kbd loc) val remove)
   1294       val)))
   1295 
   1296 (defun transient--layout-member-1 (loc layout remove)
   1297   (cond ((listp layout)
   1298          (seq-some (lambda (elt) (transient--layout-member-1 loc elt remove))
   1299                    layout))
   1300         ((vectorp (car (aref layout 3)))
   1301          (seq-some (lambda (elt) (transient--layout-member-1 loc elt remove))
   1302                    (aref layout 3)))
   1303         (remove
   1304          (aset layout 3
   1305                (delq (car (transient--group-member loc layout))
   1306                      (aref layout 3)))
   1307          nil)
   1308         (t (transient--group-member loc layout))))
   1309 
   1310 (defun transient--group-member (loc group)
   1311   (cl-member-if (lambda (suffix)
   1312                   (and (listp suffix)
   1313                        (let* ((def (nth 2 suffix))
   1314                               (cmd (plist-get def :command)))
   1315                          (if (symbolp loc)
   1316                              (eq cmd loc)
   1317                            (equal (transient--kbd
   1318                                    (or (plist-get def :key)
   1319                                        (transient--command-key cmd)))
   1320                                   loc)))))
   1321                 (aref group 3)))
   1322 
   1323 (defun transient--kbd (keys)
   1324   (when (vectorp keys)
   1325     (setq keys (key-description keys)))
   1326   (when (stringp keys)
   1327     (setq keys (kbd keys)))
   1328   keys)
   1329 
   1330 (defun transient--spec-key (spec)
   1331   (let ((plist (nth 2 spec)))
   1332     (or (plist-get plist :key)
   1333         (transient--command-key
   1334          (plist-get plist :command)))))
   1335 
   1336 (defun transient--command-key (cmd)
   1337   (and-let* ((obj (get cmd 'transient--suffix)))
   1338     (cond ((slot-boundp obj 'key)
   1339            (oref obj key))
   1340           ((slot-exists-p obj 'shortarg)
   1341            (if (slot-boundp obj 'shortarg)
   1342                (oref obj shortarg)
   1343              (transient--derive-shortarg (oref obj argument)))))))
   1344 
   1345 (defun transient--nthcdr (n list)
   1346   (nthcdr (if (< n 0) (- (length list) (abs n)) n) list))
   1347 
   1348 ;;; Variables
   1349 
   1350 (defvar transient-current-prefix nil
   1351   "The transient from which this suffix command was invoked.
   1352 This is an object representing that transient, use
   1353 `transient-current-command' to get the respective command.")
   1354 
   1355 (defvar transient-current-command nil
   1356   "The transient from which this suffix command was invoked.
   1357 This is a symbol representing that transient, use
   1358 `transient-current-prefix' to get the respective object.")
   1359 
   1360 (defvar transient-current-suffixes nil
   1361   "The suffixes of the transient from which this suffix command was invoked.
   1362 This is a list of objects.  Usually it is sufficient to instead
   1363 use the function `transient-args', which returns a list of
   1364 values.  In complex cases it might be necessary to use this
   1365 variable instead.")
   1366 
   1367 (defvar transient-exit-hook nil
   1368   "Hook run after exiting a transient.")
   1369 
   1370 (defvar transient--prefix nil)
   1371 (defvar transient--layout nil)
   1372 (defvar transient--suffixes nil)
   1373 
   1374 (defconst transient--stay t   "Do not exit the transient.")
   1375 (defconst transient--exit nil "Do exit the transient.")
   1376 
   1377 (defvar transient--exitp nil "Whether to exit the transient.")
   1378 (defvar transient--showp nil "Whether the transient is show in a popup buffer.")
   1379 (defvar transient--helpp nil "Whether help-mode is active.")
   1380 (defvar transient--editp nil "Whether edit-mode is active.")
   1381 
   1382 (defvar transient--active-infix nil "The active infix awaiting user input.")
   1383 
   1384 (defvar transient--timer nil)
   1385 
   1386 (defvar transient--stack nil)
   1387 
   1388 (defvar transient--minibuffer-depth 0)
   1389 
   1390 (defvar transient--buffer-name " *transient*"
   1391   "Name of the transient buffer.")
   1392 
   1393 (defvar transient--window nil
   1394   "The window used to display the transient popup.")
   1395 
   1396 (defvar transient--original-window nil
   1397   "The window that was selected before the transient was invoked.
   1398 Usually it remains selected while the transient is active.")
   1399 
   1400 (defvar transient--original-buffer nil
   1401   "The buffer that was current before the transient was invoked.
   1402 Usually it remains current while the transient is active.")
   1403 
   1404 (defvar transient--debug nil "Whether put debug information into *Messages*.")
   1405 
   1406 (defvar transient--history nil)
   1407 
   1408 (defvar transient--scroll-commands
   1409   '(transient-scroll-up
   1410     transient-scroll-down
   1411     mwheel-scroll
   1412     scroll-bar-toolkit-scroll))
   1413 
   1414 ;;; Identities
   1415 
   1416 (defun transient-suffix-object (&optional command)
   1417   "Return the object associated with the current suffix command.
   1418 
   1419 Each suffix commands is associated with an object, which holds
   1420 additional information about the suffix, such as its value (in
   1421 the case of an infix command, which is a kind of suffix command).
   1422 
   1423 This function is intended to be called by infix commands, whose
   1424 command definition usually (at least when defined using
   1425 `transient-define-infix') is this:
   1426 
   1427    (lambda ()
   1428      (interactive)
   1429      (let ((obj (transient-suffix-object)))
   1430        (transient-infix-set obj (transient-infix-read obj)))
   1431      (transient--show))
   1432 
   1433 \(User input is read outside of `interactive' to prevent the
   1434 command from being added to `command-history'.  See #23.)
   1435 
   1436 Such commands need to be able to access their associated object
   1437 to guide how `transient-infix-read' reads the new value and to
   1438 store the read value.  Other suffix commands (including non-infix
   1439 commands) may also need the object to guide their behavior.
   1440 
   1441 This function attempts to return the object associated with the
   1442 current suffix command even if the suffix command was not invoked
   1443 from a transient.  (For some suffix command that is a valid thing
   1444 to do, for others it is not.)  In that case nil may be returned
   1445 if the command was not defined using one of the macros intended
   1446 to define such commands.
   1447 
   1448 The optional argument COMMAND is intended for internal use.  If
   1449 you are contemplating using it in your own code, then you should
   1450 probably use this instead:
   1451 
   1452   (get COMMAND \\='transient--suffix)"
   1453   (when command
   1454     (cl-check-type command command))
   1455   (if (or transient--prefix
   1456           transient-current-prefix)
   1457       (let ((suffixes
   1458              (cl-remove-if-not
   1459               (lambda (obj)
   1460                 (eq (transient--suffix-command obj)
   1461                     (or command
   1462                         (if (eq this-command 'transient-set-level)
   1463                             ;; This is how it can look up for which
   1464                             ;; command it is setting the level.
   1465                             this-original-command
   1466                           this-command))))
   1467               (or transient--suffixes
   1468                   transient-current-suffixes))))
   1469         (or (and (cdr suffixes)
   1470                  (cl-find-if
   1471                   (lambda (obj)
   1472                     (equal (listify-key-sequence (transient--kbd (oref obj key)))
   1473                            (listify-key-sequence (this-command-keys))))
   1474                   suffixes))
   1475             (car suffixes)))
   1476     (when-let* ((obj (get (or command this-command) 'transient--suffix))
   1477                 (obj (clone obj)))
   1478       ;; Cannot use and-let* because of debbugs#31840.
   1479       (transient-init-scope obj)
   1480       (transient-init-value obj)
   1481       obj)))
   1482 
   1483 (defun transient--suffix-command (object)
   1484   "Return the command represented by OBJECT.
   1485 
   1486 If the value of OBJECT's `command' slot is a command, then return
   1487 that.  Otherwise it is a symbol whose `transient--infix-command'
   1488 property holds an anonymous command, which is returned instead."
   1489   (cl-check-type object transient-suffix)
   1490   (let ((sym (oref object command)))
   1491     (if (commandp sym)
   1492         sym
   1493       (get sym 'transient--infix-command))))
   1494 
   1495 (defun transient--suffix-symbol (arg)
   1496   "Return a symbol representing ARG.
   1497 
   1498 ARG must be a command and/or a symbol.  If it is a symbol,
   1499 then just return it.  Otherwise return the symbol whose
   1500 `transient--infix-command' property's value is ARG."
   1501   (or (cl-typep arg 'command)
   1502       (cl-typep arg 'symbol)
   1503       (signal 'wrong-type-argument `((command symbol) ,arg)))
   1504   (if (symbolp arg)
   1505       arg
   1506     (let* ((obj (transient-suffix-object))
   1507            (sym (oref obj command)))
   1508       (if (eq (get sym 'transient--infix-command) arg)
   1509           sym
   1510         (catch 'found
   1511           (mapatoms (lambda (sym)
   1512                       (when (eq (get sym 'transient--infix-command) arg)
   1513                         (throw 'found sym)))))))))
   1514 
   1515 ;;; Keymaps
   1516 
   1517 (defvar-keymap transient-base-map
   1518   :doc "Parent of other keymaps used by Transient.
   1519 
   1520 This is the parent keymap of all the keymaps that are used in
   1521 all transients: `transient-map' (which in turn is the parent
   1522 of the transient-specific keymaps), `transient-edit-map' and
   1523 `transient-sticky-map'.
   1524 
   1525 If you change a binding here, then you might also have to edit
   1526 `transient-sticky-map' and `transient-common-commands'.  While
   1527 the latter isn't a proper transient prefix command, it can be
   1528 edited using the same functions as used for transients.
   1529 
   1530 If you add a new command here, then you must also add a binding
   1531 to `transient-predicate-map'."
   1532   "ESC ESC ESC" #'transient-quit-all
   1533   "C-g"     #'transient-quit-one
   1534   "C-q"     #'transient-quit-all
   1535   "C-z"     #'transient-suspend
   1536   "C-v"     #'transient-scroll-up
   1537   "C-M-v"   #'transient-scroll-down
   1538   "<next>"  #'transient-scroll-up
   1539   "<prior>" #'transient-scroll-down)
   1540 
   1541 (defvar-keymap transient-map
   1542   :doc "Top-level keymap used by all transients.
   1543 
   1544 If you add a new command here, then you must also add a binding
   1545 to `transient-predicate-map'.  Also see `transient-base-map'."
   1546   :parent transient-base-map
   1547   "C-u"   #'universal-argument
   1548   "C--"   #'negative-argument
   1549   "C-t"   #'transient-show
   1550   "?"     #'transient-help
   1551   "C-h"   #'transient-help
   1552   ;; Also bound to "C-x p" and "C-x n" in transient-common-commands.
   1553   "C-M-p" #'transient-history-prev
   1554   "C-M-n" #'transient-history-next)
   1555 
   1556 (defvar-keymap transient-edit-map
   1557   :doc "Keymap that is active while a transient in is in \"edit mode\"."
   1558   :parent transient-base-map
   1559   "?"     #'transient-help
   1560   "C-h"   #'transient-help
   1561   "C-x l" #'transient-set-level)
   1562 
   1563 (defvar-keymap transient-sticky-map
   1564   :doc "Keymap that is active while an incomplete key sequence is active."
   1565   :parent transient-base-map
   1566   "C-g" #'transient-quit-seq)
   1567 
   1568 (defvar transient--common-command-prefixes '(?\C-x))
   1569 
   1570 (put 'transient-common-commands
   1571      'transient--layout
   1572      (list
   1573       (eval
   1574        (car (transient--parse-child
   1575              'transient-common-commands
   1576              (vector
   1577               :hide
   1578               (lambda ()
   1579                 (and (not (memq
   1580                            (car (bound-and-true-p transient--redisplay-key))
   1581                            transient--common-command-prefixes))
   1582                      (not transient-show-common-commands)))
   1583               (vector
   1584                "Value commands"
   1585                (list "C-x s  " "Set"            #'transient-set)
   1586                (list "C-x C-s" "Save"           #'transient-save)
   1587                (list "C-x C-k" "Reset"          #'transient-reset)
   1588                (list "C-x p  " "Previous value" #'transient-history-prev)
   1589                (list "C-x n  " "Next value"     #'transient-history-next))
   1590               (vector
   1591                "Sticky commands"
   1592                ;; Like `transient-sticky-map' except that
   1593                ;; "C-g" has to be bound to a different command.
   1594                (list "C-g" "Quit prefix or transient" #'transient-quit-one)
   1595                (list "C-q" "Quit transient stack"     #'transient-quit-all)
   1596                (list "C-z" "Suspend transient stack"  #'transient-suspend))
   1597               (vector
   1598                "Customize"
   1599                (list "C-x t" 'transient-toggle-common :description
   1600                      (lambda ()
   1601                        (if transient-show-common-commands
   1602                            "Hide common commands"
   1603                          "Show common permanently")))
   1604                (list "C-x l" "Show/hide suffixes" #'transient-set-level))))))))
   1605 
   1606 (defvar-keymap transient-popup-navigation-map
   1607   :doc "One of the keymaps used when popup navigation is enabled.
   1608 See `transient-enable-popup-navigation'."
   1609   "<down-mouse-1>" #'transient-noop
   1610   "<up>"   #'transient-backward-button
   1611   "<down>" #'transient-forward-button
   1612   "C-r"    #'transient-isearch-backward
   1613   "C-s"    #'transient-isearch-forward
   1614   "M-RET"  #'transient-push-button)
   1615 
   1616 (defvar-keymap transient-button-map
   1617   :doc "One of the keymaps used when popup navigation is enabled.
   1618 See `transient-enable-popup-navigation'."
   1619   "<mouse-1>" #'transient-push-button
   1620   "<mouse-2>" #'transient-push-button)
   1621 
   1622 (defvar-keymap transient-predicate-map
   1623   :doc "Base keymap used to map common commands to their transient behavior.
   1624 
   1625 The \"transient behavior\" of a command controls, among other
   1626 things, whether invoking the command causes the transient to be
   1627 exited or not, and whether infix arguments are exported before
   1628 doing so.
   1629 
   1630 Each \"key\" is a command that is common to all transients and
   1631 that is bound in `transient-map', `transient-edit-map',
   1632 `transient-sticky-map' and/or `transient-common-command'.
   1633 
   1634 Each binding is a \"pre-command\", a function that controls the
   1635 transient behavior of the respective command.
   1636 
   1637 For transient commands that are bound in individual transients,
   1638 the transient behavior is specified using the `:transient' slot
   1639 of the corresponding object."
   1640   "<transient-suspend>"           #'transient--do-suspend
   1641   "<transient-help>"              #'transient--do-stay
   1642   "<transient-set-level>"         #'transient--do-stay
   1643   "<transient-history-prev>"      #'transient--do-stay
   1644   "<transient-history-next>"      #'transient--do-stay
   1645   "<universal-argument>"          #'transient--do-stay
   1646   "<negative-argument>"           #'transient--do-minus
   1647   "<digit-argument>"              #'transient--do-stay
   1648   "<top-level>"                   #'transient--do-quit-all
   1649   "<transient-quit-all>"          #'transient--do-quit-all
   1650   "<transient-quit-one>"          #'transient--do-quit-one
   1651   "<transient-quit-seq>"          #'transient--do-stay
   1652   "<transient-show>"              #'transient--do-stay
   1653   "<transient-update>"            #'transient--do-stay
   1654   "<transient-toggle-common>"     #'transient--do-stay
   1655   "<transient-set>"               #'transient--do-call
   1656   "<transient-save>"              #'transient--do-call
   1657   "<transient-reset>"             #'transient--do-call
   1658   "<describe-key-briefly>"        #'transient--do-stay
   1659   "<describe-key>"                #'transient--do-stay
   1660   "<transient-scroll-up>"         #'transient--do-stay
   1661   "<transient-scroll-down>"       #'transient--do-stay
   1662   "<mwheel-scroll>"               #'transient--do-stay
   1663   "<scroll-bar-toolkit-scroll>"   #'transient--do-stay
   1664   "<transient-noop>"              #'transient--do-noop
   1665   "<transient-mouse-push-button>" #'transient--do-move
   1666   "<transient-push-button>"       #'transient--do-push-button
   1667   "<transient-backward-button>"   #'transient--do-move
   1668   "<transient-forward-button>"    #'transient--do-move
   1669   "<transient-isearch-backward>"  #'transient--do-move
   1670   "<transient-isearch-forward>"   #'transient--do-move
   1671   ;; If a valid but incomplete prefix sequence is followed by
   1672   ;; an unbound key, then Emacs calls the `undefined' command
   1673   ;; but does not set `this-command', `this-original-command'
   1674   ;; or `real-this-command' accordingly.  Instead they are nil.
   1675   "<nil>"                         #'transient--do-warn)
   1676 
   1677 (defvar transient--transient-map nil)
   1678 (defvar transient--predicate-map nil)
   1679 (defvar transient--redisplay-map nil)
   1680 (defvar transient--redisplay-key nil)
   1681 
   1682 (defun transient--push-keymap (var)
   1683   (let ((map (symbol-value var)))
   1684     (transient--debug "     push %s%s" var (if map "" " VOID"))
   1685     (when map
   1686       (with-demoted-errors "transient--push-keymap: %S"
   1687         (internal-push-keymap map 'overriding-terminal-local-map)))))
   1688 
   1689 (defun transient--pop-keymap (var)
   1690   (let ((map (symbol-value var)))
   1691     (when map
   1692       (transient--debug "     pop  %s" var)
   1693       (with-demoted-errors "transient--pop-keymap: %S"
   1694         (internal-pop-keymap map 'overriding-terminal-local-map)))))
   1695 
   1696 (defun transient--make-transient-map ()
   1697   (let ((map (make-sparse-keymap)))
   1698     (set-keymap-parent map (if transient--editp
   1699                                transient-edit-map
   1700                              transient-map))
   1701     (dolist (obj transient--suffixes)
   1702       (let ((key (oref obj key)))
   1703         (when (vectorp key)
   1704           (setq key (key-description key))
   1705           (oset obj key key))
   1706         (when transient-substitute-key-function
   1707           (setq key (save-match-data
   1708                       (funcall transient-substitute-key-function obj)))
   1709           (oset obj key key))
   1710         (let ((kbd (kbd key))
   1711               (cmd (transient--suffix-command obj)))
   1712           (when-let ((conflict (and transient-detect-key-conflicts
   1713                                     (transient--lookup-key map kbd))))
   1714             (unless (eq cmd conflict)
   1715               (error "Cannot bind %S to %s and also %s"
   1716                      (string-trim key)
   1717                      cmd conflict)))
   1718           (define-key map kbd cmd))))
   1719     (when-let ((b (keymap-lookup map "-"))) (keymap-set map "<kp-subtract>" b))
   1720     (when-let ((b (keymap-lookup map "="))) (keymap-set map "<kp-equal>" b))
   1721     (when-let ((b (keymap-lookup map "+"))) (keymap-set map "<kp-add>" b))
   1722     (when transient-enable-popup-navigation
   1723       ;; `transient--make-redisplay-map' maps only over bindings that are
   1724       ;; directly in the base keymap, so that cannot be a composed keymap.
   1725       (set-keymap-parent
   1726        map (make-composed-keymap
   1727             (keymap-parent map)
   1728             transient-popup-navigation-map)))
   1729     map))
   1730 
   1731 (defun transient--make-predicate-map ()
   1732   (let ((map (make-sparse-keymap)))
   1733     (set-keymap-parent map transient-predicate-map)
   1734     (when (memq (oref transient--prefix transient-non-suffix)
   1735                 '(nil transient--do-warn transient--do-noop))
   1736       (keymap-set map "<handle-switch-frame>" #'transient--do-suspend))
   1737     (dolist (obj transient--suffixes)
   1738       (let* ((cmd (oref obj command))
   1739              (sub-prefix (and (symbolp cmd) (get cmd 'transient--prefix) t))
   1740              (sym (transient--suffix-symbol cmd)))
   1741         (cond
   1742          ((oref obj inapt)
   1743           (define-key map (vector sym) #'transient--do-warn-inapt))
   1744          ((slot-boundp obj 'transient)
   1745           (define-key map (vector sym)
   1746             (let ((do (oref obj transient)))
   1747               (pcase (list do sub-prefix)
   1748                 ('(t     t) #'transient--do-recurse)
   1749                 ('(t   nil) (if (cl-typep obj 'transient-infix)
   1750                                 #'transient--do-stay
   1751                               #'transient--do-call))
   1752                 ('(nil   t) #'transient--do-replace)
   1753                 ('(nil nil) #'transient--do-exit)
   1754                 (_          do)))))
   1755          ((not (lookup-key transient-predicate-map (vector sym)))
   1756           (define-key map (vector sym)
   1757             (if sub-prefix
   1758                 #'transient--do-replace
   1759               (or (oref transient--prefix transient-suffix)
   1760                   #'transient--do-exit)))))))
   1761     map))
   1762 
   1763 (defun transient--make-redisplay-map ()
   1764   (setq transient--redisplay-key
   1765         (cl-case this-command
   1766           (transient-update
   1767            (setq transient--showp t)
   1768            (setq unread-command-events
   1769                  (listify-key-sequence (this-single-command-raw-keys))))
   1770           (transient-quit-seq
   1771            (setq unread-command-events
   1772                  (butlast (listify-key-sequence
   1773                            (this-single-command-raw-keys))
   1774                           2))
   1775            (butlast transient--redisplay-key))
   1776           (t nil)))
   1777   (let ((topmap (make-sparse-keymap))
   1778         (submap (make-sparse-keymap)))
   1779     (when transient--redisplay-key
   1780       (define-key topmap (vconcat transient--redisplay-key) submap)
   1781       (set-keymap-parent submap transient-sticky-map))
   1782     (map-keymap-internal
   1783      (lambda (key def)
   1784        (when (and (not (eq key ?\e))
   1785                   (listp def)
   1786                   (keymapp def))
   1787          (define-key topmap (vconcat transient--redisplay-key (list key))
   1788            #'transient-update)))
   1789      (if transient--redisplay-key
   1790          (let ((key (vconcat transient--redisplay-key)))
   1791            (or (lookup-key transient--transient-map key)
   1792                (and-let* ((regular (lookup-key local-function-key-map key)))
   1793                  (lookup-key transient--transient-map (vconcat regular)))))
   1794        transient--transient-map))
   1795     topmap))
   1796 
   1797 ;;; Setup
   1798 
   1799 (defun transient-setup (&optional name layout edit &rest params)
   1800   "Setup the transient specified by NAME.
   1801 
   1802 This function is called by transient prefix commands to setup the
   1803 transient.  In that case NAME is mandatory, LAYOUT and EDIT must
   1804 be nil and PARAMS may be (but usually is not) used to set, e.g.,
   1805 the \"scope\" of the transient (see `transient-define-prefix').
   1806 
   1807 This function is also called internally in which case LAYOUT and
   1808 EDIT may be non-nil."
   1809   (transient--debug 'setup)
   1810   (transient--with-emergency-exit
   1811     (cond
   1812      ((not name)
   1813       ;; Switching between regular and edit mode.
   1814       (transient--pop-keymap 'transient--transient-map)
   1815       (transient--pop-keymap 'transient--redisplay-map)
   1816       (setq name (oref transient--prefix command))
   1817       (setq params (list :scope (oref transient--prefix scope))))
   1818      (transient--prefix
   1819       ;; Invoked as a ":transient-non-suffix 'transient--do-{stay,call}"
   1820       ;; of an outer prefix.  Unlike the usual `transient--do-replace',
   1821       ;; these predicates fail to clean up after the outer prefix.
   1822       (transient--pop-keymap 'transient--transient-map)
   1823       (transient--pop-keymap 'transient--redisplay-map))
   1824      ((not (or layout                      ; resuming parent/suspended prefix
   1825                transient-current-command)) ; entering child prefix
   1826       (transient--stack-zap))              ; replace suspended prefix, if any
   1827      (edit
   1828       ;; Returning from help to edit.
   1829       (setq transient--editp t)))
   1830     (transient--init-objects name layout params)
   1831     (transient--history-init transient--prefix)
   1832     (setq transient--predicate-map (transient--make-predicate-map))
   1833     (setq transient--transient-map (transient--make-transient-map))
   1834     (setq transient--redisplay-map (transient--make-redisplay-map))
   1835     (setq transient--original-window (selected-window))
   1836     (setq transient--original-buffer (current-buffer))
   1837     (setq transient--minibuffer-depth (minibuffer-depth))
   1838     (transient--redisplay)
   1839     (transient--init-transient)
   1840     (transient--suspend-which-key-mode)))
   1841 
   1842 (cl-defgeneric transient-setup-children (group children)
   1843   "Setup the CHILDREN of GROUP.
   1844 If the value of the `setup-children' slot is non-nil, then call
   1845 that function with CHILDREN as the only argument and return the
   1846 value.  Otherwise return CHILDREN as is."
   1847   (if (slot-boundp group 'setup-children)
   1848       (funcall (oref group setup-children) children)
   1849     children))
   1850 
   1851 (defun transient--init-objects (name layout params)
   1852   (setq transient--prefix (transient--init-prefix name params))
   1853   (setq transient--layout (or layout (transient--init-suffixes name)))
   1854   (setq transient--suffixes (transient--flatten-suffixes transient--layout)))
   1855 
   1856 (defun transient--init-prefix (name &optional params)
   1857   (let ((obj (let ((proto (get name 'transient--prefix)))
   1858                (apply #'clone proto
   1859                       :prototype proto
   1860                       :level (or (alist-get t (alist-get name transient-levels))
   1861                                  transient-default-level)
   1862                       params))))
   1863     (transient--setup-recursion obj)
   1864     (transient-init-value obj)
   1865     obj))
   1866 
   1867 (defun transient--init-suffixes (name)
   1868   (let ((levels (alist-get name transient-levels)))
   1869     (cl-mapcan (lambda (c) (transient--init-child levels c))
   1870                (append (get name 'transient--layout)
   1871                        (and (not transient--editp)
   1872                             (get 'transient-common-commands
   1873                                  'transient--layout))))))
   1874 
   1875 (defun transient--flatten-suffixes (layout)
   1876   (cl-labels ((s (def)
   1877                 (cond
   1878                  ((stringp def) nil)
   1879                  ((listp def) (cl-mapcan #'s def))
   1880                  ((transient-group--eieio-childp def)
   1881                   (cl-mapcan #'s (oref def suffixes)))
   1882                  ((transient-suffix--eieio-childp def)
   1883                   (list def)))))
   1884     (cl-mapcan #'s layout)))
   1885 
   1886 (defun transient--init-child (levels spec)
   1887   (cl-etypecase spec
   1888     (vector  (transient--init-group  levels spec))
   1889     (list    (transient--init-suffix levels spec))
   1890     (string  (list spec))))
   1891 
   1892 (defun transient--init-group (levels spec)
   1893   (pcase-let ((`(,level ,class ,args ,children) (append spec nil)))
   1894     (when-let* ((- (transient--use-level-p level))
   1895                 (obj (apply class :level level args))
   1896                 (- (transient--use-suffix-p obj))
   1897                 (suffixes (cl-mapcan (lambda (c) (transient--init-child levels c))
   1898                                      (transient-setup-children obj children))))
   1899       ;; Cannot use and-let* because of debbugs#31840.
   1900       (oset obj suffixes suffixes)
   1901       (list obj))))
   1902 
   1903 (defun transient--init-suffix (levels spec)
   1904   (pcase-let* ((`(,level ,class ,args) spec)
   1905                (cmd (plist-get args :command))
   1906                (level (or (alist-get (transient--suffix-symbol cmd) levels)
   1907                           level)))
   1908     (let ((fn (and (symbolp cmd)
   1909                    (symbol-function cmd))))
   1910       (when (autoloadp fn)
   1911         (transient--debug "   autoload %s" cmd)
   1912         (autoload-do-load fn)))
   1913     (when (transient--use-level-p level)
   1914       (let ((obj (if-let ((proto (and cmd
   1915                                       (symbolp cmd)
   1916                                       (get cmd 'transient--suffix))))
   1917                      (apply #'clone proto :level level args)
   1918                    (apply class :level level args))))
   1919         (transient--init-suffix-key obj)
   1920         (transient--ensure-infix-command obj)
   1921         (when (transient--use-suffix-p obj)
   1922           (if (transient--inapt-suffix-p obj)
   1923               (oset obj inapt t)
   1924             (transient-init-scope obj)
   1925             (transient-init-value obj))
   1926           (list obj))))))
   1927 
   1928 (cl-defmethod transient--init-suffix-key ((obj transient-suffix))
   1929   (unless (slot-boundp obj 'key)
   1930     (error "No key for %s" (oref obj command))))
   1931 
   1932 (cl-defmethod transient--init-suffix-key ((obj transient-argument))
   1933   (if (transient-switches--eieio-childp obj)
   1934       (cl-call-next-method obj)
   1935     (unless (slot-boundp obj 'shortarg)
   1936       (when-let ((shortarg (transient--derive-shortarg (oref obj argument))))
   1937         (oset obj shortarg shortarg)))
   1938     (unless (slot-boundp obj 'key)
   1939       (if (slot-boundp obj 'shortarg)
   1940           (oset obj key (oref obj shortarg))
   1941         (error "No key for %s" (oref obj command))))))
   1942 
   1943 (defun transient--use-level-p (level &optional edit)
   1944   (or (and transient--editp (not edit))
   1945       (and (>= level 1)
   1946            (<= level (oref transient--prefix level)))))
   1947 
   1948 (defun transient--use-suffix-p (obj)
   1949   (transient--do-suffix-p
   1950    (oref obj if)
   1951    (oref obj if-not)
   1952    (oref obj if-nil)
   1953    (oref obj if-non-nil)
   1954    (oref obj if-mode)
   1955    (oref obj if-not-mode)
   1956    (oref obj if-derived)
   1957    (oref obj if-not-derived)
   1958    t))
   1959 
   1960 (defun transient--inapt-suffix-p (obj)
   1961   (transient--do-suffix-p
   1962    (oref obj inapt-if)
   1963    (oref obj inapt-if-not)
   1964    (oref obj inapt-if-nil)
   1965    (oref obj inapt-if-non-nil)
   1966    (oref obj inapt-if-mode)
   1967    (oref obj inapt-if-not-mode)
   1968    (oref obj inapt-if-derived)
   1969    (oref obj inapt-if-not-derived)
   1970    nil))
   1971 
   1972 (defun transient--do-suffix-p
   1973     (if if-not if-nil if-non-nil if-mode if-not-mode if-derived if-not-derived
   1974         default)
   1975   (cond
   1976    (if                  (funcall if))
   1977    (if-not         (not (funcall if-not)))
   1978    (if-non-nil          (symbol-value if-non-nil))
   1979    (if-nil         (not (symbol-value if-nil)))
   1980    (if-mode             (if (atom if-mode)
   1981                             (eq major-mode if-mode)
   1982                           (memq major-mode if-mode)))
   1983    (if-not-mode    (not (if (atom if-not-mode)
   1984                             (eq major-mode if-not-mode)
   1985                           (memq major-mode if-not-mode))))
   1986    (if-derived          (if (atom if-derived)
   1987                             (derived-mode-p if-derived)
   1988                           (apply #'derived-mode-p if-derived)))
   1989    (if-not-derived (not (if (atom if-not-derived)
   1990                             (derived-mode-p if-not-derived)
   1991                           (apply #'derived-mode-p if-not-derived))))
   1992    (t default)))
   1993 
   1994 (defun transient--suffix-predicate (spec)
   1995   (let ((plist (nth 2 spec)))
   1996     (seq-some (lambda (prop)
   1997                 (and-let* ((pred (plist-get plist prop)))
   1998                   (list prop pred)))
   1999               '( :if :if-not
   2000                  :if-nil :if-non-nil
   2001                  :if-mode :if-not-mode
   2002                  :if-derived :if-not-derived
   2003                  :inapt-if :inapt-if-not
   2004                  :inapt-if-nil :inapt-if-non-nil
   2005                  :inapt-if-mode :inapt-if-not-mode
   2006                  :inapt-if-derived :inapt-if-not-derived))))
   2007 
   2008 ;;; Flow-Control
   2009 
   2010 (defun transient--init-transient ()
   2011   (transient--debug 'init-transient)
   2012   (transient--push-keymap 'transient--transient-map)
   2013   (transient--push-keymap 'transient--redisplay-map)
   2014   (add-hook 'pre-command-hook  #'transient--pre-command)
   2015   (add-hook 'post-command-hook #'transient--post-command)
   2016   (advice-add 'recursive-edit :around #'transient--recursive-edit)
   2017   (when transient--exitp
   2018     ;; This prefix command was invoked as the suffix of another.
   2019     ;; Prevent `transient--post-command' from removing the hooks
   2020     ;; that we just added.
   2021     (setq transient--exitp 'replace)))
   2022 
   2023 (defun transient--pre-command ()
   2024   (transient--debug 'pre-command)
   2025   (transient--with-emergency-exit
   2026     ;; The use of `overriding-terminal-local-map' does not prevent the
   2027     ;; lookup of command remappings in the overridden maps, which can
   2028     ;; lead to a suffix being remapped to a non-suffix.  We have to undo
   2029     ;; the remapping in that case.  However, remapping a non-suffix to
   2030     ;; another should remain possible.
   2031     (when (and (transient--get-predicate-for this-original-command 'suffix)
   2032                (not (transient--get-predicate-for this-command 'suffix)))
   2033       (setq this-command this-original-command))
   2034     (cond
   2035      ((memq this-command '(transient-update transient-quit-seq))
   2036       (transient--pop-keymap 'transient--redisplay-map))
   2037      ((and transient--helpp
   2038            (not (memq this-command '(transient-quit-one
   2039                                      transient-quit-all))))
   2040       (cond
   2041        ((transient-help)
   2042         (transient--do-suspend)
   2043         (setq this-command 'transient-suspend)
   2044         (transient--pre-exit))
   2045        ((not (transient--edebug-command-p))
   2046         (setq this-command 'transient-undefined))))
   2047      ((and transient--editp
   2048            (transient-suffix-object)
   2049            (not (memq this-command '(transient-quit-one
   2050                                      transient-quit-all
   2051                                      transient-help))))
   2052       (setq this-command 'transient-set-level)
   2053       (transient--wrap-command))
   2054      (t
   2055       (setq transient--exitp nil)
   2056       (let ((exitp (eq (transient--do-pre-command) transient--exit)))
   2057         (transient--wrap-command)
   2058         (when exitp
   2059           (transient--pre-exit)))))))
   2060 
   2061 (defun transient--do-pre-command ()
   2062   (if-let ((fn (transient--get-predicate-for this-command)))
   2063       (let ((action (funcall fn)))
   2064         (when (eq action transient--exit)
   2065           (setq transient--exitp (or transient--exitp t)))
   2066         action)
   2067     (if (let ((keys (this-command-keys-vector)))
   2068           (eq (aref keys (1- (length keys))) ?\C-g))
   2069         (setq this-command 'transient-noop)
   2070       (unless (transient--edebug-command-p)
   2071         (setq this-command 'transient-undefined)))
   2072     transient--stay))
   2073 
   2074 (defun transient--get-predicate-for (cmd &optional suffix-only)
   2075   (or (ignore-errors
   2076         (lookup-key transient--predicate-map
   2077                     (vector (transient--suffix-symbol cmd))))
   2078       (and (not suffix-only)
   2079            (let ((pred (oref transient--prefix transient-non-suffix)))
   2080              (pcase pred
   2081                ('t   #'transient--do-stay)
   2082                ('nil #'transient--do-warn)
   2083                (_    pred))))))
   2084 
   2085 (defun transient--pre-exit ()
   2086   (transient--debug 'pre-exit)
   2087   (transient--delete-window)
   2088   (transient--timer-cancel)
   2089   (transient--pop-keymap 'transient--transient-map)
   2090   (transient--pop-keymap 'transient--redisplay-map)
   2091   (unless transient--showp
   2092     (let ((message-log-max nil))
   2093       (message "")))
   2094   (setq transient--transient-map nil)
   2095   (setq transient--predicate-map nil)
   2096   (setq transient--redisplay-map nil)
   2097   (setq transient--redisplay-key nil)
   2098   (setq transient--helpp nil)
   2099   (setq transient--editp nil)
   2100   (setq transient--prefix nil)
   2101   (setq transient--layout nil)
   2102   (setq transient--suffixes nil)
   2103   (setq transient--original-window nil)
   2104   (setq transient--original-buffer nil)
   2105   (setq transient--window nil))
   2106 
   2107 (defun transient--delete-window ()
   2108   (when (window-live-p transient--window)
   2109     (let ((remain-in-minibuffer-window
   2110            (and (minibuffer-selected-window)
   2111                 (selected-window)))
   2112           (buf (window-buffer transient--window)))
   2113       ;; Only delete the window if it never showed another buffer.
   2114       (unless (eq (car (window-parameter transient--window 'quit-restore)) 'other)
   2115         (with-demoted-errors "Error while exiting transient: %S"
   2116           (delete-window transient--window)))
   2117       (kill-buffer buf)
   2118       (when remain-in-minibuffer-window
   2119         (select-window remain-in-minibuffer-window)))))
   2120 
   2121 (defun transient--export ()
   2122   (setq transient-current-prefix transient--prefix)
   2123   (setq transient-current-command (oref transient--prefix command))
   2124   (setq transient-current-suffixes transient--suffixes)
   2125   (transient--history-push transient--prefix))
   2126 
   2127 (defun transient--suspend-override (&optional nohide)
   2128   (transient--debug 'suspend-override)
   2129   (transient--timer-cancel)
   2130   (cond ((and (not nohide) transient-hide-during-minibuffer-read)
   2131          (transient--delete-window))
   2132         ((and transient--prefix transient--redisplay-key)
   2133          (setq transient--redisplay-key nil)
   2134          (when transient--showp
   2135            (transient--show))))
   2136   (transient--pop-keymap 'transient--transient-map)
   2137   (transient--pop-keymap 'transient--redisplay-map)
   2138   (remove-hook 'pre-command-hook  #'transient--pre-command)
   2139   (remove-hook 'post-command-hook #'transient--post-command))
   2140 
   2141 (defun transient--resume-override (&optional _ignore)
   2142   (transient--debug 'resume-override)
   2143   (when (and transient--showp transient-hide-during-minibuffer-read)
   2144     (transient--show))
   2145   (transient--push-keymap 'transient--transient-map)
   2146   (transient--push-keymap 'transient--redisplay-map)
   2147   (add-hook 'pre-command-hook  #'transient--pre-command)
   2148   (add-hook 'post-command-hook #'transient--post-command))
   2149 
   2150 (defun transient--recursive-edit (fn)
   2151   (transient--debug 'recursive-edit)
   2152   (if (not transient--prefix)
   2153       (funcall fn)
   2154     (transient--suspend-override (bound-and-true-p edebug-active))
   2155     (funcall fn) ; Already unwind protected.
   2156     (cond ((memq this-command '(top-level abort-recursive-edit))
   2157            (setq transient--exitp t)
   2158            (transient--post-exit)
   2159            (transient--delete-window))
   2160           (transient--prefix
   2161            (transient--resume-override)))))
   2162 
   2163 (defmacro transient--with-suspended-override (&rest body)
   2164   (let ((depth (make-symbol "depth"))
   2165         (setup (make-symbol "setup"))
   2166         (exit  (make-symbol "exit")))
   2167     `(if (and transient--transient-map
   2168               (memq transient--transient-map
   2169                     overriding-terminal-local-map))
   2170          (let ((,depth (1+ (minibuffer-depth))) ,setup ,exit)
   2171            (setq ,setup
   2172                  (lambda () "@transient--with-suspended-override"
   2173                    (transient--debug 'minibuffer-setup)
   2174                    (remove-hook 'minibuffer-setup-hook ,setup)
   2175                    (transient--suspend-override)))
   2176            (setq ,exit
   2177                  (lambda () "@transient--with-suspended-override"
   2178                    (transient--debug 'minibuffer-exit)
   2179                    (when (= (minibuffer-depth) ,depth)
   2180                      (transient--resume-override))))
   2181            (unwind-protect
   2182                (progn
   2183                  (add-hook 'minibuffer-setup-hook ,setup)
   2184                  (add-hook 'minibuffer-exit-hook ,exit)
   2185                  ,@body)
   2186              (remove-hook 'minibuffer-setup-hook ,setup)
   2187              (remove-hook 'minibuffer-exit-hook ,exit)))
   2188        ,@body)))
   2189 
   2190 (defun transient--wrap-command ()
   2191   (let* ((prefix transient--prefix)
   2192          (suffix this-command)
   2193          (advice nil)
   2194          (advice-interactive
   2195           (lambda (spec)
   2196             (let ((abort t))
   2197               (unwind-protect
   2198 	          (prog1 (advice-eval-interactive-spec spec)
   2199 	            (setq abort nil))
   2200 	        (when abort
   2201                   (when-let ((unwind (oref prefix unwind-suffix)))
   2202                     (transient--debug 'unwind-interactive)
   2203                     (funcall unwind suffix))
   2204                   (if (symbolp suffix)
   2205                       (advice-remove suffix advice)
   2206                     (remove-function suffix advice))
   2207                   (oset prefix unwind-suffix nil))))))
   2208          (advice-body
   2209           (lambda (fn &rest args)
   2210             (unwind-protect
   2211                 (apply fn args)
   2212               (when-let ((unwind (oref prefix unwind-suffix)))
   2213                 (transient--debug 'unwind-command)
   2214                 (funcall unwind suffix))
   2215               (if (symbolp suffix)
   2216                   (advice-remove suffix advice)
   2217                 (remove-function suffix advice))
   2218               (oset prefix unwind-suffix nil)))))
   2219     (setq advice `(lambda (fn &rest args)
   2220                     (interactive ,advice-interactive)
   2221                     (apply ',advice-body fn args)))
   2222     (if (symbolp suffix)
   2223         (advice-add suffix :around advice '((depth . -99)))
   2224       (add-function :around (var suffix) advice '((depth . -99))))))
   2225 
   2226 (defun transient--premature-post-command ()
   2227   (and (equal (this-command-keys-vector) [])
   2228        (= (minibuffer-depth)
   2229           (1+ transient--minibuffer-depth))
   2230        (progn
   2231          (transient--debug 'premature-post-command)
   2232          (transient--suspend-override)
   2233          (oset (or transient--prefix transient-current-prefix)
   2234                unwind-suffix
   2235                (if transient--exitp
   2236                    #'transient--post-exit
   2237                  #'transient--resume-override))
   2238          t)))
   2239 
   2240 (defun transient--post-command ()
   2241   (unless (transient--premature-post-command)
   2242     (transient--debug 'post-command)
   2243     (transient--with-emergency-exit
   2244       (cond (transient--exitp (transient--post-exit))
   2245             ((eq this-command (oref transient--prefix command)))
   2246             ((let ((old transient--redisplay-map)
   2247                    (new (transient--make-redisplay-map)))
   2248                (unless (equal old new)
   2249                  (transient--pop-keymap 'transient--redisplay-map)
   2250                  (setq transient--redisplay-map new)
   2251                  (transient--push-keymap 'transient--redisplay-map))
   2252                (transient--redisplay)))))))
   2253 
   2254 (defun transient--post-exit (&optional command)
   2255   (transient--debug 'post-exit)
   2256   (unless (and (eq transient--exitp 'replace)
   2257                (or transient--prefix
   2258                    ;; The current command could act as a prefix,
   2259                    ;; but decided not to call `transient-setup',
   2260                    ;; or it is prevented from doing so because it
   2261                    ;; uses the minibuffer and the user aborted
   2262                    ;; that.
   2263                    (prog1 nil
   2264                      (if (let ((obj (transient-suffix-object command)))
   2265                            (and (slot-boundp obj 'transient)
   2266                                 (oref obj transient)))
   2267                          ;; This sub-prefix is a transient suffix;
   2268                          ;; go back to outer prefix, by calling
   2269                          ;; `transient--stack-pop' further down.
   2270                          (setq transient--exitp nil)
   2271                        (transient--stack-zap)))))
   2272     (remove-hook 'pre-command-hook  #'transient--pre-command)
   2273     (remove-hook 'post-command-hook #'transient--post-command)
   2274     (advice-remove 'recursive-edit #'transient--recursive-edit))
   2275   (setq transient-current-prefix nil)
   2276   (setq transient-current-command nil)
   2277   (setq transient-current-suffixes nil)
   2278   (let ((resume (and transient--stack
   2279                      (not (memq transient--exitp '(replace suspend))))))
   2280     (unless (or resume (eq transient--exitp 'replace))
   2281       (setq transient--showp nil))
   2282     (setq transient--exitp nil)
   2283     (setq transient--helpp nil)
   2284     (setq transient--editp nil)
   2285     (setq transient--minibuffer-depth 0)
   2286     (run-hooks 'transient-exit-hook)
   2287     (when resume
   2288       (transient--stack-pop))))
   2289 
   2290 (defun transient--stack-push ()
   2291   (transient--debug 'stack-push)
   2292   (push (list (oref transient--prefix command)
   2293               transient--layout
   2294               transient--editp
   2295               :scope (oref transient--prefix scope))
   2296         transient--stack))
   2297 
   2298 (defun transient--stack-pop ()
   2299   (transient--debug 'stack-pop)
   2300   (and transient--stack
   2301        (prog1 t (apply #'transient-setup (pop transient--stack)))))
   2302 
   2303 (defun transient--stack-zap ()
   2304   (transient--debug 'stack-zap)
   2305   (setq transient--stack nil))
   2306 
   2307 (defun transient--redisplay ()
   2308   (if (or (eq transient-show-popup t)
   2309           transient--showp)
   2310       (unless
   2311           (or (memq this-command transient--scroll-commands)
   2312               (and (or (memq this-command '(mouse-drag-region
   2313                                             mouse-set-region))
   2314                        (equal (key-description (this-command-keys-vector))
   2315                               "<mouse-movement>"))
   2316                    (and (eq (current-buffer)
   2317                             (get-buffer transient--buffer-name)))))
   2318         (transient--show))
   2319     (when (and (numberp transient-show-popup)
   2320                (not (zerop transient-show-popup))
   2321                (not transient--timer))
   2322       (transient--timer-start))
   2323     (transient--show-brief)))
   2324 
   2325 (defun transient--timer-start ()
   2326   (setq transient--timer
   2327         (run-at-time (abs transient-show-popup) nil
   2328                      (lambda ()
   2329                        (transient--timer-cancel)
   2330                        (transient--show)
   2331                        (let ((message-log-max nil))
   2332                          (message ""))))))
   2333 
   2334 (defun transient--timer-cancel ()
   2335   (when transient--timer
   2336     (cancel-timer transient--timer)
   2337     (setq transient--timer nil)))
   2338 
   2339 (defun transient--debug (arg &rest args)
   2340   (when transient--debug
   2341     (let ((inhibit-message (not (eq transient--debug 'message))))
   2342       (if (symbolp arg)
   2343           (message "-- %-22s (cmd: %s, event: %S, exit: %s%s)"
   2344                    arg
   2345                    (or (ignore-errors (transient--suffix-symbol this-command))
   2346                        (if (byte-code-function-p this-command)
   2347                            "#[...]"
   2348                          this-command))
   2349                    (key-description (this-command-keys-vector))
   2350                    transient--exitp
   2351                    (cond ((stringp (car args))
   2352                           (concat ", " (apply #'format args)))
   2353                          (args
   2354                           (concat ", " (apply (car args) (cdr args))))
   2355                          (t "")))
   2356         (apply #'message arg args)))))
   2357 
   2358 (defun transient--emergency-exit ()
   2359   "Exit the current transient command after an error occurred.
   2360 When no transient is active (i.e. when `transient--prefix' is
   2361 nil) then do nothing."
   2362   (transient--debug 'emergency-exit)
   2363   (when transient--prefix
   2364     (setq transient--stack nil)
   2365     (setq transient--exitp t)
   2366     (transient--pre-exit)
   2367     (transient--post-exit)))
   2368 
   2369 ;;; Pre-Commands
   2370 
   2371 (defun transient--do-stay ()
   2372   "Call the command without exporting variables and stay transient."
   2373   transient--stay)
   2374 
   2375 (defun transient--do-noop ()
   2376   "Call `transient-noop' and stay transient."
   2377   (setq this-command 'transient-noop)
   2378   transient--stay)
   2379 
   2380 (defun transient--do-warn ()
   2381   "Call `transient-undefined' and stay transient."
   2382   (setq this-command 'transient-undefined)
   2383   transient--stay)
   2384 
   2385 (defun transient--do-warn-inapt ()
   2386   "Call `transient-inapt' and stay transient."
   2387   (setq this-command 'transient-inapt)
   2388   transient--stay)
   2389 
   2390 (defun transient--do-call ()
   2391   "Call the command after exporting variables and stay transient."
   2392   (transient--export)
   2393   transient--stay)
   2394 
   2395 (defun transient--do-return ()
   2396   "Call the command after exporting variables and return to parent prefix.
   2397 If there is no parent prefix, then behave like `transient--do-exit'."
   2398   (if (not transient--stack)
   2399       (transient--do-exit)
   2400     (transient--export)
   2401     transient--exit))
   2402 
   2403 (defun transient--do-exit ()
   2404   "Call the command after exporting variables and exit the transient."
   2405   (transient--export)
   2406   (transient--stack-zap)
   2407   transient--exit)
   2408 
   2409 (defun transient--do-leave ()
   2410   "Call the command without exporting variables and exit the transient."
   2411   transient--stay)
   2412 
   2413 (defun transient--do-push-button ()
   2414   "Call the command represented by the activated button.
   2415 Use that command's pre-command to determine transient behavior."
   2416   (if (and (mouse-event-p last-command-event)
   2417            (not (eq (posn-window (event-start last-command-event))
   2418                     transient--window)))
   2419       transient--stay
   2420     (setq this-command
   2421           (with-selected-window transient--window
   2422             (get-text-property (if (mouse-event-p last-command-event)
   2423                                    (posn-point (event-start last-command-event))
   2424                                  (point))
   2425                                'command)))
   2426     (transient--do-pre-command)))
   2427 
   2428 (defun transient--do-recurse ()
   2429   "Call the transient prefix command, preparing for return to active transient.
   2430 If there is no parent prefix, then just call the command."
   2431   (transient--do-replace))
   2432 
   2433 (defun transient--setup-recursion (prefix-obj)
   2434   (when transient--stack
   2435     (let ((command (oref prefix-obj command)))
   2436       (when-let ((suffix-obj (transient-suffix-object command)))
   2437         (when (and (slot-boundp suffix-obj 'transient)
   2438                    (memq (oref suffix-obj transient)
   2439                          (list t #'transient--do-recurse)))
   2440           (oset prefix-obj transient-suffix 'transient--do-return))))))
   2441 
   2442 (defun transient--do-replace ()
   2443   "Call the transient prefix command, replacing the active transient."
   2444   (transient--export)
   2445   (transient--stack-push)
   2446   (setq transient--exitp 'replace)
   2447   transient--exit)
   2448 
   2449 (defun transient--do-suspend ()
   2450   "Suspend the active transient, saving the transient stack."
   2451   (transient--stack-push)
   2452   (setq transient--exitp 'suspend)
   2453   transient--exit)
   2454 
   2455 (defun transient--do-quit-one ()
   2456   "If active, quit help or edit mode, else exit the active transient."
   2457   (cond (transient--helpp
   2458          (setq transient--helpp nil)
   2459          transient--stay)
   2460         (transient--editp
   2461          (setq transient--editp nil)
   2462          (transient-setup)
   2463          transient--stay)
   2464         (t transient--exit)))
   2465 
   2466 (defun transient--do-quit-all ()
   2467   "Exit all transients without saving the transient stack."
   2468   (transient--stack-zap)
   2469   transient--exit)
   2470 
   2471 (defun transient--do-move ()
   2472   "Call the command if `transient-enable-popup-navigation' is non-nil.
   2473 In that case behave like `transient--do-stay', otherwise similar
   2474 to `transient--do-warn'."
   2475   (unless transient-enable-popup-navigation
   2476     (setq this-command 'transient-popup-navigation-help))
   2477   transient--stay)
   2478 
   2479 (defun transient--do-minus ()
   2480   "Call `negative-argument' or pivot to `transient-update'.
   2481 If `negative-argument' is invoked using \"-\" then preserve the
   2482 prefix argument and pivot to `transient-update'."
   2483   (when (equal (this-command-keys) "-")
   2484     (setq this-command 'transient-update))
   2485   transient--stay)
   2486 
   2487 (put 'transient--do-stay       'transient-color 'transient-red)
   2488 (put 'transient--do-noop       'transient-color 'transient-red)
   2489 (put 'transient--do-warn       'transient-color 'transient-red)
   2490 (put 'transient--do-warn-inapt 'transient-color 'transient-red)
   2491 (put 'transient--do-call       'transient-color 'transient-red)
   2492 (put 'transient--do-return     'transient-color 'transient-purple)
   2493 (put 'transient--do-exit       'transient-color 'transient-blue)
   2494 (put 'transient--do-recurse    'transient-color 'transient-red)
   2495 (put 'transient--do-replace    'transient-color 'transient-blue)
   2496 (put 'transient--do-suspend    'transient-color 'transient-blue)
   2497 (put 'transient--do-quit-one   'transient-color 'transient-blue)
   2498 (put 'transient--do-quit-all   'transient-color 'transient-blue)
   2499 (put 'transient--do-move       'transient-color 'transient-red)
   2500 (put 'transient--do-minus      'transient-color 'transient-red)
   2501 
   2502 ;;; Commands
   2503 
   2504 (defun transient-noop ()
   2505   "Do nothing at all."
   2506   (interactive))
   2507 
   2508 (defun transient-undefined ()
   2509   "Warn the user that the pressed key is not bound to any suffix."
   2510   (interactive)
   2511   (transient--invalid "Unbound suffix"))
   2512 
   2513 (defun transient-inapt ()
   2514   "Warn the user that the invoked command is inapt."
   2515   (interactive)
   2516   (transient--invalid "Inapt command"))
   2517 
   2518 (defun transient--invalid (msg)
   2519   (ding)
   2520   (message "%s: `%s' (Use `%s' to abort, `%s' for help)%s"
   2521            msg
   2522            (propertize (key-description (this-single-command-keys))
   2523                        'face 'font-lock-warning-face)
   2524            (propertize "C-g" 'face 'transient-key)
   2525            (propertize "?"   'face 'transient-key)
   2526            ;; `this-command' is `transient-undefined' or `transient-inapt'.
   2527            ;; Show the command (`this-original-command') the user actually
   2528            ;; tried to invoke.  For an anonymous inapt command that is a
   2529            ;; lambda expression, which cannot be mapped to a symbol, so
   2530            ;; forgo displaying the command.
   2531            (if-let ((cmd (ignore-errors
   2532                            (symbol-name (transient--suffix-symbol
   2533                                          this-original-command)))))
   2534                (format " [%s]" (propertize cmd 'face 'font-lock-warning-face))
   2535              ""))
   2536   (unless (and transient--transient-map
   2537                (memq transient--transient-map overriding-terminal-local-map))
   2538     (let ((transient--prefix (or transient--prefix 'sic)))
   2539       (transient--emergency-exit))
   2540     (view-lossage)
   2541     (other-window 1)
   2542     (display-warning 'transient "Inconsistent transient state detected.
   2543 This should never happen.
   2544 Please open an issue and post the shown command log.
   2545 This is a heisenbug, so any additional details might help.
   2546 Thanks!" :error)))
   2547 
   2548 (defun transient-toggle-common ()
   2549   "Toggle whether common commands are always shown."
   2550   (interactive)
   2551   (setq transient-show-common-commands (not transient-show-common-commands)))
   2552 
   2553 (defun transient-suspend ()
   2554   "Suspend the current transient.
   2555 It can later be resumed using `transient-resume' while no other
   2556 transient is active."
   2557   (interactive))
   2558 
   2559 (defun transient-quit-all ()
   2560   "Exit all transients without saving the transient stack."
   2561   (interactive))
   2562 
   2563 (defun transient-quit-one ()
   2564   "Exit the current transients, possibly returning to the previous."
   2565   (interactive))
   2566 
   2567 (defun transient-quit-seq ()
   2568   "Abort the current incomplete key sequence."
   2569   (interactive))
   2570 
   2571 (defun transient-update ()
   2572   "Redraw the transient's state in the popup buffer."
   2573   (interactive)
   2574   (when (equal this-original-command 'negative-argument)
   2575     (setq prefix-arg current-prefix-arg)))
   2576 
   2577 (defun transient-show ()
   2578   "Show the transient's state in the popup buffer."
   2579   (interactive)
   2580   (setq transient--showp t))
   2581 
   2582 (defvar-local transient--restore-winconf nil)
   2583 
   2584 (defvar transient-resume-mode)
   2585 
   2586 (defun transient-help (&optional interactive)
   2587   "Show help for the active transient or one of its suffixes.\n\n(fn)"
   2588   (interactive (list t))
   2589   (if interactive
   2590       (setq transient--helpp t)
   2591     (with-demoted-errors "transient-help: %S"
   2592       (when (lookup-key transient--transient-map
   2593                         (this-single-command-raw-keys))
   2594         (setq transient--helpp nil)
   2595         (let ((winconf (current-window-configuration)))
   2596           (transient-show-help
   2597            (if (eq this-original-command 'transient-help)
   2598                transient--prefix
   2599              (or (transient-suffix-object)
   2600                  this-original-command)))
   2601           (setq transient--restore-winconf winconf))
   2602         (fit-window-to-buffer nil (frame-height) (window-height))
   2603         (transient-resume-mode)
   2604         (message "Type \"q\" to resume transient command.")
   2605         t))))
   2606 
   2607 (defun transient-set-level (&optional command level)
   2608   "Set the level of the transient or one of its suffix commands."
   2609   (interactive
   2610    (let ((command this-original-command)
   2611          (prefix (oref transient--prefix command)))
   2612      (and (or (not (eq command 'transient-set-level))
   2613               (and transient--editp
   2614                    (setq command prefix)))
   2615           (list command
   2616                 (let ((keys (this-single-command-raw-keys)))
   2617                   (and (lookup-key transient--transient-map keys)
   2618                        (string-to-number
   2619                         (let ((transient--active-infix
   2620                                (transient-suffix-object command)))
   2621                           (transient--show)
   2622                           (transient--read-number-N
   2623                            (format "Set level for `%s': "
   2624                                    (transient--suffix-symbol command))
   2625                            nil nil (not (eq command prefix)))))))))))
   2626   (cond
   2627    ((not command)
   2628     (setq transient--editp t)
   2629     (transient-setup))
   2630    (level
   2631     (let* ((prefix (oref transient--prefix command))
   2632            (alist (alist-get prefix transient-levels))
   2633            (sym (transient--suffix-symbol command)))
   2634       (if (eq command prefix)
   2635           (progn (oset transient--prefix level level)
   2636                  (setq sym t))
   2637         (oset (transient-suffix-object command) level level))
   2638       (setf (alist-get sym alist) level)
   2639       (setf (alist-get prefix transient-levels) alist))
   2640     (transient-save-levels)
   2641     (transient--show))
   2642    (t
   2643     (transient-undefined))))
   2644 
   2645 (defun transient-set ()
   2646   "Save the value of the active transient for this Emacs session."
   2647   (interactive)
   2648   (transient-set-value (or transient--prefix transient-current-prefix)))
   2649 
   2650 (defun transient-save ()
   2651   "Save the value of the active transient persistenly across Emacs sessions."
   2652   (interactive)
   2653   (transient-save-value (or transient--prefix transient-current-prefix)))
   2654 
   2655 (defun transient-reset ()
   2656   "Clear the set and saved values of the active transient."
   2657   (interactive)
   2658   (transient-reset-value (or transient--prefix transient-current-prefix)))
   2659 
   2660 (defun transient-history-next ()
   2661   "Switch to the next value used for the active transient."
   2662   (interactive)
   2663   (let* ((obj transient--prefix)
   2664          (pos (1- (oref obj history-pos)))
   2665          (hst (oref obj history)))
   2666     (if (< pos 0)
   2667         (user-error "End of history")
   2668       (oset obj history-pos pos)
   2669       (oset obj value (nth pos hst))
   2670       (mapc #'transient-init-value transient--suffixes))))
   2671 
   2672 (defun transient-history-prev ()
   2673   "Switch to the previous value used for the active transient."
   2674   (interactive)
   2675   (let* ((obj transient--prefix)
   2676          (pos (1+ (oref obj history-pos)))
   2677          (hst (oref obj history))
   2678          (len (length hst)))
   2679     (if (> pos (1- len))
   2680         (user-error "End of history")
   2681       (oset obj history-pos pos)
   2682       (oset obj value (nth pos hst))
   2683       (mapc #'transient-init-value transient--suffixes))))
   2684 
   2685 (defun transient-scroll-up (&optional arg)
   2686   "Scroll text of transient popup window upward ARG lines.
   2687 If ARG is nil scroll near full screen.  This is a wrapper
   2688 around `scroll-up-command' (which see)."
   2689   (interactive "^P")
   2690   (with-selected-window transient--window
   2691     (scroll-up-command arg)))
   2692 
   2693 (defun transient-scroll-down (&optional arg)
   2694   "Scroll text of transient popup window down ARG lines.
   2695 If ARG is nil scroll near full screen.  This is a wrapper
   2696 around `scroll-down-command' (which see)."
   2697   (interactive "^P")
   2698   (with-selected-window transient--window
   2699     (scroll-down-command arg)))
   2700 
   2701 (defun transient-push-button ()
   2702   "Invoke the suffix command represented by this button."
   2703   (interactive))
   2704 
   2705 (defun transient-resume ()
   2706   "Resume a previously suspended stack of transients."
   2707   (interactive)
   2708   (cond (transient--stack
   2709          (let ((winconf transient--restore-winconf))
   2710            (kill-local-variable 'transient--restore-winconf)
   2711            (when transient-resume-mode
   2712              (transient-resume-mode -1)
   2713              (quit-window))
   2714            (when winconf
   2715              (set-window-configuration winconf)))
   2716          (transient--stack-pop))
   2717         (transient-resume-mode
   2718          (kill-local-variable 'transient--restore-winconf)
   2719          (transient-resume-mode -1)
   2720          (quit-window))
   2721         (t
   2722          (message "No suspended transient command"))))
   2723 
   2724 ;;; Value
   2725 ;;;; Init
   2726 
   2727 (cl-defgeneric transient-init-scope (obj)
   2728   "Set the scope of the suffix object OBJ.
   2729 
   2730 The scope is actually a property of the transient prefix, not of
   2731 individual suffixes.  However it is possible to invoke a suffix
   2732 command directly instead of from a transient.  In that case, if
   2733 the suffix expects a scope, then it has to determine that itself
   2734 and store it in its `scope' slot.
   2735 
   2736 This function is called for all suffix commands, but unless a
   2737 concrete method is implemented this falls through to the default
   2738 implementation, which is a noop.")
   2739 
   2740 (cl-defmethod transient-init-scope ((_   transient-suffix))
   2741   "Noop." nil)
   2742 
   2743 (cl-defgeneric transient-init-value (_)
   2744   "Set the initial value of the object OBJ.
   2745 
   2746 This function is called for all prefix and suffix commands.
   2747 
   2748 For suffix commands (including infix argument commands) the
   2749 default implementation is a noop.  Classes derived from the
   2750 abstract `transient-infix' class must implement this function.
   2751 Non-infix suffix commands usually don't have a value."
   2752   nil)
   2753 
   2754 (cl-defmethod transient-init-value :around ((obj transient-prefix))
   2755   "If bound, then call OBJ's `init-value' function.
   2756 Otherwise call the primary method according to object's class."
   2757   (if (slot-boundp obj 'init-value)
   2758       (funcall (oref obj init-value) obj)
   2759     (cl-call-next-method obj)))
   2760 
   2761 (cl-defmethod transient-init-value :around ((obj transient-infix))
   2762   "If bound, then call OBJ's `init-value' function.
   2763 Otherwise call the primary method according to object's class."
   2764   (if (slot-boundp obj 'init-value)
   2765       (funcall (oref obj init-value) obj)
   2766     (cl-call-next-method obj)))
   2767 
   2768 (cl-defmethod transient-init-value ((obj transient-prefix))
   2769   (if (slot-boundp obj 'value)
   2770       (oref obj value)
   2771     (oset obj value
   2772           (if-let ((saved (assq (oref obj command) transient-values)))
   2773               (cdr saved)
   2774             (transient-default-value obj)))))
   2775 
   2776 (cl-defmethod transient-init-value ((obj transient-argument))
   2777   (oset obj value
   2778         (let ((value (oref transient--prefix value))
   2779               (argument (and (slot-boundp obj 'argument)
   2780                              (oref obj argument)))
   2781               (multi-value (oref obj multi-value))
   2782               (case-fold-search nil)
   2783               (regexp (if (slot-exists-p obj 'argument-regexp)
   2784                           (oref obj argument-regexp)
   2785                         (format "\\`%s\\(.*\\)" (oref obj argument)))))
   2786           (if (memq multi-value '(t rest))
   2787               (cdr (assoc argument value))
   2788             (let ((match (lambda (v)
   2789                            (and (stringp v)
   2790                                 (string-match regexp v)
   2791                                 (match-string 1 v)))))
   2792               (if multi-value
   2793                   (delq nil (mapcar match value))
   2794                 (cl-some match value)))))))
   2795 
   2796 (cl-defmethod transient-init-value ((obj transient-switch))
   2797   (oset obj value
   2798         (car (member (oref obj argument)
   2799                      (oref transient--prefix value)))))
   2800 
   2801 ;;;; Default
   2802 
   2803 (cl-defgeneric transient-default-value (_)
   2804   "Return the default value."
   2805   nil)
   2806 
   2807 (cl-defmethod transient-default-value ((obj transient-prefix))
   2808   (if-let ((default (and (slot-boundp obj 'default-value)
   2809                          (oref obj default-value))))
   2810       (if (functionp default)
   2811           (funcall default)
   2812         default)
   2813     nil))
   2814 
   2815 ;;;; Read
   2816 
   2817 (cl-defgeneric transient-infix-read (obj)
   2818   "Determine the new value of the infix object OBJ.
   2819 
   2820 This function merely determines the value; `transient-infix-set'
   2821 is used to actually store the new value in the object.
   2822 
   2823 For most infix classes this is done by reading a value from the
   2824 user using the reader specified by the `reader' slot (using the
   2825 `transient-infix' method described below).
   2826 
   2827 For some infix classes the value is changed without reading
   2828 anything in the minibuffer, i.e. the mere act of invoking the
   2829 infix command determines what the new value should be, based
   2830 on the previous value.")
   2831 
   2832 (cl-defmethod transient-infix-read :around ((obj transient-infix))
   2833   "Highlight the infix in the popup buffer.
   2834 
   2835 This also wraps the call to `cl-call-next-method' with two
   2836 macros.
   2837 
   2838 `transient--with-suspended-override' is necessary to allow
   2839 reading user input using the minibuffer.
   2840 
   2841 `transient--with-emergency-exit' arranges for the transient to
   2842 be exited in case of an error because otherwise Emacs would get
   2843 stuck in an inconsistent state, which might make it necessary to
   2844 kill it from the outside.
   2845 
   2846 If you replace this method, then you must make sure to always use
   2847 the latter macro and most likely also the former."
   2848   (let ((transient--active-infix obj))
   2849     (transient--show))
   2850   (transient--with-emergency-exit
   2851     (transient--with-suspended-override
   2852      (cl-call-next-method obj))))
   2853 
   2854 (cl-defmethod transient-infix-read ((obj transient-infix))
   2855   "Read a value while taking care of history.
   2856 
   2857 This method is suitable for a wide variety of infix commands,
   2858 including but not limited to inline arguments and variables.
   2859 
   2860 If you do not use this method for your own infix class, then
   2861 you should likely replicate a lot of the behavior of this
   2862 method.  If you fail to do so, then users might not appreciate
   2863 the lack of history, for example.
   2864 
   2865 Only for very simple classes that toggle or cycle through a very
   2866 limited number of possible values should you replace this with a
   2867 simple method that does not handle history.  (E.g. for a command
   2868 line switch the only possible values are \"use it\" and \"don't use
   2869 it\", in which case it is pointless to preserve history.)"
   2870   (with-slots (value multi-value always-read allow-empty choices) obj
   2871     (if (and value
   2872              (not multi-value)
   2873              (not always-read)
   2874              transient--prefix)
   2875         (oset obj value nil)
   2876       (let* ((enable-recursive-minibuffers t)
   2877              (reader (oref obj reader))
   2878              (prompt (transient-prompt obj))
   2879              (value (if multi-value (mapconcat #'identity value ",") value))
   2880              (history-key (or (oref obj history-key)
   2881                               (oref obj command)))
   2882              (transient--history (alist-get history-key transient-history))
   2883              (transient--history (if (or (null value)
   2884                                          (eq value (car transient--history)))
   2885                                      transient--history
   2886                                    (cons value transient--history)))
   2887              (initial-input (and transient-read-with-initial-input
   2888                                  (car transient--history)))
   2889              (history (if initial-input
   2890                           (cons 'transient--history 1)
   2891                         'transient--history))
   2892              (value
   2893               (cond
   2894                (reader (funcall reader prompt initial-input history))
   2895                (multi-value
   2896                 (completing-read-multiple prompt choices nil nil
   2897                                           initial-input history))
   2898                (choices
   2899                 (completing-read prompt choices nil t initial-input history))
   2900                (t (read-string prompt initial-input history)))))
   2901         (cond ((and (equal value "") (not allow-empty))
   2902                (setq value nil))
   2903               ((and (equal value "\"\"") allow-empty)
   2904                (setq value "")))
   2905         (when value
   2906           (when (and (bound-and-true-p ivy-mode)
   2907                      (stringp (car transient--history)))
   2908             (set-text-properties 0 (length (car transient--history)) nil
   2909                                  (car transient--history)))
   2910           (setf (alist-get history-key transient-history)
   2911                 (delete-dups transient--history)))
   2912         value))))
   2913 
   2914 (cl-defmethod transient-infix-read ((obj transient-switch))
   2915   "Toggle the switch on or off."
   2916   (if (oref obj value) nil (oref obj argument)))
   2917 
   2918 (cl-defmethod transient-infix-read ((obj transient-switches))
   2919   "Cycle through the mutually exclusive switches.
   2920 The last value is \"don't use any of these switches\"."
   2921   (let ((choices (mapcar (apply-partially #'format (oref obj argument-format))
   2922                          (oref obj choices))))
   2923     (if-let ((value (oref obj value)))
   2924         (cadr (member value choices))
   2925       (car choices))))
   2926 
   2927 (cl-defmethod transient-infix-read ((command symbol))
   2928   "Elsewhere use the reader of the infix command COMMAND.
   2929 Use this if you want to share an infix's history with a regular
   2930 stand-alone command."
   2931   (cl-letf (((symbol-function #'transient--show) #'ignore))
   2932     (transient-infix-read (get command 'transient--suffix))))
   2933 
   2934 ;;;; Readers
   2935 
   2936 (defun transient-read-file (prompt _initial-input _history)
   2937   "Read a file."
   2938   (file-local-name (expand-file-name (read-file-name prompt))))
   2939 
   2940 (defun transient-read-existing-file (prompt _initial-input _history)
   2941   "Read an existing file."
   2942   (file-local-name (expand-file-name (read-file-name prompt nil nil t))))
   2943 
   2944 (defun transient-read-directory (prompt _initial-input _history)
   2945   "Read a directory."
   2946   (file-local-name (expand-file-name (read-directory-name prompt))))
   2947 
   2948 (defun transient-read-existing-directory (prompt _initial-input _history)
   2949   "Read an existing directory."
   2950   (file-local-name (expand-file-name (read-directory-name prompt nil nil t))))
   2951 
   2952 (defun transient-read-number-N0 (prompt initial-input history)
   2953   "Read a natural number (including zero) and return it as a string."
   2954   (transient--read-number-N prompt initial-input history t))
   2955 
   2956 (defun transient-read-number-N+ (prompt initial-input history)
   2957   "Read a natural number (excluding zero) and return it as a string."
   2958   (transient--read-number-N prompt initial-input history nil))
   2959 
   2960 (defun transient--read-number-N (prompt initial-input history include-zero)
   2961   (save-match-data
   2962     (cl-block nil
   2963       (while t
   2964         (let ((str (read-from-minibuffer prompt initial-input nil nil history)))
   2965           (when (or (string-equal str "")
   2966                     (string-match-p (if include-zero
   2967                                         "\\`\\(0\\|[1-9][0-9]*\\)\\'"
   2968                                       "\\`[1-9][0-9]*\\'")
   2969                                     str))
   2970             (cl-return str)))
   2971         (message "Please enter a natural number (%s zero)."
   2972                  (if include-zero "including" "excluding"))
   2973         (sit-for 1)))))
   2974 
   2975 (defun transient-read-date (prompt default-time _history)
   2976   "Read a date using `org-read-date' (which see)."
   2977   (require 'org)
   2978   (when (fboundp 'org-read-date)
   2979     (org-read-date 'with-time nil nil prompt default-time)))
   2980 
   2981 ;;;; Prompt
   2982 
   2983 (cl-defgeneric transient-prompt (obj)
   2984   "Return the prompt to be used to read infix object OBJ's value.")
   2985 
   2986 (cl-defmethod transient-prompt ((obj transient-infix))
   2987   "Return the prompt to be used to read infix object OBJ's value.
   2988 
   2989 This implementation should be suitable for almost all infix
   2990 commands.
   2991 
   2992 If the value of OBJ's `prompt' slot is non-nil, then it must be
   2993 a string or a function.  If it is a string, then use that.  If
   2994 it is a function, then call that with OBJ as the only argument.
   2995 That function must return a string, which is then used as the
   2996 prompt.
   2997 
   2998 Otherwise, if the value of either the `argument' or `variable'
   2999 slot of OBJ is a string, then base the prompt on that (preferring
   3000 the former), appending either \"=\" (if it appears to be a
   3001 command-line option) or \": \".
   3002 
   3003 Finally fall through to using \"(BUG: no prompt): \" as the
   3004 prompt."
   3005   (if-let ((prompt (oref obj prompt)))
   3006       (let ((prompt (if (functionp prompt)
   3007                         (funcall prompt obj)
   3008                       prompt)))
   3009         (if (stringp prompt)
   3010             prompt
   3011           "(BUG: no prompt): "))
   3012     (or (and-let* ((arg (and (slot-boundp obj 'argument) (oref obj argument))))
   3013           (if (and (stringp arg) (string-suffix-p "=" arg))
   3014               arg
   3015             (concat arg ": ")))
   3016         (and-let* ((var (and (slot-boundp obj 'variable) (oref obj variable))))
   3017           (and (stringp var)
   3018                (concat var ": ")))
   3019         "(BUG: no prompt): ")))
   3020 
   3021 ;;;; Set
   3022 
   3023 (defvar transient--unset-incompatible t)
   3024 
   3025 (cl-defgeneric transient-infix-set (obj value)
   3026   "Set the value of infix object OBJ to value.")
   3027 
   3028 (cl-defmethod transient-infix-set ((obj transient-infix) value)
   3029   "Set the value of infix object OBJ to value."
   3030   (oset obj value value))
   3031 
   3032 (cl-defmethod transient-infix-set :around ((obj transient-argument) value)
   3033   "Unset incompatible infix arguments."
   3034   (let ((arg (if (slot-boundp obj 'argument)
   3035                  (oref obj argument)
   3036                (oref obj argument-regexp))))
   3037     (if-let ((sic (and value arg transient--unset-incompatible))
   3038              (spec (oref transient--prefix incompatible))
   3039              (incomp (cl-mapcan (lambda (rule)
   3040                                   (and (member arg rule)
   3041                                        (remove arg rule)))
   3042                                 spec)))
   3043         (progn
   3044           (cl-call-next-method obj value)
   3045           (dolist (arg incomp)
   3046             (when-let ((obj (cl-find-if (lambda (obj)
   3047                                           (and (slot-boundp obj 'argument)
   3048                                                (equal (oref obj argument) arg)))
   3049                                         transient--suffixes)))
   3050               (let ((transient--unset-incompatible nil))
   3051                 (transient-infix-set obj nil)))))
   3052       (cl-call-next-method obj value))))
   3053 
   3054 (cl-defgeneric transient-set-value (obj)
   3055   "Set the value of the transient prefix OBJ.")
   3056 
   3057 (cl-defmethod transient-set-value ((obj transient-prefix))
   3058   (oset (oref obj prototype) value (transient-get-value))
   3059   (transient--history-push obj))
   3060 
   3061 ;;;; Save
   3062 
   3063 (cl-defgeneric transient-save-value (obj)
   3064   "Save the value of the transient prefix OBJ.")
   3065 
   3066 (cl-defmethod transient-save-value ((obj transient-prefix))
   3067   (let ((value (transient-get-value)))
   3068     (oset (oref obj prototype) value value)
   3069     (setf (alist-get (oref obj command) transient-values) value)
   3070     (transient-save-values))
   3071   (transient--history-push obj))
   3072 
   3073 ;;;; Reset
   3074 
   3075 (cl-defgeneric transient-reset-value (obj)
   3076   "Clear the set and saved values of the transient prefix OBJ.")
   3077 
   3078 (cl-defmethod transient-reset-value ((obj transient-prefix))
   3079   (let ((value (transient-default-value obj)))
   3080     (oset obj value value)
   3081     (oset (oref obj prototype) value value)
   3082     (setf (alist-get (oref obj command) transient-values nil 'remove) nil)
   3083     (transient-save-values))
   3084   (transient--history-push obj)
   3085   (mapc #'transient-init-value transient--suffixes))
   3086 
   3087 ;;;; Get
   3088 
   3089 (defun transient-args (prefix)
   3090   "Return the value of the transient prefix command PREFIX.
   3091 If the current command was invoked from the transient prefix
   3092 command PREFIX, then return the active infix arguments.  If
   3093 the current command was not invoked from PREFIX, then return
   3094 the set, saved or default value for PREFIX."
   3095   (cl-mapcan #'transient--get-wrapped-value (transient-suffixes prefix)))
   3096 
   3097 (defun transient-suffixes (prefix)
   3098   "Return the suffix objects of the transient prefix command PREFIX."
   3099   (if (eq transient-current-command prefix)
   3100       transient-current-suffixes
   3101     (let ((transient--prefix (transient--init-prefix prefix)))
   3102       (transient--flatten-suffixes
   3103        (transient--init-suffixes prefix)))))
   3104 
   3105 (defun transient-get-value ()
   3106   (transient--with-emergency-exit
   3107     (cl-mapcan (lambda (obj)
   3108                  (and (or (not (slot-exists-p obj 'unsavable))
   3109                           (not (oref obj unsavable)))
   3110                       (transient--get-wrapped-value obj)))
   3111                transient-current-suffixes)))
   3112 
   3113 (defun transient--get-wrapped-value (obj)
   3114   (and-let* ((value (transient-infix-value obj)))
   3115     (cl-ecase (and (slot-exists-p obj 'multi-value)
   3116                    (oref obj multi-value))
   3117       ((nil)    (list value))
   3118       ((t rest) (list value))
   3119       (repeat   value))))
   3120 
   3121 (cl-defgeneric transient-infix-value (obj)
   3122   "Return the value of the suffix object OBJ.
   3123 
   3124 This function is called by `transient-args' (which see), meaning
   3125 this function is how the value of a transient is determined so
   3126 that the invoked suffix command can use it.
   3127 
   3128 Currently most values are strings, but that is not set in stone.
   3129 Nil is not a value, it means \"no value\".
   3130 
   3131 Usually only infixes have a value, but see the method for
   3132 `transient-suffix'.")
   3133 
   3134 (cl-defmethod transient-infix-value ((_   transient-suffix))
   3135   "Return nil, which means \"no value\".
   3136 
   3137 Infix arguments contribute the transient's value while suffix
   3138 commands consume it.  This function is called for suffixes anyway
   3139 because a command that both contributes to the transient's value
   3140 and also consumes it is not completely unconceivable.
   3141 
   3142 If you define such a command, then you must define a derived
   3143 class and implement this function because this default method
   3144 does nothing." nil)
   3145 
   3146 (cl-defmethod transient-infix-value ((obj transient-infix))
   3147   "Return the value of OBJ's `value' slot."
   3148   (oref obj value))
   3149 
   3150 (cl-defmethod transient-infix-value ((obj transient-option))
   3151   "Return ARGUMENT and VALUE as a unit or nil if the latter is nil."
   3152   (and-let* ((value (oref obj value)))
   3153     (let ((arg (oref obj argument)))
   3154       (cl-ecase (oref obj multi-value)
   3155         ((nil)    (concat arg value))
   3156         ((t rest) (cons arg value))
   3157         (repeat   (mapcar (lambda (v) (concat arg v)) value))))))
   3158 
   3159 (cl-defmethod transient-infix-value ((_   transient-variable))
   3160   "Return nil, which means \"no value\".
   3161 
   3162 Setting the value of a variable is done by, well, setting the
   3163 value of the variable.  I.e. this is a side-effect and does not
   3164 contribute to the value of the transient."
   3165   nil)
   3166 
   3167 ;;;; Utilities
   3168 
   3169 (defun transient-arg-value (arg args)
   3170   "Return the value of ARG as it appears in ARGS.
   3171 
   3172 For a switch return a boolean.  For an option return the value as
   3173 a string, using the empty string for the empty value, or nil if
   3174 the option does not appear in ARGS."
   3175   (if (string-suffix-p "=" arg)
   3176       (save-match-data
   3177         (and-let* ((match (let ((case-fold-search nil)
   3178                                 (re (format "\\`%s\\(?:=\\(.+\\)\\)?\\'"
   3179                                             (substring arg 0 -1))))
   3180                             (cl-find-if (lambda (a)
   3181                                           (and (stringp a)
   3182                                                (string-match re a)))
   3183                                         args))))
   3184           (or (match-string 1 match) "")))
   3185     (and (member arg args) t)))
   3186 
   3187 ;;; History
   3188 
   3189 (cl-defgeneric transient--history-key (obj)
   3190   "Return OBJ's history key.
   3191 If the value of the `history-key' slot is non-nil, then return
   3192 that.  Otherwise return the value of the `command' slot."
   3193   (or (oref obj history-key)
   3194       (oref obj command)))
   3195 
   3196 (cl-defgeneric transient--history-push (obj)
   3197   "Push the current value of OBJ to its entry in `transient-history'."
   3198   (let ((key (transient--history-key obj)))
   3199     (setf (alist-get key transient-history)
   3200           (let ((args (transient-get-value)))
   3201             (cons args (delete args (alist-get key transient-history)))))))
   3202 
   3203 (cl-defgeneric transient--history-init (obj)
   3204   "Initialize OBJ's `history' slot.
   3205 This is the transient-wide history; many individual infixes also
   3206 have a history of their own.")
   3207 
   3208 (cl-defmethod transient--history-init ((obj transient-prefix))
   3209   "Initialize OBJ's `history' slot from the variable `transient-history'."
   3210   (let ((val (oref obj value)))
   3211     (oset obj history
   3212           (cons val (delete val (alist-get (transient--history-key obj)
   3213                                            transient-history))))))
   3214 
   3215 ;;; Draw
   3216 
   3217 (defun transient--show-brief ()
   3218   (let ((message-log-max nil))
   3219     (if (and transient-show-popup (<= transient-show-popup 0))
   3220         (message "%s-" (key-description (this-command-keys)))
   3221       (message
   3222        "%s- [%s] %s"
   3223        (key-description (this-command-keys))
   3224        (oref transient--prefix command)
   3225        (mapconcat
   3226         #'identity
   3227         (sort
   3228          (cl-mapcan
   3229           (lambda (suffix)
   3230             (let ((key (kbd (oref suffix key))))
   3231               ;; Don't list any common commands.
   3232               (and (not (memq (oref suffix command)
   3233                               `(,(lookup-key transient-map key)
   3234                                 ,(lookup-key transient-sticky-map key)
   3235                                 ;; From transient-common-commands:
   3236                                 transient-set
   3237                                 transient-save
   3238                                 transient-history-prev
   3239                                 transient-history-next
   3240                                 transient-quit-one
   3241                                 transient-toggle-common
   3242                                 transient-set-level)))
   3243                    (list (propertize (oref suffix key) 'face 'transient-key)))))
   3244           transient--suffixes)
   3245          #'string<)
   3246         (propertize "|" 'face 'transient-unreachable-key))))))
   3247 
   3248 (defun transient--show ()
   3249   (transient--timer-cancel)
   3250   (setq transient--showp t)
   3251   (let ((buf (get-buffer-create transient--buffer-name))
   3252         (focus nil))
   3253     (with-current-buffer buf
   3254       (when transient-enable-popup-navigation
   3255         (setq focus (or (button-get (point) 'command)
   3256                         (transient--heading-at-point))))
   3257       (erase-buffer)
   3258       (setq window-size-fixed t)
   3259       (when (bound-and-true-p tab-line-format)
   3260         (setq tab-line-format nil))
   3261       (setq header-line-format nil)
   3262       (setq mode-line-format (if (eq transient-mode-line-format 'line)
   3263                                  nil
   3264                                transient-mode-line-format))
   3265       (setq mode-line-buffer-identification
   3266             (symbol-name (oref transient--prefix command)))
   3267       (if transient-enable-popup-navigation
   3268           (setq-local cursor-in-non-selected-windows 'box)
   3269         (setq cursor-type nil))
   3270       (setq display-line-numbers nil)
   3271       (setq show-trailing-whitespace nil)
   3272       (transient--insert-groups)
   3273       (when (or transient--helpp transient--editp)
   3274         (transient--insert-help))
   3275       (when (and (eq transient-mode-line-format 'line)
   3276                  window-system)
   3277         (let ((face
   3278                (if-let ((f (and (transient--semantic-coloring-p)
   3279                                 (transient--prefix-color transient--prefix))))
   3280                    `(,@(and (>= emacs-major-version 27) '(:extend t))
   3281                      :background ,(face-foreground f))
   3282                  'transient-separator)))
   3283           (insert (propertize "__" 'face face 'display '(space :height (1))))
   3284           (insert (propertize "\n" 'face face 'line-height t))))
   3285       (when transient-force-fixed-pitch
   3286         (transient--force-fixed-pitch)))
   3287     (unless (window-live-p transient--window)
   3288       (setq transient--window
   3289             (display-buffer buf transient-display-buffer-action)))
   3290     (when (window-live-p transient--window)
   3291       (with-selected-window transient--window
   3292         (goto-char (point-min))
   3293         (when transient-enable-popup-navigation
   3294           (transient--goto-button focus))
   3295         (transient--fit-window-to-buffer transient--window)))))
   3296 
   3297 (defun transient--fit-window-to-buffer (window)
   3298   (let ((window-resize-pixelwise t)
   3299         (window-size-fixed nil))
   3300     (if (eq (car (window-parameter window 'quit-restore)) 'other)
   3301         ;; Grow but never shrink window that previously displayed
   3302         ;; another buffer and is going to display that again.
   3303         (fit-window-to-buffer window nil (window-height window))
   3304       (fit-window-to-buffer window nil 1))))
   3305 
   3306 (defun transient--insert-groups ()
   3307   (let ((groups (cl-mapcan (lambda (group)
   3308                              (let ((hide (oref group hide)))
   3309                                (and (not (and (functionp hide)
   3310                                               (funcall   hide)))
   3311                                     (list group))))
   3312                            transient--layout))
   3313         group)
   3314     (while (setq group (pop groups))
   3315       (transient--insert-group group)
   3316       (when groups
   3317         (insert ?\n)))))
   3318 
   3319 (defvar transient--max-group-level 1)
   3320 
   3321 (cl-defgeneric transient--insert-group (group)
   3322   "Format GROUP and its elements and insert the result.")
   3323 
   3324 (cl-defmethod transient--insert-group :around ((group transient-group))
   3325   "Insert GROUP's description, if any."
   3326   (when-let ((desc (transient-format-description group)))
   3327     (insert desc ?\n))
   3328   (let ((transient--max-group-level
   3329          (max (oref group level) transient--max-group-level)))
   3330     (cl-call-next-method group)))
   3331 
   3332 (cl-defmethod transient--insert-group ((group transient-row))
   3333   (transient--maybe-pad-keys group)
   3334   (dolist (suffix (oref group suffixes))
   3335     (insert (transient-format suffix))
   3336     (insert "   "))
   3337   (insert ?\n))
   3338 
   3339 (cl-defmethod transient--insert-group ((group transient-column))
   3340   (transient--maybe-pad-keys group)
   3341   (dolist (suffix (oref group suffixes))
   3342     (let ((str (transient-format suffix)))
   3343       (insert str)
   3344       (unless (string-match-p ".\n\\'" str)
   3345         (insert ?\n)))))
   3346 
   3347 (cl-defmethod transient--insert-group ((group transient-columns))
   3348   (let* ((columns
   3349           (mapcar
   3350            (lambda (column)
   3351              (transient--maybe-pad-keys column group)
   3352              (let ((rows (mapcar #'transient-format (oref column suffixes))))
   3353                (when-let ((desc (transient-format-description column)))
   3354                  (push desc rows))
   3355                (flatten-tree rows)))
   3356            (oref group suffixes)))
   3357          (vp (or (oref transient--prefix variable-pitch)
   3358                  transient-align-variable-pitch))
   3359          (rs (apply #'max (mapcar #'length columns)))
   3360          (cs (length columns))
   3361          (cw (mapcar (lambda (col)
   3362                        (apply #'max
   3363                               (mapcar (if vp #'transient--pixel-width #'length)
   3364                                       col)))
   3365                      columns))
   3366          (cc (transient--seq-reductions-from
   3367               (apply-partially #'+ (* 3 (if vp (transient--pixel-width " ") 1)))
   3368               cw 0)))
   3369     (if transient-force-single-column
   3370         (dotimes (c cs)
   3371           (dotimes (r rs)
   3372             (when-let ((cell (nth r (nth c columns))))
   3373               (unless (equal cell "")
   3374                 (insert cell ?\n))))
   3375           (unless (= c (1- cs))
   3376             (insert ?\n)))
   3377       (dotimes (r rs)
   3378         (dotimes (c cs)
   3379           (if vp
   3380               (progn
   3381                 (when-let ((cell (nth r (nth c columns))))
   3382                   (insert cell))
   3383                 (if (= c (1- cs))
   3384                     (insert ?\n)
   3385                   (insert (propertize " " 'display
   3386                                       `(space :align-to (,(nth (1+ c) cc)))))))
   3387             (insert (make-string (max 1 (- (nth c cc) (current-column))) ?\s))
   3388             (when-let ((cell (nth r (nth c columns))))
   3389               (insert cell))
   3390             (when (= c (1- cs))
   3391               (insert ?\n))))))))
   3392 
   3393 (defun transient--pixel-width (string)
   3394   (save-window-excursion
   3395     (with-temp-buffer
   3396       (insert string)
   3397       (set-window-dedicated-p nil nil)
   3398       (set-window-buffer nil (current-buffer))
   3399       (car (window-text-pixel-size
   3400             nil (line-beginning-position) (point))))))
   3401 
   3402 (cl-defmethod transient--insert-group ((group transient-subgroups))
   3403   (let* ((subgroups (oref group suffixes))
   3404          (n (length subgroups)))
   3405     (dotimes (s n)
   3406       (let ((subgroup (nth s subgroups)))
   3407         (transient--maybe-pad-keys subgroup group)
   3408         (transient--insert-group subgroup)
   3409         (when (< s (1- n))
   3410           (insert ?\n))))))
   3411 
   3412 (cl-defgeneric transient-format (obj)
   3413   "Format and return OBJ for display.
   3414 
   3415 When this function is called, then the current buffer is some
   3416 temporary buffer.  If you need the buffer from which the prefix
   3417 command was invoked to be current, then do so by temporarily
   3418 making `transient--original-buffer' current.")
   3419 
   3420 (cl-defmethod transient-format ((arg string))
   3421   "Return the string ARG after applying the `transient-heading' face."
   3422   (propertize arg 'face 'transient-heading))
   3423 
   3424 (cl-defmethod transient-format ((_   null))
   3425   "Return a string containing just the newline character."
   3426   "\n")
   3427 
   3428 (cl-defmethod transient-format ((arg integer))
   3429   "Return a string containing just the ARG character."
   3430   (char-to-string arg))
   3431 
   3432 (cl-defmethod transient-format :around ((obj transient-infix))
   3433   "When reading user input for this infix, then highlight it."
   3434   (let ((str (cl-call-next-method obj)))
   3435     (when (eq obj transient--active-infix)
   3436       (setq str (concat str "\n"))
   3437       (add-face-text-property
   3438        (if (eq this-command 'transient-set-level) 3 0)
   3439        (length str)
   3440        'transient-active-infix nil str))
   3441     str))
   3442 
   3443 (cl-defmethod transient-format :around ((obj transient-suffix))
   3444   "When edit-mode is enabled, then prepend the level information.
   3445 Optional support for popup buttons is also implemented here."
   3446   (let ((str (concat
   3447               (and transient--editp
   3448                    (let ((level (oref obj level)))
   3449                      (propertize (format " %s " level)
   3450                                  'face (if (transient--use-level-p level t)
   3451                                            'transient-enabled-suffix
   3452                                          'transient-disabled-suffix))))
   3453               (cl-call-next-method obj))))
   3454     (when (oref obj inapt)
   3455       (add-face-text-property 0 (length str) 'transient-inapt-suffix nil str))
   3456     (if transient-enable-popup-navigation
   3457         (make-text-button str nil
   3458                           'type 'transient
   3459                           'command (transient--suffix-command obj))
   3460       str)))
   3461 
   3462 (cl-defmethod transient-format ((obj transient-infix))
   3463   "Return a string generated using OBJ's `format'.
   3464 %k is formatted using `transient-format-key'.
   3465 %d is formatted using `transient-format-description'.
   3466 %v is formatted using `transient-format-value'."
   3467   (format-spec (oref obj format)
   3468                `((?k . ,(transient-format-key obj))
   3469                  (?d . ,(transient-format-description obj))
   3470                  (?v . ,(transient-format-value obj)))))
   3471 
   3472 (cl-defmethod transient-format ((obj transient-suffix))
   3473   "Return a string generated using OBJ's `format'.
   3474 %k is formatted using `transient-format-key'.
   3475 %d is formatted using `transient-format-description'."
   3476   (format-spec (oref obj format)
   3477                `((?k . ,(transient-format-key obj))
   3478                  (?d . ,(transient-format-description obj)))))
   3479 
   3480 (cl-defgeneric transient-format-key (obj)
   3481   "Format OBJ's `key' for display and return the result.")
   3482 
   3483 (cl-defmethod transient-format-key ((obj transient-suffix))
   3484   "Format OBJ's `key' for display and return the result."
   3485   (let ((key (oref obj key))
   3486         (cmd (oref obj command)))
   3487     (if transient--redisplay-key
   3488         (let ((len (length transient--redisplay-key))
   3489               (seq (cl-coerce (edmacro-parse-keys key t) 'list)))
   3490           (cond
   3491            ((member (seq-take seq len)
   3492                     (list transient--redisplay-key
   3493                           (thread-last transient--redisplay-key
   3494                             (cl-substitute ?- 'kp-subtract)
   3495                             (cl-substitute ?= 'kp-equal)
   3496                             (cl-substitute ?+ 'kp-add))))
   3497             (let ((pre (key-description (vconcat (seq-take seq len))))
   3498                   (suf (key-description (vconcat (seq-drop seq len)))))
   3499               (setq pre (string-replace "RET" "C-m" pre))
   3500               (setq pre (string-replace "TAB" "C-i" pre))
   3501               (setq suf (string-replace "RET" "C-m" suf))
   3502               (setq suf (string-replace "TAB" "C-i" suf))
   3503               ;; We use e.g. "-k" instead of the more correct "- k",
   3504               ;; because the former is prettier.  If we did that in
   3505               ;; the definition, then we want to drop the space that
   3506               ;; is reinserted above.  False-positives are possible
   3507               ;; for silly bindings like "-C-c C-c".
   3508               (unless (string-search " " key)
   3509                 (setq pre (string-replace " " "" pre))
   3510                 (setq suf (string-replace " " "" suf)))
   3511               (concat (propertize pre 'face 'transient-unreachable-key)
   3512                       (and (string-prefix-p (concat pre " ") key) " ")
   3513                       (transient--colorize-key suf cmd)
   3514                       (save-excursion
   3515                         (and (string-match " +\\'" key)
   3516                              (propertize (match-string 0 key)
   3517                                          'face 'fixed-pitch))))))
   3518            ((transient--lookup-key transient-sticky-map (kbd key))
   3519             (transient--colorize-key key cmd))
   3520            (t
   3521             (propertize key 'face 'transient-unreachable-key))))
   3522       (transient--colorize-key key cmd))))
   3523 
   3524 (defun transient--colorize-key (key command)
   3525   (propertize key 'face
   3526               (or (and (transient--semantic-coloring-p)
   3527                        (transient--suffix-color command))
   3528                   'transient-key)))
   3529 
   3530 (cl-defmethod transient-format-key :around ((obj transient-argument))
   3531   (let ((key (cl-call-next-method obj)))
   3532     (cond ((not transient-highlight-mismatched-keys))
   3533           ((not (slot-boundp obj 'shortarg))
   3534            (add-face-text-property
   3535             0 (length key) 'transient-nonstandard-key nil key))
   3536           ((not (string-equal key (oref obj shortarg)))
   3537            (add-face-text-property
   3538             0 (length key) 'transient-mismatched-key nil key)))
   3539     key))
   3540 
   3541 (cl-defgeneric transient-format-description (obj)
   3542   "Format OBJ's `description' for display and return the result.")
   3543 
   3544 (cl-defmethod transient-format-description ((obj transient-child))
   3545   "The `description' slot may be a function, in which case that is
   3546 called inside the correct buffer (see `transient--insert-group')
   3547 and its value is returned to the caller."
   3548   (and-let* ((desc (oref obj description)))
   3549     (if (functionp desc)
   3550         (with-current-buffer transient--original-buffer
   3551           (funcall desc))
   3552       desc)))
   3553 
   3554 (cl-defmethod transient-format-description ((obj transient-group))
   3555   "Format the description by calling the next method.  If the result
   3556 doesn't use the `face' property at all, then apply the face
   3557 `transient-heading' to the complete string."
   3558   (and-let* ((desc (cl-call-next-method obj)))
   3559     (if (text-property-not-all 0 (length desc) 'face nil desc)
   3560         desc
   3561       (propertize desc 'face 'transient-heading))))
   3562 
   3563 (cl-defmethod transient-format-description :around ((obj transient-suffix))
   3564   "Format the description by calling the next method.  If the result
   3565 is nil, then use \"(BUG: no description)\" as the description.
   3566 If the OBJ's `key' is currently unreachable, then apply the face
   3567 `transient-unreachable' to the complete string."
   3568   (let ((desc (or (cl-call-next-method obj)
   3569                   (and (slot-boundp transient--prefix 'suffix-description)
   3570                        (funcall (oref transient--prefix suffix-description)
   3571                                 obj))
   3572                   (propertize "(BUG: no description)" 'face 'error))))
   3573     (cond ((transient--key-unreachable-p obj)
   3574            (propertize desc 'face 'transient-unreachable))
   3575           ((and transient-highlight-higher-levels
   3576                 (> (max (oref obj level) transient--max-group-level)
   3577                    transient--default-prefix-level))
   3578            (add-face-text-property
   3579             0 (length desc) 'transient-higher-level nil desc)
   3580            desc)
   3581           (t
   3582            desc))))
   3583 
   3584 (cl-defgeneric transient-format-value (obj)
   3585   "Format OBJ's value for display and return the result.")
   3586 
   3587 (cl-defmethod transient-format-value ((obj transient-suffix))
   3588   (propertize (oref obj argument)
   3589               'face (if (oref obj value)
   3590                         'transient-argument
   3591                       'transient-inactive-argument)))
   3592 
   3593 (cl-defmethod transient-format-value ((obj transient-option))
   3594   (let ((argument (oref obj argument)))
   3595     (if-let ((value (oref obj value)))
   3596         (propertize
   3597          (cl-ecase (oref obj multi-value)
   3598            ((nil)    (concat argument value))
   3599            ((t rest) (concat argument
   3600                              (and (not (string-suffix-p " " argument)) " ")
   3601                              (mapconcat #'prin1-to-string value " ")))
   3602            (repeat   (mapconcat (lambda (v) (concat argument v)) value " ")))
   3603          'face 'transient-value)
   3604       (propertize argument 'face 'transient-inactive-value))))
   3605 
   3606 (cl-defmethod transient-format-value ((obj transient-switches))
   3607   (with-slots (value argument-format choices) obj
   3608     (format (propertize argument-format
   3609                         'face (if value
   3610                                   'transient-value
   3611                                 'transient-inactive-value))
   3612             (concat
   3613              (propertize "[" 'face 'transient-inactive-value)
   3614              (mapconcat
   3615               (lambda (choice)
   3616                 (propertize choice 'face
   3617                             (if (equal (format argument-format choice) value)
   3618                                 'transient-value
   3619                               'transient-inactive-value)))
   3620               choices
   3621               (propertize "|" 'face 'transient-inactive-value))
   3622              (propertize "]" 'face 'transient-inactive-value)))))
   3623 
   3624 (defun transient--key-unreachable-p (obj)
   3625   (and transient--redisplay-key
   3626        (let ((key (oref obj key)))
   3627          (not (or (equal (seq-take (cl-coerce (edmacro-parse-keys key t) 'list)
   3628                                    (length transient--redisplay-key))
   3629                          transient--redisplay-key)
   3630                   (transient--lookup-key transient-sticky-map (kbd key)))))))
   3631 
   3632 (defun transient--lookup-key (keymap key)
   3633   (let ((val (lookup-key keymap key)))
   3634     (and val (not (integerp val)) val)))
   3635 
   3636 (defun transient--maybe-pad-keys (group &optional parent)
   3637   (when-let ((pad (if (slot-boundp group 'pad-keys)
   3638                       (oref group pad-keys)
   3639                     (and parent
   3640                          (slot-boundp parent 'pad-keys)
   3641                          (oref parent pad-keys)))))
   3642     (let ((width (apply #'max
   3643                         (cons (if (integerp pad) pad 0)
   3644                               (mapcar (lambda (suffix)
   3645                                         (length (oref suffix key)))
   3646                                       (oref group suffixes))))))
   3647       (dolist (suffix (oref group suffixes))
   3648         (oset suffix key
   3649               (truncate-string-to-width (oref suffix key) width nil ?\s))))))
   3650 
   3651 (defun transient-command-summary-or-name (obj)
   3652   "Return the summary or name of the command represented by OBJ.
   3653 
   3654 If the command has a doc-string, then return the first line of
   3655 that, else its name.
   3656 
   3657 Intended to be temporarily used as the `:suffix-description' of
   3658 a prefix command, while porting a regular keymap to a transient."
   3659   (let ((command (transient--suffix-symbol (oref obj command))))
   3660     (if-let ((doc (documentation command)))
   3661         (propertize (car (split-string doc "\n")) 'face 'font-lock-doc-face)
   3662       (propertize (symbol-name command) 'face 'font-lock-function-name-face))))
   3663 
   3664 ;;; Help
   3665 
   3666 (cl-defgeneric transient-show-help (obj)
   3667   "Show documentation for the command represented by OBJ.")
   3668 
   3669 (cl-defmethod transient-show-help ((obj transient-prefix))
   3670   "Call `show-help' if non-nil, else show `info-manual',
   3671 if non-nil, else show the `man-page' if non-nil, else use
   3672 `describe-function'."
   3673   (with-slots (show-help info-manual man-page command) obj
   3674     (cond (show-help (funcall show-help obj))
   3675           (info-manual (transient--show-manual info-manual))
   3676           (man-page (transient--show-manpage man-page))
   3677           (t (transient--describe-function command)))))
   3678 
   3679 (cl-defmethod transient-show-help ((obj transient-suffix))
   3680   "Call `show-help' if non-nil, else use `describe-function'.
   3681 Also used to dispatch showing documentation for the current
   3682 prefix.  If the suffix is a sub-prefix, then also call the
   3683 prefix method."
   3684   (cond
   3685    ((eq this-command 'transient-help)
   3686     (transient-show-help transient--prefix))
   3687    ((let ((prefix (get (transient--suffix-command obj)
   3688                        'transient--prefix)))
   3689       (and prefix (not (eq (oref transient--prefix command) this-command))
   3690            (prog1 t (transient-show-help prefix)))))
   3691    (t (if-let ((show-help (oref obj show-help)))
   3692           (funcall show-help obj)
   3693         (transient--describe-function this-command)))))
   3694 
   3695 (cl-defmethod transient-show-help ((obj transient-infix))
   3696   "Call `show-help' if non-nil, else show the `man-page'
   3697 if non-nil, else use `describe-function'.  When showing the
   3698 manpage, then try to jump to the correct location."
   3699   (if-let ((show-help (oref obj show-help)))
   3700       (funcall show-help obj)
   3701     (if-let ((man-page (oref transient--prefix man-page))
   3702              (argument (and (slot-boundp obj 'argument)
   3703                             (oref obj argument))))
   3704         (transient--show-manpage man-page argument)
   3705       (transient--describe-function this-command))))
   3706 
   3707 ;; `cl-generic-generalizers' doesn't support `command' et al.
   3708 (cl-defmethod transient-show-help (cmd)
   3709   "Show the command doc-string."
   3710   (transient--describe-function cmd))
   3711 
   3712 (defun transient--describe-function (fn)
   3713   (describe-function (if (symbolp fn) fn 'transient--anonymous-infix-argument))
   3714   (unless (derived-mode-p 'help-mode)
   3715     (when-let* ((buf (get-buffer "*Help*"))
   3716                 (win (or (and buf (get-buffer-window buf))
   3717                          (cl-find-if (lambda (win)
   3718                                        (with-current-buffer (window-buffer win)
   3719                                          (derived-mode-p 'help-mode)))
   3720                                      (window-list)))))
   3721       (select-window win))))
   3722 
   3723 (defun transient--anonymous-infix-argument ()
   3724   "Cannot show any documentation for this anonymous infix command.
   3725 
   3726 The infix command in question was defined anonymously, i.e.,
   3727 it was define when the prefix command that it belongs to was
   3728 defined, which means that it gets no docstring and also that
   3729 no symbol is bound to it.
   3730 
   3731 When you request help for an infix command, then we usually
   3732 show the respective man-page and jump to the location where
   3733 the respective argument is being described.
   3734 
   3735 Because the containing prefix command does not specify any
   3736 man-page, we cannot do that in this case.  Sorry about that.")
   3737 
   3738 (defun transient--show-manual (manual)
   3739   (info manual))
   3740 
   3741 (defun transient--show-manpage (manpage &optional argument)
   3742   (require 'man)
   3743   (let* ((Man-notify-method 'meek)
   3744          (buf (Man-getpage-in-background manpage))
   3745          (proc (get-buffer-process buf)))
   3746     (while (and proc (eq (process-status proc) 'run))
   3747       (accept-process-output proc))
   3748     (switch-to-buffer buf)
   3749     (when argument
   3750       (transient--goto-argument-description argument))))
   3751 
   3752 (defun transient--goto-argument-description (arg)
   3753   (goto-char (point-min))
   3754   (let ((case-fold-search nil)
   3755         ;; This matches preceding/proceeding options.  Options
   3756         ;; such as "-a", "-S[<keyid>]", and "--grep=<pattern>"
   3757         ;; are matched by this regex without the shy group.
   3758         ;; The ". " in the shy group is for options such as
   3759         ;; "-m parent-number", and the "-[^[:space:]]+ " is
   3760         ;; for options such as "--mainline parent-number"
   3761         (others "-\\(?:. \\|-[^[:space:]]+ \\)?[^[:space:]]+"))
   3762     (when (re-search-forward
   3763            (if (equal arg "--")
   3764                ;; Special case.
   3765                "^[\t\s]+\\(--\\(?: \\|$\\)\\|\\[--\\]\\)"
   3766              ;; Should start with whitespace and may have
   3767              ;; any number of options before and/or after.
   3768              (format
   3769               "^[\t\s]+\\(?:%s, \\)*?\\(?1:%s\\)%s\\(?:, %s\\)*$"
   3770               others
   3771               ;; Options don't necessarily end in an "="
   3772               ;; (e.g., "--gpg-sign[=<keyid>]")
   3773               (string-remove-suffix "=" arg)
   3774               ;; Simple options don't end in an "=".  Splitting this
   3775               ;; into 2 cases should make getting false positives
   3776               ;; less likely.
   3777               (if (string-suffix-p "=" arg)
   3778                   ;; "[^[:space:]]*[^.[:space:]]" matches the option
   3779                   ;; value, which is usually after the option name
   3780                   ;; and either '=' or '[='.  The value can't end in
   3781                   ;; a period, as that means it's being used at the
   3782                   ;; end of a sentence.  The space is for options
   3783                   ;; such as '--mainline parent-number'.
   3784                   "\\(?: \\|\\[?=\\)[^[:space:]]*[^.[:space:]]"
   3785                 ;; Either this doesn't match anything (e.g., "-a"),
   3786                 ;; or the option is followed by a value delimited
   3787                 ;; by a "[", "<", or ":".  A space might appear
   3788                 ;; before this value, as in "-f <file>".  The
   3789                 ;; space alternative is for options such as
   3790                 ;; "-m parent-number".
   3791                 "\\(?:\\(?: \\| ?[\\[<:]\\)[^[:space:]]*[^.[:space:]]\\)?")
   3792               others))
   3793            nil t)
   3794       (goto-char (match-beginning 1)))))
   3795 
   3796 (defun transient--insert-help ()
   3797   (unless (looking-back "\n\n" 2)
   3798     (insert "\n"))
   3799   (when transient--helpp
   3800     (insert
   3801      (format (propertize "\
   3802 Type a %s to show help for that suffix command, or %s to show manual.
   3803 Type %s to exit help.\n"
   3804                          'face 'transient-heading)
   3805              (propertize "<KEY>" 'face 'transient-key)
   3806              (propertize "?"     'face 'transient-key)
   3807              (propertize "C-g"   'face 'transient-key))))
   3808   (when transient--editp
   3809     (unless transient--helpp
   3810       (insert
   3811        (format (propertize "\
   3812 Type a %s to set level for that suffix command.
   3813 Type %s to set what levels are available for this prefix command.\n"
   3814                            'face 'transient-heading)
   3815                (propertize "<KEY>"   'face 'transient-key)
   3816                (propertize "C-x l" 'face 'transient-key))))
   3817     (with-slots (level) transient--prefix
   3818       (insert
   3819        (format (propertize "
   3820 Suffixes on levels %s are available.
   3821 Suffixes on levels %s and %s are unavailable.\n"
   3822                            'face 'transient-heading)
   3823                (propertize (format "1-%s" level)
   3824                            'face 'transient-enabled-suffix)
   3825                (propertize " 0 "
   3826                            'face 'transient-disabled-suffix)
   3827                (propertize (format ">=%s" (1+ level))
   3828                            'face 'transient-disabled-suffix))))))
   3829 
   3830 (defvar-keymap transient-resume-mode-map
   3831   :doc "Keymap for `transient-resume-mode'.
   3832 
   3833 This keymap remaps every command that would usually just quit the
   3834 documentation buffer to `transient-resume', which additionally
   3835 resumes the suspended transient."
   3836   "<remap> <Man-quit>"    #'transient-resume
   3837   "<remap> <Info-exit>"   #'transient-resume
   3838   "<remap> <quit-window>" #'transient-resume)
   3839 
   3840 (define-minor-mode transient-resume-mode
   3841   "Auxiliary minor-mode used to resume a transient after viewing help.")
   3842 
   3843 (defun transient-toggle-debug ()
   3844   "Toggle debugging statements for transient commands."
   3845   (interactive)
   3846   (setq transient--debug (not transient--debug))
   3847   (message "Debugging transient %s"
   3848            (if transient--debug "enabled" "disabled")))
   3849 
   3850 ;;; Popup Navigation
   3851 
   3852 (defun transient-popup-navigation-help ()
   3853   "Inform the user how to enable popup navigation commands."
   3854   (interactive)
   3855   (message "This command is only available if `%s' is non-nil"
   3856            'transient-enable-popup-navigation))
   3857 
   3858 (define-button-type 'transient
   3859   'face nil
   3860   'keymap transient-button-map)
   3861 
   3862 (defun transient-backward-button (n)
   3863   "Move to the previous button in the transient popup buffer.
   3864 See `backward-button' for information about N."
   3865   (interactive "p")
   3866   (with-selected-window transient--window
   3867     (backward-button n t)))
   3868 
   3869 (defun transient-forward-button (n)
   3870   "Move to the next button in the transient popup buffer.
   3871 See `forward-button' for information about N."
   3872   (interactive "p")
   3873   (with-selected-window transient--window
   3874     (forward-button n t)))
   3875 
   3876 (defun transient--goto-button (command)
   3877   (cond
   3878    ((stringp command)
   3879     (when (re-search-forward (concat "^" (regexp-quote command)) nil t)
   3880       (goto-char (match-beginning 0))))
   3881    (command
   3882     (while (and (ignore-errors (forward-button 1))
   3883                 (not (eq (button-get (button-at (point)) 'command) command))))
   3884     (unless (eq (button-get (button-at (point)) 'command) command)
   3885       (goto-char (point-min))
   3886       (forward-button 1)))))
   3887 
   3888 (defun transient--heading-at-point ()
   3889   (and (eq (get-text-property (point) 'face) 'transient-heading)
   3890        (let ((beg (line-beginning-position)))
   3891          (buffer-substring-no-properties
   3892           beg (next-single-property-change
   3893                beg 'face nil (line-end-position))))))
   3894 
   3895 ;;; Compatibility
   3896 ;;;; Popup Isearch
   3897 
   3898 (defvar-keymap transient--isearch-mode-map
   3899   :parent isearch-mode-map
   3900   "<remap> <isearch-exit>"   #'transient-isearch-exit
   3901   "<remap> <isearch-cancel>" #'transient-isearch-cancel
   3902   "<remap> <isearch-abort>"  #'transient-isearch-abort)
   3903 
   3904 (defun transient-isearch-backward (&optional regexp-p)
   3905   "Do incremental search backward.
   3906 With a prefix argument, do an incremental regular expression
   3907 search instead."
   3908   (interactive "P")
   3909   (transient--isearch-setup)
   3910   (let ((isearch-mode-map transient--isearch-mode-map))
   3911     (isearch-mode nil regexp-p)))
   3912 
   3913 (defun transient-isearch-forward (&optional regexp-p)
   3914   "Do incremental search forward.
   3915 With a prefix argument, do an incremental regular expression
   3916 search instead."
   3917   (interactive "P")
   3918   (transient--isearch-setup)
   3919   (let ((isearch-mode-map transient--isearch-mode-map))
   3920     (isearch-mode t regexp-p)))
   3921 
   3922 (defun transient-isearch-exit ()
   3923   "Like `isearch-exit' but adapted for `transient'."
   3924   (interactive)
   3925   (isearch-exit)
   3926   (transient--isearch-exit))
   3927 
   3928 (defun transient-isearch-cancel ()
   3929   "Like `isearch-cancel' but adapted for `transient'."
   3930   (interactive)
   3931   (condition-case nil (isearch-cancel) (quit))
   3932   (transient--isearch-exit))
   3933 
   3934 (defun transient-isearch-abort ()
   3935   "Like `isearch-abort' but adapted for `transient'."
   3936   (interactive)
   3937   (let ((around (lambda (fn)
   3938                   (condition-case nil (funcall fn) (quit))
   3939                   (transient--isearch-exit))))
   3940     (advice-add 'isearch-cancel :around around)
   3941     (unwind-protect
   3942         (isearch-abort)
   3943       (advice-remove 'isearch-cancel around))))
   3944 
   3945 (defun transient--isearch-setup ()
   3946   (select-window transient--window)
   3947   (transient--suspend-override t))
   3948 
   3949 (defun transient--isearch-exit ()
   3950   (select-window transient--original-window)
   3951   (transient--resume-override))
   3952 
   3953 ;;;; Hydra Color Emulation
   3954 
   3955 (defun transient--semantic-coloring-p ()
   3956   (and transient-semantic-coloring
   3957        (not transient--helpp)
   3958        (not transient--editp)))
   3959 
   3960 (defun transient--suffix-color (command)
   3961   (or (get command 'transient-color)
   3962       (get (transient--get-predicate-for command) 'transient-color)))
   3963 
   3964 (defun transient--prefix-color (command)
   3965   (let* ((nonsuf (or (oref command transient-non-suffix)
   3966                      'transient--do-warn))
   3967          (nonsuf (if (memq nonsuf '(transient--do-noop transient--do-warn))
   3968                      'disallow
   3969                    (get nonsuf 'transient-color)))
   3970          (suffix (if-let ((pred (oref command transient-suffix)))
   3971                      (get pred 'transient-color)
   3972                    (if (eq nonsuf 'transient-red)
   3973                        'transient-red
   3974                      'transient-blue))))
   3975     (pcase (list suffix nonsuf)
   3976       (`(transient-purple ,_)           'transient-purple)
   3977       ('(transient-red  disallow)       'transient-amaranth)
   3978       ('(transient-blue disallow)       'transient-teal)
   3979       ('(transient-red  transient-red)  'transient-pink)
   3980       ('(transient-red  transient-blue) 'transient-red)
   3981       ('(transient-blue transient-blue) 'transient-blue))))
   3982 
   3983 ;;;; Edebug
   3984 
   3985 (defun transient--edebug-command-p ()
   3986   (and (bound-and-true-p edebug-active)
   3987        (or (memq this-command '(top-level abort-recursive-edit))
   3988            (string-prefix-p "edebug" (symbol-name this-command)))))
   3989 
   3990 ;;;; Miscellaneous
   3991 
   3992 (cl-pushnew (list nil (concat "^\\s-*("
   3993                               (eval-when-compile
   3994                                 (regexp-opt
   3995                                  '("transient-define-prefix"
   3996                                    "transient-define-suffix"
   3997                                    "transient-define-infix"
   3998                                    "transient-define-argument")
   3999                                  t))
   4000                               "\\s-+\\(" lisp-mode-symbol-regexp "\\)")
   4001                   2)
   4002             lisp-imenu-generic-expression :test #'equal)
   4003 
   4004 (declare-function which-key-mode "which-key" (&optional arg))
   4005 
   4006 (defun transient--suspend-which-key-mode ()
   4007   (when (bound-and-true-p which-key-mode)
   4008     (which-key-mode -1)
   4009     (add-hook 'transient-exit-hook #'transient--resume-which-key-mode)))
   4010 
   4011 (defun transient--resume-which-key-mode ()
   4012   (unless transient--prefix
   4013     (which-key-mode 1)
   4014     (remove-hook 'transient-exit-hook #'transient--resume-which-key-mode)))
   4015 
   4016 (defun transient-bind-q-to-quit ()
   4017   "Modify some keymaps to bind \"q\" to the appropriate quit command.
   4018 
   4019 \"C-g\" is the default binding for such commands now, but Transient's
   4020 predecessor Magit-Popup used \"q\" instead.  If you would like to get
   4021 that binding back, then call this function in your init file like so:
   4022 
   4023   (with-eval-after-load \\='transient
   4024     (transient-bind-q-to-quit))
   4025 
   4026 Individual transients may already bind \"q\" to something else
   4027 and such a binding would shadow the quit binding.  If that is the
   4028 case then \"Q\" is bound to whatever \"q\" would have been bound
   4029 to by setting `transient-substitute-key-function' to a function
   4030 that does that.  Of course \"Q\" may already be bound to something
   4031 else, so that function binds \"M-q\" to that command instead.
   4032 Of course \"M-q\" may already be bound to something else, but
   4033 we stop there."
   4034   (keymap-set transient-base-map   "q" #'transient-quit-one)
   4035   (keymap-set transient-sticky-map "q" #'transient-quit-seq)
   4036   (setq transient-substitute-key-function
   4037         #'transient-rebind-quit-commands))
   4038 
   4039 (defun transient-rebind-quit-commands (obj)
   4040   "See `transient-bind-q-to-quit'."
   4041   (let ((key (oref obj key)))
   4042     (cond ((string-equal key "q") "Q")
   4043           ((string-equal key "Q") "M-q")
   4044           (t key))))
   4045 
   4046 (defun transient--force-fixed-pitch ()
   4047   (require 'face-remap)
   4048   (face-remap-reset-base 'default)
   4049   (face-remap-add-relative 'default 'fixed-pitch))
   4050 
   4051 ;;;; Missing from Emacs
   4052 
   4053 (defun transient--seq-reductions-from (function sequence initial-value)
   4054   (let ((acc (list initial-value)))
   4055     (seq-doseq (elt sequence)
   4056       (push (funcall function (car acc) elt) acc))
   4057     (nreverse acc)))
   4058 
   4059 (defun transient-plist-to-alist (plist)
   4060   (let (alist)
   4061     (while plist
   4062       (push (cons (let* ((symbol (pop plist))
   4063                          (name (symbol-name symbol)))
   4064                     (if (eq (aref name 0) ?:)
   4065                         (intern (substring name 1))
   4066                       symbol))
   4067                   (pop plist))
   4068             alist))
   4069     (nreverse alist)))
   4070 
   4071 ;;; Font-Lock
   4072 
   4073 (defconst transient-font-lock-keywords
   4074   (eval-when-compile
   4075     `((,(concat "("
   4076                 (regexp-opt (list "transient-define-prefix"
   4077                                   "transient-define-infix"
   4078                                   "transient-define-argument"
   4079                                   "transient-define-suffix"
   4080                                   "transient-define-groups")
   4081                             t)
   4082                 "\\_>[ \t'(]*"
   4083                 "\\(\\(?:\\sw\\|\\s_\\)+\\)?")
   4084        (1 'font-lock-keyword-face)
   4085        (2 'font-lock-function-name-face nil t)))))
   4086 
   4087 (font-lock-add-keywords 'emacs-lisp-mode transient-font-lock-keywords)
   4088 
   4089 ;;; Auxiliary Classes
   4090 ;;;; `transient-lisp-variable'
   4091 
   4092 (defclass transient-lisp-variable (transient-variable)
   4093   ((reader :initform #'transient-lisp-variable--reader)
   4094    (always-read :initform t)
   4095    (set-value :initarg :set-value :initform #'set))
   4096   "[Experimental] Class used for Lisp variables.")
   4097 
   4098 (cl-defmethod transient-init-value ((obj transient-lisp-variable))
   4099   (oset obj value (symbol-value (oref obj variable))))
   4100 
   4101 (cl-defmethod transient-infix-set ((obj transient-lisp-variable) value)
   4102   (funcall (oref obj set-value)
   4103            (oref obj variable)
   4104            (oset obj value value)))
   4105 
   4106 (cl-defmethod transient-format-description ((obj transient-lisp-variable))
   4107   (or (cl-call-next-method obj)
   4108       (symbol-name (oref obj variable))))
   4109 
   4110 (cl-defmethod transient-format-value ((obj transient-lisp-variable))
   4111   (propertize (prin1-to-string (oref obj value))
   4112               'face 'transient-value))
   4113 
   4114 (cl-defmethod transient-prompt ((obj transient-lisp-variable))
   4115   (if (and (slot-boundp obj 'prompt)
   4116            (oref obj prompt))
   4117       (cl-call-next-method obj)
   4118     (format "Set %s: " (oref obj variable))))
   4119 
   4120 (defun transient-lisp-variable--reader (prompt initial-input _history)
   4121   (read--expression prompt initial-input))
   4122 
   4123 ;;; _
   4124 (provide 'transient)
   4125 ;; Local Variables:
   4126 ;; indent-tabs-mode: nil
   4127 ;; checkdoc-symbol-words: ("command-line" "edit-mode" "help-mode")
   4128 ;; End:
   4129 ;;; transient.el ends here