branch: externals/transient
commit 5a37ade046d7150cc5aff679b782df9c081e5a2b
Author: Jonas Bernoulli <[email protected]>
Commit: Jonas Bernoulli <[email protected]>
Use Cond-Let's cond-let and cond-let*
---
lisp/transient.el | 255 +++++++++++++++++++++++++++---------------------------
1 file changed, 129 insertions(+), 126 deletions(-)
diff --git a/lisp/transient.el b/lisp/transient.el
index 02034c6c71..00f6673bd1 100644
--- a/lisp/transient.el
+++ b/lisp/transient.el
@@ -1441,12 +1441,13 @@ commands are aliases for."
(_ (use key val)))))
(when spec
(error "Need keyword, got %S" (car spec)))
- (if-let ((key (plist-get args :key)))
- (when (string-match "\\`\\({p}\\)" key)
- (use :key
- (replace-match transient-common-command-prefix t t key 1)))
- (when-let ((shortarg (plist-get args :shortarg)))
- (use :key shortarg))))
+ (cond-let
+ ([key (plist-get args :key)]
+ (when (string-match "\\`\\({p}\\)" key)
+ (use :key
+ (replace-match transient-common-command-prefix t t key 1))))
+ ([shortarg (plist-get args :shortarg)]
+ (use :key shortarg))))
(list 'cons
(macroexp-quote (or class 'transient-suffix))
(cons 'list args))))
@@ -1479,49 +1480,50 @@ symbol property.")
(put prefix 'transient--layout (vector 2 nil layout)))
(defun transient--get-layout (prefix)
- (if-let*
- ((layout
- (or (get prefix 'transient--layout)
- ;; Migrate unparsed legacy group definition.
- (condition-case-unless-debug err
- (and-let* ((value (symbol-value prefix)))
- (transient--set-layout
- prefix
- (if (and (listp value)
- (or (listp (car value))
- (vectorp (car value))))
- (transient-parse-suffixes prefix value)
- (list (transient-parse-suffix prefix value)))))
- (error
- (message "Not a legacy group definition: %s: %S" prefix err)
- nil)))))
- (if (vectorp layout)
- (let ((version (aref layout 0)))
- (if (= version 2)
- layout
- (error "Unsupported layout version %s for %s" version prefix)))
- ;; Upgrade from version 1.
- (transient--set-layout
- prefix
- (named-let upgrade ((spec layout))
- (cond ((vectorp spec)
- (pcase-let ((`[,level ,class ,args ,children] spec))
- (when level
- (setq args (plist-put args :level level)))
- (vector class args (mapcar #'upgrade children))))
- ((and (listp spec)
- (length= spec 3)
- (or (null (car spec))
- (natnump (car spec)))
- (symbolp (cadr spec)))
- (pcase-let ((`(,level ,class ,args) spec))
- (when level
- (setq args (plist-put args :level level)))
- (cons class args)))
- ((listp spec)
- (mapcar #'upgrade spec))
- (t spec)))))
- (error "Not a transient prefix command or group definition: %s" prefix)))
+ (cond-let
+ [[layout (or (get prefix 'transient--layout)
+ ;; Migrate unparsed legacy group definition.
+ (condition-case-unless-debug err
+ (and-let* ((value (symbol-value prefix)))
+ (transient--set-layout
+ prefix
+ (if (and (listp value)
+ (or (listp (car value))
+ (vectorp (car value))))
+ (transient-parse-suffixes prefix value)
+ (list (transient-parse-suffix prefix value)))))
+ (error
+ (message "Not a legacy group definition: %s: %S" prefix
err)
+ nil)))]]
+ ((not layout)
+ (error "Not a transient prefix command or group definition: %s" prefix))
+ ((vectorp layout)
+ (let ((version (aref layout 0)))
+ (if (= version 2)
+ layout
+ (error "Unsupported layout version %s for %s" version prefix))))
+ (t
+ ;; Upgrade from version 1.
+ (transient--set-layout
+ prefix
+ (named-let upgrade ((spec layout))
+ (cond ((vectorp spec)
+ (pcase-let ((`[,level ,class ,args ,children] spec))
+ (when level
+ (setq args (plist-put args :level level)))
+ (vector class args (mapcar #'upgrade children))))
+ ((and (listp spec)
+ (length= spec 3)
+ (or (null (car spec))
+ (natnump (car spec)))
+ (symbolp (cadr spec)))
+ (pcase-let ((`(,level ,class ,args) spec))
+ (when level
+ (setq args (plist-put args :level level)))
+ (cons class args)))
+ ((listp spec)
+ (mapcar #'upgrade spec))
+ (t spec)))))))
(defun transient--get-children (prefix)
(aref (transient--get-layout prefix) 2))
@@ -1717,11 +1719,12 @@ See info node `(transient)Modifying Existing
Transients'."
(defun transient--match-child (group loc child)
(cl-etypecase child
(string nil)
- (symbol (if (symbolp loc)
- (and (eq child loc)
- (list child group))
- (and-let* ((include (transient--get-layout child)))
- (transient--locate-child include loc))))
+ (symbol (cond-let
+ ((symbolp loc)
+ (and (eq child loc)
+ (list child group)))
+ ([include (transient--get-layout child)]
+ (transient--locate-child include loc))))
(vector (seq-some (lambda (subgroup)
(transient--locate-child subgroup loc))
(aref group 2)))
@@ -1967,47 +1970,46 @@ probably use this instead:
(get COMMAND \\='transient--suffix)"
(when command
(cl-check-type command command))
- (cond
- (transient--pending-suffix)
- (transient--current-suffix)
- ((or transient--prefix
- transient-current-prefix)
- (let ((suffixes
- (cl-remove-if-not
- (lambda (obj)
- (eq (oref obj command)
- (or command
- (if (eq this-command 'transient-set-level)
- ;; This is how it can look up for which
- ;; command it is setting the level.
- this-original-command
- this-command))))
- (or transient--suffixes
- transient-current-suffixes))))
- (cond
- ((length= suffixes 1)
- (car suffixes))
- ((cl-find-if (lambda (obj)
- (equal (listify-key-sequence (kbd (oref obj key)))
- (listify-key-sequence (this-command-keys))))
- suffixes))
- ;; COMMAND is only provided if `this-command' is meaningless, in
- ;; which case `this-command-keys' is also meaningless, making it
- ;; impossible to disambiguate bindings for the same command.
- (command (car suffixes))
- ;; If COMMAND is nil, then failure to disambiguate likely means
- ;; that there is a bug somewhere.
- ((length> suffixes 1)
- (error "BUG: Cannot unambiguously determine suffix object"))
- ;; It is legimate to use this function as a predicate of sorts.
- ;; `transient--pre-command' and `transient-help' are examples.
- (t nil))))
- ((and-let* ((obj (transient--suffix-prototype (or command this-command)))
- (obj (clone obj)))
- (progn
- (transient-init-scope obj)
- (transient-init-value obj)
- obj)))))
+ (cond-let*
+ (transient--pending-suffix)
+ (transient--current-suffix)
+ ((or transient--prefix
+ transient-current-prefix)
+ (let ((suffixes
+ (cl-remove-if-not
+ (lambda (obj)
+ (eq (oref obj command)
+ (or command
+ (if (eq this-command 'transient-set-level)
+ ;; This is how it can look up for which
+ ;; command it is setting the level.
+ this-original-command
+ this-command))))
+ (or transient--suffixes
+ transient-current-suffixes))))
+ (cond
+ ((length= suffixes 1)
+ (car suffixes))
+ ((cl-find-if (lambda (obj)
+ (equal (listify-key-sequence (kbd (oref obj key)))
+ (listify-key-sequence (this-command-keys))))
+ suffixes))
+ ;; COMMAND is only provided if `this-command' is meaningless, in
+ ;; which case `this-command-keys' is also meaningless, making it
+ ;; impossible to disambiguate bindings for the same command.
+ (command (car suffixes))
+ ;; If COMMAND is nil, then failure to disambiguate likely means
+ ;; that there is a bug somewhere.
+ ((length> suffixes 1)
+ (error "BUG: Cannot unambiguously determine suffix object"))
+ ;; It is legimate to use this function as a predicate of sorts.
+ ;; `transient--pre-command' and `transient-help' are examples.
+ (t nil))))
+ ([obj (transient--suffix-prototype (or command this-command))]
+ [obj (clone obj)]
+ (transient-init-scope obj)
+ (transient-init-value obj)
+ obj)))
(defun transient--suffix-prototype (command)
(or (get command 'transient--suffix)
@@ -3917,20 +3919,21 @@ command-line option) or \": \".
Finally fall through to using \"(BUG: no prompt): \" as the
prompt."
- (if-let ((prompt (oref obj prompt)))
- (let ((prompt (if (functionp prompt)
- (funcall prompt obj)
- prompt)))
- (if (stringp prompt)
- prompt
- "[BUG: invalid prompt]: "))
- (if-let ((name (or (and (slot-boundp obj 'argument) (oref obj argument))
- (and (slot-boundp obj 'variable) (oref obj variable)))))
- (if (and (stringp name)
- (string-suffix-p "=" name))
- name
- (format "%s: " name))
- "[BUG: no prompt]: ")))
+ (cond-let
+ ([prompt (oref obj prompt)]
+ (let ((prompt (if (functionp prompt)
+ (funcall prompt obj)
+ prompt)))
+ (if (stringp prompt)
+ prompt
+ "[BUG: invalid prompt]: ")))
+ ([name (or (and (slot-boundp obj 'argument) (oref obj argument))
+ (and (slot-boundp obj 'variable) (oref obj variable)))]
+ (if (and (stringp name)
+ (string-suffix-p "=" name))
+ name
+ (format "%s: " name)))
+ ("[BUG: no prompt]: ")))
;;;; Set
@@ -4978,28 +4981,28 @@ if non-nil, else show the `man-page' if non-nil, else
use
Also used to dispatch showing documentation for the current
prefix. If the suffix is a sub-prefix, then also call the
prefix method."
- (cond
- ((eq this-command 'transient-help)
- (transient-show-help transient--prefix))
- ((let ((prefix (get (oref obj command)
- 'transient--prefix)))
- (and prefix (not (eq (oref transient--prefix command) this-command))
- (prog1 t (transient-show-help prefix)))))
- ((if-let ((show-help (oref obj show-help)))
- (funcall show-help obj)
- (transient--describe-function this-command)))))
+ (cond-let
+ ((eq this-command 'transient-help)
+ (transient-show-help transient--prefix))
+ ([prefix (get (oref obj command) 'transient--prefix)]
+ [_(not (eq (oref transient--prefix command) this-command))]
+ (transient-show-help prefix))
+ ([show-help (oref obj show-help)]
+ (funcall show-help obj))
+ ((transient--describe-function this-command))))
(cl-defmethod transient-show-help ((obj transient-infix))
"Call `show-help' if non-nil, else show the `man-page'
if non-nil, else use `describe-function'. When showing the
manpage, then try to jump to the correct location."
- (if-let ((show-help (oref obj show-help)))
- (funcall show-help obj)
- (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))))
+ (cond-let
+ ([show-help (oref obj show-help)]
+ (funcall show-help obj))
+ ([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-defmethod transient-show-help (cmd)
