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