Compare commits

..

14 Commits
dev ... hydra

Author SHA1 Message Date
contrapunctus c27ac66a30 feat - tag prompt using choice.el 2021-02-10 12:53:24 +05:30
contrapunctus b219876378 Merge branch 'dev' into hydra 2021-02-09 01:46:11 +05:30
contrapunctus 930874c348 (WIP) store keys in hints; refine prompt types; design defchoice macro 2021-01-15 06:23:39 +05:30
contrapunctus 04aba37f02 Use global variable to pass state to macro 2021-01-14 19:16:06 +05:30
contrapunctus 32a04ece59 (WIP) remove hydra code, try to use a keymap for `read-key-sequence` 2021-01-14 01:35:08 +05:30
contrapunctus da8e940daa Make ad-hoc Hydra replacement which "blocks" 2021-01-12 18:25:42 +05:30
contrapunctus 5012298627 Handle empty history situations 2021-01-12 00:45:36 +05:30
contrapunctus 815421ade5 Let users decide if they want tag/key history as combinations or not 2021-01-11 12:54:07 +05:30
contrapunctus 2049e43597 tags-add - update call site to match new signature 2021-01-11 06:20:25 +05:30
contrapunctus 4c03d58d3d Make functions suitable for putting into hooks 2021-01-11 03:57:38 +05:30
contrapunctus 381abdaa2c Insert tags as a plist 2021-01-11 03:18:21 +05:30
contrapunctus c32ced5ac6 chronometrist-append-to-last -> chronometrist-plist-update
It now makes no changes to the file, and only accepts two plists
instead of a tag list and a plist.
2021-01-10 23:50:09 +05:30
contrapunctus d353075285 Use a macro instead of `eval` 2021-01-10 16:48:09 +05:30
contrapunctus 657dced732 Create a Hydra prompt for tags, keys, and values 2021-01-10 13:00:09 +05:30
52 changed files with 5111 additions and 17955 deletions

View File

