[feat] resurrect -format-duration as -format-duration-default

add support for procedure values to -duration-formats and -format-duration

elisp/chronometrist.el

@@ -80,23 +80,60 @@ file.")
   "Return the name of the currently clocked-in task, or nil if not clocked in."
   (chronometrist-sexp-current-task))
 
-(cl-defun chronometrist-format-duration (seconds &optional (blank (make-string 3 ?\s)))
-  "Format SECONDS as a string suitable for display in Chronometrist buffers.
+(defcustom chronometrist-duration-formats
+  `((chronometrist chronometrist-format-duration-default
+                   ,(concat (make-string 7 ?\s) "-"))
+    (chronometrist-total       chronometrist-format-duration-default
+                   ,(concat (make-string 6 ?\s) "-"))
+    (report        chronometrist-format-duration-default
+                   ,(concat (make-string 5 ?\s) "-"))
+    (report-total  chronometrist-format-duration-default
+                   ,(format "% 5s  " "-"))
+    (details       "%h:%.2m:%z%.2s"))
+  "List specifying duration formats.
+Each element must be in the form
+
+\(FIELD FORMAT-STRING [BLANK-STRING])
+
+FIELD should be a symbol unique to this list.
+
+FORMAT-STRING should be a string acceptable to `format-seconds',
+or a procedure of two arguments (SECONDS and BLANK-STRING)
+returning such a string.
+
+BLANK-STRING should be a string to be used if the given duration
+is zero.")
+
+(defun chronometrist-format-duration (seconds &optional field)
+  "Format SECONDS as a duration string.
 SECONDS must be a positive integer.
 
-BLANK is a string to display in place of blank values. If not
-supplied, 3 spaces are used."
-  (-let [(h m s) (chronometrist-seconds-to-hms seconds)]
-    (if (and (zerop h) (zerop m) (zerop s))
-        (concat (make-string 7 ?\s) "-")
-      (let ((h (if (zerop h) blank (format "%2d:" h)))
-            (m (cond ((and (zerop h) (zerop m))  blank)
-                     ((zerop h)  (format "%2d:" m))
-                     (t  (format "%02d:" m))))
-            (s (if (and (zerop h) (zerop m))
-                   (format "%2d" s)
-                 (format "%02d" s))))
-        (concat h m s)))))
+The format is specified by `chronometrist-duration-formats'.
+FIELD, if supplied, must be a symbol used to identify entries in
+the same."
+  (-let [(format-string blank-string)
+         (alist-get (or field 'chronometrist)
+                    chronometrist-duration-formats)]
+    (cond ((and (zerop seconds) blank-string)
+           blank-string)
+          ((stringp format-string)
+           (format-seconds format-string seconds))
+          ((functionp format-string)
+           (funcall format-string seconds)))))
+
+(defun chronometrist-format-duration-default (seconds)
+  (-let* (((h m s) (chronometrist-seconds-to-hms seconds))
+          (blank   (make-string 3 ?\s)))
+    (let ((h (if (zerop h) blank (format "%2d:" h)))
+          (m (cond ((and (zerop h) (zerop m))
+                    blank)
+                   ((zerop h)
+                    (format "%2d:" m))
+                   (t (format "%02d:" m))))
+          (s (if (and (zerop h) (zerop m))
+                 (format "%2d" s)
+               (format "%02d" s))))
+      (concat h m s))))
 
 (defun chronometrist-common-file-empty-p (file)
   "Return t if FILE is empty."
@@ -938,23 +975,6 @@ EVENT should be a plist (see `chronometrist-file')."
     (time-subtract (parse-iso8601-time-string stop)
                    (parse-iso8601-time-string start))))
 
