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