config

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

transient.el (196921B)


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