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