mirrors/emacs
1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2025-12-17 03:10:58 -08:00
Code Issues Projects Releases Wiki Activity

* lisp/transient.el: Update to package version v0.3.7-11-g7f5520b3.

Browse source
This commit is contained in:
Jonas Bernoulli 2021-11-06 15:36:29 +01:00
parent 7343b0d0e4
commit d96de23510
No known key found for this signature in database
GPG key ID: 230C2EFBB326D927
1 changed files with 135 additions and 100 deletions
Download patch file Download diff file Expand all files Collapse all files

235
lisp/transient.el
View file

@ -598,12 +598,14 @@ If `transient-save-history' is nil, then do nothing."
(history :initarg :history :initform nil) (history :initarg :history :initform nil)
(history-pos :initarg :history-pos :initform 0) (history-pos :initarg :history-pos :initform 0)
(history-key :initarg :history-key :initform nil) (history-key :initarg :history-key :initform nil)
(man-page :initarg :man-page :initform nil) (show-help :initarg :show-help :initform nil)
(info-manual :initarg :info-manual :initform nil) (info-manual :initarg :info-manual :initform nil)
(man-page :initarg :man-page :initform nil)
(transient-suffix :initarg :transient-suffix :initform nil) (transient-suffix :initarg :transient-suffix :initform nil)
(transient-non-suffix :initarg :transient-non-suffix :initform nil) (transient-non-suffix :initarg :transient-non-suffix :initform nil)
(incompatible :initarg :incompatible :initform nil) (incompatible :initarg :incompatible :initform nil)
(suffix-description :initarg :suffix-description)) (suffix-description :initarg :suffix-description)
(variable-pitch :initarg :variable-pitch :initform nil))
"Transient prefix command. "Transient prefix command.
Each transient prefix command consists of a command, which is Each transient prefix command consists of a command, which is
@ -665,6 +667,7 @@ slot is non-nil."
(transient :initarg :transient) (transient :initarg :transient)
(format :initarg :format :initform " %k %d") (format :initarg :format :initform " %k %d")
(description :initarg :description :initform nil) (description :initarg :description :initform nil)
(show-help :initarg :show-help :initform nil)
(inapt :initform nil) (inapt :initform nil)
(inapt-if (inapt-if
:initarg :inapt-if :initarg :inapt-if
@ -739,8 +742,12 @@ slot is non-nil."
(argument-regexp :initarg :argument-regexp)) (argument-regexp :initarg :argument-regexp))
"Class used for sets of mutually exclusive command-line switches.") "Class used for sets of mutually exclusive command-line switches.")
(defclass transient-files (transient-infix) () (defclass transient-files (transient-option) ()
"Class used for the \"--\" argument. ((key :initform "--")
(argument :initform "--")
(multi-value :initform rest)
(reader :initform transient-read-files))
"Class used for the \"--\" argument or similar.
All remaining arguments are treated as files. All remaining arguments are treated as files.
They become the value of this argument.") They become the value of this argument.")
@ -2460,30 +2467,30 @@ Otherwise call the primary method according to object's class."
default) default)
nil))))) nil)))))
(cl-defmethod transient-init-value ((obj transient-argument))
(oset obj value
(let ((value (oref transient--prefix value))
(argument (and (slot-boundp obj 'argument)
(oref obj argument)))
(multi-value (oref obj multi-value))
(regexp (if (slot-exists-p obj 'argument-regexp)
(oref obj argument-regexp)
(format "\\`%s\\(.*\\)" (oref obj argument)))))
(if (memq multi-value '(t rest))
(cdr (assoc argument value))
(let ((match (lambda (v)
(and (stringp v)
(string-match regexp v)
(match-string 1 v)))))
(if multi-value
(delq nil (mapcar match value))
(cl-some match value)))))))
(cl-defmethod transient-init-value ((obj transient-switch)) (cl-defmethod transient-init-value ((obj transient-switch))
(oset obj value (oset obj value
(car (member (oref obj argument) (car (member (oref obj argument)
(oref transient--prefix value))))) (oref transient--prefix value)))))
(cl-defmethod transient-init-value ((obj transient-option))
(oset obj value
(transient--value-match (format "\\`%s\\(.*\\)" (oref obj argument)))))
(cl-defmethod transient-init-value ((obj transient-switches))
(oset obj value
(transient--value-match (oref obj argument-regexp))))
(defun transient--value-match (re)
(when-let ((match (cl-find-if (lambda (v)
(and (stringp v)
(string-match re v)))
(oref transient--prefix value))))
(match-string 1 match)))
(cl-defmethod transient-init-value ((obj transient-files))
(oset obj value
(cdr (assoc "--" (oref transient--prefix value)))))
;;;; Read ;;;; Read
(cl-defgeneric transient-infix-read (obj) (cl-defgeneric transient-infix-read (obj)
@ -2733,7 +2740,7 @@ If the current command was invoked from the transient prefix
command PREFIX, then return the active infix arguments. If command PREFIX, then return the active infix arguments. If
the current command was not invoked from PREFIX, then return the current command was not invoked from PREFIX, then return
the set, saved or default value for PREFIX." the set, saved or default value for PREFIX."
(delq nil (mapcar #'transient-infix-value (transient-suffixes prefix)))) (cl-mapcan #'transient--get-wrapped-value (transient-suffixes prefix)))
(defun transient-suffixes (prefix) (defun transient-suffixes (prefix)
"Return the suffix objects of the transient prefix command PREFIX." "Return the suffix objects of the transient prefix command PREFIX."
@ -2745,11 +2752,19 @@ the set, saved or default value for PREFIX."
(defun transient-get-value () (defun transient-get-value ()
(transient--with-emergency-exit (transient--with-emergency-exit
(delq nil (mapcar (lambda (obj) (cl-mapcan (lambda (obj)
(and (or (not (slot-exists-p obj 'unsavable)) (and (or (not (slot-exists-p obj 'unsavable))
(not (oref obj unsavable))) (not (oref obj unsavable)))
(transient-infix-value obj))) (transient--get-wrapped-value obj)))
transient-current-suffixes)))) transient-current-suffixes)))
(defun transient--get-wrapped-value (obj)
(when-let ((value (transient-infix-value obj)))
(cl-ecase (and (slot-exists-p obj 'multi-value)
(oref obj multi-value))
((nil) (list value))
((t rest) (list value))
(repeat value))))
(cl-defgeneric transient-infix-value (obj) (cl-defgeneric transient-infix-value (obj)
"Return the value of the suffix object OBJ. "Return the value of the suffix object OBJ.
@ -2781,13 +2796,13 @@ does nothing." nil)
(oref obj value)) (oref obj value))
(cl-defmethod transient-infix-value ((obj transient-option)) (cl-defmethod transient-infix-value ((obj transient-option))
"Return (concat ARGUMENT VALUE) or nil. "Return ARGUMENT and VALUE as a unit or nil if the latter is nil."
ARGUMENT and VALUE are the values of the respective slots of OBJ.
If VALUE is nil, then return nil. VALUE may be the empty string,
which is not the same as nil."
(when-let ((value (oref obj value))) (when-let ((value (oref obj value)))
(concat (oref obj argument) value))) (let ((arg (oref obj argument)))
(cl-ecase (oref obj multi-value)
((nil) (concat arg value))
((t rest) (cons arg value))
(repeat (mapcar (lambda (v) (concat arg v)) value))))))
(cl-defmethod transient-infix-value ((_ transient-variable)) (cl-defmethod transient-infix-value ((_ transient-variable))
"Return nil, which means \"no value\". "Return nil, which means \"no value\".
@ -2797,15 +2812,6 @@ value of the variable. I.e. this is a side-effect and does not
contribute to the value of the transient." contribute to the value of the transient."
nil) nil)
(cl-defmethod transient-infix-value ((obj transient-files))
"Return (cons ARGUMENT VALUE) or nil.
ARGUMENT and VALUE are the values of the respective slots of OBJ.
If VALUE is nil, then return nil. VALUE may be the empty string,
which is not the same as nil."
(when-let ((value (oref obj value)))
(cons (oref obj argument) value)))
;;;; Utilities ;;;; Utilities
(defun transient-arg-value (arg args) (defun transient-arg-value (arg args)
@ -2922,16 +2928,16 @@ have a history of their own.")
'transient-separator))) 'transient-separator)))
(insert (propertize "__" 'face face 'display '(space :height (1)))) (insert (propertize "__" 'face face 'display '(space :height (1))))
(insert (propertize "\n" 'face face 'line-height t)))) (insert (propertize "\n" 'face face 'line-height t))))
(goto-char (point-min))
(when transient-force-fixed-pitch (when transient-force-fixed-pitch
(transient--force-fixed-pitch)) (transient--force-fixed-pitch)))
(when transient-enable-popup-navigation
(transient--goto-button focus)))
(unless (window-live-p transient--window) (unless (window-live-p transient--window)
(setq transient--window (setq transient--window
(display-buffer buf transient-display-buffer-action))) (display-buffer buf transient-display-buffer-action)))
(when (window-live-p transient--window) (when (window-live-p transient--window)
(with-selected-window transient--window (with-selected-window transient--window
(goto-char (point-min))
(when transient-enable-popup-navigation
(transient--goto-button focus))
(magit--fit-window-to-buffer transient--window))))) (magit--fit-window-to-buffer transient--window)))))
(defun magit--fit-window-to-buffer (window) (defun magit--fit-window-to-buffer (window)
@ -2989,11 +2995,17 @@ have a history of their own.")
(push desc rows)) (push desc rows))
rows)) rows))
(oref group suffixes))) (oref group suffixes)))
(vp (oref transient--prefix variable-pitch))
(rs (apply #'max (mapcar #'length columns))) (rs (apply #'max (mapcar #'length columns)))
(cs (length columns)) (cs (length columns))
(cw (mapcar (lambda (col) (apply #'max (mapcar #'length col))) (cw (mapcar (lambda (col)
(apply #'max
(mapcar (if vp #'transient--pixel-width #'length)
col)))
columns)) columns))
(cc (transient--seq-reductions-from (apply-partially #'+ 3) cw 0))) (cc (transient--seq-reductions-from
(apply-partially #'+ (* 3 (if vp (transient--pixel-width " ") 1)))
cw 0)))
(if transient-force-single-column (if transient-force-single-column
(dotimes (c cs) (dotimes (c cs)
(dotimes (r rs) (dotimes (r rs)
@ -3004,11 +3016,28 @@ have a history of their own.")
(insert ?\n))) (insert ?\n)))
(dotimes (r rs) (dotimes (r rs)
(dotimes (c cs) (dotimes (c cs)
(insert (make-string (- (nth c cc) (current-column)) ?\s)) (if vp
(when-let ((cell (nth r (nth c columns)))) (progn
(insert cell)) (when-let ((cell (nth r (nth c columns))))
(when (= c (1- cs)) (insert cell))
(insert ?\n))))))) (if (= c (1- cs))
(insert ?\n)
(insert (propertize " " 'display
`(space :align-to (,(nth (1+ c) cc)))))))
(insert (make-string (- (nth c cc) (current-column)) ?\s))
(when-let ((cell (nth r (nth c columns))))
(insert cell))
(when (= c (1- cs))
(insert ?\n))))))))
(defun transient--pixel-width (string)
(save-window-excursion
(with-temp-buffer
(insert string)
(set-window-dedicated-p nil nil)
(set-window-buffer nil (current-buffer))
(car (window-text-pixel-size
nil (line-beginning-position) (point))))))
(cl-defmethod transient--insert-group ((group transient-subgroups)) (cl-defmethod transient--insert-group ((group transient-subgroups))
(let* ((subgroups (oref group suffixes)) (let* ((subgroups (oref group suffixes))
@ -3195,14 +3224,17 @@ If the OBJ's `key' is currently unreachable, then apply the face
'transient-inactive-argument))) 'transient-inactive-argument)))
(cl-defmethod transient-format-value ((obj transient-option)) (cl-defmethod transient-format-value ((obj transient-option))
(let ((value (oref obj value))) (let ((argument (oref obj argument)))
(propertize (concat (oref obj argument) (if-let ((value (oref obj value)))
(if (listp value) (propertize
(mapconcat #'identity value ",") (cl-ecase (oref obj multi-value)
value)) ((nil) (concat argument value))
'face (if value ((t rest) (concat argument
'transient-value (and (not (string-suffix-p " " argument)) " ")
'transient-inactive-value)))) (mapconcat #'prin1-to-string value " ")))
(repeat (mapconcat (lambda (v) (concat argument v)) value " ")))
'face 'transient-value)
(propertize argument 'face 'transient-inactive-value))))
(cl-defmethod transient-format-value ((obj transient-switches)) (cl-defmethod transient-format-value ((obj transient-switches))
(with-slots (value argument-format choices) obj (with-slots (value argument-format choices) obj
@ -3222,15 +3254,6 @@ If the OBJ's `key' is currently unreachable, then apply the face
(propertize "|" 'face 'transient-inactive-value)) (propertize "|" 'face 'transient-inactive-value))
(propertize "]" 'face 'transient-inactive-value))))) (propertize "]" 'face 'transient-inactive-value)))))
(cl-defmethod transient-format-value ((obj transient-files))
(let ((argument (oref obj argument)))
(if-let ((value (oref obj value)))
(propertize (concat argument " "
(mapconcat (lambda (f) (format "%S" f))
(oref obj value) " "))
'face 'transient-argument)
(propertize argument 'face 'transient-inactive-argument))))
(defun transient--key-unreachable-p (obj) (defun transient--key-unreachable-p (obj)
(and transient--redisplay-key (and transient--redisplay-key
(let ((key (oref obj key))) (let ((key (oref obj key)))
@ -3274,42 +3297,58 @@ a prefix command, while porting a regular keymap to a transient."
;;; Help ;;; Help
(cl-defgeneric transient-show-help (obj) (cl-defgeneric transient-show-help (obj)
"Show help for OBJ's command.") "Show documentation for the command represented by OBJ.")
(cl-defmethod transient-show-help ((obj transient-prefix)) (cl-defmethod transient-show-help ((obj transient-prefix))
"Show the info manual, manpage or command doc-string. "Call `show-help' if non-nil, else show `info-manual',
Show the first one that is specified." if non-nil, else show the `man-page' if non-nil, else use
(if-let ((manual (oref obj info-manual))) `describe-function'."
(info manual) (with-slots (show-help info-manual man-page command) obj
(if-let ((manpage (oref obj man-page))) (cond (show-help (funcall show-help obj))
(transient--show-manpage manpage) (info-manual (transient--show-manual info-manual))
(transient--describe-function (oref obj command))))) (man-page (transient--show-manpage man-page))
(t (transient--describe-function command)))))
(cl-defmethod transient-show-help ((obj transient-suffix)) (cl-defmethod transient-show-help ((obj transient-suffix))
"Show the command doc-string." "Call `show-help' if non-nil, else use `describe-function'.
(if (eq this-command 'transient-help) Also used to dispatch showing documentation for the current
(if-let ((manpage (oref transient--prefix man-page))) prefix. If the suffix is a sub-prefix, then also call the
(transient--show-manpage manpage) prefix method."
(transient--describe-function (oref transient--prefix command))) (cond
(if-let ((prefix (get (transient--suffix-command obj) 'transient--prefix)) ((eq this-command 'transient-help)
(manpage (oref prefix man-page)) (transient-show-help transient--prefix))
(- (not (eq this-command (oref transient--prefix command))))) ((let ((prefix (get (transient--suffix-command obj)
(transient--show-manpage manpage) 'transient--prefix)))
(transient--describe-function this-original-command)))) (and prefix (not (eq (oref transient--prefix command) this-command))
(prog1 t (transient-show-help prefix)))))
(t (if-let ((show-help (oref obj show-help)))
(funcall show-help obj)
(transient--describe-function this-command)))))
(cl-defmethod transient-show-help ((obj transient-infix)) (cl-defmethod transient-show-help ((obj transient-infix))
"Show the manpage if defined or the command doc-string. "Call `show-help' if non-nil, else show the `man-page'
If the manpage is specified, then try to jump to the correct if non-nil, else use `describe-function'. When showing the
location." manpage, then try to jump to the correct location."
(if-let ((manpage (oref transient--prefix man-page))) (if-let ((show-help (oref obj show-help)))
(transient--show-manpage manpage (ignore-errors (oref obj argument))) (funcall show-help obj)
(transient--describe-function this-original-command))) (if-let ((man-page (oref transient--prefix man-page))
(argument (and (slot-boundp obj 'argument)
(oref obj argument))))
(transient--show-manpage man-page argument)
(transient--describe-function this-command))))
;; `cl-generic-generalizers' doesn't support `command' et al. ;; `cl-generic-generalizers' doesn't support `command' et al.
(cl-defmethod transient-show-help (cmd) (cl-defmethod transient-show-help (cmd)
"Show the command doc-string." "Show the command doc-string."
(transient--describe-function cmd)) (transient--describe-function cmd))
(defun transient--describe-function (fn)
(describe-function fn)
(select-window (get-buffer-window (help-buffer))))
(defun transient--show-manual (manual)
(info manual))
(defun transient--show-manpage (manpage &optional argument) (defun transient--show-manpage (manpage &optional argument)
(require 'man) (require 'man)
(let* ((Man-notify-method 'meek) (let* ((Man-notify-method 'meek)
@ -3321,10 +3360,6 @@ location."
(when argument (when argument
(transient--goto-argument-description argument)))) (transient--goto-argument-description argument))))
(defun transient--describe-function (fn)
(describe-function fn)
(select-window (get-buffer-window (help-buffer))))
(defun transient--goto-argument-description (arg) (defun transient--goto-argument-description (arg)
(goto-char (point-min)) (goto-char (point-min))
(let ((case-fold-search nil) (let ((case-fold-search nil)