-(defun chronometrist-format-duration-long (seconds)
-  "Return SECONDS as a human-friendly duration string.
-e.g. \"2 hours, 10 minutes\". SECONDS must be an integer. If
-SECONDS is less than 60, return a blank string."
-  (let* ((hours         (/ seconds 60 60))
-         (minutes       (% (/ seconds 60) 60))
-         (hour-string   (if (= 1 hours) "hour" "hours"))
-         (minute-string (if (= 1 minutes) "minute" "minutes")))
-    (cond ((and (zerop hours) (zerop minutes)) "")
-          ((zerop hours)
-           (format "%s %s" minutes minute-string))
-          ((zerop minutes)
-           (format "%s %s" hours hour-string))
-          (t (format "%s %s, %s %s"
-                     hours hour-string
-                     minutes minute-string)))))
-
 (defcustom chronometrist-update-interval 5
   "How often the `chronometrist' buffer should be updated, in seconds.
 
@@ -1072,7 +1092,10 @@ Return the value returned by Fₙ."
     arg))
 
 (defcustom chronometrist-schema
-  '[("#" 3 t) ("Task" 25 t) ("Time" 10 t) ("Active" 10 t)]
+  '[("#" 3 t)
+    ("Task" 25 t)
+    ("Time" 10 t :right-align t)
+    ("Active" 10 t :right-align t)]
   "Vector specifying schema of `chronometrist' buffer.
 See `tabulated-list-format'."
   :type '(vector))
@@ -1168,11 +1191,12 @@ is the name of the task to be clocked out of."
 (defun chronometrist-print-non-tabular ()
   "Print the non-tabular part of the buffer in `chronometrist'."
   (with-current-buffer chronometrist-buffer-name
-    (let ((inhibit-read-only t) (w "\n    "))
+    (let ((inhibit-read-only t)
+          (w "\n    "))
       (goto-char (point-max))
       (--> (chronometrist-active-time-one-day)
-           (chronometrist-format-duration it)
-           (format "%s%- 26s%s" w "Total" it)
+           (chronometrist-format-duration it 'chronometrist-total)
+           (format "%s%- 29s%s" w "Total" it)
            (insert it)))))
 
 (defun chronometrist-goto-nth-task (n)
@@ -1532,6 +1556,20 @@ The first date is the first occurrence of
        (chronometrist-previous-week-start)
        (chronometrist-report-date-to-dates-in-week)))
 
