branch: externals/activities
commit a4ce6ce854807fe284da41f6d5292edb26c7f983
Author: Adam Porter <[email protected]>
Commit: Adam Porter <[email protected]>
Tidy: Untabify
---
activities.el | 208 +++++++++++++++++++++++++++++-----------------------------
1 file changed, 104 insertions(+), 104 deletions(-)
diff --git a/activities.el b/activities.el
index 42a78ea32e..abb274456a 100644
--- a/activities.el
+++ b/activities.el
@@ -341,9 +341,9 @@ 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")))
+ :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.
@@ -351,7 +351,7 @@ 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")))
+ (float :tag "Blend Fraction")))
;;;; Commands
@@ -530,13 +530,13 @@ 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)))))))
+ (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)))
@@ -548,16 +548,16 @@ form (BUFFER . FILE) associated with the activity."
(activities-activity-state-window-state state)
(lambda (leaf)
(let ((buffer-rec (map-nested-elt (cdr leaf)
- '(parameters activities-buffer))))
+ '(parameters activities-buffer))))
(cons (activities-buffer-name buffer-rec)
- (activities-buffer-filename 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.
+ "Given a CELL, return the true filename or buffer.
If the file is a remote one, return its value as-is, not
necessarily its true name. The CELL is a (BUFFER . FILE) cons.
If the file is nil, BUFFER is returned."
@@ -568,7 +568,7 @@ If the file is nil, BUFFER is returned."
(file-truename file))
buffer))))
(not (seq-set-equal-p (mapcar #'file-or-buffer bfa)
- (mapcar #'file-or-buffer bfb)))))
+ (mapcar #'file-or-buffer bfb)))))
(cl-defun activities-save (activity &key defaultp lastp persistp)
"Save states of ACTIVITY.
@@ -580,12 +580,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)))
+ (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
@@ -716,14 +716,14 @@ activity's name is NAME."
;; function after handling the bookmark, we use an immediate timer to
;; set the window configuration.
(run-at-time nil nil
- (lambda (frame state)
- (let ((window-persistent-parameters
- (append activities-window-persistent-parameters
- window-persistent-parameters)))
- (window-state-put state (frame-root-window frame) 'safe)))
- (selected-frame)
- ;; NOTE: We copy the state so as not to mutate the one in
storage.
- (activities--bufferize-window-state (copy-tree state))))
+ (lambda (frame state)
+ (let ((window-persistent-parameters
+ (append activities-window-persistent-parameters
+ window-persistent-parameters)))
+ (window-state-put state (frame-root-window frame) 'safe)))
+ (selected-frame)
+ ;; NOTE: We copy the state so as not to mutate the one in
storage.
+ (activities--bufferize-window-state (copy-tree state))))
(defun activities--bufferize-window-state (state)
"Return window state STATE with its buffers reincarnated."
@@ -846,9 +846,9 @@ activity's name is NAME."
(activities--error-buffer
(format "%s:%s" (car bookmark) (bookmark-prop-get bookmark 'filename))
(list "Activities was unable to get a buffer for bookmark:\n\n"
- (prin1-to-string bookmark) "\n\n"
+ (prin1-to-string bookmark) "\n\n"
"Error: " (prin1-to-string error) "\n\n"
- "It's likely that the bookmark's file no longer exists, in which
case you may need to relocate it and redefine this activity.\n\n"
+ "It's likely that the bookmark's file no longer exists, in
which case you may need to relocate it and redefine this activity.\n\n"
"If this is not the case, please report this error to the
`activities' maintainer.\n\n"
"In the meantime, you may ignore this error and use the other
buffers in the activity.\n\n"))))))
@@ -893,43 +893,43 @@ 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)
+ (age-spec activities--age-spec)
+ age-unit cnt)
(if (= (round age (if half 0.5 1.)) 0)
- (format "0%s" (if abbrev "s" " seconds"))
+ (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)))))))
+ (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)))))
+ 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))))
+ (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))))))
+ (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)
@@ -945,57 +945,57 @@ which see, with DEFAULT."
(`(,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))))
+ ((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)
+ 'activities-completing-read-history
default)))
+ (or (map-elt activities-activities name)
(make-activities-activity :name name))))))
(cl-defun activities-names (&optional (activities activities-activities))
