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