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