This repository has been archived on 2022-05-13. You can view files and clone it, but cannot push or open issues or pull requests.
chronometrist/elisp/chronometrist.org

207 KiB

Chronometrist - an extensible time tracker for Emacs

Introduction

This is a book about Chronometrist, a time tracker for Emacs, written by a humble hobbyist hacker. It also happens to contain the canonical copy of the source code, and can be loaded as an Emacs Lisp program using the literate-elisp library.

I hope this book—when completed—passes Tim Daly's "Hawaii Test", in which a programmer with no knowledge of this program whatsover can read this book end-to-end, and come out as much of an expert in its maintenance as the original author.

—contrapunctus

Explanation

Why I wrote Chronometrist

It probably started off with a desire for introspection and self-awareness - what did I do all day? How much time have I spent doing X? It is also a tool to help me stay focused on a single task at a time, and to not go overboard and work on something for 7 hours straight.

At first I tried an Android application, "A Time Tracker". The designs of Chronometrist's main buffer and the chronometrist-report buffer still resemble that of A Time Tracker. However, every now and then I'd forget to start or stop tracking. Each time I did, I had to open an SQLite database and edit UNIX timestamps to correct it, which was not fun :\

Later, I discovered John Wiegley's timeclock. It turned out that since it was an Emacs extension (actually, a part of Emacs), I was more likely to use it. Chronometrist started out as an "A Time Tracker"-like UI for timeclock, moving to an s-expression backend later.

Quite recently, after around two years of Chronometrist developement and use, I discovered that Org mode has a time tracking feature, too. Even though I've embraced some of the joys of Org, I'm not quite at ease with the idea of storing data in a complex text format with only one complete implementation.

Design goals

  1. Don't make assumptions about the user's profession

    • e.g. timeclock seems to assume you're using it for a 9-to-5/contractor job
  2. Incentivize use

    • Hooks allow the time tracker to automate tasks and become a useful part of your workflow
  3. Make it easy to edit data using existing, familiar tools

    • We don't use an SQL database, where changing a single field is tricky 1
    • We use a text file containing s-expressions (easy for humans to read and write)
    • We use ISO-8601 for timestamps (easy for humans to read and write) rather than UNIX epoch time
  4. Reduce human errors in tracking
  5. Have a useful, informative, interactive interface
  6. Support mouse and keyboard use equally

Terminology

For lack of a better term, events are how we refer to time intervals. They are stored as plists; each contains at least a :name "<name>", a :start "<iso-timestamp>", and (except in case of an ongoing task) a :stop "<iso-timestamp>".

row
a row of a table in a tabulated-list-mode buffer; an element of tabulated-list-entries.
schema
the column descriptor of a table in a tabulated-list-mode buffer; the value of tabulated-list-format.

See also Currently-Used Time Formats

Overview

At its most basic, we read data from a plain text file containing Lisp plists, store it in a hash table, and display it as a tabulated-list-mode buffer. When the file is changed—whether by the program or the user—we update the hash table and the buffer.

In addition, we implement a plist pretty-printer and some migration commands. This repository also contains an extension for attaching arbitrary metadata to time intervals, and there is a extension for time goals and alerts in a separate repository.

Optimization

It is of great importance that Chronometrist be responsive -

  • A responsive program is more likely to be used; recall our design goal of 'incentivizing use'.
  • Being an Emacs program, freezing the UI for any human-noticeable length of time is unacceptable - it prevents the user from working on anything in their environment.

Thus, I have considered various optimization strategies, and so far implemented two.

Prevent excess creation of file watchers

One of the earliest 'optimizations' of great importance turned out to simply be a bug - turns out, if you run an identical call to file-notify-add-watch twice, you create two file watchers and your callback will be called twice. We were creating a file watcher each time the chronometrist command was run. 🤦 This was causing humongous slowdowns each time the file changed. 😅

  • It was fixed in v0.2.2 by making the watch creation conditional, using chronometrist--fs-watch to store the watch object.

Preserve hash table state for some commands

NOTE - this has been replaced with a more general optimization - see next section.

