[elpa] externals/detached f943404ee6 04/10: Add unique narrow criteria

[ELPA Syncer]

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

    Add unique narrow criteria
    
    This criteria makes it convenient to only show the most recent session
    if multiple sessions have the same string identifier. The identifier
    function is customizable in case the user has other ideas of what is a
    unique session.
---
 CHANGELOG.org    |  1 +
 detached-list.el | 33 +++++++++++++++++++++++++++++++++
 2 files changed, 34 insertions(+)

diff --git a/CHANGELOG.org b/CHANGELOG.org
index dfccbb8586..5372f0c51a 100644
--- a/CHANGELOG.org
+++ b/CHANGELOG.org
@@ -15,6 +15,7 @@
 - Add command for initializing a session directory
 - Add integration with =nano-modeline=
 - Add =detached-describe-session= command
+- Add unique narrow criteria
   
 * Version 0.9.1 (2022-09-22)
 
diff --git a/detached-list.el b/detached-list.el
index 9daed31d26..444e346707 100644
--- a/detached-list.el
+++ b/detached-list.el
@@ -69,6 +69,12 @@ detached list implements."
   :group 'detached
   :type '(alist :key-type string))
 
+(defcustom detached-list-session-identifier-function
+  #'detached-list-session-identifier
+  "The function to use for identifying a session."
+  :group 'detached
+  :type 'sexp)
+
 ;;;; Private
 
 (defvar detached-list--marked-sessions nil
@@ -98,6 +104,14 @@ detached list implements."
                        (propertize annotation 'face 
'detached-annotation-face)))))
         (string-join (seq-remove #'null strs) "\n")))))
 
+(defun detached-list-session-identifier (session)
+  "Return a string identifier for SESSION."
+  (string-join
+   `(,(detached--session-command session)
+     ,(detached--host-str session)
+     ,(detached--session-directory session))
+   ", "))
+
 ;;;; Commands
 
 (defun detached-list-initialize-session-directory (&optional all)
@@ -237,6 +251,24 @@ Optionally SUPPRESS-OUTPUT."
       (bury-buffer buffer))
     (detached-open-session session)))
 
+(defun detached-list-narrow-unique ()
+  "Narrow to unique sessions."
+  (interactive)
+  (when detached-list-session-identifier-function
+    (detached-list-narrow-sessions
+     `(,@detached-list--narrow-criteria
+       ("Unique" .
+        ,(lambda (sessions)
+           (thread-last sessions
+                        (seq-group-by 
detached-list-session-identifier-function)
+                        (seq-map (lambda (it)
+                                   (pcase-let ((`(,_identifier . 
,duplicate-sessions) it))
+                                     (car duplicate-sessions))))
+                        (seq-sort-by
+                         (lambda (it)
+                           (plist-get (detached--session-time it) :start))
+                         #'>))))))))
+
 (defun detached-list-narrow-after-time (time-threshold)
   "Narrow to session's created after TIME-THRESHOLD."
   (interactive
@@ -759,6 +791,7 @@ If prefix-argument is provided unmark instead of mark."
     (define-key map (kbd "n o") #'detached-list-narrow-origin)
     (define-key map (kbd "n r") #'detached-list-narrow-remote)
     (define-key map (kbd "n s") #'detached-list-narrow-success)
+    (define-key map (kbd "n u") #'detached-list-narrow-unique)
     (define-key map (kbd "n +") #'detached-list-narrow-after-time)
     (define-key map (kbd "n -") #'detached-list-narrow-before-time)
     (define-key map (kbd "n /") #'detached-list-narrow-output-regexp)