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