rethink output format - use tabulated-list-mode
This commit is contained in:
parent
2480d26f91
commit
3819b2e0de
5
TODO.org
5
TODO.org
|
@ -429,7 +429,6 @@ Ensure that the user manual is easily discoverable.
|
|||
#+END_QUOTE
|
||||
* macro for extensions :code:extension:
|
||||
<2021-06-07T16:33:54+0530>
|
||||
|
||||
A macro to create new columns for Chronometrist.
|
||||
|
||||
Extension writer specifies
|
||||
|
@ -452,6 +451,10 @@ Benefits -
|
|||
+ easier creation of such extensions
|
||||
+ users can easily replace the function used to generate the cells, without having to deal with how the string is inserted into the row specifier.
|
||||
|
||||
Current uses -
|
||||
1. =chronometrist-goal=
|
||||
2. =chronometrist-spark=
|
||||
|
||||
* unified format-duration function :code:customization:
|
||||
<2021-06-08T11:17:54+0530>
|
||||
|
||||
|
|
|
@ -105,30 +105,86 @@ SCHEMA should be a vector as specified by `tabulated-list-format'."
|
|||
(defun chronometrist-task-durations-month (task iso-year-month)
|
||||
(let* ((start-ts (chronometrist-iso-date-to-ts (concat iso-year-month "-01")))
|
||||
;; last date of month
|
||||
(stop-ts (ts-adjust 'month 1 'day -1 start-ts))
|
||||
(start-dow (ts-dow start-ts))
|
||||
(stop-dow (ts-dow stop-ts)))
|
||||
(stop-ts (ts-adjust 'month 1 'day -1 start-ts)))
|
||||
(cl-loop with current = start-ts
|
||||
while (not (ts> current stop-ts))
|
||||
collect
|
||||
(cl-loop
|
||||
with row with complete-p
|
||||
;; pad with nils if not starting from Sunday
|
||||
initially ;; could be moved to the outer loop? 🤔
|
||||
(when (and (ts= current start-ts)
|
||||
(not (zerop start-dow)))
|
||||
(setq row (make-list start-dow nil)))
|
||||
while (and (not complete-p) (ts<= current stop-ts))
|
||||
;; do (message (ts-format "%a, %d %h %Y" current))
|
||||
collect (chronometrist-task-time-one-day task current) into row
|
||||
do (setq current (ts-adjust 'day 1 current)
|
||||
complete-p (zerop (ts-dow current)))
|
||||
;; finally (message "row - %S" row)
|
||||
;; pad with nils if not ending on Saturday
|
||||
finally return
|
||||
(if (and (< stop-dow 6) (< (length row) 7))
|
||||
(append row (make-list (- 6 stop-dow) nil))
|
||||
row)))))
|
||||
collect (chronometrist-task-time-one-day task current)
|
||||
do (setq current (ts-adjust 'day 1 current)))))
|
||||
|
||||
(defgroup chronometrist-task-graph nil
|
||||
"Task-specific monthly/weekly graph for the `chronometrist' time tracker."
|
||||
:group 'chronometrist)
|
||||
|
||||
(defcustom chronometrist-task-graph-buffer-name "*chronometrist-task-graph*"
|
||||
"Name of buffer created by `chronometrist-task-graph'."
|
||||
:type 'string)
|
||||
|
||||
(defcustom chronometrist-task-graph-default-unit :month
|
||||
"Default unit for `chronometrist-task-graph'.
|
||||
Values may be either `:month' or `:week'."
|
||||
:type '(radio (const :tag "Month" :month) (const :tag "Week" :week)))
|
||||
|
||||
(defcustom chronometrist-task-graph-schema
|
||||
[("#" 3 (lambda (row-1 row-2) (< (car row-1) (car row-2))))
|
||||
("Month" 20 t)
|
||||
("Graph" 31 t)]
|
||||
"Vector specifying format of `chronometrist-task-graph' buffer.
|
||||
See `tabulated-list-format'."
|
||||
:type '(vector))
|
||||
|
||||
(defvar chronometrist-task-graph-schema-transformers nil
|
||||
"List of functions to transform `chronometrist-task-graph-schema' (which see).
|
||||
This is passed to `chronometrist-run-transformers', which see.
|
||||
|
||||
Extensions adding to this list to increase the number of columns
|
||||
will also need to modify the value of `tabulated-list-entries' by
|
||||
using `chronometrist-task-graph-row-transformers'.")
|
||||
|
||||
(defvar chronometrist-task-graph-row-transformers nil
|
||||
"List of functions to transform each row of `chronometrist-task-graph-rows'.
|
||||
This is passed to `chronometrist-run-transformers', which see.
|
||||
|
||||
Extensions adding to this list to increase the number of columns
|
||||
will also need to modify the value of `tabulated-list-format' by
|
||||
using `chronometrist-task-graph-schema-transformers'.")
|
||||
|
||||
(defun chronometrist-task-graph-rows ()
|
||||
"Return rows to be displayed in the `chronometrist-task-graph' buffer.
|
||||
Return value is a list as specified by `tabulated-list-entries'."
|
||||
(cl-loop with index = 1
|
||||
for plist in (gethash (chronometrist-events-last-date) chronometrist-events) collect
|
||||
(-let* (((&plist :name name :tags tags :start start :stop stop) plist)
|
||||
)
|
||||
(--> (vconcat (vector index-string name)
|
||||
(when chronometrist-task-graph-display-tags (vector tags))
|
||||
(when chronometrist-task-graph-display-key-values (vector key-values))
|
||||
(vector duration timespan))
|
||||
(list index it)
|
||||
(chronometrist-run-transformers chronometrist-task-graph-row-transformers it)))
|
||||
do (cl-incf index)))
|
||||
|
||||
(define-derived-mode chronometrist-task-graph-mode tabulated-list-mode "Task Graph"
|
||||
"Major mode for `chronometrist-task-graph'."
|
||||
(make-local-variable 'tabulated-list-format)
|
||||
(--> (chronometrist-run-transformers chronometrist-task-graph-schema-transformers
|
||||
chronometrist-task-graph-schema)
|
||||
(setq tabulated-list-format it))
|
||||
(make-local-variable 'tabulated-list-entries)
|
||||
(setq tabulated-list-entries #'chronometrist-task-graph-rows)
|
||||
(make-local-variable 'tabulated-list-sort-key)
|
||||
(tabulated-list-init-header)
|
||||
(run-hooks 'chronometrist-task-graph-mode-hook))
|
||||
|
||||
(defun chronometrist-task-graph ()
|
||||
(interactive)
|
||||
(let ((buffer (get-buffer-create chronometrist-task-graph-buffer-name))
|
||||
(window (save-excursion
|
||||
(get-buffer-window chronometrist-task-graph-buffer-name t))))
|
||||
(cond (window (kill-buffer chronometrist-task-graph-buffer-name))
|
||||
(t (with-current-buffer buffer
|
||||
(switch-to-buffer buffer)
|
||||
(chronometrist-task-graph-mode)
|
||||
(tabulated-list-print))))))
|
||||
|
||||
(provide 'chronometrist-spark)
|
||||
;;; chronometrist-spark.el ends here
|
||||
|
|
|
@ -162,48 +162,136 @@ SCHEMA should be a vector as specified by `tabulated-list-format'."
|
|||
(if chronometrist-spark-minor-mode (chronometrist-spark-setup) (chronometrist-spark-teardown)))
|
||||
#+END_SRC
|
||||
|
||||
** month view
|
||||
** task graph view
|
||||
*** prompt
|
||||
*** task-durations-month
|
||||
#+BEGIN_SRC emacs-lisp
|
||||
(defun chronometrist-task-durations-month (task iso-year-month)
|
||||
(let* ((start-ts (chronometrist-iso-date-to-ts (concat iso-year-month "-01")))
|
||||
;; last date of month
|
||||
(stop-ts (ts-adjust 'month 1 'day -1 start-ts))
|
||||
(start-dow (ts-dow start-ts))
|
||||
(stop-dow (ts-dow stop-ts)))
|
||||
(stop-ts (ts-adjust 'month 1 'day -1 start-ts)))
|
||||
(cl-loop with current = start-ts
|
||||
while (not (ts> current stop-ts))
|
||||
collect
|
||||
(cl-loop
|
||||
with row with complete-p
|
||||
;; pad with nils if not starting from Sunday
|
||||
initially ;; could be moved to the outer loop? 🤔
|
||||
(when (and (ts= current start-ts)
|
||||
(not (zerop start-dow)))
|
||||
(setq row (make-list start-dow nil)))
|
||||
while (and (not complete-p) (ts<= current stop-ts))
|
||||
;; do (message (ts-format "%a, %d %h %Y" current))
|
||||
collect (chronometrist-task-time-one-day task current) into row
|
||||
do (setq current (ts-adjust 'day 1 current)
|
||||
complete-p (zerop (ts-dow current)))
|
||||
;; finally (message "row - %S" row)
|
||||
;; pad with nils if not ending on Saturday
|
||||
finally return
|
||||
(if (and (< stop-dow 6) (< (length row) 7))
|
||||
(append row (make-list (- 6 stop-dow) nil))
|
||||
row)))))
|
||||
collect (chronometrist-task-time-one-day task current)
|
||||
do (setq current (ts-adjust 'day 1 current)))))
|
||||
#+END_SRC
|
||||
**** tests
|
||||
#+BEGIN_SRC emacs-lisp :tangle chronometrist-spark-tests.el :load test
|
||||
(ert-deftest chronometrist-task-durations-month ()
|
||||
(should (--every-p
|
||||
(= 7 (length it))
|
||||
(chronometrist-task-durations-month "Anything" "2021-01")))
|
||||
(should (--every-p
|
||||
(= 7 (length it))
|
||||
(chronometrist-task-durations-month "Anything" "2021-02"))))
|
||||
(should
|
||||
(--every-p #'integerp (chronometrist-task-durations-month "Anything" "2021-01"))))
|
||||
#+END_SRC
|
||||
*** task-graph :custom:group:
|
||||
#+BEGIN_SRC emacs-lisp
|
||||
(defgroup chronometrist-task-graph nil
|
||||
"Task-specific monthly/weekly graph for the `chronometrist' time tracker."
|
||||
:group 'chronometrist)
|
||||
#+END_SRC
|
||||
|
||||
*** buffer-name :custom:variable:
|
||||
#+BEGIN_SRC emacs-lisp
|
||||
(defcustom chronometrist-task-graph-buffer-name "*chronometrist-task-graph*"
|
||||
"Name of buffer created by `chronometrist-task-graph'."
|
||||
:type 'string)
|
||||
#+END_SRC
|
||||
|
||||
*** default-unit :custom:variable:
|
||||
#+BEGIN_SRC emacs-lisp
|
||||
(defcustom chronometrist-task-graph-default-unit :month
|
||||
"Default unit for `chronometrist-task-graph'.
|
||||
Values may be either `:month' or `:week'."
|
||||
:type '(radio (const :tag "Month" :month) (const :tag "Week" :week)))
|
||||
#+END_SRC
|
||||
|
||||
*** schema :custom:variable:
|
||||
#+BEGIN_SRC emacs-lisp
|
||||
(defcustom chronometrist-task-graph-schema
|
||||
[("#" 3 (lambda (row-1 row-2) (< (car row-1) (car row-2))))
|
||||
("Month" 20 t)
|
||||
("Graph" 31 t)]
|
||||
"Vector specifying format of `chronometrist-task-graph' buffer.
|
||||
See `tabulated-list-format'."
|
||||
:type '(vector))
|
||||
#+END_SRC
|
||||
|
||||
*** schema-transformers :extension:variable:
|
||||
#+BEGIN_SRC emacs-lisp
|
||||
(defvar chronometrist-task-graph-schema-transformers nil
|
||||
"List of functions to transform `chronometrist-task-graph-schema' (which see).
|
||||
This is passed to `chronometrist-run-transformers', which see.
|
||||
|
||||
Extensions adding to this list to increase the number of columns
|
||||
will also need to modify the value of `tabulated-list-entries' by
|
||||
using `chronometrist-task-graph-row-transformers'.")
|
||||
#+END_SRC
|
||||
|
||||
*** row-transformers :extension:variable:
|
||||
#+BEGIN_SRC emacs-lisp
|
||||
(defvar chronometrist-task-graph-row-transformers nil
|
||||
"List of functions to transform each row of `chronometrist-task-graph-rows'.
|
||||
This is passed to `chronometrist-run-transformers', which see.
|
||||
|
||||
Extensions adding to this list to increase the number of columns
|
||||
will also need to modify the value of `tabulated-list-format' by
|
||||
using `chronometrist-task-graph-schema-transformers'.")
|
||||
#+END_SRC
|
||||
|
||||
*** months :variable:
|
||||
#+BEGIN_SRC emacs-lisp
|
||||
(defvar chronometrist-task-graph-months
|
||||
'("January" "February" "March" "April" "May" "June"
|
||||
"July" "August" "September" "October" "November" "December"))
|
||||
#+END_SRC
|
||||
*** rows :function:
|
||||
1. check default unit
|
||||
2.
|
||||
|
||||
#+BEGIN_SRC emacs-lisp
|
||||
(defun chronometrist-task-graph-rows ()
|
||||
"Return rows to be displayed in the `chronometrist-task-graph' buffer.
|
||||
Return value is a list as specified by `tabulated-list-entries'."
|
||||
(cl-loop with index = 1
|
||||
for month in chronometrist-task-graph-months collect
|
||||
(-let* (((&plist :name name :tags tags :start start :stop stop) plist)
|
||||
)
|
||||
(--> (vconcat (vector index-string name)
|
||||
(when chronometrist-task-graph-display-tags (vector tags))
|
||||
(when chronometrist-task-graph-display-key-values (vector key-values))
|
||||
(vector duration timespan))
|
||||
(list index it)
|
||||
(chronometrist-run-transformers chronometrist-task-graph-row-transformers it)))
|
||||
do (cl-incf index)))
|
||||
#+END_SRC
|
||||
|
||||
*** chronometrist-task-graph-mode :major:mode:
|
||||
#+BEGIN_SRC emacs-lisp
|
||||
(define-derived-mode chronometrist-task-graph-mode tabulated-list-mode "Task Graph"
|
||||
"Major mode for `chronometrist-task-graph'."
|
||||
(make-local-variable 'tabulated-list-format)
|
||||
(--> (chronometrist-run-transformers chronometrist-task-graph-schema-transformers
|
||||
chronometrist-task-graph-schema)
|
||||
(setq tabulated-list-format it))
|
||||
(make-local-variable 'tabulated-list-entries)
|
||||
(setq tabulated-list-entries #'chronometrist-task-graph-rows)
|
||||
(make-local-variable 'tabulated-list-sort-key)
|
||||
(tabulated-list-init-header)
|
||||
(run-hooks 'chronometrist-task-graph-mode-hook))
|
||||
#+END_SRC
|
||||
|
||||
*** chronometrist-task-graph :command:
|
||||
#+BEGIN_SRC emacs-lisp
|
||||
(defun chronometrist-task-graph ()
|
||||
(interactive)
|
||||
(let ((buffer (get-buffer-create chronometrist-task-graph-buffer-name))
|
||||
(window (save-excursion
|
||||
(get-buffer-window chronometrist-task-graph-buffer-name t))))
|
||||
(cond (window (kill-buffer chronometrist-task-graph-buffer-name))
|
||||
(t (with-current-buffer buffer
|
||||
(switch-to-buffer buffer)
|
||||
(chronometrist-task-graph-mode)
|
||||
(tabulated-list-print))))))
|
||||
#+END_SRC
|
||||
|
||||
* Provide
|
||||
#+BEGIN_SRC emacs-lisp
|
||||
(provide 'chronometrist-spark)
|
||||
|
|
|
@ -2087,7 +2087,7 @@ Return value is a list as specified by `tabulated-list-entries'."
|
|||
(setq tabulated-list-entries #'chronometrist-details-rows)
|
||||
(make-local-variable 'tabulated-list-sort-key)
|
||||
(tabulated-list-init-header)
|
||||
(run-hooks 'chronometrist-mode-hook))
|
||||
(run-hooks 'chronometrist-details-mode-hook))
|
||||
|
||||
(defun chronometrist-details ()
|
||||
(interactive)
|
||||
|
|
|
@ -3307,7 +3307,7 @@ Return value is a list as specified by `tabulated-list-entries'."
|
|||
(setq tabulated-list-entries #'chronometrist-details-rows)
|
||||
(make-local-variable 'tabulated-list-sort-key)
|
||||
(tabulated-list-init-header)
|
||||
(run-hooks 'chronometrist-mode-hook))
|
||||
(run-hooks 'chronometrist-details-mode-hook))
|
||||
#+END_SRC
|
||||
|
||||
**** chronometrist-details :command:
|
||||
|
|
Reference in New Issue