The next one was released in v0.5. Till then, any time the chronometrist-file was modified, we'd clear the chronometrist-events hash table and read data into it again. The reading itself is nearly-instant, even with ~2 years' worth of data 2 (it uses Emacs' read, after all), but the splitting of midnight-spanning events is the real performance killer.

After the optimization…

  1. Two backend functions (chronometrist-sexp-new and chronometrist-sexp-replace-last) were modified to set a flag (chronometrist--inhibit-read-p) before saving the file.
  2. If this flag is non-nil, chronometrist-refresh-file skips the expensive calls to chronometrist-events-populate, chronometrist-tasks-from-table, and chronometrist-tags-history-populate, and resets the flag.
  3. Instead, the aforementioned backend functions modify the relevant variables - chronometrist-events, chronometrist-task-list, and chronometrist-tags-history - via…

    • chronometrist-events-add / chronometrist-events-replace-last
    • chronometrist-task-list-add, and
    • chronometrist-tags-history-add / chronometrist-tags-history-replace-last, respectively.

There are still some operations which chronometrist-refresh-file runs unconditionally - which is to say there is scope for further optimization, if or when required.

Determine type of change made to file

Most changes, whether made through user-editing or by Chronometrist commands, happen at the end of the file. We try to detect the kind of change made - whether the last expression was modified, removed, or whether a new expression was added to the end - and make the corresponding change to chronometrist-events, instead of doing a full parse again (chronometrist-events-populate). The increase in responsiveness has been significant.

When chronometrist-refresh-file is run by the file system watcher, it uses chronometrist-file-hash to assign indices and a hash to chronometrist--file-state. The next time the file changes, chronometrist-file-change-type compares this state to the current state of the file to determine the type of change made.

Challenges -

  1. Correctly detecting the type of change
  2. Updating chronometrist-task-list and the Chronometrist buffer, when a new task is added or the last interval for a task is removed (v0.6.4)
  3. Handling changes made to an active interval after midnight

    • use the date from the plist's :start timestamp instead of the date today
    • :append - normally, add to table; for spanning intervals, invalid operation
    • :modify - normally, replace in table; for spanning intervals, split and replace
    • :remove - normally, remove from table; for spanning intervals, split and remove

Effects on the task list

  1. When a plist is added, the :name might be new, in which case we need to add it to the task list.
  2. When the last plist is modified, the :name may have changed -

    1. the :name might be new and require addition to the task list.
    2. the old plist may have been the only plist for the old :name, so we need to check if there are any other plists with the old :name. If there are none, the old :name needs to be removed from the task list.
  3. When the last plist is removed, it may have been the only plist for the old :name, so we need to check if there are any other plists with the old :name. If there are none, the old :name needs to be removed from the task list.

Midnight-spanning intervals

A unique problem in working with Chronometrist, one I had never foreseen, was tasks which start on one day and end on another. For instance, you start working on something at 2021-01-01T23:00 hours and stop on 2021-01-02T01:00.

These mess up data consumption in all sorts of unforeseen ways, especially interval calculations and acquiring intervals for a specific date. In case of two of the most common operations throughout the program -

  1. finding the intervals recorded on a given date -
  2. finding the time spent on a task on a given day - if the day's intervals used for this contain a midnight-spanning interval, you'll have inaccurate results - it will include yesterday's time from the interval as well as today's.

There are a few different approaches of dealing with them. (Currently, Chronometrist uses #3.)

Check the code of the first event of the day (timeclock format)

  • Advantage - very simple to detect
  • Disadvantage - "in" and "out" events must be represented separately

Split them at the file level

  • Advantage - operation is performed only once for each such event + simpler data-consuming code + reduced post-parsing load.
  • What happens when the user changes their day-start-time? The split-up events are now split wrongly, and the second event may get split again.

Possible solutions -

  1. Add function to check if, for two events A and B, the :stop of A is the same as the :start of B, and that all their other tags are identical. Then we can re-split them according to the new day-start-time.
  2. Add a :split tag to split events. It can denote that the next event was originally a part of this one.
  3. Re-check and update the file when the day-start-time changes.

    • Possible with add-variable-watcher or :custom-set in Customize (thanks bpalmer)

Split them at the hash-table-level

Handled by chronometrist-sexp-events-populate

  • Advantage - simpler data-consuming code.

Split them at the data-consumer level (e.g. when calculating time for one day/getting events for one day)

  • Advantage - reduced repetitive post-parsing load.

Point restore behaviour

After hacking, always test for and ensure the following -

  1. Toggling the buffer via chronometrist / chronometrist-report / chronometrist-statistics should preserve point
  2. The timer function should preserve point when the buffer is current
  3. The timer function should preserve point when the buffer is not current, but is visible in another window
  4. The next/previous week keys and buttons should preserve point.

chronometrist-report date range logic

A quick description, starting from the first time chronometrist-report is run in an Emacs session -

  1. We get the current date as a ts struct, using chronometrist-date.
  2. The variable chronometrist-report-week-start-day stores the day we consider the week to start with. The default is "Sunday". We check if the date from #2 is on the week start day, else decrement it till we are, using (chronometrist-report-previous-week-start).
  3. We store the date from #3 in the global variable chronometrist-report--ui-date.
  4. By counting up from chronometrist-report--ui-date, we get dates for the days in the next 7 days using (chronometrist-report-date->dates-in-week). We store them in chronometrist-report--ui-week-dates. The dates in chronometrist-report--ui-week-dates are what is finally used to query the data displayed in the buffer.
  5. To get data for the previous/next weeks, we decrement/increment the date in chronometrist-report--ui-date by 7 days and repeat the above process (via (chronometrist-report-previous-week) / (chronometrist-report-next-week)).

Literate programming

The shift from a bunch of Elisp files to a single Org literate program was born out of frustration with programs stored as text files, which are expensive to restructure (especially in the presence of a VCS). While some dissatisfactions remain, I generally prefer the outcome - tree and source-block folding, tags, properties, and org-match have made it trivial to get different views of the program, and literate programming may allow me to express the "explanation" documentation in the same context as the program, without having to try to link between documentation and source.

Tangling

At first, I tried tangling. Back when I used benchmark.el to test it, org-babel-tangle took about 30 seconds to tangle this file. Thus, I wrote a little sed one-liner (in the file-local variables) to do the tangling, which was nearly instant. It emitted anything between lines matching the exact strings "#+BEGIN_SRC emacs-lisp" and "#+END_SRC" -

# eval: (progn (make-local-variable 'after-save-hook) (add-hook 'after-save-hook (lambda () (start-process-shell-command "chronometrist-sed-tangle" "chronometrist-sed-tangle" "sed -n -e '/#+BEGIN_SRC emacs-lisp$/,/#+END_SRC$/{//!p;};/#+END_SRC/i\\ ' chronometrist.org | sed -E 's/^ +$//' > chronometrist.el"))))

literate-elisp-load

Later, we switched from tangling to using the literate-elisp package to loading this Org file directly - a file chronometrist.el would be used to load chronometrist.org.

(literate-elisp-load
 (format "%schronometrist.org" (file-name-directory load-file-name)))

This way, source links (e.g. help buffers, stack traces) would lead to this Org file, and this documentation was available to each user, within the comfort of their Emacs. The presence of the .el file meant that users of use-package did not need to make any changes to their configuration.

Reject modernity, return to tangling

For all its benefits, the previous approach broke autoloads and no sane way could be devised to make them work, so back we came to tangling. org-babel-tangle-file seems to be quicker when run as a Git pre-commit hook - a few seconds' delay before I write a commit message.

Certain tools like checkdoc remain a pain to use with any kind of literate program. This will probably continue to be the case until these tools are fixed or extended.

Definition metadata

Each definition has its own heading. The type of definition is stored in tags -

  1. custom group
  2. [custom|hook|internal] variable
  3. keymap (use variable instead?)
  4. macro
  5. function

    • does not refer to external state
    • primarily used for the return value
  6. reader

    • reads external state without modifying it
    • primarily used for the return value
  7. writer

    • modifies external state, namely a data structure or file
    • primarily used for side-effects
  8. procedure

    • any other impure function
    • usually affects the display
    • primarily used for side-effects
  9. major/minor mode
  10. command

Further details are stored in properties -

  1. :INPUT: (for functions)
  2. :VALUE: list|hash table|…

    • for functions, this is the return value
  3. :STATE: <external file or data structure read or written to>

TODO Issues [40%]

  1. When opening this file, Emacs may freeze at the prompt for file-local variable values; if so, C-g will quit the prompt, and permanently marking them as safe will make the freezing stop. 3
  2. I like visual-fill-column-mode for natural language, but I don't want it applied to code blocks. polymode.el may hold answers.
  3. Is there a tangling solution which requires only one command (e.g. currently we use two sed s) but is equally fast? 3

    • Perhaps we can get rid of the requirement of adding newlines after each source block, and add the newlines ourselves. That gives us control, and also makes it possible to insert Org text in the middle of a definition without unnecessary newlines.
  4. nameless-insert-name does not work in source blocks.
  5. Some source blocks don't get syntax highlighted.

    • A workaround is to press M-o M-o

Currently-Used Time Formats

ts

ts.el struct

  • Used by nearly all internal functions

iso-timestamp

"YYYY-MM-DDTHH:MM:SSZ"

  • Used in the s-expression file format
  • Read by chronometrist-sexp-events-populate
  • Used in the plists in the chronometrist-events hash table values

iso-date

"YYYY-MM-DD"

  • Used as hash table keys in chronometrist-events - can't use ts structs for keys, you'd have to make a hash table predicate which uses ts=

seconds

integer seconds as duration

  • Used for most durations
  • May be changed to floating point to allow larger durations. The minimum range of most-positive-fixnum is 536870911, which seems to be enough to represent durations of 17 years.
  • Used for update intervals (chronometrist-update-interval, chronometrist-change-update-interval)

minutes

integer minutes as duration

  • Used by chronometrist-goal (chronometrist-goals-list, chronometrist-get-goal) - minutes seems like the ideal unit for users to enter

list-duration

(hours minute seconds)

  • Only returned by chronometrist-seconds-to-hms, called by chronometrist-format-time

Backend protocol

The protocol as of now, with remarks -

  1. backend-run-assertions (backend)
  2. view-backend (backend)
  3. edit-backend (backend) - these two would make sense if there was only one way to view/edit a backend. But if we want viewing/editing frontends, there would be many.
  4. backend-empty-p (backend)
  5. backend-modified-p (backend)
  6. create-file (backend &optional file)
  7. latest-date-records (backend)
  8. insert (backend plist)
  9. remove-last (backend)
  10. latest-record (backend)
  11. task-records-for-date (backend task date-ts)
  12. replace-last (backend plist)
  13. to-file (input-hash-table output-backend output-file)
  14. on-add (backend)
  15. on-modify (backend)
  16. on-remove (backend)
  17. on-change (backend)
  18. verify (backend)
  19. on-file-path-change (backend old-path new-path)
  20. reset-backend (backend) - probably rename to "initialize"
  21. memory-layer-empty-p (backend) - needs a more generic name; perhaps "initialized-p", to go with #20
  22. to-hash-table (backend)
  23. to-list (backend)

There are many operations which are file-oriented, whereas I have tried to treat files as implementation details. create-file, for instance, is used by to-file; I could make creation of files implicit by moving it into initialize-instance, but that would mean creation of files in to-file would require creation of a backend object. That seems to me to be an abuse of implicit behaviour; and what would backends which are not file-backed do in to-file, then? There's probably a way to do it, but I had other things I preferred to tackle first.

generic cl-loop interface for iterating over records

Of all the ways to work with Chronometrist data, both as part of the program and as part of my occasional "queries", my favorite was to use cl-loop.

First, there was the chronometrist-loop-file macro, which handled the sole backend at that time - the plist backend. It took care of the common logic (read ing each plist in the file, checking loop termination conditions), and let the client code specify (with the terseness of cl-loop) what they wanted to do with the data.

During the migration to the CLOS-based backend design began the quest to make chronometrist-loop-file work with generic backends - it eventually became chronometrist-loop-records and chronometrist-loop-days. The idea was to call a generic function (chronometrist-record-iterator and chronometrist-day-iterator) which would return a new record on each call. Internal state of each of these generic functions was stored in backend slots. No list would be built up, unless the client code specified an accumulation clause.

Most recently, gilberth of #lispcafe suggested an alternate approach - trying to build a list of records first, and using cl-loop (or any other iteration mechanism) on that. Testing the two approaches yielded a clear advantage for this new suggestion. The test was to generate key-values suitable for completion history from my full Chronometrist data to date (the plist backend had ~6.6k plists in a 1.2M file), using almost identical cl-loop client code for both cases. Here was the output from (benchmark 1 ...) -

approach backend benchmark output
current plist "Elapsed time: 5.322056s (0.709023s in 4 GCs)"
current plist-group "Elapsed time: 107.159170s (1.064125s in 6 GCs)"
new plist "Elapsed time: 0.559264s (0.172344s in 1 GCs)"
new plist-group "Elapsed time: 0.671106s (0.179435s in 1 GCs)"

In addition, with this approach, client code can use any kind of iteration constructs they fancy - not just cl-loop but also dolist, higher-order functions (including those from dash and seq), loopy, etc.

The macro still exists in its non-generic form as chronometrist-loop-sexp-file, providing a common way to loop over s-expressions in a text file, used by chronometrist-to-list in both backends and chronometrist-to-hash-table in the plist group backend.

How-to guides for maintainers

How to set up Emacs to contribute

  1. Install nameless-mode for easier reading of Emacs Lisp code, and literate-elisp to load this file directly without tangling.

      (mapcar #'package-install '(nameless literate-elisp))
  2. Create a .dir-locals-2.el in the project root, containing -

      ((org-mode
        .
        ((eval . (nameless-mode))
         (eval . (progn
           (make-local-variable 'after-save-hook)
           ;; you can't `defun' in one `eval' and use the
           ;; function in another `eval', apparently
           (add-hook
            'after-save-hook
            (defun chronometrist-tangle ()
              (interactive)
              (compile
               (mapconcat #'shell-quote-argument
                          `("emacs" "-q" "-Q" "--batch"
                            "--eval=(require 'ob-tangle)"
                            ,(format "--eval=(org-babel-tangle-file \"%s\")"
                                     (buffer-file-name)))
                          " ")))))))))
  3. Set up compiling, linting, and testing with makem.sh. First, define this command -

    (defun run-makem ()
      (interactive)
      (cd (locate-dominating-file default-directory "makem.sh"))
      (compile "./makem.sh compile lint test-ert"))

    Then, run it after staging the files -

    (add-hook 'magit-post-stage-hook #'run-makem)

    Or after tangling ends -

      (add-hook 'org-babel-post-tangle-hook #'run-makem)

How to tangle this file

Use org-babel (org-babel-tangle / org-babel-tangle-file), not literate-elisp-tangle. The file emitted by the latter does not contain comments - thus, it does not contain library headers or abide by checkdoc's comment conventions.

The Program

Library headers and commentary

Library headers are necessary once more, since we're back to tangling instead of literate-elisp-load.

Once, for sake of neatness, I made the value of Package-Requires: multiline -

;; Package-Requires: ((emacs "25.1")
;;                    (dash "2.16.0")
;;                    (seq "2.20")
;;                    (ts "0.2"))

But I discovered that if I do that, package-lint says - error: Couldn't parse "Package-Requires" header: End of file during parsing.

;;; chronometrist.el --- A time tracker with a nice interface -*- lexical-binding: t; -*-

;; Author: contrapunctus <xmpp:contrapunctus@jabjab.de>
;; Maintainer: contrapunctus <xmpp:contrapunctus@jabjab.de>
;; Keywords: calendar
;; Homepage: https://tildegit.org/contrapunctus/chronometrist
;; Package-Requires: ((emacs "27.1") (dash "2.16.0") (seq "2.20") (ts "0.2"))
;; Version: 0.9.0

;; This is free and unencumbered software released into the public domain.
;;
;; Anyone is free to copy, modify, publish, use, compile, sell, or
;; distribute this software, either in source code form or as a compiled
;; binary, for any purpose, commercial or non-commercial, and by any
;; means.
;;
;; For more information, please refer to <https://unlicense.org>

"Commentary" is displayed when the user clicks on the package's entry in M-x list-packages.

;;; Commentary:
;;
;; A time tracker in Emacs with a nice interface

;; Largely modelled after the Android application, [A Time Tracker](https://github.com/netmackan/ATimeTracker)

;; * Benefits
;;   1. Extremely simple and efficient to use
;;   2. Displays useful information about your time usage
;;   3. Support for both mouse and keyboard
;;   4. Human errors in tracking are easily fixed by editing a plain text file
;;   5. Hooks to let you perform arbitrary actions when starting/stopping tasks

;; * Limitations
;;   1. No support (yet) for adding a task without clocking into it.
;;   2. No support for concurrent tasks.

;; ## Comparisons
;; ### timeclock.el
;; Compared to timeclock.el, Chronometrist
;; * stores data in an s-expression format rather than a line-based one
;; * supports attaching tags and arbitrary key-values to time intervals
;; * has commands to shows useful summaries
;; * has more hooks

;; ### Org time tracking
;; Chronometrist and Org time tracking seem to be equivalent in terms of capabilities, approaching the same ends through different means.
;; * Chronometrist doesn't have a mode line indicator at the moment. (planned)
;; * Chronometrist doesn't have Org's sophisticated querying facilities. (an SQLite backend is planned)
;; * Org does so many things that keybindings seem to necessarily get longer. Chronometrist has far fewer commands than Org, so most of the keybindings are single keys, without modifiers.
;; * Chronometrist's UI makes keybindings discoverable - they are displayed in the buffers themselves.
;; * Chronometrist's UI is cleaner, since the storage is separate from the display. It doesn't show tasks as trees like Org, but it uses tags and key-values to achieve that. Additionally, navigating a flat list takes fewer user operations than navigating a tree.
;; * Chronometrist data is just s-expressions (plists), and may be easier to parse than a complex text format with numerous use-cases.

;; For information on usage and customization, see https://tildegit.org/contrapunctus/chronometrist or the included manual.org

Dependencies

;;; Code:
;; This file was automatically generated from chronometrist.org
(require 'dash)
(require 'ts)

(require 'cl-lib)
(require 'seq)
(require 'filenotify)
(require 'subr-x)
(require 'parse-time)
(require 'eieio)

(eval-when-compile
  (defvar chronometrist-mode-map)
  (require 'subr-x))

Common definitions

custom group   custom group

(defgroup chronometrist nil
  "An extensible time tracker."
  :group 'applications)

format-time   function

(cl-defun chronometrist-format-duration (seconds &optional (blank (make-string 3 ?\s)))
  "Format SECONDS as a string suitable for display in Chronometrist buffers.
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)))))

file-empty-p   reader

(defun chronometrist-file-empty-p (file)
  "Return t if FILE is empty."
  (zerop (nth 7 (file-attributes file))))

format-keybinds   function

(defun chronometrist-format-keybinds (command map &optional firstonly)
  "Return the keybindings for COMMAND in MAP as a string.
If FIRSTONLY is non-nil, return only the first keybinding found."
  (if firstonly
      (key-description
       (where-is-internal command map firstonly))
    (->> (where-is-internal command map)
         (mapcar #'key-description)
         (-take 2)
         (-interpose ", ")
         (apply #'concat))))

day-start-time   custom variable

chronometrist-events-maybe-split refers to this, but I'm not sure this has the desired effect at the moment—haven't even tried using it.

(defcustom chronometrist-day-start-time "00:00:00"
  "The time at which a day is considered to start, in \"HH:MM:SS\".

The default is midnight, i.e. \"00:00:00\"."
  :type 'string)

week-start-day   custom variable

(defcustom chronometrist-report-week-start-day "Sunday"
  "The day used for start of week by `chronometrist-report'."
  :type 'string)

weekday-number-alist   custom variable

(defcustom chronometrist-report-weekday-number-alist
  '(("Sunday"    . 0)
    ("Monday"    . 1)
    ("Tuesday"   . 2)
    ("Wednesday" . 3)
    ("Thursday"  . 4)
    ("Friday"    . 5)
    ("Saturday"  . 6))
  "Alist in the form (\"NAME\" . NUMBER), where \"NAME\" is the name of a weekday and NUMBER its associated number."
  :type 'alist)

previous-week-start   reader

(defun chronometrist-previous-week-start (ts)
  "Find the previous `chronometrist-report-week-start-day' from TS.
Return a ts struct for said day's beginning.

If the day of TS is the same as the
`chronometrist-report-week-start-day', return TS.

TS must be a ts struct (see `ts.el')."
  (cl-loop with week-start = (alist-get chronometrist-report-week-start-day
                                        chronometrist-report-weekday-number-alist
                                        nil nil #'equal)
    until (= week-start (ts-dow ts))
    do (ts-decf (ts-day ts))
    finally return ts))

plist-remove   function

(defun chronometrist-plist-remove (plist &rest keys)
  "Return PLIST with KEYS and their associated values removed."
  (let ((keys (--filter (plist-member plist it) keys)))
    (mapc (lambda (key)
            (let ((pos (seq-position plist key)))
              (setq plist (append (seq-take plist pos)
                                  (seq-drop plist (+ 2 pos))))))
          keys)
    plist))
tests
(ert-deftest chronometrist-plist-remove ()
  (should
   (equal (chronometrist-plist-remove '(:a 1 :b 2 :c 3 :d 4) :a)
          '(:b 2 :c 3 :d 4)))
  (should
   (equal (chronometrist-plist-remove '(:a 1 :b 2 :c 3 :d 4) :b)
          '(:a 1 :c 3 :d 4)))
  (should
   (equal (chronometrist-plist-remove '(:a 1 :b 2 :c 3 :d 4) :c)
          '(:a 1 :b 2 :d 4)))
  (should
   (equal (chronometrist-plist-remove '(:a 1 :b 2 :c 3 :d 4) :d)
          '(:a 1 :b 2 :c 3)))
  (should
   (equal (chronometrist-plist-remove '(:a 1 :b 2 :c 3 :d 4) :a :b)
          '(:c 3 :d 4)))
  (should
   (equal (chronometrist-plist-remove '(:a 1 :b 2 :c 3 :d 4) :a :d)
          '(:b 2 :c 3)))
  (should
   (equal (chronometrist-plist-remove '(:a 1 :b 2 :c 3 :d 4) :c :d)
          '(:a 1 :b 2)))
  (should (equal
           (chronometrist-plist-remove '(:a 1 :b 2 :c 3 :d 4) :a :b :c :d)
           nil))
  (should
   (equal (chronometrist-plist-remove '(:a 1 :b 2 :c 3 :d 4) :d :a)
          '(:b 2 :c 3))))

plist-key-values   function

(defun chronometrist-plist-key-values (plist)
  "Return user key-values from PLIST."
  (chronometrist-plist-remove plist :name :tags :start :stop))

plist-p   function

tests

(defun chronometrist-plist-p (list)
  "Return non-nil if LIST is a property list, i.e. (:KEYWORD VALUE ...)"
  (when list
    (while (consp list)
      (setq list (if (and (keywordp (cl-first list)) (consp (cl-rest list)))
                     (cddr list)
                   'not-plist)))
    (null list)))

plist type   type

(cl-deftype chronometrist-plist ()
  '(satisfies chronometrist-plist-p)
  '(satisfies (lambda (plist)
                (and (plist-get plist :name)
                     (plist-get plist :start)))))

delete-list   writer

(defun chronometrist-sexp-delete-list (&optional arg)
  "Delete ARG lists after point.
Return new position of point."
  (let ((point-1 (point)))
    ;; try to preserve the file-local variable prop line in case this
    ;; is run from the start of buffer
    (while (forward-comment 1) nil)
    (forward-sexp (or arg 1))
    (delete-region point-1 (point))
    (point)))

make-hash-table   function

(defun chronometrist-make-hash-table ()
  "Return an empty hash table with `equal' as test."
  (make-hash-table :test #'equal))

current-task   reader method

tests

(cl-defun chronometrist-current-task (&optional (backend (chronometrist-active-backend)))
  "Return the name of the active task as a string, or nil if not clocked in."
  (let ((last-event (chronometrist-latest-record backend)))
    (if (plist-member last-event :stop)
        nil
      (plist-get last-event :name))))

install-directory   variable

(defvar chronometrist-install-directory
  (when load-file-name
    (file-name-directory load-file-name))
  "Directory where Chronometrist has been installed.")

doc-paths   variable

(defvar chronometrist-doc-paths '(:lp "chronometrist.org")
  "Plist of names of Chronometrist's documentation files.")

open-literate-source   command

(defun chronometrist-open-literate-source ()
  "Visit the Org literate program for Chronometrist."
  (interactive)
  (find-file (concat chronometrist-install-directory (plist-get chronometrist-doc-paths :lp))))

debug logging

(defcustom chronometrist-debug-enable nil
  "Whether to log debugging messages."
  :type 'boolean
  :group 'chronometrist)

(defcustom chronometrist-debug-buffer "*chronometrist-debug*"
  "Name of buffer to log debug messages to."
  :type 'string
  :group 'chronometrist)

(define-derived-mode chronometrist-debug-log-mode special-mode "debug-log")

(defun chronometrist-debug-message (format-string &rest args)
  "Log a debug message to `chronometrist-debug-buffer'.
FORMAT-STRING and ARGS are passed to `format'."
  (when chronometrist-debug-enable
    (with-current-buffer (get-buffer-create chronometrist-debug-buffer)
      (goto-char (point-max))
      (chronometrist-debug-log-mode)
      (let ((inhibit-read-only t))
        (insert
         (apply #'format
                (concat (format-time-string "[%T] ")
                        format-string)
                args)
         "\n")))))

Data structures

Reading directly from the file could be difficult, especially when your most common query is "get all intervals recorded on <date>" 4 - and so, we maintain the hash table chronometrist-events, where each key is a date in the ISO-8601 format. The plists in this hash table are free of midnight-spanning intervals, making code which consumes it easier to write.

The data from chronometrist-events is used by most (all?) interval-consuming functions, but is never written to the user's file itself.

reset   command

(defun chronometrist-reset ()
  "Reset Chronometrist's internal state."
  (interactive)
  (chronometrist-debug-message "[Command] reset")
  (chronometrist-reset-backend (chronometrist-active-backend))
  (chronometrist-refresh))

apply-time   function

(defun chronometrist-apply-time (time timestamp)
  "Return TIMESTAMP with time modified to TIME.
TIME must be a string in the form \"HH:MM:SS\"

TIMESTAMP must be a time string in the ISO-8601 format.

Return value is a ts struct (see `ts.el')."
  (-let [(h m s) (mapcar #'string-to-number (split-string time ":"))]
    (ts-apply :hour h :minute m :second s
              (chronometrist-iso-to-ts timestamp))))
tests
(ert-deftest chronometrist-apply-time ()
  (should
   (equal (ts-format "%FT%T%z" (chronometrist-apply-time "01:02:03" "2021-02-17T01:20:18+0530"))
          "2021-02-17T01:02:03+0530")))

split-plist   function

(defun chronometrist-split-plist (plist)
  "Return a list of two split plists if PLIST spans a midnight, else nil."
  (when (plist-get plist :stop)
    (let ((split-time (chronometrist-split-time (plist-get plist :start)
                                           (plist-get plist :stop)
                                           chronometrist-day-start-time)))
      (when split-time
        (-let* (((&plist :start start-1 :stop stop-1) (cl-first  split-time))
                ((&plist :start start-2 :stop stop-2) (cl-second split-time))
                ;; `plist-put' modifies lists in-place. The resulting bugs
                ;; left me puzzled for a while.
                (event-1      (cl-copy-list plist))
                (event-2      (cl-copy-list plist)))
          (list (-> event-1
                    (plist-put :start start-1)
                    (plist-put :stop  stop-1))
                (-> event-2
                    (plist-put :start start-2)
                    (plist-put :stop  stop-2))))))))
tests
(ert-deftest chronometrist-split-plist ()
  (should
   (null (chronometrist-split-plist
          '(:name  "Task"
                   :start "2021-02-17T01:33:12+0530"
                   :stop  "2021-02-17T01:56:08+0530"))))
  (should
   (equal (chronometrist-split-plist
           '(:name  "Guitar"
                    :tags  (classical warm-up)
                    :start "2021-02-12T23:45:21+0530"
                    :stop  "2021-02-13T00:03:46+0530"))
          '((:name "Guitar"
                   :tags (classical warm-up)
                   :start "2021-02-12T23:45:21+0530"
                   :stop "2021-02-13T00:00:00+0530")
            (:name "Guitar"
                   :tags (classical warm-up)
                   :start "2021-02-13T00:00:00+0530"
                   :stop "2021-02-13T00:03:46+0530")))))

events-update   writer

(defun chronometrist-events-update (plist hash-table &optional replace)
  "Return HASH-TABLE with PLIST added as the latest interval.
If REPLACE is non-nil, replace the last interval with PLIST."
  (let* ((date (->> (plist-get plist :start)
                    (chronometrist-iso-to-ts )
                    (ts-format "%F" )))
         (events-today (gethash date hash-table)))
    (--> (if replace (-drop-last 1 events-today) events-today)
         (append it (list plist))
         (puthash date it hash-table))
    hash-table))

last-date   reader

(defun chronometrist-events-last-date (hash-table)
  "Return an ISO-8601 date string for the latest date present in `chronometrist-events'."
  (--> (hash-table-keys hash-table)
       (last it)
       (car it)))

events-last   reader

(cl-defun chronometrist-events-last (&optional (backend (chronometrist-active-backend)))
  "Return the last plist from `chronometrist-events'."
  (let* ((hash-table (chronometrist-backend-hash-table backend))
         (last-date  (chronometrist-events-last-date hash-table)))
    (--> (gethash last-date hash-table)
         (last it)
         (car it))))

events-subset   reader

(defun chronometrist-events-subset (start end hash-table)
  "Return a subset of HASH-TABLE.
The subset will contain values between dates START and END (both
inclusive).

START and END must be ts structs (see `ts.el'). They will be
treated as though their time is 00:00:00."
  (let ((subset (chronometrist-make-hash-table))
        (start  (chronometrist-date-ts start))
        (end    (chronometrist-date-ts end)))
    (maphash (lambda (key value)
               (when (ts-in start end (chronometrist-iso-to-ts key))
                 (puthash key value subset)))
             hash-table)
    subset))

task-time-one-day   reader

(cl-defun chronometrist-task-time-one-day (task &optional (date (chronometrist-date-ts)) (backend (chronometrist-active-backend)))
  "Return total time spent on TASK today or on DATE, an ISO-8601 date.
The return value is seconds, as an integer."
  (let ((task-events (chronometrist-task-records-for-date backend task date)))
    (if task-events
        (->> (chronometrist-events-to-durations task-events)
             (-reduce #'+)
             (truncate))
      ;; no events for this task on DATE, i.e. no time spent
      0)))

active-time-on   reader

(defvar chronometrist-task-list)
(cl-defun chronometrist-active-time-on (&optional (date (chronometrist-date-ts)))
  "Return the total active time today, or on DATE.
Return value is seconds as an integer."
  (->> (--map (chronometrist-task-time-one-day it date) (chronometrist-task-list))
       (-reduce #'+)
       (truncate)))

count-active-days   function

(cl-defun chronometrist-statistics-count-active-days (task table)
  "Return the number of days the user spent any time on TASK.
  TABLE must be a hash table - if not supplied, `chronometrist-events' is used.

  This will not return correct results if TABLE contains records
which span midnights."
  (cl-loop for events being the hash-values of table
    count (seq-find (lambda (event)
                      (equal task (plist-get event :name)))
                    events)))

task-list   variable

(defcustom chronometrist-task-list nil
  "List of tasks used by `chronometrist'.
Value may be either nil or a list of strings.

If nil, the task list is generated from user data in
`chronometrist-file' and stored in the task-list slot of the
active backend."
  :type '(choice (repeat string) nil)
  :group 'chronometrist)

Time functions

iso-to-ts   function

(defun chronometrist-iso-to-ts (timestamp)
  "Convert TIMESTAMP to a TS struct. (see `ts.el')
TIMESTAMP must be an ISO-8601 timestamp, as handled by
`parse-iso8601-time-string'."
  (-let [(second minute hour day month year dow _dst utcoff)
         (decode-time
          (parse-iso8601-time-string timestamp))]
    (ts-update
     (make-ts :hour hour :minute minute :second second
              :day day   :month month   :year year
              :dow dow   :tz-offset utcoff))))
tests
(ert-deftest chronometrist-iso-to-ts ()
  (should (ts= (chronometrist-iso-to-ts "2021-01-01")
               (make-ts :year 2021 :month 1  :day 1
                        :hour 0    :minute 0 :second 0)))
  (should (ts= (chronometrist-iso-to-ts "2021-01-01T01:01:01")
               (make-ts :year 2021 :month 1  :day 1
                        :hour 1    :minute 1 :second 1))))

events-to-durations   function

(defun chronometrist-events-to-durations (events)
  "Convert EVENTS into a list of durations in seconds.
EVENTS must be a list of valid Chronometrist property lists (see
`chronometrist-file').

Return 0 if EVENTS is nil."
  (if events
      (cl-loop for plist in events collect
        (let* ((start-ts (chronometrist-iso-to-ts
                          (plist-get plist :start)))
               (stop-iso (plist-get plist :stop))
               ;; Add a stop time if it does not exist.
               (stop-ts  (if stop-iso
                             (chronometrist-iso-to-ts stop-iso)
                           (ts-now))))
          (ts-diff stop-ts start-ts)))
    0))

date-iso   function

(cl-defun chronometrist-date-iso (&optional (ts (ts-now)))
  (ts-format "%F" ts))

date-ts   function

(cl-defun chronometrist-date-ts (&optional (ts (ts-now)))
  "Return a ts struct representing the time 00:00:00 on today's date.
If TS is supplied, use that date instead of today.
TS should be a ts struct (see `ts.el')."
  (ts-apply :hour 0 :minute 0 :second 0 ts))

format-time-iso8601   function

(defun chronometrist-format-time-iso8601 (&optional unix-time)
  "Return current date and time as an ISO-8601 timestamp.
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
;; sufficient for all conceivable cases.

FIXME split-time   reader

It does not matter here that the :stop dates in the returned plists are different from the :start, because chronometrist-events-populate uses only the date segment of the :start values as hash table keys. (The hash table keys form the rest of the program's notion of "days", and that of which plists belong to which day.)

(defun chronometrist-split-time (start-time stop-time day-start-time)
  "If START-TIME and STOP-TIME intersect DAY-START-TIME, split them into two intervals.
START-TIME and STOP-TIME must be ISO-8601 timestamps e.g. \"YYYY-MM-DDTHH:MM:SSZ\".

DAY-START-TIME must be a string in the form \"HH:MM:SS\" (see
`chronometrist-day-start-time')

Return a list in the form
\((:start START-TIME
  :stop <day-start time on initial day>)
 (:start <day start time on second day>
  :stop STOP-TIME))"
  ;; FIXME - time zones are ignored; may cause issues with
  ;; time-zone-spanning events

  ;; The time on which the first provided day starts (according to `chronometrist-day-start-time')
  (let* ((stop-ts         (chronometrist-iso-to-ts stop-time))
         (first-day-start (chronometrist-apply-time day-start-time start-time))
         (next-day-start  (ts-adjust 'hour 24 first-day-start)))
    ;; Does the event stop time exceed the next day start time?
    (when (ts< next-day-start stop-ts)
      (let ((split-time (ts-format "%FT%T%z" next-day-start)))
        (list `(:start ,start-time :stop ,split-time)
              `(:start ,split-time :stop ,stop-time))))))
tests
(ert-deftest chronometrist-split-time ()
  (should
   (null
    (chronometrist-split-time "2021-02-17T01:33:12+0530"
                 "2021-02-17T01:56:08+0530"
                 "00:00:00")))
  (should
   (equal
    (chronometrist-split-time "2021-02-19T23:45:36+0530"
                 "2021-02-20T00:18:40+0530"
                 "00:00:00")
    '((:start "2021-02-19T23:45:36+0530"
              :stop "2021-02-20T00:00:00+0530")
      (:start "2021-02-20T00:00:00+0530"
              :stop "2021-02-20T00:18:40+0530"))))
  (should
   (equal
    (chronometrist-split-time "2021-02-19T23:45:36+0530"
                 "2021-02-20T03:18:40+0530"
                 "01:20:30")
    '((:start "2021-02-19T23:45:36+0530"
              :stop "2021-02-20T01:20:30+0530")
      (:start "2021-02-20T01:20:30+0530"
              :stop "2021-02-20T03:18:40+0530")))))

seconds-to-hms   function

(defun chronometrist-seconds-to-hms (seconds)
  "Convert SECONDS to a vector in the form [HOURS MINUTES SECONDS].
SECONDS must be a positive integer."
  (let* ((seconds (truncate seconds))
         (s       (% seconds 60))
         (m       (% (/ seconds 60) 60))
         (h       (/ seconds 3600)))
    (list h m s)))

interval   function

(defun chronometrist-interval (event)
  "Return the period of time covered by EVENT as a time value.
EVENT should be a plist (see `chronometrist-file')."
  (let ((start (plist-get event :start))
        (stop  (plist-get event :stop)))
    (time-subtract (parse-iso8601-time-string stop)
                   (parse-iso8601-time-string start))))

format-duration-long   function

(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)))))
tests
(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")))

Plist pretty-printing

pp.el, part of Emacs, doesn't align plist keys along the same column. ppp.el (available on MELPA) doesn't align plist values along the same column; also, it's GPL, and I try to avoid GPL dependencies. And thus, I wrote this ad hoc plist pretty-printer.

  1. work recursively for plist/alist values
  2. Add variable (to chronometrist-sexp.el) to set pretty-printing function. Default to ppp.el if found, fallback to internal Emacs pretty printer, and let users set their own pretty printing function.
  3. Fix alignment of alist dots

    • While also handling alist members which are proper lists

The suggested way of debugging this pretty printer is to

  1. edebug chronometrist-pp-buffer (and others if desired),
  2. insert an s-expression in a blank emacs-lisp-mode buffer, ensuring it does not contain newlines (other than in strings),
  3. place point at the beginning of the buffer, and
  4. M-: (chronometrist-pp-buffer) RET.

normalize-whitespace   writer

(defun chronometrist-pp-normalize-whitespace ()
  "Remove whitespace following point, and insert a space.
Point is placed at the end of the space."
  (when (looking-at "[[:blank:]]+")
    (delete-region (match-beginning 0) (match-end 0))
    (insert " ")))

column   reader

(defun chronometrist-pp-column ()
  "Return column point is on, as an integer.
0 means point is at the beginning of the line."
  (- (point) (point-at-bol)))

pair-p   function

(defun chronometrist-pp-pair-p (cons)
  "Return non-nil if CONS is a pair, i.e. (CAR . CDR)."
  (and (listp cons) (not (listp (cdr cons)))))

alist-p   function

(defun chronometrist-pp-alist-p (list)
  "Return non-nil if LIST is an association list.
If even a single element of LIST is a pure cons cell (as
determined by `chronometrist-pp-pair-p'), this function
considers it an alist."
  (when (listp list)
    (cl-loop for elt in list thereis (chronometrist-pp-pair-p elt))))

plist-group-p   function

(defun chronometrist-plist-group-p (list)
  "Return non-nil if LIST is in the form \(ATOM PLIST+\)."
  (and (consp list)
       (not (consp (cl-first list)))
       (cl-rest list)
       (seq-every-p #'chronometrist-plist-p (cl-rest list))))

longest-keyword-length   reader

(defun chronometrist-pp-longest-keyword-length ()
  "Find the length of the longest keyword in a plist.
This assumes there is a single plist in the current buffer, and
that point is after the first opening parenthesis."
  (save-excursion
    (cl-loop with sexp
      while (setq sexp (ignore-errors (read (current-buffer))))
      when (keywordp sexp)
      maximize (length (symbol-name sexp)))))

indent-sexp   function

(cl-defun chronometrist-pp-indent-sexp (sexp &optional (right-indent 0))
  "Return a string indenting SEXP by RIGHT-INDENT spaces."
  (format (concat "% -" (number-to-string right-indent) "s")
          sexp))

buffer   writer

It might help to make in-sublist an integer representing depth, instead of a boolean. But at the moment, it's getting the job done.

This procedure runs in a buffer containing a single s-expression, entirely on one line - which is why reaching the line-end is a termination condition.

(cl-defun chronometrist-pp-buffer (&optional in-sublist)
  "Recursively indent the alist, plist, or a list of plists after point.
The list must be on a single line, as emitted by `prin1'.

IN-SUBLIST, if non-nil, means point is inside an inner list."
  (if (not (looking-at-p (rx (or ")" line-end))))
      (let ((sexp (save-excursion
                    (read (current-buffer)))))
          (cond
           ((chronometrist-plist-p sexp)
            (chronometrist-pp-buffer-plist in-sublist)
            ;; we want to continue, in case we were inside a sublist
            (chronometrist-pp-buffer in-sublist))
           ((chronometrist-plist-group-p sexp)
            (chronometrist-pp-buffer-plist-group in-sublist)
            (chronometrist-pp-buffer in-sublist))
           ((chronometrist-pp-alist-p sexp)
            (chronometrist-pp-buffer-alist)
            (unless in-sublist (chronometrist-pp-buffer)))
           ((chronometrist-pp-pair-p sexp)
            (forward-sexp)
            (chronometrist-pp-buffer in-sublist))
           ((listp sexp)
            (down-list)
            (chronometrist-pp-buffer t)
            (up-list))
           ;; atoms and other values
           (t (forward-sexp)
              (chronometrist-pp-buffer in-sublist))))
    ;; we're before a ) - is it a lone paren on its own line?
    (let ((point (point))
          (bol   (point-at-bol)))
      (goto-char bol)
      (if (string-match "^[[:blank:]]*$" (buffer-substring bol point))
          ;; join the ) to the previous line by deleting the newline and whitespace
          (delete-region (1- bol) point)
        (goto-char point)))))

buffer-plist   writer

(defun chronometrist-pp-buffer-plist (&optional in-sublist)
  "Indent a single plist after point."
  (down-list)
  (let ((left-indent  (1- (chronometrist-pp-column)))
        (right-indent (chronometrist-pp-longest-keyword-length))
        (first-p t) sexp)
    (while (not (looking-at-p ")"))
      (chronometrist-pp-normalize-whitespace)
      (setq sexp (save-excursion (read (current-buffer))))
      (cond ((keywordp sexp)
             (chronometrist-sexp-delete-list)
             (insert (if first-p
                         (progn (setq first-p nil) "")
                       (make-string left-indent ?\s))
                     (chronometrist-pp-indent-sexp sexp right-indent)))
            ;; not a keyword = a value
            ((chronometrist-plist-p sexp)
             (chronometrist-pp-buffer-plist))
            ((and (listp sexp)
                  (not (chronometrist-pp-pair-p sexp)))
             (chronometrist-pp-buffer t)
             (insert "\n"))
            (t (forward-sexp)
               (insert "\n"))))
    (when (bolp) (delete-char -1))
    (up-list)
    ;; we have exited the plist, but might still be in a list with more plists
    (unless (eolp) (insert "\n"))
    (when in-sublist
      (insert (make-string (1- left-indent) ?\s)))))

buffer-plist-group   writer

(defun chronometrist-pp-buffer-plist-group (&optional _in-sublist)
  (down-list)
  (forward-sexp)
  (default-indent-new-line)
  (chronometrist-pp-buffer t))

buffer-alist   writer

(defun chronometrist-pp-buffer-alist ()
  "Indent a single alist after point."
  (down-list)
  (let ((indent (chronometrist-pp-column)) (first-p t) sexp)
    (while (not (looking-at-p ")"))
      (setq sexp (save-excursion (read (current-buffer))))
      (chronometrist-sexp-delete-list)
      (insert (if first-p
                  (progn (setq first-p nil) "")
                (make-string indent ?\s))
              (format "%S\n" sexp)))
    (when (bolp) (delete-char -1))
    (up-list)))

to-string   reader

(defun chronometrist-pp-to-string (object)
  "Convert OBJECT to a pretty-printed string."
  (with-temp-buffer
    (lisp-mode-variables nil)
    (set-syntax-table emacs-lisp-mode-syntax-table)
    (let ((print-quoted t))
      (prin1 object (current-buffer)))
    (goto-char (point-min))
    (chronometrist-pp-buffer)
    (buffer-string)))

plist-pp   reader

(defun chronometrist-plist-pp (object &optional stream)
  "Pretty-print OBJECT and output to STREAM (see `princ')."
  (princ (chronometrist-pp-to-string object)
         (or stream standard-output)))

Backends

chronometrist-file   custom variable

(defcustom chronometrist-file
  (locate-user-emacs-file "chronometrist")
  "Name (without extension) and full path of the Chronometrist database."
  :type 'file)

(defun chronometrist-file-variable-watcher (_symbol newval _operation _where)
  "Update slots of the active backend when `chronometrist-file' is changed.
For SYMBOL, NEWVAL, OPERATION, and WHERE, see `add-variable-watcher'."
  (chronometrist-on-file-path-change (chronometrist-active-backend) chronometrist-file newval))

(add-variable-watcher 'chronometrist-file #'chronometrist-file-variable-watcher)

protocol

backend   class

The backend may use no files, a single file, or multiple files. Thus, chronometrist-backend makes no reference to files, and chronometrist-file-backend-mixin may be used by single file backends.

(defclass chronometrist-backend ()
  ((task-list :initform nil
              :initarg :task-list
              :accessor chronometrist-backend-task-list)))
backends-alist   variable
(defvar chronometrist-backends-alist nil
  "Alist of Chronometrist backends.
Each element must be in the form `(KEYWORD TAG OBJECT)', where
TAG is a string used as a tag in customization, and OBJECT is an
EIEIO object such as one returned by `make-instance'.")
active-backend   custom variable
(defcustom chronometrist-active-backend :plist
  "The backend currently in use.
Value must be a keyword corresponding to a key in
`chronometrist-backends-alist'."
  :type `(choice
          ,@(cl-loop for elt in chronometrist-backends-alist
              collect `(const :tag ,(cl-second elt) ,(cl-first elt)))))
active-backend   reader
(defun chronometrist-active-backend ()
  "Return an object representing the currently active backend."
  (cl-second (alist-get chronometrist-active-backend chronometrist-backends-alist)))
switch-backend   command
(defun chronometrist-switch-backend ()
  (interactive)
  (chronometrist-debug-message "[Command] switch-backend")
  (let* ((prompt (format "Switch to backend (current - %s): "
                         chronometrist-active-backend))
         (choice (chronometrist-read-backend-name prompt
                                     chronometrist-backends-alist
                                     (lambda (keyword)
                                       (not (eq chronometrist-active-backend
                                                keyword)))
                                     t)))
    (setq chronometrist-active-backend choice)
    (chronometrist-reset-backend (chronometrist-active-backend))
    ;; timer function is backend-dependent
    (chronometrist-force-restart-timer)))
register-backend   writer
(defun chronometrist-register-backend (keyword tag object)
  "Add backend to `chronometrist-backends-alist'.
For values of KEYWORD, TAG, and OBJECT, see `chronometrist-backends-alist'.

If a backend with KEYWORD already exists, the existing entry will
be replaced."
  (setq chronometrist-backends-alist
        (assq-delete-all keyword chronometrist-backends-alist))
  (add-to-list 'chronometrist-backends-alist
               (list keyword tag object)
               t))
read-backend-name   procedure
(defun chronometrist-read-backend-name (prompt backend-alist
                                  &optional predicate return-keyword)
  "Prompt user for a Chronometrist backend name.
BACKEND-ALIST should be an alist similar to `chronometrist-backends-alist'.

RETURN-KEYWORD, if non-nil, means return only the keyword of the
selected backend; otherwise, return the CLOS object for the
backend.

PROMPT and PREDICATE have the same meanings as in
`completing-read'."
  (let ((backend-keyword
         (read
          (completing-read prompt
                           (cl-loop for list in backend-alist
                             collect (cl-first list))
                           predicate t))))
    (if return-keyword
        backend-keyword
      (cl-second (alist-get backend-keyword backend-alist)))))
task-list   function
(defun chronometrist-task-list ()
  "Return the list of tasks to be used.
If `chronometrist-task-list' is non-nil, return its value; else,
return a list of tasks from the active backend."
  (let ((backend (chronometrist-active-backend)))
    (with-slots (task-list) backend
      (or chronometrist-task-list
          task-list
          (setf task-list (chronometrist-list-tasks backend))))))
list-tasks   function
(defun chronometrist-list-tasks (backend)
  "Return all tasks recorded in BACKEND as a list of strings."
  (cl-loop for plist in (chronometrist-to-list backend)
    collect (plist-get plist :name) into names
    finally return
    (sort (cl-remove-duplicates names :test #'equal)
          #'string-lessp)))
run-assertions   generic function
(cl-defgeneric chronometrist-backend-run-assertions (backend)
  "Check common preconditions for any operations on BACKEND.
Signal errors for any unmet preconditions.")
view-backend   generic function
(cl-defgeneric chronometrist-view-backend (backend)
  "Open BACKEND for interactive viewing.")
edit-backend   generic function
(cl-defgeneric chronometrist-edit-backend (backend)
  "Open BACKEND for interactive editing.")
backend-empty-p   generic function
(cl-defgeneric chronometrist-backend-empty-p (backend)
  "Return non-nil if BACKEND contains no records, else nil.")
backend-modified-p   generic function
(cl-defgeneric chronometrist-backend-modified-p (backend)
  "Return non-nil if BACKEND is being modified.
For instance, a file-based backend could be undergoing editing by
a user.")
file operations
create-file   generic function

tests

(cl-defgeneric chronometrist-create-file (backend &optional file)
  "Create file associated with BACKEND.
Use FILE as a path, if provided.
Return path of new file if successfully created, and nil if it already exists.")
latest-date-records   generic function
(cl-defgeneric chronometrist-latest-date-records (backend)
  "Return intervals of latest day in BACKEND as a tagged list (\"DATE\" PLIST*).
Return nil if BACKEND contains no records.")
insert   generic function
(cl-defgeneric chronometrist-insert (backend plist)
  "Insert PLIST as new record in BACKEND.
Return non-nil if record is inserted successfully.")

(cl-defmethod chronometrist-insert :before ((_backend t) plist &key &allow-other-keys)
  (unless (cl-typep plist 'chronometrist-plist)
    (error "Not a valid plist: %S" plist)))
remove-last   generic function
(cl-defgeneric chronometrist-remove-last (backend)
  "Remove last record from BACKEND.
Return non-nil if record is successfully removed.
Signal an error if there is no record to remove.")
latest-record   generic function
(cl-defgeneric chronometrist-latest-record (backend)
  "Return the latest entry from BACKEND as a plist, or nil if BACKEND contains no records.
Return value may be active, i.e. it may or may not have a :stop key-value.")
task-records-for-date   generic function
(cl-defgeneric chronometrist-task-records-for-date (backend task date-ts)
  "From BACKEND, return records for TASK on DATE-TS as a list of plists.
DATE-TS must be a `ts.el' struct.

Return nil if BACKEND contains no records.")

(cl-defmethod chronometrist-task-records-for-date :before ((_backend t) task date-ts &key &allow-other-keys)
  (unless (cl-typep task 'string)
    (error "task %S is not a string" task))
  (unless (cl-typep date-ts 'ts)
    (error "date-ts %S is not a `ts' struct" date-ts)))
replace-last   generic function
(cl-defgeneric chronometrist-replace-last (backend plist)
  "Replace last record in BACKEND with PLIST.
Return non-nil if successful.")

(cl-defmethod chronometrist-replace-last :before ((_backend t) plist &key &allow-other-keys)
  (unless (cl-typep plist 'chronometrist-plist)
    (error "Not a valid plist: %S" plist)))
to-file   generic function
(cl-defgeneric chronometrist-to-file (input-hash-table output-backend output-file)
  "Save data from INPUT-HASH-TABLE to OUTPUT-FILE, in OUTPUT-BACKEND format.
Any existing data in OUTPUT-FILE is overwritten.")
on-add   generic function
(cl-defgeneric chronometrist-on-add (backend)
  "Function called when data is added to BACKEND.
This may happen within Chronometrist (e.g. via
`chronometrist-insert') or outside it (e.g. a user editing the
backend file).

NEW-DATA is the data that was added.")
on-modify   generic function
(cl-defgeneric chronometrist-on-modify (backend)
  "Function called when data in BACKEND is modified (rather than added or removed).
This may happen within Chronometrist (e.g. via
`chronometrist-replace-last') or outside it (e.g. a user editing
the backend file).

OLD-DATA and NEW-DATA is the data before and after the changes,
respectively.")
on-remove   generic function
(cl-defgeneric chronometrist-on-remove (backend)
  "Function called when data is removed from BACKEND.
This may happen within Chronometrist (e.g. via
`chronometrist-remove-last') or outside it (e.g. a user editing
the backend file).

OLD-DATA is the data that was modified.")
on-change   generic function
(cl-defgeneric chronometrist-on-change (backend)
  "Function to be run when BACKEND changes on disk.
This may happen within Chronometrist (e.g. via
`chronometrist-insert') or outside it (e.g. a user editing the
backend file).")
verify   generic function
(cl-defgeneric chronometrist-verify (backend)
  "Check BACKEND for errors in data.
Return nil if no errors are found.

If an error is found, return (LINE-NUMBER . COLUMN-NUMBER) for file-based backends.")
on-file-path-change   generic function
(cl-defgeneric chronometrist-on-file-path-change (backend old-path new-path)
  "Function run when the value of `chronometrist-file' is changed.
OLD-PATH and NEW-PATH are the old and new values of
`chronometrist-file', respectively.")
memory operations
reset-backend   generic function
(cl-defgeneric chronometrist-reset-backend (backend)
  "Reset data structures for BACKEND.")
to-hash-table   generic function
(cl-defgeneric chronometrist-to-hash-table (backend)
  "Return data in BACKEND as a hash table in chronological order.
Hash table keys are ISO-8601 date strings. Hash table values are
lists of records, represented by plists. Both hash table keys and
hash table values must be in chronological order.")
to-list   generic function
(cl-defgeneric chronometrist-to-list (backend)
  "Return all records in BACKEND as a list of plists.")
memory-layer-empty-p   generic function
(cl-defgeneric chronometrist-memory-layer-empty-p (backend)
  "Return non-nil if memory layer of BACKEND contains no records, else nil.")
extended protocol (unimplemented)

These can be implemented in terms of the minimal protocol above.

active-days   generic function
(cl-defgeneric chronometrist-active-days (backend task &key start end)
  "From BACKEND, return number of days on which TASK had recorded time.")
count-records   generic function
(cl-defgeneric chronometrist-count-records (backend)
  "Return number of records in BACKEND.")

Common definitions for s-expression backends

file-backend-mixin   mixin
(defclass chronometrist-file-backend-mixin ()
  ((path :initform nil
    :initarg :path
    :accessor chronometrist-backend-path
    :custom 'string
    :documentation
    "Path to backend file, without extension.")
   (extension :initform nil
    :initarg :extension
    :accessor chronometrist-backend-ext
    :custom 'string
    :documentation
    "Extension of backend file.")
   (file :initarg :file
         :initform nil
         :accessor chronometrist-backend-file
         :custom 'string
         :documentation "Full path to backend file, with extension.")
   (hash-table :initform (chronometrist-make-hash-table)
               :initarg :hash-table
               :accessor chronometrist-backend-hash-table)
   (file-watch :initform nil
               :initarg :file-watch
               :accessor chronometrist-backend-file-watch
               :documentation "Filesystem watch object, as returned by `file-notify-add-watch'."))
  :documentation "Mixin for backends storing data in a single file.")
setup-file-watch   writer
(cl-defun chronometrist-setup-file-watch (&optional (callback #'chronometrist-refresh-file))
  "Arrange for CALLBACK to be called when the backend file changes."
  (with-slots (file file-watch) (chronometrist-active-backend)
    (unless file-watch
      (setq file-watch
            (file-notify-add-watch file '(change) callback)))))
edit-backend   method
(cl-defmethod chronometrist-edit-backend ((backend chronometrist-file-backend-mixin))
  (find-file-other-window (chronometrist-backend-file backend))
  (goto-char (point-max)))
initialize-instance   method
(cl-defmethod initialize-instance :after ((backend chronometrist-file-backend-mixin)
                                          &rest _initargs)
  "Initialize FILE based on PATH and EXTENSION."
  (with-slots (path extension file) backend
    (when (and path extension (not file))
      (setf file (concat path "." extension)))))
reset-backend   writer method
(cl-defmethod chronometrist-reset-backend ((backend chronometrist-file-backend-mixin))
  (with-slots (hash-table file-watch
               rest-start rest-end rest-hash
               file-length last-hash) backend
    (chronometrist-reset-task-list backend)
    (when file-watch
      (file-notify-rm-watch file-watch))
    (setf hash-table  (chronometrist-to-hash-table backend)
          file-watch  nil
          rest-start  nil
          rest-end    nil
          rest-hash   nil
          file-length nil
          last-hash   nil)
    (chronometrist-setup-file-watch)))
backend-empty-p   reader method
(cl-defmethod chronometrist-backend-empty-p ((backend chronometrist-file-backend-mixin))
  (with-slots (file) backend
      (or (not (file-exists-p file))
          (chronometrist-file-empty-p file))))
memory-layer-empty-p   reader method
(cl-defmethod chronometrist-memory-layer-empty-p ((backend chronometrist-file-backend-mixin))
  (with-slots (hash-table) backend
    (zerop (hash-table-count hash-table))))
backend-modified-p   reader method
(cl-defmethod chronometrist-backend-modified-p ((backend chronometrist-file-backend-mixin))
  (with-slots (file) backend
    (buffer-modified-p
     (get-buffer-create
      (find-file-noselect file)))))
on-file-path-change   generic function
(cl-defmethod chronometrist-on-file-path-change ((backend chronometrist-file-backend-mixin) _old-path new-path)
  (with-slots (path extension file) backend
    (setf path new-path
          file (concat path "." extension))))
elisp-sexp-backend   class
(defclass chronometrist-elisp-sexp-backend (chronometrist-backend chronometrist-file-backend-mixin)
  ((rest-start :initarg :rest-start
               :initform nil
               :accessor chronometrist-backend-rest-start
               :documentation "Integer denoting start of first s-expression in file.")
   (rest-end :initarg :rest-end
             :initform nil
             :accessor chronometrist-backend-rest-end
             :documentation "Integer denoting end of second-last s-expression in file.")
   (rest-hash :initarg :rest-hash
              :initform nil
              :accessor chronometrist-backend-rest-hash
              :documentation "Hash of content between rest-start and rest-end.")
   (file-length :initarg :file-length
                :initform nil
                :accessor chronometrist-backend-file-length
                :documentation "Integer denoting length of file, as returned by `(point-max)'.")
   (last-hash :initarg :last-hash
              :initform nil
              :accessor chronometrist-backend-last-hash
              :documentation "Hash of content between rest-end and file-length."))
  :documentation "Base class for any text file backend which stores s-expressions readable by Emacs Lisp.")
sexp-mode   major mode
(define-derived-mode chronometrist-sexp-mode
  ;; fundamental-mode
  emacs-lisp-mode
  "chronometrist-sexp")
create-file   writer method
(cl-defmethod chronometrist-create-file ((backend chronometrist-elisp-sexp-backend) &optional file)
  (let ((file (or file (chronometrist-backend-file backend))))
    (unless (file-exists-p file)
      (with-current-buffer (find-file-noselect file)
        (erase-buffer)
        (goto-char (point-min))
        (insert ";;; -*- mode: chronometrist-sexp; -*-\n\n")
        (write-file file))
      file)))
in-file   macro
(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)))
pre-read-check   procedure
(defun chronometrist-sexp-pre-read-check (buffer)
  "Return non-nil if there is an s-expression before point in BUFFER.
Move point to the start of this s-expression."
  (with-current-buffer buffer
    (and (not (bobp))
         (backward-list)
         (or (not (bobp))
             (not (looking-at-p "^[[:blank:]]*;"))))))
loop-sexp-file   macro
(defmacro chronometrist-loop-sexp-file (_for sexp _in file &rest loop-clauses)
  "`cl-loop' LOOP-CLAUSES over s-expressions in FILE.
SEXP is bound to each s-expressions in reverse order (last
expression first)."
  (declare (indent defun) (debug 'cl-loop))
  `(chronometrist-sexp-in-file ,file
     (goto-char (point-max))
     (cl-loop with ,sexp
       while (and (chronometrist-sexp-pre-read-check (current-buffer))
                  (setq ,sexp (ignore-errors (read (current-buffer))))
                  (backward-list))
       ,@loop-clauses)))
backend-empty-p   reader method
(cl-defmethod chronometrist-backend-empty-p ((backend chronometrist-elisp-sexp-backend))
  (chronometrist-sexp-in-file (chronometrist-backend-file backend)
    (goto-char (point-min))
    (not (ignore-errors
           (read (current-buffer))))))
indices and hashes
(defun chronometrist-rest-start (file)
  (chronometrist-sexp-in-file file
    (goto-char (point-min))
    (forward-list)
    (backward-list)
    (point)))

(defun chronometrist-rest-end (file)
  (chronometrist-sexp-in-file file
    (goto-char (point-max))
    (backward-list 2)
    (forward-list)
    (point)))

(defun chronometrist-file-length (file)
  (chronometrist-sexp-in-file file (point-max)))
file-hash   reader
(cl-defun chronometrist-file-hash (start end &optional (file (chronometrist-backend-file (chronometrist-active-backend))))
  "Calculate hash of `chronometrist-file' between START and END."
  (chronometrist-sexp-in-file file
    (secure-hash 'sha1
                 (buffer-substring-no-properties start end))))
tests
(ert-deftest file-hash ()
  (-let* ((file chronometrist-test-file)
          ((last-start last-end)
           (chronometrist-file-hash :before-last nil nil file))
          ((rest-start rest-end rest-hash)
           (chronometrist-file-hash nil :before-last t file)))
    (message "chronometrist - file-hash test - file path is %s" file)
    (should (= 1 rest-start))
    (should (= 1254 rest-end))
    (should (= 1256 last-start))
    (should (= 1426 last-end))))
file-change-type   reader
  • rest-start - start of first sexp
  • rest-end - end of second last sexp
  • file-length - end of file
  • rest-hash - hash of content between rest-start and rest-end
  • last-hash - hash of content between rest-end and file-length
  • ht-last-sexp - last sexp in memory
  • file-sexp-after-rest - sexp after rest-end
  • file-last-sexp - last sexp in file
situation rest-hash last-hash file-sexp-after-rest file-last-sexp file-length
no change same same same as ht-last-sexp same as ht-last-sexp and file-last-sexp same
append same same - (new s-expression) always greater
modify same changed changed changed may be smaller
remove same changed nil same as second last sexp always smaller
other change changed - - may be smaller than rest-end

We avoid comparing s-expressions in the file with the contents of the hash table, since the last s-expression might be represented differently in the hash tables of different elisp-sexp backends. Additionally, in :modify as well as nil situations, there is no s-expression after old-file-length.

(defun chronometrist-file-change-type (backend)
  "Determine the type of change made to BACKEND's file.
    Return
    :append  if a new s-expression was added to the end,
    :modify  if the last s-expression was modified,
    :remove  if the last s-expression was removed,
        nil  if the contents didn't change, and
          t  for any other change."
  (with-slots
      (file file-watch
            ;; The slots contain the old state of the file.
            hash-table
            rest-start rest-end rest-hash
            file-length last-hash) backend
    (let* ((new-length    (chronometrist-file-length file))
           (new-rest-hash (when (and (>= new-length rest-start)
                                     (>= new-length rest-end))
                            (chronometrist-file-hash rest-start rest-end file)))
           (new-last-hash (when (and (>= new-length rest-end)
                                     (>= new-length file-length))
                            (chronometrist-file-hash rest-end file-length file))))
      ;; (chronometrist-debug-message "File indices - old rest-start: %s rest-end: %s file-length: %s new-length: %s"
      ;;          rest-start rest-end file-length new-length)
      (cond ((and (= file-length new-length)
                  (equal rest-hash new-rest-hash)
                  (equal last-hash new-last-hash))
             nil)
            ((or (< new-length rest-end) ;; File has shrunk so much that we cannot compare rest-hash.
                 (not (equal rest-hash new-rest-hash)))
             t)
            ;; From here on, it is implicit that the change has happened at the end of the file.
            ((and (< file-length new-length) ;; File has grown.
                  (equal last-hash new-last-hash))
             :append)
            ((and (< new-length file-length) ;; File has shrunk.
                  (not (chronometrist-sexp-in-file file
                         (goto-char rest-end)
                         (ignore-errors
                           (read (current-buffer)))))) ;; There is no sexp after rest-end.
             :remove)
            (t :modify)))))
tests
(ert-deftest chronometrist-file-change-type ()
  (with-slots (file hash-table file-state) chronometrist-plist-test-backend
    (let* ((b chronometrist-plist-test-backend)
           (test-contents (with-current-buffer (find-file-noselect file)
                            (buffer-substring (point-min) (point-max)))))
      (chronometrist-reset-backend b)
      (setf file-state
            (list :last (chronometrist-file-hash :before-last nil)
                  :rest (chronometrist-file-hash nil :before-last t)))
      (unwind-protect
          (progn
            (should
             (eq nil (chronometrist-file-change-type file-state)))
            (should
             (eq :append
                 (progn
                   (chronometrist-insert chronometrist-plist-test-backend
                             '(:name "Append Test"
                                     :start "2021-02-01T13:06:46+0530"
                                     :stop "2021-02-01T13:06:49+0530"))
                   (chronometrist-tests--change-type-and-update file-state file))))
            (should
             (eq :modify
                 (progn
                   (chronometrist-replace-last chronometrist-plist-test-backend
                                   '(:name "Modify Test"
                                           :tags (some tags)
                                           :start "2021-02-01T13:06:46+0530"
                                           :stop "2021-02-01T13:06:49+0530"))
                   (chronometrist-tests--change-type-and-update file-state file))))
            (should
             (eq :remove
                 (progn
                   (chronometrist-sexp-in-file file
                     (goto-char (point-max))
                     (backward-list 1)
                     (chronometrist-sexp-delete-list 1)
                     (save-buffer))
                   (chronometrist-tests--change-type-and-update file-state file))))
            (should
             (eq t
                 (progn
                   (chronometrist-sexp-in-file file
                     (goto-char (point-min))
                     (chronometrist-plist-pp '(:name "Other Change Test"
                                         :start "2021-02-02T17:39:40+0530"
                                         :stop "2021-02-02T17:39:44+0530")
                                 (current-buffer))
                     (save-buffer))
                   (chronometrist-tests--change-type-and-update file-state file)))))
        (with-current-buffer
            (find-file-noselect file)
          (delete-region (point-min) (point-max))
          (insert test-contents)
          (save-buffer))
        (chronometrist-reset-backend b)))))
reset-task-list   writer
(cl-defun chronometrist-reset-task-list (backend)
  "Regenerate BACKEND's task list from its data.
Only takes effect if `chronometrist-task-list' is nil (i.e. the
user has not defined their own task list)."
  (unless chronometrist-task-list
    (setf (chronometrist-backend-task-list backend) (chronometrist-list-tasks backend))))
add-to-task-list   writer
(defun chronometrist-add-to-task-list (task backend)
  "Add TASK to BACKEND's task list, if it is not already present.
Only takes effect if `chronometrist-task-list' is nil (i.e. the
user has not defined their own task list)."
  (with-slots (task-list) backend
    (unless (and (not chronometrist-task-list)
                 (cl-member task task-list :test #'equal))
      (setf task-list
            (sort (cons task task-list)
                  #'string-lessp)))))
remove-from-task-list   writer
(defun chronometrist-remove-from-task-list (task backend)
  "Remove TASK from BACKEND's task list if necessary.
TASK is removed if it does not occur in BACKEND's hash table, or
if it only occurs in the newest plist of the same.

Only takes effect if `chronometrist-task-list' is nil (i.e. the
user has not defined their own task list).

Return new value of BACKEND's task list, or nil if
unchanged."
  (with-slots (hash-table task-list) backend
    (unless chronometrist-task-list
      (let (;; number of plists in hash table
            (ht-plist-count (cl-loop with count = 0
                              for intervals being the hash-values of hash-table
                              do (cl-loop for _interval in intervals
                                   do (cl-incf count))
                              finally return count))
            ;; index of first occurrence of TASK in hash table, or nil if not found
            (ht-task-first-result (cl-loop with count = 0
                                    for intervals being the hash-values of hash-table
                                    when (cl-loop for interval in intervals
                                           do (cl-incf count)
                                           when (equal task (plist-get interval :name))
                                           return t)
                                    return count)))
        (when (or (not ht-task-first-result)
                  (= ht-task-first-result ht-plist-count))
          ;; The only interval for TASK is the last expression
          (setf task-list (remove task task-list)))))))
on-change   writer method
(cl-defmethod chronometrist-on-change ((backend chronometrist-elisp-sexp-backend) fs-event)
  "Function called when BACKEND file is changed.
This may happen within Chronometrist (through the backend
protocol) or outside it (e.g. a user editing the backend file).

FS-EVENT is the event passed by the `filenotify' library (see `file-notify-add-watch')."
  (with-slots (file hash-table file-watch
                    rest-start rest-end rest-hash
                    file-length last-hash) backend
    (-let* (((_ action _ _) fs-event)
            (file-state-bound-p (and rest-start rest-end rest-hash
                                     file-length last-hash))
            (change      (when file-state-bound-p
                           (chronometrist-file-change-type backend)))
            (reset-watch-p (or (eq action 'deleted)
                               (eq action 'renamed))))
      (chronometrist-debug-message "[Method] on-change: file change type %s" change)
      ;; If only the last plist was changed, update hash table and
      ;; task list, otherwise clear and repopulate hash table.
      (cond ((or reset-watch-p
                 (not file-state-bound-p) ;; why?
                 (eq change t))
             (chronometrist-reset-backend backend))
            (file-state-bound-p
             (pcase change
               ;; A new s-expression was added at the end of the file
               (:append (chronometrist-on-add backend))
               ;; The last s-expression in the file was changed
               (:modify (chronometrist-on-modify backend))
               ;; The last s-expression in the file was removed
               (:remove (chronometrist-on-remove backend))
               ((pred null) nil))))
      (setf rest-start  (chronometrist-rest-start file)
            rest-end    (chronometrist-rest-end file)
            file-length (chronometrist-file-length file)
            last-hash   (chronometrist-file-hash rest-end file-length file)
            rest-hash   (chronometrist-file-hash rest-start rest-end file)))))

plist backend

In this format, user data is stored as Elisp plists in a plain text file. A basic plist in this file looks like this -

(:name "Task Name"
 [:keyword <value>]*
 :start "<ISO-8601 date-time>"
 :stop "<ISO-8601 date-time>")

:name and :start are essential. :stop may be missing if the task is currently active.

The reasons I like this format are -

  1. Users can browse and edit the data using the Emacs setup they are accustomed to. We get things like swiper, undo-tree, and a host of other features for free.
  2. It is trivial to parse using the read built-in to Emacs.

    • chronometrist-loop-file is provided as an additional convenience, to iterate through each expression in the file.
  3. It is easy to diff and version control.
tests
(defvar chronometrist-plist-test-backend
  (make-instance 'chronometrist-plist-backend
                 :file (make-temp-file "chronometrist-plist-test-" nil ".sexp")))

(let ((file (chronometrist-backend-file chronometrist-plist-test-backend)))
  (with-current-buffer (find-file-noselect file)
    (mapcar
     (lambda (plist)
       ;; to use this, we'd have to move `chronometrist-plist-pp' before this
       ;; definition, and I'm perfectly content with where it is
       ;; right now
       (chronometrist-plist-pp plist (current-buffer))
       (insert "\n\n")
       ;; (print plist) (princ "\n")
       )
     '((:name "Programming"
              :start "2018-01-01T00:00:00+0530"
              :stop  "2018-01-01T01:00:00+0530")
       (:name "Swimming"
              :start "2018-01-01T02:00:00+0530"
              :stop  "2018-01-01T03:00:00+0530")
       (:name "Cooking"
              :start "2018-01-01T04:00:00+0530"
              :stop  "2018-01-01T05:00:00+0530")
       (:name "Guitar"
              :start "2018-01-01T06:00:00+0530"
              :stop  "2018-01-01T07:00:00+0530")
       (:name "Cycling"
              :start "2018-01-01T08:00:00+0530"
              :stop  "2018-01-01T09:00:00+0530")
       (:name "Programming"
              :start "2018-01-02T23:00:00+0530"
              :stop  "2018-01-03T01:00:00+0530")
       (:name "Cooking"
              :start "2018-01-03T23:00:00+0530"
              :stop  "2018-01-04T01:00:00+0530")
       (:name "Programming"
              :tags      (bug-hunting)
              :project   "Chronometrist"
              :component "goals"
              :start     "2020-05-09T20:03:25+0530"
              :stop      "2020-05-09T20:05:55+0530")
       (:name "Arrangement/new edition"
              :tags     (new edition)
              :song     "Songs of Travel"
              :composer "Vaughan Williams, Ralph"
              :start    "2020-05-10T00:04:14+0530"
              :stop     "2020-05-10T00:25:48+0530")
       (:name "Guitar"
              :tags  (classical warm-up)
              :start "2020-05-10T15:41:14+0530"
              :stop  "2020-05-10T15:55:42+0530")
       (:name "Guitar"
              :tags  (classical solo)
              :start "2020-05-10T16:00:00+0530"
              :stop  "2020-05-10T16:30:00+0530")
       (:name "Programming"
              :tags  (reading)
              :book  "Smalltalk-80: The Language and Its Implementation"
              :start "2020-05-10T16:33:17+0530"
              :stop  "2020-05-10T17:10:48+0530")))))
  1. finding the test input file

    • buffer-file-name returns nil when Emacs is run in batch mode; I've tried using (concat (or (ignore-errors (file-name-directory (buffer-file-name))) default-directory) "test.sexp"), but that resulted in "~/.emacs.d/test.sexp" being used instead, for some reason.
    • maybe we can store the test file contents in a string instead, and create a temporary test file using make-temp-file?

Boilerplate for updating state between file operations in tests.

(defmacro chronometrist-tests--change-type-and-update (state file)
  `(prog1 (chronometrist-file-change-type ,state)
     (setq ,state
           (list :last (chronometrist-file-hash :before-last nil nil ,file)
                 :rest (chronometrist-file-hash nil :before-last t ,file)))))
backend   class
(defclass chronometrist-plist-backend (chronometrist-elisp-sexp-backend)
  ((extension :initform "plist"
              :accessor chronometrist-backend-ext
              :custom 'string)))

(chronometrist-register-backend
 :plist "Store records as plists."
 (make-instance 'chronometrist-plist-backend :path chronometrist-file))
pretty-print-function   custom variable
(defcustom chronometrist-sexp-pretty-print-function #'chronometrist-plist-pp
  "Function used to pretty print plists in `chronometrist-file'.
Like `pp', it must accept an OBJECT and optionally a
STREAM (which is the value of `current-buffer')."
  :type 'function
  :group 'chronometrist)
latest-date-records   reader method

In this backend, it's easier to implement this in terms of chronometrist-latest-record than the other way round.

(cl-defmethod chronometrist-latest-date-records ((backend chronometrist-plist-backend))
  (chronometrist-backend-run-assertions backend)
  (with-slots (hash-table) backend
    (when-let*
        ((latest-date (chronometrist-events-last-date hash-table))
         (records     (gethash latest-date hash-table)))
      (cons latest-date records))))
to-hash-table   writer method
(cl-defmethod chronometrist-to-hash-table ((backend chronometrist-plist-backend))
  (chronometrist-sexp-in-file (chronometrist-backend-file backend)
    (goto-char (point-min))
    (let ((table (chronometrist-make-hash-table))
          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-split-plist 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)
                                    (substring it 0 10)))
               (existing-value (gethash new-value-date table)))
          (puthash new-value-date
                   (if existing-value
                       (append existing-value
                               (list new-value))
                     (list new-value))
                   table)))
      table)))
insert   writer method
(cl-defmethod chronometrist-insert ((backend chronometrist-plist-backend) plist &key (save t))
  (chronometrist-backend-run-assertions backend)
  (chronometrist-debug-message "[Method] insert: %s" plist)
  (chronometrist-sexp-in-file (chronometrist-backend-file backend)
    (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"))
    (funcall chronometrist-sexp-pretty-print-function plist (current-buffer))
    (when save (save-buffer))
    t))
remove-last   writer method
(cl-defmethod chronometrist-remove-last ((backend chronometrist-plist-backend))
  (chronometrist-debug-message "[Method] remove-last")
  (chronometrist-backend-run-assertions backend)
  (when (chronometrist-backend-empty-p backend)
  (error "chronometrist-remove-last has nothing to remove in %s"
         (eieio-object-class-name backend)))
  (chronometrist-sexp-in-file (chronometrist-backend-file backend)
    (goto-char (point-max))
    ;; this condition should never really occur, since we insert a
    ;; file local variable prop line when the file is created...
    (unless (and (bobp) (bolp)) (insert "\n"))
    (backward-list 1)
    (chronometrist-sexp-delete-list)))
reindent-buffer   command
(defun chronometrist-sexp-reindent-buffer ()
  "Reindent the current buffer.
This is meant to be run in `chronometrist-file' when using an s-expression backend."
  (interactive)
  (chronometrist-debug-message "[Command] reindent-buffer")
  (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)))
      (funcall chronometrist-sexp-pretty-print-function expr (current-buffer))
      (insert "\n")
      (unless (eobp) (insert "\n")))))
to-file   writer method
(cl-defmethod chronometrist-to-file (hash-table (backend chronometrist-plist-backend) file)
  (delete-file file)
  (chronometrist-create-file backend file)
  (chronometrist-reset-backend backend)             ; possibly to ensure BACKEND is up to date
  (chronometrist-sexp-in-file file
    (goto-char (point-max))
    (cl-loop
      for date in (sort (hash-table-keys hash-table) #'string-lessp) do
      (cl-loop for plist in (gethash date hash-table) do
        (insert (chronometrist-plist-pp plist) "\n\n"))
      finally do (save-buffer))))
to-list   reader method
(cl-defmethod chronometrist-to-list ((backend chronometrist-plist-backend))
  (chronometrist-backend-run-assertions backend)
  (chronometrist-loop-sexp-file for expr in (chronometrist-backend-file backend) collect expr))
on-add   writer method
(cl-defmethod chronometrist-on-add ((backend chronometrist-plist-backend))
  "Function run when a new plist is added at the end of a
`chronometrist-plist-backend' file."
  (with-slots (hash-table) backend
    (-let [(new-plist &as &plist :name new-task) (chronometrist-latest-record backend)]
      (setf hash-table (chronometrist-events-update new-plist hash-table))
      (chronometrist-add-to-task-list new-task backend))))
on-modify   writer method
(cl-defmethod chronometrist-on-modify ((backend chronometrist-plist-backend))
  "Function run when the newest plist in a
`chronometrist-plist-backend' file is modified."
  (with-slots (hash-table) backend
    (-let (((new-plist &as &plist :name new-task) (chronometrist-latest-record backend))
           ((&plist :name old-task) (chronometrist-events-last backend)))
      (setf hash-table (chronometrist-events-update new-plist hash-table t))
      (chronometrist-remove-from-task-list old-task backend)
      (chronometrist-add-to-task-list new-task backend))))
on-remove   writer method
(cl-defmethod chronometrist-on-remove ((backend chronometrist-plist-backend))
  "Function run when the newest plist in a
`chronometrist-plist-backend' file is deleted."
  (with-slots (hash-table) backend
    (-let (((&plist :name old-task) (chronometrist-events-last))
           (date  (chronometrist-events-last-date hash-table)))
      ;; `chronometrist-remove-from-task-list' checks the hash table to determine
      ;; if `chronometrist-task-list' is to be updated. Thus, the hash table must
      ;; not be updated until the task list is.
      (chronometrist-remove-from-task-list old-task backend)
      (--> (gethash date hash-table)
           (-drop-last 1 it)
           (setf (gethash date hash-table) it)))))
extended protocol
latest-record   reader method
(cl-defmethod chronometrist-latest-record ((backend chronometrist-plist-backend))
  (chronometrist-backend-run-assertions backend)
  (chronometrist-sexp-in-file (chronometrist-backend-file backend)
    (goto-char (point-max))
    (backward-list)
    (ignore-errors (read (current-buffer)))))
task-records-for-date   reader method
(cl-defmethod chronometrist-task-records-for-date ((backend chronometrist-plist-backend) task date-ts)
  (chronometrist-backend-run-assertions backend)
  (let* ((date    (chronometrist-date-iso date-ts))
         (records (gethash date (chronometrist-backend-hash-table backend))))
    (cl-loop for record in records
      when (equal task (plist-get record :name))
      collect record)))
replace-last   writer method
(cl-defmethod chronometrist-replace-last ((backend chronometrist-plist-backend) plist)
  (chronometrist-debug-message "[Method] replace-last with %s" plist)
  (chronometrist-sexp-in-file (chronometrist-backend-file backend)
    (goto-char (chronometrist-remove-last backend))
    (funcall chronometrist-sexp-pretty-print-function plist (current-buffer))
    (save-buffer)
    t))
count-records   reader method
(cl-defmethod chronometrist-count-records ((backend chronometrist-plist-backend))
  (chronometrist-sexp-in-file (chronometrist-backend-file backend)
    (goto-char (point-min))
    (cl-loop with count = 0
      while (ignore-errors (read (current-buffer)))
      do (cl-incf count)
      finally return count)))

plist group backend

This is largely like the plist backend, but plists are grouped by date by wrapping them in a tagged list -

("<ISO-8601 date>"
 (:name "Task Name"
  [:keyword <value>]*
  :start "<ISO-8601 time>"
  :stop "<ISO-8601 time>")
 ...)

This makes it easy and computationally cheap to perform our most common query - getting the plists on a given day. Midnight-spanning intervals are split in the file itself. The downside is that the user, if editing it by hand, must take care to split the intervals.

Note that migrating from the plist backend to the plist group backend is inherently likely to result in more plists compared to the source, as each midnight-spanning plist is split into two.

Concerns specific to the plist group backend -

  1. the last plist may be split across two days. In such a situation -

    • changing key-values for the last plist would only apply to the most recent one
    • deleting the last plist via chronometrist-remove-last would only delete the recent part of the split plist fixed
    • resetting is unaffected, since that only applies to the last interval, whether or not it's a split plist
    • restarting is unaffected, since that only applies to the active interval, and split intervals are always inactive ones
backend   class
(defclass chronometrist-plist-group-backend (chronometrist-elisp-sexp-backend)
  ((extension :initform "plg"
              :accessor chronometrist-backend-ext
              :custom 'string)))

(chronometrist-register-backend
 :plist-group "Store records as plists grouped by date."
 (make-instance 'chronometrist-plist-group-backend
                :path chronometrist-file))
backward-read-sexp   reader
(defun chronometrist-backward-read-sexp (buffer)
  (backward-list)
  (save-excursion (read buffer)))
run-assertions   reader method
(cl-defmethod chronometrist-backend-run-assertions ((backend chronometrist-file-backend-mixin))
  (with-slots (file) backend
    (unless (file-exists-p file)
      (error "Backend file %S does not exist" file))))
latest-date-records   reader method
(cl-defmethod chronometrist-latest-date-records ((backend chronometrist-plist-group-backend))
  (chronometrist-backend-run-assertions backend)
  (chronometrist-sexp-in-file (chronometrist-backend-file backend)
    (goto-char (point-max))
    (ignore-errors
      (chronometrist-backward-read-sexp (current-buffer)))))
HACK insert   writer method

<<hack-note-plist-group-insert>> We just want to insert a plist, but as a hack to avoid updating the pretty-printer to handle indentation of plists being inserted into an outer list, we append the plist to a plist group and insert/replace the plist group instead.

Situations -

  1. new inactive day-crossing record

    1. first record - split, insert into two new groups
    2. not first record - split, insert into existing group + new group
  2. new active record, or new non-day-crossing inactive record

    1. first record - insert into new plist group
    2. not first record

      1. latest recorded date = today - insert into existing group
      2. insert into new group
(cl-defmethod chronometrist-insert ((backend chronometrist-plist-group-backend) plist &key (save t))
  (cl-check-type plist chronometrist-plist)
  (chronometrist-debug-message "[Method] insert: %S" plist)
  (chronometrist-backend-run-assertions backend)
  (if (not plist)
      (error "%s" "`chronometrist-insert' was called with an empty plist")
    (chronometrist-sexp-in-file (chronometrist-backend-file backend)
      (-let* (((plist-1 plist-2)   (chronometrist-split-plist plist))
              ;; Determine if we need to insert a new plist group
              (latest-plist-group  (chronometrist-latest-date-records backend))
              (backend-latest-date (cl-first latest-plist-group))
              (date-today          (chronometrist-date-iso))
              (insert-new-group    (not (equal date-today backend-latest-date)))
              (start-date          (cl-first (split-string (plist-get plist :start) "T")))
              (new-plist-group-1   (if latest-plist-group
                                       (append latest-plist-group
                                               (list (or plist-1 plist)))
                                     (list start-date (or plist-1 plist))))
              (new-plist-group-2   (when (or plist-2 insert-new-group)
                                     (list date-today (or plist-2 plist)))))
        (goto-char (point-max))
        (when (not latest-plist-group)
          ;; first record
          (while (forward-comment 1) nil))
        (if (and plist-1 plist-2)
            ;; inactive, day-crossing record
            (progn
              (when latest-plist-group
                ;; not the first record
                (chronometrist-sexp-pre-read-check (current-buffer))
                (chronometrist-sexp-delete-list))
              (funcall chronometrist-sexp-pretty-print-function new-plist-group-1 (current-buffer))
              (dotimes (_ 2) (default-indent-new-line))
              (funcall chronometrist-sexp-pretty-print-function new-plist-group-2 (current-buffer)))
          ;; active, or non-day-crossing inactive record
          ;; insert into new group
          (if (or (not latest-plist-group) ;; first record
                  insert-new-group)
              (progn
                (default-indent-new-line)
                (funcall chronometrist-sexp-pretty-print-function new-plist-group-2 (current-buffer)))
            ;; insert into existing group
            (chronometrist-sexp-pre-read-check (current-buffer))
            (chronometrist-sexp-delete-list)
            (funcall chronometrist-sexp-pretty-print-function new-plist-group-1 (current-buffer))))
        (when save (save-buffer))
        t))))
plists-split-p   function

tests

(defun chronometrist-plists-split-p (old-plist new-plist)
  "Return t if OLD-PLIST and NEW-PLIST are split plists.
Split plists means the :stop time of old-plist must be the same as
the :start time of new-plist, and they must have identical
keyword-values (except :start and :stop)."
  (-let* (((&plist :stop  old-stop)  old-plist)
          ((&plist :start new-start) new-plist)
          (old-stop-unix     (parse-iso8601-time-string old-stop))
          (new-start-unix    (parse-iso8601-time-string new-start))
          (old-plist-no-time (chronometrist-plist-remove old-plist :start :stop))
          (new-plist-no-time (chronometrist-plist-remove new-plist :start :stop)))
    (and (time-equal-p old-stop-unix
                       new-start-unix)
         (equal old-plist-no-time
                new-plist-no-time))))
last-two-split-p   procedure
(defun chronometrist-last-two-split-p (file)
  "Return non-nil if the latest two plists in FILE are split.
FILE must be a file containing plist groups, as created by
`chronometrist-plist-backend'.

Return value is either a list in the form
(OLDER-PLIST NEWER-PLIST), or nil."
  (chronometrist-sexp-in-file file
    (let* ((newer-group (progn (goto-char (point-max))
                               (backward-list)
                               (read (current-buffer))))
           (older-group (and (= 2 (length newer-group))
                             (backward-list 2)
                             (read (current-buffer))))
           ;; in case there was just one plist-group in the file
           (older-group (unless (equal older-group newer-group)
                          older-group))
           (newer-plist (cl-second newer-group))
           (older-plist (cl-first (last older-group))))
      (when (and older-plist newer-plist
                 (chronometrist-plists-split-p older-plist newer-plist))
        (list older-plist newer-plist)))))
plist-unify   function
(defun chronometrist-plist-unify (old-plist new-plist)
  "Return a plist with the :start of OLD-PLIST and the :stop of NEW-PLIST."
  (let ((old-plist-wo-time (chronometrist-plist-remove old-plist :start :stop))
        (new-plist-wo-time (chronometrist-plist-remove new-plist :start :stop)))
    (cond ((not (and old-plist new-plist)) nil)
          ((equal old-plist-wo-time new-plist-wo-time)
           (let ((plist (cl-copy-list old-plist)))
             (plist-put plist :stop (plist-get new-plist :stop))))
          (t (error "Attempt to unify plists with non-identical key-values")))))
remove-last   writer method
(cl-defmethod chronometrist-remove-last ((backend chronometrist-plist-group-backend) &key (save t))
  (with-slots (file) backend
    (chronometrist-sexp-in-file file
      (goto-char (point-max))
      (when (chronometrist-backend-empty-p backend)
        (error "chronometrist-remove-last has nothing to remove in %s"
               (eieio-object-class-name backend)))
      (when (chronometrist-last-two-split-p file) ;; cannot be checked after changing the file
        ;; latest plist-group has only one plist, which is split - delete the group
        (backward-list)
        (chronometrist-sexp-delete-list))
      ;; remove the last plist in the last plist-group
      ;; if the plist-group has only one plist, delete the group
      (let ((plist-group (save-excursion (backward-list)
                                         (read (current-buffer)))))
        (if (= 2 (length plist-group))
            (progn (backward-list)
                   (chronometrist-sexp-delete-list))
          (down-list -1)
          (backward-list)
          (chronometrist-sexp-delete-list)
          (join-line))
        (when save (save-buffer))
        t))))
to-list   reader method
(cl-defmethod chronometrist-to-list ((backend chronometrist-plist-group-backend))
  (chronometrist-backend-run-assertions backend)
  (chronometrist-loop-sexp-file for expr in (chronometrist-backend-file backend)
    append (reverse (cl-rest expr))))
to-hash-table   reader method
(cl-defmethod chronometrist-to-hash-table ((backend chronometrist-plist-group-backend))
  (with-slots (file) backend
    (chronometrist-loop-sexp-file for plist-group in file
      with table = (chronometrist-make-hash-table) do
      (puthash (cl-first plist-group) (cl-rest plist-group) table)
      finally return table)))
to-file   writer method
(cl-defmethod chronometrist-to-file (hash-table (backend chronometrist-plist-group-backend) file)
  (cl-check-type hash-table hash-table)
  (delete-file file)
  (chronometrist-create-file backend file)
  (chronometrist-reset-backend backend)
  (chronometrist-sexp-in-file file
    (goto-char (point-max))
    (cl-loop for date being the hash-keys of hash-table
      using (hash-values plists) do
      (insert
       (chronometrist-plist-pp (apply #'list date plists))
       "\n")
      finally do (save-buffer))))
on-add   writer method
(cl-defmethod chronometrist-on-add ((backend chronometrist-plist-group-backend))
  "Function run when a new plist-group is added at the end of a
`chronometrist-plist-group-backend' file."
  (with-slots (hash-table) backend
    (-let [(date plist) (chronometrist-latest-date-records backend)]
      (puthash date plist hash-table)
      (chronometrist-add-to-task-list (plist-get plist :name) backend))))
on-modify   writer method
(cl-defmethod chronometrist-on-modify ((backend chronometrist-plist-group-backend))
  "Function run when the newest plist-group in a
`chronometrist-plist-group-backend' file is modified."
  (with-slots (hash-table) backend
    (-let* (((date . plists) (chronometrist-latest-date-records backend))
            (old-date        (chronometrist-events-last-date hash-table))
            (old-plists      (gethash old-date hash-table)))
      (puthash date plists hash-table)
      (cl-loop for plist in old-plists
        do (chronometrist-remove-from-task-list (plist-get plist :name) backend))
      (cl-loop for plist in plists
        do (chronometrist-add-to-task-list (plist-get plist :name) backend)))))
on-remove   writer method
(cl-defmethod chronometrist-on-remove ((backend chronometrist-plist-group-backend))
  "Function run when the newest plist-group in a
`chronometrist-plist-group-backend' file is deleted."
  (with-slots (hash-table) backend
    (-let* ((old-date        (chronometrist-events-last-date hash-table))
            (old-plists      (gethash old-date hash-table)))
      (cl-loop for plist in old-plists
        do (chronometrist-remove-from-task-list (plist-get plist :name) backend))
      (puthash old-date nil hash-table))))
verify   reader method
(cl-defmethod chronometrist-verify ((backend chronometrist-plist-group-backend))
  (with-slots (file hash-table) backend
    ;; incorrectly ordered groups check
    (chronometrist-loop-sexp-file for group in file
      with old-date-iso with old-date-unix
      with new-date-iso with new-date-unix
      ;; while (not (bobp))
      do (setq new-date-iso  (cl-first group)
               new-date-unix (parse-iso8601-time-string new-date-iso))
      when (and old-date-unix
                (time-less-p old-date-unix
                             new-date-unix))
      do (cl-return (format "%s appears before %s on line %s"
                            new-date-iso old-date-iso (line-number-at-pos)))
      else do (setq old-date-iso  new-date-iso
                    old-date-unix new-date-unix)
      finally return "Yay, no errors! (...that I could find 💀)")))
extended protocol
latest-record   reader method
(cl-defmethod chronometrist-latest-record ((backend chronometrist-plist-group-backend))
  (cl-first (last (chronometrist-latest-date-records backend))))
task-records-for-date   reader method
(cl-defmethod chronometrist-task-records-for-date ((backend chronometrist-plist-group-backend)
                                      task date-ts)
  (cl-check-type task string)
  (cl-check-type date-ts ts)
  (chronometrist-backend-run-assertions backend)
  (cl-loop for plist in (gethash (chronometrist-date-iso date-ts)
                                 (chronometrist-backend-hash-table backend))
    when (equal task (plist-get plist :name))
    collect plist))
TODO active-days   reader method NOEXPORT
(cl-defmethod chronometrist-active-days ((backend chronometrist-plist-group-backend) task &key start end)
  (cl-check-type task string)
  (chronometrist-backend-run-assertions backend))
replace-last   writer method

chronometrist-replace-last is what is used for clocking out, so we split midnight-spanning intervals in this operation.

We apply the same hack as in the insert method, removing and inserting the plist group instead of just the specific plist, to avoid having to update the pretty printer.

(cl-defmethod chronometrist-replace-last ((backend chronometrist-plist-group-backend) plist)
  (cl-check-type plist chronometrist-plist)
  (when (chronometrist-backend-empty-p backend)
    (error "No record to replace in %s" (eieio-object-class-name backend)))
  (chronometrist-sexp-in-file (chronometrist-backend-file backend)
    (chronometrist-remove-last backend :save nil)
    (chronometrist-insert backend plist :save nil)
    (save-buffer)
    t))
count-records   reader method NOEXPORT
(cl-defmethod chronometrist-count-records ((backend chronometrist-plist-group-backend)))

Migration

remove-prefix

(defun chronometrist-remove-prefix (string)
  (replace-regexp-in-string "^chronometrist-" "" string))

migrate

(defun chronometrist-migrate ()
  "Convert from one Chronometrist backend to another."
  (interactive)
  (let* ((input-backend
          (chronometrist-read-backend-name "Backend to convert: "
                              chronometrist-backends-alist))
         (input-file-suggestion (chronometrist-backend-file input-backend))
         (input-file (read-file-name "File to convert: " nil
                                     input-file-suggestion t
                                     input-file-suggestion))
         (output-backend (chronometrist-read-backend-name
                          "Backend to write: "
                          chronometrist-backends-alist
                          (lambda (keyword)
                            (not (equal (cl-second
                                         (alist-get keyword chronometrist-backends-alist))
                                        input-backend)))))
         (output-file-suggestion (chronometrist-backend-file output-backend))
         (output-file (read-file-name "File to write: " nil nil nil
                                      output-file-suggestion))
         (input-backend-name  (chronometrist-remove-prefix
                               (symbol-name
                                (eieio-object-class-name input-backend))))
         (output-backend-name (chronometrist-remove-prefix
                               (symbol-name
                                (eieio-object-class-name output-backend))))
         (confirm (yes-or-no-p
                   (format "Convert %s (%s) to %s (%s)? "
                           input-file
                           input-backend-name
                           output-file
                           output-backend-name)))
         (confirm-exists
          (if (and confirm
                   (file-exists-p output-file)
                   (not (chronometrist-file-empty-p output-file)))
              (yes-or-no-p
               (format "Overwrite existing non-empty file %s ?"
                       output-file))
            t)))
    (if (and confirm confirm-exists)
        (chronometrist-to-file (chronometrist-backend-hash-table input-backend)
                  output-backend
                  output-file)
      (message "Conversion aborted."))))

table   variable

(defvar chronometrist-migrate-table (make-hash-table))

EXTEND populate   writer

  1. support other timeclock codes - currently only "i" and "o" are supported.
(defun chronometrist-migrate-populate (in-file)
  "Read data from IN-FILE to `chronometrist-migrate-table'.
IN-FILE should be a file in the format supported by timeclock.el.
See `timeclock-log-data' for a description."
  (clrhash chronometrist-migrate-table)
  (with-current-buffer (find-file-noselect in-file)
    (save-excursion
      (goto-char (point-min))
      (let ((key-counter 0))
        (while (not (eobp))
          (let* ((event-string (buffer-substring-no-properties (point-at-bol)
                                                               (point-at-eol)))
                 (event-list   (split-string event-string "[ /:]"))
                 (code         (cl-first event-list))
                 (date-time    (--> (seq-drop event-list 1)
                                    (seq-take it 6)
                                    (mapcar #'string-to-number it)
                                    (reverse it)
                                    (apply #'encode-time it)
                                    (chronometrist-format-time-iso8601 it)))
                 (project-or-comment
                  (replace-regexp-in-string
                   (rx (and (or "i" "o") " "
                            (and (= 4 digit) "/" (= 2 digit) "/" (= 2 digit) " ")
                            (and (= 2 digit) ":" (= 2 digit) ":" (= 2 digit))
                            (opt " ")))
                   ""
                   event-string)))
            (pcase code
              ("i"
               (cl-incf key-counter)
               (puthash key-counter
                        `(:name ,project-or-comment :start ,date-time)
                        chronometrist-migrate-table))
              ("o"
               (--> (gethash key-counter chronometrist-migrate-table)
                    (append it
                            `(:stop ,date-time)
                            (when (and (stringp project-or-comment)
                                       (not
                                        (string= project-or-comment "")))
                              `(:comment ,project-or-comment)))
                    (puthash key-counter it chronometrist-migrate-table)))))
          (forward-line)
          (goto-char (point-at-bol))))
      nil)))

timelog-file-to-sexp-file   writer

(defvar timeclock-file)

(defun chronometrist-migrate-timelog-file-to-sexp-file (&optional in-file out-file)
  "Migrate your existing `timeclock-file' to the Chronometrist file format.
IN-FILE and OUT-FILE, if provided, are used as input and output
file names respectively."
  (interactive `(,(if (featurep 'timeclock)
                      (read-file-name (concat "timeclock file (default: "
                                              timeclock-file
                                              "): ")
                                      user-emacs-directory
                                      timeclock-file t)
                    (read-file-name (concat "timeclock file: ")
                                    user-emacs-directory
                                    nil t))
                 ,(read-file-name (concat "Output file (default: "
                                          (locate-user-emacs-file "chronometrist.sexp")
                                          "): ")
                                  user-emacs-directory
                                  (locate-user-emacs-file "chronometrist.sexp"))))
  (when (if (file-exists-p out-file)
            (yes-or-no-p (concat "Output file "
                                 out-file
                                 " already exists - overwrite? "))
          t)
    (let ((output (find-file-noselect out-file)))
      (with-current-buffer output
        (erase-buffer)
        (chronometrist-migrate-populate in-file)
        (maphash (lambda (_key value)
                   (chronometrist-plist-pp value output)
                   (insert "\n\n"))
                 chronometrist-migrate-table)
        (save-buffer)))))

check   writer

(defun chronometrist-migrate-check ()
  "Offer to import data from `timeclock-file' if `chronometrist-file' does not exist."
  (when (and (bound-and-true-p timeclock-file)
             (not (file-exists-p chronometrist-file)))
    (if (yes-or-no-p (format (concat "Chronometrist v0.3+ uses a new file format;"
                                     " import data from %s ? ")
                             timeclock-file))
        (chronometrist-migrate-timelog-file-to-sexp-file timeclock-file chronometrist-file)
      (message "You can migrate later using `chronometrist-migrate-timelog-file-to-sexp-file'."))))

Timer

Instead of the Emacs convention of pressing g to update, we keep buffers updated with a timer.

Note - sometimes, when hacking or dealing with errors, timers may result in subtle bugs which are very hard to debug. Using chronometrist-force-restart-timer or restarting Emacs can fix them, so try that as a first sanity check.

update-interval   custom variable

(defcustom chronometrist-update-interval 5
  "How often the `chronometrist' buffer should be updated, in seconds.

This is not guaranteed to be accurate - see (info \"(elisp)Timers\")."
  :type 'integer)

timer-object   internal variable

(defvar chronometrist--timer-object nil)

timer-hook   hook custom variable

(defcustom chronometrist-timer-hook nil
  "Functions run by `chronometrist-timer'."
  :type '(repeat function))

start-timer   command

(defun chronometrist-start-timer ()
  (setq chronometrist--timer-object
        (run-at-time t chronometrist-update-interval #'chronometrist-timer)))

stop-timer   command

(defun chronometrist-stop-timer ()
  "Stop the timer for Chronometrist buffers."
  (interactive)
  (cancel-timer chronometrist--timer-object)
  (setq chronometrist--timer-object nil))

maybe-start-timer   command

(defun chronometrist-maybe-start-timer (&optional interactive-test)
  "Start `chronometrist-timer' if `chronometrist--timer-object' is non-nil.
INTERACTIVE-TEST is used to determine if this has been called
interactively."
  (interactive "p")
  (unless chronometrist--timer-object
    (chronometrist-start-timer)
    (when interactive-test
      (message "Timer started."))
    t))

force-restart-timer   command

(defun chronometrist-force-restart-timer ()
  "Restart the timer for Chronometrist buffers."
  (interactive)
  (when chronometrist--timer-object
    (cancel-timer chronometrist--timer-object))
  (chronometrist-start-timer))

change-update-interval   command

(defun chronometrist-change-update-interval (arg)
  "Change the update interval for Chronometrist buffers.

ARG should be the new update interval, in seconds."
  (interactive "NEnter new interval (in seconds): ")
  (cancel-timer chronometrist--timer-object)
  (setq chronometrist-update-interval arg
        chronometrist--timer-object nil)
  (chronometrist-maybe-start-timer))

timer   function

(defvar chronometrist-buffer-name)
(defun chronometrist-timer ()
  "Refresh Chronometrist and related buffers.
Buffers will be refreshed only if they are visible, the user is
clocked in to a task, and the active backend is not being
modified."
  ;; No need to update the buffer if there is no active task, or if
  ;; the file is being edited by the user. (The file may be in an
  ;; invalid state, and reading it then may result in a read error.)
  ;; Check for buffer modification first, since `chronometrist-current-task' may
  ;; access the file (causing an error).
  (when (and (not (chronometrist-backend-modified-p (chronometrist-active-backend)))
             (chronometrist-current-task))
    (when (get-buffer-window chronometrist-buffer-name)
      (chronometrist-refresh))
    (run-hooks 'chronometrist-timer-hook)))

Frontends

All four of these use (info "(elisp)Tabulated List Mode"). Each of them also contains a "-print-non-tabular" function, which prints the non-tabular parts of the buffer.

  1. There is some duplication between the four frontend commands, e.g. all four act as toggles for their respective buffers, point preservation, etc.

Chronometrist

TODO [33%]
  1. Define hooks with defcustom instead of defvar
  2. Change abnormal hooks to normal hooks
  3. midnight-spanning plist not displayed (may have to do with partial updates)
buffer-name   custom variable
(defcustom chronometrist-buffer-name "*Chronometrist*"
  "The name of the buffer created by `chronometrist'."
  :type 'string)
hide-cursor   custom variable

I have not yet gotten this to work as well as I wanted.

(defcustom chronometrist-hide-cursor nil
  "If non-nil, hide the cursor and only highlight the current line in the `chronometrist' buffer."
  :type 'boolean)
activity-indicator   custom variable
(defcustom chronometrist-activity-indicator "*"
  "How to indicate that a task is active.
Can be a string to be displayed, or a function which returns this string.
The default is \"*\""
  :type '(choice string function))
point   internal variable
(defvar chronometrist--point nil)
open-log   command
(defun chronometrist-open-log (&optional _button)
  "Open `chronometrist-file' in another window.

Argument _BUTTON is for the purpose of using this command as a
button action."
  (interactive)
  (chronometrist-edit-backend (chronometrist-active-backend)))
task-active-p   reader
(defun chronometrist-task-active-p (task)
  "Return t if TASK is currently clocked in, else nil."
  (equal (chronometrist-current-task) task))
activity-indicator   procedure
(defun chronometrist-activity-indicator ()
  "Return a string to indicate that a task is active.
See custom variable `chronometrist-activity-indicator'."
  (if (functionp chronometrist-activity-indicator)
      (funcall chronometrist-activity-indicator)
    chronometrist-activity-indicator))
run-transformers   function

Used by chronometrist-row-transformers and chronometrist-schema-transformers to remove the need for Chronometrist to know about extensions like chronometrist-goal.

(defun chronometrist-run-transformers (transformers arg)
  "Run TRANSFORMERS with ARG.
TRANSFORMERS should be a list of functions (F₁ ... Fₙ), each of
which should accept a single argument.

Call F₁ with ARG, with each following function being called with
the return value of the previous function.

Return the value returned by Fₙ."
  (if transformers
      (dolist (fn transformers arg)
        (setq arg (funcall fn arg)))
    arg))
TODO schema   custom variable
  1. Define custom :type
(defcustom chronometrist-schema
  '[("#" 3 t) ("Task" 25 t) ("Time" 10 t) ("Active" 10 t)]
  "Vector specifying schema of `chronometrist' buffer.
See `tabulated-list-format'."
  :type '(vector))
chronometrist-mode-hook   hook normal
(defvar chronometrist-mode-hook nil
  "Normal hook run at the very end of `chronometrist-mode'.")
schema-transformers   extension variable
(defvar chronometrist-schema-transformers nil
  "List of functions to transform `chronometrist-schema'.
This is called with `chronometrist-run-transformers' in `chronometrist-mode', which see.

Extensions using `chronometrist-schema-transformers' to
increase the number of columns will also need to modify the value
of `tabulated-list-entries' by using
`chronometrist-row-transformers'.")
row-transformers   extension variable
(defvar chronometrist-row-transformers nil
  "List of functions to transform each row of `tabulated-list-entries'.
This is called with `chronometrist-run-transformers' in `chronometrist-rows', which see.

Extensions using `chronometrist-row-transformers' to increase
the number of columns will also need to modify the value of
`tabulated-list-format' by using
`chronometrist-schema-transformers'.")
before-in-functions   hook abnormal
(defcustom chronometrist-before-in-functions nil
  "Functions to run before a task is clocked in.
Each function in this hook must accept a single argument, which
is the name of the task to be clocked-in.

The commands `chronometrist-toggle-task-button',
`chronometrist-add-new-task-button', `chronometrist-toggle-task',
and `chronometrist-add-new-task' will run this hook."
  :type '(repeat function))
after-in-functions   hook abnormal
(defcustom chronometrist-after-in-functions nil
  "Functions to run after a task is clocked in.
Each function in this hook must accept a single argument, which
is the name of the task to be clocked-in.

The commands `chronometrist-toggle-task-button',
`chronometrist-add-new-task-button', `chronometrist-toggle-task',
and `chronometrist-add-new-task' will run this hook."
  :type '(repeat function))
before-out-functions   hook abnormal
(defcustom chronometrist-before-out-functions nil
  "Functions to run before a task is clocked out.
Each function in this hook must accept a single argument, which
is the name of the task to be clocked out of.

The task will be stopped only if all functions in this list
return a non-nil value."
  :type '(repeat function))
after-out-functions   hook abnormal
(defcustom chronometrist-after-out-functions nil
  "Functions to run after a task is clocked out.
Each function in this hook must accept a single argument, which
is the name of the task to be clocked out of."
  :type '(repeat function))
file-change-hook   hook normal
(defcustom chronometrist-file-change-hook nil
  "Functions to be run after `chronometrist-file' is changed on disk."
  :type '(repeat function))
rows   procedure
(defun chronometrist-rows ()
  "Return rows to be displayed in the buffer created by `chronometrist', in the format specified by `tabulated-list-entries'."
  (cl-loop with index = 1
    for task in (-sort #'string-lessp (chronometrist-task-list)) collect
    (let* ((index       (number-to-string index))
           (task-button `(,task action chronometrist-toggle-task-button
                                follow-link t))
           (task-time   (chronometrist-format-duration (chronometrist-task-time-one-day task)))
           (indicator   (if (chronometrist-task-active-p task)
                            (chronometrist-activity-indicator) "")))
      (--> (vector index task-button task-time indicator)
           (list task it)
           (chronometrist-run-transformers chronometrist-row-transformers it)))
    do (cl-incf index)))
task-at-point   procedure
(defun chronometrist-task-at-point ()
  "Return the task at point in the `chronometrist' buffer, or nil if there is no task at point."
  (save-excursion
    (beginning-of-line)
    (when (re-search-forward "[0-9]+ +" nil t)
      (get-text-property (point) 'tabulated-list-id))))
goto-last-task   procedure
(defun chronometrist-goto-last-task ()
  "In the `chronometrist' buffer, move point to the line containing the last active task."
  (let* ((latest-record (chronometrist-latest-record (chronometrist-active-backend)))
         (name (plist-get latest-record :name)))
    (goto-char (point-min))
    (re-search-forward name nil t)
    (beginning-of-line)))
CLEANUP print-non-tabular   procedure
(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    "))
      (goto-char (point-max))
      (--> (chronometrist-active-time-on)
           (chronometrist-format-duration it)
           (format "%s%- 26s%s" w "Total" it)
           (insert it)))))
goto-nth-task   procedure
(defun chronometrist-goto-nth-task (n)
  "Move point to the line containing the Nth task.
Return the task at point, or nil if there is no corresponding
task. N must be a positive integer."
  (goto-char (point-min))
  (when (re-search-forward (format "^%d" n) nil t)
    (beginning-of-line)
    (chronometrist-task-at-point)))
refresh   procedure
(defun chronometrist-refresh (&optional _ignore-auto _noconfirm)
  "Refresh the `chronometrist' buffer, without re-reading `chronometrist-file'.
The optional arguments _IGNORE-AUTO and _NOCONFIRM are ignored,
and are present solely for the sake of using this function as a
value of `revert-buffer-function'."
  (let* ((window (get-buffer-window chronometrist-buffer-name t))
         (point  (window-point window)))
    (when window
      (with-current-buffer chronometrist-buffer-name
        (tabulated-list-print t nil)
        (chronometrist-print-non-tabular)
        (chronometrist-maybe-start-timer)
        (set-window-point window point)))))
refresh-file   writer

chronometrist-file-change-type must be run before we update chronometrist--file-state (the latter represents the old state of the file, which chronometrist-file-change-type compares with the newer current state).

(defun chronometrist-refresh-file (fs-event)
  "Procedure run when `chronometrist-file' changes.
Re-read `chronometrist-file', update caches, and
refresh the `chronometrist' buffer."
  (run-hooks 'chronometrist-file-change-hook)
  ;; (message "chronometrist - file %s" fs-event)
  (chronometrist-on-change (chronometrist-active-backend) fs-event)
  (chronometrist-refresh))
query-stop   procedure
(defun chronometrist-query-stop ()
  "Ask the user if they would like to clock out."
  (let ((task (chronometrist-current-task)))
    (and task
         (yes-or-no-p (format "Stop tracking time for %s? " task))
         (chronometrist-out))
    t))
chronometrist-in   command
(defun chronometrist-in (task &optional _prefix)
  "Clock in to TASK; record current time in `chronometrist-file'.
TASK is the name of the task, a string. PREFIX is ignored."
  (interactive "P")
  (let ((plist `(:name ,task :start ,(chronometrist-format-time-iso8601))))
    (chronometrist-insert (chronometrist-active-backend) plist)
    (chronometrist-refresh)))
chronometrist-out   command
(defun chronometrist-out (&optional _prefix)
  "Record current moment as stop time to last s-exp in `chronometrist-file'.
PREFIX is ignored."
  (interactive "P")
  (let* ((latest (chronometrist-latest-record (chronometrist-active-backend)))
         (plist  (plist-put latest :stop (chronometrist-format-time-iso8601))))
    (chronometrist-replace-last (chronometrist-active-backend) plist)))
run-functions-and-clock-in   writer
(defun chronometrist-run-functions-and-clock-in (task)
  "Run hooks and clock in to TASK."
  (run-hook-with-args 'chronometrist-before-in-functions task)
  (chronometrist-in task)
  (run-hook-with-args 'chronometrist-after-in-functions task))
run-functions-and-clock-out   writer
(defun chronometrist-run-functions-and-clock-out (task)
  "Run hooks and clock out of TASK."
  (when (run-hook-with-args-until-failure 'chronometrist-before-out-functions task)
    (chronometrist-out)
    (run-hook-with-args 'chronometrist-after-out-functions task)))
chronometrist-mode-map   keymap
(defvar chronometrist-mode-map
  (let ((map (make-sparse-keymap)))
    (define-key map (kbd "a")          #'chronometrist-add-new-task)
    (define-key map (kbd "RET")        #'chronometrist-toggle-task)
    (define-key map (kbd "M-RET")      #'chronometrist-toggle-task-no-hooks)
    (define-key map [mouse-1]          #'chronometrist-toggle-task)
    (define-key map [mouse-3]          #'chronometrist-toggle-task-no-hooks)
    (define-key map (kbd "<C-return>") #'chronometrist-restart-task)
    (define-key map (kbd "<C-M-return>") #'chronometrist-extend-task)
    (define-key map (kbd "D")          #'chronometrist-discard-active)
    (define-key map (kbd "d")          #'chronometrist-details)
    (define-key map (kbd "r")          #'chronometrist-report)
    (define-key map (kbd "l")          #'chronometrist-open-log)
    (define-key map (kbd "G")          #'chronometrist-reset)
    (define-key map (kbd "T")          #'chronometrist-force-restart-timer)
    map)
  "Keymap used by `chronometrist-mode'.")
chronometrist-menu   menu
(easy-menu-define chronometrist-menu chronometrist-mode-map
  "Chronometrist mode menu."
  '("Chronometrist"
    ["Start a new task" chronometrist-add-new-task]
    ["Toggle task at point" chronometrist-toggle-task]
    ["Toggle task without running hooks" chronometrist-toggle-task-no-hooks]
    ["Discard and restart active task" chronometrist-restart-task]
    ["Discard and restart without running hooks" (chronometrist-restart-task t)
     :keys "\\[universal-argument] \\[chronometrist-restart-task]"]
    ["Extend time for last completed task" chronometrist-extend-task]
    ["Extend time without running hooks" (chronometrist-extend-task t)
     :keys "\\[universal-argument] \\[chronometrist-extend-task]"]
    ["Discard active interval" chronometrist-discard-active]
    "----"
    ["View details of today's data" chronometrist-details]
    ["View weekly report" chronometrist-report]
    ["View/edit log file" chronometrist-open-log]
    ["View/edit literate source" chronometrist-open-literate-source]
    "----"
    ["Restart timer" chronometrist-force-restart-timer]
    ["Reset state" chronometrist-reset]
    ["Import/export data" chronometrist-migrate]))
chronometrist-mode   major mode
(define-derived-mode chronometrist-mode tabulated-list-mode "Chronometrist"
  "Major mode for `chronometrist'."
  (make-local-variable 'tabulated-list-format)
  (--> (chronometrist-run-transformers chronometrist-schema-transformers chronometrist-schema)
    (setq tabulated-list-format it))
  (make-local-variable 'tabulated-list-entries)
  (setq tabulated-list-entries 'chronometrist-rows)
  (make-local-variable 'tabulated-list-sort-key)
  (setq tabulated-list-sort-key '("Task" . nil))
  (tabulated-list-init-header)
  (setq revert-buffer-function #'chronometrist-refresh)
  (run-hooks 'chronometrist-mode-hook))
toggle-task-button   writer
(defun chronometrist-toggle-task-button (_button)
  "Button action to toggle a task.
Argument _BUTTON is for the purpose of using this as a button
action, and is ignored."
  (when current-prefix-arg
    (chronometrist-goto-nth-task (prefix-numeric-value current-prefix-arg)))
  (let ((current  (chronometrist-current-task))
        (at-point (chronometrist-task-at-point)))
    ;; clocked in + point on current    = clock out
    ;; clocked in + point on some other task = clock out, clock in to task
    ;; clocked out = clock in
    (when current
      (chronometrist-run-functions-and-clock-out current))
    (unless (equal at-point current)
      (chronometrist-run-functions-and-clock-in at-point))))
add-new-task-button   writer
(defun chronometrist-add-new-task-button (_button)
  "Button action to add a new task.
Argument _BUTTON is for the purpose of using this as a button
action, and is ignored."
  (let ((current (chronometrist-current-task)))
    (when current
      (chronometrist-run-functions-and-clock-out current))
    (let ((task (read-from-minibuffer "New task name: " nil nil nil nil nil t)))
      (chronometrist-run-functions-and-clock-in task))))
toggle-task   command
;; TODO - if clocked in and point not on a task, just clock out
(defun chronometrist-toggle-task (&optional prefix inhibit-hooks)
  "Start or stop the task at point.

If there is no task at point, do nothing.

With numeric prefix argument PREFIX, toggle the Nth task in
the buffer. If there is no corresponding task, do nothing.

If INHIBIT-HOOKS is non-nil, the hooks
`chronometrist-before-in-functions',
`chronometrist-after-in-functions',
`chronometrist-before-out-functions', and
`chronometrist-after-out-functions' will not be run."
  (interactive "P")
  (chronometrist-debug-message "[Command] toggle-task %s" (if inhibit-hooks "(without hooks)" ""))
  (let* ((empty-file   (chronometrist-backend-empty-p (chronometrist-active-backend)))
         (nth          (when prefix (chronometrist-goto-nth-task prefix)))
         (at-point     (chronometrist-task-at-point))
         (target       (or nth at-point))
         (current      (chronometrist-current-task))
         (in-function  (if inhibit-hooks #'chronometrist-in  #'chronometrist-run-functions-and-clock-in))
         (out-function (if inhibit-hooks #'chronometrist-out #'chronometrist-run-functions-and-clock-out)))
    ;; do not run hooks - chronometrist-add-new-task will do it
    (cond (empty-file (chronometrist-add-new-task))
          ;; What should we do if the user provides an invalid
          ;; argument? Currently - nothing.
          ((and prefix (not nth)))
          (target ;; do nothing if there's no task at point
           ;; clocked in + target is current = clock out
           ;; clocked in + target is some other task = clock out, clock in to task
           ;; clocked out = clock in
           (when current
             (funcall out-function current))
           (unless (equal target current)
             (funcall in-function target))))))
toggle-task-no-hooks   command
(defun chronometrist-toggle-task-no-hooks (&optional prefix)
  "Like `chronometrist-toggle-task', but don't run hooks.

With numeric prefix argument PREFIX, toggle the Nth task. If
there is no corresponding task, do nothing."
  (interactive "P")
  (chronometrist-toggle-task prefix t))
add-new-task   command
(defun chronometrist-add-new-task ()
  "Add a new task."
  (interactive)
  (chronometrist-debug-message "[Command] add-new-task")
  (chronometrist-add-new-task-button nil))
restart-task   command
(defun chronometrist-restart-task (&optional inhibit-hooks)
  "Change the start time of the active task to the current time.
`chronometrist-before-in-functions' and
`chronometrist-after-in-functions' are run again, unless
INHIBIT-HOOKS is non-nil or prefix argument is supplied.

Has no effect if no task is active."
  (interactive "P")
  (chronometrist-debug-message "[Command] restart-task")
  (if (chronometrist-current-task)
      (let* ((latest (chronometrist-latest-record (chronometrist-active-backend)))
             (plist  (plist-put latest :start (chronometrist-format-time-iso8601)))
             (task   (plist-get plist :name)))
        (unless inhibit-hooks
         (run-hook-with-args 'chronometrist-before-in-functions task))
        (chronometrist-replace-last (chronometrist-active-backend) plist)
        (unless inhibit-hooks
         (run-hook-with-args 'chronometrist-after-in-functions task)))
    (message "Can only restart an active task - use this when clocked in.")))
extend-task   command
(defun chronometrist-extend-task (&optional inhibit-hooks)
  "Change the stop time of the last task to the current time.
`chronometrist-before-out-functions' and
`chronometrist-after-out-functions' are run again, unless
INHIBIT-HOOKS is non-nil or prefix argument is supplied.

Has no effect if a task is active."
  (interactive "P")
  (chronometrist-debug-message "[Command] extend-task")
  (if (chronometrist-current-task)
      (message "Cannot extend an active task - use this after clocking out.")
    (let* ((latest (chronometrist-latest-record (chronometrist-active-backend)))
           (plist  (plist-put latest :stop (chronometrist-format-time-iso8601)))
           (task   (plist-get plist :name)))
      (unless inhibit-hooks
         (run-hook-with-args-until-failure 'chronometrist-before-out-functions task))
      (chronometrist-replace-last (chronometrist-active-backend) plist)
      (unless inhibit-hooks
        (run-hook-with-args 'chronometrist-after-out-functions task)))))
discard-active   command
(defun chronometrist-discard-active ()
  "Remove active interval from the active backend."
  (interactive)
  (chronometrist-debug-message "[Command] discard-active")
  (let ((backend (chronometrist-active-backend)))
    (if (chronometrist-current-task backend)
        (chronometrist-remove-last backend)
      (message "Nothing to discard - use this when clocked in."))))
chronometrist   command
;;;###autoload
(defun chronometrist (&optional arg)
  "Display the user's tasks and the time spent on them today.
If numeric argument ARG is 1, run `chronometrist-report'; if 2,
run `chronometrist-statistics'."
  (interactive "P")
  (chronometrist-migrate-check)
  (let* ((buffer (get-buffer-create chronometrist-buffer-name))
         (w      (save-excursion
                   (get-buffer-window chronometrist-buffer-name t)))
         (backend (chronometrist-active-backend)))
    (cond
     (arg (cl-case arg
            (1 (chronometrist-report))
            (2 (chronometrist-statistics))))
     (w (with-current-buffer buffer
          (setq chronometrist--point (point))
          (kill-buffer chronometrist-buffer-name)))
     (t (with-current-buffer buffer
          (cond ((chronometrist-backend-empty-p backend)
                 ;; database is empty
                 (chronometrist-create-file backend)
                 (let ((inhibit-read-only t))
                   (erase-buffer)
                   (insert "Welcome to Chronometrist! Hit RET to ")
                   (insert-text-button "start a new task."
                                       'action #'chronometrist-add-new-task-button
                                       'follow-link t)
                   (chronometrist-mode)
                   (switch-to-buffer buffer)))
                (t (chronometrist-mode)
                   (when chronometrist-hide-cursor
                     (make-local-variable 'cursor-type)
                     (setq cursor-type nil)
                     (hl-line-mode))
                   (switch-to-buffer buffer)
                   (when (chronometrist-memory-layer-empty-p backend)
                     (chronometrist-reset-backend backend))
                   (chronometrist-refresh)
                   (if chronometrist--point
                       (goto-char chronometrist--point)
                     (chronometrist-goto-last-task))))
          (chronometrist-setup-file-watch))))))

Report

TODO [0%]
  1. preserve point when clicking buttons
report   custom group
(defgroup chronometrist-report nil
  "Weekly report for the `chronometrist' time tracker."
  :group 'chronometrist)
buffer-name   custom variable
(defcustom chronometrist-report-buffer-name "*Chronometrist-Report*"
  "The name of the buffer created by `chronometrist-report'."
  :type 'string)
ui-date   internal variable
(defvar chronometrist-report--ui-date nil
  "The first date of the week displayed by `chronometrist-report'.
A value of nil means the current week. Otherwise, it must be a
date in the form \"YYYY-MM-DD\".")
ui-week-dates   internal variable
(defvar chronometrist-report--ui-week-dates nil
  "List of dates currently displayed by `chronometrist-report'.
Each date is a list containing calendrical information (see (info \"(elisp)Time Conversion\"))")
point   internal variable
(defvar chronometrist-report--point nil)
date-to-dates-in-week   function
(defun chronometrist-report-date-to-dates-in-week (first-date-in-week)
  "Return a list of dates in a week, starting from FIRST-DATE-IN-WEEK.
Each date is a ts struct (see `ts.el').

FIRST-DATE-IN-WEEK must be a ts struct representing the first date."
  (cl-loop for i from 0 to 6 collect
           (ts-adjust 'day i first-date-in-week)))
date-to-week-dates   function
(defun chronometrist-report-date-to-week-dates ()
  "Return dates in week as a list.
Each element is a ts struct (see `ts.el').

The first date is the first occurrence of
`chronometrist-report-week-start-day' before the date specified in
`chronometrist-report--ui-date' (if non-nil) or the current date."
  (->> (or chronometrist-report--ui-date (chronometrist-date-ts))
       (chronometrist-previous-week-start)
       (chronometrist-report-date-to-dates-in-week)))
rows   procedure
(defun chronometrist-report-rows ()
  "Return rows to be displayed in the `chronometrist-report' buffer."
  (cl-loop
    ;; `chronometrist-report-date-to-week-dates' uses today if chronometrist-report--ui-date is nil
    with week-dates = (setq chronometrist-report--ui-week-dates
                            (chronometrist-report-date-to-week-dates))
    for task in (chronometrist-task-list) collect
    (let* ((durations        (--map (chronometrist-task-time-one-day task (chronometrist-date-ts it))
                                    week-dates))
           (duration-strings (mapcar #'chronometrist-format-duration durations))
           (total-duration   (->> (-reduce #'+ durations)
                                  (chronometrist-format-duration)
                                  (vector))))
      (list task
            (vconcat
             (vector task)
             duration-strings ;; vconcat converts lists to vectors
             total-duration)))))
print-keybind   procedure
(defun chronometrist-report-print-keybind (command &optional description firstonly)
  "Insert one or more keybindings for COMMAND into the current buffer.
DESCRIPTION is a description of the command.

If FIRSTONLY is non-nil, insert only the first keybinding found."
  (insert "\n    "
          (chronometrist-format-keybinds command firstonly)
          " - "
          (if description description "")))
CLEANUP print-non-tabular   procedure
(defun chronometrist-report-print-non-tabular ()
  "Print the non-tabular part of the buffer in `chronometrist-report'."
  (let* ((inhibit-read-only t)
         (w "\n    ")
         (ui-week-dates-ts  (mapcar #'chronometrist-date-ts chronometrist-report--ui-week-dates))
         (total-time-daily  (mapcar #'chronometrist-active-time-on
                                    ui-week-dates-ts)))
    (goto-char (point-min))
    (insert (make-string 25 ?\s))
    (insert (mapconcat (lambda (ts)
                         (ts-format "%F" ts))
                       (chronometrist-report-date-to-week-dates)
                       " "))
    (insert "\n")
    (goto-char (point-max))
    (insert w (format "%- 21s" "Total"))
    (->> (mapcar #'chronometrist-format-duration total-time-daily)
         (--map (format "% 9s  " it))
         (apply #'insert))
    (->> (-reduce #'+ total-time-daily)
         (chronometrist-format-duration)
         (format "% 13s")
         (insert))
    (insert "\n" w)
    (insert-text-button "<<" 'action #'chronometrist-report-previous-week 'follow-link t)
    (insert (format "% 4s" " "))
    (insert-text-button ">>" 'action #'chronometrist-report-next-week 'follow-link t)
    (insert "\n")
    (chronometrist-report-print-keybind 'chronometrist-report-previous-week)
    (insert-text-button "previous week" 'action #'chronometrist-report-previous-week 'follow-link t)
    (chronometrist-report-print-keybind 'chronometrist-report-next-week)
    (insert-text-button "next week" 'action #'chronometrist-report-next-week 'follow-link t)
    (chronometrist-report-print-keybind 'chronometrist-open-log)
    (insert-text-button "open log file" 'action #'chronometrist-open-log 'follow-link t)))
REVIEW refresh   procedure

Merge this into `chronometrist-refresh-file', while moving the -refresh call to the call site?

(defun chronometrist-report-refresh (&optional _ignore-auto _noconfirm)
  "Refresh the `chronometrist-report' buffer, without re-reading `chronometrist-file'."
  (let* ((w (get-buffer-window chronometrist-report-buffer-name t))
         (p (point)))
    (with-current-buffer chronometrist-report-buffer-name
      (tabulated-list-print t nil)
      (chronometrist-report-print-non-tabular)
      (chronometrist-maybe-start-timer)
      (set-window-point w p))))
refresh-file   writer
(defun chronometrist-report-refresh-file (fs-event)
  "Re-read `chronometrist-file' and refresh the `chronometrist-report' buffer."
  (run-hooks 'chronometrist-file-change-hook)
  (chronometrist-on-change (chronometrist-active-backend) fs-event)
  (chronometrist-report-refresh))
report-mode-map   keymap
(defvar chronometrist-report-mode-map
  (let ((map (make-sparse-keymap)))
    (define-key map (kbd "l") #'chronometrist-open-log)
    (define-key map (kbd "b") #'chronometrist-report-previous-week)
    (define-key map (kbd "f") #'chronometrist-report-next-week)
    ;; Works when number of tasks < screen length; after that, you
    ;; probably expect mousewheel to scroll up/down, and
    ;; alt-mousewheel or something for next/previous week. For now,
    ;; I'm assuming most people won't have all that many tasks - I've
    ;; been using it for ~2 months and have 18 tasks, which are
    ;; still just half the screen on my 15" laptop. Let's see what
    ;; people say.
    (define-key map [mouse-4] #'chronometrist-report-next-week)
    (define-key map [mouse-5] #'chronometrist-report-previous-week)
    map)
  "Keymap used by `chronometrist-report-mode'.")
report-mode   major mode
(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)])
  (make-local-variable 'tabulated-list-entries)
  (setq tabulated-list-entries 'chronometrist-report-rows)
  (make-local-variable 'tabulated-list-sort-key)
  (setq tabulated-list-sort-key '("Task" . nil))
  (tabulated-list-init-header)
  (chronometrist-maybe-start-timer)
  (add-hook 'chronometrist-timer-hook
            (lambda ()
              (when (get-buffer-window chronometrist-report-buffer-name)
                (chronometrist-report-refresh))))
  (setq revert-buffer-function #'chronometrist-report-refresh)
  (chronometrist-setup-file-watch))
chronometrist-report   command
;;;###autoload
(defun chronometrist-report (&optional keep-date)
  "Display a weekly report of the data in `chronometrist-file'.
If a buffer called `chronometrist-report-buffer-name' already
exists and is visible, kill the buffer.

If KEEP-DATE is nil (the default when not supplied), set
`chronometrist-report--ui-date' to nil and display data from the
current week. Otherwise, display data from the week specified by
`chronometrist-report--ui-date'."
  (interactive)
  (chronometrist-migrate-check)
  (let ((buffer (get-buffer-create chronometrist-report-buffer-name)))
    (with-current-buffer buffer
      (cond ((and (get-buffer-window chronometrist-report-buffer-name)
                  (not keep-date))
             (setq chronometrist-report--point (point))
             (kill-buffer buffer))
            (t (unless keep-date
                 (setq chronometrist-report--ui-date nil))
               (chronometrist-create-file (chronometrist-active-backend))
               (chronometrist-report-mode)
               (switch-to-buffer buffer)
               (chronometrist-report-refresh-file nil)
               (goto-char (or chronometrist-report--point 1)))))))
report-previous-week   command
(defun chronometrist-report-previous-week (arg)
  "View the previous week's report.
With prefix argument ARG, move back ARG weeks."
  (interactive "P")
  (let ((arg (if (and arg (numberp arg))
                 (abs arg)
               1)))
    (setq chronometrist-report--ui-date
          (ts-adjust 'day (- (* arg 7))
                     (if chronometrist-report--ui-date
                         chronometrist-report--ui-date
                       (ts-now)))))
  (setq chronometrist-report--point (point))
  (kill-buffer)
  (chronometrist-report t))
report-next-week   command
(defun chronometrist-report-next-week (arg)
  "View the next week's report.
With prefix argument ARG, move forward ARG weeks."
  (interactive "P")
  (let ((arg (if (and arg (numberp arg))
                 (abs arg)
               1)))
    (setq chronometrist-report--ui-date
          (ts-adjust 'day (* arg 7)
                     (if chronometrist-report--ui-date
                         chronometrist-report--ui-date
                       (ts-now))))
    (setq chronometrist-report--point (point))
    (kill-buffer)
    (chronometrist-report t)))

Statistics

statistics   custom group
(defgroup chronometrist-statistics nil
  "Statistics buffer for the `chronometrist' time tracker."
  :group 'chronometrist)
buffer-name   custom variable
(defcustom chronometrist-statistics-buffer-name "*Chronometrist-Statistics*"
  "The name of the buffer created by `chronometrist-statistics'."
  :type 'string)
ui-state   internal variable
(defvar chronometrist-statistics--ui-state nil
  "Stores the display state for `chronometrist-statistics'.

This must be a plist in the form (:MODE :START :END).

:MODE is either 'week, 'month, 'year, 'full, or 'custom.

'week, 'month, and 'year mean display statistics
weekly/monthly/yearly respectively.

'full means display statistics for all available data at once.

'custom means display statistics from an arbitrary date range.

:START and :END are the start and end of the date range to be
displayed. They must be ts structs (see `ts.el').")
point   internal variable
(defvar chronometrist-statistics--point nil)
mode-map   keymap
(defvar chronometrist-statistics-mode-map)
count-average-time-spent   function
(cl-defun chronometrist-statistics-count-average-time-spent (task &optional (backend (chronometrist-active-backend)))
  "Return the average time the user has spent on TASK in BACKEND."
  (cl-loop with days = 0
    with events-in-day
    for date being the hash-keys of (chronometrist-backend-hash-table backend)
    when (setq events-in-day (chronometrist-task-records-for-date backend task date))
    do (cl-incf days) and
    collect
    (-reduce #'+ (chronometrist-events-to-durations events-in-day))
    into per-day-time-list
    finally return
    (if per-day-time-list
        (/ (-reduce #'+ per-day-time-list) days)
      0)))
rows-internal   reader
(defun chronometrist-statistics-rows-internal (table)
  "Helper function for `chronometrist-statistics-rows'.

It simply operates on the entire hash table TABLE (see
`chronometrist-to-hash-table' for table format), so ensure that TABLE is
reduced to the desired range using
`chronometrist-events-subset'."
  (cl-loop for task in (chronometrist-task-list) collect
    (let* ((active-days    (chronometrist-statistics-count-active-days task table))
           (active-percent (cl-case (plist-get chronometrist-statistics--ui-state :mode)
                             ('week (* 100 (/ active-days 7.0)))))
           (active-percent (if (zerop active-days)
                               (format "    % 6s" "-")
                             (format "    %05.2f%%" active-percent)))
           (active-days    (format "% 5s"
                                   (if (zerop active-days)
                                       "-"
                                     active-days)))
           (average-time   (->> (chronometrist-statistics-count-average-time-spent task table)
                             (chronometrist-format-duration)
                             (format "% 5s")))
           (content        (vector task active-days active-percent average-time)))
      (list task content))))
TEST rows   reader
(defun chronometrist-statistics-rows ()
  "Return rows to be displayed in the buffer created by `chronometrist-statistics'."
  ;; We assume that all fields in `chronometrist-statistics--ui-state' are set, so they must
  ;; be changed by the view-changing functions.
  (with-slots (hash-table) (chronometrist-active-backend)
    (cl-case (plist-get chronometrist-statistics--ui-state :mode)
      ('week
       (let* ((start (plist-get chronometrist-statistics--ui-state :start))
              (end   (plist-get chronometrist-statistics--ui-state :end))
              (ht    (chronometrist-events-subset start end hash-table)))
         (chronometrist-statistics-rows-internal ht)))
      (t ;; `chronometrist-statistics--ui-state' is nil, show current week's data
       (let* ((start (chronometrist-previous-week-start (chronometrist-date-ts)))
              (end   (ts-adjust 'day 7 start))
              (ht    (chronometrist-events-subset start end hash-table)))
         (setq chronometrist-statistics--ui-state `(:mode week :start ,start :end ,end))
         (chronometrist-statistics-rows-internal ht))))))
print-keybind   procedure
(defun chronometrist-statistics-print-keybind (command &optional description firstonly)
  "Insert the keybindings for COMMAND.
If DESCRIPTION is non-nil, insert that too.
If FIRSTONLY is non-nil, return only the first keybinding found."
  (insert "\n    "
          (chronometrist-format-keybinds command
                             chronometrist-statistics-mode-map
                             firstonly)
          " - "
          (if description description "")))
print-non-tabular   procedure
(defun chronometrist-statistics-print-non-tabular ()
  "Print the non-tabular part of the buffer in `chronometrist-statistics'."
  (let ((w "\n    ")
        (inhibit-read-only t))
    (goto-char (point-max))
    (insert w)
    (insert-text-button (cl-case (plist-get chronometrist-statistics--ui-state :mode)
                          ('week "Weekly view"))
                        ;; 'action #'chronometrist-report-previous-week ;; TODO - make interactive function to accept new mode from user
                        'follow-link t)
    (insert ", from")
    (insert
     (format " %s to %s\n"
             (ts-format "%F" (plist-get chronometrist-statistics--ui-state :start))
             (ts-format "%F" (plist-get chronometrist-statistics--ui-state :end))))))
refresh   procedure
(defun chronometrist-statistics-refresh (&optional _ignore-auto _noconfirm)
  "Refresh the `chronometrist-statistics' buffer.
This does not re-read `chronometrist-file'.

The optional arguments _IGNORE-AUTO and _NOCONFIRM are ignored,
and are present solely for the sake of using this function as a
value of `revert-buffer-function'."
  (let* ((w (get-buffer-window chronometrist-statistics-buffer-name t))
         (p (point)))
    (with-current-buffer chronometrist-statistics-buffer-name
      (tabulated-list-print t nil)
      (chronometrist-statistics-print-non-tabular)
      (chronometrist-maybe-start-timer)
      (set-window-point w p))))
mode-map   keymap
(defvar chronometrist-statistics-mode-map
  (let ((map (make-sparse-keymap)))
    (define-key map (kbd "l") #'chronometrist-open-log)
    (define-key map (kbd "b") #'chronometrist-statistics-previous-range)
    (define-key map (kbd "f") #'chronometrist-statistics-next-range)
    map)
  "Keymap used by `chronometrist-statistics-mode'.")
statistics-mode   major mode
(define-derived-mode chronometrist-statistics-mode tabulated-list-mode "Chronometrist-Statistics"
  "Major mode for `chronometrist-statistics'."
  (make-local-variable 'tabulated-list-format)
  (setq tabulated-list-format
        [("Task"              25 t)
         ("Active days"       12 t)
         ("%% of days active" 17 t)
         ("Average time"      12 t)
         ;; ("Current streak"    10 t)
         ;; ("Last streak"       10 t)
         ;; ("Longest streak"    10 t)
         ])
  (make-local-variable 'tabulated-list-entries)
  (setq tabulated-list-entries 'chronometrist-statistics-rows)
  (make-local-variable 'tabulated-list-sort-key)
  (setq tabulated-list-sort-key '("Task" . nil))
  (tabulated-list-init-header)
  ;; (chronometrist-maybe-start-timer)
  (add-hook 'chronometrist-timer-hook
            (lambda ()
              (when (get-buffer-window chronometrist-statistics-buffer-name)
                (chronometrist-statistics-refresh))))
  (setq revert-buffer-function #'chronometrist-statistics-refresh)
  (chronometrist-setup-file-watch))
chronometrist-statistics   command
;;;###autoload
(defun chronometrist-statistics (&optional preserve-state)
  "Display statistics for Chronometrist data.
If a buffer called `chronometrist-statistics-buffer-name' already
exists and is visible, kill the buffer.

If PRESERVE-STATE is nil (the default when not supplied), display
data from the current week. Otherwise, display data from the week
specified by `chronometrist-statistics--ui-state'."
  (interactive)
  (chronometrist-migrate-check)
  (let* ((buffer     (get-buffer-create chronometrist-statistics-buffer-name))
         (today      (chronometrist-date-ts))
         (week-start (chronometrist-previous-week-start today))
         (week-end   (ts-adjust 'day 6 week-start)))
    (with-current-buffer buffer
      (cond ((get-buffer-window chronometrist-statistics-buffer-name)
             (kill-buffer buffer))
            (t ;; (delete-other-windows)
             (unless preserve-state
               (setq chronometrist-statistics--ui-state `(:mode week
                                         :start ,week-start
                                         :end   ,week-end)))
             (chronometrist-create-file (chronometrist-active-backend))
             (chronometrist-statistics-mode)
             (switch-to-buffer buffer)
             (chronometrist-statistics-refresh))))))
previous-range   command
(defun chronometrist-statistics-previous-range (arg)
  "View the statistics in the previous time range.
If ARG is a numeric argument, go back that many times."
  (interactive "P")
  (let* ((arg   (if (and arg (numberp arg))
                    (abs arg)
                  1))
         (start (plist-get chronometrist-statistics--ui-state :start)))
    (cl-case (plist-get chronometrist-statistics--ui-state :mode)
      ('week
       (let* ((new-start (ts-adjust 'day (- (* arg 7)) start))
              (new-end   (ts-adjust 'day +6 new-start)))
         (plist-put chronometrist-statistics--ui-state :start new-start)
         (plist-put chronometrist-statistics--ui-state :end   new-end))))
    (setq chronometrist-statistics--point (point))
    (kill-buffer)
    (chronometrist-statistics t)))
next-range   command
(defun chronometrist-statistics-next-range (arg)
  "View the statistics in the next time range.
If ARG is a numeric argument, go forward that many times."
  (interactive "P")
  (let* ((arg   (if (and arg (numberp arg))
                    (abs arg)
                  1))
         (start (plist-get chronometrist-statistics--ui-state :start)))
    (cl-case (plist-get chronometrist-statistics--ui-state :mode)
      ('week
       (let* ((new-start (ts-adjust 'day (* arg 7) start))
              (new-end   (ts-adjust 'day 6 new-start)))
         (plist-put chronometrist-statistics--ui-state :start new-start)
         (plist-put chronometrist-statistics--ui-state :end   new-end))))
    (setq chronometrist-statistics--point (point))
    (kill-buffer)
    (chronometrist-statistics t)))

Details

chronometrist displays the total time spent on a task - but what were the details? That's where chronometrist-details comes in - to display details of recorded time intervals for a given day, in a format terser and more informative than the plists in the file.

  1. Handle active task (no :stop).
  2. Update data with timer
  3. Permit forward/backward scrolling through dates + input a specific date.
  4. Display key-values and tags

    • make it possible to create columns using keys
  5. Remove outer parentheses from tags
details   custom group
(defgroup chronometrist-details nil
  "Details buffer for the `chronometrist' time tracker."
  :group 'chronometrist)
buffer-name-base   custom variable
(defcustom chronometrist-details-buffer-name-base "chronometrist-details"
  "Name of buffer created by `chronometrist-details'."
  :type 'string)
buffer-name   reader
(defun chronometrist-details-buffer-name (&optional suffix)
  "Return buffer name based on `chronometrist-details-buffer-name-base' and SUFFIX."
  (if suffix
      (format "*%s_%s*" chronometrist-details-buffer-name-base suffix)
    (format "*%s*" chronometrist-details-buffer-name-base)))
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.

(defcustom chronometrist-details-display-tags "%s"
  "How to display tags in `chronometrist-details' buffers.
Value can be
nil, meaning do not display tags, or
a format string consuming a single argument passed to `format', or
a function of one argument (the tags, as a list of symbols),
which must return the string to be displayed.

To disable display of tags, customize `chronometrist-details-schema'."
  :type '(choice nil string function))
display-key-values   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.

(defcustom chronometrist-details-display-key-values "%s"
  "How to display tags in `chronometrist-details' buffers.
Value can be
nil, meaning do not display key-values, or
a format string consuming a single argument passed to `format', or
a function of one argument (the full interval plist),
which must return the string to be displayed.

To disable display of key-values, set this to nil and customize
`chronometrist-details-schema'."
  :type '(choice nil string function))
time-format-string   custom variable
(defcustom chronometrist-details-time-format-string "%H:%M"
  "String specifying time format in `chronometrist-details' buffers.
See `format-time-string'."
  :type 'string)
FIXME schema   custom variable

This was originally called chronometrist-details-table-format, but "schema" is both shorter and a term I'm more familiar with.

  1. Index column does not sort correctly with 10 or more rows - see tabulated-list-format
(defcustom chronometrist-details-schema
  [("#" 3 (lambda (row-1 row-2)
            (< (car row-1)
               (car row-2))))
   ("Task" 20 t)
   ("Tags" 20 t)
   ("Details" 45 t)
   ("Duration" 20 t :right-align t :pad-right 3)
   ("Time" 10 t)]
  "Vector specifying format of `chronometrist-details' buffer.
See `tabulated-list-format'."
  :type '(vector))
schema-transformers   extension variable
(defvar chronometrist-details-schema-transformers nil
  "List of functions to transform `chronometrist-details-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-details-row-transformers'.")
rows-helper   reader
(defun chronometrist-details-rows-helper (list)
  "Return LIST as a string to be inserted in a `chronometrist-details' buffer.
LIST is either tags (a list of symbols) or a plist."
  (let (contents custom)
    (if (chronometrist-plist-p list)
        (setq custom   chronometrist-details-display-key-values
              contents (seq-remove #'keywordp
                                   (chronometrist-plist-key-values list)))
      (setq custom   chronometrist-details-display-tags
            contents list))
    (if (and contents custom)
        (pcase custom
          ((pred stringp)
           (--> (flatten-list contents)
             (seq-remove #'keywordp it)
             (mapconcat
              (lambda (elt) (format custom elt))
              it ", ")))
          ((pred functionp)
           (funcall custom list)))
      "")))
tests
(ert-deftest chronometrist-details-row-helper ()
  (let ((tags  '(a b c))
        (plist '(:a 1 :b 2 :c 3)))
    (let ((chronometrist-details-display-tags nil)
          (chronometrist-details-display-key-values nil))
      (should (equal (chronometrist-details-rows-helper tags)  ""))
      (should (equal (chronometrist-details-rows-helper plist) "")))
    (let ((chronometrist-details-display-tags "%s")
          (chronometrist-details-display-key-values "%s"))
      (should (equal (chronometrist-details-rows-helper nil) ""))
      (should (equal (chronometrist-details-rows-helper nil) ""))
      (should (equal (chronometrist-details-rows-helper tags)
                     "a b c"))
      (should (equal (chronometrist-details-rows-helper plist)
                     "1 2 3")))))
row-transformers   extension variable
(defvar chronometrist-details-row-transformers nil
  "List of functions to transform each row of `chronometrist-details-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-details-schema-transformers'.")
map   keymap
(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))
chronometrist-details-menu   menu
(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]))
chronometrist-details-mode   major mode
(define-derived-mode chronometrist-details-mode tabulated-list-mode "Details"
  "Major mode for `chronometrist-details'."
  (make-local-variable 'tabulated-list-format)
  (--> (chronometrist-run-transformers chronometrist-details-schema-transformers chronometrist-details-schema)
    (setq tabulated-list-format it))
  (make-local-variable '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))
details-setup-buffer   procedure
(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)))
chronometrist-details   command
(defun chronometrist-details ()
  "Display details of time tracked over a period of time."
  (interactive)
  (let* ((buffer (get-buffer-create (chronometrist-details-buffer-name)))
         (window (save-excursion
                   (get-buffer-window buffer t))))
    (cond (window (kill-buffer buffer))
          (t (chronometrist-details-setup-buffer buffer)))))
range   variable
(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)
iso-date-p   function
(defun chronometrist-iso-date-p (string)
  "Return non-nil if STRING is a date in the ISO-8601 format."
  (string-match-p
   (rx (and string-start
            (>= 1 num) "-" (= 2 num) "-" (= 2 num)
            string-end))
   string))
intervals-for-range   reader

This is basically like chronometrist-events-subset, but returns a list instead of a hash table. Might replace one with the other in the future.

(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 as returned by
`chronometrist-to-hash-table'."
  (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)
input-to-value   function
(defun chronometrist-details-input-to-value (input)
  "Return INPUT as a value acceptable to `chronometrist-details-range'."
  (pcase input
    ('nil nil)
    (`(,date) date)
    (`(,begin ,end)
     (let* ((ht-keys      (hash-table-keys
                           (chronometrist-backend-hash-table (chronometrist-active-backend))))
            (date-p       (seq-find #'chronometrist-iso-date-p input))
            (begin-date   (car ht-keys))
            (begin-iso-ts (ts-format
                           "%FT%T%z" (chronometrist-iso-to-ts begin-date)))
            (end-date     (car (last ht-keys)))
            (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 %S" input))))
set-range   command writer
(defun chronometrist-details-set-range ()
  "Prompt user for range for current `chronometrist-details' buffer."
  (interactive)
  (let* ((hash-table (chronometrist-backend-hash-table (chronometrist-active-backend)))
         (input (completing-read-multiple
                 (concat "Range (blank, ISO-8601 date, "
                         "or two ISO-8601 dates/timestamps): ")
                 (append '("begin" "end")
                         (reverse (hash-table-keys hash-table)))
                 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
                        (`(,begin . ,end)
                         (chronometrist-details-buffer-name (format "%s_%s" begin end)))
                        ((pred stringp)
                         (chronometrist-details-buffer-name new-value)))))
    (chronometrist-details-setup-buffer (get-buffer-create buffer-name))
    (with-current-buffer buffer-name
      (setq-local chronometrist-details-range new-value)
      (tabulated-list-revert))))
filter   variable
(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)
filter-match-p   function
(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 %S" filter))))
set-filter   command writer
(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))
          (t (error "Unsupported filter %S" input)))
    (tabulated-list-revert)))
intervals   function
(defun chronometrist-details-intervals (range filter backend)
  "Return plists matching RANGE and FILTER from BACKEND.
For values of RANGE, see `chronometrist-details-range'. For
values of FILTER, see `chronometrist-details-filter'. TABLE must
be a hash table as returned by `chronometrist-to-hash-table'."
  (cl-loop for plist in (chronometrist-details-intervals-for-range range (chronometrist-backend-hash-table backend))
    when (chronometrist-details-filter-match-p plist filter)
    collect plist))
rows   function
(defun chronometrist-details-rows ()
  "Return rows to be displayed in the `chronometrist-details' buffer.
Return value is a list as specified by `tabulated-list-entries'."
  (cl-loop with index = 1
    for plist in (chronometrist-details-intervals chronometrist-details-range chronometrist-details-filter (chronometrist-active-backend))
    collect
    (-let* (((&plist :name name :tags tags :start start :stop stop) plist)
            ;; whether tags or key-values are actually displayed is handled later
            (tags       (chronometrist-details-rows-helper tags))
            (key-values (chronometrist-details-rows-helper plist))
            ;; resetting seconds with `ts-apply' is necessary to
            ;; prevent situations like "1 hour  from 00:08 to 01:09"
            (start   (ts-apply :second 0 (chronometrist-iso-to-ts start)))
            (stop    (ts-apply :second 0 (if stop
                                             (chronometrist-iso-to-ts stop)
                                           (ts-now))))
            (interval      (floor (ts-diff stop start)))
            (index-string  (format "%s" index))
            (duration      (chronometrist-format-duration-long interval))
            (timespan (format "from %s to %s"
                              (ts-format chronometrist-details-time-format-string
                                         start)
                              (ts-format chronometrist-details-time-format-string
                                         stop))))
      (--> (vconcat (vector index-string name)
                    (when chronometrist-details-display-tags (vector tags))
                    (when chronometrist-details-display-key-values (vector key-values))
                    (vector duration timespan))
        (list index it)
        (chronometrist-run-transformers chronometrist-details-row-transformers it)))
    do (cl-incf index)))

Provide

(provide 'chronometrist)

;;; chronometrist.el ends here

Local variables   NOEXPORT

Evaluate this to be able to insert the package prefix via nameless-insert-name, at the cost of having all nameless-aliases break (= less readable code).

(setq nameless-current-name "chronometrist")

1

I still have doubts about this. Having SQL as a query language would be very useful in perusing the stored data. Maybe we should have tried to create a companion mode to edit SQL databases interactively?

2

As indicated by exploratory work in the parsimonious-reading branch, where I made a loop to only read and collect s-expressions from the file. It was near-instant…until I added event splitting to it.

3

No longer a problem since we switched to literate-elisp

4

it might be the case that the file format is not suited to our most frequent operation…