Compare commits
17 Commits
dev
...
details-vi
Author | SHA1 | Date |
---|---|---|
contrapunctus | 5ce2aca5a8 | |
contrapunctus | 661369188e | |
contrapunctus | 224a7fec3f | |
contrapunctus | 26e3dd5c5d | |
contrapunctus | 7976b53d91 | |
contrapunctus | 1931e88c85 | |
contrapunctus | 883f813615 | |
contrapunctus | 0f68ab4f38 | |
contrapunctus | f7f2349004 | |
contrapunctus | c5d4c33057 | |
contrapunctus | a04ca1fd28 | |
contrapunctus | cc77b18797 | |
contrapunctus | fd468a9ed5 | |
contrapunctus | 5adf3f3901 | |
contrapunctus | b774700450 | |
contrapunctus | c4b94be941 | |
contrapunctus | 9f8e455e01 |
|
@ -7,10 +7,11 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0
|
||||||
## [unreleased]
|
## [unreleased]
|
||||||
### Added
|
### Added
|
||||||
1. New commands `chronometrist-restart-task`, `chronometrist-extend-task`
|
1. New commands `chronometrist-restart-task`, `chronometrist-extend-task`
|
||||||
2. Menus for `chronometrist` and `chronometrist-key-values`
|
2. Menus for `chronometrist`, `chronometrist-key-values`, and `chronometrist-details`
|
||||||
|
3. Custom ranges and filters for `chronometrist-details`. See command `chronometrist-details-set-range` and `chronometrist-details-set-filter`.
|
||||||
### Changed
|
### Changed
|
||||||
3. Display graph ranges in `chronometrist-spark` column
|
4. Display graph ranges in `chronometrist-spark` column
|
||||||
4. `chronometrist-tags-add` and `chronometrist-key-values-unified-prompt` now also work interactively.
|
5. `chronometrist-tags-add` and `chronometrist-key-values-unified-prompt` now also work interactively.
|
||||||
|
|
||||||
## [0.8.1] - 2021-06-01
|
## [0.8.1] - 2021-06-01
|
||||||
### Changed
|
### Changed
|
||||||
|
|
6
TODO.org
6
TODO.org
|
@ -623,16 +623,18 @@ list of tasks, one day, durations and graphs
|
||||||
list of tasks, one week, durations only
|
list of tasks, one week, durations only
|
||||||
*** statistics
|
*** statistics
|
||||||
list of tasks, one week/month/year [fn:1]
|
list of tasks, one week/month/year [fn:1]
|
||||||
*** details (intervals for a day) [0%]
|
*** details (intervals for a day) [25%]
|
||||||
list of intervals, one day [fn:1]
|
list of intervals, one day [fn:1]
|
||||||
+ [-] commands [50%]
|
+ [-] commands [50%]
|
||||||
1. [X] set [task/key-value] filter [fn:2]
|
1. [X] set [task/key-value] filter [fn:2]
|
||||||
2. [X] set range
|
2. [X] set range
|
||||||
|
1. implement timestamp ranges (e.g. =2021-06-01T12:00+05:30= to =2021-07-03T00:10:29+0530=)
|
||||||
3. [ ] previous/next day
|
3. [ ] previous/next day
|
||||||
4. [ ] set duration format
|
4. [ ] set duration format
|
||||||
+ [ ] with =spark= - vertical sparkline for each interval
|
+ [ ] with =spark= - vertical sparkline for each interval
|
||||||
+ [ ] non-tabular text [fn:3]
|
+ [ ] non-tabular text [fn:3]
|
||||||
+ [ ] when range is a pair with the =car= or the =cdr= being blank, set the respective date to the earliest (if =car= is blank) or the latest (if =cdr= is blank) date available.
|
+ [X] when range is a pair with the =car= or the =cdr= being blank, set the start/stop date to the earliest/latest date available.
|
||||||
|
* not possible with =completing-read-multiple=, which removes blank strings; the simplest solution was to allow "begin"/"end" as inputs.
|
||||||
|
|
||||||
** New frontends I want
|
** New frontends I want
|
||||||
*** task-key-values
|
*** task-key-values
|
||||||
|
|
|
@ -122,12 +122,12 @@ EVENTS must be a list of valid Chronometrist property lists (see
|
||||||
Return 0 if EVENTS is nil."
|
Return 0 if EVENTS is nil."
|
||||||
(if events
|
(if events
|
||||||
(cl-loop for plist in events collect
|
(cl-loop for plist in events collect
|
||||||
(let* ((start-ts (chronometrist-iso-timestamp-to-ts
|
(let* ((start-ts (chronometrist-iso-to-ts
|
||||||
(plist-get plist :start)))
|
(plist-get plist :start)))
|
||||||
(stop-iso (plist-get plist :stop))
|
(stop-iso (plist-get plist :stop))
|
||||||
;; Add a stop time if it does not exist.
|
;; Add a stop time if it does not exist.
|
||||||
(stop-ts (if stop-iso
|
(stop-ts (if stop-iso
|
||||||
(chronometrist-iso-timestamp-to-ts stop-iso)
|
(chronometrist-iso-to-ts stop-iso)
|
||||||
(ts-now))))
|
(ts-now))))
|
||||||
(ts-diff stop-ts start-ts)))
|
(ts-diff stop-ts start-ts)))
|
||||||
0))
|
0))
|
||||||
|
@ -707,7 +707,7 @@ TIMESTAMP must be a time string in the ISO-8601 format.
|
||||||
Return value is a ts struct (see `ts.el')."
|
Return value is a ts struct (see `ts.el')."
|
||||||
(-let [(h m s) (mapcar #'string-to-number (split-string time ":"))]
|
(-let [(h m s) (mapcar #'string-to-number (split-string time ":"))]
|
||||||
(ts-apply :hour h :minute m :second s
|
(ts-apply :hour h :minute m :second s
|
||||||
(chronometrist-iso-timestamp-to-ts timestamp))))
|
(chronometrist-iso-to-ts timestamp))))
|
||||||
|
|
||||||
(defun chronometrist-events-maybe-split (event)
|
(defun chronometrist-events-maybe-split (event)
|
||||||
"Split EVENT if it spans midnight.
|
"Split EVENT if it spans midnight.
|
||||||
|
@ -745,7 +745,7 @@ were none."
|
||||||
"Add PLIST to the end of `chronometrist-events'.
|
"Add PLIST to the end of `chronometrist-events'.
|
||||||
If REPLACE is non-nil, replace the last event with PLIST."
|
If REPLACE is non-nil, replace the last event with PLIST."
|
||||||
(let* ((date (->> (plist-get plist :start)
|
(let* ((date (->> (plist-get plist :start)
|
||||||
(chronometrist-iso-timestamp-to-ts )
|
(chronometrist-iso-to-ts )
|
||||||
(ts-format "%F" )))
|
(ts-format "%F" )))
|
||||||
(events-today (gethash date chronometrist-events)))
|
(events-today (gethash date chronometrist-events)))
|
||||||
(--> (if replace (-drop-last 1 events-today) events-today)
|
(--> (if replace (-drop-last 1 events-today) events-today)
|
||||||
|
@ -775,7 +775,7 @@ treated as though their time is 00:00:00."
|
||||||
(start (chronometrist-date start))
|
(start (chronometrist-date start))
|
||||||
(end (chronometrist-date end)))
|
(end (chronometrist-date end)))
|
||||||
(maphash (lambda (key value)
|
(maphash (lambda (key value)
|
||||||
(when (ts-in start end (chronometrist-iso-date-to-ts key))
|
(when (ts-in start end (chronometrist-iso-to-ts key))
|
||||||
(puthash key value subset)))
|
(puthash key value subset)))
|
||||||
chronometrist-events)
|
chronometrist-events)
|
||||||
subset))
|
subset))
|
||||||
|
@ -867,9 +867,10 @@ unchanged."
|
||||||
;; The only interval for TASK is the last expression
|
;; The only interval for TASK is the last expression
|
||||||
(setq chronometrist-task-list (remove task chronometrist-task-list)))))
|
(setq chronometrist-task-list (remove task chronometrist-task-list)))))
|
||||||
|
|
||||||
(defun chronometrist-iso-timestamp-to-ts (timestamp)
|
(defun chronometrist-iso-to-ts (timestamp)
|
||||||
"Convert TIMESTAMP to a TS struct. (see `ts.el')
|
"Convert TIMESTAMP to a TS struct. (see `ts.el')
|
||||||
TIMESTAMP must be the ISO-8601 format, as handled by `parse-iso8601-time-string'."
|
TIMESTAMP must be an ISO-8601 timestamp, as handled by
|
||||||
|
`parse-iso8601-time-string'."
|
||||||
(-let [(second minute hour day month year dow _dst utcoff)
|
(-let [(second minute hour day month year dow _dst utcoff)
|
||||||
(decode-time
|
(decode-time
|
||||||
(parse-iso8601-time-string timestamp))]
|
(parse-iso8601-time-string timestamp))]
|
||||||
|
@ -878,15 +879,6 @@ TIMESTAMP must be the ISO-8601 format, as handled by `parse-iso8601-time-string'
|
||||||
:day day :month month :year year
|
:day day :month month :year year
|
||||||
:dow dow :tz-offset utcoff))))
|
:dow dow :tz-offset utcoff))))
|
||||||
|
|
||||||
(defun chronometrist-iso-date-to-ts (date)
|
|
||||||
"Return a ts struct (see `ts.el') representing DATE.
|
|
||||||
DATE should be an ISO-8601 date string (\"YYYY-MM-DD\")."
|
|
||||||
(-let [(year month day) (mapcar #'string-to-number
|
|
||||||
(split-string date "-"))]
|
|
||||||
(ts-update
|
|
||||||
(make-ts :hour 0 :minute 0 :second 0
|
|
||||||
:day day :month month :year year))))
|
|
||||||
|
|
||||||
(cl-defun chronometrist-date (&optional (ts (ts-now)))
|
(cl-defun chronometrist-date (&optional (ts (ts-now)))
|
||||||
"Return a ts struct representing the time 00:00:00 on today's date.
|
"Return a ts struct representing the time 00:00:00 on today's date.
|
||||||
If TS is supplied, use that date instead of today.
|
If TS is supplied, use that date instead of today.
|
||||||
|
@ -918,8 +910,8 @@ Return a list in the form
|
||||||
;; time-zone-spanning events
|
;; time-zone-spanning events
|
||||||
|
|
||||||
;; The time on which the first provided day starts (according to `chronometrist-day-start-time')
|
;; The time on which the first provided day starts (according to `chronometrist-day-start-time')
|
||||||
(let* ((start-ts (chronometrist-iso-timestamp-to-ts start-time))
|
(let* ((start-ts (chronometrist-iso-to-ts start-time))
|
||||||
(stop-ts (chronometrist-iso-timestamp-to-ts stop-time))
|
(stop-ts (chronometrist-iso-to-ts stop-time))
|
||||||
(first-day-start (chronometrist-apply-time day-start-time start-time))
|
(first-day-start (chronometrist-apply-time day-start-time start-time))
|
||||||
(next-day-start (ts-adjust 'hour 24 first-day-start)))
|
(next-day-start (ts-adjust 'hour 24 first-day-start)))
|
||||||
;; Does the event stop time exceed the next day start time?
|
;; Does the event stop time exceed the next day start time?
|
||||||
|
@ -1762,7 +1754,7 @@ TABLE should be a hash table - if not supplied,
|
||||||
with events-in-day
|
with events-in-day
|
||||||
for date being the hash-keys of table
|
for date being the hash-keys of table
|
||||||
when (setq events-in-day
|
when (setq events-in-day
|
||||||
(chronometrist-task-events-in-day task (chronometrist-iso-date-to-ts date)))
|
(chronometrist-task-events-in-day task (chronometrist-iso-to-ts date)))
|
||||||
do (cl-incf days) and
|
do (cl-incf days) and
|
||||||
collect
|
collect
|
||||||
(-reduce #'+ (chronometrist-events-to-durations events-in-day))
|
(-reduce #'+ (chronometrist-events-to-durations events-in-day))
|
||||||
|
@ -1962,10 +1954,15 @@ If ARG is a numeric argument, go forward that many times."
|
||||||
"Details buffer for the `chronometrist' time tracker."
|
"Details buffer for the `chronometrist' time tracker."
|
||||||
:group 'chronometrist)
|
:group 'chronometrist)
|
||||||
|
|
||||||
(defcustom chronometrist-details-buffer-name "*chronometrist-details*"
|
(defcustom chronometrist-details-buffer-name-base "chronometrist-details"
|
||||||
"Name of buffer created by `chronometrist-details'."
|
"Name of buffer created by `chronometrist-details'."
|
||||||
:type 'string)
|
:type 'string)
|
||||||
|
|
||||||
|
(defun chronometrist-details-buffer-name (&optional suffix)
|
||||||
|
(if suffix
|
||||||
|
(format "*%s_%s*" chronometrist-details-buffer-name-base suffix)
|
||||||
|
(format "*%s*" chronometrist-details-buffer-name-base)))
|
||||||
|
|
||||||
(defcustom chronometrist-details-display-tags "%s"
|
(defcustom chronometrist-details-display-tags "%s"
|
||||||
"How to display tags in `chronometrist-details' buffers.
|
"How to display tags in `chronometrist-details' buffers.
|
||||||
Value can be
|
Value can be
|
||||||
|
@ -2028,9 +2025,11 @@ LIST is either tags (a list of symbols) or a plist."
|
||||||
(if (and contents custom)
|
(if (and contents custom)
|
||||||
(pcase custom
|
(pcase custom
|
||||||
((pred stringp)
|
((pred stringp)
|
||||||
|
(--> (flatten-list contents)
|
||||||
|
(seq-remove #'keywordp it)
|
||||||
(mapconcat
|
(mapconcat
|
||||||
(lambda (elt) (format custom elt))
|
(lambda (elt) (format custom elt))
|
||||||
contents " "))
|
it ", ")))
|
||||||
((pred functionp)
|
((pred functionp)
|
||||||
(funcall custom list)))
|
(funcall custom list)))
|
||||||
"")))
|
"")))
|
||||||
|
@ -2047,25 +2046,26 @@ using `chronometrist-details-schema-transformers'.")
|
||||||
"Return rows to be displayed in the `chronometrist-details' buffer.
|
"Return rows to be displayed in the `chronometrist-details' buffer.
|
||||||
Return value is a list as specified by `tabulated-list-entries'."
|
Return value is a list as specified by `tabulated-list-entries'."
|
||||||
(cl-loop with index = 1
|
(cl-loop with index = 1
|
||||||
for plist in (gethash (chronometrist-events-last-date) chronometrist-events) collect
|
for plist in (chronometrist-details-intervals chronometrist-details-range chronometrist-details-filter chronometrist-events)
|
||||||
|
collect
|
||||||
(-let* (((&plist :name name :tags tags :start start :stop stop) plist)
|
(-let* (((&plist :name name :tags tags :start start :stop stop) plist)
|
||||||
;; whether tags or key-values are actually displayed is handled later
|
;; whether tags or key-values are actually displayed is handled later
|
||||||
(tags (chronometrist-details-rows-helper tags))
|
(tags (chronometrist-details-rows-helper tags))
|
||||||
(key-values (chronometrist-details-rows-helper plist))
|
(key-values (chronometrist-details-rows-helper plist))
|
||||||
;; resetting seconds with `ts-apply' is necessary to
|
;; resetting seconds with `ts-apply' is necessary to
|
||||||
;; prevent situations like "1 hour from 00:08 to 01:09"
|
;; prevent situations like "1 hour from 00:08 to 01:09"
|
||||||
(start (ts-apply :second 0
|
(start (ts-apply :second 0 (chronometrist-iso-to-ts start)))
|
||||||
(chronometrist-iso-timestamp-to-ts start)))
|
(stop (ts-apply :second 0 (if stop
|
||||||
(stop (ts-apply :second 0
|
(chronometrist-iso-to-ts stop)
|
||||||
(if stop
|
|
||||||
(chronometrist-iso-timestamp-to-ts stop)
|
|
||||||
(ts-now))))
|
(ts-now))))
|
||||||
(interval (floor (ts-diff stop start)))
|
(interval (floor (ts-diff stop start)))
|
||||||
(index-string (format "%s" index))
|
(index-string (format "%s" index))
|
||||||
(duration (chronometrist-format-duration-long interval))
|
(duration (chronometrist-format-duration-long interval))
|
||||||
(timespan (format "from %s to %s"
|
(timespan (format "from %s to %s"
|
||||||
(ts-format chronometrist-details-time-format-string start)
|
(ts-format chronometrist-details-time-format-string
|
||||||
(ts-format chronometrist-details-time-format-string stop))))
|
start)
|
||||||
|
(ts-format chronometrist-details-time-format-string
|
||||||
|
stop))))
|
||||||
(--> (vconcat (vector index-string name)
|
(--> (vconcat (vector index-string name)
|
||||||
(when chronometrist-details-display-tags (vector tags))
|
(when chronometrist-details-display-tags (vector tags))
|
||||||
(when chronometrist-details-display-key-values (vector key-values))
|
(when chronometrist-details-display-key-values (vector key-values))
|
||||||
|
@ -2074,6 +2074,24 @@ Return value is a list as specified by `tabulated-list-entries'."
|
||||||
(chronometrist-run-transformers chronometrist-details-row-transformers it)))
|
(chronometrist-run-transformers chronometrist-details-row-transformers it)))
|
||||||
do (cl-incf index)))
|
do (cl-incf index)))
|
||||||
|
|
||||||
|
(defvar chronometrist-details-mode-map
|
||||||
|
(let ((map (make-sparse-keymap)))
|
||||||
|
(define-key map (kbd "s r") #'chronometrist-details-set-range)
|
||||||
|
(define-key map (kbd "s f") #'chronometrist-details-set-filter)
|
||||||
|
(define-key map (kbd "r") #'chronometrist-report)
|
||||||
|
(define-key map (kbd "l") #'chronometrist-open-log)
|
||||||
|
(define-key map (kbd "G") #'chronometrist-reset)
|
||||||
|
map))
|
||||||
|
|
||||||
|
(easy-menu-define chronometrist-details-menu chronometrist-details-mode-map
|
||||||
|
"Menu for `chronometrist-details'."
|
||||||
|
'("Details"
|
||||||
|
["Set date/time range" chronometrist-details-set-range]
|
||||||
|
["Set interval filter" chronometrist-details-set-filter]
|
||||||
|
["View weekly report" chronometrist-report]
|
||||||
|
["View/edit log file" chronometrist-open-log]
|
||||||
|
["Reset state" chronometrist-reset]))
|
||||||
|
|
||||||
(define-derived-mode chronometrist-details-mode tabulated-list-mode "Details"
|
(define-derived-mode chronometrist-details-mode tabulated-list-mode "Details"
|
||||||
"Major mode for `chronometrist-details'."
|
"Major mode for `chronometrist-details'."
|
||||||
(make-local-variable 'tabulated-list-format)
|
(make-local-variable 'tabulated-list-format)
|
||||||
|
@ -2085,16 +2103,170 @@ Return value is a list as specified by `tabulated-list-entries'."
|
||||||
(tabulated-list-init-header)
|
(tabulated-list-init-header)
|
||||||
(run-hooks 'chronometrist-mode-hook))
|
(run-hooks 'chronometrist-mode-hook))
|
||||||
|
|
||||||
|
(defun chronometrist-details-setup-buffer (buffer-or-name)
|
||||||
|
"Enable `chronometrist-details-mode' in BUFFER-OR-NAME and switch to it.
|
||||||
|
BUFFER-OR-NAME must be an existing buffer."
|
||||||
|
(with-current-buffer buffer-or-name
|
||||||
|
(switch-to-buffer buffer-or-name)
|
||||||
|
(chronometrist-details-mode)
|
||||||
|
(tabulated-list-print)))
|
||||||
|
|
||||||
(defun chronometrist-details ()
|
(defun chronometrist-details ()
|
||||||
(interactive)
|
(interactive)
|
||||||
(let ((buffer (get-buffer-create chronometrist-details-buffer-name))
|
(let ((buffer (get-buffer-create (chronometrist-details-buffer-name)))
|
||||||
(window (save-excursion
|
(window (save-excursion
|
||||||
(get-buffer-window chronometrist-details-buffer-name t))))
|
(get-buffer-window buffer t))))
|
||||||
(cond (window (kill-buffer chronometrist-details-buffer-name))
|
(cond (window (kill-buffer buffer))
|
||||||
(t (with-current-buffer buffer
|
(t (chronometrist-details-setup-buffer buffer)))))
|
||||||
(switch-to-buffer buffer)
|
|
||||||
(chronometrist-details-mode)
|
(defvar chronometrist-details-range nil
|
||||||
(tabulated-list-print))))))
|
"Time range for intervals displayed by `chronometrist-details'.
|
||||||
|
Values can be one of -
|
||||||
|
nil - no range. Display all intervals for today.
|
||||||
|
An ISO date string - display intervals for this date.
|
||||||
|
A cons cell in the form (BEGIN . END), where BEGIN and END are
|
||||||
|
ISO date strings (inclusive) or date-time strings (\"BEGIN\"
|
||||||
|
inclusive, \"END\" exclusive) - display intervals in this
|
||||||
|
range.")
|
||||||
|
(make-variable-buffer-local 'chronometrist-details-range)
|
||||||
|
|
||||||
|
(defun chronometrist-iso-date-p (string)
|
||||||
|
(string-match-p
|
||||||
|
(rx (and string-start
|
||||||
|
(>= 1 num) "-" (= 2 num) "-" (= 2 num)
|
||||||
|
string-end))
|
||||||
|
string))
|
||||||
|
|
||||||
|
(defun chronometrist-details-intervals-for-range (range table)
|
||||||
|
"Return intervals for RANGE from TABLE.
|
||||||
|
RANGE must be a time range as specified by `chronometrist-details-range'.
|
||||||
|
|
||||||
|
TABLE must be a hash table similar to `chronometrist-events'."
|
||||||
|
(pcase range
|
||||||
|
('nil
|
||||||
|
(gethash (format-time-string "%F") table))
|
||||||
|
((pred stringp)
|
||||||
|
(gethash range table))
|
||||||
|
(`(,begin . ,end)
|
||||||
|
;; `chronometrist-iso-to-ts' also accepts ISO dates
|
||||||
|
(let ((begin-ts (chronometrist-iso-to-ts begin))
|
||||||
|
(end-ts (chronometrist-iso-to-ts end)))
|
||||||
|
(if (and (chronometrist-iso-date-p begin) (chronometrist-iso-date-p end))
|
||||||
|
(cl-loop while (not (ts> begin-ts end-ts))
|
||||||
|
append (gethash (ts-format "%F" begin-ts) table)
|
||||||
|
do (ts-adjustf begin-ts 'day 1))
|
||||||
|
(cl-loop while (not (ts> begin-ts end-ts))
|
||||||
|
append
|
||||||
|
(cl-loop for plist in (gethash (ts-format "%F" begin-ts) table)
|
||||||
|
when
|
||||||
|
(let ((start-ts (chronometrist-iso-to-ts (plist-get plist :start)))
|
||||||
|
(stop-ts (chronometrist-iso-to-ts (plist-get plist :stop))))
|
||||||
|
(and (ts>= start-ts begin-ts)
|
||||||
|
(ts<= stop-ts end-ts)))
|
||||||
|
collect plist)
|
||||||
|
do (ts-adjustf begin-ts 'day 1)))))))
|
||||||
|
|
||||||
|
;; (chronometrist-details-intervals-for-range nil chronometrist-events)
|
||||||
|
;; (chronometrist-details-intervals-for-range "2021-06-01" chronometrist-events)
|
||||||
|
;; (chronometrist-details-intervals-for-range '("2021-06-01" . "2021-06-03") chronometrist-events)
|
||||||
|
;; (chronometrist-details-intervals-for-range '("2021-06-02T01:00+05:30" . "2021-06-02T03:00+05:30") chronometrist-events)
|
||||||
|
|
||||||
|
(defun chronometrist-details-input-to-value (input)
|
||||||
|
(pcase input
|
||||||
|
('nil nil)
|
||||||
|
(`(,date) date)
|
||||||
|
(`(,begin ,end)
|
||||||
|
(let* ((date-p (seq-find #'chronometrist-iso-date-p input))
|
||||||
|
(begin-date (car (hash-table-keys chronometrist-events)))
|
||||||
|
(begin-iso-ts (ts-format
|
||||||
|
"%FT%T%z" (chronometrist-iso-to-ts begin-date)))
|
||||||
|
(end-date (car (last (hash-table-keys chronometrist-events))))
|
||||||
|
(end-iso-ts (chronometrist-format-time-iso8601))
|
||||||
|
(begin (if (equal begin "begin")
|
||||||
|
(if date-p begin-date begin-iso-ts)
|
||||||
|
begin))
|
||||||
|
(end (if (equal end "end")
|
||||||
|
(if date-p end-date end-iso-ts)
|
||||||
|
end)))
|
||||||
|
(cons begin end)))
|
||||||
|
(_ (error "Unsupported range."))))
|
||||||
|
|
||||||
|
(defun chronometrist-details-set-range ()
|
||||||
|
"Prompt user for range for current `chronometrist-details' buffer."
|
||||||
|
(interactive)
|
||||||
|
(let* ((input (completing-read-multiple
|
||||||
|
(concat "Range (blank, ISO-8601 date, "
|
||||||
|
"or two ISO-8601 dates/timestamps): ")
|
||||||
|
(append '("begin" "end")
|
||||||
|
(reverse (hash-table-keys chronometrist-events)))
|
||||||
|
nil nil (pcase chronometrist-details-range
|
||||||
|
('nil nil)
|
||||||
|
((pred stringp)
|
||||||
|
(format "%s" chronometrist-details-range))
|
||||||
|
(`(,begin . ,end)
|
||||||
|
(format "%s,%s" begin end)))
|
||||||
|
'chronometrist-details-range-history))
|
||||||
|
(new-value (chronometrist-details-input-to-value input))
|
||||||
|
(buffer-name (pcase new-value
|
||||||
|
('date
|
||||||
|
(chronometrist-details-buffer-name date))
|
||||||
|
(`(,begin . ,end)
|
||||||
|
(chronometrist-details-buffer-name (format "%s_%s" begin end))))))
|
||||||
|
(chronometrist-details-setup-buffer (get-buffer-create buffer-name))
|
||||||
|
(with-current-buffer buffer-name
|
||||||
|
(setq-local chronometrist-details-range new-value)
|
||||||
|
(tabulated-list-revert))))
|
||||||
|
|
||||||
|
(defvar chronometrist-details-filter nil
|
||||||
|
"Parameters to filter intervals displayed by `chronometrist-details'.
|
||||||
|
Values can be one of -
|
||||||
|
nil - no filter. Display all intervals in the given time range.
|
||||||
|
A list of keywords - display intervals containing all given keywords.
|
||||||
|
A plist - display intervals containing all given keyword-values.
|
||||||
|
A predicate of one argument (the interval plist) - display all
|
||||||
|
intervals for which the predicate returns non-nil.")
|
||||||
|
(make-variable-buffer-local 'chronometrist-details-filter)
|
||||||
|
|
||||||
|
(defun chronometrist-details-filter-match-p (plist filter)
|
||||||
|
"Return PLIST if it matches FILTER.
|
||||||
|
FILTER must be a filter specifier as described by
|
||||||
|
`chronometrist-details-filter'."
|
||||||
|
(cond ((null filter) plist)
|
||||||
|
((seq-every-p #'keywordp filter)
|
||||||
|
(when (--every-p (plist-get plist it) filter)
|
||||||
|
plist))
|
||||||
|
((chronometrist-plist-p filter)
|
||||||
|
(when (cl-loop for (keyword value) on filter by #'cddr
|
||||||
|
always (equal (plist-get plist keyword) value))
|
||||||
|
plist))
|
||||||
|
((functionp filter)
|
||||||
|
(when (funcall filter plist) plist))
|
||||||
|
(t (error "Invalid filter."))))
|
||||||
|
|
||||||
|
(defun chronometrist-details-set-filter ()
|
||||||
|
"Prompt user for filter for current `chronometrist-details' buffer."
|
||||||
|
(interactive)
|
||||||
|
(let* ((input (read-from-minibuffer
|
||||||
|
(concat "Filter (blank, a list of keywords, "
|
||||||
|
"a plist, or a predicate): ")
|
||||||
|
nil nil nil 'chronometrist-details-filter-history
|
||||||
|
(pcase chronometrist-details-filter
|
||||||
|
('nil "")
|
||||||
|
((pred consp) (format "%S" chronometrist-details-filter)))))
|
||||||
|
(sexp (ignore-errors (read input))))
|
||||||
|
(cond ((equal input "") (setq-local chronometrist-details-filter nil))
|
||||||
|
((consp sexp) (setq-local chronometrist-details-filter sexp))
|
||||||
|
(_ (error "Unsupported filter.")))
|
||||||
|
(tabulated-list-revert)))
|
||||||
|
|
||||||
|
(defun chronometrist-details-intervals (range filter table)
|
||||||
|
"Return plists matching RANGE and FILTER from TABLE.
|
||||||
|
For values of RANGE, see `chronometrist-details-range'. For
|
||||||
|
values of FILTER, see `chronometrist-details-filter'. TABLE must
|
||||||
|
be a hash table similar to `chronometrist-events'."
|
||||||
|
(cl-loop for plist in (chronometrist-details-intervals-for-range range table)
|
||||||
|
when (chronometrist-details-filter-match-p plist filter)
|
||||||
|
collect plist))
|
||||||
|
|
||||||
(provide 'chronometrist)
|
(provide 'chronometrist)
|
||||||
|
|
||||||
|
|
|
@ -475,12 +475,12 @@ EVENTS must be a list of valid Chronometrist property lists (see
|
||||||
Return 0 if EVENTS is nil."
|
Return 0 if EVENTS is nil."
|
||||||
(if events
|
(if events
|
||||||
(cl-loop for plist in events collect
|
(cl-loop for plist in events collect
|
||||||
(let* ((start-ts (chronometrist-iso-timestamp-to-ts
|
(let* ((start-ts (chronometrist-iso-to-ts
|
||||||
(plist-get plist :start)))
|
(plist-get plist :start)))
|
||||||
(stop-iso (plist-get plist :stop))
|
(stop-iso (plist-get plist :stop))
|
||||||
;; Add a stop time if it does not exist.
|
;; Add a stop time if it does not exist.
|
||||||
(stop-ts (if stop-iso
|
(stop-ts (if stop-iso
|
||||||
(chronometrist-iso-timestamp-to-ts stop-iso)
|
(chronometrist-iso-to-ts stop-iso)
|
||||||
(ts-now))))
|
(ts-now))))
|
||||||
(ts-diff stop-ts start-ts)))
|
(ts-diff stop-ts start-ts)))
|
||||||
0))
|
0))
|
||||||
|
@ -1532,7 +1532,7 @@ TIMESTAMP must be a time string in the ISO-8601 format.
|
||||||
Return value is a ts struct (see `ts.el')."
|
Return value is a ts struct (see `ts.el')."
|
||||||
(-let [(h m s) (mapcar #'string-to-number (split-string time ":"))]
|
(-let [(h m s) (mapcar #'string-to-number (split-string time ":"))]
|
||||||
(ts-apply :hour h :minute m :second s
|
(ts-apply :hour h :minute m :second s
|
||||||
(chronometrist-iso-timestamp-to-ts timestamp))))
|
(chronometrist-iso-to-ts timestamp))))
|
||||||
#+END_SRC
|
#+END_SRC
|
||||||
**** tests
|
**** tests
|
||||||
#+BEGIN_SRC emacs-lisp :tangle chronometrist-tests.el :load test
|
#+BEGIN_SRC emacs-lisp :tangle chronometrist-tests.el :load test
|
||||||
|
@ -1609,7 +1609,7 @@ were none."
|
||||||
"Add PLIST to the end of `chronometrist-events'.
|
"Add PLIST to the end of `chronometrist-events'.
|
||||||
If REPLACE is non-nil, replace the last event with PLIST."
|
If REPLACE is non-nil, replace the last event with PLIST."
|
||||||
(let* ((date (->> (plist-get plist :start)
|
(let* ((date (->> (plist-get plist :start)
|
||||||
(chronometrist-iso-timestamp-to-ts )
|
(chronometrist-iso-to-ts )
|
||||||
(ts-format "%F" )))
|
(ts-format "%F" )))
|
||||||
(events-today (gethash date chronometrist-events)))
|
(events-today (gethash date chronometrist-events)))
|
||||||
(--> (if replace (-drop-last 1 events-today) events-today)
|
(--> (if replace (-drop-last 1 events-today) events-today)
|
||||||
|
@ -1635,6 +1635,7 @@ If REPLACE is non-nil, replace the last event with PLIST."
|
||||||
*** events-subset :reader:
|
*** events-subset :reader:
|
||||||
:PROPERTIES:
|
:PROPERTIES:
|
||||||
:VALUE: hash table
|
:VALUE: hash table
|
||||||
|
:CUSTOM_ID: program-data-structures-events-subset
|
||||||
:END:
|
:END:
|
||||||
#+BEGIN_SRC emacs-lisp
|
#+BEGIN_SRC emacs-lisp
|
||||||
(defun chronometrist-events-subset (start end)
|
(defun chronometrist-events-subset (start end)
|
||||||
|
@ -1648,7 +1649,7 @@ treated as though their time is 00:00:00."
|
||||||
(start (chronometrist-date start))
|
(start (chronometrist-date start))
|
||||||
(end (chronometrist-date end)))
|
(end (chronometrist-date end)))
|
||||||
(maphash (lambda (key value)
|
(maphash (lambda (key value)
|
||||||
(when (ts-in start end (chronometrist-iso-date-to-ts key))
|
(when (ts-in start end (chronometrist-iso-to-ts key))
|
||||||
(puthash key value subset)))
|
(puthash key value subset)))
|
||||||
chronometrist-events)
|
chronometrist-events)
|
||||||
subset))
|
subset))
|
||||||
|
@ -1760,11 +1761,12 @@ unchanged."
|
||||||
(setq chronometrist-task-list (remove task chronometrist-task-list)))))
|
(setq chronometrist-task-list (remove task chronometrist-task-list)))))
|
||||||
#+END_SRC
|
#+END_SRC
|
||||||
** Time functions
|
** Time functions
|
||||||
*** iso-timestamp-to-ts :function:
|
*** iso-to-ts :function:
|
||||||
#+BEGIN_SRC emacs-lisp
|
#+BEGIN_SRC emacs-lisp
|
||||||
(defun chronometrist-iso-timestamp-to-ts (timestamp)
|
(defun chronometrist-iso-to-ts (timestamp)
|
||||||
"Convert TIMESTAMP to a TS struct. (see `ts.el')
|
"Convert TIMESTAMP to a TS struct. (see `ts.el')
|
||||||
TIMESTAMP must be the ISO-8601 format, as handled by `parse-iso8601-time-string'."
|
TIMESTAMP must be an ISO-8601 timestamp, as handled by
|
||||||
|
`parse-iso8601-time-string'."
|
||||||
(-let [(second minute hour day month year dow _dst utcoff)
|
(-let [(second minute hour day month year dow _dst utcoff)
|
||||||
(decode-time
|
(decode-time
|
||||||
(parse-iso8601-time-string timestamp))]
|
(parse-iso8601-time-string timestamp))]
|
||||||
|
@ -1772,17 +1774,18 @@ TIMESTAMP must be the ISO-8601 format, as handled by `parse-iso8601-time-string'
|
||||||
(make-ts :hour hour :minute minute :second second
|
(make-ts :hour hour :minute minute :second second
|
||||||
:day day :month month :year year
|
:day day :month month :year year
|
||||||
:dow dow :tz-offset utcoff))))
|
:dow dow :tz-offset utcoff))))
|
||||||
|
|
||||||
#+END_SRC
|
#+END_SRC
|
||||||
*** iso-date-to-ts :function:
|
**** tests
|
||||||
#+BEGIN_SRC emacs-lisp
|
#+BEGIN_SRC emacs-lisp :tangle chronometrist-tests.el :load test
|
||||||
(defun chronometrist-iso-date-to-ts (date)
|
(ert-deftest chronometrist-iso-to-ts ()
|
||||||
"Return a ts struct (see `ts.el') representing DATE.
|
(should (ts= (chronometrist-iso-to-ts "2021-01-01")
|
||||||
DATE should be an ISO-8601 date string (\"YYYY-MM-DD\")."
|
(make-ts :year 2021 :month 1 :day 1
|
||||||
(-let [(year month day) (mapcar #'string-to-number
|
:hour 0 :minute 0 :second 0)))
|
||||||
(split-string date "-"))]
|
(should (ts= (chronometrist-iso-to-ts "2021-01-01T01:01:01")
|
||||||
(ts-update
|
(make-ts :year 2021 :month 1 :day 1
|
||||||
(make-ts :hour 0 :minute 0 :second 0
|
:hour 1 :minute 1 :second 1))))
|
||||||
:day day :month month :year year))))
|
|
||||||
#+END_SRC
|
#+END_SRC
|
||||||
*** date :function:
|
*** date :function:
|
||||||
#+BEGIN_SRC emacs-lisp
|
#+BEGIN_SRC emacs-lisp
|
||||||
|
@ -1823,8 +1826,8 @@ Return a list in the form
|
||||||
;; time-zone-spanning events
|
;; time-zone-spanning events
|
||||||
|
|
||||||
;; The time on which the first provided day starts (according to `chronometrist-day-start-time')
|
;; The time on which the first provided day starts (according to `chronometrist-day-start-time')
|
||||||
(let* ((start-ts (chronometrist-iso-timestamp-to-ts start-time))
|
(let* ((start-ts (chronometrist-iso-to-ts start-time))
|
||||||
(stop-ts (chronometrist-iso-timestamp-to-ts stop-time))
|
(stop-ts (chronometrist-iso-to-ts stop-time))
|
||||||
(first-day-start (chronometrist-apply-time day-start-time start-time))
|
(first-day-start (chronometrist-apply-time day-start-time start-time))
|
||||||
(next-day-start (ts-adjust 'hour 24 first-day-start)))
|
(next-day-start (ts-adjust 'hour 24 first-day-start)))
|
||||||
;; Does the event stop time exceed the next day start time?
|
;; Does the event stop time exceed the next day start time?
|
||||||
|
@ -2892,7 +2895,7 @@ TABLE should be a hash table - if not supplied,
|
||||||
with events-in-day
|
with events-in-day
|
||||||
for date being the hash-keys of table
|
for date being the hash-keys of table
|
||||||
when (setq events-in-day
|
when (setq events-in-day
|
||||||
(chronometrist-task-events-in-day task (chronometrist-iso-date-to-ts date)))
|
(chronometrist-task-events-in-day task (chronometrist-iso-to-ts date)))
|
||||||
do (cl-incf days) and
|
do (cl-incf days) and
|
||||||
collect
|
collect
|
||||||
(-reduce #'+ (chronometrist-events-to-durations events-in-day))
|
(-reduce #'+ (chronometrist-events-to-durations events-in-day))
|
||||||
|
@ -3125,14 +3128,22 @@ If ARG is a numeric argument, go forward that many times."
|
||||||
:group 'chronometrist)
|
:group 'chronometrist)
|
||||||
#+END_SRC
|
#+END_SRC
|
||||||
|
|
||||||
**** buffer-name :custom:variable:
|
**** buffer-name-base :custom:variable:
|
||||||
#+BEGIN_SRC emacs-lisp
|
#+BEGIN_SRC emacs-lisp
|
||||||
(defcustom chronometrist-details-buffer-name "*chronometrist-details*"
|
(defcustom chronometrist-details-buffer-name-base "chronometrist-details"
|
||||||
"Name of buffer created by `chronometrist-details'."
|
"Name of buffer created by `chronometrist-details'."
|
||||||
:type 'string)
|
:type 'string)
|
||||||
|
|
||||||
#+END_SRC
|
#+END_SRC
|
||||||
|
|
||||||
|
**** buffer-name :reader:
|
||||||
|
#+BEGIN_SRC emacs-lisp
|
||||||
|
(defun chronometrist-details-buffer-name (&optional suffix)
|
||||||
|
(if suffix
|
||||||
|
(format "*%s_%s*" chronometrist-details-buffer-name-base suffix)
|
||||||
|
(format "*%s*" chronometrist-details-buffer-name-base)))
|
||||||
|
|
||||||
|
#+END_SRC
|
||||||
**** display-tags :custom:variable:
|
**** display-tags :custom:variable:
|
||||||
If the value of this variable is a function and the string it returns contains a newline, the results may be undesirable...but hardly unrecoverable, so try it and see, if you wish.
|
If the value of this variable is a function and the string it returns contains a newline, the results may be undesirable...but hardly unrecoverable, so try it and see, if you wish.
|
||||||
|
|
||||||
|
@ -3220,9 +3231,11 @@ LIST is either tags (a list of symbols) or a plist."
|
||||||
(if (and contents custom)
|
(if (and contents custom)
|
||||||
(pcase custom
|
(pcase custom
|
||||||
((pred stringp)
|
((pred stringp)
|
||||||
|
(--> (flatten-list contents)
|
||||||
|
(seq-remove #'keywordp it)
|
||||||
(mapconcat
|
(mapconcat
|
||||||
(lambda (elt) (format custom elt))
|
(lambda (elt) (format custom elt))
|
||||||
contents " "))
|
it ", ")))
|
||||||
((pred functionp)
|
((pred functionp)
|
||||||
(funcall custom list)))
|
(funcall custom list)))
|
||||||
"")))
|
"")))
|
||||||
|
@ -3264,25 +3277,26 @@ using `chronometrist-details-schema-transformers'.")
|
||||||
"Return rows to be displayed in the `chronometrist-details' buffer.
|
"Return rows to be displayed in the `chronometrist-details' buffer.
|
||||||
Return value is a list as specified by `tabulated-list-entries'."
|
Return value is a list as specified by `tabulated-list-entries'."
|
||||||
(cl-loop with index = 1
|
(cl-loop with index = 1
|
||||||
for plist in (gethash (chronometrist-events-last-date) chronometrist-events) collect
|
for plist in (chronometrist-details-intervals chronometrist-details-range chronometrist-details-filter chronometrist-events)
|
||||||
|
collect
|
||||||
(-let* (((&plist :name name :tags tags :start start :stop stop) plist)
|
(-let* (((&plist :name name :tags tags :start start :stop stop) plist)
|
||||||
;; whether tags or key-values are actually displayed is handled later
|
;; whether tags or key-values are actually displayed is handled later
|
||||||
(tags (chronometrist-details-rows-helper tags))
|
(tags (chronometrist-details-rows-helper tags))
|
||||||
(key-values (chronometrist-details-rows-helper plist))
|
(key-values (chronometrist-details-rows-helper plist))
|
||||||
;; resetting seconds with `ts-apply' is necessary to
|
;; resetting seconds with `ts-apply' is necessary to
|
||||||
;; prevent situations like "1 hour from 00:08 to 01:09"
|
;; prevent situations like "1 hour from 00:08 to 01:09"
|
||||||
(start (ts-apply :second 0
|
(start (ts-apply :second 0 (chronometrist-iso-to-ts start)))
|
||||||
(chronometrist-iso-timestamp-to-ts start)))
|
(stop (ts-apply :second 0 (if stop
|
||||||
(stop (ts-apply :second 0
|
(chronometrist-iso-to-ts stop)
|
||||||
(if stop
|
|
||||||
(chronometrist-iso-timestamp-to-ts stop)
|
|
||||||
(ts-now))))
|
(ts-now))))
|
||||||
(interval (floor (ts-diff stop start)))
|
(interval (floor (ts-diff stop start)))
|
||||||
(index-string (format "%s" index))
|
(index-string (format "%s" index))
|
||||||
(duration (chronometrist-format-duration-long interval))
|
(duration (chronometrist-format-duration-long interval))
|
||||||
(timespan (format "from %s to %s"
|
(timespan (format "from %s to %s"
|
||||||
(ts-format chronometrist-details-time-format-string start)
|
(ts-format chronometrist-details-time-format-string
|
||||||
(ts-format chronometrist-details-time-format-string stop))))
|
start)
|
||||||
|
(ts-format chronometrist-details-time-format-string
|
||||||
|
stop))))
|
||||||
(--> (vconcat (vector index-string name)
|
(--> (vconcat (vector index-string name)
|
||||||
(when chronometrist-details-display-tags (vector tags))
|
(when chronometrist-details-display-tags (vector tags))
|
||||||
(when chronometrist-details-display-key-values (vector key-values))
|
(when chronometrist-details-display-key-values (vector key-values))
|
||||||
|
@ -3292,6 +3306,29 @@ Return value is a list as specified by `tabulated-list-entries'."
|
||||||
do (cl-incf index)))
|
do (cl-incf index)))
|
||||||
#+END_SRC
|
#+END_SRC
|
||||||
|
|
||||||
|
**** map :keymap:
|
||||||
|
#+BEGIN_SRC emacs-lisp
|
||||||
|
(defvar chronometrist-details-mode-map
|
||||||
|
(let ((map (make-sparse-keymap)))
|
||||||
|
(define-key map (kbd "s r") #'chronometrist-details-set-range)
|
||||||
|
(define-key map (kbd "s f") #'chronometrist-details-set-filter)
|
||||||
|
(define-key map (kbd "r") #'chronometrist-report)
|
||||||
|
(define-key map (kbd "l") #'chronometrist-open-log)
|
||||||
|
(define-key map (kbd "G") #'chronometrist-reset)
|
||||||
|
map))
|
||||||
|
|
||||||
|
#+END_SRC
|
||||||
|
**** chronometrist-details-menu :menu:
|
||||||
|
#+BEGIN_SRC emacs-lisp
|
||||||
|
(easy-menu-define chronometrist-details-menu chronometrist-details-mode-map
|
||||||
|
"Menu for `chronometrist-details'."
|
||||||
|
'("Details"
|
||||||
|
["Set date/time range" chronometrist-details-set-range]
|
||||||
|
["Set interval filter" chronometrist-details-set-filter]
|
||||||
|
["View weekly report" chronometrist-report]
|
||||||
|
["View/edit log file" chronometrist-open-log]
|
||||||
|
["Reset state" chronometrist-reset]))
|
||||||
|
#+END_SRC
|
||||||
**** chronometrist-details-mode :major:mode:
|
**** chronometrist-details-mode :major:mode:
|
||||||
#+BEGIN_SRC emacs-lisp
|
#+BEGIN_SRC emacs-lisp
|
||||||
(define-derived-mode chronometrist-details-mode tabulated-list-mode "Details"
|
(define-derived-mode chronometrist-details-mode tabulated-list-mode "Details"
|
||||||
|
@ -3306,20 +3343,206 @@ Return value is a list as specified by `tabulated-list-entries'."
|
||||||
(run-hooks 'chronometrist-mode-hook))
|
(run-hooks 'chronometrist-mode-hook))
|
||||||
#+END_SRC
|
#+END_SRC
|
||||||
|
|
||||||
|
**** details-setup-buffer :procedure:
|
||||||
|
#+BEGIN_SRC emacs-lisp
|
||||||
|
(defun chronometrist-details-setup-buffer (buffer-or-name)
|
||||||
|
"Enable `chronometrist-details-mode' in BUFFER-OR-NAME and switch to it.
|
||||||
|
BUFFER-OR-NAME must be an existing buffer."
|
||||||
|
(with-current-buffer buffer-or-name
|
||||||
|
(switch-to-buffer buffer-or-name)
|
||||||
|
(chronometrist-details-mode)
|
||||||
|
(tabulated-list-print)))
|
||||||
|
|
||||||
|
#+END_SRC
|
||||||
**** chronometrist-details :command:
|
**** chronometrist-details :command:
|
||||||
#+BEGIN_SRC emacs-lisp
|
#+BEGIN_SRC emacs-lisp
|
||||||
(defun chronometrist-details ()
|
(defun chronometrist-details ()
|
||||||
(interactive)
|
(interactive)
|
||||||
(let ((buffer (get-buffer-create chronometrist-details-buffer-name))
|
(let ((buffer (get-buffer-create (chronometrist-details-buffer-name)))
|
||||||
(window (save-excursion
|
(window (save-excursion
|
||||||
(get-buffer-window chronometrist-details-buffer-name t))))
|
(get-buffer-window buffer t))))
|
||||||
(cond (window (kill-buffer chronometrist-details-buffer-name))
|
(cond (window (kill-buffer buffer))
|
||||||
(t (with-current-buffer buffer
|
(t (chronometrist-details-setup-buffer buffer)))))
|
||||||
(switch-to-buffer buffer)
|
|
||||||
(chronometrist-details-mode)
|
|
||||||
(tabulated-list-print))))))
|
|
||||||
#+END_SRC
|
#+END_SRC
|
||||||
|
|
||||||
|
**** range :variable:
|
||||||
|
#+BEGIN_SRC emacs-lisp
|
||||||
|
(defvar chronometrist-details-range nil
|
||||||
|
"Time range for intervals displayed by `chronometrist-details'.
|
||||||
|
Values can be one of -
|
||||||
|
nil - no range. Display all intervals for today.
|
||||||
|
An ISO date string - display intervals for this date.
|
||||||
|
A cons cell in the form (BEGIN . END), where BEGIN and END are
|
||||||
|
ISO date strings (inclusive) or date-time strings (\"BEGIN\"
|
||||||
|
inclusive, \"END\" exclusive) - display intervals in this
|
||||||
|
range.")
|
||||||
|
(make-variable-buffer-local 'chronometrist-details-range)
|
||||||
|
|
||||||
|
#+END_SRC
|
||||||
|
**** iso-date-p :function:
|
||||||
|
#+BEGIN_SRC emacs-lisp
|
||||||
|
(defun chronometrist-iso-date-p (string)
|
||||||
|
(string-match-p
|
||||||
|
(rx (and string-start
|
||||||
|
(>= 1 num) "-" (= 2 num) "-" (= 2 num)
|
||||||
|
string-end))
|
||||||
|
string))
|
||||||
|
|
||||||
|
#+END_SRC
|
||||||
|
**** intervals-for-range :reader:
|
||||||
|
This is basically like [[#program-data-structures-events-subset][chronometrist-events-subset]], but returns a list instead of a hash table. Might replace one with the other in the future.
|
||||||
|
|
||||||
|
#+BEGIN_SRC emacs-lisp
|
||||||
|
(defun chronometrist-details-intervals-for-range (range table)
|
||||||
|
"Return intervals for RANGE from TABLE.
|
||||||
|
RANGE must be a time range as specified by `chronometrist-details-range'.
|
||||||
|
|
||||||
|
TABLE must be a hash table similar to `chronometrist-events'."
|
||||||
|
(pcase range
|
||||||
|
('nil
|
||||||
|
(gethash (format-time-string "%F") table))
|
||||||
|
((pred stringp)
|
||||||
|
(gethash range table))
|
||||||
|
(`(,begin . ,end)
|
||||||
|
;; `chronometrist-iso-to-ts' also accepts ISO dates
|
||||||
|
(let ((begin-ts (chronometrist-iso-to-ts begin))
|
||||||
|
(end-ts (chronometrist-iso-to-ts end)))
|
||||||
|
(if (and (chronometrist-iso-date-p begin) (chronometrist-iso-date-p end))
|
||||||
|
(cl-loop while (not (ts> begin-ts end-ts))
|
||||||
|
append (gethash (ts-format "%F" begin-ts) table)
|
||||||
|
do (ts-adjustf begin-ts 'day 1))
|
||||||
|
(cl-loop while (not (ts> begin-ts end-ts))
|
||||||
|
append
|
||||||
|
(cl-loop for plist in (gethash (ts-format "%F" begin-ts) table)
|
||||||
|
when
|
||||||
|
(let ((start-ts (chronometrist-iso-to-ts (plist-get plist :start)))
|
||||||
|
(stop-ts (chronometrist-iso-to-ts (plist-get plist :stop))))
|
||||||
|
(and (ts>= start-ts begin-ts)
|
||||||
|
(ts<= stop-ts end-ts)))
|
||||||
|
collect plist)
|
||||||
|
do (ts-adjustf begin-ts 'day 1)))))))
|
||||||
|
|
||||||
|
;; (chronometrist-details-intervals-for-range nil chronometrist-events)
|
||||||
|
;; (chronometrist-details-intervals-for-range "2021-06-01" chronometrist-events)
|
||||||
|
;; (chronometrist-details-intervals-for-range '("2021-06-01" . "2021-06-03") chronometrist-events)
|
||||||
|
;; (chronometrist-details-intervals-for-range '("2021-06-02T01:00+05:30" . "2021-06-02T03:00+05:30") chronometrist-events)
|
||||||
|
|
||||||
|
#+END_SRC
|
||||||
|
**** input-to-value :function:
|
||||||
|
#+BEGIN_SRC emacs-lisp
|
||||||
|
(defun chronometrist-details-input-to-value (input)
|
||||||
|
(pcase input
|
||||||
|
('nil nil)
|
||||||
|
(`(,date) date)
|
||||||
|
(`(,begin ,end)
|
||||||
|
(let* ((date-p (seq-find #'chronometrist-iso-date-p input))
|
||||||
|
(begin-date (car (hash-table-keys chronometrist-events)))
|
||||||
|
(begin-iso-ts (ts-format
|
||||||
|
"%FT%T%z" (chronometrist-iso-to-ts begin-date)))
|
||||||
|
(end-date (car (last (hash-table-keys chronometrist-events))))
|
||||||
|
(end-iso-ts (chronometrist-format-time-iso8601))
|
||||||
|
(begin (if (equal begin "begin")
|
||||||
|
(if date-p begin-date begin-iso-ts)
|
||||||
|
begin))
|
||||||
|
(end (if (equal end "end")
|
||||||
|
(if date-p end-date end-iso-ts)
|
||||||
|
end)))
|
||||||
|
(cons begin end)))
|
||||||
|
(_ (error "Unsupported range."))))
|
||||||
|
|
||||||
|
#+END_SRC
|
||||||
|
**** set-range :command:writer:
|
||||||
|
#+BEGIN_SRC emacs-lisp
|
||||||
|
(defun chronometrist-details-set-range ()
|
||||||
|
"Prompt user for range for current `chronometrist-details' buffer."
|
||||||
|
(interactive)
|
||||||
|
(let* ((input (completing-read-multiple
|
||||||
|
(concat "Range (blank, ISO-8601 date, "
|
||||||
|
"or two ISO-8601 dates/timestamps): ")
|
||||||
|
(append '("begin" "end")
|
||||||
|
(reverse (hash-table-keys chronometrist-events)))
|
||||||
|
nil nil (pcase chronometrist-details-range
|
||||||
|
('nil nil)
|
||||||
|
((pred stringp)
|
||||||
|
(format "%s" chronometrist-details-range))
|
||||||
|
(`(,begin . ,end)
|
||||||
|
(format "%s,%s" begin end)))
|
||||||
|
'chronometrist-details-range-history))
|
||||||
|
(new-value (chronometrist-details-input-to-value input))
|
||||||
|
(buffer-name (pcase new-value
|
||||||
|
('date
|
||||||
|
(chronometrist-details-buffer-name date))
|
||||||
|
(`(,begin . ,end)
|
||||||
|
(chronometrist-details-buffer-name (format "%s_%s" begin end))))))
|
||||||
|
(chronometrist-details-setup-buffer (get-buffer-create buffer-name))
|
||||||
|
(with-current-buffer buffer-name
|
||||||
|
(setq-local chronometrist-details-range new-value)
|
||||||
|
(tabulated-list-revert))))
|
||||||
|
|
||||||
|
#+END_SRC
|
||||||
|
**** filter :variable:
|
||||||
|
#+BEGIN_SRC emacs-lisp
|
||||||
|
(defvar chronometrist-details-filter nil
|
||||||
|
"Parameters to filter intervals displayed by `chronometrist-details'.
|
||||||
|
Values can be one of -
|
||||||
|
nil - no filter. Display all intervals in the given time range.
|
||||||
|
A list of keywords - display intervals containing all given keywords.
|
||||||
|
A plist - display intervals containing all given keyword-values.
|
||||||
|
A predicate of one argument (the interval plist) - display all
|
||||||
|
intervals for which the predicate returns non-nil.")
|
||||||
|
(make-variable-buffer-local 'chronometrist-details-filter)
|
||||||
|
|
||||||
|
#+END_SRC
|
||||||
|
**** filter-match-p :function:
|
||||||
|
#+BEGIN_SRC emacs-lisp
|
||||||
|
(defun chronometrist-details-filter-match-p (plist filter)
|
||||||
|
"Return PLIST if it matches FILTER.
|
||||||
|
FILTER must be a filter specifier as described by
|
||||||
|
`chronometrist-details-filter'."
|
||||||
|
(cond ((null filter) plist)
|
||||||
|
((seq-every-p #'keywordp filter)
|
||||||
|
(when (--every-p (plist-get plist it) filter)
|
||||||
|
plist))
|
||||||
|
((chronometrist-plist-p filter)
|
||||||
|
(when (cl-loop for (keyword value) on filter by #'cddr
|
||||||
|
always (equal (plist-get plist keyword) value))
|
||||||
|
plist))
|
||||||
|
((functionp filter)
|
||||||
|
(when (funcall filter plist) plist))
|
||||||
|
(t (error "Invalid filter."))))
|
||||||
|
|
||||||
|
#+END_SRC
|
||||||
|
**** set-filter :command:writer:
|
||||||
|
#+BEGIN_SRC emacs-lisp
|
||||||
|
(defun chronometrist-details-set-filter ()
|
||||||
|
"Prompt user for filter for current `chronometrist-details' buffer."
|
||||||
|
(interactive)
|
||||||
|
(let* ((input (read-from-minibuffer
|
||||||
|
(concat "Filter (blank, a list of keywords, "
|
||||||
|
"a plist, or a predicate): ")
|
||||||
|
nil nil nil 'chronometrist-details-filter-history
|
||||||
|
(pcase chronometrist-details-filter
|
||||||
|
('nil "")
|
||||||
|
((pred consp) (format "%S" chronometrist-details-filter)))))
|
||||||
|
(sexp (ignore-errors (read input))))
|
||||||
|
(cond ((equal input "") (setq-local chronometrist-details-filter nil))
|
||||||
|
((consp sexp) (setq-local chronometrist-details-filter sexp))
|
||||||
|
(_ (error "Unsupported filter.")))
|
||||||
|
(tabulated-list-revert)))
|
||||||
|
|
||||||
|
#+END_SRC
|
||||||
|
**** intervals :function:
|
||||||
|
#+BEGIN_SRC emacs-lisp
|
||||||
|
(defun chronometrist-details-intervals (range filter table)
|
||||||
|
"Return plists matching RANGE and FILTER from TABLE.
|
||||||
|
For values of RANGE, see `chronometrist-details-range'. For
|
||||||
|
values of FILTER, see `chronometrist-details-filter'. TABLE must
|
||||||
|
be a hash table similar to `chronometrist-events'."
|
||||||
|
(cl-loop for plist in (chronometrist-details-intervals-for-range range table)
|
||||||
|
when (chronometrist-details-filter-match-p plist filter)
|
||||||
|
collect plist))
|
||||||
|
|
||||||
|
#+END_SRC
|
||||||
** Provide
|
** Provide
|
||||||
#+BEGIN_SRC emacs-lisp
|
#+BEGIN_SRC emacs-lisp
|
||||||
(provide 'chronometrist)
|
(provide 'chronometrist)
|
||||||
|
|
Reference in New Issue