181 lines
6.5 KiB
EmacsLisp
181 lines
6.5 KiB
EmacsLisp
;;; chronometrist-sexp.el --- s-expression backend for Chronometrist -*- lexical-binding: t; -*-
|
|
|
|
;;; Commentary:
|
|
|
|
(require 'chronometrist-custom)
|
|
(require 'chronometrist-plist-pp)
|
|
(require 'ts)
|
|
|
|
;;; Code:
|
|
|
|
;; chronometrist-file (-custom)
|
|
;; chronometrist-events, chronometrist-events-maybe-split (-events)
|
|
;; chronometrist-plist-pp (-plist-pp)
|
|
|
|
(defmacro chronometrist-sexp-in-file (file &rest body)
|
|
"Run BODY in a buffer visiting FILE, restoring point afterwards."
|
|
(declare (indent defun) (debug t))
|
|
`(with-current-buffer (find-file-noselect ,file)
|
|
(save-excursion ,@body)))
|
|
|
|
;;;; Queries
|
|
(defun chronometrist-sexp-open-log ()
|
|
"Open `chronometrist-file' in another window."
|
|
(find-file-other-window chronometrist-file)
|
|
(goto-char (point-max)))
|
|
|
|
(cl-defun chronometrist-sexp-read (&optional ts-beg ts-end)
|
|
"Return events between TS-BEG and TS-END.
|
|
Events are a list of plists, in reverse chronological order.
|
|
|
|
If not supplied, TS-BEG is the beginning of today and TS-END is
|
|
the beginning of tomorrow, i.e. the events for today are returned.
|
|
|
|
If TS-BEG or TS-END is between the :start and :stop time of an
|
|
event, the event will be included. Thus, the first and the last
|
|
events may extend outside the given range.
|
|
|
|
The events returned may also cross the
|
|
`chronometrist-day-start-time', which can affect duration
|
|
calculations. See `chronometrist-events-maybe-split'.
|
|
|
|
If the latest (first) event does not have a :stop property, it
|
|
will be added with the current time as the value."
|
|
(let ((no-range-p (and (not ts-beg) (not ts-end))))
|
|
(chronometrist-sexp-in-file chronometrist-file
|
|
(goto-char (point-max))
|
|
(cl-loop
|
|
with expr with start with stop
|
|
do
|
|
(if (bobp)
|
|
(setq expr nil)
|
|
(backward-list 1)
|
|
(setq expr (read (current-buffer)))
|
|
(backward-list 1))
|
|
;; loop till we reach the beginning of the range
|
|
while
|
|
(and expr
|
|
(setq start (chronometrist-iso-timestamp->ts
|
|
(plist-get expr :start))
|
|
stop (plist-get expr :stop)
|
|
stop (if stop
|
|
(chronometrist-iso-timestamp->ts stop)
|
|
(let ((now (ts-now)))
|
|
(plist-put expr :stop (chronometrist-ts->iso now))
|
|
now)))
|
|
;; don't go past TS-BEG
|
|
(or no-range-p
|
|
(ts> start ts-beg)
|
|
(ts> stop ts-beg)))
|
|
when
|
|
(or no-range-p
|
|
(ts-in ts-beg ts-end start)
|
|
(ts-in ts-beg ts-end stop))
|
|
;; expr is within range
|
|
collect expr))))
|
|
|
|
(defun chronometrist-sexp-last ()
|
|
"Return last s-expression from `chronometrist-file'."
|
|
(chronometrist-sexp-in-file chronometrist-file
|
|
(goto-char (point-max))
|
|
(backward-list)
|
|
(ignore-errors (read (current-buffer)))))
|
|
|
|
(defun chronometrist-sexp-current-task ()
|
|
"Return the name of the currently clocked-in task, or nil if not clocked in."
|
|
(let ((last-event (chronometrist-sexp-last)))
|
|
(if (plist-member last-event :stop)
|
|
nil
|
|
(plist-get last-event :name))))
|
|
|
|
(defun chronometrist-sexp-events-populate ()
|
|
"Populate hash table `chronometrist-events'.
|
|
The data is acquired from `chronometrist-file'.
|
|
|
|
Return final number of events read from file, or nil if there
|
|
were none."
|
|
(chronometrist-sexp-in-file chronometrist-file
|
|
(goto-char (point-min))
|
|
(let ((index 0)
|
|
expr
|
|
pending-expr)
|
|
(while (or pending-expr
|
|
(setq expr (ignore-errors (read (current-buffer)))))
|
|
;; find and split midnight-spanning events during deserialization itself
|
|
(let* ((split-expr (chronometrist-events-maybe-split expr))
|
|
(new-value (cond (pending-expr
|
|
(prog1 pending-expr
|
|
(setq pending-expr nil)))
|
|
(split-expr
|
|
(setq pending-expr (cl-second split-expr))
|
|
(cl-first split-expr))
|
|
(t expr)))
|
|
(new-value-date (->> (plist-get new-value :start)
|
|
(s-left 10)))
|
|
(existing-value (gethash new-value-date chronometrist-events)))
|
|
(unless pending-expr (cl-incf index))
|
|
(puthash new-value-date
|
|
(if existing-value
|
|
(append existing-value
|
|
(list new-value))
|
|
(list new-value))
|
|
chronometrist-events)))
|
|
(unless (zerop index) index))))
|
|
|
|
;;;; Modifications
|
|
(defun chronometrist-sexp-create-file ()
|
|
"Create `chronometrist-file' if it doesn't already exist."
|
|
(unless (file-exists-p chronometrist-file)
|
|
(with-current-buffer (find-file-noselect chronometrist-file)
|
|
(write-file chronometrist-file))))
|
|
|
|
(cl-defun chronometrist-sexp-new (plist &optional (buffer (find-file-noselect chronometrist-file)))
|
|
"Add new PLIST at the end of `chronometrist-file'.
|
|
BUFFER is the buffer to operate in - default is one accessing `chronometrist-file'."
|
|
(with-current-buffer buffer
|
|
(goto-char (point-max))
|
|
;; If we're adding the first s-exp in the file, don't add a
|
|
;; newline before it
|
|
(unless (bobp) (insert "\n"))
|
|
(unless (bolp) (insert "\n"))
|
|
(chronometrist-plist-pp plist (current-buffer))
|
|
(save-buffer)))
|
|
|
|
(defun chronometrist-sexp-delete-list (&optional arg)
|
|
"Delete ARG lists after point."
|
|
(let ((point-1 (point)))
|
|
(forward-sexp (or arg 1))
|
|
(delete-region point-1 (point))))
|
|
|
|
(defun chronometrist-sexp-replace-last (plist)
|
|
"Replace the last s-expression in `chronometrist-file' with PLIST."
|
|
(chronometrist-sexp-in-file chronometrist-file
|
|
(goto-char (point-max))
|
|
(unless (and (bobp) (bolp))
|
|
(insert "\n"))
|
|
(backward-list 1)
|
|
(chronometrist-sexp-delete-list)
|
|
(chronometrist-plist-pp plist (current-buffer))
|
|
(save-buffer)))
|
|
|
|
(defun chronometrist-sexp-reindent-buffer ()
|
|
"Reindent the current buffer.
|
|
This is meant to be run in `chronometrist-file' when using the s-expression backend."
|
|
(interactive)
|
|
(let (expr)
|
|
(goto-char (point-min))
|
|
(while (setq expr (ignore-errors (read (current-buffer))))
|
|
(backward-list)
|
|
(chronometrist-sexp-delete-list)
|
|
(when (looking-at "\n*")
|
|
(delete-region (match-beginning 0)
|
|
(match-end 0)))
|
|
(chronometrist-plist-pp expr (current-buffer))
|
|
(insert "\n")
|
|
(unless (eobp)
|
|
(insert "\n")))))
|
|
|
|
(provide 'chronometrist-sexp)
|
|
|
|
;;; chronometrist-sexp.el ends here
|