config

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

transient.el (180568B)


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