Make interactive clocking in/out work

* -sexp.el - remove old multiple backends code, rename
  -in-sexp/-out-sexp to -in/-out

* -time.el - create -current-time-iso8601

* -events.el - -file-clean won't try to check an interval which
  doesn't have a :stop time (fixes error with current event)

* chronometrist.el - change quite a few uses of "project" to
  "task" (including function and argument names). Make -file-clean run
  before -events-populate. Replace calls to timeclock-in/out with
  chronometrist-in/out.
This commit is contained in:
contrapunctus 2019-09-07 09:43:03 +05:30
parent 6de886ffbe
commit 2b19b9f30e
4 changed files with 60 additions and 97 deletions

View File

@ -57,31 +57,32 @@ It returns t if the table was modified, else nil."
(let ((buffer (find-file-noselect chronometrist-file))
modified
expr)
(with-current-buffer (find-file-noselect chronometrist-file)
(with-current-buffer buffer
(save-excursion
(goto-char (point-min))
(while (setq expr (ignore-errors (read (current-buffer))))
(let ((split-time (chronometrist-events-midnight-spanning-p (plist-get expr :start)
(plist-get expr :stop))))
(when split-time
(let ((first-start (plist-get (first split-time) :start))
(first-stop (plist-get (first split-time) :stop))
(second-start (plist-get (second split-time) :start))
(second-stop (plist-get (second split-time) :stop)))
(backward-list 1)
(chronometrist-delete-list)
(-> expr
(plist-put :start first-start)
(plist-put :stop first-stop)
(plist-pp buffer))
(when (looking-at-p "\n\n")
(delete-char 2))
(-> expr
(plist-put :start second-start)
(plist-put :stop second-stop)
(plist-pp buffer))
(setq modified t))))))
(save-buffer))
(when (plist-get expr :stop)
(let ((split-time (chronometrist-events-midnight-spanning-p (plist-get expr :start)
(plist-get expr :stop))))
(when split-time
(let ((first-start (plist-get (first split-time) :start))
(first-stop (plist-get (first split-time) :stop))
(second-start (plist-get (second split-time) :start))
(second-stop (plist-get (second split-time) :stop)))
(backward-list 1)
(chronometrist-delete-list)
(-> expr
(plist-put :start first-start)
(plist-put :stop first-stop)
(plist-pp buffer))
(when (looking-at-p "\n\n")
(delete-char 2))
(-> expr
(plist-put :start second-start)
(plist-put :stop second-stop)
(plist-pp buffer))
(setq modified t))))))
(save-buffer)))
modified))
;; TODO - Maybe strip dates from values, since they're part of the key

View File