@ -1,26 +1,16 @@
;;; Directory Local Variables
;;; For more information see (info "(emacs) Directory Variables")
;; for some reason, setting `nameless-current-name' to "chronometrist"
;; makes all aliases not take effect - probably specific to Org
;; literate programs
((nil . ((nameless-aliases . (("cb" . "chronometrist-backend")
("cc" . "chronometrist-common")
("cd" . "chronometrist-details")
("ce" . "chronometrist-events")
("ck" . "chronometrist-key-values")
("cm" . "chronometrist-migrate")
("cp" . "chronometrist-plist-pp")
("cr" . "chronometrist-report")
("cs" . "chronometrist-statistics")
("cx" . "chronometrist-sexp")
("c" . "chronometrist")))
(sentence-end-double-space . t)))
(org-mode
. ((org-html-self-link-headlines . t)
(eval . (org-indent-mode))
(org-html-head
. (concat "<link rel=\"stylesheet\" "
"type=\"text/css\" "
"href=\"../org-doom-molokai.css\" />"))
(org-babel-tangle-use-relative-file-links . t))))
((emacs-lisp-mode . ((nameless-aliases . (("cc" . "chronometrist-common")
("cd" . "chronometrist-diary")
("ce" . "chronometrist-events")
("ck" . "chronometrist-kv")
("cm" . "chronometrist-migrate")
("cp" . "chronometrist-plist-pp")
("cr" . "chronometrist-report")
("cs" . "chronometrist-statistics")
("cx" . "chronometrist-sexp")
("c" . "chronometrist")))
(outline-regexp . ";;;+ ")))
(dired-mode . ((dired-omit-mode . t)
(dired-omit-extensions . (".html" ".texi")))))

View File

@ -4,78 +4,7 @@ All notable changes to this project will be documented in this file.
The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/),
and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0.html).
## unreleased
### Added
1. `chronometrist-third`, an extension to add support for the [Third Time](https://www.lesswrong.com/posts/RWu8eZqbwgB9zaerh/third-time-a-better-way-to-work) system.
2. New custom variable `chronometrist-key-value-preset-alist`, to define completion suggestions in advance.
3. New custom variable `chronometrist-key-value-use-database-history`, to control whether database history is used for key-value suggestions.
## [0.10.0] - 2022-02-15
### Changed
1. The value of `chronometrist-file` must now be a file path _without extension._ Please update your configurations.
2. The existing file format used by Chronometrist is now called the `plist` format.
3. The extension for files in the `plist` format is now `.plist`. Update the extension of your file to use it with the `plist` backend.
### Added
1. Multiple backend support - new custom variable `chronometrist-active-backend` to determine active backend, new command `chronometrist-switch-backend` to temporarily select a backend (with completion).
2. New `plist-group` backend, reducing time taken in startup and after changes to the file.
3. Unified migration interface with command `chronometrist-migrate`.
4. New custom variable `chronometrist-task-list`, to add/hide tasks without modifying the database. Setting it also disables generation of the task list from the database, speeding up many operations.
5. New command `chronometrist-discard-active`, to discard the active interval.
6. Debug logging messages - to view them, set `chronometrist-debug-enable`.
### Fixed
1. Code to detect the type of change made to the file has been rewritten, hopefully fixing some uncommon `read` errors and `args out of range` errors.
### Deprecated
1. The plist backend is deprecated and may be removed in a future release. The `plist-group` backend is more performant and extensible - please use `chronometrist-migrate` to convert your data to the `plist-group` backend.
## [0.9.0] - 2021-07-08
### Added
1. New commands `chronometrist-restart-task`, `chronometrist-extend-task`
2. Menus for `chronometrist`, `chronometrist-key-values`, and `chronometrist-details`
3. Custom ranges and filters for `chronometrist-details`. See command `chronometrist-details-set-range` and `chronometrist-details-set-filter`.
### Changed
4. Display graph ranges in `chronometrist-spark` column
5. `chronometrist-tags-add` and `chronometrist-key-values-unified-prompt` now also work interactively.
## [0.8.1] - 2021-06-01
### Changed
1. Distribute a tangled Elisp file as well as the literate program. Autoloads now work as usual.
## [0.8.0] - 2021-05-31
### Added
1. New frontend `chronometrist-details`, to display time intervals in a tabular format.
2. New extension `chronometrist-spark`, to display sparklines in the chronometrist buffer.
3. `chronometrist-schema`, custom variable used to define `tabulated-list-format`
### Changed
4. Renames -
* `chronometrist-list-format-transformers``chronometrist-schema-transformers`
* `chronometrist-entry-transformers``chronometrist-row-transformers`
5. Hooks now use `defcustom` instead of `defvar`.
### Fixed
6. error when launching `chronometrist-statistics`
## [0.7.2] - 2021-05-18
### Changed
* If `chronometrist-file` is being edited, `chronometrist-timer` will not refresh the buffer or run `chronometrist-timer-hook`, preventing errors resulting from `read`ing of incomplete data and easing editing of the file.
## [0.7.1] - 2021-05-14
### Added
* key-values - `chronometrist-key-values-unified-prompt`, which uses `completing-read`. A more streamlined way to enter key-values, for those comfortable with entering/editing s-expressions directly.
### Removed
* key-values - all `choice.el`-based prompts have been removed.
## [0.7.0] - 2021-05-07
### Added
* Single key prompts for key-values - `chronometrist-tag-choice`, and `chronometrist-key-values-unified-choice`, with more to come.
* `chronometrist-reset`, to clear all internal state
### Changed
* `chronometrist` is now a literate Org program.
### Removed
* `chronometrist-skip-query-prompt`, `chronometrist-skip-query-reset`, and `chronometrist--skip-detail-prompts` - these are covered by the new single key prompt functions
## [0.6.5] - 2021-02-11
## [Unreleased]
### Added
* Major mode (syntax highlighting, hook) for Chronometrist s-expression files, derived from emacs-lisp-mode
### Fixed

25
Cask Normal file
View File

@ -0,0 +1,25 @@
(source gnu)
(source melpa)
(package
"Chronometrist"
"0.6.4"
"A time tracker for Emacs with a nice interface")
(depends-on "cl-lib")
(depends-on "dash" "2.16.0")
(depends-on "seq" "2.20")
(depends-on "s" "1.12.0")
(depends-on "ts" "0.2")
(depends-on "anaphora" "1.0.4")
(depends-on "choice" "0.1.0")
(files "elisp/*.el")
(development
(depends-on "f")
(depends-on "ecukes")
(depends-on "ert-runner")
(depends-on "el-mock")
(depends-on "elsa")
(depends-on "buttercup"))

View File

@ -1,82 +0,0 @@
.phony: all setup tangle compile lint
all: clean-elc manual.md setup tangle compile lint
setup:
emacs --batch --eval="(package-initialize)" \
--eval="(mapcar #'package-install '(indent-lint package-lint relint))"
manual.md:
emacs -q -Q --batch --eval="(require 'ox-md)" \
"manual.org" -f 'org-md-export-to-markdown'
# No -q or -Q without ORG_PATH - if the user has a newer version of
# Org, we want to use it.
tangle:
cd elisp/ && \
emacs --batch \
--eval="(progn (package-initialize) (require 'ob-tangle))" \
--eval='(org-babel-tangle-file "chronometrist.org")' \
--eval='(org-babel-tangle-file "chronometrist-key-values.org")' \
--eval='(org-babel-tangle-file "chronometrist-spark.org")' \
--eval='(org-babel-tangle-file "chronometrist-third.org")' \
--eval='(org-babel-tangle-file "chronometrist-sqlite.org")' ; \
cd ..
compile: tangle
cd elisp/ && \
emacs --batch \
--eval="(progn (package-initialize) (require 'dash) (require 'ts))" \
--eval='(byte-compile-file "chronometrist.el")' \
--eval='(byte-compile-file "chronometrist-key-values.el")' \
--eval='(byte-compile-file "chronometrist-spark.el")' \
--eval='(byte-compile-file "chronometrist-third.el")' \
--eval='(byte-compile-file "chronometrist-sqlite.el")' ; \
cd ..
lint-check-declare: tangle
cd elisp/ && \
emacs -q --batch \
--eval='(check-declare-file "chronometrist.el")' \
--eval='(check-declare-file "chronometrist-key-values.el")' \
--eval='(check-declare-file "chronometrist-spark.el")' \
--eval='(check-declare-file "chronometrist-third.el")' \
--eval='(check-declare-file "chronometrist-sqlite.el")' ; \
cd ..
lint-checkdoc: tangle
cd elisp/ && \
emacs -q -Q --batch \
--eval='(checkdoc-file "chronometrist.el")' \
--eval='(checkdoc-file "chronometrist-key-values.el")' \
--eval='(checkdoc-file "chronometrist-spark.el")' \
--eval='(checkdoc-file "chronometrist-third.el")' \
--eval='(checkdoc-file "chronometrist-sqlite.el")' ; \
cd ..
lint-package-lint: setup tangle
cd elisp/ && \
emacs --batch \
--eval="(progn (package-initialize) (require 'dash) (require 'ts) (require 'package-lint))" \
-f 'package-lint-batch-and-exit' chronometrist.el \
-f 'package-lint-batch-and-exit' chronometrist-key-values.el \
-f 'package-lint-batch-and-exit' chronometrist-spark.el \
-f 'package-lint-batch-and-exit' chronometrist-third.el \
-f 'package-lint-batch-and-exit' chronometrist-sqlite.el ; \
cd ..
lint-relint: setup tangle
cd elisp/ && \
emacs --batch \
--eval="(progn (package-initialize) (require 'relint))" \
--eval='(relint-file "chronometrist.el")' \
--eval='(relint-file "chronometrist-key-values.el")' \
--eval='(relint-file "chronometrist-spark.el")' \
--eval='(relint-file "chronometrist-third.el")' \
--eval='(relint-file "chronometrist-sqlite.el")' ; \
cd ..
lint: lint-check-declare lint-checkdoc lint-package-lint lint-relint
clean-elc:
rm elisp/*.elc

225
README.md Normal file
View File

@ -0,0 +1,225 @@
[![MELPA](https://melpa.org/packages/chronometrist-badge.svg)](https://melpa.org/#/chronometrist)
# chronometrist
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.
**IMPORTANT: with version v0.3, chronometrist no longer uses timeclock as a dependency and will use its own s-expression-based backend. A command to migrate the timeclock-file, `chronometrist-migrate-timelog-file->sexp-file`, is provided.**
## 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 (see [Hooks](#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.
## Installation
### MELPA
1. Set up MELPA - https://melpa.org/#/getting-started
(Chronometrist uses semantic versioning and only releases are pushed to the master branch, so using MELPA Stable is recommended and has no effect on frequency of updates.)
2. `M-x package-install RET chronometrist RET`
### Git
You can get `chronometrist` from https://github.com/contrapunctus-1/chronometrist
`chronometrist` requires
* Emacs v26 or higher
* [dash.el](https://github.com/magnars/dash.el)
* [s.el](https://github.com/magnars/s.el)
* [ts.el](https://github.com/alphapapa/ts.el)
* [anaphora](https://github.com/rolandwalker/anaphora)
Add the "elisp/" subdirectory to your load-path, and `(require 'chronometrist)`.
## Usage
In the buffers created by the following three commands, you can press `l` (`chronometrist-open-log`) to view/edit your `chronometrist-file`, which by default is `~/.emacs.d/chronometrist.sexp`.
All of these commands will kill their buffer when run again with the buffer visible, so the keys you bind them to behave as a toggle.
### chronometrist
Run `M-x chronometrist` to see your projects, the time you spent on them today, which one is active, and the total time clocked today.
Hit `RET` (`chronometrist-toggle-task`) on a project to start tracking time for it. If it's already clocked in, it will be clocked out. This command runs some [hooks](#Hooks), which are useful for a wide range of functionality (see [Adding more information](#adding-more-information-experimental) below). In some cases, you may want to skip running the hooks - use `M-RET` (`chronometrist-toggle-task-no-hooks`) to do that.
You can also hit `<numeric prefix> RET` anywhere in the buffer to toggle the corresponding project, e.g. `C-1 RET` will toggle the project with index 1.
Press `r` to see a weekly report (see `chronometrist-report`)
`chronometrist` keeps itself updated via an idle timer - no need to frequently press `g` to update.
### chronometrist-report
Run `M-x chronometrist-report` (or `chronometrist` with a prefix argument of 1, or press `r` in the `chronometrist` buffer) to see a weekly report.
Press `b` to look at past weeks, and `f` for future weeks.
`chronometrist-report` keeps itself updated via an idle timer - no pressing `g` to update.
### chronometrist-statistics
Run `M-x chronometrist-statistics` (or `chronometrist` with a prefix argument of 2) to view statistics.
Press `b` to look at past time ranges, and `f` for future ones.
### Attaching tags and key values
Part of the reason Chronometrist stores time intervals as property lists is to allow you to add tags and arbitrary key-values to them.
#### Tags
To be prompted for tags, add `chronometrist-tags-add` to any hook except `chronometrist-before-in-functions`, based on your preference (see [Hooks](#Hooks)). The prompt suggests past combinations you used for the current task, which you can browse with `M-p`/`M-n`. You can leave it blank by pressing `RET`, or skip the prompt just this once by pressing `M-RET` (`chronometrist-toggle-task-no-hooks`).
#### Key-value pairs
Similarly, to be prompted for key-values, add `chronometrist-kv-add` to any hook except `chronometrist-before-in-functions`. To exit the prompt, press the key it indicates for quitting - you can then edit the resulting key-values by hand if required. Press `C-c C-c` to accept the key-values, or `C-c C-k` to cancel.
#### Quick re-use of last-used tags and/or key-values
Add `chronometrist-skip-query-prompt` to the hook(s) containing `chronometrist-tags-add`/`chronometrist-kv-add`, _before_ these functions, and `chronometrist-skip-query-reset` _after_ them -
```elisp
(setq chronometrist-before-out-functions '(chronometrist-skip-query-prompt
chronometrist-tags-add
chronometrist-kv-add
chronometrist-skip-query-reset))
```
### Prompt when exiting Emacs
If you wish to be prompted when you exit Emacs while tracking time, you can use this -
`(add-hook 'kill-emacs-query-functions 'chronometrist-query-stop)`
### Time goals/targets
If you wish you could define time goals for some tasks, and have Chronometrist notify you when you're approaching the goal, completing it, or exceeding it, check out the extension [chronometrist-goal.el](https://github.com/contrapunctus-1/chronometrist-goal/).
## Customization
See the Customize groups `chronometrist` and `chronometrist-report` for variables intended to be user-customizable.
### Hooks
Chronometrist currently has the following hooks -
1. `chronometrist-mode-hook`
2. `chronometrist-before-in-functions`
3. `chronometrist-after-in-functions`
4. `chronometrist-before-out-functions`
5. `chronometrist-after-out-functions`
6. `chronometrist-list-format-transformers`
7. `chronometrist-entry-transformers`
8. `chronometrist-file-change-hook`
The hooks whose names end with `-functions` are abnormal hooks - each function must accept exactly one argument, which is the name of the project which is being started or stopped, as a string.
`chronometrist-before-out-functions` is different from the other three, in that it runs until failure - the task will be clocked out only if all functions in this hook return `t`.
### Opening certain files when you start a task
An idea from the author's own init -
```elisp
(defun my-start-project (project)
(pcase project
("Guitar"
(find-file-other-window "~/repertoire.org"))
;; ...
))
(add-hook 'chronometrist-before-in-functions 'my-start-project)
```
### Reminding you to commit your changes
Another one, prompting the user if they have uncommitted changes in a git repository (assuming they use [Magit](https://magit.vc/)) -
```elisp
(autoload 'magit-anything-modified-p "magit")
(defun my-commit-prompt ()
"Prompt user if `default-directory' is a dirty Git repository.
Return t if the user answers yes, if the repository is clean, or
if there is no Git repository.
Return nil (and run `magit-status') if the user answers no."
(cond ((not (magit-anything-modified-p)) t)
((yes-or-no-p
(format "You have uncommitted changes in %S. Really clock out? "
default-directory)) t)
(t (magit-status) nil)))
(add-hook 'chronometrist-before-out-functions 'my-commit-prompt)
```
### Displaying the current time interval in the activity indicator
```elisp
(defun my-activity-indicator ()
(thread-last (plist-put (chronometrist-last)
:stop (chronometrist-format-time-iso8601))
list
chronometrist-events->ts-pairs
chronometrist-ts-pairs->durations
(-reduce #'+)
truncate
chronometrist-format-time))
(setq chronometrist-activity-indicator 'my-activity-indicator)
```
## Roadmap/Ideas
* Show details for time spent on a project when clicking on a non-zero "time spent" field (in both Chronometrist and Chronometrist-Report buffers).
### chronometrist
1. Use `make-thread` in v26 or the emacs-async library for `chronometrist-entries`/`chronometrist-report-entries`
2. Some way to update buffers every second without making Emacs unusable. (impossible?)
3. "Day summary" - for users who use the "reason" feature to note the specifics of their actual work. Combine the reasons together to create a descriptive overview of the work done in the day.
### chronometrist-statistics
1. Show range counter and max ranges; don't scroll past first/last time ranges
2. activity-specific - average time spent in $TIMEPERIOD, average days worked on in $TIMEPERIOD, current/longest/last streak, % of $TIMEPERIOD, % of active (tracked) time in $TIMEPERIOD, ...
3. general - most productive $TIMEPERIOD, GitHub-style work heatmap calendar, ...
4. press 1 for weekly stats, 2 for monthly, 3 for yearly
### Miscellaneous
1. README - add images
2. [-] Create test timelog file and UI behaviour tests
3. Use for `chronometrist-report-weekday-number-alist` whatever variables like `initial-frame-alist` use to get that fancy Custom UI for alists.
4. Multi-timelog-file support?
5. [inflatable raptor](https://github.com/MichaelMure/git-bug/#planned-features)
## Contributions and contact
Feedback and MRs are very welcome. 🙂
* [TODO.org](TODO.org) has a long list of tasks
* [doc/manual.org](doc/manual.org) contains an overview of the codebase, explains various mechanisms and decisions, and has a reference of definitions.
If you have tried using Chronometrist, I'd love to hear your experiences! Get in touch with the author and other Emacs users in the Emacs channel on the Jabber network - [xmpp:emacs@salas.suchat.org?join](https://conversations.im/j/emacs@salas.suchat.org) ([web chat](https://inverse.chat/#converse/room?jid=emacs@salas.suchat.org))
(For help in getting started with Jabber, [click here](https://xmpp.org/getting-started/))
## License
I dream of a world where all software is liberated - transparent, trustable, and accessible for anyone to use or improve. But I don't want to make demands or threats (e.g. via legal conditions) to get there.
I'd rather make a request - please do everything you can to help that dream come true. Please Unlicense as much software as you can.
Chronometrist is released under your choice of [Unlicense](https://unlicense.org/) or the [WTFPL](http://www.wtfpl.net/).
(See files [UNLICENSE](UNLICENSE) and [WTFPL](WTFPL)).
## Thanks
wasamasa, bpalmer, aidalgol, pjb and the rest of #emacs for their tireless help and support
jwiegley for timeclock.el, which we used as a backend in earlier versions
blandest for helping me with the name
fiete and wu-lee for testing and bug reports

View File

@ -1 +0,0 @@
manual.org

1046
TODO.org

File diff suppressed because it is too large Load Diff

360
chronometrist-tests.el Normal file
View File

@ -0,0 +1,360 @@
;;; chronometrist-tests.el --- Tests for Chronometrist -*- lexical-binding: t; -*-
;; This is free and unencumbered software released into the public domain.
;;
;; Anyone is free to copy, modify, publish, use, compile, sell, or
;; distribute this software, either in source code form or as a compiled
;; binary, for any purpose, commercial or non-commercial, and by any
;; means.
;;
;; For more information, please refer to <https://unlicense.org>
;;; Commentary:
;; These should be replaced by buttercup tests, which have a nicer
;; syntax.
(require 'ert)
(require 'chronometrist)
(require 'chronometrist-report)
;; TODO - add tests for chronometrist-task-time-one-day with custom day start
;; times.
;; #### CHRONOMETRIST-REPORT ####
;;; Code:
(defun interval-test (start target)
"Basic logic used to derive 'gap' in `chronometrist-previous-week-start'."
(cond ((= start target) 7)
((> start target) (- start target))
((< start target) (+ start (- 7 target)))))
(ert-deftest chronometrist-interval-test-0 ()
(should (= (interval-test 0 0) 7))
(should (= (interval-test 0 1) 6))
(should (= (interval-test 0 2) 5))
(should (= (interval-test 0 3) 4))
(should (= (interval-test 0 4) 3))
(should (= (interval-test 0 5) 2))
(should (= (interval-test 0 6) 1)))
(ert-deftest chronometrist-interval-test-1 ()
(should (= (interval-test 1 0) 1))
(should (= (interval-test 1 1) 7))
(should (= (interval-test 1 2) 6))
(should (= (interval-test 1 3) 5))
(should (= (interval-test 1 4) 4))
(should (= (interval-test 1 5) 3))
(should (= (interval-test 1 6) 2)))
(ert-deftest chronometrist-interval-test-2 ()
(should (= (interval-test 2 0) 2))
(should (= (interval-test 2 1) 1))
(should (= (interval-test 2 2) 7))
(should (= (interval-test 2 3) 6))
(should (= (interval-test 2 4) 5))
(should (= (interval-test 2 5) 4))
(should (= (interval-test 2 6) 3)))
(ert-deftest chronometrist-interval-test-3 ()
(should (= (interval-test 3 0) 3))
(should (= (interval-test 3 1) 2))
(should (= (interval-test 3 2) 1))
(should (= (interval-test 3 3) 7))
(should (= (interval-test 3 4) 6))
(should (= (interval-test 3 5) 5))
(should (= (interval-test 3 6) 4)))
(ert-deftest chronometrist-interval-test-4 ()
(should (= (interval-test 4 0) 4))
(should (= (interval-test 4 1) 3))
(should (= (interval-test 4 2) 2))
(should (= (interval-test 4 3) 1))
(should (= (interval-test 4 4) 7))
(should (= (interval-test 4 5) 6))
(should (= (interval-test 4 6) 5)))
(ert-deftest chronometrist-interval-test-5 ()
(should (= (interval-test 5 0) 5))
(should (= (interval-test 5 1) 4))
(should (= (interval-test 5 2) 3))
(should (= (interval-test 5 3) 2))
(should (= (interval-test 5 4) 1))
(should (= (interval-test 5 5) 7))
(should (= (interval-test 5 6) 6)))
(ert-deftest chronometrist-interval-test-6 ()
(should (= (interval-test 6 0) 6))
(should (= (interval-test 6 1) 5))
(should (= (interval-test 6 2) 4))
(should (= (interval-test 6 3) 3))
(should (= (interval-test 6 4) 2))
(should (= (interval-test 6 5) 1))
(should (= (interval-test 6 6) 7)))
(ert-deftest chronometrist-previous-week-start-sunday ()
"Tests for `chronometrist-previous-week-start'."
(let ((chronometrist-report-week-start-day "Sunday"))
(should (equal (chronometrist-previous-week-start '(0 0 0 1 9 2018 6 nil 19800))
'(0 0 0 26 8 2018 0 nil 19800)))
(should (equal (chronometrist-previous-week-start '(0 0 0 2 9 2018 0 nil 19800))
'(0 0 0 2 9 2018 0 nil 19800)))
(should (equal (chronometrist-previous-week-start '(0 0 0 3 9 2018 1 nil 19800))
'(0 0 0 2 9 2018 0 nil 19800)))
(should (equal (chronometrist-previous-week-start '(0 0 0 4 9 2018 2 nil 19800))
'(0 0 0 2 9 2018 0 nil 19800)))
(should (equal (chronometrist-previous-week-start '(0 0 0 5 9 2018 3 nil 19800))
'(0 0 0 2 9 2018 0 nil 19800)))
(should (equal (chronometrist-previous-week-start '(0 0 0 6 9 2018 4 nil 19800))
'(0 0 0 2 9 2018 0 nil 19800)))
(should (equal (chronometrist-previous-week-start '(0 0 0 7 9 2018 5 nil 19800))
'(0 0 0 2 9 2018 0 nil 19800)))
(should (equal (chronometrist-previous-week-start '(0 0 0 8 9 2018 6 nil 19800))
'(0 0 0 2 9 2018 0 nil 19800)))))
(ert-deftest chronometrist-previous-week-start-monday ()
"Tests for `chronometrist-previous-week-start'."
(let ((chronometrist-report-week-start-day "Monday"))
(should (equal (chronometrist-previous-week-start '(0 0 0 1 9 2018 6 nil 19800))
'(0 0 0 27 8 2018 1 nil 19800)))
(should (equal (chronometrist-previous-week-start '(0 0 0 2 9 2018 0 nil 19800))
'(0 0 0 27 8 2018 1 nil 19800)))
(should (equal (chronometrist-previous-week-start '(0 0 0 3 9 2018 1 nil 19800))
'(0 0 0 3 9 2018 1 nil 19800)))
(should (equal (chronometrist-previous-week-start '(0 0 0 4 9 2018 2 nil 19800))
'(0 0 0 3 9 2018 1 nil 19800)))
(should (equal (chronometrist-previous-week-start '(0 0 0 5 9 2018 3 nil 19800))
'(0 0 0 3 9 2018 1 nil 19800)))
(should (equal (chronometrist-previous-week-start '(0 0 0 6 9 2018 4 nil 19800))
'(0 0 0 3 9 2018 1 nil 19800)))
(should (equal (chronometrist-previous-week-start '(0 0 0 7 9 2018 5 nil 19800))
'(0 0 0 3 9 2018 1 nil 19800)))
(should (equal (chronometrist-previous-week-start '(0 0 0 8 9 2018 6 nil 19800))
'(0 0 0 3 9 2018 1 nil 19800)))))
(ert-deftest chronometrist-previous-week-start-tuesday ()
"Tests for `chronometrist-previous-week-start'."
(let ((chronometrist-report-week-start-day "Tuesday"))
(should (equal (chronometrist-previous-week-start '(0 0 0 1 9 2018 6 nil 19800))
'(0 0 0 28 8 2018 2 nil 19800)))
(should (equal (chronometrist-previous-week-start '(0 0 0 2 9 2018 0 nil 19800))
'(0 0 0 28 8 2018 2 nil 19800)))
(should (equal (chronometrist-previous-week-start '(0 0 0 3 9 2018 1 nil 19800))
'(0 0 0 28 8 2018 2 nil 19800)))
(should (equal (chronometrist-previous-week-start '(0 0 0 4 9 2018 2 nil 19800))
'(0 0 0 4 9 2018 2 nil 19800)))
(should (equal (chronometrist-previous-week-start '(0 0 0 5 9 2018 3 nil 19800))
'(0 0 0 4 9 2018 2 nil 19800)))
(should (equal (chronometrist-previous-week-start '(0 0 0 6 9 2018 4 nil 19800))
'(0 0 0 4 9 2018 2 nil 19800)))
(should (equal (chronometrist-previous-week-start '(0 0 0 7 9 2018 5 nil 19800))
'(0 0 0 4 9 2018 2 nil 19800)))
(should (equal (chronometrist-previous-week-start '(0 0 0 8 9 2018 6 nil 19800))
'(0 0 0 4 9 2018 2 nil 19800)))))
(ert-deftest chronometrist-previous-week-start-wednesday ()
"Tests for `chronometrist-previous-week-start'."
(let ((chronometrist-report-week-start-day "Wednesday"))
(should (equal (chronometrist-previous-week-start '(0 0 0 1 9 2018 6 nil 19800))
'(0 0 0 29 8 2018 3 nil 19800)))
(should (equal (chronometrist-previous-week-start '(0 0 0 2 9 2018 0 nil 19800))
'(0 0 0 29 8 2018 3 nil 19800)))
(should (equal (chronometrist-previous-week-start '(0 0 0 3 9 2018 1 nil 19800))
'(0 0 0 29 8 2018 3 nil 19800)))
(should (equal (chronometrist-previous-week-start '(0 0 0 4 9 2018 2 nil 19800))
'(0 0 0 29 8 2018 3 nil 19800)))
(should (equal (chronometrist-previous-week-start '(0 0 0 5 9 2018 3 nil 19800))
'(0 0 0 5 9 2018 3 nil 19800)))
(should (equal (chronometrist-previous-week-start '(0 0 0 6 9 2018 4 nil 19800))
'(0 0 0 5 9 2018 3 nil 19800)))
(should (equal (chronometrist-previous-week-start '(0 0 0 7 9 2018 5 nil 19800))
'(0 0 0 5 9 2018 3 nil 19800)))
(should (equal (chronometrist-previous-week-start '(0 0 0 8 9 2018 6 nil 19800))
'(0 0 0 5 9 2018 3 nil 19800)))))
(ert-deftest chronometrist-previous-week-start-thursday ()
"Tests for `chronometrist-previous-week-start'."
(let ((chronometrist-report-week-start-day "Thursday"))
(should (equal (chronometrist-previous-week-start '(0 0 0 1 9 2018 6 nil 19800))
'(0 0 0 30 8 2018 4 nil 19800)))
(should (equal (chronometrist-previous-week-start '(0 0 0 2 9 2018 0 nil 19800))
'(0 0 0 30 8 2018 4 nil 19800)))
(should (equal (chronometrist-previous-week-start '(0 0 0 3 9 2018 1 nil 19800))
'(0 0 0 30 8 2018 4 nil 19800)))
(should (equal (chronometrist-previous-week-start '(0 0 0 4 9 2018 2 nil 19800))
'(0 0 0 30 8 2018 4 nil 19800)))
(should (equal (chronometrist-previous-week-start '(0 0 0 5 9 2018 3 nil 19800))
'(0 0 0 30 8 2018 4 nil 19800)))
(should (equal (chronometrist-previous-week-start '(0 0 0 6 9 2018 4 nil 19800))
'(0 0 0 6 9 2018 4 nil 19800)))
(should (equal (chronometrist-previous-week-start '(0 0 0 7 9 2018 5 nil 19800))
'(0 0 0 6 9 2018 4 nil 19800)))
(should (equal (chronometrist-previous-week-start '(0 0 0 8 9 2018 6 nil 19800))
'(0 0 0 6 9 2018 4 nil 19800)))))
(ert-deftest chronometrist-previous-week-start-friday ()
"Tests for `chronometrist-previous-week-start'."
(let ((chronometrist-report-week-start-day "Friday"))
(should (equal (chronometrist-previous-week-start '(0 0 0 1 9 2018 6 nil 19800))
'(0 0 0 31 8 2018 5 nil 19800)))
(should (equal (chronometrist-previous-week-start '(0 0 0 2 9 2018 0 nil 19800))
'(0 0 0 31 8 2018 5 nil 19800)))
(should (equal (chronometrist-previous-week-start '(0 0 0 3 9 2018 1 nil 19800))
'(0 0 0 31 8 2018 5 nil 19800)))
(should (equal (chronometrist-previous-week-start '(0 0 0 4 9 2018 2 nil 19800))
'(0 0 0 31 8 2018 5 nil 19800)))
(should (equal (chronometrist-previous-week-start '(0 0 0 5 9 2018 3 nil 19800))
'(0 0 0 31 8 2018 5 nil 19800)))
(should (equal (chronometrist-previous-week-start '(0 0 0 6 9 2018 4 nil 19800))
'(0 0 0 31 8 2018 5 nil 19800)))
(should (equal (chronometrist-previous-week-start '(0 0 0 7 9 2018 5 nil 19800))
'(0 0 0 7 9 2018 5 nil 19800)))
(should (equal (chronometrist-previous-week-start '(0 0 0 8 9 2018 6 nil 19800))
'(0 0 0 7 9 2018 5 nil 19800)))))
(ert-deftest chronometrist-previous-week-start-saturday ()
"Tests for `chronometrist-previous-week-start'."
(let ((chronometrist-report-week-start-day "Saturday"))
(should (equal (chronometrist-previous-week-start '(0 0 0 30 8 2018 4 nil 19800))
'(0 0 0 25 8 2018 6 nil 19800)))
(should (equal (chronometrist-previous-week-start '(0 0 0 31 8 2018 5 nil 19800))
'(0 0 0 25 8 2018 6 nil 19800)))
(should (equal (chronometrist-previous-week-start '(0 0 0 2 9 2018 0 nil 19800))
'(0 0 0 1 9 2018 6 nil 19800)))
(should (equal (chronometrist-previous-week-start '(0 0 0 3 9 2018 1 nil 19800))
'(0 0 0 1 9 2018 6 nil 19800)))
(should (equal (chronometrist-previous-week-start '(0 0 0 4 9 2018 2 nil 19800))
'(0 0 0 1 9 2018 6 nil 19800)))
(should (equal (chronometrist-previous-week-start '(0 0 0 5 9 2018 3 nil 19800))
'(0 0 0 1 9 2018 6 nil 19800)))
(should (equal (chronometrist-previous-week-start '(0 0 0 6 9 2018 4 nil 19800))
'(0 0 0 1 9 2018 6 nil 19800)))
(should (equal (chronometrist-previous-week-start '(0 0 0 7 9 2018 5 nil 19800))
'(0 0 0 1 9 2018 6 nil 19800)))
(should (equal (chronometrist-previous-week-start '(0 0 0 8 9 2018 6 nil 19800))
'(0 0 0 8 9 2018 6 nil 19800)))))
;; #### CHRONOMETRIST-COMMON ####
(ert-deftest chronometrist-ptod-tests ()
"Tests for `chronometrist-task-time-one-day'."
(let ((timeclock-file "test.timelog"))
(timeclock-reread-log)
;; basic 1 hour test
(should (equal (chronometrist-task-time-one-day "Programming" '(0 0 0 1 1 2018))
[1 0 0]))
(should (equal (chronometrist-task-time-one-day "Swimming" '(0 0 0 1 1 2018))
[1 0 0]))
(should (equal (chronometrist-task-time-one-day "Cooking" '(0 0 0 1 1 2018))
[1 0 0]))
(should (equal (chronometrist-task-time-one-day "Guitar" '(0 0 0 1 1 2018))
[1 0 0]))
(should (equal (chronometrist-task-time-one-day "Cycling" '(0 0 0 1 1 2018))
[1 0 0]))
;; across midnight
(should (equal (chronometrist-task-time-one-day "Programming" '(0 0 0 2 1 2018))
[1 0 0]))
(should (equal (chronometrist-task-time-one-day "Programming" '(0 0 0 3 1 2018))
[1 0 0]))))
(ert-deftest chronometrist-ptod-midnight-clocked-in ()
"Tests for `chronometrist-task-time-one-day' behaviour
across midnight + when not clocked out."
:expected-result :failed
(let ((timeclock-file "test2.timelog"))
(timeclock-reread-log)
(should (equal (chronometrist-task-time-one-day "Test" '(0 0 0 1 1 2018))
[1 0 0]))
(should (equal (chronometrist-task-time-one-day "Test" '(0 0 0 2 1 2018))
[24 0 0]))))
;; #### CHRONOMETRIST ####
(ert-deftest chronometrist-seconds-to-hms-tests ()
"Tests for `chronometrist-seconds-to-hms'."
(should (equal (chronometrist-seconds-to-hms 1)
[0 0 1]))
(should (equal (chronometrist-seconds-to-hms 60)
[0 1 0]))
(should (equal (chronometrist-seconds-to-hms 61)
[0 1 1]))
(should (equal (chronometrist-seconds-to-hms 3600)
[1 0 0]))
(should (equal (chronometrist-seconds-to-hms 3660)
[1 1 0]))
(should (equal (chronometrist-seconds-to-hms 3661)
[1 1 1])))
(ert-deftest chronometrist-time-add-tests ()
"Tests for `chronometrist-time-add'."
(should (equal (chronometrist-time-add [0 0 0] [0 0 0])
[0 0 0]))
(should (equal (chronometrist-time-add [0 0 1] [0 0 0])
[0 0 1]))
(should (equal (chronometrist-time-add [0 0 1] [0 0 59])
[0 1 0]))
(should (equal (chronometrist-time-add [0 1 0] [0 0 1])
[0 1 1]))
(should (equal (chronometrist-time-add [0 1 1] [0 59 59])
[1 1 0])))
(ert-deftest chronometrist-ttod-tests ()
"Tests for `chronometrist-active-time-one-day'."
(let ((timeclock-file "test.timelog"))
(timeclock-reread-log)
;; 1 hour per activity test
(should (equal (chronometrist-active-time-one-day '(0 0 0 1 1 2018))
[5 0 0]))
;; pan-midnight tests
(should (equal (chronometrist-active-time-one-day '(0 0 0 2 1 2018))
[1 0 0]))
(should (equal (chronometrist-active-time-one-day '(0 0 0 3 1 2018))
[1 0 0]))
;; 1 second test
(should (equal (chronometrist-active-time-one-day '(0 0 0 4 1 2018))
[0 0 1]))))
(ert-deftest chronometrist-format-time-tests ()
"Tests for `chronometrist-format-time'."
(should (equal (chronometrist-format-time '( 0 0 0))
" -"))
(should (equal (chronometrist-format-time '( 0 0 1))
" 1"))
(should (equal (chronometrist-format-time '( 0 0 10))
" 10"))
(should (equal (chronometrist-format-time '( 0 1 10))
" 1:10"))
(should (equal (chronometrist-format-time '( 0 10 10))
" 10:10"))
(should (equal (chronometrist-format-time '( 1 10 10))
" 1:10:10"))
(should (equal (chronometrist-format-time '(10 10 10))
"10:10:10"))
(should (equal (chronometrist-format-time '[ 0 0 0])
" -"))
(should (equal (chronometrist-format-time '[ 0 0 1])
" 1"))
(should (equal (chronometrist-format-time '[ 0 0 10])
" 10"))
(should (equal (chronometrist-format-time '[ 0 1 10])
" 1:10"))
(should (equal (chronometrist-format-time '[ 0 10 10])
" 10:10"))
(should (equal (chronometrist-format-time '[ 1 10 10])
" 1:10:10"))
(should (equal (chronometrist-format-time '[10 10 10])
"10:10:10")))
(ert-deftest chronometrist-report-iodd-tests ()
(should (equal (chronometrist-date-op '(2020 2 28) '+)
'(2020 2 29))))
(provide 'chronometrist-tests)
;; Local Variables:
;; nameless-current-name: "chronometrist"
;; End:
;;; chronometrist-tests.el ends here

View File

@ -1,9 +0,0 @@
(defsystem chronometrist-sqlite
:version "0.0.1"
:serial t
:license "Unlicense"
:author "contrapunctus <contrapunctus at disroot dot org>"
:description "SQLite backend for Chronometrist"
:defsystem-depends-on ("literate-lisp")
:depends-on (:trivia :clsql-sqlite3)
:components ((:org "chronometrist")))

File diff suppressed because it is too large Load Diff

File diff suppressed because it is too large Load Diff

View File

@ -1,9 +0,0 @@
(defsystem chronometrist
:version "0.0.1"
:serial t
:license "Unlicense"
:author "contrapunctus <contrapunctus at disroot dot org>"
:description "Friendly and extensible personal time tracker - common library"
:defsystem-depends-on ("literate-lisp")
:depends-on (:trivia)
:components ((:org "chronometrist")))

View File

@ -1,32 +0,0 @@
* Explanation
:PROPERTIES:
:CUSTOM_ID: explanation
:END:
This is a port of Chronometrist to Common Lisp.
Currently, it contains
1. a read-only plist-group backend
2. an incomplete SQLite backend
3. an incomplete CLIM frontend
** Source code overview
:PROPERTIES:
:CUSTOM_ID: source-code-overview
:END:
*** CLIM frontend
:PROPERTIES:
:CUSTOM_ID: clim-frontend
:END:
The CLIM frontend uses CLIM panes for each view of data Chronometrist provides. Each pane has a [[file:chronometrist.org::#display-pane][=display-pane=]] method to display its contents.
Currently, only one CLIM pane has been implemented, called the [[file:chronometrist.org::#task-duration-table-pane][task-duration table]]. By default, it displays a list of tasks, and each of their durations for today.
**** Tables
:PROPERTIES:
:CUSTOM_ID: tables
:END:
The tables in the CLIM frontend are designed with ease of extensibility in mind. Thus -
1. The columns displayed in this table are controlled by [[file:chronometrist.org::#*task-duration-table-spec*][=*task-duration-table-spec*=]], which contains a list of [[file:chronometrist.org::#column-specifier][=column-specifier=]] objects.
2. Each [[file:chronometrist.org::#column-specifier][=column-specifier=]] has two methods specializing on it, a [[file:chronometrist.org::#cell-data][=cell-data=]] method and a [[file:chronometrist.org::#cell-print][=cell-print=]] method. These determine the data contained by the cells of the column, and how that data is printed in the CLIM pane.
The function [[file:chronometrist.org::#task-duration-table-function][=task-duration-table-function=]] uses the [[file:chronometrist.org::#cell-data][=cell-data=]] methods to return the data of the table as a list of lists. This data is used by [[file:chronometrist.org::#display-pane][=display-pane=]] in conjunction with [[file:chronometrist.org::#cell-print][=cell-print=]] methods to display the data in the pane.

View File

@ -1,9 +0,0 @@
(defsystem chronometrist-clim
:version "0.0.1"
:serial t
:license "Unlicense"
:author "contrapunctus <contrapunctus at disroot dot org>"
:description "Friendly and extensible personal time tracker - CLIM GUI"
:defsystem-depends-on ("literate-lisp")
:depends-on (:trivia :mcclim)
:components ((:org "chronometrist")))

Binary file not shown.

Before

Width:  |  Height:  |  Size: 56 KiB

1149
doc/manual.info Normal file

File diff suppressed because it is too large Load Diff

484
doc/manual.org Normal file
View File

@ -0,0 +1,484 @@
#+TITLE: The Chronometrist Manual
#+AUTHOR: contrapunctus
The structure of this manual was inspired by https://documentation.divio.com/
* How to...
:PROPERTIES:
:DESCRIPTION: Step-by-step guides to achieve specific tasks
:END:
** How to set up Emacs to contribute
All of these are optional, but recommended for the best experience.
1. Use [[https://github.com/Malabarba/Nameless][nameless-mode]] for easier reading of Emacs Lisp code, and
2. Use [[https://github.com/joostkremers/visual-fill-column][visual-fill-column-mode]] to soft-wrap lines in Org/Markdown files.
=org-indent-mode= (for Org files) and [[https://elpa.gnu.org/packages/adaptive-wrap.html][adaptive-prefix-mode]] (for Markdown and other files) will further enhance the experience.
3. Get the sources from https://github.com/contrapunctus-1/chronometrist and read this manual in the Org format (doc/manual.org), so links to identifiers can take you to their location in the source.
4. Install [[https://github.com/cask/cask][Cask]] to easily byte-compile and test the project.
From the project root, you can now run
1. =cask= to install the project dependencies in a sandbox
2. =cask exec buttercup -L . --traceback pretty= to run tests.
* Explanation
:PROPERTIES:
:DESCRIPTION: The design, the implementation, and a little history
:END:
** 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
[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>"=.
** Project overview
:PROPERTIES:
:DESCRIPTION: A broad overview of the code
:END:
Chronometrist has three components, and each has a file containing major mode definitions and user-facing commands.
1. [[file:../elisp/chronometrist.el][chronometrist.el]]
2. [[file:../elisp/chronometrist-report.el][chronometrist-report.el]]
3. [[file:../elisp/chronometrist-statistics.el][chronometrist-statistics.el]]
All three of these use =(info "(elisp)Tabulated List Mode")=. Each of them also contains a "-print-non-tabular" function, which prints the non-tabular parts of the buffer.
Each of them has a corresponding =-custom= file, which contain the Customize group and custom variable definitions for user-facing variables -
- [[file:../elisp/chronometrist-custom.el][chronometrist-custom.el]]
- [[file:../elisp/chronometrist-report-custom.el][chronometrist-report-custom.el]]
- [[file:../elisp/chronometrist-statistics-custom.el][chronometrist-statistics-custom.el]]
[[file:../elisp/chronometrist-common.el][chronometrist-common.el]] contains definitions common to all components.
All three components use timers to keep their buffers updated. [[file:../elisp/chronometrist-timer.el][chronometrist-timer.el]] contains all timer-related code.
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.
** Chronometrist
:PROPERTIES:
:DESCRIPTION: The primary command and its associated buffer.
:END:
*** 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 [[file:../elisp/chronometrist-common.el::defvar chronometrist--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 [[file:../elisp/chronometrist-custom.el::defcustom chronometrist-file (][=chronometrist-file=]] was modified, we'd clear the [[file:../elisp/chronometrist-events.el::defvar 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:1] (it uses Emacs' [[elisp:(describe-function 'read)][=read=]], after all), but the splitting of [[* Midnight-spanning events][midnight-spanning events]] is the real performance killer.
After the optimization...
1. Two backend functions ([[file:../elisp/chronometrist-sexp.el::cl-defun chronometrist-sexp-new (][=chronometrist-sexp-new=]] and [[file:../elisp/chronometrist-sexp.el::defun chronometrist-sexp-replace-last (][=chronometrist-sexp-replace-last=]]) were modified to set a flag ([[file:../elisp/chronometrist.el::defvar chronometrist--inhibit-read-p ][=chronometrist--inhibit-read-p=]]) before saving the file.
2. If this flag is non-nil, [[file:../elisp/chronometrist.el::defun chronometrist-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 [[file:../elisp/chronometrist.el::defun chronometrist-refresh-file (][=chronometrist-refresh-file=]] runs unconditionally - which is to say there is scope for further optimization, if or when required.
[fn:1] 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 events
:PROPERTIES:
:DESCRIPTION: Events starting on one day and ending on another
:END:
A unique problem in working with Chronometrist, one I had never foreseen, was tasks which start on one day and end on another. These mess up data consumption (especially interval calculations and acquiring data for a specific date) in all sorts of unforeseen ways.
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 [[file:../elisp/chronometrist-report.el::defun chronometrist-report (][=chronometrist-report=]] is run in an Emacs session -
1. We get the current date as a ts struct =(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)=).
** Tags and Key-Values
:PROPERTIES:
:DESCRIPTION: How tags and key-values are implemented
:END:
[[file:../elisp/chronometrist-key-values.el][chronometrist-key-values.el]] deals with adding additional information to events, in the form of key-values and tags.
Key-values are stored as plist keywords and values. The user can add any keywords except =:name=, =:tags=, =:start=, and =:stop=. [fn:2] Values can be any readable Lisp values.
Similarly, tags are stored using a =:tags (<tag>*)= keyword-value pair. The tags themselves (the elements of the list) can be any readable Lisp value.
[fn:2] To remove this restriction, I had briefly considered making a keyword called =:user=, whose value would be another plist containing all user-defined keyword-values. But in practice, this hasn't been a big enough issue yet to justify the work.
*** User input
The entry points are [[file:../elisp/chronometrist-key-values.el::defun chronometrist-kv-add (][=chronometrist-kv-add=]] and [[file:../elisp/chronometrist-key-values.el::defun chronometrist-tags-add (][=chronometrist-tags-add=]]. The user adds these to the desired hooks, and they prompt the user for tags/key-values.
Both have corresponding functions to create a prompt -
+ [[file:../elisp/chronometrist-key-values.el::defun chronometrist-key-prompt (][=chronometrist-key-prompt=]],
+ [[file:../elisp/chronometrist-key-values.el::defun chronometrist-value-prompt (][=chronometrist-value-prompt=]], and
+ [[file:../elisp/chronometrist-key-values.el::defun chronometrist-tags-prompt (][=chronometrist-tags-prompt=]].
[[file:../elisp/chronometrist-key-values.el::defun chronometrist-kv-add (][=chronometrist-kv-add=]]'s way of reading key-values from the user is somewhat different from most Emacs prompts - it creates a new buffer, and uses the minibuffer to alternatingly ask for keys and values in a loop. Key-values are inserted into the buffer as the user enters/selects them. The user can break out of this loop with an empty input (the keys to accept an empty input differ between completion systems, so we try to let the user know about them using [[file:../elisp/chronometrist-key-values.el::defun chronometrist-kv-completion-quit-key (][=chronometrist-kv-completion-quit-key=]]). After exiting the loop, they can edit the key-values in the buffer, and use the commands [[file:../elisp/chronometrist-key-values.el::defun chronometrist-kv-accept (][=chronometrist-kv-accept=]] to accept the key-values (which uses [[file:../elisp/chronometrist-key-values.el::defun chronometrist-append-to-last (][=chronometrist-append-to-last=]] to add them to the last plist in =chronometrist-file=) or [[file:../elisp/chronometrist-key-values.el::defun chronometrist-kv-reject (][=chronometrist-kv-reject=]] to discard them.
*** History
All prompts suggest past user inputs. These are queried from three history hash tables -
+ [[file:../elisp/chronometrist-key-values.el::defvar chronometrist-key-history (][=chronometrist-key-history=]],
+ [[file:../elisp/chronometrist-key-values.el::defvar chronometrist-value-history (][=chronometrist-value-history=]], and
+ [[file:../elisp/chronometrist-key-values.el::defvar chronometrist-tags-history (][=chronometrist-tags-history=]].
Each of these has a corresponding function to clear it and fill it with values -
+ [[file:../elisp/chronometrist-key-values.el::defun chronometrist-key-history-populate (][=chronometrist-key-history-populate=]]
+ [[file:../elisp/chronometrist-key-values.el::defun chronometrist-value-history-populate (][=chronometrist-value-history-populate=]], and
+ [[file:../elisp/chronometrist-key-values.el::defun chronometrist-tags-history-populate (][=chronometrist-tags-history-populate=]].
* Reference
:PROPERTIES:
:DESCRIPTION: A list of definitions, with some type information
:END:
** Legend of currently-used time formats
*** ts
ts.el struct
* Used by nearly all internal functions
*** iso-timestamp
"YYYY-MM-DDTHH:MM:SSZ"
* Used in the s-expression file format
* Read by chronometrist-sexp-events-populate
* Used in the plists in the chronometrist-events hash table values
*** iso-date
"YYYY-MM-DD"
* Used as hash table keys in chronometrist-events - can't use ts structs for keys, you'd have to make a hash table predicate which uses ts=
*** seconds
integer seconds as duration
* Used for most durations
* May be changed to floating point to allow larger durations. The minimum range of `most-positive-fixnum` is 536870911, which seems to be enough to represent durations of 17 years.
* Used for update intervals (chronometrist-update-interval, chronometrist-change-update-interval)
*** minutes
integer minutes as duration
* Used for goals (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
** chronometrist-common.el
1. Variable - chronometrist-task-list
2. Internal Variable - chronometrist--fs-watch
3. Function - chronometrist-current-task ()
4. Function - chronometrist-format-time (seconds &optional (blank " "))
* seconds -> "h:m:s"
5. Function - chronometrist-common-file-empty-p (file)
6. Function - chronometrist-common-clear-buffer (buffer)
7. Function - chronometrist-format-keybinds (command map &optional firstonly)
8. Function - chronometrist-events->ts-pairs (events)
* (plist ...) -> ((ts . ts) ...)
9. Function - chronometrist-ts-pairs->durations (ts-pairs)
* ((ts . ts) ...) -> seconds
10. Function - chronometrist-previous-week-start (ts)
* ts -> ts
** chronometrist-custom.el
1. Custom variable - chronometrist-file
2. Custom variable - chronometrist-buffer-name
3. Custom variable - chronometrist-hide-cursor
4. Custom variable - chronometrist-update-interval
5. Custom variable - chronometrist-activity-indicator
6. Custom variable - chronometrist-day-start-time
** chronometrist-diary-view.el
1. Variable - chronometrist-diary-buffer-name
2. Internal Variable - chronometrist-diary--current-date
3. Function - chronometrist-intervals-on (date)
4. Function - chronometrist-diary-tasks-reasons-on (date)
5. Function - chronometrist-diary-refresh (&optional ignore-auto noconfirm date)
6. Major Mode - chronometrist-diary-view-mode
7. Command - chronometrist-diary-view (&optional date)
** chronometrist.el
1. Internal Variable - chronometrist--point
2. Keymap - chronometrist-mode-map
3. Command - chronometrist-open-log (&optional button)
4. Function - chronometrist-common-create-file ()
5. Function - chronometrist-task-active? (task)
* String -> Boolean
6. Function - chronometrist-use-goals? ()
7. Function - chronometrist-run-transformers (transformers arg)
8. Function - chronometrist-activity-indicator ()
9. Function - chronometrist-entries ()
10. Function - chronometrist-task-at-point ()
11. Function - chronometrist-goto-last-task ()
12. Function - chronometrist-print-keybind (command &optional description firstonly)
13. Function - chronometrist-print-non-tabular ()
14. Function - chronometrist-goto-nth-task (n)
15. Function - chronometrist-refresh (&optional ignore-auto noconfirm)
16. Internal Variable - chronometrist--file-state
17. Function - chronometrist-file-hash (&optional start end hash)
18. Function - chronometrist-read-from (position)
19. Function - chronometrist-file-change-type (state)
20. Function - chronometrist-task-list ()
* -> List
21. Function - chronometrist-reset-task-list ()
22. Function - chronometrist-add-to-task-list (task)
23. Function - chronometrist-remove-from-task-list (task)
24. Function - chronometrist-refresh-file (fs-event)
25. Command - chronometrist-query-stop ()
26. Command - chronometrist-in (task &optional _prefix)
27. Command - chronometrist-out (&optional _prefix)
28. Variable - chronometrist-before-in-functions
29. Variable - chronometrist-after-in-functions
30. Variable - chronometrist-before-out-functions
31. Variable - chronometrist-after-out-functions
32. Function - chronometrist-run-functions-and-clock-in (task)
33. Function - chronometrist-run-functions-and-clock-out (task)
34. Keymap - chronometrist-mode-map
35. Major Mode - chronometrist-mode
36. Function - chronometrist-toggle-task-button (button)
37. Function - chronometrist-add-new-task-button (button)
38. Command - chronometrist-toggle-task (&optional prefix inhibit-hooks)
39. Command - chronometrist-toggle-task-no-hooks (&optional prefix)
40. Command - chronometrist-add-new-task ()
41. Command - chronometrist (&optional arg)
** chronometrist-events.el
1. Variable - chronometrist-events
* keys - iso-date
2. Function - chronometrist-day-start (timestamp)
* iso-timestamp -> encode-time
3. Function - chronometrist-file-clean ()
* commented out, unused
4. Function - chronometrist-events-maybe-split (event)
5. Function - chronometrist-events-populate ()
6. Function - chronometrist-events-update (plist &optional replace)
7. Function - chronometrist-events-subset (start end)
* ts ts -> hash-table
** chronometrist-migrate.el
1. Variable - chronometrist-migrate-table
2. Function - chronometrist-migrate-populate (in-file)
3. Function - chronometrist-migrate-timelog-file->sexp-file (&optional in-file out-file)
4. Function - chronometrist-migrate-check ()
** chronometrist-plist-pp.el
1. Variable - chronometrist-plist-pp-keyword-re
2. Variable - chronometrist-plist-pp-whitespace-re
3. Function - chronometrist-plist-pp-longest-keyword-length ()
4. Function - chronometrist-plist-pp-buffer-keyword-helper ()
5. Function - chronometrist-plist-pp-buffer ()
6. Function - chronometrist-plist-pp-to-string (object)
7. Function - chronometrist-plist-pp (object &optional stream)
** chronometrist-queries.el
1. Function - chronometrist-last ()
* -> plist
2. Function - chronometrist-task-time-one-day (task &optional (ts (ts-now)))
* String &optional ts -> seconds
3. Function - chronometrist-active-time-one-day (&optional (ts (ts-now)))
* &optional ts -> seconds
4. Function - chronometrist-statistics-count-active-days (task &optional (table chronometrist-events))
5. Function - chronometrist-task-events-in-day (task &optional (ts (ts-now)))
** chronometrist-report-custom.el
1. Custom variable - chronometrist-report-buffer-name
2. Custom variable - chronometrist-report-week-start-day
3. Custom variable - chronometrist-report-weekday-number-alist
** chronometrist-report.el
1. Internal Variable - chronometrist-report--ui-date
2. Internal Variable - chronometrist-report--ui-week-dates
3. Internal Variable - chronometrist-report--point
4. Function - chronometrist-report-date ()
5. Function - chronometrist-report-date->dates-in-week (first-date-in-week)
* ts-1 -> (ts-1 ... ts-7)
6. Function - chronometrist-report-date->week-dates ()
7. Function - chronometrist-report-entries ()
8. Function - chronometrist-report-print-keybind (command &optional description firstonly)
9. Function - chronometrist-report-print-non-tabular ()
10. Function - chronometrist-report-refresh (&optional _ignore-auto _noconfirm)
11. Function - chronometrist-report-refresh-file (_fs-event)
12. Keymap - chronometrist-report-mode-map
13. Major Mode - chronometrist-report-mode
14. Function - chronometrist-report (&optional keep-date)
15. Function - chronometrist-report-previous-week (arg)
16. Function - chronometrist-report-next-week (arg)
** chronometrist-key-values.el
1. Internal Variable - chronometrist--tag-suggestions
2. Internal Variable - chronometrist--value-suggestions
3. Function - chronometrist-plist-remove (plist &rest keys)
4. Function - chronometrist-maybe-string-to-symbol (list)
5. Function - chronometrist-maybe-symbol-to-string (list)
6. Function - chronometrist-append-to-last (tags plist)
7. Variable - chronometrist-tags-history
8. Function - chronometrist-history-prep (key history-table)
9. Function - chronometrist-tags-history-populate (task history-table file)
10. Function - chronometrist-key-history-populate (task history-table file)
11. Function - chronometrist-value-history-populate (history-table file)
12. Function - chronometrist-tags-history-add (plist)
13. Function - chronometrist-tags-history-combination-strings (task)
14. Function - chronometrist-tags-history-individual-strings (task)
15. Function - chronometrist-tags-prompt (task &optional initial-input)
16. Function - chronometrist-tags-add (&rest args)
17. Custom Variable - chronometrist-kv-buffer-name
18. Variable - chronometrist-key-history
19. Variable - chronometrist-value-history
20. Keymap - chronometrist-kv-read-mode-map
21. Major Mode - chronometrist-kv-read-mode
22. Function - chronometrist-kv-completion-quit-key ()
23. Function - chronometrist-string-has-whitespace-p (string)
24. Function - chronometrist-key-prompt (used-keys)
25. Function - chronometrist-value-prompt (key)
26. Function - chronometrist-value-insert (value)
27. Function - chronometrist-kv-add (&rest args)
28. Command - chronometrist-kv-accept ()
29. Command - chronometrist-kv-reject ()
30. Internal Variable - chronometrist--skip-detail-prompts
31. Function - chronometrist-skip-query-prompt (task)
32. Function - chronometrist-skip-query-reset (_task)
** chronometrist-statistics-custom.el
1. Custom variable - chronometrist-statistics-buffer-name
** chronometrist-statistics.el
1. Internal Variable - chronometrist-statistics--ui-state
2. Internal Variable - chronometrist-statistics--point
3. Function - chronometrist-statistics-count-average-time-spent (task &optional (table chronometrist-events))
* string &optional hash-table -> seconds
4. Function - chronometrist-statistics-entries-internal (table)
5. Function - chronometrist-statistics-entries ()
6. Function - chronometrist-statistics-print-keybind (command &optional description firstonly)
7. Function - chronometrist-statistics-print-non-tabular ()
8. Function - chronometrist-statistics-refresh (&optional ignore-auto noconfirm)
9. Keymap - chronometrist-statistics-mode-map
10. Major Mode - chronometrist-statistics-mode
11. Command - chronometrist-statistics (&optional preserve-state)
12. Command - chronometrist-statistics-previous-range (arg)
13. Command - chronometrist-statistics-next-range (arg)
** chronometrist-time.el
1. Function - chronometrist-iso-timestamp->ts (timestamp)
* iso-timestamp -> ts
2. Function - chronometrist-iso-date->ts (date)
* iso-date -> ts
3. Function - chronometrist-date (&optional (ts (ts-now)))
* &optional ts -> ts (with time 00:00:00)
4. Function - chronometrist-format-time-iso8601 (&optional unix-time)
5. Function - chronometrist-midnight-spanning-p (start-time stop-time)
6. Function - chronometrist-seconds-to-hms (seconds)
* seconds -> list-duration
7. Function - chronometrist-interval (event)
* event -> duration
** chronometrist-timer.el
1. Internal Variable - chronometrist--timer-object
2. Function - chronometrist-timer ()
3. Command - chronometrist-stop-timer ()
4. Command - chronometrist-maybe-start-timer (&optional interactive-test)
5. Command - chronometrist-force-restart-timer ()
6. Command - chronometrist-change-update-interval (arg)
** chronometrist-goal
1. Internal Variable - chronometrist-goal--timers-list
2. Custom Variable - chronometrist-goal-list nil
3. Function - chronometrist-goal-run-at-time (time repeat function &rest args)
4. Function - chronometrist-goal-seconds->alert-string (seconds)
* seconds -> string
5. Function - chronometrist-goal-approach-alert (task goal spent)
* string minutes minutes
6. Function - chronometrist-goal-complete-alert (task goal spent)
* string minutes minutes
7. Function - chronometrist-goal-exceed-alert (task goal spent)
* string minutes minutes
8. Function - chronometrist-goal-no-goal-alert (task goal spent)
* string minutes minutes
9. Custom Variable - chronometrist-goal-alert-functions
* each function is passed - string minutes minutes
10. Function - chronometrist-goal-get (task &optional (goal-list chronometrist-goal-list))
* String &optional List -> minutes
11. Function - chronometrist-goal-run-alert-timers (task)
12. Function - chronometrist-goal-stop-alert-timers (&optional _task)
13. Function - chronometrist-goal-on-file-change ()
** chronometrist-sexp
1. Custom variable - chronometrist-sexp-pretty-print-function
2. Macro - chronometrist-sexp-in-file (file &rest body)
3. Macro - chronometrist-loop-file (for expr in file &rest loop-clauses)
4. Function - chronometrist-sexp-open-log ()
5. Function - chronometrist-sexp-between (&optional (ts-beg (chronometrist-date)) (ts-end (ts-adjust 'day +1 (chronometrist-date))))
6. Function - chronometrist-sexp-query-till (&optional (date (chronometrist-date)))
7. Function - chronometrist-sexp-last ()
* -> plist
8. Function - chronometrist-sexp-current-task ()
9. Function - chronometrist-sexp-events-populate ()
10. Function - chronometrist-sexp-create-file ()
11. Function - chronometrist-sexp-new (plist &optional (buffer (find-file-noselect chronometrist-file)))
12. Function - chronometrist-sexp-delete-list (&optional arg)
13. Function - chronometrist-sexp-replace-last (plist)
14. Command - chronometrist-sexp-reindent-buffer ()
# Local Variables:
# org-link-file-path-type: relative
# eval: (progn (make-local-variable (quote after-save-hook)) (add-hook (quote after-save-hook) (lambda () (org-export-to-file 'texinfo "manual.info"))))
# End:

View File

@ -0,0 +1,130 @@
;;; chronometrist-common.el --- Common definitions for Chronometrist -*- lexical-binding: t; -*-
;; Author: contrapunctus <xmpp:contrapunctus@jabber.fr>
;; This is free and unencumbered software released into the public domain.
;;
;; Anyone is free to copy, modify, publish, use, compile, sell, or
;; distribute this software, either in source code form or as a compiled
;; binary, for any purpose, commercial or non-commercial, and by any
;; means.
;;
;; For more information, please refer to <https://unlicense.org>
;;; Commentary:
;;
(require 'dash)
(require 'cl-lib)
(require 'ts)
(require 'chronometrist-time)
(require 'chronometrist-sexp)
;; ## VARIABLES ##
;;; Code:
(defvar chronometrist-task-list nil
"List of tasks in `chronometrist-file'.")
(defvar chronometrist--fs-watch nil
"Filesystem watch object.
Used to prevent more than one watch being added for the same
file.")
(defun chronometrist-current-task ()
"Return the name of the currently clocked-in task, or nil if not clocked in."
(chronometrist-sexp-current-task))
(cl-defun chronometrist-format-time (seconds &optional (blank " "))
"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))
" -"
(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)))))
(defun chronometrist-common-file-empty-p (file)
"Return t if FILE is empty."
(let ((size (elt (file-attributes file) 7)))
(if (zerop size) t nil)))
(defun chronometrist-common-clear-buffer (buffer)
"Clear the contents of BUFFER."
(with-current-buffer buffer
(goto-char (point-min))
(delete-region (point-min) (point-max))))
(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))))
(defun chronometrist-events->ts-pairs (events)
"Convert EVENTS to a list of ts struct pairs (see `ts.el').
EVENTS must be a list of valid Chronometrist property lists (see
`chronometrist-file')."
(cl-loop for plist in events collect
(let* ((start (chronometrist-iso-timestamp->ts
(plist-get plist :start)))
(stop (plist-get plist :stop))
(stop (if stop
(chronometrist-iso-timestamp->ts stop)
(ts-now))))
(cons start stop))))
(defun chronometrist-ts-pairs->durations (ts-pairs)
"Return the durations represented by TS-PAIRS.
TS-PAIRS is a list of pairs, where each element is a ts struct (see `ts.el').
Return seconds as an integer, or 0 if TS-PAIRS is nil."
(if ts-pairs
(cl-loop for pair in ts-pairs collect
(ts-diff (cdr pair) (car pair)))
0))
(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))
(provide 'chronometrist-common)
;;; chronometrist-common.el ends here

View File

@ -0,0 +1,103 @@
;;; chronometrist-diary-view.el --- A diary-like view for Chronometrist -*- lexical-binding: t; -*-
;; Author: contrapunctus <xmpp:contrapunctus@jabber.fr>
;; This is free and unencumbered software released into the public domain.
;;
;; Anyone is free to copy, modify, publish, use, compile, sell, or
;; distribute this software, either in source code form or as a compiled
;; binary, for any purpose, commercial or non-commercial, and by any
;; means.
;;
;; For more information, please refer to <https://unlicense.org>
;;; Commentary:
;; TODO - add forward/backward, current date display (and don't scroll
;; past the actual data)
;; TODO - when the reason is "-", add that interval to the next reason
;; TODO - permit switching between time formats
;; - hours and minutes - "X hours, Y minutes"
;; - minutes only - "80 minutes"
;; - relaxed - "(almost|slightly over) 1 hour"
;; - strict time periods (using `chronometrist-seconds-to-hms')
;; - period start/end ("HH:MM to HH:MM")
;; Add variable to store format functions as list (first one is
;; default), command to cycle between them
;;; Code:
(require 'chronometrist-events)
(require 'chronometrist-common)
(defvar chronometrist-diary-buffer-name "*Chronometrist-Diary*"
"Name for the buffer created by `chronometrist-diary'.")
(defvar chronometrist-diary--current-date nil
"Stores the date for the buffer.")
(defun chronometrist-intervals-on (date)
"Return a list of all time intervals on DATE.
DATE should be a list in the form \"YYYY-MM-DD\"
Each time interval is a string as returned by `chronometrist-seconds-to-hms'."
(->> (gethash date chronometrist-events)
(chronometrist-events->ts-pairs)
;; Why were we calling `-partition' here?
;; (-partition 2)
(--map (time-subtract (cadr it) (car it)))
(--map (chronometrist-seconds-to-hms (cadr it)))))
;; "X minutes on TASK (REASON)"
;; TODO - think of a better way to show details concisely, ideally
;; combining tags and key-values
(defun chronometrist-diary-tasks-reasons-on (date)
"Return a list of tasks and reasons on DATE."
(mapcar (lambda (plist)
(let ((task (plist-get plist :name))
(reason (or (plist-get plist :comment) "")))
(concat " on " task
(unless (equal reason "")
(concat " (" reason ")"))
"\n")))
(gethash date chronometrist-events)))
(defun chronometrist-diary-refresh (&optional _ignore-auto _noconfirm date)
"Refresh the `chronometrist-diary' buffer.
This does not re-read `chronometrist-file'.
Optional argument DATE should be a list in the form
\"YYYY-MM-DD\". If not supplied, today's date is used.
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* ((date (if date date (chronometrist-date)))
(intervals (->> (chronometrist-intervals-on date)
(mapcar #'chronometrist-format-time)))
(tasks-reasons (chronometrist-diary-tasks-reasons-on date))
(inhibit-read-only t))
(setq chronometrist-diary--current-date date)
(chronometrist-common-clear-buffer chronometrist-diary-buffer-name)
(seq-mapn #'insert intervals tasks-reasons)))
(define-derived-mode chronometrist-diary-view-mode special-mode "Chronometrist-Diary"
"A mode to view your activity today like a diary."
(setq revert-buffer-function #'chronometrist-diary-refresh))
(defun chronometrist-diary-view (&optional date)
"Display today's Chronometrist data in a diary-like view.
If DATE is supplied, show data for that date. DATE should be an
ISO-8601 date string (\"YYYY-MM-DD\")."
(interactive)
(switch-to-buffer
(get-buffer-create chronometrist-diary-buffer-name))
(chronometrist-diary-view-mode)
(chronometrist-diary-refresh nil nil date))
(provide 'chronometrist-diary-view)
;;; chronometrist-diary-view.el ends here

View File

@ -0,0 +1,130 @@
;;; chronometrist-events.el --- Event management and querying code for Chronometrist -*- lexical-binding: t; -*-
;; Author: contrapunctus <xmpp:contrapunctus@jabber.fr>
;; 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>
;; (require 'chronometrist-plist-pp)
(require 'chronometrist-common)
(require 'chronometrist-sexp)
(require 'ts)
;; external -
;; chronometrist-day-start-time (-custom)
;; chronometrist-midnight-spanning-p (-time)
;; chronometrist-date-less-p (-time)
;;; Commentary:
;;
;;; Code:
(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).")
(defun chronometrist-day-start (timestamp)
"Get start of day (according to `chronometrist-day-start-time') for TIMESTAMP.
TIMESTAMP must be a time string in the ISO-8601 format.
Return value is a time value (see `current-time')."
(let ((timestamp-date-list (->> timestamp
(parse-iso8601-time-string)
(decode-time)
(-drop 3)
(-take 3))))
(--> chronometrist-day-start-time
(split-string it ":")
(mapcar #'string-to-number it)
(reverse it)
(append it timestamp-date-list)
(apply #'encode-time it))))
(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))))
(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))))))))
;; TODO - Maybe strip dates from values, since they're part of the key
;; anyway. Consider using a state machine.
;; OPTIMIZE - It should not be necessary to call this unless the file
;; has changed. Any other refresh situations should not require this.
(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-sexp-events-populate))
(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-timestamp->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))))
(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-date->ts key))
(puthash key value subset)))
chronometrist-events)
subset))
(defun chronometrist-events-last-date ()
(--> (hash-table-keys chronometrist-events)
(last it)
(car it)))
(defun chronometrist-events-last ()
"Return the last plist from `chronometrist-events'."
(--> (gethash (chronometrist-events-last-date) chronometrist-events)
(last it)
(car it)))
(provide 'chronometrist-events)
;;; chronometrist-events.el ends here

View File

@ -1,11 +1,19 @@
;;; chronometrist-key-values.el --- add key-values to Chronometrist data -*- 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: ((chronometrist "0.7.0"))
;; Version: 0.1.0
(require 'cl-lib)
(require 'subr-x)
(require 'dash)
(require 'seq)
(require 'anaphora)
(require 'choice)
(require 'chronometrist-migrate)
(require 'chronometrist-events)
(require 'chronometrist-plist-pp)
(require 'chronometrist-common)
(declare-function chronometrist-refresh "chronometrist.el")
(declare-function chronometrist-last "chronometrist-queries.el")
;; This is free and unencumbered software released into the public domain.
;;
@ -18,33 +26,35 @@
;;; Commentary:
;;
;; This package lets users attach tags and key-values to their tracked time, similar to tags and properties in Org mode.
;;
;; To use, add one or more of these functions to any chronometrist hook except `chronometrist-before-in-functions'.
;; * `chronometrist-tags-add'
;; * `chronometrist-kv-add'
;; * `chronometrist-key-values-unified-prompt'
;;; Code:
(require 'chronometrist)
(defun chronometrist-history-prep (key history-table)
"Prepare history of KEY in HISTORY-TABLE for use in prompts.
Each value in hash table TABLE must be a list. Each value will be reversed and will have duplicate elements removed."
(--> (gethash key history-table)
(cl-remove-duplicates it :test #'equal :from-end t)
(puthash key it history-table)))
(require 'chronometrist-sexp)
(defun chronometrist-keyword-to-string (keyword)
"Return KEYWORD as a string, with the leading \":\" removed."
(replace-regexp-in-string "^:?" "" (symbol-name keyword)))
(defvar chronometrist--tag-suggestions nil
"Suggestions for tags.
Used as history by `chronometrist-tags-prompt'.")
(defvar chronometrist--value-suggestions nil
"Suggestions for values.
Used as history by `chronometrist--value-suggestions'.")
(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))
(defun chronometrist-maybe-string-to-symbol (list)
"For each string in LIST, if it has no spaces, convert it to a symbol."
(cl-loop for string in list
if (string-match-p "[[:space:]]" string)
collect string
else collect (intern string)))
(--map (if (chronometrist-string-has-whitespace-p it)
it
(intern it))
list))
(defun chronometrist-maybe-symbol-to-string (list)
"Convert each symbol in LIST to a string."
@ -64,9 +74,9 @@ alongside new tags from NEW-PLIST."
(-let* (((&plist :name old-name :tags old-tags
:start old-start :stop old-stop) old-plist)
;; Anything that's left will be the user's key-values.
(old-kvs (chronometrist-plist-key-values old-plist))
(old-kvs (chronometrist-plist-remove old-plist :name :tags :start :stop))
;; Prevent the user from adding reserved key-values.
(plist (chronometrist-plist-key-values new-plist))
(plist (chronometrist-plist-remove new-plist :name :tags :start :stop))
(new-tags (-> (append old-tags (plist-get new-plist :tags))
(cl-remove-duplicates :test #'equal)))
;; In case there is an overlap in key-values, we use
@ -76,7 +86,7 @@ alongside new tags from NEW-PLIST."
(-> (cl-loop for (key val) on plist by #'cddr
do (plist-put new-kvs key val)
finally return new-kvs)
(chronometrist-plist-key-values))
(chronometrist-plist-remove :name :tags :start :stop))
old-kvs)))
(append `(:name ,old-name)
(when new-tags `(:tags ,new-tags))
@ -84,19 +94,42 @@ alongside new tags from NEW-PLIST."
`(:start ,old-start)
(when old-stop `(:stop ,old-stop)))))
;;;; TAGS ;;;;
(defcustom chronometrist-tag-history-style :combinations
"How previously-used tags are suggested.
Valid values are :combinations and :individual."
:group 'chronometrist-key-values
:type '(choice (const :combinations)
(const :individual)))
(defcustom chronometrist-key-history-style :individual
"How previously-used tags are suggested.
Valid values are :combinations and :individual."
:group 'chronometrist-key-values
:type '(choice (const :combinations)
(const :individual)))
(defvar chronometrist-tags-history (make-hash-table :test #'equal)
"Hash table of tasks and past tag combinations.
Each value is a list of tag combinations, in reverse
chronological order. Each combination is a list containing tags
as symbol and/or strings.")
(defun chronometrist-tags-history-populate (task history-table backend)
(defun chronometrist-history-prep (key history-table)
"Prepare history hash tables for use in prompts.
Each value in hash table TABLE must be a list. Each value will be
reversed and will have duplicate elements removed."
(--> (gethash key history-table)
(cl-remove-duplicates it :test #'equal :from-end t)
(puthash key it history-table)))
(defun chronometrist-tags-history-populate (task history-table file)
"Store tag history for TASK in HISTORY-TABLE from FILE.
Return the new value inserted into HISTORY-TABLE.
HISTORY-TABLE must be a hash table. (see `chronometrist-tags-history')"
(puthash task nil history-table)
(cl-loop for plist in (chronometrist-to-list backend) do
(chronometrist-loop-file for plist in file do
(let ((new-tag-list (plist-get plist :tags))
(old-tag-lists (gethash task history-table)))
(and (equal task (plist-get plist :name))
@ -108,18 +141,64 @@ HISTORY-TABLE must be a hash table. (see `chronometrist-tags-history')"
history-table))))
(chronometrist-history-prep task history-table))
(defvar chronometrist--tag-suggestions nil
"Suggestions for tags.
Used as history by `chronometrist-tags-prompt'.")
(defun chronometrist-key-history-populate (task history-table file)
"Store key history for TASK in HISTORY-TABLE from FILE.
Return the new value inserted into HISTORY-TABLE.
HISTORY-TABLE must be a hash table (see `chronometrist-key-history')."
(puthash task nil history-table)
(chronometrist-loop-file for plist in file do
(catch 'quit
(let* ((name (plist-get plist :name))
(check (unless (equal name task) (throw 'quit nil)))
(new-keys (--> (chronometrist-plist-remove plist :name :start :stop :tags)
(seq-filter #'keywordp it)
(cl-loop for key in it collect
(s-chop-prefix ":" (symbol-name key)))))
(check (unless new-keys (throw 'quit nil)))
(new-keys (case chronometrist-key-history-style
(:combinations (list new-keys))
(:individual new-keys)))
(old-keys (gethash name history-table)))
(puthash name
(if old-keys (append old-keys new-keys) new-keys)
history-table))))
(chronometrist-history-prep task history-table))
;; We don't want values to be task-sensitive, so this does not have a
;; KEY parameter similar to TASK for `chronometrist-tags-history-populate' or
;; `chronometrist-key-history-populate'
(defun chronometrist-value-history-populate (history-table file)
"Store value history in HISTORY-TABLE from FILE.
HISTORY-TABLE must be a hash table. (see `chronometrist-value-history')"
(clrhash history-table)
;; Note - while keys are Lisp keywords, values may be any Lisp
;; object, including lists
(chronometrist-loop-file for plist in file do
;; We call them user-key-values because we filter out Chronometrist's
;; reserved key-values
(let ((user-key-values (chronometrist-plist-remove plist :name :tags :start :stop)))
(cl-loop for (key value) on user-key-values by #'cddr do
(let* ((key-string (s-chop-prefix ":" (symbol-name key)))
(old-values (gethash key-string history-table))
(value (if (not (stringp value)) ;; why?
(list (format "%S" value))
(list value))))
(puthash key-string
(if old-values (append old-values value) value)
history-table)))))
(maphash (lambda (key values)
(chronometrist-history-prep key history-table))
history-table))
(defun chronometrist-tags-history-add (plist)
"Add tags from PLIST to `chronometrist-tags-history'."
(let* ((table chronometrist-tags-history)
(name (plist-get plist :name))
(tags (plist-get plist :tags))
(tags (awhen (plist-get plist :tags) (list it)))
(old-tags (gethash name table)))
(when tags
(--> (cons tags old-tags)
(--> (append tags old-tags)
(puthash name it table)))))
(defun chronometrist-tags-history-combination-strings (task)
@ -143,12 +222,12 @@ This is used to provide history for `completing-read-multiple' in
This is used to provide completion for individual tags, in
`completing-read-multiple' in `chronometrist-tags-prompt'."
(--> (gethash task chronometrist-tags-history)
(-flatten it)
(cl-remove-duplicates it :test #'equal)
(cl-loop for elt in it
collect (if (stringp elt)
elt
(symbol-name elt)))))
(-flatten it)
(cl-remove-duplicates it :test #'equal)
(cl-loop for elt in it
collect (if (stringp elt)
elt
(symbol-name elt)))))
(defun chronometrist-tags-prompt (task &optional initial-input)
"Read one or more tags from the user and return them as a list of strings.
@ -167,54 +246,26 @@ INITIAL-INPUT is as used in `completing-read'."
_ARGS are ignored. This function always returns t, so it can be
used in `chronometrist-before-out-functions'."
(interactive)
(let* ((backend (chronometrist-active-backend))
(last-expr (chronometrist-latest-record backend))
(last-name (plist-get last-expr :name))
(_history (chronometrist-tags-history-populate last-name chronometrist-tags-history backend))
(last-tags (plist-get last-expr :tags))
(input (->> (chronometrist-maybe-symbol-to-string last-tags)
(-interpose ",")
(apply #'concat)
(chronometrist-tags-prompt last-name)
(chronometrist-maybe-string-to-symbol))))
(when input
(--> (append last-tags input)
(reverse it)
(cl-remove-duplicates it :test #'equal)
(reverse it)
(list :tags it)
(chronometrist-plist-update
(chronometrist-latest-record backend) it)
(chronometrist-replace-last backend it)))
t))
(unless chronometrist--skip-detail-prompts
(let* ((last-expr (chronometrist-last))
(last-name (plist-get last-expr :name))
(_history (chronometrist-tags-history-populate last-name chronometrist-tags-history chronometrist-file))
(last-tags (plist-get last-expr :tags))
(input (->> (chronometrist-maybe-symbol-to-string last-tags)
(-interpose ",")
(apply #'concat)
(chronometrist-tags-prompt last-name)
(chronometrist-maybe-string-to-symbol))))
(when input
(--> (chronometrist-plist-update (chronometrist-sexp-last) (list :tags input))
(chronometrist-sexp-replace-last it)))))
t)
;;;; KEY-VALUES ;;;;
(defgroup chronometrist-key-values nil
"Add key-values to Chronometrist time intervals."
:group 'chronometrist)
(defcustom chronometrist-key-value-use-database-history t
"If non-nil, use database to generate key-value suggestions.
If nil, only `chronometrist-key-value-preset-alist' is used."
:type 'boolean
:group 'chronometrist-key-value)
(defcustom chronometrist-key-value-preset-alist nil
"Alist of key-value suggestions for `chronometrist-key-value' prompts.
Each element must be in the form (\"TASK\" <KEYWORD> <VALUE> ...)"
:type
'(repeat
(cons
(string :tag "Task name")
(repeat :tag "Property preset"
(plist :tag "Property"
;; :key-type 'keyword :value-type 'sexp
))))
:group 'chronometrist-key-values)
(defun chronometrist-key-value-get-presets (task)
"Return presets for TASK from `chronometrist-key-value-preset-alist' as a list of plists."
(alist-get task chronometrist-key-value-preset-alist nil nil #'equal))
(defcustom chronometrist-kv-buffer-name "*Chronometrist-Key-Values*"
"Name of buffer in which key-values are entered."
:group 'chronometrist-key-values
@ -228,60 +279,12 @@ containing keywords used with that task, in reverse chronological
order. The keywords are stored as strings and their leading \":\"
is removed.")
(defun chronometrist-key-history-populate (task history-table backend)
"Store key history for TASK in HISTORY-TABLE from FILE.
Return the new value inserted into HISTORY-TABLE.
HISTORY-TABLE must be a hash table (see `chronometrist-key-history')."
(puthash task nil history-table)
(cl-loop for plist in backend do
(catch 'quit
(let* ((name (plist-get plist :name))
(_check (unless (equal name task) (throw 'quit nil)))
(keys (--> (chronometrist-plist-key-values plist)
(seq-filter #'keywordp it)
(cl-loop for key in it collect
(chronometrist-keyword-to-string key))))
(_check (unless keys (throw 'quit nil)))
(old-keys (gethash name history-table)))
(puthash name
(if old-keys (append old-keys keys) keys)
history-table))))
(chronometrist-history-prep task history-table))
(defvar chronometrist-value-history
(make-hash-table :test #'equal)
"Hash table to store previously-used values for user-keys.
The hash table keys are user-key names (as strings), and the
values are lists containing values (as strings).")
(defun chronometrist-value-history-populate (history-table backend)
"Store value history in HISTORY-TABLE from FILE.
HISTORY-TABLE must be a hash table. (see `chronometrist-value-history')"
(clrhash history-table)
;; Note - while keys are Lisp keywords, values may be any Lisp
;; object, including lists
(cl-loop for plist in (chronometrist-to-list backend) do
;; We call them user-key-values because we filter out Chronometrist's
;; reserved key-values
(let ((user-key-values (chronometrist-plist-key-values plist)))
(cl-loop for (key value) on user-key-values by #'cddr do
(let* ((key-string (chronometrist-keyword-to-string key))
(old-values (gethash key-string history-table))
(value (if (not (stringp value)) ;; why?
(list (format "%S" value))
(list value))))
(puthash key-string
(if old-values (append old-values value) value)
history-table)))))
(maphash (lambda (key _values)
(chronometrist-history-prep key history-table))
history-table))
(defvar chronometrist--value-suggestions nil
"Suggestions for values.
Used as history by `chronometrist-value-prompt'.")
(defvar chronometrist-kv-read-mode-map
(let ((map (make-sparse-keymap)))
(define-key map (kbd "C-c C-c") #'chronometrist-kv-accept)
@ -308,21 +311,24 @@ It currently supports ido, ido-ubiquitous, ivy, and helm."
"\\<helm-comp-read-map>\\[helm-cr-empty-string]")
(t "leave blank"))))
(defun chronometrist-string-has-whitespace-p (string)
"Return non-nil if STRING contains whitespace."
(string-match-p "[[:space:]]" string))
(defun chronometrist-key-prompt (used-keys)
"Prompt the user to enter keys.
USED-KEYS are keys they have already added since the invocation
of `chronometrist-kv-add'."
(let ((key-suggestions (--> (chronometrist-latest-record (chronometrist-active-backend))
(plist-get it :name)
(gethash it chronometrist-key-history))))
(completing-read (format "Key (%s to quit): "
(chronometrist-kv-completion-quit-key))
(let ((key-suggestions (--> (chronometrist-last)
(plist-get it :name)
(gethash it chronometrist-key-history))))
(completing-read (format "Key (%s to quit): " (chronometrist-kv-completion-quit-key))
;; don't suggest keys which have already been used
(cl-loop for used-key in used-keys do
(setq key-suggestions
(seq-remove (lambda (key)
(equal key used-key))
key-suggestions))
(->> key-suggestions
(seq-remove (lambda (key)
(equal key used-key)))
(setq key-suggestions))
finally return key-suggestions)
nil nil nil 'key-suggestions)))
@ -330,10 +336,8 @@ of `chronometrist-kv-add'."
"Prompt the user to enter values.
KEY should be a string for the just-entered key."
(setq chronometrist--value-suggestions (gethash key chronometrist-value-history))
(completing-read (format "Value (%s to quit): "
(chronometrist-kv-completion-quit-key))
chronometrist--value-suggestions nil nil nil
'chronometrist--value-suggestions))
(completing-read (format "Value (%s to quit): " (chronometrist-kv-completion-quit-key))
chronometrist--value-suggestions nil nil nil 'chronometrist--value-suggestions))
(defun chronometrist-value-insert (value)
"Insert VALUE into the key-value entry buffer."
@ -356,61 +360,61 @@ to add them to the last s-expression in `chronometrist-file', or
_ARGS are ignored. This function always returns t, so it can be
used in `chronometrist-before-out-functions'."
(interactive)
(let* ((buffer (get-buffer-create chronometrist-kv-buffer-name))
(first-key-p t)
(backend (chronometrist-active-backend))
(last-sexp (chronometrist-latest-record backend))
(last-name (plist-get last-sexp :name))
(last-kvs (chronometrist-plist-key-values last-sexp))
(used-keys (--map (chronometrist-keyword-to-string it)
(seq-filter #'keywordp last-kvs))))
(chronometrist-key-history-populate last-name chronometrist-key-history backend)
(chronometrist-value-history-populate chronometrist-value-history backend)
(switch-to-buffer buffer)
(with-current-buffer buffer
(erase-buffer)
(chronometrist-kv-read-mode)
(if (and (chronometrist-current-task (chronometrist-active-backend)) last-kvs)
(progn
(funcall chronometrist-sexp-pretty-print-function last-kvs buffer)
(down-list -1)
(insert "\n "))
(insert "()")
(down-list -1))
(catch 'empty-input
(let (input key value)
(while t
(setq key (chronometrist-key-prompt used-keys)
input key
used-keys (append used-keys
(list key)))
(if (string-empty-p input)
(throw 'empty-input nil)
(unless first-key-p
(insert " "))
(insert ":" key)
(setq first-key-p nil))
(setq value (chronometrist-value-prompt key)
input value)
(if (string-empty-p input)
(throw 'empty-input nil)
(chronometrist-value-insert value)))))
(chronometrist-sexp-reindent-buffer))
t))
(unless chronometrist--skip-detail-prompts
(let* ((buffer (get-buffer-create chronometrist-kv-buffer-name))
(first-key-p t)
(last-sexp (chronometrist-last))
(last-name (plist-get last-sexp :name))
(last-kvs (chronometrist-plist-remove last-sexp :name :tags :start :stop))
(used-keys (->> (seq-filter #'keywordp last-kvs)
(mapcar #'symbol-name)
(--map (s-chop-prefix ":" it)))))
(chronometrist-key-history-populate last-name chronometrist-key-history chronometrist-file)
(chronometrist-value-history-populate chronometrist-value-history chronometrist-file)
(switch-to-buffer buffer)
(with-current-buffer buffer
(chronometrist-common-clear-buffer buffer)
(chronometrist-kv-read-mode)
(if (and (chronometrist-current-task) last-kvs)
(progn
(funcall chronometrist-sexp-pretty-print-function last-kvs buffer)
(down-list -1)
(insert "\n "))
(insert "()")
(down-list -1))
(catch 'empty-input
(let (input key value)
(while t
(setq key (chronometrist-key-prompt used-keys)
input key
used-keys (append used-keys
(list key)))
(if (string-empty-p input)
(throw 'empty-input nil)
(unless first-key-p
(insert " "))
(insert ":" key)
(setq first-key-p nil))
(setq value (chronometrist-value-prompt key)
input value)
(if (string-empty-p input)
(throw 'empty-input nil)
(chronometrist-value-insert value)))))
(chronometrist-sexp-reindent-buffer))))
t)
;;;; COMMANDS ;;;;
(defun chronometrist-kv-accept ()
"Accept the plist in `chronometrist-kv-buffer-name' and add it to `chronometrist-file'."
(interactive)
(let* ((backend (chronometrist-active-backend))
(latest (chronometrist-latest-record backend))
user-kv-expr)
(let (user-kv-expr)
(with-current-buffer (get-buffer chronometrist-kv-buffer-name)
(goto-char (point-min))
(setq user-kv-expr (ignore-errors (read (current-buffer))))
(kill-buffer chronometrist-kv-buffer-name))
(if user-kv-expr
(chronometrist-replace-last backend (chronometrist-plist-update latest user-kv-expr))
(aif user-kv-expr
(chronometrist-sexp-replace-last
(chronometrist-plist-update (chronometrist-sexp-last) it))
(chronometrist-refresh))))
(defun chronometrist-kv-reject ()
@ -419,44 +423,109 @@ used in `chronometrist-before-out-functions'."
(kill-buffer chronometrist-kv-buffer-name)
(chronometrist-refresh))
(easy-menu-define chronometrist-key-value-menu chronometrist-mode-map
"Key value menu for Chronometrist mode."
'("Key-Values"
["Change tags for active/last interval" chronometrist-tags-add]
["Change key-values for active/last interval" chronometrist-kv-add]
["Change tags and key-values for active/last interval"
chronometrist-key-values-unified-prompt]))
;;;; SKIPPING QUERIES ;;;;
(defvar chronometrist--skip-detail-prompts nil)
(cl-defun chronometrist-key-values-unified-prompt
(&optional (task (plist-get (chronometrist-latest-record (chronometrist-active-backend)) :name)))
"Query user for tags and key-values to be added for TASK.
(defun chronometrist-skip-query-prompt (task)
"Offer to skip tag/key-value prompts and reuse last-used details.
This function always returns t, so it can be used in `chronometrist-before-out-functions'."
;; find latest interval for TASK; if it has tags or key-values, prompt
(let (plist)
;; iterate over events in reverse
(cl-loop for key in (reverse (hash-table-keys chronometrist-events)) do
(cl-loop for event in (reverse (gethash key chronometrist-events))
when (and (equal task (plist-get event :name))
(setq plist (chronometrist-plist-remove event :name :start :stop)))
return nil)
when plist return nil)
(and plist
(yes-or-no-p
(format "Skip prompt and use last-used tags/key-values? %S " plist))
(setq chronometrist--skip-detail-prompts t)
(chronometrist-sexp-replace-last
(chronometrist-plist-update (chronometrist-sexp-last) plist)))
t))
(defun chronometrist-skip-query-reset (_task)
"Enable prompting for tags and key-values.
This function always returns t, so it can be used in `chronometrist-before-out-functions'."
(setq chronometrist--skip-detail-prompts nil) t)
;; TODO
;; 1. rename `chronometrist-tags-history' to `chronometrist-tag-history' for consistency
;; 2. suggest key combinations for task, instead of individual keys
;; * values for each of the selected keys can be queried one by one
;; after that
;; * make it possible to select new keys after initial
;; key-combination selection - perhaps at a confirmation step
;; after the values are selected?
;; 3. select a combination and edit it
;; * use universal argument?
;; 4. Multiple values for a key
;; #### POSSIBLE INTERFACES ####
;;
;; (#1 and #2 are meant to be mixed and matched.)
;;
;; 1. (tag|key|value) combinations -> ...
;; 0-9 - use combination (and exit)
;; C-u 0-9 - edit combination (then exit)
;; s - skip (exit)
;; (b - back [to previous prompt])
;; 2. select individual (tags|keys|values) -> ...
;; 0-9 - select keys (toggles; save in var; doesn't exit)
;; u - use selection (and exit)
;; e - edit selection (then exit)
;; s - skip (exit)
;; (b - back [to previous prompt])
;; Great for values; makes it easy to add multiple values, too,
;; especially for users who don't know Lisp.
;; 3. tag-key-value combinations (everything in one prompt)
;; 0-9 - use combination (and exit)
;; C-u 0-9 - edit combination (then exit)
;; s - skip (exit)
;; [x] we want C-g to quit, and universal arg to work...
;; FIXME - incorrect tags added to file
(defun chronometrist-defchoice (mode key table)
"MODE ::= :tag
| :key
| :value
KEY ::= \"task\" (if MODE is :tags or :keys)
| \"key\" (if MODE is :values)"
(cl-loop with num = 0
for comb in (-take 10 (gethash key table))
do (incf num)
if (= num 10) do (setq num 0)
collect
(list (format "%s" num)
`(chronometrist-sexp-replace-last
(chronometrist-plist-update (chronometrist-sexp-last) ',(list :tags comb)))
(format "%s" comb))
into numeric-commands
finally do
(eval `(defchoice ,(intern
(format
"chronometrist-%s" (s-chop-prefix ":" (symbol-name mode))))
,@numeric-commands
("s" nil "skip")))))
(defun chronometrist-tag-choice (task)
"Query user for tags to be added to TASK.
Return t, to permit use in `chronometrist-before-out-functions'."
(interactive)
(let* ((backend (chronometrist-active-backend))
(presets (--map (format "%S" it)
(chronometrist-key-value-get-presets task)))
(key-values
(when chronometrist-key-value-use-database-history
(cl-loop for plist in (chronometrist-to-list backend)
when (equal (plist-get plist :name) task)
collect
(let ((plist (chronometrist-plist-remove plist :name :start :stop)))
(when plist (format "%S" plist)))
into key-value-plists
finally return
(--> (seq-filter #'identity key-value-plists)
(cl-remove-duplicates it :test #'equal :from-end t)))))
(latest (chronometrist-latest-record backend)))
(if (and (null presets) (null key-values))
(progn (chronometrist-tags-add) (chronometrist-kv-add))
(let* ((candidates (append presets key-values))
(input (completing-read
(format "Key-values for %s: " task)
candidates nil nil nil 'chronometrist-key-values-unified-prompt-history)))
(chronometrist-replace-last backend
(chronometrist-plist-update latest
(read input))))))
t)
(let ((table chronometrist-tags-history))
(chronometrist-tags-history-populate task table chronometrist-file)
(if (hash-table-empty-p table)
(chronometrist-tags-add)
(chronometrist-defchoice :tag task table)
(chronometrist-tag-choice-prompt "Which tags?"))
t))
(provide 'chronometrist-key-values)
;;; chronometrist-key-values.el ends here

View File

@ -1,788 +0,0 @@
#+TITLE: chronometrist-key-values
#+SUBTITLE: Key-value support for Chronometrist
#+AUTHOR: contrapunctus
#+TODO: TODO TEST WIP EXTEND CLEANUP FIXME REVIEW |
#+PROPERTY: header-args :tangle yes :load yes
* TODO [50%]
1. [X] Remove calls from =chronometrist.org= to make this an optional dependency.
2. [ ] key-values and tags should work regardless of what hook they're called from, including =chronometrist-before-in-functions=
3. [ ] investigate =rmc.el= (read multiple choice) as an alternative to =choice.el=
* About this file
** Definition metadata
Each definition has its own heading. The type of definition is stored in tags -
1. custom group
2. [custom|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
A =:hook:variable:= is a variable which contains a list of functions; a =:hook:= tag with any of the function tags means a function meant to be added to a hook.
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>
* Explanation
:PROPERTIES:
:DESCRIPTION: How tags and key-values are implemented
:END:
[[file:chronometrist-key-values.org][chronometrist-key-values.org]] deals with adding additional information to events, in the form of key-values and tags.
Key-values are stored as plist keywords and values. The user can add any keywords except =:name=, =:tags=, =:start=, and =:stop=. [fn:1] Values can be any readable Lisp values.
Similarly, tags are stored using a =:tags (<tag>*)= keyword-value pair. The tags themselves (the elements of the list) can be any readable Lisp value.
[fn:1] To remove this restriction, I had briefly considered making a keyword called =:user=, whose value would be another plist containing all user-defined keyword-values. But in practice, this hasn't been a big enough issue yet to justify the work.
** User input
The entry points are [[kv-add][=chronometrist-kv-add=]] and [[tags-add][=chronometrist-tags-add=]]. The user adds these to the desired hooks, and they prompt the user for tags/key-values.
Both have corresponding functions to create a prompt -
+ [[key-prompt][=chronometrist-key-prompt=]],
+ [[value-prompt][=chronometrist-value-prompt=]], and
+ [[tags-prompt][=chronometrist-tags-prompt=]].
[[kv-add][=chronometrist-kv-add=]]'s way of reading key-values from the user is somewhat different from most Emacs prompts - it creates a new buffer, and uses the minibuffer to alternatingly ask for keys and values in a loop. Key-values are inserted into the buffer as the user enters/selects them. The user can break out of this loop with an empty input (the keys to accept an empty input differ between completion systems, so we try to let the user know about them using [[kv-completion-quit-key][=chronometrist-kv-completion-quit-key=]]). After exiting the loop, they can edit the key-values in the buffer, and use the commands [[kv-accept][=chronometrist-kv-accept=]] to accept the key-values (which uses [[plist-update][=chronometrist-plist-update=]] to add them to the last plist in =chronometrist-file=) or [[kv-reject][=chronometrist-kv-reject=]] to discard them.
** History
All prompts suggest past user inputs. These are queried from three history hash tables -
+ [[key-history][=chronometrist-key-history=]],
+ [[value-history][=chronometrist-value-history=]], and
+ [[tags-history][=chronometrist-tags-history=]].
Each of these has a corresponding function to clear it and fill it with values -
+ [[key-history-populate][=chronometrist-key-history-populate=]]
+ [[value-history-populate][=chronometrist-value-history-populate=]], and
+ [[tags-history-populate][=chronometrist-tags-history-populate=]].
* Library headers and commentary
#+BEGIN_SRC emacs-lisp
;;; chronometrist-key-values.el --- add key-values to Chronometrist data -*- 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: ((chronometrist "0.7.0"))
;; Version: 0.1.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:
;;
;; This package lets users attach tags and key-values to their tracked time, similar to tags and properties in Org mode.
;;
;; To use, add one or more of these functions to any chronometrist hook except `chronometrist-before-in-functions'.
;; * `chronometrist-tags-add'
;; * `chronometrist-kv-add'
;; * `chronometrist-key-values-unified-prompt'
#+END_SRC
* Dependencies
#+BEGIN_SRC emacs-lisp
;;; Code:
(require 'chronometrist)
#+END_SRC
* Code
** Common
*** history-prep :writer:
#+BEGIN_SRC emacs-lisp
(defun chronometrist-history-prep (key history-table)
"Prepare history of KEY in HISTORY-TABLE for use in prompts.
Each value in hash table TABLE must be a list. Each value will be reversed and will have duplicate elements removed."
(--> (gethash key history-table)
(cl-remove-duplicates it :test #'equal :from-end t)
(puthash key it history-table)))
#+END_SRC
*** keyword-to-string :function:
#+BEGIN_SRC emacs-lisp
(defun chronometrist-keyword-to-string (keyword)
"Return KEYWORD as a string, with the leading \":\" removed."
(replace-regexp-in-string "^:?" "" (symbol-name keyword)))
#+END_SRC
*** maybe-string-to-symbol :function:
#+BEGIN_SRC emacs-lisp
(defun chronometrist-maybe-string-to-symbol (list)
"For each string in LIST, if it has no spaces, convert it to a symbol."
(cl-loop for string in list
if (string-match-p "[[:space:]]" string)
collect string
else collect (intern string)))
#+END_SRC
*** maybe-symbol-to-string :function:
#+BEGIN_SRC emacs-lisp
(defun chronometrist-maybe-symbol-to-string (list)
"Convert each symbol in LIST to a string."
(--map (if (symbolp it)
(symbol-name it)
it)
list))
#+END_SRC
*** plist-update :function:
#+BEGIN_SRC emacs-lisp
(defun chronometrist-plist-update (old-plist new-plist)
"Add tags and keyword-values from NEW-PLIST to OLD-PLIST.
OLD-PLIST and NEW-PLIST should be a property lists.
Keywords reserved by Chronometrist - :name, :start, and :stop -
will not be updated. Keywords in OLD-PLIST with new values in
NEW-PLIST will be updated. Tags in OLD-PLIST will be preserved
alongside new tags from NEW-PLIST."
(-let* (((&plist :name old-name :tags old-tags
:start old-start :stop old-stop) old-plist)
;; Anything that's left will be the user's key-values.
(old-kvs (chronometrist-plist-key-values old-plist))
;; Prevent the user from adding reserved key-values.
(plist (chronometrist-plist-key-values new-plist))
(new-tags (-> (append old-tags (plist-get new-plist :tags))
(cl-remove-duplicates :test #'equal)))
;; In case there is an overlap in key-values, we use
;; plist-put to replace old ones with new ones.
(new-kvs (cl-copy-list old-plist))
(new-kvs (if plist
(-> (cl-loop for (key val) on plist by #'cddr
do (plist-put new-kvs key val)
finally return new-kvs)
(chronometrist-plist-key-values))
old-kvs)))
(append `(:name ,old-name)
(when new-tags `(:tags ,new-tags))
new-kvs
`(:start ,old-start)
(when old-stop `(:stop ,old-stop)))))
#+END_SRC
** Tags
*** tags-history :variable:
:PROPERTIES:
:VALUE: hash table
:END:
#+BEGIN_SRC emacs-lisp
(defvar chronometrist-tags-history (make-hash-table :test #'equal)
"Hash table of tasks and past tag combinations.
Each value is a list of tag combinations, in reverse
chronological order. Each combination is a list containing tags
as symbol and/or strings.")
#+END_SRC
*** tags-history-populate :writer:
#+BEGIN_SRC emacs-lisp
(defun chronometrist-tags-history-populate (task history-table backend)
"Store tag history for TASK in HISTORY-TABLE from FILE.
Return the new value inserted into HISTORY-TABLE.
HISTORY-TABLE must be a hash table. (see `chronometrist-tags-history')"
(puthash task nil history-table)
(cl-loop for plist in (chronometrist-to-list backend) do
(let ((new-tag-list (plist-get plist :tags))
(old-tag-lists (gethash task history-table)))
(and (equal task (plist-get plist :name))
new-tag-list
(puthash task
(if old-tag-lists
(append old-tag-lists (list new-tag-list))
(list new-tag-list))
history-table))))
(chronometrist-history-prep task history-table))
#+END_SRC
**** tests
#+BEGIN_SRC emacs-lisp :tangle chronometrist-key-values-tests.el :load test
(ert-deftest chronometrist-tags-history ()
(progn
(clrhash chronometrist-tags-history)
(cl-loop for task in '("Guitar" "Programming") do
(chronometrist-tags-history-populate task chronometrist-tags-history "test.sexp")))
(should
(= (hash-table-count chronometrist-tags-history) 2))
(should
(cl-loop for task being the hash-keys of chronometrist-tags-history
always (stringp task)))
(should
(equal (gethash "Guitar" chronometrist-tags-history)
'((classical solo)
(classical warm-up))))
(should
(equal (gethash "Programming" chronometrist-tags-history)
'((reading) (bug-hunting)))))
#+END_SRC
*** -tag-suggestions :variable:
#+BEGIN_SRC emacs-lisp
(defvar chronometrist--tag-suggestions nil
"Suggestions for tags.
Used as history by `chronometrist-tags-prompt'.")
#+END_SRC
*** tags-history-add :writer:
#+BEGIN_SRC emacs-lisp
(defun chronometrist-tags-history-add (plist)
"Add tags from PLIST to `chronometrist-tags-history'."
(let* ((table chronometrist-tags-history)
(name (plist-get plist :name))
(tags (plist-get plist :tags))
(old-tags (gethash name table)))
(when tags
(--> (cons tags old-tags)
(puthash name it table)))))
#+END_SRC
*** tags-history-combination-strings :reader:
#+BEGIN_SRC emacs-lisp
(defun chronometrist-tags-history-combination-strings (task)
"Return list of past tag combinations for TASK.
Each combination is a string, with tags separated by commas.
This is used to provide history for `completing-read-multiple' in
`chronometrist-tags-prompt'."
(->> (gethash task chronometrist-tags-history)
(mapcar (lambda (list)
(->> list
(mapcar (lambda (elt)
(if (stringp elt)
elt
(symbol-name elt))))
(-interpose ",")
(apply #'concat))))))
#+END_SRC
*** tags-history-individual-strings :reader:
#+BEGIN_SRC emacs-lisp
(defun chronometrist-tags-history-individual-strings (task)
"Return list of tags for TASK, with each tag being a single string.
This is used to provide completion for individual tags, in
`completing-read-multiple' in `chronometrist-tags-prompt'."
(--> (gethash task chronometrist-tags-history)
(-flatten it)
(cl-remove-duplicates it :test #'equal)
(cl-loop for elt in it
collect (if (stringp elt)
elt
(symbol-name elt)))))
#+END_SRC
*** tags-prompt :reader:
#+BEGIN_SRC emacs-lisp
(defun chronometrist-tags-prompt (task &optional initial-input)
"Read one or more tags from the user and return them as a list of strings.
TASK should be a string.
INITIAL-INPUT is as used in `completing-read'."
(setq chronometrist--tag-suggestions (chronometrist-tags-history-combination-strings task))
(completing-read-multiple (concat "Tags for " task " (optional): ")
(chronometrist-tags-history-individual-strings task)
nil
'confirm
initial-input
'chronometrist--tag-suggestions))
#+END_SRC
*** tags-add :hook:writer:
#+BEGIN_SRC emacs-lisp
(defun chronometrist-tags-add (&rest _args)
"Read tags from the user; add them to the last entry in `chronometrist-file'.
_ARGS are ignored. This function always returns t, so it can be
used in `chronometrist-before-out-functions'."
(interactive)
(let* ((backend (chronometrist-active-backend))
(last-expr (chronometrist-latest-record backend))
(last-name (plist-get last-expr :name))
(_history (chronometrist-tags-history-populate last-name chronometrist-tags-history backend))
(last-tags (plist-get last-expr :tags))
(input (->> (chronometrist-maybe-symbol-to-string last-tags)
(-interpose ",")
(apply #'concat)
(chronometrist-tags-prompt last-name)
(chronometrist-maybe-string-to-symbol))))
(when input
(--> (append last-tags input)
(reverse it)
(cl-remove-duplicates it :test #'equal)
(reverse it)
(list :tags it)
(chronometrist-plist-update
(chronometrist-latest-record backend) it)
(chronometrist-replace-last backend it)))
t))
#+END_SRC
** Key-Values
*** key-values :custom:group:
#+BEGIN_SRC emacs-lisp
(defgroup chronometrist-key-values nil
"Add key-values to Chronometrist time intervals."
:group 'chronometrist)
#+END_SRC
*** use-database-history :custom:variable:
#+BEGIN_SRC emacs-lisp
(defcustom chronometrist-key-value-use-database-history t
"If non-nil, use database to generate key-value suggestions.
If nil, only `chronometrist-key-value-preset-alist' is used."
:type 'boolean
:group 'chronometrist-key-value)
#+END_SRC
*** preset-alist :custom:variable:
#+BEGIN_SRC emacs-lisp
(defcustom chronometrist-key-value-preset-alist nil
"Alist of key-value suggestions for `chronometrist-key-value' prompts.
Each element must be in the form (\"TASK\" <KEYWORD> <VALUE> ...)"
:type
'(repeat
(cons
(string :tag "Task name")
(repeat :tag "Property preset"
(plist :tag "Property"
;; :key-type 'keyword :value-type 'sexp
))))
:group 'chronometrist-key-values)
#+END_SRC
**** get-presets
#+BEGIN_SRC emacs-lisp
(defun chronometrist-key-value-get-presets (task)
"Return presets for TASK from `chronometrist-key-value-preset-alist' as a list of plists."
(alist-get task chronometrist-key-value-preset-alist nil nil #'equal))
#+END_SRC
*** kv-buffer-name :custom:variable:
#+BEGIN_SRC emacs-lisp
(defcustom chronometrist-kv-buffer-name "*Chronometrist-Key-Values*"
"Name of buffer in which key-values are entered."
:group 'chronometrist-key-values
:type 'string)
#+END_SRC
*** key-history :variable:
:PROPERTIES:
:VALUE: hash table
:END:
#+BEGIN_SRC emacs-lisp
(defvar chronometrist-key-history
(make-hash-table :test #'equal)
"Hash table to store previously-used user-keys.
Each hash key is the name of a task. Each hash value is a list
containing keywords used with that task, in reverse chronological
order. The keywords are stored as strings and their leading \":\"
is removed.")
#+END_SRC
*** key-history-populate :writer:
#+BEGIN_SRC emacs-lisp
(defun chronometrist-key-history-populate (task history-table backend)
"Store key history for TASK in HISTORY-TABLE from FILE.
Return the new value inserted into HISTORY-TABLE.
HISTORY-TABLE must be a hash table (see `chronometrist-key-history')."
(puthash task nil history-table)
(cl-loop for plist in backend do
(catch 'quit
(let* ((name (plist-get plist :name))
(_check (unless (equal name task) (throw 'quit nil)))
(keys (--> (chronometrist-plist-key-values plist)
(seq-filter #'keywordp it)
(cl-loop for key in it collect
(chronometrist-keyword-to-string key))))
(_check (unless keys (throw 'quit nil)))
(old-keys (gethash name history-table)))
(puthash name
(if old-keys (append old-keys keys) keys)
history-table))))
(chronometrist-history-prep task history-table))
#+END_SRC
**** tests
#+BEGIN_SRC emacs-lisp :tangle chronometrist-key-values-tests.el :load test
(ert-deftest chronometrist-key-history ()
(progn
(clrhash chronometrist-key-history)
(cl-loop for task in '("Programming" "Arrangement/new edition") do
(chronometrist-key-history-populate task chronometrist-key-history "test.sexp")))
(should (= (hash-table-count chronometrist-key-history) 2))
(should (= (length (gethash "Programming" chronometrist-key-history)) 3))
(should (= (length (gethash "Arrangement/new edition" chronometrist-key-history)) 2)))
#+END_SRC
*** value-history :variable:
:PROPERTIES:
:VALUE: hash table
:END:
#+BEGIN_SRC emacs-lisp
(defvar chronometrist-value-history
(make-hash-table :test #'equal)
"Hash table to store previously-used values for user-keys.
The hash table keys are user-key names (as strings), and the
values are lists containing values (as strings).")
#+END_SRC
*** value-history-populate :writer:
We don't want values to be task-sensitive, so this does not have a KEY parameter similar to TASK for =chronometrist-tags-history-populate= or =chronometrist-key-history-populate=.
#+BEGIN_SRC emacs-lisp
(defun chronometrist-value-history-populate (history-table backend)
"Store value history in HISTORY-TABLE from FILE.
HISTORY-TABLE must be a hash table. (see `chronometrist-value-history')"
(clrhash history-table)
;; Note - while keys are Lisp keywords, values may be any Lisp
;; object, including lists
(cl-loop for plist in (chronometrist-to-list backend) do
;; We call them user-key-values because we filter out Chronometrist's
;; reserved key-values
(let ((user-key-values (chronometrist-plist-key-values plist)))
(cl-loop for (key value) on user-key-values by #'cddr do
(let* ((key-string (chronometrist-keyword-to-string key))
(old-values (gethash key-string history-table))
(value (if (not (stringp value)) ;; why?
(list (format "%S" value))
(list value))))
(puthash key-string
(if old-values (append old-values value) value)
history-table)))))
(maphash (lambda (key _values)
(chronometrist-history-prep key history-table))
history-table))
#+END_SRC
**** tests
#+BEGIN_SRC emacs-lisp :tangle chronometrist-key-values-tests.el :load test
(ert-deftest chronometrist-value-history ()
(progn
(clrhash chronometrist-value-history)
(chronometrist-value-history-populate chronometrist-value-history "test.sexp"))
(should (= (hash-table-count chronometrist-value-history) 5))
(should
(cl-loop for task being the hash-keys of chronometrist-value-history
always (stringp task))))
#+END_SRC
*** -value-suggestions :variable:
#+BEGIN_SRC emacs-lisp
(defvar chronometrist--value-suggestions nil
"Suggestions for values.
Used as history by `chronometrist-value-prompt'.")
#+END_SRC
*** kv-read-mode-map :keymap:
#+BEGIN_SRC emacs-lisp
(defvar chronometrist-kv-read-mode-map
(let ((map (make-sparse-keymap)))
(define-key map (kbd "C-c C-c") #'chronometrist-kv-accept)
(define-key map (kbd "C-c C-k") #'chronometrist-kv-reject)
map)
"Keymap used by `chronometrist-kv-read-mode'.")
#+END_SRC
*** kv-read-mode :major:mode:
#+BEGIN_SRC emacs-lisp
(define-derived-mode chronometrist-kv-read-mode emacs-lisp-mode "Key-Values"
"Mode used by `chronometrist' to read key values from the user."
(->> ";; Use \\[chronometrist-kv-accept] to accept, or \\[chronometrist-kv-reject] to cancel\n"
(substitute-command-keys)
(insert)))
#+END_SRC
*** kv-completion-quit-key :reader:
#+BEGIN_SRC emacs-lisp
(defun chronometrist-kv-completion-quit-key ()
"Return appropriate keybinding (as a string) to quit from `completing-read'.
It currently supports ido, ido-ubiquitous, ivy, and helm."
(substitute-command-keys
(cond ((or (bound-and-true-p ido-mode)
(bound-and-true-p ido-ubiquitous-mode))
"\\<ido-completion-map>\\[ido-select-text]")
((bound-and-true-p ivy-mode)
"\\<ivy-minibuffer-map>\\[ivy-immediate-done]")
((bound-and-true-p helm-mode)
"\\<helm-comp-read-map>\\[helm-cr-empty-string]")
(t "leave blank"))))
#+END_SRC
*** key-prompt :reader:
#+BEGIN_SRC emacs-lisp
(defun chronometrist-key-prompt (used-keys)
"Prompt the user to enter keys.
USED-KEYS are keys they have already added since the invocation
of `chronometrist-kv-add'."
(let ((key-suggestions (--> (chronometrist-latest-record (chronometrist-active-backend))
(plist-get it :name)
(gethash it chronometrist-key-history))))
(completing-read (format "Key (%s to quit): "
(chronometrist-kv-completion-quit-key))
;; don't suggest keys which have already been used
(cl-loop for used-key in used-keys do
(setq key-suggestions
(seq-remove (lambda (key)
(equal key used-key))
key-suggestions))
finally return key-suggestions)
nil nil nil 'key-suggestions)))
#+END_SRC
*** value-prompt :writer:
#+BEGIN_SRC emacs-lisp
(defun chronometrist-value-prompt (key)
"Prompt the user to enter values.
KEY should be a string for the just-entered key."
(setq chronometrist--value-suggestions (gethash key chronometrist-value-history))
(completing-read (format "Value (%s to quit): "
(chronometrist-kv-completion-quit-key))
chronometrist--value-suggestions nil nil nil
'chronometrist--value-suggestions))
#+END_SRC
*** value-insert :writer:
#+BEGIN_SRC emacs-lisp
(defun chronometrist-value-insert (value)
"Insert VALUE into the key-value entry buffer."
(insert " ")
(cond ((or
;; list or vector
(and (string-match-p (rx (and bos (or "(" "\"" "["))) value)
(string-match-p (rx (and (or ")" "\"" "]") eos)) value))
;; int or float
(string-match-p "^[0-9]*\\.?[0-9]*$" value))
(insert value))
(t (insert "\"" value "\"")))
(insert "\n"))
#+END_SRC
*** kv-add :hook:writer:
#+BEGIN_SRC emacs-lisp
(defun chronometrist-kv-add (&rest _args)
"Read key-values from user, adding them to a temporary buffer for review.
In the resulting buffer, users can run `chronometrist-kv-accept'
to add them to the last s-expression in `chronometrist-file', or
`chronometrist-kv-reject' to cancel.
_ARGS are ignored. This function always returns t, so it can be
used in `chronometrist-before-out-functions'."
(interactive)
(let* ((buffer (get-buffer-create chronometrist-kv-buffer-name))
(first-key-p t)
(backend (chronometrist-active-backend))
(last-sexp (chronometrist-latest-record backend))
(last-name (plist-get last-sexp :name))
(last-kvs (chronometrist-plist-key-values last-sexp))
(used-keys (--map (chronometrist-keyword-to-string it)
(seq-filter #'keywordp last-kvs))))
(chronometrist-key-history-populate last-name chronometrist-key-history backend)
(chronometrist-value-history-populate chronometrist-value-history backend)
(switch-to-buffer buffer)
(with-current-buffer buffer
(erase-buffer)
(chronometrist-kv-read-mode)
(if (and (chronometrist-current-task (chronometrist-active-backend)) last-kvs)
(progn
(funcall chronometrist-sexp-pretty-print-function last-kvs buffer)
(down-list -1)
(insert "\n "))
(insert "()")
(down-list -1))
(catch 'empty-input
(let (input key value)
(while t
(setq key (chronometrist-key-prompt used-keys)
input key
used-keys (append used-keys
(list key)))
(if (string-empty-p input)
(throw 'empty-input nil)
(unless first-key-p
(insert " "))
(insert ":" key)
(setq first-key-p nil))
(setq value (chronometrist-value-prompt key)
input value)
(if (string-empty-p input)
(throw 'empty-input nil)
(chronometrist-value-insert value)))))
(chronometrist-sexp-reindent-buffer))
t))
#+END_SRC
*** kv-accept :command:
#+BEGIN_SRC emacs-lisp
(defun chronometrist-kv-accept ()
"Accept the plist in `chronometrist-kv-buffer-name' and add it to `chronometrist-file'."
(interactive)
(let* ((backend (chronometrist-active-backend))
(latest (chronometrist-latest-record backend))
user-kv-expr)
(with-current-buffer (get-buffer chronometrist-kv-buffer-name)
(goto-char (point-min))
(setq user-kv-expr (ignore-errors (read (current-buffer))))
(kill-buffer chronometrist-kv-buffer-name))
(if user-kv-expr
(chronometrist-replace-last backend (chronometrist-plist-update latest user-kv-expr))
(chronometrist-refresh))))
#+END_SRC
*** kv-reject :command:
#+BEGIN_SRC emacs-lisp
(defun chronometrist-kv-reject ()
"Reject the property list in `chronometrist-kv-buffer-name'."
(interactive)
(kill-buffer chronometrist-kv-buffer-name)
(chronometrist-refresh))
#+END_SRC
*** chronometrist-key-value-menu :menu:
#+BEGIN_SRC emacs-lisp
(easy-menu-define chronometrist-key-value-menu chronometrist-mode-map
"Key value menu for Chronometrist mode."
'("Key-Values"
["Change tags for active/last interval" chronometrist-tags-add]
["Change key-values for active/last interval" chronometrist-kv-add]
["Change tags and key-values for active/last interval"
chronometrist-key-values-unified-prompt]))
#+END_SRC
** WIP Single-key prompts [0%]
This was initially implemented using Hydra. But, at the moment of reckoning, it turned out that Hydra does not pause Emacs until the user provides an input, and is thus unsuited for use in a hook. Thus, we created a new library called =choice.el= which functions similarly to Hydra (associations of keys, Lisp forms, and hints are passed to a macro which emits a prompt function) and used that.
Then I discovered that there's =rmc.el= which does about the same thing.
1. [ ] Rewrite these using =rmc.el=
Types of prompts planned (#1 and #2 are meant to be mixed and matched)
1. [-] =(tag|key-value)-combination-choice= - select combinations of (tags|key-values)
* commands
+ 0-9 - use combination (and exit)
+ C-u 0-9 - edit combination (then exit)
+ s - skip (exit)
+ (b - back [to previous prompt])
* [X] tag-combination-prompt
* [ ] key-value-combination-prompt
2. [ ] =(tag|key|value)-multiselect-choice= - select individual (tags|keys|values)
* commands
+ 0-9 - select (toggles; save in var; doesn't exit)
+ u - use selection (and exit)
+ e - edit selection (then exit)
+ n - new tag/key/value
+ s - skip (exit)
+ (b - back [to previous prompt])
Great for values; makes it easy to add multiple values, too, especially for users who don't know Lisp.
3. [-] =unified-choice= - select tag-key-value combinations, all in one prompt
* commands
+ 0-9 - use combination (and exit)
+ C-u 0-9 - edit combination (then exit)
+ s - skip (exit)
* [X] basic implementation
* [ ] make it more aesthetically pleasing in case of long suggestion strings
*** defchoice :function:
#+BEGIN_SRC emacs-lisp :tangle no :load no
(defun chronometrist-defchoice (name type list)
"Construct and evaluate a `defchoice' form.
NAME should be a string - `defchoice' will be called with chronometrist-NAME.
TYPE should be a :key-values or :tags.
LIST should be a list, with all elements being either a plists,
or lists of symbols."
(cl-loop with backend = (chronometrist-active-backend)
with num = 0
with last = (chronometrist-latest-record backend)
for elt in (-take 7 list)
do (incf num)
if (= num 10) do (setq num 0)
collect
(list (format "%s" num)
`(chronometrist-replace-last
backend
(chronometrist-plist-update last
',(cl-case type
(:tags (list :tags elt))
(:key-values elt))))
(format "%s" elt)) into numeric-commands
finally do (eval
`(defchoice ,(intern (format "chronometrist-%s" name))
,@numeric-commands
("s" nil "skip")))))
#+END_SRC
*** tag-choice :function:
#+BEGIN_SRC emacs-lisp :tangle no :load no
(defun chronometrist-tag-choice (task)
"Query user for tags to be added to TASK.
Return t, to permit use in `chronometrist-before-out-functions'."
(let ((table chronometrist-tags-history))
(chronometrist-tags-history-populate task table (chronometrist-active-backend))
(if (hash-table-empty-p table)
(chronometrist-tags-add)
(chronometrist-defchoice "tag" :tag (gethash task table))
(chronometrist-tag-choice-prompt "Which tags?"))
t))
#+END_SRC
*** WIP chronometrist-key-choice :hook:writer:
#+BEGIN_SRC emacs-lisp :tangle no :load no
(defun chronometrist-key-choice (task)
"Query user for keys to be added to TASK.
Return t, to permit use in `chronometrist-before-out-functions'."
(let ((table chronometrist-key-history))
(chronometrist-key-history-populate task table (chronometrist-active-backend))
(if (hash-table-empty-p table)
(chronometrist-kv-add)
(chronometrist-defchoice :key task table)
(chronometrist-key-choice-prompt "Which keys?"))
t))
#+END_SRC
*** WIP chronometrist-kv-prompt-helper :function:
#+BEGIN_SRC emacs-lisp :tangle no :load no
(defun chronometrist-kv-prompt-helper (mode task)
(let ((table (case mode
(:tag chronometrist-tags-history)
(:key chronometrist-key-history)
(:value chronometrist-value-history)))
())))
#+END_SRC
*** WIP unified-prompt :hook:writer:
:PROPERTIES:
:CUSTOM_ID: unified-prompt
:END:
1. [ ] Improve appearance - is there an easy way to syntax highlight the plists?
#+BEGIN_SRC emacs-lisp
(cl-defun chronometrist-key-values-unified-prompt
(&optional (task (plist-get (chronometrist-latest-record (chronometrist-active-backend)) :name)))
"Query user for tags and key-values to be added for TASK.
Return t, to permit use in `chronometrist-before-out-functions'."
(interactive)
(let* ((backend (chronometrist-active-backend))
(presets (--map (format "%S" it)
(chronometrist-key-value-get-presets task)))
(key-values
(when chronometrist-key-value-use-database-history
(cl-loop for plist in (chronometrist-to-list backend)
when (equal (plist-get plist :name) task)
collect
(let ((plist (chronometrist-plist-remove plist :name :start :stop)))
(when plist (format "%S" plist)))
into key-value-plists
finally return
(--> (seq-filter #'identity key-value-plists)
(cl-remove-duplicates it :test #'equal :from-end t)))))
(latest (chronometrist-latest-record backend)))
(if (and (null presets) (null key-values))
(progn (chronometrist-tags-add) (chronometrist-kv-add))
(let* ((candidates (append presets key-values))
(input (completing-read
(format "Key-values for %s: " task)
candidates nil nil nil 'chronometrist-key-values-unified-prompt-history)))
(chronometrist-replace-last backend
(chronometrist-plist-update latest
(read input))))))
t)
#+END_SRC
* Provide
#+BEGIN_SRC emacs-lisp
(provide 'chronometrist-key-values)
;;; chronometrist-key-values.el ends here
#+END_SRC
* Local variables :noexport:
# Local Variables:
# my-org-src-default-lang: "emacs-lisp"
# eval: (when (package-installed-p 'literate-elisp) (require 'literate-elisp) (literate-elisp-load (buffer-file-name)))
# End:

View File

@ -0,0 +1,127 @@
;;; chronometrist-migrate.el --- Commands to aid in migrating from timeclock to chronometrist s-expr format -*- lexical-binding: t; -*-
;; Author: contrapunctus <xmpp:contrapunctus@jabber.fr>
;; This is free and unencumbered software released into the public domain.
;;
;; Anyone is free to copy, modify, publish, use, compile, sell, or
;; distribute this software, either in source code form or as a compiled
;; binary, for any purpose, commercial or non-commercial, and by any
;; means.
;;
;; For more information, please refer to <https://unlicense.org>
;;; Commentary:
;;; Code:
(require 'cl-lib)
(require 'dash)
(require 'seq)
(require 'chronometrist-common)
(require 'chronometrist-time)
(require 'chronometrist-plist-pp)
(defvar chronometrist-file)
(defvar chronometrist-migrate-table (make-hash-table))
;; TODO - support other timeclock codes (currently only "i" and "o"
;; are supported.)
(defun chronometrist-migrate-populate (in-file)
"Read data from IN-FILE to `chronometrist-migrate-table'.
IN-FILE should be a file in the format supported by timeclock.el.
See `timeclock-log-data' for a description."
(clrhash chronometrist-migrate-table)
(with-current-buffer (find-file-noselect in-file)
(save-excursion
(goto-char (point-min))
(let ((key-counter 0))
(while (not (eobp))
(let* ((event-string (buffer-substring-no-properties (point-at-bol)
(point-at-eol)))
(event-list (split-string event-string "[ /:]"))
(code (cl-first event-list))
(date-time (--> event-list
(seq-drop it 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)))
(defvar timeclock-file)
(defun chronometrist-migrate-timelog-file->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
(chronometrist-common-clear-buffer output)
(chronometrist-migrate-populate in-file)
(maphash (lambda (_key value)
(chronometrist-plist-pp value output)
(insert "\n\n"))
chronometrist-migrate-table)
(save-buffer)))))
(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->sexp-file timeclock-file chronometrist-file)
(message "You can migrate later using `chronometrist-migrate-timelog-file->sexp-file'."))))
(provide 'chronometrist-migrate)
;;; chronometrist-migrate.el ends here

View File

@ -0,0 +1,162 @@
;;; chronometrist-plist-pp.el --- Functions to pretty print property lists -*- lexical-binding: t; -*-
;; Author: contrapunctus <xmpp:contrapunctus@jabber.fr>
;; This is free and unencumbered software released into the public domain.
;;
;; Anyone is free to copy, modify, publish, use, compile, sell, or
;; distribute this software, either in source code form or as a compiled
;; binary, for any purpose, commercial or non-commercial, and by any
;; means.
;;
;; For more information, please refer to <https://unlicense.org>
;;; Commentary:
;;; Code:
(defvar chronometrist-plist-pp-whitespace-re "[\n\t\s]")
(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 (concat chronometrist-plist-pp-whitespace-re "+"))
(delete-region (match-beginning 0) (match-end 0))
(insert " ")))
(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)))
(defun chronometrist-plist-pp-pair-p (cons)
(and (listp cons) (not (listp (cdr cons)))))
(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))))
(defun chronometrist-plist-pp-plist-p (list)
(while (consp list)
(setq list (if (and (keywordp (car list))
(consp (cdr list)))
(cddr list)
'not-plist)))
(null list))
(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)))))
(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))
(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))))
(progn
(setq sexp (save-excursion (read (current-buffer))))
(cond
((chronometrist-plist-pp-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 (concat "^" chronometrist-plist-pp-whitespace-re "*$")
(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)))))
(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-pp-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) ?\ )))))
(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)))
(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)))
(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)))
(provide 'chronometrist-plist-pp)
;;; chronometrist-plist-pp.el ends here

View File

@ -0,0 +1,86 @@
;;; chronometrist-queries.el --- Functions which query Chronometrist data -*- lexical-binding: t; -*-
;; Author: contrapunctus <xmpp:contrapunctus@jabber.fr>
;; This is free and unencumbered software released into the public domain.
;;
;; Anyone is free to copy, modify, publish, use, compile, sell, or
;; distribute this software, either in source code form or as a compiled
;; binary, for any purpose, commercial or non-commercial, and by any
;; means.
;;
;; For more information, please refer to <https://unlicense.org>
;;; Commentary:
;;
;;; Code:
(require 'dash)
(require 'chronometrist-common)
(require 'chronometrist-events)
(defun chronometrist-last ()
"Return the last entry from `chronometrist-file' as a plist."
(chronometrist-sexp-last))
(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->ts-pairs task-events)
(chronometrist-ts-pairs->durations)
(-reduce #'+)
(truncate))
;; no events for this task on TS, i.e. no time spent
0)))
(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."
(->> chronometrist-task-list
(--map (chronometrist-task-time-one-day it ts))
(-reduce #'+)
(truncate)))
(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. (see `chronometrist-events-clean')"
(let ((count 0))
(maphash (lambda (_date events)
(when (seq-find (lambda (event)
(equal (plist-get event :name) task))
events)
(cl-incf count)))
table)
count))
(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. (see `chronometrist-events-clean')"
(->> (gethash (ts-format "%F" ts) chronometrist-events)
(mapcar (lambda (event)
(when (equal task (plist-get event :name))
event)))
(seq-filter #'identity)))
(provide 'chronometrist-queries)
;;; chronometrist-queries.el ends here

View File

@ -0,0 +1,295 @@
;;; chronometrist-report.el --- Report view for Chronometrist -*- lexical-binding: t; -*-
;; Author: contrapunctus <xmpp:contrapunctus@jabber.fr>
;; This is free and unencumbered software released into the public domain.
;;
;; Anyone is free to copy, modify, publish, use, compile, sell, or
;; distribute this software, either in source code form or as a compiled
;; binary, for any purpose, commercial or non-commercial, and by any
;; means.
;;
;; For more information, please refer to <https://unlicense.org>
;;; Commentary:
;;
(require 'filenotify)
(require 'subr-x)
(require 'chronometrist-common)
(require 'chronometrist-queries)
(require 'chronometrist-migrate)
(declare-function chronometrist-refresh-file "chronometrist.el")
;; TODO - improve first-run (no file, or no data in file) behaviour
;; TODO - add support for custom week start day to
;; tabulated-list-format. Have it use chronometrist-report-weekday-number-alist for day
;; names to aid i10n
;; TODO - use variables instead of hardcoded numbers to determine spacing
;; ## VARIABLES ##
;;; Code:
(defgroup chronometrist-report nil
"Weekly report for the `chronometrist' time tracker."
:group 'chronometrist)
(defcustom chronometrist-report-buffer-name "*Chronometrist-Report*"
"The name of the buffer created by `chronometrist-report'."
:type 'string)
(defcustom chronometrist-report-week-start-day "Sunday"
"The day used for start of week by `chronometrist-report'."
:type 'string)
(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)
(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\".")
(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\"))")
(defvar chronometrist-report--point nil)
;; ## FUNCTIONS ##
(defun chronometrist-report-date ()
"Return the date specified by `chronometrist-report--ui-date'.
If it is nil, return the current date as calendrical
information (see (info \"(elisp)Time Conversion\"))."
(if chronometrist-report--ui-date chronometrist-report--ui-date (chronometrist-date)))
(defun chronometrist-report-date->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)))
(defun chronometrist-report-date->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->dates-in-week)))
(defun chronometrist-report-entries ()
"Create entries to be displayed in the `chronometrist-report' buffer."
(let* ((week-dates (chronometrist-report-date->week-dates))) ;; uses today if chronometrist-report--ui-date is nil
(setq chronometrist-report--ui-week-dates week-dates)
(cl-loop 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-time
durations))
(total-duration (->> (-reduce #'+ durations)
(chronometrist-format-time)
(vector))))
(list task
(vconcat
(vector task)
duration-strings ;; vconcat converts lists to vectors
total-duration))))))
(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 "")))
;; TODO - preserve point when clicking buttons
(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 (->> chronometrist-report--ui-week-dates
(mapcar #'chronometrist-date)
(mapcar #'chronometrist-active-time-one-day))))
(goto-char (point-min))
(insert " ")
(insert (mapconcat (lambda (ts)
(ts-format "%F" ts))
(chronometrist-report-date->week-dates)
" "))
(insert "\n")
(goto-char (point-max))
(insert w (format "%- 21s" "Total"))
(->> total-time-daily
(mapcar #'chronometrist-format-time)
(--map (format "% 9s " it))
(apply #'insert))
(->> total-time-daily
(-reduce #'+)
(chronometrist-format-time)
(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)))
(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))))
;; REVIEW - merge this into `chronometrist-refresh-file', while moving the -refresh call to the call site?
(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-events-clean)
(chronometrist-report-refresh))
;; ## MAJOR MODE ##
(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'.")
(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-entries)
(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))))
;; ## COMMANDS ##
;;;###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-common-create-file)
(chronometrist-report-mode)
(switch-to-buffer buffer)
(chronometrist-report-refresh-file nil)
(goto-char (or chronometrist-report--point 1)))))))
(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))
(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)))
(provide 'chronometrist-report)
;;; chronometrist-report.el ends here

152
elisp/chronometrist-sexp.el Normal file
View File

@ -0,0 +1,152 @@
;;; chronometrist-sexp.el --- s-expression backend for Chronometrist -*- lexical-binding: t; -*-
;;; Commentary:
;;
;;; Code:
;; chronometrist-file (-custom)
;; chronometrist-events, chronometrist-events-maybe-split (-events)
(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)
(define-derived-mode chronometrist-sexp-mode
;; fundamental-mode
emacs-lisp-mode
"chronometrist-sexp")
(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)))
(defmacro chronometrist-loop-file (for expr in file &rest loop-clauses)
"`cl-loop' LOOP-CLAUSES over s-expressions in FILE, in reverse.
VAR 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)))
;;;; Queries
(defun chronometrist-sexp-open-log ()
"Open `chronometrist-file' in another window."
(find-file-other-window chronometrist-file)
(goto-char (point-max)))
(defun chronometrist-sexp-last ()
"Return last s-expression from `chronometrist-file'."
(chronometrist-sexp-in-file chronometrist-file
(goto-char (point-max))
(backward-list)
(ignore-errors (read (current-buffer)))))
(defun chronometrist-sexp-current-task ()
"Return the name of the currently clocked-in task, or nil if not clocked in."
(let ((last-event (chronometrist-sexp-last)))
(if (plist-member last-event :stop)
nil
(plist-get last-event :name))))
(defun chronometrist-sexp-events-populate ()
"Populate hash table `chronometrist-events'.
The data is acquired from `chronometrist-file'.
Return final number of events read from file, or nil if there
were none."
(chronometrist-sexp-in-file chronometrist-file
(goto-char (point-min))
(let ((index 0) expr pending-expr)
(while (or pending-expr
(setq expr (ignore-errors (read (current-buffer)))))
;; find and split midnight-spanning events during deserialization itself
(let* ((split-expr (chronometrist-events-maybe-split expr))
(new-value (cond (pending-expr
(prog1 pending-expr
(setq pending-expr nil)))
(split-expr
(setq pending-expr (cl-second split-expr))
(cl-first split-expr))
(t expr)))
(new-value-date (->> (plist-get new-value :start)
(s-left 10)))
(existing-value (gethash new-value-date chronometrist-events)))
(unless pending-expr (cl-incf index))
(puthash new-value-date
(if existing-value
(append existing-value
(list new-value))
(list new-value))
chronometrist-events)))
(unless (zerop index) index))))
;;;; Modifications
(defun chronometrist-sexp-create-file ()
"Create `chronometrist-file' if it doesn't already exist."
(unless (file-exists-p chronometrist-file)
(with-current-buffer (find-file-noselect chronometrist-file)
(goto-char (point-min))
(insert ";;; -*- mode: chronometrist-sexp; -*-")
(write-file chronometrist-file))))
(cl-defun chronometrist-sexp-new (plist)
"Add new PLIST at the end of `chronometrist-file'."
(chronometrist-sexp-in-file chronometrist-file
(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)))
(defun chronometrist-sexp-delete-list (&optional arg)
"Delete ARG lists after point."
(let ((point-1 (point)))
(forward-sexp (or arg 1))
(delete-region point-1 (point))))
(defun chronometrist-sexp-replace-last (plist)
"Replace the last s-expression in `chronometrist-file' with PLIST."
(chronometrist-sexp-in-file chronometrist-file
(goto-char (point-max))
(unless (and (bobp) (bolp)) (insert "\n"))
(backward-list 1)
(chronometrist-sexp-delete-list)
(funcall chronometrist-sexp-pretty-print-function plist (current-buffer))
(save-buffer)))
(defun chronometrist-sexp-reindent-buffer ()
"Reindent the current buffer.
This is meant to be run in `chronometrist-file' when using the s-expression backend."
(interactive)
(let (expr)
(goto-char (point-min))
(while (setq expr (ignore-errors (read (current-buffer))))
(backward-list)
(chronometrist-sexp-delete-list)
(when (looking-at "\n*")
(delete-region (match-beginning 0) (match-end 0)))
(funcall chronometrist-sexp-pretty-print-function expr (current-buffer))
(insert "\n")
(unless (eobp) (insert "\n")))))
(provide 'chronometrist-sexp)
;;; chronometrist-sexp.el ends here

View File

@ -1,104 +0,0 @@
;;; chronometrist-spark.el --- Show sparklines in Chronometrist buffers -*- 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") (chronometrist "0.7.0") (spark "0.1"))
;; Version: 0.1.0
;; This is free and unencumbered software released into the public domain.
;;
;; Anyone is free to copy, modify, publish, use, compile, sell, or
;; distribute this software, either in source code form or as a compiled
;; binary, for any purpose, commercial or non-commercial, and by any
;; means.
;;
;; For more information, please refer to <https://unlicense.org>
;;; Commentary:
;;
;; This package adds a column to Chronometrist displaying sparklines for each task.
;;; Code:
;; This file was automatically generated from chronometrist-spark.org.
(require 'chronometrist)
(require 'spark)
(defgroup chronometrist-spark nil
"Show sparklines in `chronometrist'."
:group 'applications)
(defcustom chronometrist-spark-length 7
"Length of each sparkline in number of days."
:type 'integer)
(defcustom chronometrist-spark-show-range t
"If non-nil, display range of each sparkline."
:type 'boolean)
(defun chronometrist-spark-range (durations)
"Return range for DURATIONS as a string.
DURATIONS must be a list of integer seconds."
(let* ((duration-minutes (--map (/ it 60) durations))
(durations-nonzero (seq-remove #'zerop duration-minutes))
(length (length durations-nonzero)))
(cond ((not durations-nonzero) "")
((> length 1)
(format "(%sm~%sm)" (apply #'min durations-nonzero)
(apply #'max duration-minutes)))
((= 1 length)
;; This task only had activity on one day in the given
;; range of days - these durations, then, cannot really
;; have a minimum and maximum range.
(format "(%sm)" (apply #'max duration-minutes))))))
(defun chronometrist-spark-durations (task length stop-ts)
"Return a list of durations for time tracked for TASK in the last LENGTH days before STOP-TS."
(cl-loop for day from (- (- length 1)) to 0
collect
(chronometrist-task-time-one-day task (ts-adjust 'day day stop-ts))))
(defun chronometrist-spark-row-transformer (row)
"Add a sparkline cell to ROW.
Used to add a sparkline column to `chronometrist-rows'.
ROW must be a valid element of the list specified by
`tabulated-list-entries'."
(-let* (((task vector) row)
(durations (chronometrist-spark-durations task chronometrist-spark-length (ts-now)))
(sparkline (if (and (not (seq-every-p #'zerop durations))
chronometrist-spark-show-range)
(format "%s %s" (spark durations) (chronometrist-spark-range durations))
(format "%s" (spark durations)))))
(list task (vconcat vector `[,sparkline]))))
(defun chronometrist-spark-schema-transformer (schema)
"Add a sparkline column to SCHEMA.
Used to add a sparkline column to `chronometrist-schema-transformers'.
SCHEMA should be a vector as specified by `tabulated-list-format'."
(vconcat schema `[("Graph"
,(if chronometrist-spark-show-range
(+ chronometrist-spark-length 12)
chronometrist-spark-length)
t)]))
(defun chronometrist-spark-setup ()
"Add `chronometrist-sparkline' functions to `chronometrist' hooks."
(add-to-list 'chronometrist-row-transformers #'chronometrist-spark-row-transformer)
(add-to-list 'chronometrist-schema-transformers #'chronometrist-spark-schema-transformer))
(defun chronometrist-spark-teardown ()
"Remove `chronometrist-sparkline' functions from `chronometrist' hooks."
(setq chronometrist-row-transformers
(remove #'chronometrist-spark-row-transformer chronometrist-row-transformers)
chronometrist-schema-transformers
(remove #'chronometrist-spark-schema-transformer chronometrist-schema-transformers)))
(define-minor-mode chronometrist-spark-minor-mode
nil nil nil nil
;; when being enabled/disabled, `chronometrist-spark-minor-mode' will already be t/nil here
(if chronometrist-spark-minor-mode (chronometrist-spark-setup) (chronometrist-spark-teardown)))
(provide 'chronometrist-spark)
;;; chronometrist-spark.el ends here

View File

@ -1,177 +0,0 @@
#+TITLE: chronometrist-spark
#+AUTHOR: contrapunctus
#+SUBTITLE: Show sparklines in Chronometrist
#+PROPERTY: header-args :tangle yes :load yes
* Library headers and commentary
#+BEGIN_SRC emacs-lisp
;;; chronometrist-spark.el --- Show sparklines in Chronometrist buffers -*- 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") (chronometrist "0.7.0") (spark "0.1"))
;; Version: 0.1.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:
;;
;; This package adds a column to Chronometrist displaying sparklines for each task.
#+END_SRC
* Dependencies
#+BEGIN_SRC emacs-lisp
;;; Code:
;; This file was automatically generated from chronometrist-spark.org.
(require 'chronometrist)
(require 'spark)
#+END_SRC
* Code
** custom group :custom:group:
#+BEGIN_SRC emacs-lisp
(defgroup chronometrist-spark nil
"Show sparklines in `chronometrist'."
:group 'applications)
#+END_SRC
** length :custom:variable:
#+BEGIN_SRC emacs-lisp
(defcustom chronometrist-spark-length 7
"Length of each sparkline in number of days."
:type 'integer)
#+END_SRC
** show-range :custom:variable:
#+BEGIN_SRC emacs-lisp
(defcustom chronometrist-spark-show-range t
"If non-nil, display range of each sparkline."
:type 'boolean)
#+END_SRC
** range :function:
#+BEGIN_SRC emacs-lisp
(defun chronometrist-spark-range (durations)
"Return range for DURATIONS as a string.
DURATIONS must be a list of integer seconds."
(let* ((duration-minutes (--map (/ it 60) durations))
(durations-nonzero (seq-remove #'zerop duration-minutes))
(length (length durations-nonzero)))
(cond ((not durations-nonzero) "")
((> length 1)
(format "(%sm~%sm)" (apply #'min durations-nonzero)
(apply #'max duration-minutes)))
((= 1 length)
;; This task only had activity on one day in the given
;; range of days - these durations, then, cannot really
;; have a minimum and maximum range.
(format "(%sm)" (apply #'max duration-minutes))))))
#+END_SRC
*** tests
#+BEGIN_SRC emacs-lisp :tangle ../tests/chronometrist-spark-tests :load test
(ert-deftest chronometrist-spark-range ()
(should (equal (chronometrist-spark-range '(0 0 0)) ""))
(should (equal (chronometrist-spark-range '(0 1 2)) ""))
(should (equal (chronometrist-spark-range '(60 0 0)) "(1m)"))
(should (equal (chronometrist-spark-range '(60 0 120)) "(1m~2m)")))
#+END_SRC
** durations :function:
#+BEGIN_SRC emacs-lisp
(defun chronometrist-spark-durations (task length stop-ts)
"Return a list of durations for time tracked for TASK in the last LENGTH days before STOP-TS."
(cl-loop for day from (- (- length 1)) to 0
collect
(chronometrist-task-time-one-day task (ts-adjust 'day day stop-ts))))
#+END_SRC
** TODO row-transformer :function:
if larger than 7
add space after (% length 7)th element
then add space after every 7 elements
+ if task has no time tracked for it - ""
+ don't display 0 as the minimum time tracked
+ [ ] if task has only one day of time tracked - "(40m)"
#+BEGIN_SRC emacs-lisp
(defun chronometrist-spark-row-transformer (row)
"Add a sparkline cell to ROW.
Used to add a sparkline column to `chronometrist-rows'.
ROW must be a valid element of the list specified by
`tabulated-list-entries'."
(-let* (((task vector) row)
(durations (chronometrist-spark-durations task chronometrist-spark-length (ts-now)))
(sparkline (if (and (not (seq-every-p #'zerop durations))
chronometrist-spark-show-range)
(format "%s %s" (spark durations) (chronometrist-spark-range durations))
(format "%s" (spark durations)))))
(list task (vconcat vector `[,sparkline]))))
#+END_SRC
** TODO schema-transformer :function:
calculate length while accounting for space
#+BEGIN_SRC emacs-lisp
(defun chronometrist-spark-schema-transformer (schema)
"Add a sparkline column to SCHEMA.
Used to add a sparkline column to `chronometrist-schema-transformers'.
SCHEMA should be a vector as specified by `tabulated-list-format'."
(vconcat schema `[("Graph"
,(if chronometrist-spark-show-range
(+ chronometrist-spark-length 12)
chronometrist-spark-length)
t)]))
#+END_SRC
** setup :writer:
#+BEGIN_SRC emacs-lisp
(defun chronometrist-spark-setup ()
"Add `chronometrist-sparkline' functions to `chronometrist' hooks."
(add-to-list 'chronometrist-row-transformers #'chronometrist-spark-row-transformer)
(add-to-list 'chronometrist-schema-transformers #'chronometrist-spark-schema-transformer))
#+END_SRC
** teardown :writer:
#+BEGIN_SRC emacs-lisp
(defun chronometrist-spark-teardown ()
"Remove `chronometrist-sparkline' functions from `chronometrist' hooks."
(setq chronometrist-row-transformers
(remove #'chronometrist-spark-row-transformer chronometrist-row-transformers)
chronometrist-schema-transformers
(remove #'chronometrist-spark-schema-transformer chronometrist-schema-transformers)))
#+END_SRC
** minor-mode :minor:mode:
#+BEGIN_SRC emacs-lisp
(define-minor-mode chronometrist-spark-minor-mode
nil nil nil nil
;; when being enabled/disabled, `chronometrist-spark-minor-mode' will already be t/nil here
(if chronometrist-spark-minor-mode (chronometrist-spark-setup) (chronometrist-spark-teardown)))
#+END_SRC
* Provide
#+BEGIN_SRC emacs-lisp
(provide 'chronometrist-spark)
;;; chronometrist-spark.el ends here
#+END_SRC
* Local variables :noexport:
# Local Variables:
# eval: (when (package-installed-p 'literate-elisp) (require 'literate-elisp) (literate-elisp-load (buffer-file-name)))
# End:

View File

@ -1,210 +0,0 @@
;;; chronometrist-sqlite.el --- SQLite backend for Chronometrist -*- 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 "24.3") (chronometrist "0.9.0") (emacsql-sqlite "1.0.0"))
;; Version: 0.1.0
;; This is free and unencumbered software released into the public domain.
;;
;; Anyone is free to copy, modify, publish, use, compile, sell, or
;; distribute this software, either in source code form or as a compiled
;; binary, for any purpose, commercial or non-commercial, and by any
;; means.
;;
;; For more information, please refer to <https://unlicense.org>
;;; Commentary:
;;
;; This package provides an SQLite 3 backend for Chronometrist.
;;; Code:
(require 'chronometrist)
(require 'emacsql-sqlite)
(defclass chronometrist-sqlite-backend (chronometrist-backend chronometrist-file-backend-mixin)
((extension :initform "sqlite"
:accessor chronometrist-backend-ext
:custom 'string)
(connection :initform nil
:initarg :connection
:accessor chronometrist-backend-connection)))
(chronometrist-register-backend
:sqlite "Store records in SQLite database."
(make-instance 'chronometrist-sqlite-backend :path chronometrist-file))
(cl-defmethod initialize-instance :after ((backend chronometrist-sqlite-backend)
&rest _initargs)
"Initialize connection for BACKEND based on its file."
(with-slots (file connection) backend
(when (and file (not connection))
(setf connection (emacsql-sqlite file)))))
(cl-defmethod chronometrist-create-file ((backend chronometrist-sqlite-backend) &optional file)
"Create file for BACKEND if it does not already exist.
Return the connection object from `emacsql-sqlite'."
(let* ((file (or file (chronometrist-backend-file backend)))
(db (or (chronometrist-backend-connection backend)
(setf (chronometrist-backend-connection backend)
(emacsql-sqlite file)))))
(cl-loop
for query in
'(;; Properties are user-defined key-values stored as JSON.
[:create-table properties
([(prop-id integer :primary-key)
(properties text :unique :not-null)])]
;; An event is a timestamp with a name and optional properties.
[:create-table event-names
([(name-id integer :primary-key)
(name text :unique :not-null)])]
[:create-table events
([(event-id integer :primary-key)
(name-id integer :not-null :references event-names [name-id])])]
;; An interval is a time range with a name and optional properties.
[:create-table interval-names
([(name-id integer :primary-key)
(name text :unique :not-null)])]
[:create-table intervals
([(interval-id integer :primary-key)
(name-id integer :not-null :references interval-names [name-id])
(start-time integer :not-null)
;; The latest interval may be ongoing, so the stop time may be NULL.
(stop-time integer)
(prop-id integer :references properties [prop-id])]
(:unique [name-id start-time stop-time]))]
;; A date contains one or more events and intervals. It may
;; also contain properties.
[:create-table dates
([(date-id integer :primary-key)
(date integer :unique :not-null)
(prop-id integer :references properties [prop-id])])]
[:create-table date-events
([(date-id integer :not-null :references dates [date-id])
(event-id integer :not-null :references events [event-id])])]
[:create-table date-intervals
([(date-id integer :not-null :references dates [date-id])
(interval-id integer :not-null :references intervals [interval-id])])])
do (emacsql db query)
finally return db)))
(defun chronometrist-iso-to-unix (timestamp)
(truncate (float-time (parse-iso8601-time-string timestamp))))
(cl-defmethod chronometrist-to-file (hash-table (backend chronometrist-sqlite-backend) file)
(with-slots (connection) backend
(delete-file file)
(when connection (emacsql-close connection))
(setf connection nil)
(chronometrist-create-file backend file)
(cl-loop for date in (sort (hash-table-keys hash-table) #'string-lessp) do
;; insert date if it does not exist
(emacsql connection [:insert-or-ignore-into dates [date] :values [$s1]]
(chronometrist-iso-to-unix date))
(cl-loop for plist in (gethash date hash-table) do
(chronometrist-insert backend plist)))))
(defun chronometrist-sqlite-insert-properties (backend plist)
"Insert properties from PLIST to (SQLite) BACKEND.
Properties are key-values excluding :name, :start, and :stop.
Insert nothing if the properties already exist. Return the
prop-id of the inserted or existing property."
(with-slots (connection) backend
(let* ((plist (chronometrist-plist-key-values plist))
(props (if (functionp chronometrist-sqlite-properties-function)
(funcall chronometrist-sqlite-properties-function plist)
plist)))
(emacsql connection
[:insert-or-ignore-into properties [properties] :values [$s1]]
props)
(caar (emacsql connection [:select [prop-id]
:from properties
:where (= properties $s1)]
props)))))
(defun chronometrist-sqlite-properties-to-json (plist)
"Return PLIST as a JSON string."
(json-encode
;; `json-encode' throws an error when it thinks
;; it sees "alists" which have numbers as
;; "keys", so we convert any cons cells and any
;; lists starting with a number to vectors
(-tree-map (lambda (elt)
(cond ((chronometrist-pp-pair-p elt)
(vector (car elt) (cdr elt)))
((consp elt)
(vconcat elt))
(t elt)))
plist)))
(defcustom chronometrist-sqlite-properties-function nil
"Function used to control the encoding of user key-values.
The function must accept a single argument, the plist of key-values.
Any non-function value results in key-values being inserted as
s-expressions in a text column."
:type '(choice function (sexp :tag "Insert as s-expressions")))
(cl-defmethod chronometrist-insert ((backend chronometrist-sqlite-backend) plist)
(-let (((plist-1 plist-2) (chronometrist-split-plist plist))
(db (chronometrist-backend-connection backend)))
(cl-loop for plist in (if (and plist-1 plist-2)
(list plist-1 plist-2)
(list plist))
do
(-let* (((&plist :name name :start start :stop stop) plist)
(date-unix (chronometrist-iso-to-unix (chronometrist-iso-to-date start)))
(start-unix (chronometrist-iso-to-unix start))
(stop-unix (and stop (chronometrist-iso-to-unix stop)))
name-id interval-id prop-id)
;; insert name if it does not exist
(emacsql db [:insert-or-ignore-into interval-names [name]
:values [$s1]]
name)
;; insert interval properties if they do not exist
(setq prop-id (chronometrist-sqlite-insert-properties backend plist))
;; insert interval and associate it with the date
(setq name-id
(caar (emacsql db [:select [name-id]
:from interval-names
:where (= name $s1)]
name)))
(emacsql db [:insert-or-ignore-into intervals
[name-id start-time stop-time prop-id]
:values [$s1 $s2 $s3 $s4]]
name-id start-unix stop-unix prop-id)
(emacsql db [:insert-or-ignore-into dates [date]
:values [$s1]] date-unix)
(setq date-id
(caar (emacsql db [:select [date-id] :from dates
:where (= date $s1)]
date-unix))
interval-id
(caar (emacsql db [:select (funcall max interval-id) :from intervals])))
(emacsql db [:insert-into date-intervals [date-id interval-id]
:values [$s1 $s2]]
date-id interval-id)))))
(cl-defmethod chronometrist-edit-backend ((backend chronometrist-sqlite-backend))
(require 'sql)
(switch-to-buffer
(sql-comint-sqlite 'sqlite (list file))))
;; SELECT * FROM TABLE WHERE ID = (SELECT MAX(ID) FROM TABLE);
;; SELECT * FROM tablename ORDER BY column DESC LIMIT 1;
(cl-defmethod chronometrist-latest-record ((backend chronometrist-sqlite-backend) db)
(emacsql db [:select * :from events :order-by rowid :desc :limit 1]))
(cl-defmethod chronometrist-task-records-for-date ((backend chronometrist-sqlite-backend) task date-ts))
(cl-defmethod chronometrist-active-days ((backend chronometrist-sqlite-backend) task))
(cl-defmethod chronometrist-replace-last ((backend chronometrist-sqlite-backend) plist)
(emacsql db [:delete-from events :where ]))
(provide 'chronometrist-sqlite)
;;; chronometrist-sqlite.el ends here

View File

@ -1,277 +0,0 @@
#+TITLE: chronometrist-sqlite
#+AUTHOR: contrapunctus
#+SUBTITLE: SQLite backend for Chronometrist
#+PROPERTY: header-args :tangle yes :load yes
* Library headers and commentary
#+BEGIN_SRC emacs-lisp
;;; chronometrist-sqlite.el --- SQLite backend for Chronometrist -*- 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 "24.3") (chronometrist "0.9.0") (emacsql-sqlite "1.0.0"))
;; Version: 0.1.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:
;;
;; This package provides an SQLite 3 backend for Chronometrist.
#+END_SRC
* Dependencies
#+BEGIN_SRC emacs-lisp
;;; Code:
(require 'chronometrist)
(require 'emacsql-sqlite)
#+END_SRC
* Code
** class
#+BEGIN_SRC emacs-lisp
(defclass chronometrist-sqlite-backend (chronometrist-backend chronometrist-file-backend-mixin)
((extension :initform "sqlite"
:accessor chronometrist-backend-ext
:custom 'string)
(connection :initform nil
:initarg :connection
:accessor chronometrist-backend-connection)))
(chronometrist-register-backend
:sqlite "Store records in SQLite database."
(make-instance 'chronometrist-sqlite-backend :path chronometrist-file))
#+END_SRC
** initialize-instance :method:
#+BEGIN_SRC emacs-lisp
(cl-defmethod initialize-instance :after ((backend chronometrist-sqlite-backend)
&rest _initargs)
"Initialize connection for BACKEND based on its file."
(with-slots (file connection) backend
(when (and file (not connection))
(setf connection (emacsql-sqlite file)))))
#+END_SRC
** create-file
#+BEGIN_SRC emacs-lisp
(cl-defmethod chronometrist-create-file ((backend chronometrist-sqlite-backend) &optional file)
"Create file for BACKEND if it does not already exist.
Return the connection object from `emacsql-sqlite'."
(let* ((file (or file (chronometrist-backend-file backend)))
(db (or (chronometrist-backend-connection backend)
(setf (chronometrist-backend-connection backend)
(emacsql-sqlite file)))))
(cl-loop
for query in
'(;; Properties are user-defined key-values stored as JSON.
[:create-table properties
([(prop-id integer :primary-key)
(properties text :unique :not-null)])]
;; An event is a timestamp with a name and optional properties.
[:create-table event-names
([(name-id integer :primary-key)
(name text :unique :not-null)])]
[:create-table events
([(event-id integer :primary-key)
(name-id integer :not-null :references event-names [name-id])])]
;; An interval is a time range with a name and optional properties.
[:create-table interval-names
([(name-id integer :primary-key)
(name text :unique :not-null)])]
[:create-table intervals
([(interval-id integer :primary-key)
(name-id integer :not-null :references interval-names [name-id])
(start-time integer :not-null)
;; The latest interval may be ongoing, so the stop time may be NULL.
(stop-time integer)
(prop-id integer :references properties [prop-id])]
(:unique [name-id start-time stop-time]))]
;; A date contains one or more events and intervals. It may
;; also contain properties.
[:create-table dates
([(date-id integer :primary-key)
(date integer :unique :not-null)
(prop-id integer :references properties [prop-id])])]
[:create-table date-events
([(date-id integer :not-null :references dates [date-id])
(event-id integer :not-null :references events [event-id])])]
[:create-table date-intervals
([(date-id integer :not-null :references dates [date-id])
(interval-id integer :not-null :references intervals [interval-id])])])
do (emacsql db query)
finally return db)))
#+END_SRC
** iso-to-unix :function:
#+BEGIN_SRC emacs-lisp
(defun chronometrist-iso-to-unix (timestamp)
(truncate (float-time (parse-iso8601-time-string timestamp))))
#+END_SRC
** to-file :method:
#+BEGIN_SRC emacs-lisp
(cl-defmethod chronometrist-to-file (hash-table (backend chronometrist-sqlite-backend) file)
(with-slots (connection) backend
(delete-file file)
(when connection (emacsql-close connection))
(setf connection nil)
(chronometrist-create-file backend file)
(cl-loop for date in (sort (hash-table-keys hash-table) #'string-lessp) do
;; insert date if it does not exist
(emacsql connection [:insert-or-ignore-into dates [date] :values [$s1]]
(chronometrist-iso-to-unix date))
(cl-loop for plist in (gethash date hash-table) do
(chronometrist-insert backend plist)))))
#+END_SRC
** insert-properties :writer:
#+BEGIN_SRC emacs-lisp
(defun chronometrist-sqlite-insert-properties (backend plist)
"Insert properties from PLIST to (SQLite) BACKEND.
Properties are key-values excluding :name, :start, and :stop.
Insert nothing if the properties already exist. Return the
prop-id of the inserted or existing property."
(with-slots (connection) backend
(let* ((plist (chronometrist-plist-key-values plist))
(props (if (functionp chronometrist-sqlite-properties-function)
(funcall chronometrist-sqlite-properties-function plist)
plist)))
(emacsql connection
[:insert-or-ignore-into properties [properties] :values [$s1]]
props)
(caar (emacsql connection [:select [prop-id]
:from properties
:where (= properties $s1)]
props)))))
#+END_SRC
*** properties-to-json :function:
#+BEGIN_SRC emacs-lisp
(defun chronometrist-sqlite-properties-to-json (plist)
"Return PLIST as a JSON string."
(json-encode
;; `json-encode' throws an error when it thinks
;; it sees "alists" which have numbers as
;; "keys", so we convert any cons cells and any
;; lists starting with a number to vectors
(-tree-map (lambda (elt)
(cond ((chronometrist-pp-pair-p elt)
(vector (car elt) (cdr elt)))
((consp elt)
(vconcat elt))
(t elt)))
plist)))
#+END_SRC
*** properties-function :custom:variable:
#+BEGIN_SRC emacs-lisp
(defcustom chronometrist-sqlite-properties-function nil
"Function used to control the encoding of user key-values.
The function must accept a single argument, the plist of key-values.
Any non-function value results in key-values being inserted as
s-expressions in a text column."
:type '(choice function (sexp :tag "Insert as s-expressions")))
#+END_SRC
** insert
#+BEGIN_SRC emacs-lisp
(cl-defmethod chronometrist-insert ((backend chronometrist-sqlite-backend) plist)
(-let (((plist-1 plist-2) (chronometrist-split-plist plist))
(db (chronometrist-backend-connection backend)))
(cl-loop for plist in (if (and plist-1 plist-2)
(list plist-1 plist-2)
(list plist))
do
(-let* (((&plist :name name :start start :stop stop) plist)
(date-unix (chronometrist-iso-to-unix (chronometrist-iso-to-date start)))
(start-unix (chronometrist-iso-to-unix start))
(stop-unix (and stop (chronometrist-iso-to-unix stop)))
name-id interval-id prop-id)
;; insert name if it does not exist
(emacsql db [:insert-or-ignore-into interval-names [name]
:values [$s1]]
name)
;; insert interval properties if they do not exist
(setq prop-id (chronometrist-sqlite-insert-properties backend plist))
;; insert interval and associate it with the date
(setq name-id
(caar (emacsql db [:select [name-id]
:from interval-names
:where (= name $s1)]
name)))
(emacsql db [:insert-or-ignore-into intervals
[name-id start-time stop-time prop-id]
:values [$s1 $s2 $s3 $s4]]
name-id start-unix stop-unix prop-id)
(emacsql db [:insert-or-ignore-into dates [date]
:values [$s1]] date-unix)
(setq date-id
(caar (emacsql db [:select [date-id] :from dates
:where (= date $s1)]
date-unix))
interval-id
(caar (emacsql db [:select (funcall max interval-id) :from intervals])))
(emacsql db [:insert-into date-intervals [date-id interval-id]
:values [$s1 $s2]]
date-id interval-id)))))
#+END_SRC
** open-file
#+BEGIN_SRC emacs-lisp
(cl-defmethod chronometrist-edit-backend ((backend chronometrist-sqlite-backend))
(require 'sql)
(switch-to-buffer
(sql-comint-sqlite 'sqlite (list file))))
#+END_SRC
** latest-record
#+BEGIN_SRC emacs-lisp
;; SELECT * FROM TABLE WHERE ID = (SELECT MAX(ID) FROM TABLE);
;; SELECT * FROM tablename ORDER BY column DESC LIMIT 1;
(cl-defmethod chronometrist-latest-record ((backend chronometrist-sqlite-backend) db)
(emacsql db [:select * :from events :order-by rowid :desc :limit 1]))
#+END_SRC
** task-records-for-date
#+BEGIN_SRC emacs-lisp
(cl-defmethod chronometrist-task-records-for-date ((backend chronometrist-sqlite-backend) task date-ts))
#+END_SRC
** active-days
#+BEGIN_SRC emacs-lisp
(cl-defmethod chronometrist-active-days ((backend chronometrist-sqlite-backend) task))
#+END_SRC
** replace-last
#+BEGIN_SRC emacs-lisp
(cl-defmethod chronometrist-replace-last ((backend chronometrist-sqlite-backend) plist)
(emacsql db [:delete-from events :where ]))
#+END_SRC
** Provide
#+BEGIN_SRC emacs-lisp
(provide 'chronometrist-sqlite)
;;; chronometrist-sqlite.el ends here
#+END_SRC
* Local variables :noexport:
# Local Variables:
# eval: (when (or (package-installed-p 'emacsql) (featurep 'emacsql)) (require 'emacsql) (emacsql-fix-vector-indentation))
# eval: (when (or (package-installed-p 'literate-elisp) (featurep 'literate-elisp)) (require 'literate-elisp) (literate-elisp-load (buffer-file-name)))
# End:

View File

@ -0,0 +1,318 @@
;;; chronometrist-statistics.el --- View statistics for Chronometrist data -*- lexical-binding: t; -*-
;; Author: contrapunctus <xmpp:contrapunctus@jabber.fr>
;; This is free and unencumbered software released into the public domain.
;;
;; Anyone is free to copy, modify, publish, use, compile, sell, or
;; distribute this software, either in source code form or as a compiled
;; binary, for any purpose, commercial or non-commercial, and by any
;; means.
;;
;; For more information, please refer to <https://unlicense.org>
;;; Commentary:
;;
(require 'parse-time)
(require 'cl-lib)
(require 'filenotify)
(require 'chronometrist-common)
(require 'chronometrist-time)
(require 'chronometrist-events)
(require 'chronometrist-migrate)
(require 'chronometrist-queries)
(declare-function chronometrist-refresh-file "chronometrist.el")
;; details!
;; for each activity, spent most time on doing X (where X is a
;; comment, assuming you use comments to detail what you did)
;; Really might need emacs-async for this...buttloads of big
;; calculations which will only get bigger as the timelog file grows,
;; and the more the activities, the more the calculations! I'm
;; visualizing the table loading gradually, field by field, like an
;; image in a browser.
;; TODO -
;; 1. [x] show dash instead of zero
;; 2. [x] percent for active days
;; 3. buttons
;; 4. [x] display date ranges in a nicer way
;; 5. month and year ranges
;; 6. totals for each column
;; 7. (maybe) jump between chronometrist-report and chronometrist-statistics for viewing the same week's data
;; - in chronometrist-statistics, this only makes sense in week mode
;; 8. a 'counter' - if I have ten weeks of data and I'm on the latest,
;; show 10/10; update this as we scroll
;; - don't scroll past the end, as currently happens
;; - also applicable to chronometrist-report
;; TODO - convert all functions which take dates as arguments to use
;; the (YEAR MONTH DAY) format
;;; Code:
;; ## VARIABLES ##
(defgroup chronometrist-statistics nil
"Statistics buffer for the `chronometrist' time tracker."
:group 'chronometrist)
(defcustom chronometrist-statistics-buffer-name "*Chronometrist-Statistics*"
"The name of the buffer created by `chronometrist-statistics'."
:type 'string)
(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').")
(defvar chronometrist-statistics--point nil)
(defvar chronometrist-statistics-mode-map)
;; ## FUNCTIONS ##
(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
;; for date being the hash-keys of table
;; (let ((events-in-day (chronometrist-task-events-in-day task (chronometrist-iso-date->ts key))))
;; (when events-in-day)))
(let ((days 0)
(per-day-time-list))
(maphash (lambda (key _value)
(let ((events-in-day (chronometrist-task-events-in-day task (chronometrist-iso-date->ts key))))
(when events-in-day
(setq days (1+ days))
(->> (chronometrist-events->ts-pairs events-in-day)
(chronometrist-ts-pairs->durations)
(-reduce #'+)
(list)
(append per-day-time-list)
(setq per-day-time-list)))))
table)
(if per-day-time-list
(--> (-reduce #'+ per-day-time-list)
(/ it days))
0)))
(defun chronometrist-statistics-entries-internal (table)
"Helper function for `chronometrist-statistics-entries'.
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'."
(mapcar (lambda (task)
(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-time)
(format "% 5s")))
(content (vector task
active-days
active-percent
average-time)))
(list task content)))
chronometrist-task-list))
(defun chronometrist-statistics-entries ()
"Create entries 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-entries-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-entries-internal ht)))))
(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 "")))
(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))))))
(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))))
;; ## MAJOR MODE ##
(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'.")
(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-entries)
(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))))
;; ## COMMANDS ##
;;;###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-common-create-file)
(chronometrist-statistics-mode)
(switch-to-buffer buffer)
(chronometrist-statistics-refresh))))))
(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)))
(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)))
(provide 'chronometrist-statistics)
;;; chronometrist-statistics.el ends here

View File

@ -1,178 +0,0 @@
;;; chronometrist-third.el --- Third Time support for Chronometrist -*- 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") (alert "1.2") (chronometrist "0.6.0"))
;; Version: 0.0.1
;; This is free and unencumbered software released into the public domain.
;;
;; Anyone is free to copy, modify, publish, use, compile, sell, or
;; distribute this software, either in source code form or as a compiled
;; binary, for any purpose, commercial or non-commercial, and by any
;; means.
;;
;; For more information, please refer to <https://unlicense.org>
;;; Commentary:
;; Add support for the Third Time system to Chronometrist. In Third
;; Time, you work for any length of time you like, and "earn" a third
;; of the work time as break time. For a more detailed explanation,
;; see
;; https://www.lesswrong.com/posts/RWu8eZqbwgB9zaerh/third-time-a-better-way-to-work
;; For information on usage and customization, see https://tildegit.org/contrapunctus/chronometrist-goal/src/branch/production/README.md
;;; Code:
(require 'chronometrist)
(require 'alert)
;; [[file:chronometrist-third.org::*group][group:1]]
(defgroup chronometrist-third nil
"Third Time support for Chronometrist."
:group 'chronometrist)
;; group:1 ends here
;; [[file:chronometrist-third.org::*divisor][divisor:1]]
(defcustom chronometrist-third-divisor 3
"Number to determine accumulation of break time relative to work time."
:type 'number)
;; divisor:1 ends here
;; [[file:chronometrist-third.org::*duration-format][duration-format:1]]
(defcustom chronometrist-third-duration-format "%H, %M and %S%z"
"Format string for durations, passed to `format-seconds'."
:type 'string)
;; duration-format:1 ends here
;; [[file:chronometrist-third.org::*break-time][break-time:1]]
(defvar chronometrist-third-break-time 0
"Accumulated break time in seconds.")
;; break-time:1 ends here
;; [[file:chronometrist-third.org::*alert-functions][alert-functions:1]]
(defcustom chronometrist-third-alert-functions '(chronometrist-third-half-alert chronometrist-third-quarter-alert chronometrist-third-break-over-alert)
"List of timed alerts for the Third Time system.
Typically, each function in this list should call
`chronometrist-third-run-at-time' to run another function, which
in turn should call `alert' to notify the user.
All functions in this list are started when the user clocks out,
and stopped when they clock in."
:group 'chronometrist-third
:type 'hook)
;; alert-functions:1 ends here
;; [[file:chronometrist-third.org::*timer-list][timer-list:1]]
(defvar chronometrist-third-timer-list nil)
;; timer-list:1 ends here
;; [[file:chronometrist-third.org::*run-at-time][run-at-time:1]]
(defun chronometrist-third-run-at-time (time repeat function &rest args)
"Like `run-at-time', but store timer objects in `chronometrist-third-timer-list'."
(cl-pushnew (apply #'run-at-time time repeat function args) chronometrist-third-timer-list))
;; run-at-time:1 ends here
;; [[file:chronometrist-third.org::*half-alert][half-alert:1]]
(defun chronometrist-third-half-alert ()
"Display an alert when half the break time is consumed."
(let ((half-time (/ chronometrist-third-break-time 2.0)))
(and (not (zerop chronometrist-third-break-time))
(chronometrist-third-run-at-time
half-time nil
(lambda (half-time)
(alert
(format "%s left on your break."
(format-seconds chronometrist-third-duration-format half-time))))
half-time))))
;; half-alert:1 ends here
;; [[file:chronometrist-third.org::*quarter-alert][quarter-alert:1]]
(defun chronometrist-third-quarter-alert ()
"Display an alert when 3/4ths of the break time is consumed."
(let ((three-fourths (* chronometrist-third-break-time 7.5)))
(and (not (zerop chronometrist-third-break-time))
(chronometrist-third-run-at-time
three-fourths nil
(lambda (three-fourths)
(alert
(format "%s left on your break."
(format-seconds chronometrist-third-duration-format
(- chronometrist-third-break-time three-fourths)))))
three-fourths))))
;; quarter-alert:1 ends here
;; [[file:chronometrist-third.org::*break-over-alert][break-over-alert:1]]
(defun chronometrist-third-break-over-alert ()
"Display an alert when break time is over."
(and (not (zerop chronometrist-third-break-time))
(chronometrist-third-run-at-time
chronometrist-third-break-time nil
(lambda () (alert (format "Break time is over!"))))))
;; break-over-alert:1 ends here
;; [[file:chronometrist-third.org::*start-alert-timers][start-alert-timers:1]]
(defun chronometrist-third-start-alert-timers ()
"Run functions in `chronometrist-third-alert-functions'."
(mapc #'funcall chronometrist-third-alert-functions))
;; start-alert-timers:1 ends here
;; [[file:chronometrist-third.org::*stop-alert-timers][stop-alert-timers:1]]
(defun chronometrist-third-stop-alert-timers ()
"Stop timers in `chronometrist-third-timer-list'."
(mapc (lambda (timer) (cancel-timer timer)) chronometrist-third-timer-list))
;; stop-alert-timers:1 ends here
;; [[file:chronometrist-third.org::*clock-in][clock-in:1]]
(defun chronometrist-third-clock-in (&optional _arg)
"Stop alert timers and update break time."
(chronometrist-third-stop-alert-timers)
(unless (zerop chronometrist-third-break-time)
(-let* (((&plist :stop stop) (cl-second (chronometrist-to-list (chronometrist-active-backend))))
(used-break (ts-diff (ts-now) (chronometrist-iso-to-ts stop)))
(used-break-string (format-seconds chronometrist-third-duration-format used-break))
(new-break (- chronometrist-third-break-time used-break))
(old-break chronometrist-third-break-time))
(setq chronometrist-third-break-time (if (> new-break 0) new-break 0))
(alert
(if (zerop chronometrist-third-break-time)
(format "You have used up all %s of your break time (%s break)"
(format-seconds chronometrist-third-duration-format old-break)
used-break-string)
(format "You have used %s of your break time (%s left)"
used-break-string
(format-seconds chronometrist-third-duration-format chronometrist-third-break-time)))))))
;; clock-in:1 ends here
;; [[file:chronometrist-third.org::*clock-out][clock-out:1]]
(defun chronometrist-third-clock-out (&optional _arg)
"Update break time based on the latest work interval.
Run `chronometrist-third-alert-functions' to alert user when
break time is up."
(let* ((latest-work-duration (chronometrist-interval (chronometrist-latest-record (chronometrist-active-backend))))
(break-time-increment (/ latest-work-duration chronometrist-third-divisor)))
(cl-incf chronometrist-third-break-time break-time-increment)
(alert (format "You have gained %s of break time (%s total)"
(format-seconds chronometrist-third-duration-format break-time-increment)
(format-seconds chronometrist-third-duration-format chronometrist-third-break-time)))
;; start alert timer(s)
(chronometrist-third-start-alert-timers)))
;; clock-out:1 ends here
;; [[file:chronometrist-third.org::*third-minor-mode][third-minor-mode:1]]
;;;###autoload
(define-minor-mode chronometrist-third-minor-mode
nil nil nil nil
(cond (chronometrist-third-minor-mode
(add-hook 'chronometrist-after-in-functions #'chronometrist-third-clock-in)
(add-hook 'chronometrist-after-out-functions #'chronometrist-third-clock-out))
(t (remove-hook 'chronometrist-after-in-functions #'chronometrist-third-clock-in)
(remove-hook 'chronometrist-after-out-functions #'chronometrist-third-clock-out))))
;; third-minor-mode:1 ends here
(provide 'chronometrist-third)
;;; chronometrist-third.el ends here

View File

@ -1,213 +0,0 @@
#+TITLE: chronometrist-third
#+SUBTITLE: Third Time System extension for Chronometrist
#+PROPERTY: header-args :tangle yes :load yes :comments link
* Program source
** Library headers and commentary
#+BEGIN_SRC emacs-lisp :comments no
;;; chronometrist-third.el --- Third Time support for Chronometrist -*- 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") (alert "1.2") (chronometrist "0.6.0"))
;; Version: 0.0.1
;; This is free and unencumbered software released into the public domain.
;;
;; Anyone is free to copy, modify, publish, use, compile, sell, or
;; distribute this software, either in source code form or as a compiled
;; binary, for any purpose, commercial or non-commercial, and by any
;; means.
;;
;; For more information, please refer to <https://unlicense.org>
;;; Commentary:
;; Add support for the Third Time system to Chronometrist. In Third
;; Time, you work for any length of time you like, and "earn" a third
;; of the work time as break time. For a more detailed explanation,
;; see
;; https://www.lesswrong.com/posts/RWu8eZqbwgB9zaerh/third-time-a-better-way-to-work
;; For information on usage and customization, see https://tildegit.org/contrapunctus/chronometrist-goal/src/branch/production/README.md
#+END_SRC
** Dependencies
#+BEGIN_SRC emacs-lisp :comments no
;;; Code:
(require 'chronometrist)
(require 'alert)
#+END_SRC
** group :custom:group:
#+BEGIN_SRC emacs-lisp
(defgroup chronometrist-third nil
"Third Time support for Chronometrist."
:group 'chronometrist)
#+END_SRC
** divisor :custom:variable:
#+BEGIN_SRC emacs-lisp
(defcustom chronometrist-third-divisor 3
"Number to determine accumulation of break time relative to work time."
:type 'number)
#+END_SRC
** duration-format :custom:variable:
#+BEGIN_SRC emacs-lisp
(defcustom chronometrist-third-duration-format "%H, %M and %S%z"
"Format string for durations, passed to `format-seconds'."
:type 'string)
#+END_SRC
** break-time :variable:
#+BEGIN_SRC emacs-lisp
(defvar chronometrist-third-break-time 0
"Accumulated break time in seconds.")
#+END_SRC
** alert-functions :custom:variable:
#+BEGIN_SRC emacs-lisp
(defcustom chronometrist-third-alert-functions '(chronometrist-third-half-alert chronometrist-third-quarter-alert chronometrist-third-break-over-alert)
"List of timed alerts for the Third Time system.
Typically, each function in this list should call
`chronometrist-third-run-at-time' to run another function, which
in turn should call `alert' to notify the user.
All functions in this list are started when the user clocks out,
and stopped when they clock in."
:group 'chronometrist-third
:type 'hook)
#+END_SRC
** timer-list :variable:
#+BEGIN_SRC emacs-lisp
(defvar chronometrist-third-timer-list nil)
#+END_SRC
** run-at-time :procedure:
#+BEGIN_SRC emacs-lisp
(defun chronometrist-third-run-at-time (time repeat function &rest args)
"Like `run-at-time', but store timer objects in `chronometrist-third-timer-list'."
(cl-pushnew (apply #'run-at-time time repeat function args) chronometrist-third-timer-list))
#+END_SRC
** half-alert :procedure:
#+BEGIN_SRC emacs-lisp
(defun chronometrist-third-half-alert ()
"Display an alert when half the break time is consumed."
(let ((half-time (/ chronometrist-third-break-time 2.0)))
(and (not (zerop chronometrist-third-break-time))
(chronometrist-third-run-at-time
half-time nil
(lambda (half-time)
(alert
(format "%s left on your break."
(format-seconds chronometrist-third-duration-format half-time))))
half-time))))
#+END_SRC
** quarter-alert :procedure:
#+BEGIN_SRC emacs-lisp
(defun chronometrist-third-quarter-alert ()
"Display an alert when 3/4ths of the break time is consumed."
(let ((three-fourths (* chronometrist-third-break-time 7.5)))
(and (not (zerop chronometrist-third-break-time))
(chronometrist-third-run-at-time
three-fourths nil
(lambda (three-fourths)
(alert
(format "%s left on your break."
(format-seconds chronometrist-third-duration-format
(- chronometrist-third-break-time three-fourths)))))
three-fourths))))
#+END_SRC
** break-over-alert :procedure:
#+BEGIN_SRC emacs-lisp
(defun chronometrist-third-break-over-alert ()
"Display an alert when break time is over."
(and (not (zerop chronometrist-third-break-time))
(chronometrist-third-run-at-time
chronometrist-third-break-time nil
(lambda () (alert (format "Break time is over!"))))))
#+END_SRC
** start-alert-timers :procedure:
#+BEGIN_SRC emacs-lisp
(defun chronometrist-third-start-alert-timers ()
"Run functions in `chronometrist-third-alert-functions'."
(mapc #'funcall chronometrist-third-alert-functions))
#+END_SRC
** stop-alert-timers :procedure:
#+BEGIN_SRC emacs-lisp
(defun chronometrist-third-stop-alert-timers ()
"Stop timers in `chronometrist-third-timer-list'."
(mapc (lambda (timer) (cancel-timer timer)) chronometrist-third-timer-list))
#+END_SRC
** clock-in :hook:procedure:
#+BEGIN_SRC emacs-lisp
(defun chronometrist-third-clock-in (&optional _arg)
"Stop alert timers and update break time."
(chronometrist-third-stop-alert-timers)
(unless (zerop chronometrist-third-break-time)
(-let* (((&plist :stop stop) (cl-second (chronometrist-to-list (chronometrist-active-backend))))
(used-break (ts-diff (ts-now) (chronometrist-iso-to-ts stop)))
(used-break-string (format-seconds chronometrist-third-duration-format used-break))
(new-break (- chronometrist-third-break-time used-break))
(old-break chronometrist-third-break-time))
(setq chronometrist-third-break-time (if (> new-break 0) new-break 0))
(alert
(if (zerop chronometrist-third-break-time)
(format "You have used up all %s of your break time (%s break)"
(format-seconds chronometrist-third-duration-format old-break)
used-break-string)
(format "You have used %s of your break time (%s left)"
used-break-string
(format-seconds chronometrist-third-duration-format chronometrist-third-break-time)))))))
#+END_SRC
** clock-out :hook:procedure:
#+BEGIN_SRC emacs-lisp
(defun chronometrist-third-clock-out (&optional _arg)
"Update break time based on the latest work interval.
Run `chronometrist-third-alert-functions' to alert user when
break time is up."
(let* ((latest-work-duration (chronometrist-interval (chronometrist-latest-record (chronometrist-active-backend))))
(break-time-increment (/ latest-work-duration chronometrist-third-divisor)))
(cl-incf chronometrist-third-break-time break-time-increment)
(alert (format "You have gained %s of break time (%s total)"
(format-seconds chronometrist-third-duration-format break-time-increment)
(format-seconds chronometrist-third-duration-format chronometrist-third-break-time)))
;; start alert timer(s)
(chronometrist-third-start-alert-timers)))
#+END_SRC
** third-minor-mode :minor:mode:
#+BEGIN_SRC emacs-lisp
;;;###autoload
(define-minor-mode chronometrist-third-minor-mode
nil nil nil nil
(cond (chronometrist-third-minor-mode
(add-hook 'chronometrist-after-in-functions #'chronometrist-third-clock-in)
(add-hook 'chronometrist-after-out-functions #'chronometrist-third-clock-out))
(t (remove-hook 'chronometrist-after-in-functions #'chronometrist-third-clock-in)
(remove-hook 'chronometrist-after-out-functions #'chronometrist-third-clock-out))))
#+END_SRC
** Provide
#+BEGIN_SRC emacs-lisp :comments no
(provide 'chronometrist-third)
;;; chronometrist-third.el ends here
#+END_SRC
* Local variables :noexport:
# Local Variables:
# my-org-src-default-lang: "emacs-lisp"
# eval: (when (package-installed-p 'literate-elisp) (require 'literate-elisp) (literate-elisp-load (buffer-file-name)))
# End:

110
elisp/chronometrist-time.el Normal file
View File

@ -0,0 +1,110 @@
;;; chronometrist-time.el --- Time and date functions for Chronometrist -*- lexical-binding: t; -*-
;; Author: contrapunctus <xmpp:contrapunctus@jabber.fr>
(require 'parse-time)
(require 'dash)
(require 's)
(declare-function chronometrist-day-start "chronometrist-events.el")
;; This is free and unencumbered software released into the public domain.
;;
;; Anyone is free to copy, modify, publish, use, compile, sell, or
;; distribute this software, either in source code form or as a compiled
;; binary, for any purpose, commercial or non-commercial, and by any
;; means.
;;
;; For more information, please refer to <https://unlicense.org>
;;; Commentary:
;; Pretty sure quite a few of these are redundant. Hopefully putting
;; them together in the same file will make it easier to figure out
;; which ones those are.
;;; Code:
(defun chronometrist-iso-timestamp->ts (timestamp)
"Return new ts struct, parsing TIMESTAMP with `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))))
(defun chronometrist-iso-date->ts (date)
"Return a ts struct (see `ts.el') representing DATE.
DATE should be an ISO-8601 date string (\"YYYY-MM-DD\")."
(let* ((date-list (mapcar #'string-to-number
(split-string date "-")))
(day (caddr date-list))
(month (cadr date-list))
(year (car date-list)))
(ts-update
(make-ts :hour 0 :minute 0 :second 0
:day day :month month :year year))))
(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))
(defun chronometrist-format-time-iso8601 (&optional unix-time)
"Return current moment as an ISO-8601 format time string.
Optional argument UNIX-TIME should be a time value (see
`current-time') accepted by `format-time-string'."
(format-time-string "%FT%T%z" unix-time))
;; Note - this assumes that an event never crosses >1 day. This seems
;; sufficient for all conceivable cases.
(defun chronometrist-midnight-spanning-p (start-time stop-time)
"Return non-nil if START-TIME and STOP-TIME cross a midnight.
Return value is 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* ((first-day-start (chronometrist-day-start start-time))
;; HACK - won't work with custom day-start time
;; (first-day-end (parse-iso8601-time-string
;; (concat (chronometrist-date (parse-iso8601-time-string start-time))
;; "24:00:00")))
(next-day-start (time-add first-day-start
'(0 . 86400)))
(stop-time-unix (parse-iso8601-time-string stop-time)))
;; Does the event stop time exceed the next day start time?
(when (time-less-p next-day-start stop-time-unix)
(list `(:start ,start-time
:stop ,(chronometrist-format-time-iso8601 next-day-start))
`(:start ,(chronometrist-format-time-iso8601 next-day-start)
:stop ,stop-time)))))
(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)))
(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))))
(provide 'chronometrist-time)
;;; chronometrist-time.el ends here

View File

@ -0,0 +1,77 @@
;;; chronometrist-timer.el --- Timer-related functions for Chronometrist -*- lexical-binding: t; -*-
;; Author: contrapunctus <xmpp:contrapunctus@jabber.fr>
;; This is free and unencumbered software released into the public domain.
;;
;; Anyone is free to copy, modify, publish, use, compile, sell, or
;; distribute this software, either in source code form or as a compiled
;; binary, for any purpose, commercial or non-commercial, and by any
;; means.
;;
;; For more information, please refer to <https://unlicense.org>
;;; Commentary:
;;
;;; Code:
(declare-function chronometrist-refresh "chronometrist.el")
(defvar chronometrist--timer-object nil)
(defcustom chronometrist-timer-hook nil
"Functions run by `chronometrist-timer'.")
(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."
(when (chronometrist-current-task) ;; FIXME - This line is currently
;; resulting in no refresh at midnight. When `chronometrist-entries' is
;; optimized to consume less CPU and avoid unnecessary parsing,
;; remove this condition.
(when (get-buffer-window chronometrist-buffer-name)
(chronometrist-refresh))
(run-hooks 'chronometrist-timer-hook)))
(defun chronometrist-stop-timer ()
"Stop the timer for Chronometrist buffers."
(interactive)
(cancel-timer chronometrist--timer-object)
(setq chronometrist--timer-object nil))
(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))
(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)))
(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))
(provide 'chronometrist-timer)
;;; chronometrist-timer.el ends here

File diff suppressed because it is too large Load Diff

File diff suppressed because it is too large Load Diff

View File

@ -1,443 +0,0 @@
#+TITLE: Chronometrist
#+SUBTITLE: Friendly and powerful personal time tracker/analyzer with Emacs and CLIM frontends
#+DESCRIPTION: User Manual
#+HTML_HEAD: <link rel="stylesheet" type="text/css" href="style.css" />
#+BEGIN_EXPORT html
<a href="https://liberapay.com/contrapunctus/donate">
<img alt="Donate using Liberapay" src="https://img.shields.io/liberapay/receives/contrapunctus.svg?logo=liberapay">
</a>
<a href="https://melpa.org/#/chronometrist">
<img src="https://melpa.org/packages/chronometrist-badge.svg">
</a>
#+END_EXPORT
* Explanation
:PROPERTIES:
:CUSTOM_ID: explanation
:END:
Chronometrist is a friendly and powerful personal time tracker and analyzer. It has frontends for Emacs and [[https://mcclim.common-lisp.dev/][CLIM]].
#+CAPTION: The main Chronometrist buffer, with the enabled extensions [[#time-goals][chronometrist-goal]] ("Targets" column + alerts) and chronometrist-spark ("Graph" column displaying the activity for the past 4 weeks).
[[file:doc/2022-02-20 13-26-53.png]]
** Benefits
:PROPERTIES:
:CUSTOM_ID: benefits
:END:
1. Extremely simple and efficient to use
2. Displays useful information about your time usage (including fancy graphs with the =chronometrist-spark= extension)
3. Support for both mouse and keyboard
4. Human errors in tracking can be easily fixed by editing a plain text file
5. Hooks to integrate time tracking into your workflow
** Limitations
:PROPERTIES:
:CUSTOM_ID: limitations
:END:
1. No support for concurrent tasks.
** Comparisons
:PROPERTIES:
:CUSTOM_ID: comparisons
:END:
*** timeclock.el (Emacs built-in)
:PROPERTIES:
:CUSTOM_ID: timeclock.el
:END:
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
:PROPERTIES:
:CUSTOM_ID: org-time-tracking
:END:
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 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.
** Common Lisp port
:PROPERTIES:
:CUSTOM_ID: common-lisp-port
:END:
In March 2022, work began on the long-awaited Common Lisp port of Chronometrist, which aims to create -
1. a greater variety of backends (e.g. SQLite)
2. a common reusable library for frontends to use,
3. a greater variety of frontends, such as -
* a command line interface (CLI), for UNIX scripting;
* a terminal user inteface (TUI), for those so inclined;
* a CLIM (Common Lisp Interface Manager) GUI [fn:1],
* Qt and Android interfaces using [[https://gitlab.com/eql/lqml][LQML]],
* web frontends (possibly via [[https://common-lisp.net/project/parenscript/][Parenscript]] or [[https://github.com/rabbibotton/clog][CLOG]]),
* and perhaps even an interface for wearable devices!
The port was also driven by the desire to have access to Common Lisp's better performance, and features such as namespaces, a /de facto/ standard build system, multithreading, SQLite bindings, a more fully-featured implementation of CLOS and MOP, and type annotations, checking, and inference.
The literate sources for the Common Lisp port may be found in [[file:cl/chronometrist.org][cl/chronometrist.org]]. Currently, this port can -
1. import from a plist-group file and export to an SQLite database
#+BEGIN_SRC lisp
(chronometrist:to-file (chronometrist:to-hash-table
(make-instance 'chronometrist.plist-group:plist-group-backend
:file "/path/to/file.plg"))
(make-instance 'chronometrist.sqlite:sqlite-backend)
"/path/to/file.sqlite")
#+END_SRC
2. display a (WIP) CLIM GUI - =(chronometrist.clim:run-chronometrist)=
The Emacs Lisp codebase will probably become an Emacs frontend to a future Common Lisp CLI client.
[fn:1] McCLIM also has an incomplete ncurses backend - when completed, a CLIM frontend could provide a TUI "for free".
** Literate program
:PROPERTIES:
:CUSTOM_ID: explanation-literate-program
:END:
Chronometrist is written as an Org literate program, which makes it easy to obtain different views of the program source, thanks to tree- and source-block folding, tags, properties, and the =org-match= command.
The canonical source file is [[file:elisp/chronometrist.org][elisp/chronometrist.org]], which contains source blocks. These are provided to users after /tangling/ (extracting the source into an Emacs Lisp file). [fn:2]
The Org literate program can also be loaded directly using the [[https://github.com/jingtaozf/literate-elisp][literate-elisp]] package, so that all source links (e.g. =xref=, =describe-function=) lead to the Org file. See [[#how-to-literate-elisp][How to load the program using literate-elisp]].
[fn:2] the literate source is also included in MELPA installs, although not loaded through =literate-elisp-load= by default, since doing so would interfere with automatic generation of autoloads.
** Source code overview
:PROPERTIES:
:CUSTOM_ID: source-code-overview
:END:
At its most basic, we read data from a [[file:elisp/chronometrist.org::#program-backend][backend]] and [[file:elisp/chronometrist.org::#program-frontend-chronometrist][display it]] as a [[elisp:(find-library "tabulated-list")][=tabulated-list-mode=]] buffer.
The plist and plist-group backends (collectively known as the s-expression backends) =read= a text file containing s-expressions into a [[file:elisp/chronometrist.org::#program-data-structures][hash table]], and query that. When the file is changed—whether by the program or the user—they [[file:elisp/chronometrist.org::refresh-file][update the hash table]] and the [[file:elisp/chronometrist.org::#program-frontend-chronometrist-refresh][buffer]]. The s-expression backends also make use of a [[file:elisp/chronometrist.org::#program-pretty-printer][plist pretty-printer]] of their own.
There are also some [[file:elisp/chronometrist.org::#program-migration][migration commands]].
Extensions exist for -
1. [[file:elisp/chronometrist-key-values.org][attaching arbitrary metadata]] to time intervals,
2. [[https://tildegit.org/contrapunctus/chronometrist-goal][time goals and alerts]], and
3. support for the [[file:elisp/chronometrist-third.org][Third Time system]]
** Contributions and contact
:PROPERTIES:
:CUSTOM_ID: contributions-contact
:END:
Feedback and MRs are very welcome. 🙂
+ [[file:TODO.org]] has a long list of tasks
+ [[file:elisp/chronometrist.org]] contains all developer-oriented documentation
If you have tried using Chronometrist, I'd love to hear your experiences! Get in touch with the author and other Emacs users in the Emacs channel on the Jabber network - [[https://conversations.im/j/emacs@salas.suchat.org][xmpp:emacs@salas.suchat.org?join]] ([[https://inverse.chat/#converse/room?jid=emacs@salas.suchat.org][web chat]])
(For help in getting started with Jabber, [[https://xmpp.org/getting-started/][click here]])
** License
:PROPERTIES:
:CUSTOM_ID: license
:END:
I'd /like/ for all software to be liberated - transparent, trustable, and accessible for anyone to use, study, or improve.
I'd /like/ anyone using my software to credit me for the work.
I'd /like/ to receive financial support for my efforts, so I can spend all my time doing what I find meaningful.
But I don't want to make demands or threats (e.g. via legal conditions) to accomplish all that, nor restrict my services to only those who can pay.
Thus, Chronometrist is released under your choice of [[https://unlicense.org/][Unlicense]] or the [[http://www.wtfpl.net/][WTFPL]].
(See files [[file:UNLICENSE][UNLICENSE]] and [[file:WTFPL][WTFPL]]).
** Thanks
:PROPERTIES:
:CUSTOM_ID: thanks
:END:
The main buffer and the report buffer are copied from the Android application, [[https://github.com/netmackan/ATimeTracker][A Time Tracker]]
wasamasa, bpalmer, aidalgol, pjb and the rest of #emacs for their tireless help and support
jwiegley for =timeclock.el=, which we used as a backend in earlier versions
blandest for helping me with the name
fiete and wu-lee for testing and bug reports
* Tutorials
:PROPERTIES:
:CUSTOM_ID: usage
:END:
** Installation
:PROPERTIES:
:CUSTOM_ID: installation
:END:
*** from MELPA
:PROPERTIES:
:CUSTOM_ID: install-from-melpa
:END:
1. Set up MELPA - https://melpa.org/#/getting-started
2. =M-x package-install RET chronometrist RET=
*** from Git
:PROPERTIES:
:CUSTOM_ID: install-from-git
:END:
You can get =chronometrist= from https://tildegit.org/contrapunctus/chronometrist or https://codeberg.org/contrapunctus/chronometrist
=chronometrist= requires
+ Emacs v25 or higher
+ [[https://github.com/magnars/dash.el][dash.el]]
+ [[https://github.com/alphapapa/ts.el][ts.el]]
Add the ="elisp/"= subdirectory to your load-path, and =(require 'chronometrist)=.
** chronometrist
:PROPERTIES:
:CUSTOM_ID: usage-chronometrist
:END:
Run =M-x chronometrist= to see your projects, the time you spent on them today, which one is active, and the total time clocked today.
Click or hit =RET= (=chronometrist-toggle-task=) on a project to start tracking time for it. If it's already clocked in, it will be clocked out.
You can also hit =<numeric prefix> RET= anywhere in the buffer to toggle the corresponding project, e.g. =C-1 RET= will toggle the project with index 1.
Press =r= to see a weekly report (see =chronometrist-report=)
** chronometrist-report
:PROPERTIES:
:CUSTOM_ID: usage-chronometrist-report
:END:
Run =M-x chronometrist-report= (or =chronometrist= with a prefix argument of 1, or press =r= in the =chronometrist= buffer) to see a weekly report.
Press =b= to look at past weeks, and =f= for future weeks.
** chronometrist-statistics
:PROPERTIES:
:CUSTOM_ID: usage-chronometrist-statistics
:END:
Run =M-x chronometrist-statistics= (or =chronometrist= with a prefix argument of 2) to view statistics.
Press =b= to look at past time ranges, and =f= for future ones.
** chronometrist-details
:PROPERTIES:
:CUSTOM_ID: chronometrist-details
:END:
** common commands
:PROPERTIES:
:CUSTOM_ID: usage-common-commands
:END:
In the buffers created by the previous three commands, you can press =l= (=chronometrist-open-log=) to view/edit your =chronometrist-file=, which by default is =~/.emacs.d/chronometrist.sexp=.
All of these commands will kill their buffer when run again with the buffer visible, so the keys you bind them to behave as a toggle.
All buffers keep themselves updated via an idle timer - no need to frequently press =g= to update.
** Time goals/targets
:PROPERTIES:
:CUSTOM_ID: time-goals
:END:
If you wish you could define time goals for some tasks, and have Chronometrist notify you when you're approaching the goal, completing it, or exceeding it, check out the extension [[https://github.com/contrapunctus-1/chronometrist-goal/][chronometrist-goal.el]].
* How-to Guides
:PROPERTIES:
:CUSTOM_ID: how-to
:END:
See the Customize groups =chronometrist= and =chronometrist-report= for variables intended to be user-customizable.
** How to display a prompt when exiting with an active task
:PROPERTIES:
:CUSTOM_ID: how-to-prompt-when-exiting-emacs
:END:
Evaluate or add to your init.el the following -
=(add-hook 'kill-emacs-query-functions 'chronometrist-query-stop)=
** How to load the program using literate-elisp
:PROPERTIES:
:CUSTOM_ID: how-to-literate-elisp
:END:
The literate Org document will automatically =literate-elisp-load= itself when opened, if =literate-elisp= is installed via =package.el=.
If you want it to be loaded with =literate-elisp-load= on Emacs startup, add the following to your init.el -
#+BEGIN_SRC emacs-lisp
(add-to-list 'load-path "<directory containing chronometrist.org>")
(require 'literate-elisp) ;; or autoload, use-package, ...
(literate-elisp-load "chronometrist.org")
#+END_SRC
** How to attach tags to time intervals
:PROPERTIES:
:CUSTOM_ID: how-to-tags
:END:
1. Add =chronometrist-tags-add= to one or more of these hooks [fn:3] -
#+BEGIN_SRC emacs-lisp
(add-to-list 'chronometrist-after-in-functions 'chronometrist-tags-add)
(add-to-list 'chronometrist-before-out-functions 'chronometrist-tags-add)
(add-to-list 'chronometrist-after-out-functions 'chronometrist-tags-add)
#+END_SRC
2. clock in/clock out to trigger the hook.
The prompt suggests past combinations you used for the current task, which you can browse with =M-p=/=M-n=. You can leave it blank by pressing =RET=.
[fn:3] but not =chronometrist-before-in-functions=
** How to attach key-values to time intervals
:PROPERTIES:
:CUSTOM_ID: how-to-key-value-pairs
:END:
1. Add =chronometrist-kv-add= to one or more of these hooks [fn:3] -
#+BEGIN_SRC emacs-lisp
(add-to-list 'chronometrist-after-in-functions 'chronometrist-kv-add)
(add-to-list 'chronometrist-before-out-functions 'chronometrist-kv-add)
(add-to-list 'chronometrist-after-out-functions 'chronometrist-kv-add)
#+END_SRC
To exit the prompt, press the key it indicates for quitting - you can then edit the resulting key-values by hand if required. Press =C-c C-c= to accept the key-values, or =C-c C-k= to cancel.
** How to skip running hooks/attaching tags and key values
:PROPERTIES:
:CUSTOM_ID: how-to-skip-running-hooks/attaching-tags-and-key-values
:END:
Use =M-RET= (=chronometrist-toggle-task-no-hooks=) to clock in/out.
** How to open certain files when you start a task
:PROPERTIES:
:CUSTOM_ID: how-to-open-files-on-task-start
:END:
An idea from the author's own init -
#+BEGIN_SRC emacs-lisp
(defun my-start-project (project)
(pcase project
("Guitar"
(find-file-other-window "~/repertoire.org"))
;; ...
))
(add-hook 'chronometrist-before-in-functions 'my-start-project)
#+END_SRC
** How to warn yourself about uncommitted changes
:PROPERTIES:
:CUSTOM_ID: how-to-warn-uncommitted-changes
:END:
Another one, prompting the user if they have uncommitted changes in a git repository (assuming they use [[https://magit.vc/][Magit]]) -
#+BEGIN_SRC emacs-lisp
(autoload 'magit-anything-modified-p "magit")
(defun my-commit-prompt ()
"Prompt user if `default-directory' is a dirty Git repository.
Return t if the user answers yes, if the repository is clean, or
if there is no Git repository.
Return nil (and run `magit-status') if the user answers no."
(cond ((not (magit-anything-modified-p)) t)
((yes-or-no-p
(format "You have uncommitted changes in %S. Really clock out? "
default-directory)) t)
(t (magit-status) nil)))
(add-hook 'chronometrist-before-out-functions 'my-commit-prompt)
#+END_SRC
** How to display the current time interval in the activity indicator
:PROPERTIES:
:CUSTOM_ID: how-to-activity-indicator
:END:
#+BEGIN_SRC emacs-lisp
(defun my-activity-indicator ()
(--> (chronometrist-latest-record (chronometrist-active-backend))
(plist-put it :stop (chronometrist-format-time-iso8601))
(list it)
(chronometrist-events-to-durations it)
(-reduce #'+ it)
(truncate it)
(chronometrist-format-duration it)))
(setq chronometrist-activity-indicator #'my-activity-indicator)
#+END_SRC
** How to back up your Chronometrist data
:PROPERTIES:
:CUSTOM_ID: how-to-backup
:END:
I suggest backing up Chronometrist data on each save using the [[https://tildegit.org/contrapunctus/async-backup][async-backup]] package.[fn:4] Here's how you can do that.
1. Add the following to your init.
#+BEGIN_SRC emacs-lisp
(use-package async-backup)
#+END_SRC
2. Open your Chronometrist file and add =async-backup= to a buffer-local =after-save-hook=.
: M-x chronometrist-open-log
: M-x add-file-local-variable-prop-line RET eval RET (add-hook 'after-save-hook #'async-backup nil t) RET
3. Optionally, configure =async-backup-location= to set a specific directory for the backups -
: (setq async-backup-location "/path/to/backup/dir/")
[fn:4] It is possible to use Emacs' built-in backup system to do it, but since it is synchronous, doing so will greatly slow down saving of the Chronometrist file.
** How to configure Vertico for use with Chronometrist
:PROPERTIES:
:CUSTOM_ID: howto-vertico
:END:
By default, [[https://github.com/minad/vertico][Vertico]] uses its own sorting function - for some commands (such as =chronometrist-key-values-unified-prompt=) this results in /worse/ suggestions, since Chronometrist sorts suggestions in most-recent-first order.
You can either disable Vertico's sorting entirely -
#+BEGIN_SRC emacs-lisp
(setq vertico-sort-function nil)
#+END_SRC
Or use =vertico-multiform= to disable sorting for only specific commands -
#+BEGIN_SRC emacs-lisp
(use-package vertico-multiform
:init (vertico-multiform-mode)
:config
(setq vertico-multiform-commands
'((chronometrist-toggle-task (vertico-sort-function . nil))
(chronometrist-toggle-task-no-hooks (vertico-sort-function . nil))
(chronometrist-key-values-unified-prompt (vertico-sort-function . nil)))))
#+END_SRC
* User's reference
:PROPERTIES:
:CUSTOM_ID: users-reference
:END:
All variables intended for user customization are listed here. They serve as the public API for this project for the purpose of semantic versioning. Any changes to these which require a user to modify their configuration are considered breaking changes.
1. =chronometrist-file=
2. =chronometrist-buffer-name=
3. =chronometrist-report-buffer-name=
4. =chronometrist-details-buffer-name=
5. =chronometrist-sexp-pretty-print-function=
6. =chronometrist-hide-cursor=
7. =chronometrist-update-interval=
8. =chronometrist-activity-indicator=
Buffer schemas
1. =chronometrist-schema=
2. =chronometrist-details-schema=
Hooks
1. =chronometrist-mode-hook=
2. =chronometrist-schema-transformers=
3. =chronometrist-row-transformers=
4. =chronometrist-before-in-functions=
5. =chronometrist-after-in-functions=
6. =chronometrist-before-out-functions=
7. =chronometrist-after-out-functions=
8. =chronometrist-file-change-hook=
9. =chronometrist-timer-hook=
* Local variables :noexport:
:PROPERTIES:
:CUSTOM_ID: local-variables
:END:
# Local Variables:
# my-org-src-default-lang: "emacs-lisp"
# End:

View File

@ -1,679 +0,0 @@
/* An incomplete mix of */
/* 1. motherfuckingwebsite.com + bettermotherfuckingwebsite.com +
thebestmotherfucking.website*/
/* 2. Org default style*/
/* 3. doom-molokai, using htmlize-buffer */
body {
margin: 40px auto;
max-width: 1000px;
line-height: 1.6;
font-size: 18px;
padding: 0 10px;
font-family: sans-serif;
/* original colors */
/* color: #444; */
/* background-color: #eeeeee; */
/* colors resembling Firefox's reader mode in the dark setting */
color: #eeeeee !important;
background-color: #333333;
}
h1,h2,h3 {
line-height: 1.2;
}
img {
max-width: 80%;
height: auto;
width: auto\9; /* ie8 */
}
Org defaults
.title {
text-align: center;
margin-bottom: .2em;
}
.subtitle {
text-align: center;
font-size: medium;
font-weight: bold;
margin-top:0;
}
.todo {
font-family: monospace;
color: red;
}
.done {
font-family: monospace;
color: green;
}
.priority {
font-family: monospace;
color: orange;
}
.tag {
background-color: #111111;
font-family: monospace;
padding: 2px;
font-size: 80%;
font-weight: normal;
}
.timestamp {
color: #bebebe;
}
.timestamp-kwd {
color: #5f9ea0;
}
.org-right {
margin-left: auto;
margin-right: 0px;
text-align: right;
}
.org-left {
margin-left: 0px;
margin-right: auto;
text-align: left;
}
.org-center {
margin-left: auto;
margin-right: auto;
text-align: center;
}
.underline {
text-decoration: underline;
}
#postamble p, #preamble p {
font-size: 90%;
margin: .2em;
}
p.verse {
margin-left: 3%;
}
pre {
border: 1px solid #ccc;
/* box-shadow: 3px 3px 3px #eee; */
padding: 8pt;
font-family: monospace;
overflow: scroll;
margin: 1.2em;
}
pre.src {
position: relative;
overflow: scroll;
padding-top: 1.2em;
}
pre.src:before {
display: none;
position: absolute;
background-color: #111111;
/* top: -10px; */
/* right: 10px; */
/* padding: 3px; */
border: 1px solid black;
}
pre.src:hover:before {
display: inline;}
/* Languages per Org manual */
pre.src-asymptote:before {
content: 'Asymptote';
}
pre.src-awk:before {
content: 'Awk';
}
pre.src-C:before {
content: 'C';
}
/* pre.src-C++ doesn't work in CSS */
pre.src-clojure:before {
content: 'Clojure';
}
pre.src-css:before {
content: 'CSS';
}
pre.src-D:before {
content: 'D';
}
pre.src-ditaa:before {
content: 'ditaa';
}
pre.src-dot:before {
content: 'Graphviz';
}
pre.src-calc:before {
content: 'Emacs Calc';
}
pre.src-emacs-lisp:before {
content: 'Emacs Lisp';
}
pre.src-fortran:before {
content: 'Fortran';
}
pre.src-gnuplot:before {
content: 'gnuplot';
}
pre.src-haskell:before {
content: 'Haskell';
}
pre.src-hledger:before {
content: 'hledger';
}
pre.src-java:before {
content: 'Java';
}
pre.src-js:before {
content: 'Javascript';
}
pre.src-latex:before {
content: 'LaTeX';
}
pre.src-ledger:before {
content: 'Ledger';
}
pre.src-lisp:before {
content: 'Lisp';
}
pre.src-lilypond:before {
content: 'Lilypond';
}
pre.src-lua:before {
content: 'Lua';
}
pre.src-matlab:before {
content: 'MATLAB';
}
pre.src-mscgen:before {
content: 'Mscgen';
}
pre.src-ocaml:before {
content: 'Objective Caml';
}
pre.src-octave:before {
content: 'Octave';
}
pre.src-org:before {
content: 'Org mode';
}
pre.src-oz:before {
content: 'OZ';
}
pre.src-plantuml:before {
content: 'Plantuml';
}
pre.src-processing:before {
content: 'Processing.js';
}
pre.src-python:before {
content: 'Python';
}
pre.src-R:before {
content: 'R';
}
pre.src-ruby:before {
content: 'Ruby';
}
pre.src-sass:before {
content: 'Sass';
}
pre.src-scheme:before {
content: 'Scheme';
}
pre.src-screen:before {
content: 'Gnu Screen';
}
pre.src-sed:before {
content: 'Sed';
}
pre.src-sh:before {
content: 'shell';
}
pre.src-sql:before {
content: 'SQL';
}
pre.src-sqlite:before {
content: 'SQLite';
}
/* additional languages in org.el's org-babel-load-languages alist */
pre.src-forth:before {
content: 'Forth';
}
pre.src-io:before {
content: 'IO';
}
pre.src-J:before {
content: 'J';
}
pre.src-makefile:before {
content: 'Makefile';
}
pre.src-maxima:before {
content: 'Maxima';
}
pre.src-perl:before {
content: 'Perl';
}
pre.src-picolisp:before {
content: 'Pico Lisp';
}
pre.src-scala:before {
content: 'Scala';
}
pre.src-shell:before {
content: 'Shell Script';
}
pre.src-ebnf2ps:before {
content: 'ebfn2ps';
}
/* additional language identifiers per "defun org-babel-execute"
in ob-*.el */
pre.src-cpp:before {
content: 'C++';
}
pre.src-abc:before {
content: 'ABC';
}
pre.src-coq:before {
content: 'Coq';
}
pre.src-groovy:before {
content: 'Groovy';
}
/* additional language identifiers from org-babel-shell-names in
ob-shell.el: ob-shell is the only babel language using a lambda to put
the execution function name together. */
pre.src-bash:before {
content: 'bash';
}
pre.src-csh:before {
content: 'csh';
}
pre.src-ash:before {
content: 'ash';
}
pre.src-dash:before {
content: 'dash';
}
pre.src-ksh:before {
content: 'ksh';
}
pre.src-mksh:before {
content: 'mksh';
}
pre.src-posh:before {
content: 'posh';
}
/* Additional Emacs modes also supported by the LaTeX listings package */
pre.src-ada:before {
content: 'Ada';
}
pre.src-asm:before {
content: 'Assembler';
}
pre.src-caml:before {
content: 'Caml';
}
pre.src-delphi:before {
content: 'Delphi';
}
pre.src-html:before {
content: 'HTML';
}
pre.src-idl:before {
content: 'IDL';
}
pre.src-mercury:before {
content: 'Mercury';
}
pre.src-metapost:before {
content: 'MetaPost';
}
pre.src-modula-2:before {
content: 'Modula-2';
}
pre.src-pascal:before {
content: 'Pascal';
}
pre.src-ps:before {
content: 'PostScript';
}
pre.src-prolog:before {
content: 'Prolog';
}
pre.src-simula:before {
content: 'Simula';
}
pre.src-tcl:before {
content: 'tcl';
}
pre.src-tex:before {
content: 'TeX';
}
pre.src-plain-tex:before {
content: 'Plain TeX';
}
pre.src-verilog:before {
content: 'Verilog';
}
pre.src-vhdl:before {
content: 'VHDL';
}
pre.src-xml:before {
content: 'XML';
}
pre.src-nxml:before {
content: 'XML';
}
/* add a generic configuration mode;
LaTeX export needs an additional
(add-to-list 'org-latex-listings-langs '(conf " ")) in .emacs */
pre.src-conf:before {
content: 'Configuration File';
}
/* table { */
/* border-collapse:collapse; */
/* } */
/* caption.t-above { */
/* caption-side: top; */
/* } */
/* caption.t-bottom { */
/* caption-side: bottom; */
/* } */
/* td, th { */
/* vertical-align:top; */
/* } */
/* th.org-right { */
/* text-align: center; */
/* } */
/* th.org-left { */
/* text-align: center; */
/* } */
/* th.org-center { */
/* text-align: center; */
/* } */
/* td.org-right { */
/* text-align: right; */
/* } */
/* td.org-left { */
/* text-align: left; */
/* } */
/* td.org-center { */
/* text-align: center; */
/* } */
/* dt { */
/* font-weight: bold; */
/* } */
/* .footpara { */
/* display: inline; */
/* } */
/* .footdef { */
/* margin-bottom: 1em; */
/* } */
/* .figure { */
/* padding: 1em; */
/* } */
/* .figure p { */
/* text-align: center; */
/* } */
/* .equation-container { */
/* display: table; */
/* text-align: center; */
/* width: 100%; */
/* } */
/* .equation { */
/* vertical-align: middle; */
/* } */
/* .equation-label { */
/* display: table-cell; */
/* text-align: right; */
/* vertical-align: middle; */
/* } */
/* .inlinetask { */
/* padding: 10px; */
/* border: 2px solid gray; */
/* margin: 10px; */
/* background: #ffffcc; */
/* } */
/* #org-div-home-and-up */
/* { */
/* text-align: right; */
/* font-size: 70%; */
/* white-space: nowrap; */
/* } */
/* textarea { */
/* overflow-x: auto; */
/* } */
/* .linenr { */
/* font-size: smaller */
/* } */
/* .code-highlighted { */
/* background-color: #ffff00; */
/* } */
/* .org-info-js_info-navigation { */
/* border-style: none; */
/* } */
/* #org-info-js_console-label */
/* { */
/* font-size: 10px; */
/* font-weight: bold; */
/* white-space: nowrap; */
/* } */
/* .org-info-js_search-highlight */
/* { */
/* background-color: #ffff00; */
/* color: #000000; */
/* font-weight: bold; */
/* } */
/* .org-svg { */
/* width: 90%; */
/* } */
/* htmlize-buffer output */
body {
color: #eff0f1;
background-color: #232629;
}
.builtin {
/* font-lock-builtin-face */
color: #fd971f;
}
.comment {
/* font-lock-comment-face */
color: #555556;
}
.comment-delimiter {
/* font-lock-comment-delimiter-face */
color: #555556;
}
.constant {
/* font-lock-constant-face */
color: #fd971f;
}
.custom {
/* (:background "#27da2b442eaf" :extend t) */
background-color: #27da2b442eaf;
}
.doc {
/* font-lock-doc-face */
color: #7f7f80;
}
.function-name {
/* font-lock-function-name-face */
color: #b6e63e;
}
.hl-line {
/* hl-line */
background-color: #222323;
}
.italic {
/* italic */
font-style: italic;
}
.keyword {
/* font-lock-keyword-face */
color: #fb2874;
}
.nameless {
/* nameless-face */
color: #66d9ef;
}
.org-block-begin-line {
/* org-block-begin-line */
color: #555556;
background-color: #2d2e2e;
}
.org-block-end-line {
/* org-block-end-line */
color: #555556;
background-color: #2d2e2e;
}
.org-checkbox {
/* org-checkbox */
color: #e2c770;
font-weight: bold;
}
.org-checkbox-statistics-todo {
/* org-checkbox-statistics-todo */
color: #e2c770;
font-weight: bold;
}
code {
/* org-code */
color: #fd971f;
}
.org-document-info-keyword {
/* org-document-info-keyword */
color: #555556;
}
.org-document-title {
/* org-document-title */
color: #fd971f;
font-weight: bold;
}
.org-done {
/* org-done */
color: #555556;
font-weight: bold;
}
.org-drawer {
/* org-drawer */
color: #87cefa;
}
.org-footnote {
/* org-footnote */
color: #fd971f;
}
.org-hide {
/* org-hide */
color: #232629;
}
/* I want URLs in headings to be colored using the heading colors */
a {
color: #fd971f;
font-weight: bold;
text-decoration: underline;
}
h1 {
color: #fb2874;
font-weight: bold;
}
h2 {
color: #fd971f;
font-weight: bold;
}
h3 {
color: #9c91e4;
font-weight: bold;
}
h4 {
color: #5ca8dd;
font-weight: bold;
}
h5 {
color: #fb5d96;
font-weight: bold;
}
h6 {
color: #92c4e8;
font-weight: bold;
}
h1 a, h2 a, h3 a, h4 a, h5 a, h6 a, h7 a { color: inherit; }
.org-meta-line {
/* org-meta-line */
color: #7f7f80;
}
.org-property-value {
/* org-property-value */
color: #7f7f80;
}
.org-special-keyword {
/* org-special-keyword */
color: #7f7f80;
}
.org-tag {
/* org-tag */
color: #e2c770;
}
.org-todo {
/* org-todo */
color: #e2c770;
font-weight: bold;
}
.org-verbatim {
/* org-verbatim */
color: #b6e63e;
}
.rainbow-delimiters-depth-1 {
/* rainbow-delimiters-depth-1-face */
color: #fb2874;
}
.rainbow-delimiters-depth-2 {
/* rainbow-delimiters-depth-2-face */
color: #fd971f;
}
.rainbow-delimiters-depth-3 {
/* rainbow-delimiters-depth-3-face */
color: #b6e63e;
}
.rainbow-delimiters-depth-4 {
/* rainbow-delimiters-depth-4-face */
color: #66d9ef;
}
.rainbow-delimiters-depth-5 {
/* rainbow-delimiters-depth-5-face */
color: #fb2874;
}
.rainbow-delimiters-depth-6 {
/* rainbow-delimiters-depth-6-face */
color: #fd971f;
}
.rainbow-delimiters-depth-7 {
/* rainbow-delimiters-depth-7-face */
color: #b6e63e;
}
.rainbow-delimiters-depth-8 {
/* rainbow-delimiters-depth-8-face */
color: #b6e63e;
}
.rainbow-delimiters-depth-9 {
/* rainbow-delimiters-depth-9-face */
color: #9c91e4;
}
.string {
/* font-lock-string-face */
color: #e2c770;
}
.type {
/* font-lock-type-face */
color: #66d9ef;
}
.variable-name {
/* font-lock-variable-name-face */
color: #fd971f;
}
.warning {
/* font-lock-warning-face */
color: #e2c770;
}
a:hover {
text-decoration: underline;
}

28
scratch-test Executable file
View File

@ -0,0 +1,28 @@
#!/bin/bash
if [[ $# == 0 ]] || [[ ! -d "$1" ]] || [[ ! -f "./chronometrist.el" ]]; then
printf "Usage: scratch-test DASH-PATH [TIMECLOCK-FILE]\n"
printf "Please run this script from the chronometrist directory.\n"
else
dashdir="$1"
if [[ $# == 2 ]]; then
if [[ -f "$2" ]]; then
emacs -q -L "$(pwd)" \
-L "$dashdir" \
--eval "(progn
(require 'chronometrist)
(setq timeclock-file \"$2\")
(chronometrist))";
else
printf "Invalid timeclock file - $2"
fi
else
mv -v ~/.emacs.d/timelog ~/.emacs.d/timelog.old &&
emacs -q -L "$(pwd)" \
-L "$dashdir" \
--eval "(progn
(require 'chronometrist)
(chronometrist))" ;
mv -v ~/.emacs.d/timelog.old ~/.emacs.d/timelog
fi
fi

14
test.timelog Normal file
View File

@ -0,0 +1,14 @@
i 2018/01/01 00:00:00 Programming
o 2018/01/01 01:00:00
i 2018/01/01 02:00:00 Swimming
o 2018/01/01 03:00:00
i 2018/01/01 04:00:00 Cooking
o 2018/01/01 05:00:00
i 2018/01/01 06:00:00 Guitar
o 2018/01/01 07:00:00
i 2018/01/01 08:00:00 Cycling
o 2018/01/01 09:00:00
i 2018/01/02 23:00:00 Programming
o 2018/01/03 01:00:00
i 2018/01/04 00:00:00 Programming
o 2018/01/04 00:00:01

1
test2.timelog Normal file
View File

@ -0,0 +1 @@
i 2018/01/01 23:00:00 Test

View File

@ -0,0 +1,73 @@
;; -*- lexical-binding: t; -*-
(require 'chronometrist)
(ert-deftest task-list ()
(let ((task-list (chronometrist-task-list)))
(should (listp task-list))
(should (seq-every-p #'stringp task-list))))
(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)))))
;; ;; TODO
;; add newline after last expression and save => nil
;; remove newline after last expession and save => nil
(ert-deftest file-change-type ()
(let* ((chronometrist-file (concat default-directory "test.sexp"))
(test-contents (with-current-buffer (find-file-noselect chronometrist-file)
(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-sexp-new
'(: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-sexp-replace-last
'(: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-file
(goto-char (point-min))
(chronometrist-plist-pp '(:name "Other Change Test"
:start "2021-02-02T17:39:40+0530"
:stop "2021-02-02T17:39:44+0530")
(current-buffer))
(save-buffer))
(chronometrist-tests--change-type-and-update chronometrist--file-state)))))
(with-current-buffer (find-file-noselect chronometrist-file)
(delete-region (point-min) (point-max))
(insert test-contents)
(save-buffer))
(setq chronometrist--file-state chronometrist--file-state-old
chronometrist-events chronometrist-events-old))))
;; Local Variables:
;; nameless-current-name: "chronometrist"
;; End:

View File

@ -0,0 +1,94 @@
(require 'chronometrist-key-values)
(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))))
(ert-deftest chronometrist-plist-update ()
(let ((test-plist-1 '(:name "Old name"
:tags (foo)
:key1 "val 1"
:start "2021-01-10T22:59:23+0530"
:stop "2021-01-10T22:59:27+0530"))
(test-plist-2 '(:name "New name" :tags (bar)
:key1 "new val 1"
:key2 "val 2"
:start "2021-01-10T22:59:23+0530"
:stop "2021-01-10T22:59:27+0530")))
;; :name, :start, and :stop should not be updated
;; same keys should be updated
;; new keys should be added
;; old tags should be preserved
;; new tags should be added
(should (equal (chronometrist-plist-update test-plist-1 test-plist-2)
'(:name "Old name"
:tags (foo bar)
:key1 "new val 1"
:key2 "val 2"
:start "2021-01-10T22:59:23+0530"
:stop "2021-01-10T22:59:27+0530")))))
(ert-deftest chronometrist-tags-history ()
(progn
(clrhash chronometrist-tags-history)
(cl-loop for task in '("Guitar" "Programming") do
(chronometrist-tags-history-populate task chronometrist-tags-history "test.sexp")))
(should
(= (hash-table-count chronometrist-tags-history) 2))
(should
(cl-loop for task being the hash-keys of chronometrist-tags-history
always (stringp task)))
(should
(equal (gethash "Guitar" chronometrist-tags-history)
'((classical solo)
(classical warm-up))))
(should
(equal (gethash "Programming" chronometrist-tags-history)
'((reading) (bug-hunting)))))
(ert-deftest chronometrist-key-history ()
(progn
(clrhash chronometrist-key-history)
(cl-loop for task in '("Programming" "Arrangement/new edition") do
(chronometrist-key-history-populate task chronometrist-key-history "test.sexp")))
(should (= (hash-table-count chronometrist-key-history) 2))
(should (= (length (gethash "Programming" chronometrist-key-history)) 3))
(should (= (length (gethash "Arrangement/new edition" chronometrist-key-history)) 2)))
(ert-deftest chronometrist-value-history ()
(progn
(clrhash chronometrist-value-history)
(chronometrist-value-history-populate chronometrist-value-history "test.sexp"))
(should (= (hash-table-count chronometrist-value-history) 5))
(should
(cl-loop for task being the hash-keys of chronometrist-value-history
always (stringp task))))
;; Local Variables:
;; nameless-current-name: "chronometrist"
;; End:

105
tests-ert/plist-pp-tests.el Normal file
View File

@ -0,0 +1,105 @@
;; -*- lexical-binding: t; -*-
(require 'chronometrist-plist-pp)
(ert-deftest plist-p ()
(should (eq t (chronometrist-plist-pp-plist-p '(:a 1 :b 2))))
(should (eq nil (chronometrist-plist-pp-plist-p '(0 :a 1 :b 2))))
(should (eq nil (chronometrist-plist-pp-plist-p '(:a 1 :b 2 3)))))
(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\")))"))))
;; Local Variables:
;; nameless-current-name: "chronometrist-plist-pp"
;; End:

View File

@ -1,6 +1,6 @@
;;; -*- lexical-binding: t; -*-
(require 'buttercup)
(require 'chronometrist)
(require 'chronometrist-common)
(describe
"chronometrist-format-time"

View File

@ -1,6 +1,6 @@
;; -*- lexical-binding: t; -*-
(require 'buttercup)
(require 'chronometrist)
(require 'chronometrist-plist-pp)
(describe "chronometrist-plist-pp-buffer"
:var ((buffer (find-file-noselect "tests/plist-pp-test.sexp")))

View File

@ -1,7 +1,11 @@
;; -*- lexical-binding: t; -*-
(require 'buttercup)
(require 'ts)
(require 'chronometrist)
(require 'chronometrist-sexp)
(require 'chronometrist-events)
(require 'chronometrist-queries)
(require 'chronometrist-time)
(describe "chronometrist-task-time-one-day"
:var ((ts-1 (chronometrist-iso-date->ts "2018-01-01"))

View File

@ -1,488 +0,0 @@
#+PROPERTY: header-args :tangle yes :load yes :comments link
#+BEGIN_SRC emacs-lisp :load no :tangle no
(setq nameless-current-name "chronometrist")
#+END_SRC
* Setup
** test-file-path-stem
#+BEGIN_SRC emacs-lisp
(defvar chronometrist-test-file-path-stem
(format "%stest" (file-name-directory (or load-file-name default-directory))))
#+END_SRC
** test-backends
=chronometrist-test-backend= is just here till I finish writing the tests for a single backend. Will tackle how to apply the same tests to different backends afterwards - possibly with a [[#chronometrist-ert-deftest][wrapper macro]] around =ert-deftest=.
#+BEGIN_SRC emacs-lisp
(defvar chronometrist-test-backend
(make-instance 'chronometrist-plist-group-backend :path chronometrist-test-file-path-stem))
(defun chronometrist-make-test-backends ()
(cl-loop for backend in '(chronometrist-plist-backend chronometrist-plist-group-backend)
collect (make-instance backend :path chronometrist-test-file-path-stem)))
(defvar chronometrist-test-backends (chronometrist-make-test-backends))
#+END_SRC
** test-first-record
#+BEGIN_SRC emacs-lisp
(defvar chronometrist-test-first-record
'(:name "Programming"
:start "2018-01-01T00:00:00+0530"
:stop "2018-01-01T01:00:00+0530"))
#+END_SRC
** test-latest-record
#+BEGIN_SRC emacs-lisp
(defvar chronometrist-test-latest-record
'(: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
** test-records
#+BEGIN_SRC emacs-lisp
(defvar chronometrist-test-records
'((: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
** cleanup
#+BEGIN_SRC emacs-lisp
(cl-defgeneric chronometrist-backend-test-cleanup (backend)
"Delete any files created by BACKEND during testing.")
(cl-defmethod chronometrist-backend-test-cleanup ((backend chronometrist-elisp-sexp-backend))
(with-slots (file hash-table) backend
(when file
(when (file-exists-p file)
(delete-file file))
(with-current-buffer (get-file-buffer file)
;; (erase-buffer)
;; Unsuccessful attempt to inhibit "Delete excess backup versions of <file>?" prompts
(defvar delete-old-versions)
(let ((delete-old-versions t))
(set-buffer-modified-p nil)
(kill-buffer))))
(setf hash-table (clrhash hash-table))))
(cl-defmethod chronometrist-backend-test-cleanup :after ((backend t))
(setf chronometrist-test-backends (chronometrist-make-test-backends)))
#+END_SRC
** ert-deftest :macro:
:PROPERTIES:
:CUSTOM_ID: chronometrist-ert-deftest
:END:
#+BEGIN_SRC emacs-lisp
(defmacro chronometrist-ert-deftest (name backend-var &rest test-forms)
"Generate test groups containing TEST-FORMS for each backend.
BACKEND-VAR is bound to each backend in
`chronometrist-test-backends'. TEST-FORMS are passed to
`ert-deftest'."
(declare (indent defun) (debug t))
(cl-loop for backend in chronometrist-test-backends collect
(let* ((backend-name (string-remove-suffix
"-backend"
(string-remove-prefix "chronometrist"
(symbol-name
(eieio-object-class-name backend)))))
(test-name (concat "chronometrist-" (symbol-name name) backend-name)))
`(ert-deftest ,(intern test-name) ()
(let ((,backend-var ,backend))
(unwind-protect
(progn ,@test-forms)
;; cleanup - remove test backend file
(chronometrist-backend-test-cleanup ,backend)))))
into test-groups
finally return (cons 'progn test-groups)))
#+END_SRC
* Tests
** common
*** current-task
:PROPERTIES:
:CUSTOM_ID: tests-common-current-task
:END:
#+BEGIN_SRC emacs-lisp
(chronometrist-ert-deftest current-task b
;; (message "current-task test - hash-table-count %s" (hash-table-count (chronometrist-backend-hash-table b)))
(chronometrist-create-file b)
(should (not (chronometrist-current-task b)))
(chronometrist-insert b (list :name "Test" :start (chronometrist-format-time-iso8601)))
(should (equal "Test" (chronometrist-current-task b)))
(chronometrist-remove-last b)
(should (not (chronometrist-current-task b))))
#+END_SRC
*** plist-p
:PROPERTIES:
:CUSTOM_ID: tests-common-plist-p
:END:
#+BEGIN_SRC emacs-lisp
(ert-deftest chronometrist-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))))
(should (not (chronometrist-plist-p nil))))
#+END_SRC
*** plists-split-p
:PROPERTIES:
:CUSTOM_ID: tests-common-plists-split-p
:END:
#+BEGIN_SRC emacs-lisp
(ert-deftest chronometrist-plists-split-p ()
(should
(chronometrist-plists-split-p
'(:name "Cooking"
:recipe "whole wheat penne rigate in arrabbiata sauce"
:start "2021-11-30T23:01:10+0530"
:stop "2021-12-01T00:00:00+0530")
'(:name "Cooking"
:recipe "whole wheat penne rigate in arrabbiata sauce"
:start "2021-12-01T00:00:00+0530"
:stop "2021-12-01T00:06:22+0530")))
;; without :stop
(should
(chronometrist-plists-split-p
'(:name "Cooking"
:recipe "whole wheat penne rigate in arrabbiata sauce"
:start "2021-11-30T23:01:10+0530"
:stop "2021-12-01T00:00:00+0530")
'(:name "Cooking"
:recipe "whole wheat penne rigate in arrabbiata sauce"
:start "2021-12-01T00:00:00+0530")))
;; difference in time
(should
(not (chronometrist-plists-split-p
'(:name "Cooking"
:recipe "whole wheat penne rigate in arrabbiata sauce"
:start "2021-11-30T23:01:10+0530"
:stop "2021-12-01T00:00:00+0530")
'(:name "Cooking"
:recipe "whole wheat penne rigate in arrabbiata sauce"
:start "2021-12-01T00:00:01+0530"
:stop "2021-12-01T00:06:22+0530"))))
;; difference in key-values
(should
(not (chronometrist-plists-split-p
'(:name "Cooking"
:recipe "whole wheat penne rigate in arrabbiata sauce"
:start "2021-11-30T23:01:10+0530"
:stop "2021-12-01T00:00:00+0530")
'(:name "Cooking"
:start "2021-12-01T00:00:00+0530"
:stop "2021-12-01T00:06:22+0530")))))
#+END_SRC
** data structures
*** list-tasks
#+BEGIN_SRC emacs-lisp
(chronometrist-ert-deftest list-tasks b
;; (message "list-tasks test - hash-table-count %s" (hash-table-count (chronometrist-backend-hash-table b)))
(chronometrist-create-file b)
(let ((task-list (chronometrist-list-tasks b)))
(should (listp task-list))
(should (seq-every-p #'stringp task-list))))
#+END_SRC
** time functions
*** format-duration-long :pure:
#+BEGIN_SRC emacs-lisp
(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
** plist pretty-printing
[[file:../elisp/chronometrist.org::#program-pretty-printer][source]]
*** plist-group-p
#+BEGIN_SRC emacs-lisp
(ert-deftest chronometrist-plist-group-p ()
(should (eq t (chronometrist-plist-group-p '(symbol (:a 1 :b 2)))))
(should (eq t (chronometrist-plist-group-p '("string" (:a 1 :b 2)))))
(should (not (chronometrist-plist-group-p nil)))
(should (not (chronometrist-plist-group-p '("string")))))
#+END_SRC
*** plist-pp-to-string
#+BEGIN_SRC emacs-lisp
(ert-deftest chronometrist-pp-to-string ()
(should
(equal
(chronometrist-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-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-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-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\")))")))
(should (equal
(chronometrist-pp-to-string
'(:name "Guitar"
:tags (classical)
:warm-up ((right-hand-patterns "pima" "piam" "pmia" "pmai" "pami" "paim"))
:start "2021-09-28T17:49:18+0530"
:stop "2021-09-28T17:53:49+0530"))
(concat
"(:name \"Guitar\"\n"
" :tags (classical)\n"
" :warm-up ((right-hand-patterns \"pima\" \"piam\" \"pmia\" \"pmai\" \"pami\" \"paim\"))\n"
" :start \"2021-09-28T17:49:18+0530\"\n"
" :stop \"2021-09-28T17:53:49+0530\")")))
(should (equal
(chronometrist-pp-to-string
'(:name "Cooking"
:tags (lunch)
:recipe ("urad dhuli"
(:name "brown rice"
:brand "Dawat quick-cooking"
:quantity "40% of steel measuring glass"
:water "2× dry rice"))
:start "2021-11-07T14:40:45+0530"
:stop "2021-11-07T15:28:13+0530"))
(concat
"(:name \"Cooking\"\n"
" :tags (lunch)\n"
" :recipe (\"urad dhuli\"\n"
" (:name \"brown rice\"\n"
" :brand \"Dawat quick-cooking\"\n"
" :quantity \"40% of steel measuring glass\"\n"
" :water \"2× dry rice\"))\n"
" :start \"2021-11-07T14:40:45+0530\"\n"
" :stop \"2021-11-07T15:28:13+0530\")"))))
#+END_SRC
** backend
Situations
1. no file
2. empty file
3. non-empty file with no records
4. single record
* active
* inactive
* active, day-crossing
* inactive, day-crossing
5. multiple records
6. +[plist-group] latest plist is split+ (covered in #4)
Tests to be added -
1. to-hash-table
2. to-file
The order of these tests is important - the last test for each case is one which moves into the next case.
*** create-file
:PROPERTIES:
:CUSTOM_ID: tests-backend-create-file
:END:
#+BEGIN_SRC emacs-lisp
(chronometrist-ert-deftest create-file b
;; (message "create-file test - hash-table-count %s" (hash-table-count (chronometrist-backend-hash-table b)))
;; * file does not exist *
(should (chronometrist-create-file b))
;; * file exists but has no records *
(should (not (chronometrist-create-file b))))
#+END_SRC
*** latest-date-records
#+BEGIN_SRC emacs-lisp
(chronometrist-ert-deftest latest-date-records b
;; (message "latest-date-records test - hash-table-count %s" (hash-table-count (chronometrist-backend-hash-table b)))
(let ((plist-1 (cl-first chronometrist-test-records))
(plist-2 (cl-second chronometrist-test-records))
(today-ts (chronometrist-date-ts)))
;; * file does not exist *
(should-error (chronometrist-latest-date-records b))
(should (chronometrist-create-file b))
;; (message "latest-date-records: %S" (chronometrist-latest-date-records b))
;; * file exists but has no records *
(should (not (chronometrist-latest-date-records b)))
(should (chronometrist-insert b plist-1))
;; * backend has a single active record *
;; * backend has a single inactive record *
;; * backend has a single active day-crossing record *
;; * backend has a single inactive day-crossing record *
;; * backend has two records and one is active *
;; * backend has two records and both are inactive *
;; * backend has two day-crossing records and one is active *
;; * backend has two day-crossing records and both are inactive *
))
#+END_SRC
*** insert
#+BEGIN_SRC emacs-lisp
(chronometrist-ert-deftest insert b
;; (message "insert test - hash-table-count %s" (hash-table-count (chronometrist-backend-hash-table b)))
(let* ((plist1 (list :name "Test" :start (chronometrist-format-time-iso8601)))
(plist2 (append plist1 (list :stop (chronometrist-format-time-iso8601)))))
;; * file does not exist *
(should-error (chronometrist-insert b plist1))
(should (chronometrist-create-file b))
;; * file exists but has no records *
(should (chronometrist-insert b plist1))
(should (equal (progn (chronometrist-reset-backend b)
(chronometrist-latest-date-records b))
(list (chronometrist-date-iso) plist1)))
;; * backend has a single active record *
(should (chronometrist-replace-last b plist2))
(should (equal (progn (chronometrist-reset-backend b)
(chronometrist-latest-date-records b))
(list (chronometrist-date-iso) plist2)))
;; * backend has a single inactive record *
;; * backend has a single active day-crossing record *
;; * backend has a single inactive day-crossing record *
;; * backend has two records and one is active *
;; * backend has two records and both are inactive *
;; * backend has two day-crossing records and one is active *
;; * backend has two day-crossing records and both are inactive *
))
#+END_SRC
* Local Variables
# Local Variables:
# delete-old-versions: t
# End:

57
tests/test.sexp Normal file
View File

@ -0,0 +1,57 @@
(: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")