annotations and sorting for activities-completing-read

README.org

@@ -135,6 +135,17 @@ Key bindings are, as always, ultimately up to the user.  However, in [[Configura
 
 When option ~activities-bookmark-store~ is enabled, an Emacs bookmark is stored when a new activity is made.  This allows the command ~bookmark-jump~ (~C-x r b~) to be used to resume an activity (helping to universalize the bookmark system).
 
+** Completion
+
+When selecting an activity in the minibuffer, if you are using an interface that supports /annotations/, additional information is shown alongside the activity name:
+
+- An ~@~ symbol for active activities,
+- The number of buffers and files the activity contains,
+- A color-coded age (elapsed time since the activity was last updated), and
+- A final ~*~ if the activity's list of buffers and files has been modified from its default state.
+
+The sort order when completing activities can be configured using ~activities-sort-by~.
+
 * FAQ
 
 + How is this different from [[https://github.com/alphapapa/burly.el][Burly.el]] or [[https://github.com/alphapapa/bufler.el/][Bufler.el]]? :: Burly is a well-polished tool for restoring window and frame configurations, which could be considered an incubator for some of the ideas furthered here.  Bufler's ~bufler-workspace~ library uses Burly to provide some similar functionality, which is at an exploratory stage.  ~activities~ hopes to provide a longer-term solution more suitable for integration into Emacs.
@@ -153,7 +164,11 @@ When option ~activities-bookmark-store~ is enabled, an Emacs bookmark is stored
 
 ** v0.8-pre
 
-Nothing new yet.
+*Additions*
++ New completion interface with rich annotations.  ([[https://github.com/alphapapa/activity.el/pull/83][#83]].  Thanks to [[https://github.com/jdtsmith][JD Smith]].)
+
+*Changes*
++ During save, the ~time~ slot for an activity remains unchanged unless its buffers or files differ from their last saved state.  ([[https://github.com/alphapapa/activity.el/pull/83][#83]].  Thanks to [[https://github.com/jdtsmith][JD Smith]].)
 
 ** v0.7.2
 

activities.el

@@ -66,6 +66,7 @@
 (require 'map)
 (require 'persist)
 (require 'subr-x)
+(require 'color)
 
 ;;;; Types
 
@@ -331,6 +332,27 @@ Kills buffers that have only been shown in that activity's
 frame/tab."
   :type 'boolean)
 
+(defcustom activities-sort-by #'activities-sort-by-active-age
+  "How to sort activities during selection.
+Function used to sort by when prompting for activities.  By
+default, a function is used which sorts active activities first,
+and then by age since modification.  A custom predicate function
+may also be set.  It should take two arguments, both activity
+names (strings), and return non-nil if the first activity should
+sort before the second."
+  :type `(choice (function-item :tag "Active state and age"
+				:doc "Sort by active state and age."
+				,#'activities-sort-by-active-age)
+		 (function :tag "Custom predicate")))
+
+(defcustom activities-annotation-colors '("blue" "red" 0.65)
+  "Colors to use for annotating activity age.
+A list (OLD-COLOR NEW-COLOR ALPHA).  Activity color is based on
+the activity's age, varying between OLD-COLOR and NEW-COLOR, and
+blended with fraction ALPHA into the default foreground."
+  :type '(list (color :tag "Old Color") (color :tag "New Color")
+	       (float :tag "Blend Fraction")))
+
 ;;;; Commands
 
 ;;;###autoload
@@ -502,6 +524,45 @@ To be called from `kill-emacs-hook'."
 
 ;;;; Functions
 
+(defun activities--mapcar-window-state-leafs (state func)
+  "Return a list of leaf node values from window-state STATE.
+The returned list contains the values obtained by calling FUNC on
+each of the leaf nodes in STATE."
+  (let (values)
+    (cl-labels ((map-leafs (state func)
+		  (pcase state
+		    (`(leaf . ,_attrs)
+		     (push (funcall func state) values))
+		    ((pred proper-list-p)
+		     (if-let ((leaf-pos (cl-position 'leaf state)))
+			 (push (funcall func (cl-subseq state leaf-pos)) values)
+		       (dolist (s state) (map-leafs s func)))))))
+      (map-leafs state func))
+    (nreverse values)))
+
+(defun activities--buffers-and-files (state)
+  "Return a list of buffers and files from STATE.
+STATE is a window-state.  The returned list contains elements of
+form (BUFFER . FILE) associated with the activity."
+  (activities--mapcar-window-state-leafs
+   (activities-activity-state-window-state state)
+   (lambda (leaf)
+     (let ((buffer-rec (map-nested-elt (cdr leaf)
+				       '(parameters activities-buffer))))
+       (cons (activities-buffer-name buffer-rec)
+	     (activities-buffer-filename buffer-rec))))))
+
+(defun activities--buffers-and-files-differ-p (bfa bfb)
+  "Return non-nil if BFA and BFB are not the same set of files or buffers.
+Each of BFA and BFB is a list of buffer and files, as returned
+from `activities--buffers-and-files'."
+  (cl-labels ((file-or-buffer (cell)
+		"Given a CELL, return the true filename or buffer.
+The CELL is a (BUFFER . FILE) cons.  If the file is nil, BUFFER is returned."
+		(if (cdr cell) (file-truename (cdr cell)) (car cell))))
+    (not (seq-set-equal-p (mapcar #'file-or-buffer bfa)
+			  (mapcar #'file-or-buffer bfb)))))
+
 (cl-defun activities-save (activity &key defaultp lastp persistp)
   "Save states of ACTIVITY.
 If DEFAULTP, save its default state; if LASTP, its last.  If
@@ -512,6 +573,12 @@ according to option `activities-always-persist', which see)."
       (unless (run-hook-with-args-until-success 'activities-anti-save-predicates)
         (pcase-let* (((cl-struct activities-activity default last) activity)
                      (new-state (activities-state)))
+	  (when (and lastp last
+		     (not (activities--buffers-and-files-differ-p
+			   (activities--buffers-and-files last)
+			   (activities--buffers-and-files new-state))))
+	    (setf (map-elt (activities-activity-state-etc new-state) 'time)
+		  (map-elt (activities-activity-state-etc last) 'time)))
           (setf (activities-activity-default activity) (if (or defaultp (not default)) new-state default)
                 (activities-activity-last activity) (if (or lastp (not last)) new-state last)))))
     ;; Always set the value so, e.g. the activity can be modified
@@ -803,6 +870,60 @@ activity's name is NAME."
                   "In the meantime, it's recommended to not use buffers of this major mode in an activity's layout; or you may simply ignore this error and use the other buffers in the activity.")
           (current-buffer)))))
 
+(defvar activities--age-spec
+  `((?Y "year"   "years"   ,(round (* 60 60 24 365.2425)))
+    (?M "month"  "months"  ,(round (* 60 60 24 30.436875)))
+    (?w "week"   "weeks"   ,(* 60 60 24 7))
+    (?d "day"    "days"    ,(* 60 60 24))
+    (?h "hour"   "hours"   ,(* 60 60))
+    (?m "min"    "mins"    60)
+    (?s "sec"    "secs"    1))
+  "Age specification.  See `magit--age-spec', which this duplicates.")
+
+(defun activities--age (age &optional abbrev)
+  "Summarize AGE.
+Abbreviate the units if ABBREV is non-nil."
+  ;; Based orginally on `magit--age'."
+  ;; TODO: replace this if seconds-to-string adds READABLE support; see bug#71572
+  (let ((half t)
+	(age-spec activities--age-spec)
+	age-unit cnt)
+    (if (= (round age (if half 0.5 1.)) 0)
+	(format "0%s" (if abbrev "s" " seconds"))
+      (while (and (setq age-unit (pop age-spec)) age-spec
+                  (< (/ age (nth 3 age-unit)) 1)))
+      (setq cnt (round (/ (float age) (nth 3 age-unit)) (if half 0.5 1.)))
+      (concat (let ((c (if half (/ cnt 2) cnt)))
+		(and (> c 0) (number-to-string c)))
+	      (and half (= (mod cnt 2) 1) "½")
+	      (or abbrev " ")
+	      (cond (abbrev (car age-unit))
+		    ((<= cnt (if half 2 1)) (nth 1 age-unit))
+		    (t (nth 2 age-unit)))))))
+
+(defun activities--oldest-age (activities)
+  "Return the age in seconds of the oldest activity in ACTIVITIES."
+  (cl-loop for (_name . activity) in activities
+	   for state = (pcase-let (((cl-struct activities-activity default last) activity))
+			 (or last default))
+	   if state
+	   for etc = (activities-activity-state-etc state)
+	   maximize (float-time (time-since (map-elt etc 'time)))))
+
+(defun activities-sort-by-active-age (names)
+  "Return the list of activity NAMES sorted active first, then by age."
+  (cl-labels ((time-active-p (name)
+		(pcase-let* ((activity (map-elt activities-activities name))
+			     (active-p (activities-activity-active-p activity))
+			     ((cl-struct activities-activity last default) activity)
+			     (state (or last default))
+			     (time (map-elt (activities-activity-state-etc state) 'time)))
+		  (cons time active-p))))
+    (sort names (pcase-lambda ((app time-active-p `(,time-a . ,activep-a))
+			       (app time-active-p `(,time-b . ,activep-b)))
+		  (if (xor activep-a activep-b) activep-a
+		    (time-less-p time-b time-a))))))
+
 (cl-defun activities-completing-read
     (&key (activities activities-activities)
           (default (when (activities-current)
@@ -811,11 +932,64 @@ activity's name is NAME."
   "Return an activity read with completion from ACTIVITIES.
 PROMPT is passed to `completing-read' by way of `format-prompt',
 which see, with DEFAULT."
-  (let* ((prompt (format-prompt prompt default))
-         (names (activities-names activities))
-         (name (completing-read prompt names nil t nil 'activities-completing-read-history default)))
-    (or (map-elt activities-activities name)
-        (make-activities-activity :name name))))
+  (pcase-let*
+      ((names (activities-names activities))
+       (max-age (activities--oldest-age activities))
+       (`(,old-col ,new-col ,blend-frac) activities-annotation-colors)
+       (prompt (format-prompt prompt default)))
+    (cl-labels
+	((activity-annotation-function (name)
+	   "Add buffer and file count, age, active and changed status to activity NAME."
+	   (when-let ((activity (map-elt activities-activities name)))
+	     (let (activity-data)
+	       (dolist (type '(last default))
+		 (when-let ((state (cl-struct-slot-value 'activities-activity type activity)))
+		   (let* ((time (map-elt (activities-activity-state-etc state) 'time))
+			  (buffers-and-files (activities--buffers-and-files state)))
+		     (setf (alist-get type activity-data)
+			   (list (and time (float-time (time-since time))) buffers-and-files)))))
+	       (pcase-let*
+		   ((`(,default-age ,default-buffers-and-files) (map-elt activity-data 'default))
+		    (`(,last-age ,last-buffers-and-files) (map-elt activity-data 'last)) ;possibly nil
+		    (age (if last-age (min last-age default-age) default-age))
+		    (buffers-and-files (if last-age last-buffers-and-files default-buffers-and-files))
+		    (num-buffers (length buffers-and-files))
+		    (num-files (seq-count #'stringp (mapcar #'cdr buffers-and-files)))
+		    (dirtyp (when last-buffers-and-files
+			      (activities--buffers-and-files-differ-p
+			       last-buffers-and-files
+			       default-buffers-and-files)))
+		    (annotation (format "%s%s buf%s %s file%s "
+					(if (activities-activity-active-p activity)
+					    (propertize "@" 'face 'bold) " ")
+					(propertize (format "%2d" num-buffers) 'face 'success)
+					(if (= num-buffers 1) " " "s")
+					(propertize (format "%2d" num-files) 'face 'warning)
+					(if (= num-files 1) " " "s")))
+		    (age-color  (apply #'color-rgb-to-hex
+				       (cl-loop for co in (color-name-to-rgb old-col)
+						for cn in (color-name-to-rgb new-col)
+						for cd in (color-name-to-rgb (face-foreground 'default))
+						collect (+ (* blend-frac (+ cn (* (- co cn) (/ age max-age))))
+							   (* (- 1. blend-frac) cd)))))
+		    (age-annotation (propertize
+				     (format "%10s" (activities--age age))
+				     'face `(:foreground ,age-color :weight bold)))
+		    (dirty-annotation (if dirtyp (propertize "*" 'face 'bold) " ")))
+		 (concat (propertize " " 'display
+				     `(space :align-to (- right ,(+ 1 (length annotation)
+								    (length age-annotation)))))
+			 annotation age-annotation dirty-annotation)))))
+	 (activity-table (str pred action)
+	   "Complete activities from STR, using completion PRED and ACTION."
+	   (if (eq action 'metadata)
+	       `(metadata (annotation-function . ,#'activity-annotation-function)
+			  (display-sort-function . ,activities-sort-by))
+	     (complete-with-action action names str pred))))
+      (let ((name (completing-read prompt #'activity-table nil t nil
+				   'activities-completing-read-history default)))
+	(or (map-elt activities-activities name)
+            (make-activities-activity :name name))))))
 
 (cl-defun activities-names (&optional (activities activities-activities))
   "Return list of names of ACTIVITIES."