contrapunctus
/
chronometrist
Archived
1
3
Fork 0
Code Issues 1 Pull Requests Projects Releases Wiki Activity
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

3706 lines
168 KiB
Org Mode
Raw Blame History

This file contains ambiguous Unicode characters

This file contains Unicode characters that might be confused with other characters. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

#+TITLE: Chronometrist - an extensible time tracker for Emacs
#+SUBTITLE: Developer manual and program source
#+AUTHOR: contrapunctus
#+TODO: TODO TEST WIP EXTEND CLEANUP FIXME REVIEW |
#+PROPERTY: header-args :tangle yes :load yes
#+INFOJS_OPT: view:info toc:nil
* 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 [[https://www.youtube.com/watch?v=Av0PQDVTP4A&t=8m52s]["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
:PROPERTIES:
:DESCRIPTION: The design, the implementation, and a little history
:END:
** 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 [[#explanation-literate-programming][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
:PROPERTIES:
:DESCRIPTION: Some vague objectives which guided the project
:END:
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 [fn: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
[fn: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?
** Terminology
:PROPERTIES:
:DESCRIPTION: Explanation of some terms used later
:END:
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 [[#explanation-time-formats][Currently-Used Time Formats]]
** Overview
At its most basic, we read data from a [[#program-backend][plain text file]] containing Lisp plists, store it in a [[#program-data-structures][hash table]], and [[#program-frontend-chronometrist][display it]] as a [[elisp:(find-library "tabulated-list-mode")][=tabulated-list-mode=]] buffer. When the file is changed—whether by the program or the user—we [[refresh-file][update the hash table]] and the buffer.
In addition, we implement a [[#program-pretty-printer][plist pretty-printer]] and some migration commands. This repository also contains an extension for [[file:chronometrist-key-values.org][attaching arbitrary metadata]] to time intervals, and there is a extension for [[https://tildegit.org/contrapunctus/chronometrist-goal][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 [[elisp:(describe-function 'file-notify-add-watch)][=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 [[* fs-watch][=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][=chronometrist-file=]] was modified, we'd clear the [[* chronometrist-events][=chronometrist-events=]] hash table and read data into it again. The reading itself is nearly-instant, even with ~2 years' worth of data [fn:2] (it uses Emacs' [[elisp:(describe-function 'read)][=read=]], after all), but the splitting of [[#explanation-midnight-spanning-intervals][midnight-spanning events]] is the real performance killer.
After the optimization...
1. Two backend functions ([[* new][=chronometrist-sexp-new=]] and [[* replace-last][=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, [[* refresh-file][=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 [[* refresh-file][=chronometrist-refresh-file=]] runs unconditionally - which is to say there is scope for further optimization, if or when required.
[fn: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.
*** 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
** Midnight-spanning intervals
:PROPERTIES:
:DESCRIPTION: Events starting on one day and ending on another
:CUSTOM_ID: explanation-midnight-spanning-intervals
:END:
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)
:PROPERTIES:
:DESCRIPTION: When the code of the first event in the day is "o", it's a midnight-spanning event.
:END:
+ 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
:PROPERTIES:
:DESCRIPTION: The desired behaviour of point in Chronometrist
:END:
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
:PROPERTIES:
:DESCRIPTION: Deriving dates in the current week
:END:
A quick description, starting from the first time [[* chronometrist-report][=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
:PROPERTIES:
:CUSTOM_ID: explanation-literate-programming
:END:
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"= -
#+BEGIN_SRC org :tangle no
# 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"))))
#+END_SRC
*** 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=.
#+BEGIN_SRC emacs-lisp :tangle no :load no
(literate-elisp-load
(format "%schronometrist.org" (file-name-directory load-file-name)))
#+END_SRC
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. [X] 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. [fn: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. [X] Is there a tangling solution which requires only one command (e.g. currently we use two =sed= s) but is equally fast? [fn: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=
[fn:3] No longer a problem since we switched to =literate-elisp=
** Currently-Used Time Formats
:PROPERTIES:
:CUSTOM_ID: explanation-time-formats
:END:
*** 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 [[https://tildegit.org/contrapunctus/chronometrist-goal][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=
* How-to guides for maintainers
** How to set up Emacs to contribute
# Different approaches to this setup -
# 1. Document it and let contributors do it voluntarily.
# * Downside - if a contributor does not do it, it can lead to inconsistency and an additional headache for the maintainer.
# 2. Put it in file variables and/or =.dir-locals.el=.
# * Downside - if the contributor does not have a dependency installed (e.g. nameless), Emacs will create an error. That's not the UX I want for someone opening the file for the first time - it does not tell them that they need to install something.
# + Technically, a friendlier error message could be displayed. But you want to read/edit a document and it asks you to install something first...kind of a flow breaker.
# 3. Use a tool which installs developement dependencies for you, e.g. Cask, Eldev.
# * May look into this in the future. But as of now I don't even foresee any contributors 😓
1. Install [[https://github.com/Malabarba/Nameless][nameless-mode]] for easier reading of Emacs Lisp code, and [[https://github.com/jingtaozf/literate-elisp][literate-elisp]] to load this file directly without tangling.
#+BEGIN_SRC emacs-lisp :tangle no :load no
(mapcar #'package-install '(nameless literate-elisp))
#+END_SRC
2. Create a =.dir-locals-2.el= in the project root, containing -
#+BEGIN_SRC emacs-lisp :tangle no :load no
((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)))
" ")))))))))
#+END_SRC
3. Set up compiling, linting, and testing with =makem.sh=. First, define this command -
#+BEGIN_SRC emacs-lisp :tangle no :load no
(defun run-makem ()
(interactive)
(cd (locate-dominating-file default-directory "makem.sh"))
(compile "./makem.sh compile lint test-ert"))
#+END_SRC
Then, run it after staging the files -
#+BEGIN_SRC emacs-lisp :tangle no :load no
(add-hook 'magit-post-stage-hook #'run-makem)
#+END_SRC
Or after tangling ends -
#+BEGIN_SRC emacs-lisp :tangle no :load no
(add-hook 'org-babel-post-tangle-hook #'run-makem)
#+END_SRC
** 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 -
#+BEGIN_SRC emacs-lisp :tangle no :load no
;; Package-Requires: ((emacs "25.1")
;; (dash "2.16.0")
;; (seq "2.20")
;; (ts "0.2"))
#+END_SRC
But I discovered that if I do that, =package-lint= says - =error: Couldn't parse "Package-Requires" header: End of file during parsing=.
#+BEGIN_SRC emacs-lisp
;;; 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 "25.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>
#+END_SRC
"Commentary" is displayed when the user clicks on the package's entry in =M-x list-packages=.
#+BEGIN_SRC emacs-lisp
;;; 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
#+END_SRC
** Dependencies
#+BEGIN_SRC emacs-lisp
;;; 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)
(eval-when-compile
(defvar chronometrist-mode-map)
(require 'subr-x))
#+END_SRC
** Common
*** custom group :custom:group:
#+BEGIN_SRC emacs-lisp
(defgroup chronometrist nil
"An extensible time tracker."
:group 'applications)
#+END_SRC
*** fs-watch :internal:variable:
:PROPERTIES:
:VALUE: file notify watch
:END:
#+BEGIN_SRC emacs-lisp
(defvar chronometrist--fs-watch nil
"Filesystem watch object.
Used to prevent more than one watch being added for the same
file.")
#+END_SRC
*** format-time :function:
#+BEGIN_SRC emacs-lisp
(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)))))
#+END_SRC
*** file-empty-p :reader:
#+BEGIN_SRC emacs-lisp
(defun chronometrist-common-file-empty-p (file)
"Return t if FILE is empty."
(zerop (nth 7 (file-attributes file))))
#+END_SRC
*** format-keybinds :function:
#+BEGIN_SRC emacs-lisp
(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))))
#+END_SRC
*** events-to-durations :function:
#+BEGIN_SRC emacs-lisp
(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))
#+END_SRC
*** day-start-time :custom:variable:
[[* events-maybe-split][=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.
#+BEGIN_SRC emacs-lisp
(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)
#+END_SRC
*** week-start-day :custom:variable:
#+BEGIN_SRC emacs-lisp
(defcustom chronometrist-report-week-start-day "Sunday"
"The day used for start of week by `chronometrist-report'."
:type 'string)
#+END_SRC
*** weekday-number-alist :custom:variable:
#+BEGIN_SRC emacs-lisp
(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)
#+END_SRC
*** previous-week-start :reader:
#+BEGIN_SRC emacs-lisp
(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))
#+END_SRC
*** plist-remove :function:
#+BEGIN_SRC emacs-lisp
(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))
#+END_SRC
**** tests
#+BEGIN_SRC emacs-lisp :tangle chronometrist-tests.el :load test
(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))))
#+END_SRC
*** plist-key-values :function:
#+BEGIN_SRC emacs-lisp
(defun chronometrist-plist-key-values (plist)
"Return user key-values from PLIST."
(chronometrist-plist-remove plist :name :tags :start :stop))
#+END_SRC
*** plist-p :function:
#+BEGIN_SRC emacs-lisp
(defun chronometrist-plist-p (list)
"Return non-nil if LIST is a property list, i.e. (:KEYWORD VALUE ...)"
(while (consp list)
(setq list (if (and (keywordp (car list))
(consp (cdr list)))
(cddr list)
'not-plist)))
(null list))
#+END_SRC
**** tests
#+BEGIN_SRC emacs-lisp :tangle chronometrist-tests.el :load test
(ert-deftest plist-p ()
(should (eq t (chronometrist-plist-p '(:a 1 :b 2))))
(should (eq nil (chronometrist-plist-p '(0 :a 1 :b 2))))
(should (eq nil (chronometrist-plist-p '(:a 1 :b 2 3)))))
#+END_SRC
*** delete-list :writer:
#+BEGIN_SRC emacs-lisp
(defun chronometrist-sexp-delete-list (&optional arg)
"Delete ARG lists after point."
(let ((point-1 (point)))
(forward-sexp (or arg 1))
(delete-region point-1 (point))))
#+END_SRC
** Plist pretty-printing
:PROPERTIES:
:CUSTOM_ID: program-pretty-printer
:END:
=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. [X] work recursively for plist/alist values
2. [X] 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
*** normalize-whitespace :writer:
#+BEGIN_SRC emacs-lisp
(defun chronometrist-plist-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 " ")))
#+END_SRC
*** column :reader:
#+BEGIN_SRC emacs-lisp
(defun chronometrist-plist-pp-column ()
"Return column point is on, as an integer.
0 means point is at the beginning of the line."
(- (point) (point-at-bol)))
#+END_SRC
*** pair-p :function:
#+BEGIN_SRC emacs-lisp
(defun chronometrist-plist-pp-pair-p (cons)
"Return non-nil if CONS is a pair, i.e. (CAR . CDR)."
(and (listp cons) (not (listp (cdr cons)))))
#+END_SRC
*** alist-p :function:
#+BEGIN_SRC emacs-lisp
(defun chronometrist-plist-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-plist-pp-pair-p'), this function
considers it an alist."
(when (listp list)
(cl-loop for elt in list thereis (chronometrist-plist-pp-pair-p elt))))
#+END_SRC
*** longest-keyword-length :reader:
#+BEGIN_SRC emacs-lisp
(defun chronometrist-plist-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)))))
#+END_SRC
*** indent-sexp :function:
#+BEGIN_SRC emacs-lisp
(cl-defun chronometrist-plist-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))
#+END_SRC
*** buffer :writer:
It might help to make =inside-sublist-p= an integer representing depth, instead of a boolean. But at the moment, it's getting the job done.
#+BEGIN_SRC emacs-lisp
(cl-defun chronometrist-plist-pp-buffer (&optional inside-sublist-p)
"Recursively indent the alist, plist, or a list of plists after point.
The list must be on a single line, as emitted by `prin1'."
(if (not (looking-at-p (rx (or ")" line-end))))
(let ((sexp (save-excursion (read (current-buffer)))))
(cond
((chronometrist-plist-p sexp)
(chronometrist-plist-pp-buffer-plist inside-sublist-p)
(chronometrist-plist-pp-buffer inside-sublist-p))
((chronometrist-plist-pp-alist-p sexp)
(chronometrist-plist-pp-buffer-alist)
(unless inside-sublist-p (chronometrist-plist-pp-buffer)))
((chronometrist-plist-pp-pair-p sexp)
(forward-sexp)
(chronometrist-plist-pp-buffer inside-sublist-p))
((listp sexp)
(down-list)
(chronometrist-plist-pp-buffer t))
(t (forward-sexp)
(chronometrist-plist-pp-buffer inside-sublist-p))))
;; we're before a ) - is it a lone paren on its own line?
(let ((pos (point))
(bol (point-at-bol)))
(goto-char bol)
(if (string-match "^[[:blank:]]*$" (buffer-substring bol pos))
;; join the ) to the previous line by deleting the newline and whitespace
(delete-region (1- bol) pos)
(goto-char pos))
(when (not (eobp))
(forward-char)))))
#+END_SRC
**** tests
#+BEGIN_SRC emacs-lisp :tangle chronometrist-tests.el :load test
(ert-deftest plist-pp-buffer ()
(should
(equal
(chronometrist-plist-pp-to-string
'(:name "Task"
:tags (foo bar)
:comment ((70 . "baz")
"zot"
(16 . "frob")
(20 20 "quux"))
:start "2020-06-25T19:27:57+0530"
:stop "2020-06-25T19:43:30+0530"))
(concat
"(:name \"Task\"\n"
" :tags (foo bar)\n"
" :comment ((70 . \"baz\")\n"
" \"zot\"\n"
" (16 . \"frob\")\n"
" (20 20 \"quux\"))\n"
" :start \"2020-06-25T19:27:57+0530\"\n"
" :stop \"2020-06-25T19:43:30+0530\")")))
(should
(equal
(chronometrist-plist-pp-to-string
'(:name "Singing"
:tags (classical solo)
:piece ((:composer "Gioachino Rossini"
:name "Il barbiere di Siviglia"
:aria ("All'idea di quel metallo" "Dunque io son"))
(:composer "Ralph Vaughan Williams"
:name "Songs of Travel"
:movement ((4 . "Youth and Love")
(5 . "In Dreams")
(7 . "Wither Must I Wander?")))
(:composer "Ralph Vaughan Williams"
:name "Merciless Beauty"
:movement 1)
(:composer "Franz Schubert"
:name "Winterreise"
:movement ((1 . "Gute Nacht")
(2 . "Die Wetterfahne")
(4 . "Erstarrung"))))
:start "2020-11-01T12:01:20+0530"
:stop "2020-11-01T13:08:32+0530"))
(concat
"(:name \"Singing\"\n"
" :tags (classical solo)\n"
" :piece ((:composer \"Gioachino Rossini\"\n"
" :name \"Il barbiere di Siviglia\"\n"
" :aria (\"All'idea di quel metallo\" \"Dunque io son\"))\n"
" (:composer \"Ralph Vaughan Williams\"\n"
" :name \"Songs of Travel\"\n"
" :movement ((4 . \"Youth and Love\")\n"
" (5 . \"In Dreams\")\n"
" (7 . \"Wither Must I Wander?\")))\n"
" (:composer \"Ralph Vaughan Williams\"\n"
" :name \"Merciless Beauty\"\n"
" :movement 1)\n"
" (:composer \"Franz Schubert\"\n"
" :name \"Winterreise\"\n"
" :movement ((1 . \"Gute Nacht\")\n"
" (2 . \"Die Wetterfahne\")\n"
" (4 . \"Erstarrung\"))))\n"
" :start \"2020-11-01T12:01:20+0530\"\n"
" :stop \"2020-11-01T13:08:32+0530\")")))
(should (equal
(chronometrist-plist-pp-to-string
'(:name "Cooking"
:tags (lunch)
:recipe (:name "moong-masoor ki dal"
:url "https://www.mirchitales.com/moong-masoor-dal-red-and-yellow-lentil-curry/")
:start "2020-09-23T15:22:39+0530"
:stop "2020-09-23T16:29:49+0530"))
(concat
"(:name \"Cooking\"\n"
" :tags (lunch)\n"
" :recipe (:name \"moong-masoor ki dal\"\n"
" :url \"https://www.mirchitales.com/moong-masoor-dal-red-and-yellow-lentil-curry/\")\n"
" :start \"2020-09-23T15:22:39+0530\"\n"
" :stop \"2020-09-23T16:29:49+0530\")")))
(should (equal
(chronometrist-plist-pp-to-string
'(:name "Exercise"
:tags (warm-up)
:start "2018-11-21T15:35:04+0530"
:stop "2018-11-21T15:38:41+0530"
:comment ("stretching" (25 10 "push-ups"))))
(concat
"(:name \"Exercise\"\n"
" :tags (warm-up)\n"
" :start \"2018-11-21T15:35:04+0530\"\n"
" :stop \"2018-11-21T15:38:41+0530\"\n"
" :comment (\"stretching\" (25 10 \"push-ups\")))"))))
#+END_SRC
*** buffer-plist :writer:
#+BEGIN_SRC emacs-lisp
(defun chronometrist-plist-pp-buffer-plist (&optional inside-sublist-p)
"Indent a single plist after point."
(down-list)
(let ((left-indent (1- (chronometrist-plist-pp-column)))
(right-indent (chronometrist-plist-pp-longest-keyword-length))
(first-p t) sexp)
(while (not (looking-at-p ")"))
(chronometrist-plist-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 ?\ ))
(chronometrist-plist-pp-indent-sexp sexp right-indent)))
;; not a keyword = a value
((chronometrist-plist-p sexp)
(chronometrist-plist-pp-buffer-plist))
((and (listp sexp)
(not (chronometrist-plist-pp-pair-p sexp)))
(chronometrist-plist-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 inside-sublist-p
(insert (make-string (1- left-indent) ?\ )))))
#+END_SRC
*** buffer-alist :writer:
#+BEGIN_SRC emacs-lisp
(defun chronometrist-plist-pp-buffer-alist ()
"Indent a single alist after point."
(down-list)
(let ((indent (chronometrist-plist-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 ?\ ))
(format "%S\n" sexp)))
(when (bolp) (delete-char -1))
(up-list)))
#+END_SRC
*** to-string :reader:
:PROPERTIES:
:STATE: emacs-lisp-mode-syntax-table
:END:
#+BEGIN_SRC emacs-lisp
(defun chronometrist-plist-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-plist-pp-buffer)
(buffer-string)))
#+END_SRC
*** plist-pp :reader:
#+NAME: plist-pp
#+BEGIN_SRC emacs-lisp
(defun chronometrist-plist-pp (object &optional stream)
"Pretty-print OBJECT and output to STREAM (see `princ')."
(princ (chronometrist-plist-pp-to-string object)
(or stream standard-output)))
#+END_SRC
** Backends
:PROPERTIES:
:CUSTOM_ID: program-backend
:END:
*** chronometrist-file :custom:variable:
#+BEGIN_SRC emacs-lisp
(defcustom chronometrist-file
(locate-user-emacs-file "chronometrist")
"Name (without extension) and full path of the Chronometrist database."
:type 'file)
#+END_SRC
*** protocol
**** backend :class:
#+BEGIN_SRC emacs-lisp
(defclass chronometrist-backend ()
((path ;; :initform (error "Path is required")
:initarg :path
:accessor chronometrist-backend-path
:custom 'string
:documentation
"Path to backend file, without extension.")
(extension ;; :initform (error "Extension is required")
:initarg :ext
:accessor chronometrist-backend-ext
:custom 'string
:documentation
"Extension of backend file.")
(file :initarg :file
:accessor chronometrist-backend-file
:custom 'string
:documentation "Full path to backend file, with extension.")))
#+END_SRC
**** initialize-instance
Initialize FILE based on PATH and EXTENSION.
#+BEGIN_SRC emacs-lisp
(cl-defmethod initialize-instance :after ((backend chronometrist-backend) &rest initargs)
(when (and (chronometrist-backend-path backend) (chronometrist-backend-ext backend) (not (chronometrist-backend-file backend)))
(setf (chronometrist-backend-file backend)
(concat (chronometrist-backend-path backend) "." (chronometrist-backend-ext backend)))))
#+END_SRC
**** backends-alist :variable:
#+BEGIN_SRC emacs-lisp
(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'.")
#+END_SRC
**** active-backend :custom:variable:
#+BEGIN_SRC emacs-lisp
(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 ,(second elt)
,(first elt)))))
#+END_SRC
**** active-backend :reader:
#+BEGIN_SRC emacs-lisp
(defun chronometrist-active-backend ()
"Return an object representing the currently active backend."
(second (alist-get chronometrist-active-backend chronometrist-backends-alist)))
#+END_SRC
**** current-task :generic:function:
#+BEGIN_SRC emacs-lisp
(cl-defgeneric chronometrist-current-task (backend)
"Return the name of the active task, or nil if not clocked in.")
#+END_SRC
**** latest-record :generic:function:
#+BEGIN_SRC emacs-lisp
(cl-defgeneric chronometrist-latest-record (backend)
"Return the latest entry from BACKEND as a plist.")
#+END_SRC
**** list-tasks :generic:function:
#+BEGIN_SRC emacs-lisp
(cl-defgeneric chronometrist-list-tasks (backend &key start end)
"Return a list of tasks from BACKEND.")
#+END_SRC
**** task-records :generic:function:
#+BEGIN_SRC emacs-lisp
(cl-defgeneric chronometrist-task-records (backend task date)
"From BACKEND, return a list of records for TASK on DATE.")
#+END_SRC
**** task-time :generic:function:
#+BEGIN_SRC emacs-lisp
(cl-defgeneric chronometrist-task-time (backend task date)
"From BACKEND, return time recorded for TASK on DATE as integer seconds.")
#+END_SRC
**** active-time :generic:function:
#+BEGIN_SRC emacs-lisp
(cl-defgeneric chronometrist-active-time (backend date)
"From BACKEND, return total time recorded on DATE as integer seconds.")
#+END_SRC
**** active-days :generic:function:
#+BEGIN_SRC emacs-lisp
(cl-defgeneric chronometrist-active-days (backend task &key start end)
"From BACKEND, return number of days on which TASK had recorded time.")
#+END_SRC
**** insert :generic:function:
#+BEGIN_SRC emacs-lisp
(cl-defgeneric chronometrist-insert (backend plist)
"Insert PLIST as new record in BACKEND.")
#+END_SRC
**** replace-last :generic:function:
#+BEGIN_SRC emacs-lisp
(cl-defgeneric chronometrist-replace-last (backend plist)
"Replace last record in BACKEND with PLIST.")
#+END_SRC
**** create-file :generic:function:
#+BEGIN_SRC emacs-lisp
(cl-defgeneric chronometrist-create-file (backend)
"Create file associated with BACKEND.")
#+END_SRC
**** view-file :generic:function:
#+BEGIN_SRC emacs-lisp
(cl-defgeneric chronometrist-view-file (backend)
"Open file associated with BACKEND for interactive viewing.")
#+END_SRC
**** edit-file :generic:function:
#+BEGIN_SRC emacs-lisp
(cl-defgeneric chronometrist-edit-file (backend)
"Open file associated with BACKEND for interactive editing.")
#+END_SRC
**** count-records :generic:function:
#+BEGIN_SRC emacs-lisp
(cl-defgeneric chronometrist-count-records (backend)
"Return number of records in BACKEND.")
#+END_SRC
**** to-hash-table :generic:function:
#+BEGIN_SRC emacs-lisp
(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.")
#+END_SRC
**** from-hash-table :generic:function:
#+BEGIN_SRC emacs-lisp
(cl-defgeneric chronometrist-from-hash-table (backend hash-table)
"Save data from HASH-TABLE to BACKEND.")
#+END_SRC
**** list-records :generic:function:
#+BEGIN_SRC emacs-lisp
(cl-defgeneric chronometrist-list-records (backend)
"Return all records in BACKEND as a list of plists, in reverse chronological order.")
#+END_SRC
**** on-file-change :generic:function:
#+BEGIN_SRC emacs-lisp
(cl-defgeneric chronometrist-on-file-change (backend)
"Function to be run when file for BACKEND changes.")
#+END_SRC
*** 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 -
#+BEGIN_SRC emacs-lisp :tangle no :load no
(:name "Task Name"
[:keyword <value>]*
:start "<ISO-8601 timestamp>"
:stop "<ISO-8601 timestamp>")
#+END_SRC
=: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
:PROPERTIES:
:header-args: :tangle chronometrist-tests.el
:END:
#+BEGIN_SRC emacs-lisp :load test
(defvar chronometrist-plist-test-backend
(make-instance 'chronometrist-plist-backend
:file (make-temp-file "chronometrist-plist-test-" nil ".sexp")))
(with-current-buffer (find-file-noselect)
(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"))))
#+END_SRC
1. [X] 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.
#+BEGIN_SRC emacs-lisp :load test
(defmacro chronometrist-tests--change-type-and-update (state)
`(prog1 (chronometrist-file-change-type ,state)
(setq ,state
(list :last (chronometrist-file-hash :before-last nil)
:rest (chronometrist-file-hash nil :before-last t)))))
#+END_SRC
**** backend :class:
#+BEGIN_SRC emacs-lisp
(defclass chronometrist-plist-backend (chronometrist-backend) ())
(add-to-list 'chronometrist-backends-alist
`(:plist "Store records as plists."
,(make-instance 'chronometrist-plist-backend
:path chronometrist-file
:ext "plist")))
#+END_SRC
**** pretty-print-function :custom:variable:
#+BEGIN_SRC emacs-lisp
(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)
#+END_SRC
**** sexp-mode :major:mode:
#+BEGIN_SRC emacs-lisp
(define-derived-mode chronometrist-sexp-mode
;; fundamental-mode
emacs-lisp-mode
"chronometrist-sexp")
#+END_SRC
**** in-file :macro:
#+BEGIN_SRC emacs-lisp
(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)))
#+END_SRC
**** loop-file :macro:
#+BEGIN_SRC emacs-lisp
(defmacro chronometrist-loop-file (_for expr _in file &rest loop-clauses)
"`cl-loop' LOOP-CLAUSES over s-expressions in FILE, in reverse.
EXPR is bound to each s-expression."
(declare (indent defun)
(debug nil)
;; FIXME
;; (debug ("for" form "in" form &rest &or sexp form))
)
`(chronometrist-sexp-in-file ,file
(goto-char (point-max))
(cl-loop with ,expr
while (and (not (bobp))
(backward-list)
(or (not (bobp))
(not (looking-at-p "^[[:blank:]]*;")))
(setq ,expr (ignore-errors (read (current-buffer))))
(backward-list))
,@loop-clauses)))
#+END_SRC
**** edit-file :method:
#+BEGIN_SRC emacs-lisp
(cl-defmethod chronometrist-edit-file ((backend chronometrist-plist-backend))
(find-file-other-window (chronometrist-backend-file backend))
(goto-char (point-max)))
#+END_SRC
**** count-records :reader:method:
#+BEGIN_SRC emacs-lisp
(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)))
#+END_SRC
**** latest-record :reader:method:
#+BEGIN_SRC emacs-lisp
(cl-defmethod chronometrist-latest-record ((backend chronometrist-plist-backend))
(chronometrist-sexp-in-file (chronometrist-backend-file backend)
(goto-char (point-max))
(backward-list)
(ignore-errors (read (current-buffer)))))
#+END_SRC
**** current-task :reader:method:
#+BEGIN_SRC emacs-lisp
(cl-defmethod chronometrist-current-task ((backend chronometrist-plist-backend))
(let ((last-event (chronometrist-latest-record (chronometrist-active-backend))))
(if (plist-member last-event :stop)
nil
(plist-get last-event :name))))
#+END_SRC
**** to-hash-table :writer:
#+BEGIN_SRC emacs-lisp
(defvar chronometrist-events)
(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-events)
expr pending-expr)
(while (or pending-expr
(setq expr (ignore-errors (read (current-buffer)))))
;; find and split midnight-spanning events during deserialization itself
(let* ((split-expr (chronometrist-events-maybe-split expr))
(new-value (cond (pending-expr
(prog1 pending-expr
(setq pending-expr nil)))
(split-expr
(setq pending-expr (cl-second split-expr))
(cl-first split-expr))
(t expr)))
(new-value-date (--> (plist-get new-value :start)
(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)))
#+END_SRC
**** create-file :writer:method:
#+BEGIN_SRC emacs-lisp
(cl-defmethod chronometrist-create-file ((backend chronometrist-plist-backend))
(let ((file (chronometrist-backend-file backend)))
(unless (file-exists-p file)
(with-current-buffer (find-file-noselect file)
(goto-char (point-min))
(insert ";;; -*- mode: chronometrist-sexp; -*-")
(write-file file)))))
#+END_SRC
**** insert :writer:method:
#+BEGIN_SRC emacs-lisp
(cl-defmethod chronometrist-insert ((backend chronometrist-plist-backend) plist)
"Add new PLIST at the end of `chronometrist-file'."
(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))
(save-buffer)))
#+END_SRC
**** replace-last :writer:method:
#+BEGIN_SRC emacs-lisp
(cl-defmethod chronometrist-replace-last ((backend chronometrist-plist-backend) plist)
"Replace the last s-expression in `chronometrist-file' with PLIST."
(chronometrist-sexp-in-file (chronometrist-backend-file backend)
(goto-char (point-max))
(unless (and (bobp) (bolp)) (insert "\n"))
(backward-list 1)
(chronometrist-sexp-delete-list)
(funcall chronometrist-sexp-pretty-print-function plist (current-buffer))
(save-buffer)))
#+END_SRC
**** reindent-buffer :command:
#+BEGIN_SRC emacs-lisp
(defun chronometrist-sexp-reindent-buffer ()
"Reindent the current buffer.
This is meant to be run in `chronometrist-file' when using the s-expression backend."
(interactive)
(let (expr)
(goto-char (point-min))
(while (setq expr (ignore-errors (read (current-buffer))))
(backward-list)
(chronometrist-sexp-delete-list)
(when (looking-at "\n*")
(delete-region (match-beginning 0) (match-end 0)))
(funcall chronometrist-sexp-pretty-print-function expr (current-buffer))
(insert "\n")
(unless (eobp) (insert "\n")))))
#+END_SRC
**** list-tasks :reader:method:
#+BEGIN_SRC emacs-lisp
(cl-defmethod chronometrist-list-tasks ((backend chronometrist-plist-backend) &key start end)
(--> (chronometrist-loop-file for plist in (chronometrist-backend-file backend)
collect (plist-get plist :name))
(cl-remove-duplicates it :test #'equal)
(sort it #'string-lessp)))
#+END_SRC
***** tests
#+BEGIN_SRC emacs-lisp :tangle chronometrist-tests.el :load test
(ert-deftest task-list ()
(let ((task-list (chronometrist-list-tasks backend)))
(should (listp task-list))
(should (seq-every-p #'stringp task-list))))
#+END_SRC
**** list-records :reader:method:
#+BEGIN_SRC emacs-lisp
(cl-defmethod chronometrist-list-records ((backend chronometrist-plist-backend))
(chronometrist-loop-file for plist in (chronometrist-backend-file backend) collect plist))
#+END_SRC
**** file-state :internal:variable:
:PROPERTIES:
:VALUE: list
:END:
#+BEGIN_SRC emacs-lisp
(defvar chronometrist--file-state nil
"List containing the state of `chronometrist-file'.
`chronometrist-refresh-file' sets this to a plist in the form
\(:last (LAST-START LAST-END) :rest (REST-START REST-END HASH))
\(see `chronometrist-file-hash')
LAST-START and LAST-END represent the start and the end of the
last s-expression.
REST-START and REST-END represent the start of the file and the
end of the second-last s-expression.")
#+END_SRC
**** file-hash :reader:
#+BEGIN_SRC emacs-lisp
(defun chronometrist-file-hash (&optional start end hash)
"Calculate hash of `chronometrist-file' between START and END.
START can be
a number or marker,
:before-last - the position at the start of the last s-expression
nil or any other value - the value of `point-min'.
END can be
a number or marker,
:before-last - the position at the end of the second-last s-expression,
nil or any other value - the position at the end of the last s-expression.
Return (START END) if HASH is nil, else (START END HASH).
Return a list in the form (A B HASH), where A and B are markers
in `chronometrist-file' describing the region for which HASH was calculated."
(chronometrist-sexp-in-file chronometrist-file
(let* ((start (cond ((number-or-marker-p start) start)
((eq :before-last start)
(goto-char (point-max))
(backward-list))
(t (point-min))))
(end (cond ((number-or-marker-p end) end)
((eq :before-last end)
(goto-char (point-max))
(backward-list 2)
(forward-list))
(t (goto-char (point-max))
(backward-list)
(forward-list)))))
(if hash
(--> (buffer-substring-no-properties start end)
(secure-hash 'sha1 it)
(list start end it))
(list start end)))))
#+END_SRC
***** tests
#+BEGIN_SRC emacs-lisp :tangle chronometrist-tests.el :load test
(ert-deftest file-hash ()
(-let* ((chronometrist-file chronometrist-test-file)
((last-start last-end)
(chronometrist-file-hash :before-last nil))
((rest-start rest-end rest-hash)
(chronometrist-file-hash nil :before-last t)))
(message "chronometrist - file-hash test - file path is %s"
chronometrist-test-file)
(should (= 1 rest-start))
(should (= 1254 rest-end))
(should (= 1256 last-start))
(should (= 1426 last-end))))
#+END_SRC
**** read-from :reader:
#+BEGIN_SRC emacs-lisp
(defun chronometrist-read-from (position)
(chronometrist-sexp-in-file chronometrist-file
(goto-char (if (number-or-marker-p position)
position
(funcall position)))
(ignore-errors (read (current-buffer)))))
#+END_SRC
**** TODO file-change-type :reader:
1. [ ] add newline after last expression and save => nil
2. [ ] remove newline after last expession and save => nil
The initial idea was to use two pairs of hashes, one for the content between the start of the file up to the last expression, and the other for the last expression itself. However, in the latter case, this can cause issues -
+ the expression may shrink, and if we try to compute the hash of the previously-known region again, we will get an args-out-of-range error.
+ false negatives for whitespace/indentation differences.
Thus, we use =read= for the last expression.
Possible states
: <rest-start> <rest-end> <last-start> <last-end>
1. :append - rest same, last same, new expr after last-end
2. :modify - rest same, last not same, no expr after last-end
3. :remove - rest same, last not same, no expr after last-start
4. nil - rest same, last same, no expr after last-end
5. t - rest changed
#+BEGIN_SRC emacs-lisp
(defun chronometrist-file-change-type (state)
"Determine the type of change made to `chronometrist-file'.
STATE must be a plist. (see `chronometrist--file-state')
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."
(-let*
(((last-start last-end) (plist-get state :last))
((rest-start rest-end rest-hash) (plist-get state :rest))
(last-expr-file (chronometrist-read-from last-start))
(last-expr-ht (chronometrist-events-last))
(last-same-p (equal last-expr-ht last-expr-file))
(file-new-length (chronometrist-sexp-in-file chronometrist-file (point-max)))
(rest-same-p (unless (< file-new-length rest-end)
(--> (chronometrist-file-hash rest-start rest-end t)
(cl-third it)
(equal rest-hash it)))))
;; (message "chronometrist - last-start\nlast-expr-file - %S\nlast-expr-ht - %S"
;; last-expr-file
;; last-expr-ht)
;; (message "chronometrist - last-same-p - %S, rest-same-p - %S"
;; last-same-p rest-same-p)
(cond ((not rest-same-p) t)
(last-same-p
(when (chronometrist-read-from last-end) :append))
((not (chronometrist-read-from last-start))
:remove)
((not (chronometrist-read-from
(lambda ()
(progn (goto-char last-start)
(forward-list)))))
:modify))))
#+END_SRC
***** tests
#+BEGIN_SRC emacs-lisp :tangle chronometrist-tests.el :load test
(ert-deftest chronometrist-file-change-type ()
(let* ((test-contents (with-current-buffer (find-file-noselect
(chronometrist-backend-file chronometrist-plist-test-backend))
(buffer-substring (point-min) (point-max))))
(chronometrist--file-state-old chronometrist--file-state)
(chronometrist--file-state (list :last (chronometrist-file-hash :before-last nil)
:rest (chronometrist-file-hash nil :before-last t)))
(chronometrist-events-old chronometrist-events))
(chronometrist-events-populate)
(unwind-protect
(progn
(should
(eq nil (chronometrist-file-change-type chronometrist--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 chronometrist--file-state))))
(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 chronometrist--file-state))))
(should
(eq :remove
(progn
(chronometrist-sexp-in-file chronometrist-file
(goto-char (point-max))
(backward-list 1)
(chronometrist-sexp-delete-list 1)
(save-buffer))
(chronometrist-tests--change-type-and-update chronometrist--file-state))))
(should
(eq t
(progn
(chronometrist-sexp-in-file chronometrist-plist-test-backend
(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 chronometrist--file-state)))))
(with-current-buffer
(find-file-noselect (chronometrist-backend-file chronometrist-plist-test-backend))
(delete-region (point-min) (point-max))
(insert test-contents)
(save-buffer))
(setq chronometrist--file-state chronometrist--file-state-old
chronometrist-events chronometrist-events-old))))
#+END_SRC
** TODO Migration
1. [ ] Use EIEIO to make a =chronometrist-migrate= command which calls a generic function.
2. [ ] Write importer for Org time tracking.
*** table :variable:
:PROPERTIES:
:VALUE: hash table
:END:
#+BEGIN_SRC emacs-lisp
(defvar chronometrist-migrate-table (make-hash-table))
#+END_SRC
*** EXTEND populate :writer:
:PROPERTIES:
:STATE: chronometrist-migrate-table
:END:
1. [ ] support other timeclock codes - currently only "i" and "o" are supported.
#+BEGIN_SRC emacs-lisp
(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)))
#+END_SRC
*** timelog-file-to-sexp-file :writer:
#+BEGIN_SRC emacs-lisp
(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)))))
#+END_SRC
*** check :writer:
#+BEGIN_SRC emacs-lisp
(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'."))))
#+END_SRC
** Data structures
:PROPERTIES:
:CUSTOM_ID: program-data-structures
:END:
Reading directly from the file could be difficult, especially when your most common query is "get all intervals recorded on <date>" [fn: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 [[#explanation-midnight-spanning-intervals][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.
[fn:4] it might be the case that the [[#program-backend][file format]] is not suited to our most frequent operation...
*** reset :command:
#+BEGIN_SRC emacs-lisp
(defun chronometrist-reset ()
"Reset Chronometrist's internal state."
(interactive)
(chronometrist-reset-task-list)
(chronometrist-events-populate)
(setq chronometrist--file-state nil)
(chronometrist-refresh))
#+END_SRC
*** chronometrist-events :variable:
:PROPERTIES:
:VALUE: hash table
:END:
#+BEGIN_SRC emacs-lisp
(defvar chronometrist-events (make-hash-table :test #'equal)
"Each key is a date in the form (YEAR MONTH DAY).
Values are lists containing events, where each event is a list in
the form (:name \"NAME\" :tags (TAGS) <key value pairs> ...
:start TIME :stop TIME).")
#+END_SRC
*** apply-time :function:
#+BEGIN_SRC emacs-lisp
(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))))
#+END_SRC
**** tests
#+BEGIN_SRC emacs-lisp :tangle chronometrist-tests.el :load test
(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")))
#+END_SRC
*** events-maybe-split :function:
#+BEGIN_SRC emacs-lisp
(defun chronometrist-events-maybe-split (event)
"Split EVENT if it spans midnight.
Return a list of two events if EVENT was split, else nil."
(when (plist-get event :stop)
(let ((split-time (chronometrist-midnight-spanning-p (plist-get event :start)
(plist-get event :stop)
chronometrist-day-start-time)))
(when split-time
(let ((first-start (plist-get (cl-first split-time) :start))
(first-stop (plist-get (cl-first split-time) :stop))
(second-start (plist-get (cl-second split-time) :start))
(second-stop (plist-get (cl-second split-time) :stop))
;; plist-put modifies lists in-place. The resulting bugs
;; left me puzzled for a while.
(event-1 (cl-copy-list event))
(event-2 (cl-copy-list event)))
(list (-> event-1
(plist-put :start first-start)
(plist-put :stop first-stop))
(-> event-2
(plist-put :start second-start)
(plist-put :stop second-stop))))))))
#+END_SRC
**** tests
#+BEGIN_SRC emacs-lisp :tangle chronometrist-tests.el :load test
(ert-deftest chronometrist-events-maybe-split ()
(should
(null (chronometrist-events-maybe-split
'(:name "Task"
:start "2021-02-17T01:33:12+0530"
:stop "2021-02-17T01:56:08+0530"))))
(should
(equal (chronometrist-events-maybe-split
'(: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")))))
#+END_SRC
*** events-populate :function:
#+BEGIN_SRC emacs-lisp
(defun chronometrist-events-populate ()
"Clear hash table `chronometrist-events' (which see) and populate it.
The data is acquired from `chronometrist-file'.
Return final number of events read from file, or nil if there
were none."
(clrhash chronometrist-events)
(chronometrist-to-hash-table (chronometrist-active-backend)))
#+END_SRC
*** events-update :writer:
#+BEGIN_SRC emacs-lisp
(defun chronometrist-events-update (plist &optional replace)
"Add PLIST to the end of `chronometrist-events'.
If REPLACE is non-nil, replace the last event with PLIST."
(let* ((date (->> (plist-get plist :start)
(chronometrist-iso-to-ts )
(ts-format "%F" )))
(events-today (gethash date chronometrist-events)))
(--> (if replace (-drop-last 1 events-today) events-today)
(append it (list plist))
(puthash date it chronometrist-events))))
#+END_SRC
*** last-date :reader:
#+BEGIN_SRC emacs-lisp
(defun chronometrist-events-last-date ()
"Return an ISO-8601 date string for the latest date present in `chronometrist-events'."
(--> (hash-table-keys chronometrist-events)
(last it)
(car it)))
#+END_SRC
*** events-last :reader:
#+BEGIN_SRC emacs-lisp
(defun chronometrist-events-last ()
"Return the last plist from `chronometrist-events'."
(--> (gethash (chronometrist-events-last-date) chronometrist-events)
(last it)
(car it)))
#+END_SRC
*** events-subset :reader:
:PROPERTIES:
:VALUE: hash table
:CUSTOM_ID: program-data-structures-events-subset
:END:
#+BEGIN_SRC emacs-lisp
(defun chronometrist-events-subset (start end)
"Return a subset of `chronometrist-events'.
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 (make-hash-table :test #'equal))
(start (chronometrist-date start))
(end (chronometrist-date end)))
(maphash (lambda (key value)
(when (ts-in start end (chronometrist-iso-to-ts key))
(puthash key value subset)))
chronometrist-events)
subset))
#+END_SRC
*** task-events-in-day :reader:
#+BEGIN_SRC emacs-lisp
(cl-defun chronometrist-task-events-in-day (task &optional (ts (ts-now)))
"Get events for TASK on TS.
TS should be a ts struct (see `ts.el').
Returns a list of events, where each event is a property list in
the form (:name \"NAME\" :start START :stop STOP ...), where
START and STOP are ISO-8601 time strings.
This will not return correct results if TABLE contains records
which span midnights."
(->> (gethash (ts-format "%F" ts) chronometrist-events)
(mapcar (lambda (event)
(when (equal task (plist-get event :name))
event)))
(seq-filter #'identity)))
#+END_SRC
*** task-time-one-day :reader:
#+BEGIN_SRC emacs-lisp
(cl-defun chronometrist-task-time-one-day (task &optional (ts (ts-now)))
"Return total time spent on TASK today or (if supplied) on timestamp TS.
The data is obtained from `chronometrist-file', via `chronometrist-events'.
TS should be a ts struct (see `ts.el').
The return value is seconds, as an integer."
(let ((task-events (chronometrist-task-events-in-day task ts)))
(if task-events
(->> (chronometrist-events-to-durations task-events)
(-reduce #'+)
(truncate))
;; no events for this task on TS, i.e. no time spent
0)))
#+END_SRC
*** active-time-one-day :reader:
#+BEGIN_SRC emacs-lisp
(defvar chronometrist-task-list)
(cl-defun chronometrist-active-time-one-day (&optional (ts (ts-now)))
"Return the total active time on TS (if non-nil) or today.
TS must be a ts struct (see `ts.el')
Return value is seconds as an integer."
(->> (--map (chronometrist-task-time-one-day it ts) chronometrist-task-list)
(-reduce #'+)
(truncate)))
#+END_SRC
*** count-active-days :function:
#+BEGIN_SRC emacs-lisp
(cl-defun chronometrist-statistics-count-active-days (task &optional (table chronometrist-events))
"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)))
#+END_SRC
*** task-list :variable:
:PROPERTIES:
:VALUE: list
:END:
#+BEGIN_SRC emacs-lisp
(defvar chronometrist-task-list nil
"List of tasks in `chronometrist-file'.")
#+END_SRC
*** reset-task-list :writer:
#+BEGIN_SRC emacs-lisp
(defun chronometrist-reset-task-list ()
(setq chronometrist-task-list (chronometrist-list-tasks (chronometrist-active-backend))))
#+END_SRC
*** add-to-task-list :writer:
#+BEGIN_SRC emacs-lisp
(defun chronometrist-add-to-task-list (task)
(unless (cl-member task chronometrist-task-list :test #'equal)
(setq chronometrist-task-list
(sort (cons task chronometrist-task-list) #'string-lessp))))
#+END_SRC
*** remove-from-task-list :writer:
#+BEGIN_SRC emacs-lisp
(defun chronometrist-remove-from-task-list (task)
"Check if we want TASK to be removed from `chronometrist-task-list', and remove it.
TASK is removed if it does not occur in `chronometrist-events',
or if it only occurs in the newest plist of the same.
Return new value of `chronometrist-task-list', or nil if
unchanged."
(let ((ht-plist-count (cl-loop with count = 0
for intervals being the hash-values of chronometrist-events
do (cl-loop for _interval in intervals
do (cl-incf count))
finally return count))
(ht-task-first-result (cl-loop with count = 0
for intervals being the hash-values of chronometrist-events
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
(setq chronometrist-task-list (remove task chronometrist-task-list)))))
#+END_SRC
** Time functions
*** iso-to-ts :function:
#+BEGIN_SRC emacs-lisp
(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))))
#+END_SRC
**** tests
#+BEGIN_SRC emacs-lisp :tangle chronometrist-tests.el :load test
(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))))
#+END_SRC
*** date :function:
#+BEGIN_SRC emacs-lisp
(cl-defun chronometrist-date (&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))
#+END_SRC
*** format-time-iso8601 :function:
#+BEGIN_SRC emacs-lisp
(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.
#+END_SRC
*** FIXME midnight-spanning-p :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.)
#+BEGIN_SRC emacs-lisp
(defun chronometrist-midnight-spanning-p (start-time stop-time day-start-time)
"Return non-nil if START-TIME and STOP-TIME cross a midnight.
START-TIME and STOP-TIME must be ISO-8601 timestamps.
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* ((start-ts (chronometrist-iso-to-ts start-time))
(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)
(list `(:start ,start-time
:stop ,(ts-format "%FT%T%z" next-day-start))
`(:start ,(ts-format "%FT%T%z" next-day-start)
:stop ,stop-time)))))
#+END_SRC
**** tests
#+BEGIN_SRC emacs-lisp :tangle chronometrist-tests.el :load test
(ert-deftest chronometrist-midnight-spanning-p ()
(should
(null
(chronometrist-midnight-spanning-p "2021-02-17T01:33:12+0530"
"2021-02-17T01:56:08+0530"
"00:00:00")))
(should
(equal
(chronometrist-midnight-spanning-p "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-midnight-spanning-p "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")))))
#+END_SRC
*** seconds-to-hms :function:
#+BEGIN_SRC emacs-lisp
(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)))
#+END_SRC
*** interval :function:
#+BEGIN_SRC emacs-lisp
(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))))
#+END_SRC
*** format-duration-long :function:
#+BEGIN_SRC emacs-lisp
(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)))))
#+END_SRC
**** tests
#+BEGIN_SRC emacs-lisp :tangle ../tests/chronometrist-tests.el :load test
(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")))
#+END_SRC
** 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:
#+BEGIN_SRC emacs-lisp
(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)
#+END_SRC
*** timer-object :internal:variable:
#+BEGIN_SRC emacs-lisp
(defvar chronometrist--timer-object nil)
#+END_SRC
*** timer-hook :hook:custom:variable:
#+BEGIN_SRC emacs-lisp
(defcustom chronometrist-timer-hook nil
"Functions run by `chronometrist-timer'."
:type '(repeat function))
#+END_SRC
*** FIXME timer :procedure:
1. [ ] Making this conditional upon =chronometrist-current-task= is, for some reason, currently resulting in no refresh at midnight.
#+BEGIN_SRC emacs-lisp
(defvar chronometrist-buffer-name)
(defun chronometrist-timer ()
"Refresh Chronometrist and related buffers.
Buffers will be refreshed only if they are visible and the user
is clocked in to a task."
(let ((file-buffer (get-buffer-create (find-file-noselect chronometrist-file))))
;; 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.)
(when (and (chronometrist-current-task (chronometrist-active-backend))
(not (buffer-modified-p file-buffer)))
(when (get-buffer-window chronometrist-buffer-name)
(chronometrist-refresh))
(run-hooks 'chronometrist-timer-hook))))
#+END_SRC
*** stop-timer :command:
#+BEGIN_SRC emacs-lisp
(defun chronometrist-stop-timer ()
"Stop the timer for Chronometrist buffers."
(interactive)
(cancel-timer chronometrist--timer-object)
(setq chronometrist--timer-object nil))
#+END_SRC
*** maybe-start-timer :command:
#+BEGIN_SRC emacs-lisp
(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
(setq chronometrist--timer-object
(run-at-time t chronometrist-update-interval #'chronometrist-timer))
(when interactive-test
(message "Timer started."))
t))
#+END_SRC
*** force-restart-timer :command:
#+BEGIN_SRC emacs-lisp
(defun chronometrist-force-restart-timer ()
"Restart the timer for Chronometrist buffers."
(interactive)
(when chronometrist--timer-object
(cancel-timer chronometrist--timer-object))
(setq chronometrist--timer-object
(run-at-time t chronometrist-update-interval #'chronometrist-timer)))
#+END_SRC
*** change-update-interval :command:
#+BEGIN_SRC emacs-lisp
(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))
#+END_SRC
** Frontends
All four of these use [[info:elisp#Tabulated List Mode][=(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
:PROPERTIES:
:CUSTOM_ID: program-frontend-chronometrist
:END:
**** TODO [33%]
1. [X] 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:
#+BEGIN_SRC emacs-lisp
(defcustom chronometrist-buffer-name "*Chronometrist*"
"The name of the buffer created by `chronometrist'."
:type 'string)
#+END_SRC
**** hide-cursor :custom:variable:
I have not yet gotten this to work as well as I wanted.
#+BEGIN_SRC emacs-lisp
(defcustom chronometrist-hide-cursor nil
"If non-nil, hide the cursor and only highlight the current line in the `chronometrist' buffer."
:type 'boolean)
#+END_SRC
**** activity-indicator :custom:variable:
#+BEGIN_SRC emacs-lisp
(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))
#+END_SRC
**** point :internal:variable:
#+BEGIN_SRC emacs-lisp
(defvar chronometrist--point nil)
#+END_SRC
**** open-log :command:
#+BEGIN_SRC emacs-lisp
(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-file (chronometrist-active-backend)))
#+END_SRC
**** task-active-p :reader:
#+BEGIN_SRC emacs-lisp
(defun chronometrist-task-active-p (task)
"Return t if TASK is currently clocked in, else nil."
(equal (chronometrist-current-task (chronometrist-active-backend)) task))
#+END_SRC
**** activity-indicator :procedure:
#+BEGIN_SRC emacs-lisp
(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))
#+END_SRC
**** run-transformers :function:
Used by [[* row-transformers][=chronometrist-row-transformers=]] and [[* schema-transformers][=chronometrist-schema-transformers=]] to remove the need for Chronometrist to know about extensions like =chronometrist-goal=.
#+BEGIN_SRC emacs-lisp
(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))
#+END_SRC
**** TODO schema :custom:variable:
1. Define custom =:type=
#+BEGIN_SRC emacs-lisp
(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))
#+END_SRC
**** chronometrist-mode-hook :hook:normal:
#+BEGIN_SRC emacs-lisp
(defvar chronometrist-mode-hook nil
"Normal hook run at the very end of `chronometrist-mode'.")
#+END_SRC
**** schema-transformers :extension:variable:
#+BEGIN_SRC emacs-lisp
(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'.")
#+END_SRC
**** row-transformers :extension:variable:
#+BEGIN_SRC emacs-lisp
(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'.")
#+END_SRC
**** before-in-functions :hook:abnormal:
#+BEGIN_SRC emacs-lisp
(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))
#+END_SRC
**** after-in-functions :hook:abnormal:
#+BEGIN_SRC emacs-lisp
(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))
#+END_SRC
**** before-out-functions :hook:abnormal:
#+BEGIN_SRC emacs-lisp
(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))
#+END_SRC
**** after-out-functions :hook:abnormal:
#+BEGIN_SRC emacs-lisp
(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))
#+END_SRC
**** file-change-hook :hook:normal:
#+BEGIN_SRC emacs-lisp
(defcustom chronometrist-file-change-hook nil
"Functions to be run after `chronometrist-file' is changed on disk."
:type '(repeat function))
#+END_SRC
**** rows :procedure:
#+BEGIN_SRC emacs-lisp
(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)))
#+END_SRC
**** task-at-point :procedure:
#+BEGIN_SRC emacs-lisp
(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))))
#+END_SRC
**** goto-last-task :procedure:
#+BEGIN_SRC emacs-lisp
(defun chronometrist-goto-last-task ()
"In the `chronometrist' buffer, move point to the line containing the last active task."
(goto-char (point-min))
(re-search-forward (plist-get (chronometrist-latest-record (chronometrist-active-backend)) :name) nil t)
(beginning-of-line))
#+END_SRC
**** CLEANUP print-non-tabular :procedure:
#+BEGIN_SRC emacs-lisp
(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-one-day)
(chronometrist-format-duration it)
(format "%s%- 26s%s" w "Total" it)
(insert it)))))
#+END_SRC
**** goto-nth-task :procedure:
#+BEGIN_SRC emacs-lisp
(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)))
#+END_SRC
**** refresh :procedure:
#+BEGIN_SRC emacs-lisp
(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)))))
#+END_SRC
**** 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).
#+BEGIN_SRC emacs-lisp
(defun chronometrist-refresh-file (fs-event)
"Procedure run when `chronometrist-file' changes.
Re-read `chronometrist-file', update `chronometrist-events', and
refresh the `chronometrist' buffer."
(run-hooks 'chronometrist-file-change-hook)
;; (message "chronometrist - file %s" fs-event)
(-let* (((descriptor action _ _) fs-event)
(change (when chronometrist--file-state
(chronometrist-file-change-type chronometrist--file-state)))
(reset-watch (or (eq action 'deleted)
(eq action 'renamed))))
;; (message "chronometrist - file change type is %s" change)
;; If only the last plist was changed, update `chronometrist-events' and
;; `chronometrist-task-list', otherwise clear and repopulate
;; `chronometrist-events'.
(cond ((or reset-watch
(not chronometrist--file-state) ;; why?
(eq change t))
;; Don't keep a watch for a nonexistent file.
(when reset-watch
(file-notify-rm-watch chronometrist--fs-watch)
(setq chronometrist--fs-watch nil chronometrist--file-state nil))
(chronometrist-events-populate)
(chronometrist-reset-task-list))
(chronometrist--file-state
(-let* (((&plist :name old-task) (chronometrist-events-last))
((&plist :name new-task) (chronometrist-latest-record (chronometrist-active-backend))))
(pcase change
(:append ;; a new plist was added at the end of the file
(chronometrist-events-update (chronometrist-latest-record (chronometrist-active-backend)))
(chronometrist-add-to-task-list new-task))
(:modify ;; the last plist in the file was changed
(chronometrist-events-update (chronometrist-latest-record (chronometrist-active-backend)) t)
(chronometrist-remove-from-task-list old-task)
(chronometrist-add-to-task-list new-task))
(:remove ;; the last plist in the file was removed
(let ((date (chronometrist-events-last-date)))
;; `chronometrist-remove-from-task-list' checks `chronometrist-events' to
;; determine if `chronometrist-task-list' is to be updated.
;; Thus, the update of the latter must occur before
;; the update of the former.
(chronometrist-remove-from-task-list old-task)
(--> (gethash date chronometrist-events)
(-drop-last 1 it)
(puthash date it chronometrist-events))))
((pred null) nil)))))
(setq chronometrist--file-state
(list :last (chronometrist-file-hash :before-last nil)
:rest (chronometrist-file-hash nil :before-last t)))
;; REVIEW - can we move most/all of this to the `chronometrist-file-change-hook'?
(chronometrist-refresh)))
#+END_SRC
**** query-stop :procedure:
#+BEGIN_SRC emacs-lisp
(defun chronometrist-query-stop ()
"Ask the user if they would like to clock out."
(let ((task (chronometrist-current-task (chronometrist-active-backend))))
(and task
(yes-or-no-p (format "Stop tracking time for %s? " task))
(chronometrist-out))
t))
#+END_SRC
**** chronometrist-in :command:
#+BEGIN_SRC emacs-lisp
(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)))
#+END_SRC
**** chronometrist-out :command:
#+BEGIN_SRC emacs-lisp
(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)))
#+END_SRC
**** run-functions-and-clock-in :writer:
#+BEGIN_SRC emacs-lisp
(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))
#+END_SRC
**** run-functions-and-clock-out :writer:
#+BEGIN_SRC emacs-lisp
(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)))
#+END_SRC
**** chronometrist-mode-map :keymap:
#+BEGIN_SRC emacs-lisp
(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 (kbd "<C-return>") #'chronometrist-restart-task)
(define-key map (kbd "<C-M-return>") #'chronometrist-extend-task)
(define-key map [mouse-1] #'chronometrist-toggle-task)
(define-key map [mouse-3] #'chronometrist-toggle-task-no-hooks)
(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'.")
#+END_SRC
**** chronometrist-menu :menu:
#+BEGIN_SRC emacs-lisp
(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]"]
["View details of today's data" chronometrist-details]
["View weekly report" chronometrist-report]
["View/edit log file" chronometrist-open-log]
["Restart timer" chronometrist-force-restart-timer]
["Reset state" chronometrist-reset]))
#+END_SRC
**** chronometrist-mode :major:mode:
#+BEGIN_SRC emacs-lisp
(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))
#+END_SRC
**** toggle-task-button :writer:
#+BEGIN_SRC emacs-lisp
(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 (chronometrist-active-backend)))
(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))))
#+END_SRC
**** add-new-task-button :writer:
#+BEGIN_SRC emacs-lisp
(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 (chronometrist-active-backend))))
(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))))
#+END_SRC
**** toggle-task :command:
#+BEGIN_SRC emacs-lisp
;; 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")
(let* ((empty-file (chronometrist-common-file-empty-p chronometrist-file))
(nth (when prefix (chronometrist-goto-nth-task prefix)))
(at-point (chronometrist-task-at-point))
(target (or nth at-point))
(current (chronometrist-current-task (chronometrist-active-backend)))
(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))))))
#+END_SRC
**** toggle-task-no-hooks :command:
#+BEGIN_SRC emacs-lisp
(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))
#+END_SRC
**** add-new-task :command:
#+BEGIN_SRC emacs-lisp
(defun chronometrist-add-new-task ()
"Add a new task."
(interactive)
(chronometrist-add-new-task-button nil))
#+END_SRC
**** restart-task :command:
#+BEGIN_SRC emacs-lisp
(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")
(if (chronometrist-current-task (chronometrist-active-backend))
(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.")))
#+END_SRC
**** extend-task :command:
#+BEGIN_SRC emacs-lisp
(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")
(if (chronometrist-current-task (chronometrist-active-backend))
(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)))))
#+END_SRC
**** chronometrist :command:
#+BEGIN_SRC emacs-lisp
;;;###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))))
(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 ((or (not (file-exists-p chronometrist-file))
(chronometrist-common-file-empty-p chronometrist-file))
;; first run
(chronometrist-create-file (chronometrist-active-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)
(if (hash-table-keys chronometrist-events)
(chronometrist-refresh)
(chronometrist-refresh-file nil))
(if chronometrist--point
(goto-char chronometrist--point)
(chronometrist-goto-last-task))))
(unless chronometrist--fs-watch
(setq chronometrist--fs-watch
(file-notify-add-watch chronometrist-file '(change) #'chronometrist-refresh-file))))))))
#+END_SRC
*** Report
**** TODO [0%]
1. [ ] preserve point when clicking buttons
**** report :custom:group:
#+BEGIN_SRC emacs-lisp
(defgroup chronometrist-report nil
"Weekly report for the `chronometrist' time tracker."
:group 'chronometrist)
#+END_SRC
**** buffer-name :custom:variable:
#+BEGIN_SRC emacs-lisp
(defcustom chronometrist-report-buffer-name "*Chronometrist-Report*"
"The name of the buffer created by `chronometrist-report'."
:type 'string)
#+END_SRC
**** ui-date :internal:variable:
#+BEGIN_SRC emacs-lisp
(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\".")
#+END_SRC
**** ui-week-dates :internal:variable:
#+BEGIN_SRC emacs-lisp
(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\"))")
#+END_SRC
**** point :internal:variable:
#+BEGIN_SRC emacs-lisp
(defvar chronometrist-report--point nil)
#+END_SRC
**** date-to-dates-in-week :function:
#+BEGIN_SRC emacs-lisp
(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)))
#+END_SRC
**** date-to-week-dates :function:
#+BEGIN_SRC emacs-lisp
(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))
(chronometrist-previous-week-start)
(chronometrist-report-date-to-dates-in-week)))
#+END_SRC
**** rows :procedure:
#+BEGIN_SRC emacs-lisp
(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 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)))))
#+END_SRC
**** print-keybind :procedure:
#+BEGIN_SRC emacs-lisp
(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 "")))
#+END_SRC
**** CLEANUP print-non-tabular :procedure:
#+BEGIN_SRC emacs-lisp
(defun chronometrist-report-print-non-tabular ()
"Print the non-tabular part of the buffer in `chronometrist-report'."
(let ((inhibit-read-only t)
(w "\n ")
(total-time-daily (->> (mapcar #'chronometrist-date chronometrist-report--ui-week-dates)
(mapcar #'chronometrist-active-time-one-day))))
(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)))
#+END_SRC
**** REVIEW refresh :procedure:
Merge this into `chronometrist-refresh-file', while moving the -refresh call to the call site?
#+BEGIN_SRC emacs-lisp
(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))))
#+END_SRC
**** refresh-file :writer:
#+BEGIN_SRC emacs-lisp
(defun chronometrist-report-refresh-file (_fs-event)
"Re-read `chronometrist-file' and refresh the `chronometrist-report' buffer.
Argument _FS-EVENT is ignored."
(chronometrist-events-populate)
(chronometrist-report-refresh))
#+END_SRC
**** report-mode-map :keymap:
#+BEGIN_SRC emacs-lisp
(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'.")
#+END_SRC
**** report-mode :major:mode:
#+BEGIN_SRC emacs-lisp
(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)
(unless chronometrist--fs-watch
(setq chronometrist--fs-watch
(file-notify-add-watch chronometrist-file
'(change)
#'chronometrist-refresh-file))))
#+END_SRC
**** chronometrist-report :command:
#+BEGIN_SRC emacs-lisp
;;;###autoload
(defun chronometrist-report (&optional keep-date)
"Display a weekly report of the data in `chronometrist-file'.
This is the 'listing command' for ‘chronometrist-report-mode’.
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)))))))
#+END_SRC
**** report-previous-week :command:
#+BEGIN_SRC emacs-lisp
(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))
#+END_SRC
**** report-next-week :command:
#+BEGIN_SRC emacs-lisp
(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)))
#+END_SRC
*** Statistics
**** statistics :custom:group:
#+BEGIN_SRC emacs-lisp
(defgroup chronometrist-statistics nil
"Statistics buffer for the `chronometrist' time tracker."
:group 'chronometrist)
#+END_SRC
**** buffer-name :custom:variable:
#+BEGIN_SRC emacs-lisp
(defcustom chronometrist-statistics-buffer-name "*Chronometrist-Statistics*"
"The name of the buffer created by `chronometrist-statistics'."
:type 'string)
#+END_SRC
**** ui-state :internal:variable:
#+BEGIN_SRC emacs-lisp
(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 from the beginning to the end of
the `chronometrist-file'.
'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').")
#+END_SRC
**** point :internal:variable:
#+BEGIN_SRC emacs-lisp
(defvar chronometrist-statistics--point nil)
#+END_SRC
**** mode-map :keymap:
#+BEGIN_SRC emacs-lisp
(defvar chronometrist-statistics-mode-map)
#+END_SRC
**** count-average-time-spent :function:
#+BEGIN_SRC emacs-lisp
(cl-defun chronometrist-statistics-count-average-time-spent (task &optional (table chronometrist-events))
"Return the average time the user has spent on TASK from TABLE.
TABLE should be a hash table - if not supplied,
`chronometrist-events' is used."
(cl-loop with days = 0
with events-in-day
for date being the hash-keys of table
when (setq events-in-day
(chronometrist-task-events-in-day task (chronometrist-iso-to-ts 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)))
#+END_SRC
**** rows-internal :reader:
#+BEGIN_SRC emacs-lisp
(defun chronometrist-statistics-rows-internal (table)
"Helper function for `chronometrist-statistics-rows'.
It simply operates on the entire hash table TABLE (see
`chronometrist-events' 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))))
#+END_SRC
**** TEST rows :reader:
#+BEGIN_SRC emacs-lisp
(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.
(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)))
(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)))
(end (ts-adjust 'day 7 start))
(ht (chronometrist-events-subset start end)))
(setq chronometrist-statistics--ui-state `(:mode week :start ,start :end ,end))
(chronometrist-statistics-rows-internal ht)))))
#+END_SRC
**** print-keybind :procedure:
#+BEGIN_SRC emacs-lisp
(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 "")))
#+END_SRC
**** print-non-tabular :procedure:
#+BEGIN_SRC emacs-lisp
(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))))))
#+END_SRC
**** refresh :procedure:
#+BEGIN_SRC emacs-lisp
(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))))
#+END_SRC
**** mode-map :keymap:
#+BEGIN_SRC emacs-lisp
(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'.")
#+END_SRC
**** statistics-mode :major:mode:
#+BEGIN_SRC emacs-lisp
(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)
(unless chronometrist--fs-watch
(setq chronometrist--fs-watch
(file-notify-add-watch chronometrist-file
'(change)
#'chronometrist-refresh-file))))
#+END_SRC
**** chronometrist-statistics :command:
#+BEGIN_SRC emacs-lisp
;;;###autoload
(defun chronometrist-statistics (&optional preserve-state)
"Display statistics for data in `chronometrist-file'.
This is the 'listing command' for `chronometrist-statistics-mode'.
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))
(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))))))
#+END_SRC
**** previous-range :command:
#+BEGIN_SRC emacs-lisp
(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)))
#+END_SRC
**** next-range :command:
#+BEGIN_SRC emacs-lisp
(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)))
#+END_SRC
*** 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. [X] Handle active task (no =:stop=).
2. Update data with timer
3. Permit forward/backward scrolling through dates + input a specific date.
4. [X] Display key-values and tags
* make it possible to create columns using keys
5. [X] Remove outer parentheses from tags
**** details :custom:group:
#+BEGIN_SRC emacs-lisp
(defgroup chronometrist-details nil
"Details buffer for the `chronometrist' time tracker."
:group 'chronometrist)
#+END_SRC
**** buffer-name-base :custom:variable:
#+BEGIN_SRC emacs-lisp
(defcustom chronometrist-details-buffer-name-base "chronometrist-details"
"Name of buffer created by `chronometrist-details'."
:type 'string)
#+END_SRC
**** buffer-name :reader:
#+BEGIN_SRC emacs-lisp
(defun chronometrist-details-buffer-name (&optional suffix)
(if suffix
(format "*%s_%s*" chronometrist-details-buffer-name-base suffix)
(format "*%s*" chronometrist-details-buffer-name-base)))
#+END_SRC
**** display-tags :custom:variable:
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.
#+BEGIN_SRC emacs-lisp
(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))
#+END_SRC
**** 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.
#+BEGIN_SRC emacs-lisp
(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))
#+END_SRC
**** time-format-string :custom:variable:
#+BEGIN_SRC emacs-lisp
(defcustom chronometrist-details-time-format-string "%H:%M"
"String specifying time format in `chronometrist-details' buffers.
See `format-time-string'."
:type 'string)
#+END_SRC
**** 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=
#+BEGIN_SRC emacs-lisp
(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))
#+END_SRC
**** schema-transformers :extension:variable:
#+BEGIN_SRC emacs-lisp
(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'.")
#+END_SRC
**** rows-helper :reader:
#+BEGIN_SRC emacs-lisp
(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)))
"")))
#+END_SRC
***** tests
#+BEGIN_SRC emacs-lisp :tangle chronometrist-tests.el :load test
(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")))))
#+END_SRC
**** row-transformers :extension:variable:
#+BEGIN_SRC emacs-lisp
(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'.")
#+END_SRC
**** rows :function:
#+BEGIN_SRC emacs-lisp
(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-events)
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)))
#+END_SRC
**** map :keymap:
#+BEGIN_SRC emacs-lisp
(defvar chronometrist-details-mode-map
(let ((map (make-sparse-keymap)))
(define-key map (kbd "s r") #'chronometrist-details-set-range)
(define-key map (kbd "s f") #'chronometrist-details-set-filter)
(define-key map (kbd "r") #'chronometrist-report)
(define-key map (kbd "l") #'chronometrist-open-log)
(define-key map (kbd "G") #'chronometrist-reset)
map))
#+END_SRC
**** chronometrist-details-menu :menu:
#+BEGIN_SRC emacs-lisp
(easy-menu-define chronometrist-details-menu chronometrist-details-mode-map
"Menu for `chronometrist-details'."
'("Details"
["Set date/time range" chronometrist-details-set-range]
["Set interval filter" chronometrist-details-set-filter]
["View weekly report" chronometrist-report]
["View/edit log file" chronometrist-open-log]
["Reset state" chronometrist-reset]))
#+END_SRC
**** chronometrist-details-mode :major:mode:
#+BEGIN_SRC emacs-lisp
(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))
#+END_SRC
**** details-setup-buffer :procedure:
#+BEGIN_SRC emacs-lisp
(defun chronometrist-details-setup-buffer (buffer-or-name)
"Enable `chronometrist-details-mode' in BUFFER-OR-NAME and switch to it.
BUFFER-OR-NAME must be an existing buffer."
(with-current-buffer buffer-or-name
(switch-to-buffer buffer-or-name)
(chronometrist-details-mode)
(tabulated-list-print)))
#+END_SRC
**** chronometrist-details :command:
#+BEGIN_SRC emacs-lisp
(defun chronometrist-details ()
(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)))))
#+END_SRC
**** range :variable:
#+BEGIN_SRC emacs-lisp
(defvar chronometrist-details-range nil
"Time range for intervals displayed by `chronometrist-details'.
Values can be one of -
nil - no range. Display all intervals for today.
An ISO date string - display intervals for this date.
A cons cell in the form (BEGIN . END), where BEGIN and END are
ISO date strings (inclusive) or date-time strings (\"BEGIN\"
inclusive, \"END\" exclusive) - display intervals in this
range.")
(make-variable-buffer-local 'chronometrist-details-range)
#+END_SRC
**** iso-date-p :function:
#+BEGIN_SRC emacs-lisp
(defun chronometrist-iso-date-p (string)
(string-match-p
(rx (and string-start
(>= 1 num) "-" (= 2 num) "-" (= 2 num)
string-end))
string))
#+END_SRC
**** intervals-for-range :reader:
This is basically like [[#program-data-structures-events-subset][chronometrist-events-subset]], but returns a list instead of a hash table. Might replace one with the other in the future.
#+BEGIN_SRC emacs-lisp
(defun chronometrist-details-intervals-for-range (range table)
"Return intervals for RANGE from TABLE.
RANGE must be a time range as specified by `chronometrist-details-range'.
TABLE must be a hash table similar to `chronometrist-events'."
(pcase range
('nil
(gethash (format-time-string "%F") table))
((pred stringp)
(gethash range table))
(`(,begin . ,end)
;; `chronometrist-iso-to-ts' also accepts ISO dates
(let ((begin-ts (chronometrist-iso-to-ts begin))
(end-ts (chronometrist-iso-to-ts end)))
(if (and (chronometrist-iso-date-p begin) (chronometrist-iso-date-p end))
(cl-loop while (not (ts> begin-ts end-ts))
append (gethash (ts-format "%F" begin-ts) table)
do (ts-adjustf begin-ts 'day 1))
(cl-loop while (not (ts> begin-ts end-ts))
append
(cl-loop for plist in (gethash (ts-format "%F" begin-ts) table)
when
(let ((start-ts (chronometrist-iso-to-ts (plist-get plist :start)))
(stop-ts (chronometrist-iso-to-ts (plist-get plist :stop))))
(and (ts>= start-ts begin-ts)
(ts<= stop-ts end-ts)))
collect plist)
do (ts-adjustf begin-ts 'day 1)))))))
;; (chronometrist-details-intervals-for-range nil chronometrist-events)
;; (chronometrist-details-intervals-for-range "2021-06-01" chronometrist-events)
;; (chronometrist-details-intervals-for-range '("2021-06-01" . "2021-06-03") chronometrist-events)
;; (chronometrist-details-intervals-for-range '("2021-06-02T01:00+05:30" . "2021-06-02T03:00+05:30") chronometrist-events)
#+END_SRC
**** input-to-value :function:
#+BEGIN_SRC emacs-lisp
(defun chronometrist-details-input-to-value (input)
(pcase input
('nil nil)
(`(,date) date)
(`(,begin ,end)
(let* ((date-p (seq-find #'chronometrist-iso-date-p input))
(begin-date (car (hash-table-keys chronometrist-events)))
(begin-iso-ts (ts-format
"%FT%T%z" (chronometrist-iso-to-ts begin-date)))
(end-date (car (last (hash-table-keys chronometrist-events))))
(end-iso-ts (chronometrist-format-time-iso8601))
(begin (if (equal begin "begin")
(if date-p begin-date begin-iso-ts)
begin))
(end (if (equal end "end")
(if date-p end-date end-iso-ts)
end)))
(cons begin end)))
(_ (error "Unsupported range."))))
#+END_SRC
**** set-range :command:writer:
#+BEGIN_SRC emacs-lisp
(defun chronometrist-details-set-range ()
"Prompt user for range for current `chronometrist-details' buffer."
(interactive)
(let* ((input (completing-read-multiple
(concat "Range (blank, ISO-8601 date, "
"or two ISO-8601 dates/timestamps): ")
(append '("begin" "end")
(reverse (hash-table-keys chronometrist-events)))
nil nil (pcase chronometrist-details-range
('nil nil)
((pred stringp)
(format "%s" chronometrist-details-range))
(`(,begin . ,end)
(format "%s,%s" begin end)))
'chronometrist-details-range-history))
(new-value (chronometrist-details-input-to-value input))
(buffer-name (pcase new-value
(`(,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))))
#+END_SRC
**** filter :variable:
#+BEGIN_SRC emacs-lisp
(defvar chronometrist-details-filter nil
"Parameters to filter intervals displayed by `chronometrist-details'.
Values can be one of -
nil - no filter. Display all intervals in the given time range.
A list of keywords - display intervals containing all given keywords.
A plist - display intervals containing all given keyword-values.
A predicate of one argument (the interval plist) - display all
intervals for which the predicate returns non-nil.")
(make-variable-buffer-local 'chronometrist-details-filter)
#+END_SRC
**** filter-match-p :function:
#+BEGIN_SRC emacs-lisp
(defun chronometrist-details-filter-match-p (plist filter)
"Return PLIST if it matches FILTER.
FILTER must be a filter specifier as described by
`chronometrist-details-filter'."
(cond ((null filter) plist)
((seq-every-p #'keywordp filter)
(when (--every-p (plist-get plist it) filter)
plist))
((chronometrist-plist-p filter)
(when (cl-loop for (keyword value) on filter by #'cddr
always (equal (plist-get plist keyword) value))
plist))
((functionp filter)
(when (funcall filter plist) plist))
(t (error "Invalid filter."))))
#+END_SRC
**** set-filter :command:writer:
#+BEGIN_SRC emacs-lisp
(defun chronometrist-details-set-filter ()
"Prompt user for filter for current `chronometrist-details' buffer."
(interactive)
(let* ((input (read-from-minibuffer
(concat "Filter (blank, a list of keywords, "
"a plist, or a predicate): ")
nil nil nil 'chronometrist-details-filter-history
(pcase chronometrist-details-filter
('nil "")
((pred consp) (format "%S" chronometrist-details-filter)))))
(sexp (ignore-errors (read input))))
(cond ((equal input "") (setq-local chronometrist-details-filter nil))
((consp sexp) (setq-local chronometrist-details-filter sexp))
(_ (error "Unsupported filter.")))
(tabulated-list-revert)))
#+END_SRC
**** intervals :function:
#+BEGIN_SRC emacs-lisp
(defun chronometrist-details-intervals (range filter table)
"Return plists matching RANGE and FILTER from TABLE.
For values of RANGE, see `chronometrist-details-range'. For
values of FILTER, see `chronometrist-details-filter'. TABLE must
be a hash table similar to `chronometrist-events'."
(cl-loop for plist in (chronometrist-details-intervals-for-range range table)
when (chronometrist-details-filter-match-p plist filter)
collect plist))
#+END_SRC
** Provide
#+BEGIN_SRC emacs-lisp
(provide 'chronometrist)
;;; chronometrist.el ends here
#+END_SRC
** Local variables :NOEXPORT:
# Local Variables:
# nameless-aliases: (("cb" . "chronometrist-backend") ("c" . "chronometrist"))
# End:
Reference in New Issue View Git Blame Copy Permalink