[elpa] externals/dtache d32b5752d6 034/158: Implement new deduplication strategy

[ELPA Syncer]

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

    Implement new deduplication strategy
    
    This patch removes the invisible cookies that were previously added in
    order to disambiguate sessions that have the same command. The new
    approach is to add a numeric identifier after the command.
---
 dtache.el | 53 +++++++++++++++++++++++++++++++----------------------
 1 file changed, 31 insertions(+), 22 deletions(-)

diff --git a/dtache.el b/dtache.el
index e31c565795..81a9063237 100644
--- a/dtache.el
+++ b/dtache.el
@@ -384,7 +384,8 @@ nil before closing."
 (defun dtache-select-session ()
   "Return selected session."
   (dtache-update-sessions)
-  (dtache-completing-read dtache--sessions))
+  (let ((sessions dtache--sessions))
+    (dtache-completing-read sessions)))
 
 (defun dtache-update-sessions ()
   "Update `dtache' sessions.
@@ -420,12 +421,31 @@ Sessions running on  current host or localhost are 
updated."
 
 (defun dtache-session-candidates (sessions)
   "Return an alist of SESSIONS candidates."
-  (seq-map (lambda (it)
-             (let ((s (format #("%s\0%s" 2 5 (invisible t))
-                              (dtache--session-truncate-command  it)
-                              (dtache--session-short-id it))))
-               (prog1 s (put-text-property 0 1 'dtache--data it s))))
-           sessions))
+  (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))))
+
+(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)
+         (reverse-sessions (seq-reverse sessions)))
+    (dolist (session reverse-sessions)
+      (if-let (count (gethash (car session) ht))
+          (setcar session (format "%s%s" (car session)
+                                  (truncate-string-to-width
+                                   (propertize (format " (%s)" (puthash (car 
session) (1+ count) ht)) 'face 'dtache-identifier-face)
+                                   identifier-width 0 ?\s)))
+        (puthash (car session) 0 ht)
+        (setcar session (format "%s%s" (car session) (make-string 
identifier-width ?\s)))))
+    (seq-reverse reverse-sessions)))
+
 (defun dtache-session-annotation (session)
   "Return annotation string for SESSION."
   (mapconcat
@@ -682,14 +702,13 @@ Sessions running on  current host or localhost are 
updated."
 (defun dtache--session-truncate-command (session)
   "Return a truncated string representation of SESSION's command."
   (let ((command (dtache--session-command session))
-        (part-length (- dtache-max-command-length 3)))
+        (truncated-command))
     (if (<= (length command) dtache-max-command-length)
-        (let ((padding-length (- dtache-max-command-length (length command))))
-          (concat command (make-string padding-length ?\s)))
+        command
       (concat
-       (substring command 0 (/ part-length 2))
+       (substring command 0 (/ dtache-max-command-length 2))
        "..."
-       (substring command (- (length command) (/ part-length 2)) (length 
command))))))
+       (substring command (- (length command) (/ dtache-max-command-length 2)) 
(length command))))))
 
 (defun dtache--session-short-id (session)
   "Return the short representation of the SESSION's id."
@@ -825,16 +844,6 @@ Sessions running on  current host or localhost are 
updated."
     (when-let ((callback (dtache--session-callback-function session)))
       (funcall callback session))))
 
-(defun dtache--eat-cookie (&rest _)
-  "Eat the disambiguation cookie in the minibuffer."
-  (let* ((pos (minibuffer-prompt-end))
-         (max (point-max)))
-    (while (and (< pos max) (/= 0 (char-after pos)))
-      (setq pos (1+ pos)))
-    (when (< pos max)
-      (add-text-properties pos (next-property-change pos nil max)
-                           '(invisible t rear-nonsticky t)))))
-
 (defun dtache--kill-processes (pid)
   "Kill PID and all of its children."
   (let ((child-processes