[elpa] externals/dtache dd57e01ba0: Improve completing read interface

[ELPA Syncer]

branch: externals/dtache
commit dd57e01ba0c06adc7d4a96c546a866ddaf1f792c
Author: Niklas Eklund <niklas.eklund@posteo.net>
Commit: Niklas Eklund <niklas.eklund@posteo.net>

    Improve completing read interface
    
    Make the command width as well as annotation dynmaic. They will both
    adapt their width depending on the current sessions.
---
 CHANGELOG.org       |   1 +
 README.md           |   2 +-
 dtache.el           | 121 ++++++++++++++++++++++++++++++++++------------------
 test/dtache-test.el |  20 ++-------
 4 files changed, 84 insertions(+), 60 deletions(-)

diff --git a/CHANGELOG.org b/CHANGELOG.org
index ef5445e109..14dbcc7d8f 100644
--- a/CHANGELOG.org
+++ b/CHANGELOG.org
@@ -3,6 +3,7 @@
 #+language: en
 
 *   Development
+- Make completion of sessions adapt to the current dtache sessions. All of the 
sessions will be used to determine an an appropriate width for the command 
width as well as each individual annotation. Format has updated in 
=dtache-annotation-format= and a =dtache-command-format= has been added, this 
supersedes the =dtache-max-command-lenght=.
 - Improvements to =dtache-env=. The package will now control which mode 
=dtache-env= should be run in. The mode is either =plain-text= or 
=terminal-data=. The latter is enabled by default and allows =dtache= to 
capture control sequences for e.g. colored output. This update will require 
users to update their =dtache-env= scripts.
 - Add integration with =dired= through =dired-do-shell-command=
 - Add option to show a session's output when attaching to a it. This feature 
is enabled with =dtache-show-output-on-attach=.
diff --git a/README.md b/README.md
index 88965be043..70333f515c 100644
--- a/README.md
+++ b/README.md
@@ -238,7 +238,7 @@ The package provides the following customizable variables.
 | dtache-timer-configuration         | Configuration of the timer that runs on 
remote hosts                      |
 | dtache-env                         | Name or path to the `dtache-env` script 
                                  |
 | dtache-annotation-format           | A list of annotations that should be 
present in completion                |
-| dtache-max-command-length          | How many characters should be used when 
displaying a command              |
+| dtache-command-format              | A configuration for displaying a 
session command                          |
 | dtache-tail-interval               | How often `dtache` should refresh the 
output when tailing                 |
 | dtache-nonattachable-commands      | A list of commands that should be 
considered nonattachable                |
 | dtache-notification-function       | Specifies which function to issue 
notifications with                      |
diff --git a/dtache.el b/dtache.el
index 5937006d42..93befbca6a 100644
--- a/dtache.el
+++ b/dtache.el
@@ -98,20 +98,21 @@
   :group 'dtache)
 
 (defcustom dtache-annotation-format
-  '((:width 3 :function dtache--state-str :face dtache-state-face)
-    (:width 3 :function dtache--status-str :face dtache-failure-face)
-    (:width 10 :function dtache--host-str :face dtache-host-face)
-    (:width 40 :function dtache--working-dir-str :face dtache-working-dir-face)
-    (:width 30 :function dtache--metadata-str :face dtache-metadata-face)
-    (:width 10 :function dtache--duration-str :face dtache-duration-face)
-    (:width 8 :function dtache--size-str :face dtache-size-face)
-    (:width 12 :function dtache--creation-str :face dtache-creation-face))
+  '((:width 3 :padding 2 :function dtache--status-str :face 
dtache-failure-face)
+    (:width 3 :padding 4 :function dtache--state-str :face dtache-state-face)
+    (:width 10 :padding 4 :function dtache--host-str :face dtache-host-face)
+    (:width 40 :padding 4 :function dtache--working-dir-str :face 
dtache-working-dir-face)
+    (:width 40 :padding 4 :function dtache--metadata-str :face 
dtache-metadata-face)
+    (:width 10 :padding 4 :function dtache--duration-str :face 
dtache-duration-face)
+    (:width 8 :padding 4 :function dtache--size-str :face dtache-size-face)
+    (:width 12 :padding 4 :function dtache--creation-str :face 
dtache-creation-face))
   "The format of the annotations."
   :type '(repeat symbol)
   :group 'dtache)
 