+(defcustom chronometrist-report-schema
+  '[("Task" 25 t)
+    ("Sunday" 10 t :right-align t)
+    ("Monday" 10 t :right-align t)
+    ("Tuesday" 10 t :right-align t)
+    ("Wednesday" 10 t :right-align t)
+    ("Thursday" 10 t :right-align t)
+    ("Friday" 10 t :right-align t)
+    ("Saturday" 10 t :right-align t :pad-right 5)
+    ("Total" 12 t :right-align t)]
+  "Vector specifying schema of `chronometrist-report' buffer.
+See `tabulated-list-format'."
+  :type '(vector))
+
 (defun chronometrist-report-rows ()
   "Return rows to be displayed in the `chronometrist-report' buffer."
   (cl-loop
@@ -1541,10 +1579,11 @@ The first date is the first occurrence of
     for task in chronometrist-task-list collect
     (let* ((durations        (--map (chronometrist-task-time-one-day task (chronometrist-date it))
                                     week-dates))
-           (duration-strings (mapcar #'chronometrist-format-duration durations))
-           (total-duration   (->> (-reduce #'+ durations)
-                                  (chronometrist-format-duration)
-                                  (vector))))
+           (duration-strings (--map (chronometrist-format-duration it 'report)
+                                    durations))
+           (total-duration   (--> (-reduce #'+ durations)
+                                  (chronometrist-format-duration it 'report)
+                                  (vector it))))
       (list task
             (vconcat
              (vector task)
@@ -1631,15 +1670,7 @@ Argument _FS-EVENT is ignored."
 (define-derived-mode chronometrist-report-mode tabulated-list-mode "Chronometrist-Report"
   "Major mode for `chronometrist-report'."
   (make-local-variable 'tabulated-list-format)
-  (setq tabulated-list-format [("Task"   25 t)
-                               ("Sunday"    10 t)
-                               ("Monday"    10 t)
-                               ("Tuesday"   10 t)
-                               ("Wednesday" 10 t)
-                               ("Thursday"  10 t)
-                               ("Friday"    10 t)
-                               ("Saturday"  10 t :pad-right 5)
-                               ("Total"     12 t)])
+  (setq tabulated-list-format chronometrist-report-schema)
   (make-local-variable 'tabulated-list-entries)
   (setq tabulated-list-entries 'chronometrist-report-rows)
   (make-local-variable 'tabulated-list-sort-key)
@@ -2062,7 +2093,7 @@ Return value is a list as specified by `tabulated-list-entries'."
                                            (ts-now))))
             (interval      (floor (ts-diff stop start)))
             (index-string  (format "%s" index))
-            (duration      (chronometrist-format-duration-long interval))
+            (duration      (chronometrist-format-duration interval 'details))
             (timespan (format "from %s to %s"
                               (ts-format chronometrist-details-time-format-string
                                          start)

elisp/chronometrist.org

@@ -425,25 +425,67 @@ file.")
   "Return the name of the currently clocked-in task, or nil if not clocked in."
   (chronometrist-sexp-current-task))
 #+END_SRC
-*** format-time                                                  :function:
+*** duration-formats                                             :function:
 #+BEGIN_SRC emacs-lisp
-(cl-defun chronometrist-format-duration (seconds &optional (blank (make-string 3 ?\s)))
-  "Format SECONDS as a string suitable for display in Chronometrist buffers.
+(defcustom chronometrist-duration-formats
+  `((chronometrist chronometrist-format-duration-default
+                   ,(concat (make-string 7 ?\s) "-"))
+    (chronometrist-total       chronometrist-format-duration-default
+                   ,(concat (make-string 6 ?\s) "-"))
+    (report        chronometrist-format-duration-default
+                   ,(concat (make-string 5 ?\s) "-"))
+    (report-total  chronometrist-format-duration-default
+                   ,(format "% 5s  " "-"))
+    (details       "%h:%.2m:%z%.2s"))
+  "List specifying duration formats.
+Each element must be in the form
+
+\(FIELD FORMAT-STRING [BLANK-STRING])
+
+FIELD should be a symbol unique to this list.
+
+FORMAT-STRING should be a string acceptable to `format-seconds',
+or a procedure of two arguments (SECONDS and BLANK-STRING)
+returning such a string.
+
+BLANK-STRING should be a string to be used if the given duration
+is zero.")
+
+#+END_SRC
+*** format-duration                                              :function:
+#+BEGIN_SRC emacs-lisp
+(defun chronometrist-format-duration (seconds &optional field)
+  "Format SECONDS as a duration string.
 SECONDS must be a positive integer.
 
-BLANK is a string to display in place of blank values. If not
-supplied, 3 spaces are used."
-  (-let [(h m s) (chronometrist-seconds-to-hms seconds)]
-    (if (and (zerop h) (zerop m) (zerop s))
-        (concat (make-string 7 ?\s) "-")
-      (let ((h (if (zerop h) blank (format "%2d:" h)))
-            (m (cond ((and (zerop h) (zerop m))  blank)
-                     ((zerop h)  (format "%2d:" m))
-                     (t  (format "%02d:" m))))
-            (s (if (and (zerop h) (zerop m))
-                   (format "%2d" s)
-                 (format "%02d" s))))
-        (concat h m s)))))
+The format is specified by `chronometrist-duration-formats'.
+FIELD, if supplied, must be a symbol used to identify entries in
+the same."
+  (-let [(format-string blank-string)
+         (alist-get (or field 'chronometrist)
+                    chronometrist-duration-formats)]
+    (cond ((and (zerop seconds) blank-string)
+           blank-string)
+          ((stringp format-string)
+           (format-seconds format-string seconds))
+          ((functionp format-string)
+           (funcall format-string seconds)))))
+#+END_SRC
+*** format-duration-default                                      :function:
+#+BEGIN_SRC emacs-lisp
+(defun chronometrist-format-duration-default (seconds)
+  (-let* (((h m s) (chronometrist-seconds-to-hms seconds))
+          (blank   (make-string 3 ?\s)))
+    (let ((h (if (zerop h) blank (format "%2d:" h)))
+          (m (cond ((and (zerop h) (zerop m))
+                    blank)
+                   ((zerop h)
+                    (format "%2d:" m))
+                   (t (format "%02d:" m))))
+          (s (if (and (zerop h) (zerop m))
+                 (format "%2d" s)
+               (format "%02d" s))))
+      (concat h m s))))
 #+END_SRC
 *** file-empty-p                                                   :reader:
 #+BEGIN_SRC emacs-lisp
@@ -1886,40 +1928,6 @@ EVENT should be a plist (see `chronometrist-file')."
     (time-subtract (parse-iso8601-time-string stop)
                    (parse-iso8601-time-string start))))
 #+END_SRC
-*** format-duration-long                                         :function:
-#+BEGIN_SRC emacs-lisp
-(defun chronometrist-format-duration-long (seconds)
-  "Return SECONDS as a human-friendly duration string.
-e.g. \"2 hours, 10 minutes\". SECONDS must be an integer. If
-SECONDS is less than 60, return a blank string."
-  (let* ((hours         (/ seconds 60 60))
-         (minutes       (% (/ seconds 60) 60))
-         (hour-string   (if (= 1 hours) "hour" "hours"))
-         (minute-string (if (= 1 minutes) "minute" "minutes")))
-    (cond ((and (zerop hours) (zerop minutes)) "")
-          ((zerop hours)
-           (format "%s %s" minutes minute-string))
-          ((zerop minutes)
-           (format "%s %s" hours hour-string))
-          (t (format "%s %s, %s %s"
-                     hours hour-string
-                     minutes minute-string)))))
-#+END_SRC
-**** tests
-#+BEGIN_SRC emacs-lisp :tangle ../tests/chronometrist-tests.el :load test
-(ert-deftest chronometrist-format-duration-long ()
-  (should (equal (chronometrist-format-duration-long 5) ""))
-  (should (equal (chronometrist-format-duration-long 65) "1 minute"))
-  (should (equal (chronometrist-format-duration-long 125) "2 minutes"))
-
-  (should (equal (chronometrist-format-duration-long 3605) "1 hour"))
-  (should (equal (chronometrist-format-duration-long 3660) "1 hour, 1 minute"))
-  (should (equal (chronometrist-format-duration-long 3725) "1 hour, 2 minutes"))
-
-  (should (equal (chronometrist-format-duration-long 7200) "2 hours"))
-  (should (equal (chronometrist-format-duration-long 7260) "2 hours, 1 minute"))
-  (should (equal (chronometrist-format-duration-long 7320) "2 hours, 2 minutes")))
-#+END_SRC
 ** Timer
 Instead of the Emacs convention of pressing ~g~ to update, we keep buffers updated with a timer.
 
@@ -2097,7 +2105,10 @@ Return the value returned by Fₙ."
 
 #+BEGIN_SRC emacs-lisp
 (defcustom chronometrist-schema
-  '[("#" 3 t) ("Task" 25 t) ("Time" 10 t) ("Active" 10 t)]
+  '[("#" 3 t)
+    ("Task" 25 t)
+    ("Time" 10 t :right-align t)
+    ("Active" 10 t :right-align t)]
   "Vector specifying schema of `chronometrist' buffer.
 See `tabulated-list-format'."
   :type '(vector))
@@ -2217,11 +2228,11 @@ is the name of the task to be clocked out of."
 (defun chronometrist-print-non-tabular ()
   "Print the non-tabular part of the buffer in `chronometrist'."
   (with-current-buffer chronometrist-buffer-name
-    (let ((inhibit-read-only t) (w "\n    "))
+    (let ((inhibit-read-only t))
       (goto-char (point-max))
       (--> (chronometrist-active-time-one-day)
-           (chronometrist-format-duration it)
-           (format "%s%- 26s%s" w "Total" it)
+           (chronometrist-format-duration it 'chronometrist-total)
+           (format "\n%s%- 29s% 7s" (make-string 4 ?\s) "Total" it)
            (insert it)))))
 #+END_SRC
 **** goto-nth-task                                             :procedure:
@@ -2638,6 +2649,22 @@ The first date is the first occurrence of
        (chronometrist-previous-week-start)
        (chronometrist-report-date-to-dates-in-week)))
 #+END_SRC
+**** schema                                              :custom:variable:
+#+BEGIN_SRC emacs-lisp
+(defcustom chronometrist-report-schema
+  '[("Task" 25 t)
+    ("Sunday" 10 t :right-align t)
+    ("Monday" 10 t :right-align t)
+    ("Tuesday" 10 t :right-align t)
+    ("Wednesday" 10 t :right-align t)
+    ("Thursday" 10 t :right-align t)
+    ("Friday" 10 t :right-align t)
+    ("Saturday" 10 t :right-align t :pad-right 5)
+    ("Total" 12 t :right-align t)]
+  "Vector specifying schema of `chronometrist-report' buffer.
+See `tabulated-list-format'."
+  :type '(vector))
+#+END_SRC
 **** rows                                                      :procedure:
 #+BEGIN_SRC emacs-lisp
 (defun chronometrist-report-rows ()
@@ -2649,10 +2676,11 @@ The first date is the first occurrence of
     for task in chronometrist-task-list collect
     (let* ((durations        (--map (chronometrist-task-time-one-day task (chronometrist-date it))
                                     week-dates))
-           (duration-strings (mapcar #'chronometrist-format-duration durations))
-           (total-duration   (->> (-reduce #'+ durations)
-                                  (chronometrist-format-duration)
-                                  (vector))))
+           (duration-strings (--map (chronometrist-format-duration it 'report)
+                                    durations))
+           (total-duration   (--> (-reduce #'+ durations)
+                                  (chronometrist-format-duration it 'report)
+                                  (vector it))))
       (list task
             (vconcat
              (vector task)
@@ -2753,15 +2781,7 @@ Argument _FS-EVENT is ignored."
 (define-derived-mode chronometrist-report-mode tabulated-list-mode "Chronometrist-Report"
   "Major mode for `chronometrist-report'."
   (make-local-variable 'tabulated-list-format)
-  (setq tabulated-list-format [("Task"   25 t)
-                               ("Sunday"    10 t)
-                               ("Monday"    10 t)
-                               ("Tuesday"   10 t)
-                               ("Wednesday" 10 t)
-                               ("Thursday"  10 t)
-                               ("Friday"    10 t)
-                               ("Saturday"  10 t :pad-right 5)
-                               ("Total"     12 t)])
+  (setq tabulated-list-format chronometrist-report-schema)
   (make-local-variable 'tabulated-list-entries)
   (setq tabulated-list-entries 'chronometrist-report-rows)
   (make-local-variable 'tabulated-list-sort-key)
@@ -3293,7 +3313,7 @@ Return value is a list as specified by `tabulated-list-entries'."
                                            (ts-now))))
             (interval      (floor (ts-diff stop start)))
             (index-string  (format "%s" index))
-            (duration      (chronometrist-format-duration-long interval))
+            (duration      (chronometrist-format-duration interval 'details))
             (timespan (format "from %s to %s"
                               (ts-format chronometrist-details-time-format-string
                                          start)