2021-02-08 06:38:27 +00:00
#+TODO : TODO | REVIEW
2021-02-05 10:45:29 +00:00
#+PROPERTY : header-args :tangle yes
2021-02-07 15:55:04 +00:00
2021-02-04 03:28:21 +00:00
* chronometrist
2021-02-07 19:34:59 +00:00
** About this file
2021-02-08 09:06:59 +00:00
This Org literate program was born out of frustration with programs stored as text files, which are expensive to restructure (especially in the presence of a VCS). I am happy with the outcome - tree and source-block folding, tags, properties, and =org-match= have made it trivial to get different views of the program, and literate programming may allow me to express the "explanation" documentation in the same context as the program, without having to try to link between documentation and source.
2021-02-07 19:34:59 +00:00
According to =benchmark= at the time of writing, =org-babel-tangle= takes about 30 seconds to tangle this file. Thus, I use a little sed one-liner (in the file-local variables) to do the tangling, which is nearly instant.
2021-02-08 09:06:59 +00:00
*** TODO Issues
1. When opening this file, Emacs may freeze at the prompt for file-local variable values; if so, C-g will quit the prompt, and permanently marking them as safe will make the freezing stop.
2. [ ] I like =visual-fill-column-mode= for natural language, but I don't want it applied to code blocks. =polymode.el= may hold answers.
3. [ ] Is there a cleaner tangling solution which is equally fast?
2021-02-04 03:28:21 +00:00
** Commentary
2021-02-04 03:28:52 +00:00
This is displayed when the user clicks on the package's entry in =M-x list-packages= .
2021-02-04 03:28:21 +00:00
#+BEGIN_SRC emacs-lisp
2021-02-04 10:43:19 +00:00
;;; chronometrist.el --- A time tracker with a nice interface -*- lexical-binding: t; -* -
;; Author: contrapunctus <xmpp:contrapunctus@jabber.fr >
;; Maintainer: contrapunctus <xmpp:contrapunctus@jabber.fr >
;; Keywords: calendar
;; Homepage: https://github.com/contrapunctus-1/chronometrist
;; Package-Requires: ((emacs "25.1")
;; (dash "2.16.0")
;; (seq "2.20")
;; (s "1.12.0")
;; (ts "0.2")
;; (anaphora "1.0.4"))
;; Version: 0.6.4
2019-08-04 19:27:22 +00:00
;;; Commentary:
;;
2020-07-05 18:16:14 +00:00
;; A time tracker in Emacs with a nice interface
2019-01-08 08:03:12 +00:00
2020-07-05 18:16:14 +00:00
;; Largely modelled after the Android application, [A Time Tracker](https://github.com/netmackan/ATimeTracker)
2019-01-08 08:03:12 +00:00
2020-07-05 18:16:14 +00:00
;; * 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
2018-08-27 20:22:06 +00:00
2020-07-05 18:16:14 +00:00
;; * Limitations
;; 1. No support (yet) for adding a task without clocking into it.
;; 2. No support for concurrent tasks.
;; ## Comparisons
;; ### timeclock.el
2020-08-11 19:54:55 +00:00
;; 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
2020-07-05 18:16:14 +00:00
;; ### Org time tracking
2020-08-11 19:54:55 +00:00
;; 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.
2020-07-05 18:16:14 +00:00
;; For information on usage and customization, see https://github.com/contrapunctus-1/chronometrist/blob/master/README.md
2021-02-04 03:28:21 +00:00
#+END_SRC
** Code
2021-02-08 09:06:59 +00:00
*** External libraries
2021-02-04 03:28:21 +00:00
#+BEGIN_SRC emacs-lisp
2019-07-29 10:59:17 +00:00
;;; Code:
2021-02-04 10:43:19 +00:00
(require 'filenotify)
(require 'cl-lib)
(require 'subr-x)
2021-02-07 15:55:04 +00:00
(require 'dash)
(require 'ts)
2020-08-11 19:59:34 +00:00
(eval-when-compile
2020-11-18 08:50:06 +00:00
(defvar chronometrist-mode-map)
(require 'subr-x))
2021-02-04 03:28:21 +00:00
#+END_SRC
2021-02-07 19:33:56 +00:00
*** Backend
2021-02-05 08:21:52 +00:00
**** pretty-print-function :custom:variable:
#+BEGIN_SRC emacs-lisp
(defcustom chronometrist-sexp-pretty-print-function #'chronometrist-plist-pp
"Function used to pretty print plists in `chronometrist-file'.
Like `pp', it must accept an OBJECT and optionally a
STREAM (which is the value of `current-buffer')."
:type 'function)
#+END_SRC
**** sexp-mode :major:mode:
#+BEGIN_SRC emacs-lisp
(define-derived-mode chronometrist-sexp-mode
;; fundamental-mode
emacs-lisp-mode
"chronometrist-sexp")
#+END_SRC
**** in-file :macro:
#+BEGIN_SRC emacs-lisp
(defmacro chronometrist-sexp-in-file (file &rest body)
"Run BODY in a buffer visiting FILE, restoring point afterwards."
(declare (indent defun) (debug t))
`(with-current-buffer (find-file-noselect ,file)
(save-excursion ,@body)))
#+END_SRC
**** loop-file :macro:
#+BEGIN_SRC emacs-lisp
(defmacro chronometrist-loop-file (for expr in file &rest loop-clauses)
"`cl-loop' LOOP-CLAUSES over s-expressions in FILE, in reverse.
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)))
#+END_SRC
**** open-log :function:
#+BEGIN_SRC emacs-lisp
(defun chronometrist-sexp-open-log ()
"Open `chronometrist-file' in another window."
(find-file-other-window chronometrist-file)
(goto-char (point-max)))
#+END_SRC
**** last :function:
#+BEGIN_SRC emacs-lisp
(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)))))
#+END_SRC
**** current-task :function:
#+BEGIN_SRC emacs-lisp
(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))))
#+END_SRC
**** events-populate :function:
#+BEGIN_SRC emacs-lisp
(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))))
#+END_SRC
**** create-file :function:
#+BEGIN_SRC emacs-lisp
(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))))
#+END_SRC
**** new :function:
#+BEGIN_SRC emacs-lisp
(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)))
#+END_SRC
**** delete-list :function:
#+BEGIN_SRC emacs-lisp
(defun chronometrist-sexp-delete-list (&optional arg)
"Delete ARG lists after point."
(let ((point-1 (point)))
(forward-sexp (or arg 1))
(delete-region point-1 (point))))
#+END_SRC
**** replace-last :function:
#+BEGIN_SRC emacs-lisp
(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)))
#+END_SRC
**** reindent-buffer :command:
#+BEGIN_SRC emacs-lisp
(defun chronometrist-sexp-reindent-buffer ()
"Reindent the current buffer.
This is meant to be run in `chronometrist-file' when using the s-expression backend."
(interactive)
(let (expr)
(goto-char (point-min))
(while (setq expr (ignore-errors (read (current-buffer))))
(backward-list)
(chronometrist-sexp-delete-list)
(when (looking-at "\n*")
(delete-region (match-beginning 0) (match-end 0)))
(funcall chronometrist-sexp-pretty-print-function expr (current-buffer))
(insert "\n")
(unless (eobp) (insert "\n")))))
#+END_SRC
2021-02-07 16:21:38 +00:00
**** last :function:query:
2021-02-07 16:12:50 +00:00
#+BEGIN_SRC emacs-lisp
(defun chronometrist-last ()
"Return the last entry from `chronometrist-file' as a plist."
(chronometrist-sexp-last))
#+END_SRC
2021-02-08 06:38:27 +00:00
*** Plist pretty-printing
**** normalize-whitespace :function:
#+BEGIN_SRC emacs-lisp
(defun chronometrist-plist-pp-normalize-whitespace ()
"Remove whitespace following point, and insert a space.
Point is placed at the end of the space."
2021-02-08 18:50:59 +00:00
(when (looking-at "[[:blank: ]]+")
2021-02-08 06:38:27 +00:00
(delete-region (match-beginning 0) (match-end 0))
(insert " ")))
#+END_SRC
**** column :function:
#+BEGIN_SRC emacs-lisp
(defun chronometrist-plist-pp-column ()
"Return column point is on, as an integer.
0 means point is at the beginning of the line."
(- (point) (point-at-bol)))
#+END_SRC
**** pair-p :function:predicate:
#+BEGIN_SRC emacs-lisp
(defun chronometrist-plist-pp-pair-p (cons)
(and (listp cons) (not (listp (cdr cons)))))
#+END_SRC
**** alist-p :function:predicate:
#+BEGIN_SRC emacs-lisp
(defun chronometrist-plist-pp-alist-p (list)
"Return non-nil if LIST is an association list.
If even a single element of LIST is a pure cons cell (as
determined by `chronometrist-plist-pp-pair-p'), this function
considers it an alist."
(when (listp list)
(cl-loop for elt in list thereis (chronometrist-plist-pp-pair-p elt))))
#+END_SRC
**** plist-p :function:predicate:
#+BEGIN_SRC emacs-lisp
(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))
#+END_SRC
**** longest-keyword-length :function:
#+BEGIN_SRC emacs-lisp
(defun chronometrist-plist-pp-longest-keyword-length ()
"Find the length of the longest keyword in a plist.
This assumes there is a single plist in the current buffer, and
that point is after the first opening parenthesis."
(save-excursion
(cl-loop with sexp
while (setq sexp (ignore-errors (read (current-buffer))))
when (keywordp sexp)
maximize (length (symbol-name sexp)))))
#+END_SRC
**** indent-sexp :function:
#+BEGIN_SRC emacs-lisp
(cl-defun chronometrist-plist-pp-indent-sexp (sexp &optional (right-indent 0))
"Return a string indenting SEXP by RIGHT-INDENT spaces."
(format (concat "% -" (number-to-string right-indent) "s")
sexp))
#+END_SRC
**** buffer :function:
#+BEGIN_SRC emacs-lisp
(cl-defun chronometrist-plist-pp-buffer (&optional inside-sublist-p)
"Recursively indent the alist, plist, or a list of plists after point.
The list must be on a single line, as emitted by `prin1'."
(if (not (looking-at-p (rx (or ")" line-end))))
(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)
2021-02-08 18:50:59 +00:00
(if (string-match "^[[:blank: ]]*$" (buffer-substring bol pos))
2021-02-08 06:38:27 +00:00
;; join the ) to the previous line by deleting the newline and whitespace
(delete-region (1- bol) pos)
(goto-char pos))
(when (not (eobp))
(forward-char)))))
#+END_SRC
**** buffer-plist :function:
#+BEGIN_SRC emacs-lisp
(defun chronometrist-plist-pp-buffer-plist (&optional inside-sublist-p)
"Indent a single plist after point."
(down-list)
(let ((left-indent (1- (chronometrist-plist-pp-column)))
(right-indent (chronometrist-plist-pp-longest-keyword-length))
(first-p t) sexp)
(while (not (looking-at-p ")"))
(chronometrist-plist-pp-normalize-whitespace)
(setq sexp (save-excursion (read (current-buffer))))
(cond ((keywordp sexp)
(chronometrist-sexp-delete-list)
(insert (if first-p
(progn (setq first-p nil) "")
(make-string left-indent ?\ ))
(chronometrist-plist-pp-indent-sexp sexp right-indent)))
;; not a keyword = a value
((chronometrist-plist-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) ?\ )))))
#+END_SRC
**** buffer-alist :function:
#+BEGIN_SRC emacs-lisp
(defun chronometrist-plist-pp-buffer-alist ()
"Indent a single alist after point."
(down-list)
(let ((indent (chronometrist-plist-pp-column)) (first-p t) sexp)
(while (not (looking-at-p ")"))
(setq sexp (save-excursion (read (current-buffer))))
(chronometrist-sexp-delete-list)
(insert (if first-p
(progn (setq first-p nil) "")
(make-string indent ?\ ))
(format "%S\n" sexp)))
(when (bolp) (delete-char -1))
(up-list)))
#+END_SRC
**** to-string :function:
#+BEGIN_SRC emacs-lisp
(defun chronometrist-plist-pp-to-string (object)
"Convert OBJECT to a pretty-printed string."
(with-temp-buffer
(lisp-mode-variables nil)
(set-syntax-table emacs-lisp-mode-syntax-table)
(let ((print-quoted t))
(prin1 object (current-buffer)))
(goto-char (point-min))
(chronometrist-plist-pp-buffer)
(buffer-string)))
#+END_SRC
**** plist-pp :function:
#+BEGIN_SRC emacs-lisp
(defun chronometrist-plist-pp (object &optional stream)
"Pretty-print OBJECT and output to STREAM (see `princ')."
(princ (chronometrist-plist-pp-to-string object)
(or stream standard-output)))
#+END_SRC
2021-02-08 05:52:58 +00:00
*** Migration
**** table :variable:
#+BEGIN_SRC emacs-lisp
(defvar chronometrist-migrate-table (make-hash-table))
#+END_SRC
**** populate :function:
#+BEGIN_SRC emacs-lisp
;; 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)))
#+END_SRC
**** timelog-file->sexp-file :function:
#+BEGIN_SRC emacs-lisp
(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)))))
#+END_SRC
**** check :function:
#+BEGIN_SRC emacs-lisp
(defun chronometrist-migrate-check ()
"Offer to import data from `timeclock-file' if `chronometrist-file' does not exist."
(when (and (bound-and-true-p timeclock-file)
(not (file-exists-p chronometrist-file)))
(if (yes-or-no-p (format (concat "Chronometrist v0.3+ uses a new file format;"
" import data from %s ? ")
timeclock-file))
(chronometrist-migrate-timelog-file->sexp-file timeclock-file chronometrist-file)
(message "You can migrate later using `chronometrist-migrate-timelog-file->sexp-file'."))))
#+END_SRC
2021-02-04 16:16:40 +00:00
*** Hash Table
2021-02-05 08:21:52 +00:00
**** chronometrist-events :variable:
2021-02-04 16:16:40 +00:00
#+BEGIN_SRC emacs-lisp
(defvar chronometrist-events (make-hash-table :test #'equal)
"Each key is a date in the form (YEAR MONTH DAY).
Values are lists containing events, where each event is a list in
the form (:name \"NAME\" :tags (TAGS) <key value pairs > ...
:start TIME :stop TIME).")
#+END_SRC
**** day-start :function:
#+BEGIN_SRC emacs-lisp
(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))))
#+END_SRC
**** events-maybe-split :function:
#+BEGIN_SRC emacs-lisp
(defun chronometrist-events-maybe-split (event)
"Split EVENT if it spans midnight.
Return a list of two events if EVENT was split, else nil."
(when (plist-get event :stop)
(let ((split-time (chronometrist-midnight-spanning-p (plist-get event :start)
(plist-get event :stop))))
(when split-time
(let ((first-start (plist-get (cl-first split-time) :start))
(first-stop (plist-get (cl-first split-time) :stop))
(second-start (plist-get (cl-second split-time) :start))
(second-stop (plist-get (cl-second split-time) :stop))
;; plist-put modifies lists in-place. The resulting bugs
;; left me puzzled for a while.
(event-1 (cl-copy-list event))
(event-2 (cl-copy-list event)))
(list (-> event-1
(plist-put :start first-start)
(plist-put :stop first-stop))
(-> event-2
(plist-put :start second-start)
(plist-put :stop second-stop))))))))
#+END_SRC
;; 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.
**** events-populate :function:
#+BEGIN_SRC emacs-lisp
(defun chronometrist-events-populate ()
"Clear hash table `chronometrist-events' (which see) and populate it.
The data is acquired from `chronometrist-file'.
Return final number of events read from file, or nil if there
were none."
(clrhash chronometrist-events)
(chronometrist-sexp-events-populate))
#+END_SRC
2021-02-07 16:12:50 +00:00
**** events-update :function:mutator:
2021-02-04 16:16:40 +00:00
#+BEGIN_SRC emacs-lisp
(defun chronometrist-events-update (plist &optional replace)
"Add PLIST to the end of `chronometrist-events'.
If REPLACE is non-nil, replace the last event with PLIST."
(let* ((date (->> (plist-get plist :start)
(chronometrist-iso-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))))
#+END_SRC
2021-02-07 16:12:50 +00:00
**** events-subset :function:query:
2021-02-04 16:16:40 +00:00
#+BEGIN_SRC emacs-lisp
(defun chronometrist-events-subset (start end)
"Return a subset of `chronometrist-events'.
The subset will contain values between dates START and END (both
inclusive).
START and END must be ts structs (see `ts.el'). They will be
treated as though their time is 00:00:00."
(let ((subset (make-hash-table :test #'equal))
(start (chronometrist-date start))
(end (chronometrist-date end)))
(maphash (lambda (key value)
(when (ts-in start end (chronometrist-iso-date->ts key))
(puthash key value subset)))
chronometrist-events)
subset))
#+END_SRC
2021-02-07 16:12:50 +00:00
**** task-time-one-day :function:query:
#+BEGIN_SRC emacs-lisp
(cl-defun chronometrist-task-time-one-day (task &optional (ts (ts-now)))
"Return total time spent on TASK today or (if supplied) on timestamp TS.
The data is obtained from `chronometrist-file', via `chronometrist-events'.
TS should be a ts struct (see `ts.el').
The return value is seconds, as an integer."
(let ((task-events (chronometrist-task-events-in-day task ts)))
(if task-events
(->> (chronometrist-events->ts-pairs task-events)
(chronometrist-ts-pairs->durations)
(-reduce #'+)
(truncate))
;; no events for this task on TS, i.e. no time spent
0)))
#+END_SRC
**** task-time-one-day :function:query:
#+BEGIN_SRC emacs-lisp
(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)))
#+END_SRC
**** count-active-days :function:query:
#+BEGIN_SRC emacs-lisp
(cl-defun chronometrist-statistics-count-active-days (task &optional (table chronometrist-events))
"Return the number of days the user spent any time on TASK.
TABLE must be a hash table - if not supplied, `chronometrist-events' is used.
This will not return correct results if TABLE contains records
which span midnights. (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))
#+END_SRC
**** task-events-in-day :function:query:
#+BEGIN_SRC emacs-lisp
(cl-defun chronometrist-task-events-in-day (task &optional (ts (ts-now)))
"Get events for TASK on TS.
TS should be a ts struct (see `ts.el').
Returns a list of events, where each event is a property list in
the form (:name \"NAME\" :start START :stop STOP ...), where
START and STOP are ISO-8601 time strings.
This will not return correct results if TABLE contains records
which span midnights. (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)))
#+END_SRC
2021-02-08 05:52:58 +00:00
*** Common
**** task-list :variable:
2021-02-04 03:28:21 +00:00
#+BEGIN_SRC emacs-lisp
2021-02-08 05:52:58 +00:00
(defvar chronometrist-task-list nil
"List of tasks in `chronometrist-file'.")
2021-02-04 03:28:21 +00:00
#+END_SRC
2021-02-08 05:52:58 +00:00
**** fs-watch :internal:variable:
2021-02-04 03:28:21 +00:00
#+BEGIN_SRC emacs-lisp
2021-02-08 05:52:58 +00:00
(defvar chronometrist--fs-watch nil
"Filesystem watch object.
Used to prevent more than one watch being added for the same
file.")
2021-02-04 03:28:21 +00:00
#+END_SRC
2021-02-08 05:52:58 +00:00
**** current-task :function:
2021-02-04 03:28:21 +00:00
#+BEGIN_SRC emacs-lisp
2021-02-08 05:52:58 +00:00
(defun chronometrist-current-task ()
"Return the name of the currently clocked-in task, or nil if not clocked in."
(chronometrist-sexp-current-task))
2021-02-04 03:28:21 +00:00
#+END_SRC
2021-02-08 05:52:58 +00:00
**** format-time :function:
2021-02-04 03:28:21 +00:00
#+BEGIN_SRC emacs-lisp
2021-02-08 05:52:58 +00:00
(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.
2020-11-18 08:50:06 +00:00
2021-02-08 05:52:58 +00:00
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)))))
2021-02-04 03:28:21 +00:00
#+END_SRC
2021-02-08 18:34:27 +00:00
**** file-empty-p :function:predicate:
2021-02-04 03:28:21 +00:00
#+BEGIN_SRC emacs-lisp
2021-02-08 05:52:58 +00:00
(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)))
2021-02-04 03:28:21 +00:00
#+END_SRC
2021-02-08 05:52:58 +00:00
**** clear-buffer :function:
2021-02-04 03:28:21 +00:00
#+BEGIN_SRC emacs-lisp
2021-02-08 05:52:58 +00:00
(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))))
2021-02-04 03:28:21 +00:00
#+END_SRC
2021-02-08 05:52:58 +00:00
**** format-keybinds :function:
2021-02-04 03:28:21 +00:00
#+BEGIN_SRC emacs-lisp
2021-02-08 05:52:58 +00:00
(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))))
2021-02-04 03:28:21 +00:00
#+END_SRC
2021-02-08 05:52:58 +00:00
**** events->ts-pairs :function:
2021-02-04 03:28:21 +00:00
#+BEGIN_SRC emacs-lisp
2021-02-08 05:52:58 +00:00
(defun chronometrist-events->ts-pairs (events)
"Convert EVENTS to a list of ts struct pairs (see `ts.el').
2020-05-15 09:44:22 +00:00
2021-02-08 05:52:58 +00:00
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))))
2021-02-04 03:28:21 +00:00
#+END_SRC
2021-02-08 05:52:58 +00:00
**** ts-pairs->durations :function:
2021-02-04 03:28:21 +00:00
#+BEGIN_SRC emacs-lisp
2021-02-08 05:52:58 +00:00
(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))
2021-02-04 03:28:21 +00:00
#+END_SRC
2021-02-08 05:52:58 +00:00
**** previous-week-start :function:
2021-02-04 03:28:21 +00:00
#+BEGIN_SRC emacs-lisp
2021-02-08 05:52:58 +00:00
(defun chronometrist-previous-week-start (ts)
"Find the previous `chronometrist-report-week-start-day' from TS.
2021-01-04 03:14:48 +00:00
2021-02-08 05:52:58 +00:00
Return a ts struct for said day's beginning.
2021-01-04 03:14:48 +00:00
2021-02-08 05:52:58 +00:00
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))
2021-02-04 03:28:21 +00:00
#+END_SRC
2021-02-08 05:52:58 +00:00
*** Time functions
**** iso-timestamp->ts :function:
2021-02-04 03:28:21 +00:00
#+BEGIN_SRC emacs-lisp
2021-02-08 05:52:58 +00:00
(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))))
2021-02-04 03:28:21 +00:00
#+END_SRC
2021-02-08 05:52:58 +00:00
**** iso-date->ts :function:
2021-02-04 03:28:21 +00:00
#+BEGIN_SRC emacs-lisp
2021-02-08 05:52:58 +00:00
(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))))
2021-02-04 03:28:21 +00:00
#+END_SRC
2021-02-08 05:52:58 +00:00
**** date :function:
2021-02-04 03:28:21 +00:00
#+BEGIN_SRC emacs-lisp
2021-02-08 05:52:58 +00:00
(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))
2021-02-04 03:28:21 +00:00
#+END_SRC
2021-02-08 05:52:58 +00:00
**** format-time-iso8601 :function:
2021-02-04 03:28:21 +00:00
#+BEGIN_SRC emacs-lisp
2021-02-08 05:52:58 +00:00
(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.
2021-02-04 03:28:21 +00:00
#+END_SRC
2021-02-08 18:34:27 +00:00
**** midnight-spanning-p :function:predicate:
2021-02-04 03:28:21 +00:00
#+BEGIN_SRC emacs-lisp
2021-02-08 05:52:58 +00:00
(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)))))
2021-02-04 03:28:21 +00:00
#+END_SRC
2021-02-08 05:52:58 +00:00
**** seconds-to-hms :function:
2021-02-04 03:28:21 +00:00
#+BEGIN_SRC emacs-lisp
2021-02-08 05:52:58 +00:00
(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)))
2021-02-04 03:28:21 +00:00
#+END_SRC
2021-02-08 05:52:58 +00:00
**** interval :function:
2021-02-04 03:28:21 +00:00
#+BEGIN_SRC emacs-lisp
2021-02-08 05:52:58 +00:00
(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))))
2021-02-04 03:28:21 +00:00
#+END_SRC
2021-02-08 05:52:58 +00:00
*** Timer
**** timer-object :internal:variable:
2021-02-04 03:28:21 +00:00
#+BEGIN_SRC emacs-lisp
2021-02-08 05:52:58 +00:00
(defvar chronometrist--timer-object nil)
2021-02-04 03:28:21 +00:00
#+END_SRC
2021-02-08 05:52:58 +00:00
**** timer-hook :hook:custom:variable:
2021-02-04 03:28:21 +00:00
#+BEGIN_SRC emacs-lisp
2021-02-08 05:52:58 +00:00
(defcustom chronometrist-timer-hook nil
"Functions run by `chronometrist-timer'.")
#+END_SRC
**** timer :function:
#+BEGIN_SRC emacs-lisp
(defun chronometrist-timer ()
"Refresh Chronometrist and related buffers.
2020-08-30 19:53:43 +00:00
2021-02-08 05:52:58 +00:00
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)))
2021-02-04 03:28:21 +00:00
#+END_SRC
2021-02-08 05:52:58 +00:00
**** stop-timer :command:
2021-02-04 03:28:21 +00:00
#+BEGIN_SRC emacs-lisp
2021-02-08 05:52:58 +00:00
(defun chronometrist-stop-timer ()
"Stop the timer for Chronometrist buffers."
(interactive)
(cancel-timer chronometrist--timer-object)
(setq chronometrist--timer-object nil))
2021-02-04 03:28:21 +00:00
#+END_SRC
2021-02-08 05:52:58 +00:00
**** maybe-start-timer :command:
2021-02-04 03:28:52 +00:00
#+BEGIN_SRC emacs-lisp
2021-02-08 05:52:58 +00:00
(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))
2021-02-04 03:28:21 +00:00
#+END_SRC
2021-02-08 05:52:58 +00:00
**** force-restart-timer :command:
2021-02-04 03:28:21 +00:00
#+BEGIN_SRC emacs-lisp
2021-02-08 05:52:58 +00:00
(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)))
2021-02-04 03:28:21 +00:00
#+END_SRC
2021-02-08 05:52:58 +00:00
**** change-update-interval :command:
2021-02-04 03:28:21 +00:00
#+BEGIN_SRC emacs-lisp
2021-02-08 05:52:58 +00:00
(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))
2021-02-04 03:28:21 +00:00
#+END_SRC
2021-02-08 18:52:04 +00:00
*** Frontends
**** Chronometrist
***** custom group :custom:group:
2021-02-04 03:28:21 +00:00
#+BEGIN_SRC emacs-lisp
2021-02-08 05:52:58 +00:00
(defgroup chronometrist nil
"A time tracker with a nice UI."
:group 'applications)
2021-02-04 03:28:21 +00:00
#+END_SRC
2021-02-08 18:52:04 +00:00
***** chronometrist-file :custom:variable:
2021-02-04 03:28:21 +00:00
#+BEGIN_SRC emacs-lisp
2021-02-08 05:52:58 +00:00
(defcustom chronometrist-file
(locate-user-emacs-file "chronometrist.sexp")
"Default path and name of the Chronometrist database.
It should be a text file containing plists in the form -
\(:name \"task name\"
[:tags TAGS]
[:comment \"comment\"]
[KEY-VALUE-PAIR ...]
:start \"TIME\"
:stop \"TIME\"\)
Where -
TAGS is a list. It can contain any strings and symbols.
KEY-VALUE-PAIR can be any keyword-value pairs. Currently,
Chronometrist ignores them.
TIME must be an ISO-8601 time string.
\(The square brackets here refer to optional elements, not
vectors.\)"
:type 'file)
2021-02-04 03:28:21 +00:00
#+END_SRC
2021-02-08 18:52:04 +00:00
***** buffer-name :custom:variable:
2021-02-04 03:28:21 +00:00
#+BEGIN_SRC emacs-lisp
2021-02-08 05:52:58 +00:00
(defcustom chronometrist-buffer-name "*Chronometrist* "
"The name of the buffer created by `chronometrist'."
:type 'string)
2021-02-04 03:28:21 +00:00
#+END_SRC
2021-02-08 18:52:04 +00:00
***** hide-cursor :custom:variable:
2021-02-04 03:28:21 +00:00
#+BEGIN_SRC emacs-lisp
2021-02-08 05:52:58 +00:00
(defcustom chronometrist-hide-cursor nil
"If non-nil, hide the cursor and only highlight the current line in the `chronometrist' buffer."
:type 'boolean)
2021-02-04 03:28:21 +00:00
#+END_SRC
2021-02-08 18:52:04 +00:00
***** update-interval :custom:variable:
2021-02-04 03:28:21 +00:00
#+BEGIN_SRC emacs-lisp
2021-02-08 05:52:58 +00:00
(defcustom chronometrist-update-interval 5
"How often the `chronometrist' buffer should be updated, in seconds.
This is not guaranteed to be accurate - see (info \"(elisp)Timers\")."
:type 'integer)
2021-02-04 03:28:21 +00:00
#+END_SRC
2021-02-08 18:52:04 +00:00
***** activity-indicator :custom:variable:
2021-02-04 03:28:21 +00:00
#+BEGIN_SRC emacs-lisp
2021-02-08 05:52:58 +00:00
(defcustom chronometrist-activity-indicator "*"
"How to indicate that a task is active.
Can be a string to be displayed, or a function which returns this string.
The default is \"*\""
:type '(choice string function))
2021-02-04 03:28:21 +00:00
#+END_SRC
2021-02-08 18:52:04 +00:00
***** day-start-time :custom:variable:
2021-02-04 03:28:21 +00:00
#+BEGIN_SRC emacs-lisp
2021-02-08 05:52:58 +00:00
(defcustom chronometrist-day-start-time "00:00:00"
"The time at which a day is considered to start, in \"HH:MM:SS\".
2020-09-06 08:43:35 +00:00
2021-02-08 05:52:58 +00:00
The default is midnight, i.e. \"00:00:00\"."
:type 'string)
2021-02-04 03:28:21 +00:00
#+END_SRC
2021-02-08 18:52:04 +00:00
***** point :internal:variable:
2021-02-04 03:28:21 +00:00
#+BEGIN_SRC emacs-lisp
2021-02-08 05:52:58 +00:00
(defvar chronometrist--point nil)
2021-02-04 03:28:21 +00:00
#+END_SRC
2021-02-08 18:52:04 +00:00
***** open-log :command:
2021-02-04 03:28:21 +00:00
#+BEGIN_SRC emacs-lisp
2021-02-08 05:52:58 +00:00
(defun chronometrist-open-log (&optional _button)
"Open `chronometrist-file' in another window.
2018-09-27 22:16:55 +00:00
2021-02-08 05:52:58 +00:00
Argument _BUTTON is for the purpose of using this command as a
button action."
(interactive)
(chronometrist-sexp-open-log))
2021-02-04 03:28:21 +00:00
#+END_SRC
2021-02-08 18:52:04 +00:00
***** create-file :function:
2021-02-04 03:28:21 +00:00
#+BEGIN_SRC emacs-lisp
2021-02-08 05:52:58 +00:00
(defun chronometrist-common-create-file ()
"Create `chronometrist-file' if it doesn't already exist."
(chronometrist-sexp-create-file))
2021-02-04 03:28:21 +00:00
#+END_SRC
2021-02-08 18:52:04 +00:00
***** task-active? :function:
2021-02-04 03:28:21 +00:00
#+BEGIN_SRC emacs-lisp
2021-02-08 05:52:58 +00:00
(defun chronometrist-task-active? (task)
"Return t if TASK is currently clocked in, else nil."
(equal (chronometrist-current-task) task))
2021-02-04 03:28:21 +00:00
#+END_SRC
2021-02-08 18:52:04 +00:00
***** activity-indicator :function:
2021-02-04 03:28:21 +00:00
#+BEGIN_SRC emacs-lisp
2021-02-08 05:52:58 +00:00
(defun chronometrist-activity-indicator ()
"Return a string to indicate that a task is active.
See custom variable `chronometrist-activity-indicator'."
(if (functionp chronometrist-activity-indicator)
(funcall chronometrist-activity-indicator)
chronometrist-activity-indicator))
2021-02-04 03:28:21 +00:00
#+END_SRC
2021-02-08 18:52:04 +00:00
***** run-transformers :function:
2021-02-04 03:28:21 +00:00
#+BEGIN_SRC emacs-lisp
2021-02-08 05:52:58 +00:00
(defun chronometrist-run-transformers (transformers arg)
"Run TRANSFORMERS with ARG.
TRANSFORMERS should be a list of functions (F₁ ... Fₙ), each of
which should accept a single argument.
Call F₁ with ARG, with each following function being called with
the return value of the previous function.
Return the value returned by Fₙ."
(if transformers
(dolist (fn transformers arg)
(setq arg (funcall fn arg)))
arg))
2021-02-04 03:28:21 +00:00
#+END_SRC
2021-02-08 18:52:04 +00:00
***** entries :function:
2021-02-04 03:28:21 +00:00
#+BEGIN_SRC emacs-lisp
2021-02-08 05:52:58 +00:00
(defun chronometrist-entries ()
"Create entries to be displayed in the buffer created by `chronometrist', in the format specified by `tabulated-list-entries'."
;; HACK - these calls are commented out, because `chronometrist-entries' is
;; called by both `chronometrist-refresh' and `chronometrist-refresh-file', and only the
;; latter should refresh from a file.
;; (chronometrist-events-populate)
;; (chronometrist-events-clean)
(->> (-sort #'string-lessp chronometrist-task-list)
(--map-indexed
(let* ((task it)
(index (number-to-string (1+ it-index)))
(task-button `(,task action chronometrist-toggle-task-button follow-link t))
(task-time (chronometrist-format-time (chronometrist-task-time-one-day task)))
(indicator (if (chronometrist-task-active? task) (chronometrist-activity-indicator) "")))
(--> (vector index task-button task-time indicator)
(list task it)
(chronometrist-run-transformers chronometrist-entry-transformers it))))))
2021-02-04 03:28:21 +00:00
#+END_SRC
2021-02-08 18:52:04 +00:00
***** task-at-point :function:
2021-02-04 03:28:21 +00:00
#+BEGIN_SRC emacs-lisp
2021-02-08 05:52:58 +00:00
(defun chronometrist-task-at-point ()
"Return the task at point in the `chronometrist' buffer, or nil if there is no task at point."
(save-excursion
(beginning-of-line)
(when (re-search-forward "[0-9]+ + " nil t)
(get-text-property (point) 'tabulated-list-id))))
2021-02-04 03:28:21 +00:00
#+END_SRC
2021-02-08 18:52:04 +00:00
***** goto-last-task :function:
2021-02-04 03:28:21 +00:00
#+BEGIN_SRC emacs-lisp
2021-02-08 05:52:58 +00:00
(defun chronometrist-goto-last-task ()
"In the `chronometrist' buffer, move point to the line containing the last active task."
(goto-char (point-min))
(re-search-forward (plist-get (chronometrist-last) :name) nil t)
(beginning-of-line))
2021-02-04 03:28:21 +00:00
#+END_SRC
2021-02-08 18:52:04 +00:00
***** print-keybind :function:
2021-02-04 03:28:21 +00:00
#+BEGIN_SRC emacs-lisp
2021-02-08 05:52:58 +00:00
(defun chronometrist-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
(format "\n% 18s - %s"
(chronometrist-format-keybinds command chronometrist-mode-map firstonly)
(if description description ""))))
2021-02-04 03:28:21 +00:00
#+END_SRC
2021-02-08 18:52:04 +00:00
***** print-non-tabular :function:
2021-02-04 03:28:21 +00:00
#+BEGIN_SRC emacs-lisp
2021-02-08 05:52:58 +00:00
(defun chronometrist-print-non-tabular ()
"Print the non-tabular part of the buffer in `chronometrist'."
(with-current-buffer chronometrist-buffer-name
(let ((inhibit-read-only t)
(w "\n ")
;; (keybind-start-new (chronometrist-format-keybinds 'chronometrist-add-new-task chronometrist-mode-map))
(keybind-toggle (chronometrist-format-keybinds 'chronometrist-toggle-task chronometrist-mode-map t)))
(goto-char (point-max))
(--> (chronometrist-active-time-one-day)
(chronometrist-format-time it)
(format "%s%- 26s%s" w "Total" it)
(insert it))
(insert "\n")
(insert w (format "% 17s" "Keys") w (format "% 17s" "----"))
(chronometrist-print-keybind 'chronometrist-add-new-task)
(insert-text-button "start a new task" 'action #'chronometrist-add-new-task-button 'follow-link t)
(chronometrist-print-keybind 'chronometrist-toggle-task "toggle task at point")
(chronometrist-print-keybind 'chronometrist-toggle-task-no-hooks "toggle without running hooks")
(insert "\n " (format "%s %s - %s" "<numeric argument N >" keybind-toggle "toggle <N >th task"))
(chronometrist-print-keybind 'chronometrist-report)
(insert-text-button "see weekly report" 'action #'chronometrist-report 'follow-link t)
(chronometrist-print-keybind 'chronometrist-open-log)
(insert-text-button "view/edit log file" 'action #'chronometrist-open-log 'follow-link t)
(insert "\n"))))
2021-02-04 03:28:21 +00:00
#+END_SRC
2021-02-08 18:52:04 +00:00
***** goto-nth-task :function:
2021-02-04 03:28:21 +00:00
#+BEGIN_SRC emacs-lisp
2021-02-08 05:52:58 +00:00
(defun chronometrist-goto-nth-task (n)
"Move point to the line containing the Nth task.
Return the task at point, or nil if there is no corresponding
task. N must be a positive integer."
(goto-char (point-min))
(when (re-search-forward (format "^%d" n) nil t)
(beginning-of-line)
(chronometrist-task-at-point)))
2021-02-04 03:28:21 +00:00
#+END_SRC
2021-02-08 18:52:04 +00:00
***** refresh :function:
2021-02-04 03:28:21 +00:00
#+BEGIN_SRC emacs-lisp
2021-02-08 05:52:58 +00:00
(defun chronometrist-refresh (&optional _ignore-auto _noconfirm)
"Refresh the `chronometrist' buffer, without re-reading `chronometrist-file'.
2018-09-21 18:50:46 +00:00
2021-02-08 05:52:58 +00:00
The optional arguments _IGNORE-AUTO and _NOCONFIRM are ignored,
and are present solely for the sake of using this function as a
value of `revert-buffer-function'."
(let* ((window (get-buffer-window chronometrist-buffer-name t))
(point (window-point window)))
(when window
(with-current-buffer chronometrist-buffer-name
(tabulated-list-print t nil)
(chronometrist-print-non-tabular)
(chronometrist-maybe-start-timer)
(set-window-point window point)))))
2021-02-04 03:28:21 +00:00
#+END_SRC
2021-02-08 18:52:04 +00:00
***** file-state :internal:variable:
2021-02-04 03:28:21 +00:00
#+BEGIN_SRC emacs-lisp
2021-02-08 05:52:58 +00:00
(defvar chronometrist--file-state nil
"List containing the state of `chronometrist-file'.
`chronometrist-refresh-file' sets this to a plist in the form
2019-08-06 11:36:38 +00:00
2021-02-08 05:52:58 +00:00
\(:last (LAST-START LAST-END) :rest (REST-START REST-END HASH))
\(see `chronometrist-file-hash')
LAST-START and LAST-END represent the start and the end of the
last s-expression.
REST-START and REST-END represent the start of the file and the
end of the second-last s-expression.")
2021-02-04 03:28:21 +00:00
#+END_SRC
2021-02-08 18:52:04 +00:00
***** file-hash :function:
2021-02-04 03:28:21 +00:00
#+BEGIN_SRC emacs-lisp
2021-02-08 05:52:58 +00:00
(defun chronometrist-file-hash (&optional start end hash)
"Calculate hash of `chronometrist-file' between START and END.
START can be
a number or marker,
:before-last - the position at the start of the last s-expression
nil or any other value - the value of `point-min'.
2019-08-06 11:36:38 +00:00
2021-02-08 05:52:58 +00:00
END can be
a number or marker,
:before-last - the position at the end of the second-last s-expression,
nil or any other value - the position at the end of the last s-expression.
2018-11-02 08:28:54 +00:00
2021-02-08 05:52:58 +00:00
Return (START END) if HASH is nil, else (START END HASH).
2018-09-11 12:27:34 +00:00
2021-02-08 05:52:58 +00:00
Return a list in the form (A B HASH), where A and B are markers
in `chronometrist-file' describing the region for which HASH was calculated."
(chronometrist-sexp-in-file chronometrist-file
(let* ((start (cond ((number-or-marker-p start) start)
((eq :before-last start)
(goto-char (point-max))
(backward-list))
(t (point-min))))
(end (cond ((number-or-marker-p end) end)
((eq :before-last end)
(goto-char (point-max))
(backward-list 2)
(forward-list))
(t (goto-char (point-max))
(backward-list)
(forward-list)))))
(if hash
(--> (buffer-substring-no-properties start end)
(secure-hash 'sha1 it)
(list start end it))
(list start end)))))
2021-02-04 03:28:21 +00:00
#+END_SRC
2021-02-08 18:52:04 +00:00
***** read-from :function:
2021-02-04 16:01:25 +00:00
#+BEGIN_SRC emacs-lisp
2021-02-08 05:52:58 +00:00
(defun chronometrist-read-from (position)
(chronometrist-sexp-in-file chronometrist-file
(goto-char
(if (number-or-marker-p position)
position
(funcall position)))
(ignore-errors (read (current-buffer)))))
2021-02-04 16:01:25 +00:00
#+END_SRC
2021-02-08 18:52:04 +00:00
***** file-change-type :function:
2021-02-08 05:52:58 +00:00
1. rest-start rest-end last-start last-end
2. :append - rest same, last same, new expr after last-end
3. :modify - rest same, last not same, no expr after last-end
4. :remove - rest same, last not same, no expr after last-start
5. nil - rest same, last same, no expr after last-end
6. t - rest changed
2021-02-04 16:01:25 +00:00
#+BEGIN_SRC emacs-lisp
2021-02-08 05:52:58 +00:00
(defun chronometrist-file-change-type (state)
"Determine the type of change made to `chronometrist-file'.
STATE must be a plist. (see `chronometrist--file-state')
Return
:append if a new s-expression was added to the end,
:modify if the last s-expression was modified,
:remove if the last s-expression was removed,
nil if the contents didn't change, and
t for any other change."
(-let* (((last-start last-end) (plist-get state :last))
((rest-start rest-end rest-hash) (plist-get state :rest))
;; Using a hash to determine if the last expression has
;; changed can cause issues - the expression may shrink, and
;; if we try to compute the hash of the old region again, we
;; will get an args-out-of-range error. A hash will also
;; result in false negatives for whitespace/indentation
;; differences.
(last-same-p (--> (hash-table-keys chronometrist-events) (last it) (car it)
(gethash it chronometrist-events) (last it) (car it)
(equal it (chronometrist-read-from last-start))))
(file-new-length (chronometrist-sexp-in-file chronometrist-file (point-max)))
(rest-same-p (unless (< file-new-length rest-end)
(equal rest-hash
(cl-third (chronometrist-file-hash rest-start rest-end t))))))
(cond ((not rest-same-p) t)
(last-same-p
(when (chronometrist-read-from last-end) :append))
((not (chronometrist-read-from last-start))
:remove)
((not (chronometrist-read-from
(lambda ()
(progn (goto-char last-start)
(forward-list)))))
:modify))))
2021-02-04 16:01:25 +00:00
#+END_SRC
2021-02-08 18:52:04 +00:00
***** task-list :function:
2021-02-04 16:01:25 +00:00
#+BEGIN_SRC emacs-lisp
2021-02-08 05:52:58 +00:00
(defun chronometrist-task-list ()
"Return a list of tasks from `chronometrist-file'."
(--> (chronometrist-loop-file for plist in chronometrist-file collect (plist-get plist :name))
(cl-remove-duplicates it :test #'equal)
(sort it #'string-lessp)))
2021-02-04 16:01:25 +00:00
#+END_SRC
2021-02-08 18:52:04 +00:00
***** add-to-task-list :function:
2021-02-04 16:01:25 +00:00
#+BEGIN_SRC emacs-lisp
2021-02-08 05:52:58 +00:00
(defun chronometrist-add-to-task-list (task)
(unless (cl-member task chronometrist-task-list :test #'equal)
(setq chronometrist-task-list
(sort (cons task chronometrist-task-list) #'string-lessp))))
2021-02-04 16:01:25 +00:00
#+END_SRC
2021-02-08 18:52:04 +00:00
***** remove-from-task-list :function:
2021-02-04 16:01:25 +00:00
#+BEGIN_SRC emacs-lisp
2021-02-08 05:52:58 +00:00
(defun chronometrist-remove-from-task-list (task)
(let ((count (cl-loop with count = 0
for intervals being the hash-values of chronometrist-events
do (cl-loop for interval in intervals
do (cl-incf count))
finally return count))
(position (cl-loop with count = 0
for intervals being the hash-values of chronometrist-events
when (cl-loop for interval in intervals
do (cl-incf count)
when (equal task (plist-get interval :name))
return t)
return count)))
(when (and position (= position count))
;; The only interval for TASK is the last expression
(setq chronometrist-task-list (remove task chronometrist-task-list)))))
2021-02-04 16:01:25 +00:00
#+END_SRC
2021-02-08 18:52:04 +00:00
***** refresh-file :function:
2021-02-04 16:01:25 +00:00
#+BEGIN_SRC emacs-lisp
2021-02-08 05:52:58 +00:00
(defun chronometrist-refresh-file (fs-event)
"Re-read `chronometrist-file' and refresh the `chronometrist' buffer.
Argument _FS-EVENT is ignored."
(run-hooks 'chronometrist-file-change-hook)
;; (message "chronometrist - file %s" fs-event)
;; `chronometrist-file-change-type' must be run /before/ we update `chronometrist--file-state'
;; (the latter represents the old state of the file, which
;; `chronometrist-file-change-type' compares with the new one)
(-let* (((descriptor action file ...) fs-event)
(change (when chronometrist--file-state
(chronometrist-file-change-type chronometrist--file-state)))
(reset-watch (or (eq action 'deleted) (eq action 'renamed))))
;; (message "chronometrist - file change type is %s" change)
(cond ((or reset-watch (not chronometrist--file-state) (eq change t))
(when reset-watch
(file-notify-rm-watch chronometrist--fs-watch)
(setq chronometrist--fs-watch nil chronometrist--file-state nil))
(chronometrist-events-populate)
(setq chronometrist-task-list (chronometrist-task-list)))
(chronometrist--file-state
(let ((task (plist-get (chronometrist-last) :name)))
(pcase change
(:append
(chronometrist-events-update (chronometrist-sexp-last))
(chronometrist-add-to-task-list task))
(:modify
(chronometrist-events-update (chronometrist-sexp-last) t)
(chronometrist-remove-from-task-list task)
(chronometrist-add-to-task-list task))
(:remove
(let* ((date (--> (hash-table-keys chronometrist-events)
(last it)
(car it)))
(old-task (--> (gethash date chronometrist-events)
(last it)
(car it)
(plist-get it :name))))
(chronometrist-remove-from-task-list old-task)
(--> (gethash date chronometrist-events)
(-drop-last 1 it)
(puthash date it chronometrist-events))))
((pred null) nil)))))
(setq chronometrist--file-state
(list :last (chronometrist-file-hash :before-last nil)
:rest (chronometrist-file-hash nil :before-last t)))
;; REVIEW - can we move most/all of this to the `chronometrist-file-change-hook'?
(chronometrist-refresh)))
2021-02-04 16:01:25 +00:00
#+END_SRC
2021-02-08 18:52:04 +00:00
***** query-stop :function:
2021-02-04 16:01:25 +00:00
#+BEGIN_SRC emacs-lisp
2021-02-08 05:52:58 +00:00
(defun chronometrist-query-stop ()
"Ask the user if they would like to clock out."
(let ((task (chronometrist-current-task)))
(and task
(yes-or-no-p (format "Stop tracking time for %s? " task))
(chronometrist-out))
t))
2021-02-04 16:01:25 +00:00
#+END_SRC
2021-02-08 18:52:04 +00:00
***** chronometrist-in :command:
2021-02-04 16:01:25 +00:00
#+BEGIN_SRC emacs-lisp
2021-02-08 05:52:58 +00:00
(defun chronometrist-in (task &optional _prefix)
"Clock in to TASK; record current time in `chronometrist-file'.
TASK is the name of the task, a string. PREFIX is ignored."
(interactive "P")
(let ((plist `(:name ,task :start ,(chronometrist-format-time-iso8601))))
(chronometrist-sexp-new plist)
(chronometrist-refresh)))
#+END_SRC
2021-02-08 18:52:04 +00:00
***** chronometrist-out :command:
2021-02-08 05:52:58 +00:00
#+BEGIN_SRC emacs-lisp
(defun chronometrist-out (&optional _prefix)
"Record current moment as stop time to last s-exp in `chronometrist-file'.
PREFIX is ignored."
(interactive "P")
(let ((plist (plist-put (chronometrist-last) :stop (chronometrist-format-time-iso8601))))
(chronometrist-sexp-replace-last plist)))
#+END_SRC
2021-02-08 18:52:04 +00:00
***** chronometrist-mode-hook :hook:normal:
2021-02-08 05:52:58 +00:00
#+BEGIN_SRC emacs-lisp
(defvar chronometrist-mode-hook nil
"Normal hook run at the very end of `chronometrist-mode'.")
#+END_SRC
2021-02-08 18:52:04 +00:00
***** list-format-transformers :extension:variable:
2021-02-08 05:52:58 +00:00
#+BEGIN_SRC emacs-lisp
(defvar chronometrist-list-format-transformers nil
"List of functions to transform `tabulated-list-format' (which see).
This is called with `chronometrist-run-transformers' in `chronometrist-mode', which see.
2021-02-04 16:01:25 +00:00
2021-02-08 05:52:58 +00:00
Extensions using `chronometrist-list-format-transformers' to
increase the number of columns will also need to modify the value
of `tabulated-list-entries' by using
`chronometrist-entry-transformers'.")
2021-02-04 16:01:25 +00:00
#+END_SRC
2021-02-08 18:52:04 +00:00
***** entry-transformers :extension:variable:
2021-02-04 16:01:25 +00:00
#+BEGIN_SRC emacs-lisp
2021-02-08 05:52:58 +00:00
(defvar chronometrist-entry-transformers nil
"List of functions to transform each entry of `tabulated-list-entries'.
This is called with `chronometrist-run-transformers' in `chronometrist-entries', which see.
2021-02-04 16:01:25 +00:00
2021-02-08 05:52:58 +00:00
Extensions using `chronometrist-entry-transformers' to increase
the number of columns will also need to modify the value of
`tabulated-list-format' by using
`chronometrist-list-format-transformers'.")
2021-02-04 16:01:25 +00:00
#+END_SRC
2021-02-08 18:52:04 +00:00
***** before-in-functions :hook:abnormal:
2021-02-04 16:01:25 +00:00
#+BEGIN_SRC emacs-lisp
2021-02-08 05:52:58 +00:00
(defvar chronometrist-before-in-functions nil
"Functions to run before a task is clocked in.
Each function in this hook must accept a single argument, which
is the name of the task to be clocked-in.
2021-02-04 16:01:25 +00:00
2021-02-08 05:52:58 +00:00
The commands `chronometrist-toggle-task-button',
`chronometrist-add-new-task-button', `chronometrist-toggle-task',
and `chronometrist-add-new-task' will run this hook.")
#+END_SRC
2021-02-08 18:52:04 +00:00
***** after-in-functions :hook:abnormal:
2021-02-08 05:52:58 +00:00
#+BEGIN_SRC emacs-lisp
(defvar chronometrist-after-in-functions nil
"Functions to run after a task is clocked in.
Each function in this hook must accept a single argument, which
is the name of the task to be clocked-in.
2021-02-04 16:01:25 +00:00
2021-02-08 05:52:58 +00:00
The commands `chronometrist-toggle-task-button',
`chronometrist-add-new-task-button', `chronometrist-toggle-task',
and `chronometrist-add-new-task' will run this hook.")
#+END_SRC
2021-02-08 18:52:04 +00:00
***** before-out-functions :hook:abnormal:
2021-02-08 05:52:58 +00:00
#+BEGIN_SRC emacs-lisp
(defvar chronometrist-before-out-functions nil
"Functions to run before a task is clocked out.
Each function in this hook must accept a single argument, which
is the name of the task to be clocked out of.
2021-02-04 16:01:25 +00:00
2021-02-08 05:52:58 +00:00
The task will be stopped only if all functions in this list
return a non-nil value.")
2021-02-04 16:01:25 +00:00
#+END_SRC
2021-02-08 18:52:04 +00:00
***** after-out-functions :hook:abnormal:
2021-02-07 16:21:38 +00:00
#+BEGIN_SRC emacs-lisp
2021-02-08 05:52:58 +00:00
(defvar chronometrist-after-out-functions nil
"Functions to run after a task is clocked out.
Each function in this hook must accept a single argument, which
is the name of the task to be clocked out of.")
2021-02-07 16:21:38 +00:00
#+END_SRC
2021-02-08 18:52:04 +00:00
***** file-change-hook :hook:normal:
2021-02-07 16:21:38 +00:00
#+BEGIN_SRC emacs-lisp
2021-02-08 05:52:58 +00:00
(defvar chronometrist-file-change-hook nil
"Functions to be run after `chronometrist-file' is changed on disk.")
2021-02-07 16:21:38 +00:00
#+END_SRC
2021-02-08 18:52:04 +00:00
***** run-functions-and-clock-in :function:
2021-02-07 16:21:38 +00:00
#+BEGIN_SRC emacs-lisp
2021-02-08 05:52:58 +00:00
(defun chronometrist-run-functions-and-clock-in (task)
"Run hooks and clock in to TASK."
(run-hook-with-args 'chronometrist-before-in-functions task)
(chronometrist-in task)
(run-hook-with-args 'chronometrist-after-in-functions task))
2021-02-07 16:21:38 +00:00
#+END_SRC
2021-02-08 18:52:04 +00:00
***** run-functions-and-clock-out :function:
2021-02-07 16:21:38 +00:00
#+BEGIN_SRC emacs-lisp
2021-02-08 05:52:58 +00:00
(defun chronometrist-run-functions-and-clock-out (task)
"Run hooks and clock out of TASK."
(when (run-hook-with-args-until-failure 'chronometrist-before-out-functions task)
(chronometrist-out)
(run-hook-with-args 'chronometrist-after-out-functions task)))
2021-02-07 16:21:38 +00:00
#+END_SRC
2021-02-08 18:52:04 +00:00
***** chronometrist-mode-map :keymap:
2021-02-07 16:21:38 +00:00
#+BEGIN_SRC emacs-lisp
2021-02-08 05:52:58 +00:00
(defvar chronometrist-mode-map
(let ((map (make-sparse-keymap)))
(define-key map (kbd "RET") #'chronometrist-toggle-task)
(define-key map (kbd "M-RET") #'chronometrist-toggle-task-no-hooks)
(define-key map (kbd "l") #'chronometrist-open-log)
(define-key map (kbd "r") #'chronometrist-report)
(define-key map [mouse-1] #'chronometrist-toggle-task)
(define-key map [mouse-3] #'chronometrist-toggle-task-no-hooks)
(define-key map (kbd "a") #'chronometrist-add-new-task)
map)
"Keymap used by `chronometrist-mode'.")
2021-02-07 16:31:10 +00:00
#+END_SRC
2021-02-08 18:52:04 +00:00
***** chronometrist-mode :major:mode:
2021-02-07 16:31:10 +00:00
#+BEGIN_SRC emacs-lisp
2021-02-08 05:52:58 +00:00
(define-derived-mode chronometrist-mode tabulated-list-mode "Chronometrist"
"Major mode for `chronometrist'."
(make-local-variable 'tabulated-list-format)
(--> [("#" 3 t) ("Task" 25 t) ("Time" 10 t) ("Active" 10 t)]
(chronometrist-run-transformers chronometrist-list-format-transformers it)
(setq tabulated-list-format it))
(make-local-variable 'tabulated-list-entries)
(setq tabulated-list-entries 'chronometrist-entries)
(make-local-variable 'tabulated-list-sort-key)
(setq tabulated-list-sort-key '("Task" . nil))
(tabulated-list-init-header)
(setq revert-buffer-function #'chronometrist-refresh)
(run-hooks 'chronometrist-mode-hook))
2021-02-07 16:31:10 +00:00
#+END_SRC
2021-02-08 18:52:04 +00:00
***** toggle-task-button :function:
2021-02-07 16:31:10 +00:00
#+BEGIN_SRC emacs-lisp
2021-02-08 05:52:58 +00:00
(defun chronometrist-toggle-task-button (_button)
"Button action to toggle a task.
2021-02-07 16:31:10 +00:00
2021-02-08 05:52:58 +00:00
Argument _BUTTON is for the purpose of using this as a button
action, and is ignored."
(when current-prefix-arg
(chronometrist-goto-nth-task (prefix-numeric-value current-prefix-arg)))
(let ((current (chronometrist-current-task))
(at-point (chronometrist-task-at-point)))
;; clocked in + point on current = clock out
;; clocked in + point on some other task = clock out, clock in to task
;; clocked out = clock in
(when current
(chronometrist-run-functions-and-clock-out current))
(unless (equal at-point current)
(chronometrist-run-functions-and-clock-in at-point))))
2021-02-07 16:31:10 +00:00
#+END_SRC
2021-02-08 18:52:04 +00:00
***** add-new-task-button :function:
2021-02-07 16:31:10 +00:00
#+BEGIN_SRC emacs-lisp
2021-02-08 05:52:58 +00:00
(defun chronometrist-add-new-task-button (_button)
"Button action to add a new task.
Argument _BUTTON is for the purpose of using this as a button
action, and is ignored."
(let ((current (chronometrist-current-task)))
(when current
(chronometrist-run-functions-and-clock-out current))
(let ((task (read-from-minibuffer "New task name: " nil nil nil nil nil t)))
(chronometrist-run-functions-and-clock-in task))))
2021-02-07 16:31:10 +00:00
#+END_SRC
2021-02-08 18:52:04 +00:00
***** toggle-task :command:
2021-02-07 16:31:10 +00:00
#+BEGIN_SRC emacs-lisp
2021-02-08 05:52:58 +00:00
;; TODO - if clocked in and point not on a task, just clock out
(defun chronometrist-toggle-task (&optional prefix inhibit-hooks)
"Start or stop the task at point.
If there is no task at point, do nothing.
With numeric prefix argument PREFIX, toggle the Nth task in
the buffer. If there is no corresponding task, do nothing.
If INHIBIT-HOOKS is non-nil, the hooks
`chronometrist-before-in-functions',
`chronometrist-after-in-functions',
`chronometrist-before-out-functions', and
`chronometrist-after-out-functions' will not be run."
(interactive "P")
(let* ((empty-file (chronometrist-common-file-empty-p chronometrist-file))
(nth (when prefix (chronometrist-goto-nth-task prefix)))
(at-point (chronometrist-task-at-point))
(target (or nth at-point))
(current (chronometrist-current-task))
(in-function (if inhibit-hooks
#'chronometrist-in
#'chronometrist-run-functions-and-clock-in))
(out-function (if inhibit-hooks
#'chronometrist-out
#'chronometrist-run-functions-and-clock-out)))
;; do not run hooks - chronometrist-add-new-task will do it
(cond (empty-file (chronometrist-add-new-task))
;; What should we do if the user provides an invalid
;; argument? Currently - nothing.
((and prefix (not nth)))
(target ;; do nothing if there's no task at point
;; clocked in + target is current = clock out
;; clocked in + target is some other task = clock out, clock in to task
;; clocked out = clock in
(when current
(funcall out-function current))
(unless (equal target current)
(funcall in-function target))))))
2021-02-07 16:31:10 +00:00
#+END_SRC
2021-02-08 18:52:04 +00:00
***** toggle-task-no-hooks :command:
2021-02-07 16:31:10 +00:00
#+BEGIN_SRC emacs-lisp
2021-02-08 05:52:58 +00:00
(defun chronometrist-toggle-task-no-hooks (&optional prefix)
"Like `chronometrist-toggle-task', but don't run hooks.
2021-02-07 16:31:10 +00:00
2021-02-08 05:52:58 +00:00
With numeric prefix argument PREFIX, toggle the Nth task. If there
is no corresponding task, do nothing."
(interactive "P")
(chronometrist-toggle-task prefix t))
2021-02-07 16:31:10 +00:00
#+END_SRC
2021-02-08 18:52:04 +00:00
***** add-new-task :command:
2021-02-07 15:55:04 +00:00
#+BEGIN_SRC emacs-lisp
2021-02-08 05:52:58 +00:00
(defun chronometrist-add-new-task ()
"Add a new task."
(interactive)
(chronometrist-add-new-task-button nil))
2021-02-07 15:55:04 +00:00
#+END_SRC
2021-02-08 18:52:04 +00:00
***** chronometrist :command:
2021-02-07 15:55:04 +00:00
#+BEGIN_SRC emacs-lisp
2021-02-08 05:52:58 +00:00
;;;###autoload
(defun chronometrist (&optional arg)
"Display the user's tasks and the time spent on them today.
2021-02-07 15:55:04 +00:00
2021-02-08 05:52:58 +00:00
Based on their timelog file `chronometrist-file'. This is the
'listing command' for `chronometrist-mode'.
2021-02-07 15:55:04 +00:00
2021-02-08 05:52:58 +00:00
If numeric argument ARG is 1, run `chronometrist-report'.
If numeric argument ARG is 2, run `chronometrist-statistics'."
(interactive "P")
(chronometrist-migrate-check)
(let ((buffer (get-buffer-create chronometrist-buffer-name))
(w (save-excursion
(get-buffer-window chronometrist-buffer-name t))))
(cond
(arg (cl-case arg
(1 (chronometrist-report))
(2 (chronometrist-statistics))))
(w (with-current-buffer buffer
(setq chronometrist--point (point))
(kill-buffer chronometrist-buffer-name)))
(t (with-current-buffer buffer
(cond ((or (not (file-exists-p chronometrist-file))
(chronometrist-common-file-empty-p chronometrist-file))
;; first run
(chronometrist-common-create-file)
(let ((inhibit-read-only t))
(chronometrist-common-clear-buffer buffer)
(insert "Welcome to Chronometrist! Hit RET to ")
(insert-text-button "start a new task."
'action #'chronometrist-add-new-task-button
'follow-link t)
(chronometrist-mode)
(switch-to-buffer buffer)))
(t (chronometrist-mode)
(when chronometrist-hide-cursor
(make-local-variable 'cursor-type)
(setq cursor-type nil)
(hl-line-mode))
(switch-to-buffer buffer)
(if (hash-table-keys chronometrist-events)
(chronometrist-refresh)
(chronometrist-refresh-file nil))
(if chronometrist--point
(goto-char chronometrist--point)
(chronometrist-goto-last-task))))
(unless chronometrist--fs-watch
(setq chronometrist--fs-watch
(file-notify-add-watch chronometrist-file '(change) #'chronometrist-refresh-file))))))))
2021-02-07 15:55:04 +00:00
#+END_SRC
2021-02-08 18:52:04 +00:00
**** Report
***** TODO [0%]
2021-02-08 06:38:27 +00:00
1. [ ] preserve point when clicking buttons
2021-02-08 18:52:04 +00:00
***** report :custom:group:
2021-02-08 06:38:27 +00:00
#+BEGIN_SRC emacs-lisp
(defgroup chronometrist-report nil
"Weekly report for the `chronometrist' time tracker."
:group 'chronometrist)
#+END_SRC
2021-02-08 18:52:04 +00:00
***** buffer-name :custom:variable:
2021-02-08 06:38:27 +00:00
#+BEGIN_SRC emacs-lisp
(defcustom chronometrist-report-buffer-name "*Chronometrist-Report* "
"The name of the buffer created by `chronometrist-report'."
:type 'string)
#+END_SRC
2021-02-08 18:52:04 +00:00
***** week-start-day :custom:variable:
2021-02-08 06:38:27 +00:00
#+BEGIN_SRC emacs-lisp
(defcustom chronometrist-report-week-start-day "Sunday"
"The day used for start of week by `chronometrist-report'."
:type 'string)
#+END_SRC
2021-02-08 18:52:04 +00:00
***** weekday-number-alist :custom:variable:
2021-02-08 06:38:27 +00:00
#+BEGIN_SRC emacs-lisp
(defcustom chronometrist-report-weekday-number-alist
'(("Sunday" . 0)
("Monday" . 1)
("Tuesday" . 2)
("Wednesday" . 3)
("Thursday" . 4)
("Friday" . 5)
("Saturday" . 6))
"Alist in the form (\"NAME\" . NUMBER), where \"NAME\" is the name of a weekday and NUMBER its associated number."
:type 'alist)
#+END_SRC
2021-02-08 18:52:04 +00:00
***** ui-date :internal:variable:
2021-02-08 06:38:27 +00:00
#+BEGIN_SRC emacs-lisp
(defvar chronometrist-report--ui-date nil
"The first date of the week displayed by `chronometrist-report'.
A value of nil means the current week. Otherwise, it must be a
date in the form \"YYYY-MM-DD\".")
#+END_SRC
2021-02-08 18:52:04 +00:00
***** ui-week-dates :internal:variable:
2021-02-08 06:38:27 +00:00
#+BEGIN_SRC emacs-lisp
(defvar chronometrist-report--ui-week-dates nil
"List of dates currently displayed by `chronometrist-report'.
Each date is a list containing calendrical information (see (info \"(elisp)Time Conversion\"))")
#+END_SRC
2021-02-08 18:52:04 +00:00
***** point :internal:variable:
2021-02-08 06:38:27 +00:00
#+BEGIN_SRC emacs-lisp
(defvar chronometrist-report--point nil)
#+END_SRC
2021-02-08 18:52:04 +00:00
***** date :function:
2021-02-08 06:38:27 +00:00
#+BEGIN_SRC emacs-lisp
(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)))
#+END_SRC
2021-02-08 18:52:04 +00:00
***** date->dates-in-week :function:
2021-02-08 06:38:27 +00:00
#+BEGIN_SRC emacs-lisp
(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)))
#+END_SRC
2021-02-08 18:52:04 +00:00
***** date->week-dates :function:
2021-02-08 06:38:27 +00:00
#+BEGIN_SRC emacs-lisp
(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)))
#+END_SRC
2021-02-08 18:52:04 +00:00
***** entries :function:
2021-02-08 06:38:27 +00:00
#+BEGIN_SRC emacs-lisp
(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))))))
#+END_SRC
2021-02-08 18:52:04 +00:00
***** print-keybind :function:
2021-02-08 06:38:27 +00:00
#+BEGIN_SRC emacs-lisp
(defun chronometrist-report-print-keybind (command &optional description firstonly)
"Insert one or more keybindings for COMMAND into the current buffer.
DESCRIPTION is a description of the command.
If FIRSTONLY is non-nil, insert only the first keybinding found."
(insert "\n "
(chronometrist-format-keybinds command firstonly)
" - "
(if description description "")))
#+END_SRC
2021-02-08 18:52:04 +00:00
***** print-non-tabular :function:
2021-02-08 06:38:27 +00:00
#+BEGIN_SRC emacs-lisp
(defun chronometrist-report-print-non-tabular ()
"Print the non-tabular part of the buffer in `chronometrist-report'."
(let ((inhibit-read-only t)
(w "\n ")
(total-time-daily (->> 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)))
#+END_SRC
2021-02-08 18:52:04 +00:00
***** REVIEW refresh :function:
2021-02-08 06:38:27 +00:00
Merge this into `chronometrist-refresh-file', while moving the -refresh call to the call site?
#+BEGIN_SRC emacs-lisp
(defun chronometrist-report-refresh (&optional _ignore-auto _noconfirm)
"Refresh the `chronometrist-report' buffer, without re-reading `chronometrist-file'."
(let* ((w (get-buffer-window chronometrist-report-buffer-name t))
(p (point)))
(with-current-buffer chronometrist-report-buffer-name
(tabulated-list-print t nil)
(chronometrist-report-print-non-tabular)
(chronometrist-maybe-start-timer)
(set-window-point w p))))
#+END_SRC
2021-02-08 18:52:04 +00:00
***** refresh-file :function:
2021-02-08 06:38:27 +00:00
#+BEGIN_SRC emacs-lisp
(defun chronometrist-report-refresh-file (_fs-event)
"Re-read `chronometrist-file' and refresh the `chronometrist-report' buffer.
Argument _FS-EVENT is ignored."
(chronometrist-events-populate)
;; (chronometrist-events-clean)
(chronometrist-report-refresh))
#+END_SRC
2021-02-08 18:52:04 +00:00
***** report-mode-map :keymap:
2021-02-08 06:38:27 +00:00
#+BEGIN_SRC emacs-lisp
(defvar chronometrist-report-mode-map
(let ((map (make-sparse-keymap)))
(define-key map (kbd "l") #'chronometrist-open-log)
(define-key map (kbd "b") #'chronometrist-report-previous-week)
(define-key map (kbd "f") #'chronometrist-report-next-week)
;; Works when number of tasks < screen length; after that, you
;; probably expect mousewheel to scroll up/down, and
;; alt-mousewheel or something for next/previous week. For now,
;; I'm assuming most people won't have all that many tasks - I've
;; been using it for ~2 months and have 18 tasks, which are
;; still just half the screen on my 15" laptop. Let's see what
;; people say.
(define-key map [mouse-4] #'chronometrist-report-next-week)
(define-key map [mouse-5] #'chronometrist-report-previous-week)
map)
"Keymap used by `chronometrist-report-mode'.")
#+END_SRC
2021-02-08 18:52:04 +00:00
***** report-mode :major:mode:
2021-02-08 06:38:27 +00:00
#+BEGIN_SRC emacs-lisp
(define-derived-mode chronometrist-report-mode tabulated-list-mode "Chronometrist-Report"
"Major mode for `chronometrist-report'."
(make-local-variable 'tabulated-list-format)
(setq tabulated-list-format [("Task" 25 t)
("Sunday" 10 t)
("Monday" 10 t)
("Tuesday" 10 t)
("Wednesday" 10 t)
("Thursday" 10 t)
("Friday" 10 t)
("Saturday" 10 t :pad-right 5)
("Total" 12 t)])
(make-local-variable 'tabulated-list-entries)
(setq tabulated-list-entries 'chronometrist-report-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))))
#+END_SRC
2021-02-08 18:52:04 +00:00
***** chronometrist-report :command:
2021-02-08 06:38:27 +00:00
#+BEGIN_SRC emacs-lisp
;;;###autoload
(defun chronometrist-report (&optional keep-date)
"Display a weekly report of the data in `chronometrist-file'.
This is the 'listing command' for ‘ ’
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)))))))
#+END_SRC
2021-02-08 18:52:04 +00:00
***** report-previous-week :command:
2021-02-08 06:38:27 +00:00
#+BEGIN_SRC emacs-lisp
(defun chronometrist-report-previous-week (arg)
"View the previous week's report.
With prefix argument ARG, move back ARG weeks."
(interactive "P")
(let ((arg (if (and arg (numberp arg))
(abs arg)
1)))
(setq chronometrist-report--ui-date
(ts-adjust 'day (- (* arg 7))
(if chronometrist-report--ui-date
chronometrist-report--ui-date
(ts-now)))))
(setq chronometrist-report--point (point))
(kill-buffer)
(chronometrist-report t))
#+END_SRC
2021-02-08 18:52:04 +00:00
***** report-next-week :command:
2021-02-08 06:38:27 +00:00
#+BEGIN_SRC emacs-lisp
(defun chronometrist-report-next-week (arg)
"View the next week's report.
With prefix argument ARG, move forward ARG weeks."
(interactive "P")
(let ((arg (if (and arg (numberp arg))
(abs arg)
1)))
(setq chronometrist-report--ui-date
(ts-adjust 'day (* arg 7)
(if chronometrist-report--ui-date
chronometrist-report--ui-date
(ts-now))))
(setq chronometrist-report--point (point))
(kill-buffer)
(chronometrist-report t)))
#+END_SRC
2021-02-08 18:52:04 +00:00
**** Statistics
***** statistics :custom:group:
2021-02-08 06:48:27 +00:00
#+BEGIN_SRC emacs-lisp
(defgroup chronometrist-statistics nil
"Statistics buffer for the `chronometrist' time tracker."
:group 'chronometrist)
#+END_SRC
2021-02-08 18:52:04 +00:00
***** buffer-name :custom:variable:
2021-02-08 06:48:27 +00:00
#+BEGIN_SRC emacs-lisp
(defcustom chronometrist-statistics-buffer-name "*Chronometrist-Statistics* "
"The name of the buffer created by `chronometrist-statistics'."
:type 'string)
#+END_SRC
2021-02-08 18:52:04 +00:00
***** ui-state :internal:variable:
2021-02-08 06:48:27 +00:00
#+BEGIN_SRC emacs-lisp
(defvar chronometrist-statistics--ui-state nil
"Stores the display state for `chronometrist-statistics'.
This must be a plist in the form (:MODE :START :END).
:MODE is either 'week, 'month, 'year, 'full, or 'custom.
'week, 'month, and 'year mean display statistics
weekly/monthly/yearly respectively.
'full means display statistics from the beginning to the end of
the `chronometrist-file'.
'custom means display statistics from an arbitrary date range.
:START and :END are the start and end of the date range to be
displayed. They must be ts structs (see `ts.el').")
#+END_SRC
2021-02-08 18:52:04 +00:00
***** point :internal:variable:
2021-02-08 06:48:27 +00:00
#+BEGIN_SRC emacs-lisp
(defvar chronometrist-statistics--point nil)
#+END_SRC
2021-02-08 18:52:04 +00:00
***** mode-map :keymap:
2021-02-08 06:48:27 +00:00
#+BEGIN_SRC emacs-lisp
(defvar chronometrist-statistics-mode-map)
#+END_SRC
2021-02-08 18:52:04 +00:00
***** count-average-time-spent :function:
2021-02-08 06:48:27 +00:00
#+BEGIN_SRC emacs-lisp
(cl-defun chronometrist-statistics-count-average-time-spent (task &optional (table chronometrist-events))
"Return the average time the user has spent on TASK from TABLE.
TABLE should be a hash table - if not supplied,
`chronometrist-events' is used."
;; (cl-loop
;; 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)))
#+END_SRC
2021-02-08 18:52:04 +00:00
***** entries-internal :function:
2021-02-08 06:48:27 +00:00
#+BEGIN_SRC emacs-lisp
(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))
#+END_SRC
2021-02-08 18:52:04 +00:00
***** entries :function:
2021-02-08 06:48:27 +00:00
#+BEGIN_SRC emacs-lisp
(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)))))
#+END_SRC
2021-02-08 18:52:04 +00:00
***** print-keybind :function:
2021-02-08 06:48:27 +00:00
#+BEGIN_SRC emacs-lisp
(defun chronometrist-statistics-print-keybind (command &optional description firstonly)
"Insert the keybindings for COMMAND.
If DESCRIPTION is non-nil, insert that too.
If FIRSTONLY is non-nil, return only the first keybinding found."
(insert "\n "
(chronometrist-format-keybinds command
chronometrist-statistics-mode-map
firstonly)
" - "
(if description description "")))
#+END_SRC
2021-02-08 18:52:04 +00:00
***** print-non-tabular :function:
2021-02-08 06:48:27 +00:00
#+BEGIN_SRC emacs-lisp
(defun chronometrist-statistics-print-non-tabular ()
"Print the non-tabular part of the buffer in `chronometrist-statistics'."
(let ((w "\n ")
(inhibit-read-only t))
(goto-char (point-max))
(insert w)
(insert-text-button (cl-case (plist-get chronometrist-statistics--ui-state :mode)
('week "Weekly view"))
;; 'action #'chronometrist-report-previous-week ;; TODO - make interactive function to accept new mode from user
'follow-link t)
(insert ", from")
(insert
(format " %s to %s\n"
(ts-format "%F" (plist-get chronometrist-statistics--ui-state :start))
(ts-format "%F" (plist-get chronometrist-statistics--ui-state :end))))))
#+END_SRC
2021-02-08 18:52:04 +00:00
***** refresh :function:
2021-02-08 06:48:27 +00:00
#+BEGIN_SRC emacs-lisp
(defun chronometrist-statistics-refresh (&optional _ignore-auto _noconfirm)
"Refresh the `chronometrist-statistics' buffer.
This does not re-read `chronometrist-file'.
The optional arguments _IGNORE-AUTO and _NOCONFIRM are ignored,
and are present solely for the sake of using this function as a
value of `revert-buffer-function'."
(let* ((w (get-buffer-window chronometrist-statistics-buffer-name t))
(p (point)))
(with-current-buffer chronometrist-statistics-buffer-name
(tabulated-list-print t nil)
(chronometrist-statistics-print-non-tabular)
(chronometrist-maybe-start-timer)
(set-window-point w p))))
#+END_SRC
2021-02-08 18:52:04 +00:00
***** mode-map :keymap:
2021-02-08 06:48:27 +00:00
#+BEGIN_SRC emacs-lisp
(defvar chronometrist-statistics-mode-map
(let ((map (make-sparse-keymap)))
(define-key map (kbd "l") #'chronometrist-open-log)
(define-key map (kbd "b") #'chronometrist-statistics-previous-range)
(define-key map (kbd "f") #'chronometrist-statistics-next-range)
map)
"Keymap used by `chronometrist-statistics-mode'.")
#+END_SRC
2021-02-08 18:52:04 +00:00
***** statistics-mode :major:mode:
2021-02-08 06:48:27 +00:00
#+BEGIN_SRC emacs-lisp
(define-derived-mode chronometrist-statistics-mode tabulated-list-mode "Chronometrist-Statistics"
"Major mode for `chronometrist-statistics'."
(make-local-variable 'tabulated-list-format)
(setq tabulated-list-format
[("Task" 25 t)
("Active days" 12 t)
("%% of days active" 17 t)
("Average time" 12 t)
;; ("Current streak" 10 t)
;; ("Last streak" 10 t)
;; ("Longest streak" 10 t)
])
(make-local-variable 'tabulated-list-entries)
(setq tabulated-list-entries 'chronometrist-statistics-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))))
#+END_SRC
2021-02-08 18:52:04 +00:00
***** chronometrist-statistics :command:
2021-02-08 06:48:27 +00:00
#+BEGIN_SRC emacs-lisp
;;;###autoload
(defun chronometrist-statistics (&optional preserve-state)
"Display statistics for data in `chronometrist-file'.
This is the 'listing command' for `chronometrist-statistics-mode'.
If a buffer called `chronometrist-statistics-buffer-name' already
exists and is visible, kill the buffer.
If PRESERVE-STATE is nil (the default when not supplied), display
data from the current week. Otherwise, display data from the week
specified by `chronometrist-statistics--ui-state'."
(interactive)
(chronometrist-migrate-check)
(let* ((buffer (get-buffer-create chronometrist-statistics-buffer-name))
(today (chronometrist-date))
(week-start (chronometrist-previous-week-start today))
(week-end (ts-adjust 'day 6 week-start)))
(with-current-buffer buffer
(cond ((get-buffer-window chronometrist-statistics-buffer-name)
(kill-buffer buffer))
(t ;; (delete-other-windows)
(unless preserve-state
(setq chronometrist-statistics--ui-state `(:mode week
:start ,week-start
:end ,week-end)))
(chronometrist-common-create-file)
(chronometrist-statistics-mode)
(switch-to-buffer buffer)
(chronometrist-statistics-refresh))))))
#+END_SRC
2021-02-08 18:52:04 +00:00
***** previous-range :command:
2021-02-08 06:48:27 +00:00
#+BEGIN_SRC emacs-lisp
(defun chronometrist-statistics-previous-range (arg)
"View the statistics in the previous time range.
If ARG is a numeric argument, go back that many times."
(interactive "P")
(let* ((arg (if (and arg (numberp arg))
(abs arg)
1))
(start (plist-get chronometrist-statistics--ui-state :start)))
(cl-case (plist-get chronometrist-statistics--ui-state :mode)
('week
(let* ((new-start (ts-adjust 'day (- (* arg 7)) start))
(new-end (ts-adjust 'day +6 new-start)))
(plist-put chronometrist-statistics--ui-state :start new-start)
(plist-put chronometrist-statistics--ui-state :end new-end))))
(setq chronometrist-statistics--point (point))
(kill-buffer)
(chronometrist-statistics t)))
#+END_SRC
2021-02-08 18:52:04 +00:00
***** next-range :command:
2021-02-08 06:48:27 +00:00
#+BEGIN_SRC emacs-lisp
(defun chronometrist-statistics-next-range (arg)
"View the statistics in the next time range.
If ARG is a numeric argument, go forward that many times."
(interactive "P")
(let* ((arg (if (and arg (numberp arg))
(abs arg)
1))
(start (plist-get chronometrist-statistics--ui-state :start)))
(cl-case (plist-get chronometrist-statistics--ui-state :mode)
('week
(let* ((new-start (ts-adjust 'day (* arg 7) start))
(new-end (ts-adjust 'day 6 new-start)))
(plist-put chronometrist-statistics--ui-state :start new-start)
(plist-put chronometrist-statistics--ui-state :end new-end))))
(setq chronometrist-statistics--point (point))
(kill-buffer)
(chronometrist-statistics t)))
#+END_SRC
2021-02-04 10:33:00 +00:00
** Provide
2021-02-04 03:28:21 +00:00
#+BEGIN_SRC emacs-lisp
2019-11-17 13:16:34 +00:00
(provide 'chronometrist)
2021-02-04 03:28:21 +00:00
#+END_SRC
2021-02-04 03:28:52 +00:00
# Local Variables:
# eval: (visual-fill-column-mode -1)
2021-02-05 08:22:43 +00:00
# eval: (nameless-mode)
2021-02-08 18:51:27 +00:00
# eval: (progn (make-local-variable 'after-save-hook) (add-hook 'after-save-hook (lambda () (start-process-shell-command "chronometrist-sed-tangle" "chronometrist-sed-tangle" "sed -n -e '/#+BEGIN_SRC emacs-lisp$/,/#+END_SRC$/{//!p;};/#+END_SRC/i\\ ' chronometrist.org | sed -E 's/^ +$//' > chronometrist.el"))))
2021-02-04 03:28:52 +00:00
# End:
