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