@ -13,43 +13,6 @@
(defvar chronometrist-file "~/.emacs.d/chronometrist.sexp"
"Default path and name of chronometrist database.")
(defvar chronometrist-current-backend 'timeclock)
;; Calling as a regular function doesn't work for interactive use,
;; unless we duplicate behaviour from timeclock-in/out.
;; `funcall-interactively' requires a recent Emacs.
(defun chronometrist-in (&optional arg project find-project)
"Start tracking time for a task.
ARG, PROJECT, and FIND-PROJECT are used as in `timeclock-in'.
The actual function to be called is determined by `chronometrist-in-function'."
(interactive "P")
(funcall-interactively (-> chronometrist-current-backend
(alist-get chronometrist-backends-alist)
(plist-get :in-function))
arg project find-project))
(defun chronometrist-out (&optional arg reason find-reason)
"Stop tracking time.
ARG, REASON, and FIND-REASON are used as in `timeclock-out'.
The actual function to be called is determined by `chronometrist-out-function'."
(interactive "P")
(funcall-interactively (-> chronometrist-current-backend
(alist-get chronometrist-backends-alist)
(plist-get :out-function))
arg reason find-reason))
;; Ugh. We have to use this so the argument list for timeclock-in/out
;; and chronometrist-in-plist/out-plist remain the same :\
(defvar chronometrist--event-plist nil
"Property list to be used by `chronometrist-in-plist'.")
(defun chronometrist-plist-remove (plist &rest keys)
"Return PLIST with KEYS and their associated values removed."
(let ((keys (--filter (plist-member plist it) keys)))
@ -60,7 +23,13 @@ The actual function to be called is determined by `chronometrist-out-function'."
keys)
plist))
(defun chronometrist-in-sexp (task plist)
(defun chronometrist-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-in (task &optional plist)
"Add new time interval as an s-expression to `chronometrist-file'.
TASK is the name of the task, a string.
@ -79,14 +48,8 @@ this time interval that should be recorded."
buffer)
(save-buffer))))
(defun chronometrist-delete-list (&optional arg)
"Delete ARG lists after point."
(let ((point-1 (point)))
(forward-sexp (or arg 1))
(delete-region point-1 (point))))
;; TODO - implement PLIST arg
(defun chronometrist-out-sexp (&optional plist)
(defun chronometrist-out (&optional plist)
"Record current moment as stop time to last s-exp in `chronometrist-file'.
PLIST is a property list containing any other information about
@ -97,11 +60,11 @@ this time interval that should be recorded."
(unless (bobp) (insert "\n"))
(backward-list 1)
(--> (read buffer)
(plist-put it :stop (format-time-string "%FT%T%z"))
(progn
(backward-list 1)
(chronometrist-delete-list)
(plist-pp it buffer)))
(plist-put it :stop (chronometrist-current-time-iso8601))
(progn
(backward-list 1)
(chronometrist-delete-list)
(plist-pp it buffer)))
(save-buffer))))
(provide 'chronometrist-sexp)

View File

@ -38,11 +38,11 @@ NUMBER should be an integer (0-6) - see
(car
(rassoc number chronometrist-report-weekday-number-alist)))
(defun chronometrist-unix-time->iso8601 (unix-time)
"Return UNIX-TIME as an ISO-8601 format time string.
(defun chronometrist-current-time-iso8601 (&optional unix-time)
"Return current moment as an ISO-8601 format time string.
UNIX-TIME must be a time value (see `current-time') accepted by
`format-time-string'."
Optional argument UNIX-TIME should be a time value (see
`current-time') accepted by `format-time-string'."
(format-time-string "%FT%T%z" unix-time))
;; Note - this assumes that an event never crosses >1 day. This seems
@ -63,8 +63,8 @@ Return value is a list in the form
(stop-time-unix (parse-iso8601-time-string stop-time)))
(when (time-less-p next-day-start stop-time-unix)
(list `(:start ,start-time
:stop ,(chronometrist-unix-time->iso8601 first-day-start))
`(:start ,(chronometrist-unix-time->iso8601 next-day-start)
:stop ,(chronometrist-current-time-iso8601 first-day-start))
`(:start ,(chronometrist-current-time-iso8601 next-day-start)
:stop ,stop-time)))))
;; Local Variables:

View File

@ -61,9 +61,9 @@
nil
(plist-get last-event :name))))
(defun chronometrist-project-active? (project)
"Return t if PROJECT is currently clocked in, else nil."
(equal (chronometrist-current-task) project))
(defun chronometrist-task-active? (task)
"Return t if TASK is currently clocked in, else nil."
(equal (chronometrist-current-task) task))
(defun chronometrist-seconds-to-hms (seconds)
"Convert SECONDS to a vector in the form [HOURS MINUTES SECONDS].
@ -92,7 +92,7 @@ SECONDS must be a positive integer."
'follow-link t)
(-> (chronometrist-project-time-one-day it)
(chronometrist-format-time))
(if (chronometrist-project-active? it)
(if (chronometrist-task-active? it)
"*" ""))))))
(defun chronometrist-project-at-point ()
@ -223,8 +223,8 @@ of `revert-buffer-function'."
(defun chronometrist-refresh-file (fs-event)
"Re-read `timeclock-file' and refresh the `chronometrist' buffer.
Argument FS-EVENT is ignored."
(chronometrist-file-clean)
(chronometrist-events-populate)
(chronometrist-events-clean)
(timeclock-reread-log)
(chronometrist-refresh))
@ -293,23 +293,22 @@ return a non-nil value.")
Each function in this hook must accept a single argument, which
is the clocked-out project.")
(defun chronometrist-run-project-start-functions (project)
(defun chronometrist-run-project-start-functions (task)
"Call each function in `chronometrist-project-start-functions' with PROJECT."
(run-hook-with-args 'chronometrist-project-start-functions
project))
task))
(defun chronometrist-run-after-project-stop-functions (project)
(defun chronometrist-run-after-project-stop-functions (task)
"Call each function in `chronometrist-after-project-stop-functions' with PROJECT."
(run-hook-with-args 'chronometrist-after-project-stop-functions
project))
task))
(defun chronometrist-run-functions-and-clock-out (project ask)
"Run hooks and clock out of PROJECT.
ASK is used like in `timeclock-out'."
(defun chronometrist-run-functions-and-clock-out (task)
"Run hooks and clock out of TASK."
(when (run-hook-with-args-until-failure 'chronometrist-before-project-stop-functions
project)
(timeclock-out nil nil ask)
(chronometrist-run-after-project-stop-functions project)))
task)
(chronometrist-out)
(chronometrist-run-after-project-stop-functions task)))
;; ## MAJOR-MODE ##
(defvar chronometrist-mode-map
@ -351,7 +350,7 @@ ASK is used like in `timeclock-out'."
;; clocked in + point on some other project = clock out, clock in to project
;; clocked out = clock in
(when current
(chronometrist-run-functions-and-clock-out current t))
(chronometrist-run-functions-and-clock-out current))
(unless (equal at-point current)
(chronometrist-run-project-start-functions at-point)
(timeclock-in nil at-point nil))
@ -361,7 +360,7 @@ ASK is used like in `timeclock-out'."
"Button action to add a new project."
(let ((current (chronometrist-current-task)))
(when current
(chronometrist-run-functions-and-clock-out current t))
(chronometrist-run-functions-and-clock-out current))
(let ((p (read-from-minibuffer "New project name: " nil nil nil nil nil t)))
(chronometrist-run-project-start-functions p)
(timeclock-in nil p nil))
@ -395,10 +394,10 @@ If NO-PROMPT is non-nil, don't ask for a reason."
;; clocked in + target is some other project = clock out, clock in to project
;; clocked out = clock in
(when current
(chronometrist-run-functions-and-clock-out current ask))
(chronometrist-run-functions-and-clock-out current))
(unless (equal target current)
(chronometrist-run-project-start-functions target)
(timeclock-in nil target nil))))
(chronometrist-in target))))
(chronometrist-refresh)))
(defun chronometrist-toggle-project-no-reason (&optional prefix)