-(defcustom dtache-max-command-length 90
-  "Maximum length of displayed command."
+(defcustom dtache-command-format
+  '(:width 50 :padding 4 :function dtache--command-str)
+  "The format for displaying the command."
   :type 'integer
   :group 'dtache)
 
@@ -260,6 +261,8 @@ This version is encoded as [package-version].[revision].")
 (make-variable-buffer-local 'dtache--buffer-session)
 (defvar dtache--session-candidates nil
   "An alist of session candidates.")
+(defvar dtache--annotation-widths nil
+  "An alist of widths to use for annotation.")
 
 (defconst dtache--shell-command-buffer "*Dtache Shell Command*"
   "Name of the `dtache-shell-command' buffer.")
@@ -331,7 +334,7 @@ Optionally SUPPRESS-OUTPUT if prefix-argument is provided."
    (list (dtache-completing-read (dtache-get-sessions))))
   (when (dtache-valid-session session)
     (if (eq 'active (dtache--session-state session))
-        (dtache-tail-session session)
+        (dtache-attach-session session)
       (if-let ((view-fun (plist-get (dtache--session-action session) :view)))
           (funcall view-fun session)
         (dtache-view-dwim session)))))
@@ -631,16 +634,26 @@ Optionally SUPPRESS-OUTPUT."
 
 (defun dtache-session-candidates (sessions)
   "Return an alist of SESSIONS candidates."
-  (setq dtache--session-candidates
-        (thread-last sessions
-                     (seq-map (lambda (it)
-                                `(,(dtache--session-truncate-command it)
-                                  . ,it)))
-                     (dtache--session-deduplicate)
-                     (seq-map (lambda (it)
-                                ;; Max width is the ... padding + width of 
identifier
-                                (setcar it (truncate-string-to-width (car it) 
(+ 3 6 dtache-max-command-length) 0 ?\s))
-                                it)))))
+  (when sessions
+    (setq dtache--annotation-widths
+          (dtache--annotation-widths sessions dtache-annotation-format))
+    (let ((command-length
+           (thread-last sessions
+                        (seq-map #'dtache--session-command)
+                        (seq-map #'length)
+                        (seq-max)
+                        (min (plist-get dtache-command-format ':width)))))
+      (let ((command-fun (plist-get dtache-command-format ':function)))
+        (setq dtache--session-candidates
+              (thread-last sessions
+                           (seq-map (lambda (it)
+                                      `(,(apply command-fun `(,it 
,command-length))
+                                        . ,it)))
+                           (dtache--session-deduplicate)
+                           (seq-map (lambda (it)
+                                      `(,(concat (car it)
+                                                 (make-string (plist-get 
dtache-command-format :padding) ?\s))
+                                        . ,(cdr it))))))))))
 
 (defun dtache-session-annotation (item)
   "Associate ITEM to a session and return ts annotation."
@@ -648,12 +661,32 @@ Optionally SUPPRESS-OUTPUT."
     (mapconcat
      #'identity
      (cl-loop for annotation in dtache-annotation-format
-              collect (let ((str (funcall (plist-get annotation :function) 
session)))
-                        (truncate-string-to-width
-                         (propertize str 'face (plist-get annotation :face))
-                         (plist-get annotation :width)
-                         0 ?\s)))
-     "   ")))
+              collect (let ((str (funcall (plist-get annotation :function) 
session))
+                            (width (alist-get (plist-get annotation :function) 
dtache--annotation-widths)))
+                        (when (> width 0)
+                          (concat
+                           (truncate-string-to-width
+                            (propertize str 'face (plist-get annotation :face))
+                            width
+                            0 ?\s)
+                           (make-string (plist-get annotation :padding) ?\s)
+                           ))))
+     "")))
+
+(defun dtache--annotation-widths (sessions annotation-format)
+  "Return widths for ANNOTATION-FORMAT based on SESSIONS."
+  (seq-map (lambda (it) (dtache--annotation-width sessions it)) 
annotation-format))
+
+(defun dtache--annotation-width (sessions annotation)
+  "Determine width for ANNOTATION based on SESSIONS."
+  (let ((annotation-fun (plist-get annotation ':function))
+        (width (plist-get annotation ':width)))
+    `(,annotation-fun .
+                      ,(thread-last sessions
+                                    (seq-map annotation-fun)
+                                    (seq-map #'length)
+                                    (seq-max)
+                                    (min width)))))
 
 ;;;###autoload
 (defun dtache-setup ()
@@ -889,16 +922,6 @@ Optionally CONCAT the command return command into a 
string."
         (buffer-string))
       "\n" t))))
 
-(defun dtache--session-truncate-command (session)
-  "Return a truncated string representation of SESSION's command."
-  (let ((command (dtache--session-command session)))
-    (if (<= (length command) dtache-max-command-length)
-        command
-      (concat
-       (substring command 0 (/ dtache-max-command-length 2))
-       "..."
-       (substring command (- (length command) (/ dtache-max-command-length 2)) 
(length command))))))
-
 (defun dtache--determine-session-state (session)
   "Return t if SESSION is active."
   (if (file-exists-p
@@ -937,7 +960,14 @@ Optionally CONCAT the command return command into a 
string."
 (defun dtache--session-deduplicate (sessions)
   "Make car of SESSIONS unique by adding an identifier to it."
   (let* ((ht (make-hash-table :test #'equal :size (length sessions)))
-         (identifier-width 6)
+         (occurences
+          (thread-last sessions
+                       (seq-group-by #'car)
+                       (seq-map (lambda (it) (seq-length (cdr it))))
+                       (seq-max)))
+         (identifier-width (if (> occurences 1)
+                               (+ (length (number-to-string occurences)) 3)
+                             0))
          (reverse-sessions (seq-reverse sessions)))
     (dolist (session reverse-sessions)
       (if-let (count (gethash (car session) ht))
@@ -1244,6 +1274,13 @@ If event is cased by an update to the `dtache' database, 
re-initialize
 
 ;;;;; UI
 
+(defun dtache--command-str (session max-length)
+  "Return SESSION's command as a string restrict it to MAX-LENGTH."
+  (let ((command (dtache--session-command session)))
+    (if (<= (length command) max-length)
+        command
+      (concat (substring (dtache--session-command session) 0 (- max-length 3)) 
"..."))))
+
 (defun dtache--metadata-str (session)
   "Return SESSION's metadata as a string."
   (string-join
@@ -1252,7 +1289,7 @@ If event is cased by an update to the `dtache' database, 
re-initialize
                 (seq-map
                  (lambda (it)
                    (concat (symbol-name (car it)) ": " (cdr it)))))
-   " "))
+   ""))
 
 (defun dtache--duration-str (session)
   "Return SESSION's duration time."
@@ -1286,14 +1323,14 @@ If event is cased by an update to the `dtache' 
database, re-initialize
   "Return string if SESSION has failed."
   (pcase (car (dtache--session-status session))
     ('failure "!")
-    ('success " ")
-    ('unknown " ")))
+    ('success "")
+    ('unknown "")))
 
 (defun dtache--state-str (session)
   "Return string based on SESSION state."
   (if (eq 'active (dtache--session-state session))
       "*"
-    " "))
+    ""))
 
 (defun dtache--working-dir-str (session)
   "Return working directory of SESSION."
diff --git a/test/dtache-test.el b/test/dtache-test.el
index ea7bc48e42..5d1ad9ea47 100644
--- a/test/dtache-test.el
+++ b/test/dtache-test.el
@@ -132,20 +132,6 @@
     (should (string= "/ssh:foo:/home/user/tmp/s12345.log" 
(dtache--session-file session 'log)))
     (should (string= "/ssh:foo:/home/user/tmp/s12345.socket" 
(dtache--session-file session 'socket)))))
 
-(ert-deftest dtache-test-session-truncate-command ()
-  (let ((dtache-max-command-length 7))
-    (dtache--session-truncate-command
-     (dtache--session-create :command "12345678"))
-    (should (string= "123...678"
-                     (dtache--session-truncate-command
-                      (dtache--session-create :command "12345678")))))
-  (let ((dtache-max-command-length 2))
-    (dtache--session-truncate-command
-                      (dtache--session-create :command "12345678"))
-    (should (string= "1...8"
-                     (dtache--session-truncate-command
-                      (dtache--session-create :command "12345678"))))))
-
 (ert-deftest dtache-test-host ()
   (cl-letf (((symbol-function #'system-name) (lambda () "localhost")))
     (should (equal '("localhost" . local) (dtache--host))))
@@ -274,12 +260,12 @@
 
 (ert-deftest dtache-test-status-str ()
   (should (string= "!" (dtache--status-str (dtache--session-create :status 
'(failure . 127)))))
-  (should (string= " " (dtache--status-str (dtache--session-create :status 
'(success . 0)))))
-  (should (string= " " (dtache--status-str (dtache--session-create :status 
'(unknown . 0))))))
+  (should (string= "" (dtache--status-str (dtache--session-create :status 
'(success . 0)))))
+  (should (string= "" (dtache--status-str (dtache--session-create :status 
'(unknown . 0))))))
 
 (ert-deftest dtache-test-state-str ()
   (should (string= "*" (dtache--state-str (dtache--session-create :state 
'active))))
-  (should (string= " " (dtache--state-str (dtache--session-create :state 
'inactive)))))
+  (should (string= "" (dtache--state-str (dtache--session-create :state 
'inactive)))))
 
 (ert-deftest dtache-test-working-dir-str ()
   (should