config

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

transient.el (184078B)


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