emacs-diffs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

emacs-28 d96de23: * lisp/transient.el: Update to package version v0.3.7-


From: Jonas Bernoulli
Subject: emacs-28 d96de23: * lisp/transient.el: Update to package version v0.3.7-11-g7f5520b3.
Date: Sat, 6 Nov 2021 10:37:32 -0400 (EDT)

branch: emacs-28
commit d96de235108bbd78c440891f4c582dbfd1c4971e
Author: Jonas Bernoulli <jonas@bernoul.li>
Commit: Jonas Bernoulli <jonas@bernoul.li>

    * lisp/transient.el: Update to package version v0.3.7-11-g7f5520b3.
---
 lisp/transient.el | 235 +++++++++++++++++++++++++++++++-----------------------
 1 file changed, 135 insertions(+), 100 deletions(-)

diff --git a/lisp/transient.el b/lisp/transient.el
index d0ba854..f80e6af 100644
--- a/lisp/transient.el
+++ b/lisp/transient.el
@@ -598,12 +598,14 @@ If `transient-save-history' is nil, then do nothing."
    (history     :initarg :history     :initform nil)
    (history-pos :initarg :history-pos :initform 0)
    (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)
+   (man-page    :initarg :man-page    :initform nil)
    (transient-suffix     :initarg :transient-suffix     :initform nil)
    (transient-non-suffix :initarg :transient-non-suffix :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.
 
 Each transient prefix command consists of a command, which is
@@ -665,6 +667,7 @@ slot is non-nil."
    (transient   :initarg :transient)
    (format      :initarg :format      :initform " %k %d")
    (description :initarg :description :initform nil)
+   (show-help   :initarg :show-help   :initform nil)
    (inapt                             :initform nil)
    (inapt-if
     :initarg :inapt-if
@@ -739,8 +742,12 @@ slot is non-nil."
    (argument-regexp  :initarg :argument-regexp))
   "Class used for sets of mutually exclusive command-line switches.")
 
-(defclass transient-files (transient-infix) ()
-  "Class used for the \"--\" argument.
+(defclass transient-files (transient-option) ()
+  ((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.
 They become the value of this argument.")
 
@@ -2460,30 +2467,30 @@ Otherwise call the primary method according to object's 
class."
                   default)
               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))
   (oset obj value
         (car (member (oref obj argument)
                      (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
 
 (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
 the current command was not invoked from PREFIX, then return
 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)
   "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 ()
   (transient--with-emergency-exit
-    (delq nil (mapcar (lambda (obj)
-                        (and (or (not (slot-exists-p obj 'unsavable))
-                                 (not (oref obj unsavable)))
-                             (transient-infix-value obj)))
-                      transient-current-suffixes))))
+    (cl-mapcan (lambda (obj)
+                 (and (or (not (slot-exists-p obj 'unsavable))
+                          (not (oref obj unsavable)))
+                      (transient--get-wrapped-value obj)))
+               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)
   "Return the value of the suffix object OBJ.
@@ -2781,13 +2796,13 @@ does nothing." nil)
   (oref obj value))
 
 (cl-defmethod transient-infix-value ((obj transient-option))
-  "Return (concat 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."
+  "Return ARGUMENT and VALUE as a unit or nil if the latter is nil."
   (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))
   "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."
   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
 
 (defun transient-arg-value (arg args)
@@ -2922,16 +2928,16 @@ have a history of their own.")
                  'transient-separator)))
           (insert (propertize "__" 'face face 'display '(space :height (1))))
           (insert (propertize "\n" 'face face 'line-height t))))
-      (goto-char (point-min))
       (when transient-force-fixed-pitch
-        (transient--force-fixed-pitch))
-      (when transient-enable-popup-navigation
-        (transient--goto-button focus)))
+        (transient--force-fixed-pitch)))
     (unless (window-live-p transient--window)
       (setq transient--window
             (display-buffer buf transient-display-buffer-action)))
     (when (window-live-p 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)))))
 
 (defun magit--fit-window-to-buffer (window)
@@ -2989,11 +2995,17 @@ have a history of their own.")
                  (push desc rows))
                rows))
            (oref group suffixes)))
+         (vp (oref transient--prefix variable-pitch))
          (rs (apply #'max (mapcar #'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))
-         (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
         (dotimes (c cs)
           (dotimes (r rs)
@@ -3004,11 +3016,28 @@ have a history of their own.")
             (insert ?\n)))
       (dotimes (r rs)
         (dotimes (c cs)
-          (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)))))))
+          (if vp
+              (progn
+                (when-let ((cell (nth r (nth c columns))))
+                  (insert cell))
+                (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))
   (let* ((subgroups (oref group suffixes))
@@ -3195,14 +3224,17 @@ If the OBJ's `key' is currently unreachable, then apply 
the face
                       'transient-inactive-argument)))
 
 (cl-defmethod transient-format-value ((obj transient-option))
-  (let ((value (oref obj value)))
-    (propertize (concat (oref obj argument)
-                        (if (listp value)
-                            (mapconcat #'identity value ",")
-                          value))
-                'face (if value
-                          'transient-value
-                        'transient-inactive-value))))
+  (let ((argument (oref obj argument)))
+    (if-let ((value (oref obj value)))
+        (propertize
+         (cl-ecase (oref obj multi-value)
+           ((nil)    (concat argument value))
+           ((t rest) (concat argument
+                             (and (not (string-suffix-p " " argument)) " ")
+                             (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))
   (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)))))
 
-(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)
   (and transient--redisplay-key
        (let ((key (oref obj key)))
@@ -3274,42 +3297,58 @@ a prefix command, while porting a regular keymap to a 
transient."
 ;;; Help
 
 (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))
-  "Show the info manual, manpage or command doc-string.
-Show the first one that is specified."
-  (if-let ((manual (oref obj info-manual)))
-      (info manual)
-    (if-let ((manpage (oref obj man-page)))
-        (transient--show-manpage manpage)
-      (transient--describe-function (oref obj command)))))
+  "Call `show-help' if non-nil, else show `info-manual',
+if non-nil, else show the `man-page' if non-nil, else use
+`describe-function'."
+  (with-slots (show-help info-manual man-page command) obj
+    (cond (show-help (funcall show-help obj))
+          (info-manual (transient--show-manual info-manual))
+          (man-page (transient--show-manpage man-page))
+          (t (transient--describe-function command)))))
 
 (cl-defmethod transient-show-help ((obj transient-suffix))
-  "Show the command doc-string."
-  (if (eq this-command 'transient-help)
-      (if-let ((manpage (oref transient--prefix man-page)))
-          (transient--show-manpage manpage)
-        (transient--describe-function (oref transient--prefix command)))
-    (if-let ((prefix (get (transient--suffix-command obj) 'transient--prefix))
-             (manpage (oref prefix man-page))
-             (- (not (eq this-command (oref transient--prefix command)))))
-        (transient--show-manpage manpage)
-      (transient--describe-function this-original-command))))
+  "Call `show-help' if non-nil, else use `describe-function'.
+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 (transient--suffix-command obj)
+                       'transient--prefix)))
+      (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))
-  "Show the manpage if defined or the command doc-string.
-If the manpage is specified, then try to jump to the correct
-location."
-  (if-let ((manpage (oref transient--prefix man-page)))
-      (transient--show-manpage manpage (ignore-errors (oref obj argument)))
-    (transient--describe-function this-original-command)))
+  "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))))
 
 ;; `cl-generic-generalizers' doesn't support `command' et al.
 (cl-defmethod transient-show-help (cmd)
   "Show the command doc-string."
   (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)
   (require 'man)
   (let* ((Man-notify-method 'meek)
@@ -3321,10 +3360,6 @@ location."
     (when 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)
   (goto-char (point-min))
   (let ((case-fold-search nil)



reply via email to

[Prev in Thread] Current Thread [Next in Thread]