config

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

transient.el (188720B)


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