2020-02-03 06:52:27 +00:00
;;; chronometrist.el --- A time tracker with a nice interface -*- lexical-binding: t; -*-
2019-07-29 10:59:17 +00:00
2019-11-05 01:41:10 +00:00
;; Author: contrapunctus <xmpp:contrapunctus@jabber.fr>
2019-11-21 09:32:16 +00:00
;; Maintainer: contrapunctus <xmpp:contrapunctus@jabber.fr>
2019-11-05 01:41:10 +00:00
;; Keywords: calendar
2020-08-11 19:01:53 +00:00
;; Homepage: https://github.com/contrapunctus-1/chronometrist
2020-09-06 08:43:35 +00:00
;; Package-Requires: ((emacs "25.1")
;; (dash "2.16.0")
;; (seq "2.20")
;; (s "1.12.0")
;; (ts "0.2")
2021-01-04 03:25:52 +00:00
;; (anaphora "1.0.4"))
2021-01-27 15:59:04 +00:00
;; Version: 0.6.4
2019-11-05 01:41:10 +00:00
2019-04-17 18:21:01 +00:00
( require 'filenotify )
2019-11-22 04:25:52 +00:00
( require 'cl-lib )
2019-11-21 06:27:54 +00:00
( require 'subr-x )
2018-11-02 01:59:24 +00:00
( require 'chronometrist-common )
2020-05-14 00:56:19 +00:00
( require 'chronometrist-key-values )
2019-09-08 18:22:52 +00:00
( require 'chronometrist-queries )
2019-10-25 07:47:27 +00:00
( require 'chronometrist-migrate )
2020-05-15 09:44:22 +00:00
( require 'chronometrist-sexp )
2018-08-27 07:56:04 +00:00
2020-02-23 19:57:22 +00:00
;; This is free and unencumbered software released into the public domain.
;;
;; Anyone is free to copy, modify, publish, use, compile, sell, or
;; distribute this software, either in source code form or as a compiled
;; binary, for any purpose, commercial or non-commercial, and by any
;; means.
;;
;; For more information, please refer to <https://unlicense.org>
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
2018-09-11 12:28:25 +00:00
2019-07-29 10:59:17 +00:00
;;; Code:
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 ) )
2020-05-16 03:05:54 +00:00
( autoload 'chronometrist-maybe-start-timer " chronometrist-timer " nil t )
( autoload 'chronometrist-report " chronometrist-report " nil t )
( autoload 'chronometrist-statistics " chronometrist-statistics " nil t )
2020-07-08 08:52:54 +00:00
;; ## VARIABLES ##
2020-11-18 08:50:06 +00:00
( defgroup chronometrist nil
" A time tracker with a nice UI. "
:group 'applications )
( 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 )
( defcustom chronometrist-buffer-name " *Chronometrist* "
" The name of the buffer created by `chronometrist' . "
:type 'string )
( defcustom chronometrist-hide-cursor nil
" If non-nil, hide the cursor and only highlight the current line in the `chronometrist' buffer. "
:type 'boolean )
( 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 )
( 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 ) )
( defcustom chronometrist-day-start-time " 00:00:00 "
" The time at which a day is considered to start, in \" HH:MM:SS \" .
The default is midnight, i.e. \"00:00:00\". "
:type 'string )
2018-10-03 19:23:37 +00:00
( defvar chronometrist--point nil )
2018-09-01 12:31:25 +00:00
;; ## FUNCTIONS ##
2020-05-15 09:44:22 +00:00
( defun chronometrist-open-log ( &optional _button )
" Open `chronometrist-file' in another window.
Argument _BUTTON is for the purpose of using this command as a
button action. "
( interactive )
( chronometrist-sexp-open-log ) )
( defun chronometrist-common-create-file ( )
" Create `chronometrist-file' if it doesn't already exist. "
( chronometrist-sexp-create-file ) )
2019-09-07 04:13:03 +00:00
( defun chronometrist-task-active? ( task )
" Return t if TASK is currently clocked in, else nil. "
( equal ( chronometrist-current-task ) task ) )
2018-08-27 07:56:04 +00:00
2019-11-28 09:21:04 +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-01-04 03:14:48 +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 ) )
2018-09-18 21:21:29 +00:00
( defun chronometrist-entries ( )
2019-08-06 11:22:35 +00:00
" Create entries to be displayed in the buffer created by `chronometrist' , in the format specified by `tabulated-list-entries' . "
2019-09-05 18:57:48 +00:00
;; 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.
2019-08-06 11:22:35 +00:00
;; (chronometrist-events-populate)
;; (chronometrist-events-clean)
2020-09-06 08:35:24 +00:00
( ->> ( -sort #' string-lessp chronometrist-task-list )
2018-09-23 14:36:47 +00:00
( --map-indexed
2020-04-14 08:53:57 +00:00
( let* ( ( task it )
( index ( number-to-string ( 1+ it-index ) ) )
2020-09-02 13:54:13 +00:00
( task-button ` ( , task action chronometrist-toggle-task-button follow-link t ) )
2020-05-17 22:31:18 +00:00
( task-time ( chronometrist-format-time ( chronometrist-task-time-one-day task ) ) )
2020-09-07 03:07:33 +00:00
( indicator ( if ( chronometrist-task-active? task ) ( chronometrist-activity-indicator ) " " ) ) )
( --> ( vector index task-button task-time indicator )
( list task it )
2021-01-04 03:14:48 +00:00
( chronometrist-run-transformers chronometrist-entry-transformers it ) ) ) ) ) )
2018-09-11 12:27:34 +00:00
2019-11-29 04:41:14 +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. "
2018-09-02 10:55:25 +00:00
( save-excursion
( beginning-of-line )
2020-12-22 14:36:20 +00:00
( when ( re-search-forward " [0-9]+ + " nil t )
( get-text-property ( point ) 'tabulated-list-id ) ) ) )
2018-09-02 05:45:46 +00:00
2019-11-29 04:41:14 +00:00
( defun chronometrist-goto-last-task ( )
" In the `chronometrist' buffer, move point to the line containing the last active task. "
2018-09-02 11:07:26 +00:00
( goto-char ( point-min ) )
2020-05-14 10:33:46 +00:00
( re-search-forward ( plist-get ( chronometrist-last ) :name ) nil t )
2018-09-02 11:07:26 +00:00
( beginning-of-line ) )
2018-09-28 07:03:52 +00:00
( defun chronometrist-print-keybind ( command &optional description firstonly )
2019-08-06 11:36:38 +00:00
" Insert the keybindings for COMMAND.
If DESCRIPTION is non-nil, insert that too.
If FIRSTONLY is non-nil, return only the first keybinding found. "
2018-09-28 07:03:52 +00:00
( insert
2020-09-02 13:54:13 +00:00
( format " \n % 18s - %s "
( chronometrist-format-keybinds command chronometrist-mode-map firstonly )
2018-09-28 07:03:52 +00:00
( if description description " " ) ) ) )
2018-09-18 21:21:29 +00:00
( defun chronometrist-print-non-tabular ( )
" Print the non-tabular part of the buffer in `chronometrist' . "
2018-09-28 07:03:52 +00:00
( with-current-buffer chronometrist-buffer-name
( let ( ( inhibit-read-only t )
( w " \n " )
2020-09-05 16:17:58 +00:00
;; (keybind-start-new (chronometrist-format-keybinds 'chronometrist-add-new-task chronometrist-mode-map))
2020-05-17 11:20:28 +00:00
( keybind-toggle ( chronometrist-format-keybinds 'chronometrist-toggle-task chronometrist-mode-map t ) ) )
2018-09-28 07:03:52 +00:00
( goto-char ( point-max ) )
2020-09-02 13:54:13 +00:00
( --> ( chronometrist-active-time-one-day )
( chronometrist-format-time it )
( format " %s%- 26s%s " w " Total " it )
( insert it ) )
2018-09-28 07:03:52 +00:00
( insert " \n " )
2020-05-17 11:20:28 +00:00
( insert w ( format " % 17s " " Keys " ) w ( format " % 17s " " ---- " ) )
2019-11-29 04:41:14 +00:00
( chronometrist-print-keybind 'chronometrist-add-new-task )
2020-05-17 11:20:28 +00:00
( 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 " ) )
2018-09-28 07:03:52 +00:00
( chronometrist-print-keybind 'chronometrist-report )
2020-05-17 11:20:28 +00:00
( insert-text-button " see weekly report " 'action #' chronometrist-report 'follow-link t )
2020-05-15 03:32:18 +00:00
( chronometrist-print-keybind 'chronometrist-open-log )
2020-05-17 11:20:28 +00:00
( insert-text-button " view/edit log file " 'action #' chronometrist-open-log 'follow-link t )
2019-01-08 08:03:54 +00:00
( insert " \n " ) ) ) )
2018-09-03 05:29:33 +00:00
2019-11-29 04:41:14 +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. "
2018-09-30 15:58:23 +00:00
( goto-char ( point-min ) )
( when ( re-search-forward ( format " ^%d " n ) nil t )
( beginning-of-line )
2019-11-29 04:41:14 +00:00
( chronometrist-task-at-point ) ) )
2018-09-21 18:50:46 +00:00
2019-11-22 04:25:52 +00:00
( defun chronometrist-refresh ( &optional _ignore-auto _noconfirm )
2019-09-07 07:08:16 +00:00
" Refresh the `chronometrist' buffer, without re-reading `chronometrist-file' .
2019-08-06 11:22:35 +00:00
2019-11-22 04:25:52 +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 '. "
2019-11-09 05:45:23 +00:00
( let* ( ( window ( get-buffer-window chronometrist-buffer-name t ) )
( point ( window-point window ) ) )
( when window
2019-09-07 16:46:37 +00:00
( with-current-buffer chronometrist-buffer-name
( tabulated-list-print t nil )
( chronometrist-print-non-tabular )
( chronometrist-maybe-start-timer )
2019-11-09 05:45:23 +00:00
( set-window-point window point ) ) ) ) )
2018-09-24 05:00:31 +00:00
2021-01-03 08:01:13 +00:00
( defvar chronometrist--file-state nil
" List containing the state of `chronometrist-file' .
2020-08-30 19:53:43 +00:00
` chronometrist-refresh-file ' sets this to a plist in the form
2021-01-03 08:01:13 +00:00
\(:last ( LAST-START LAST-END ) :rest ( REST-START REST-END HASH ) )
2020-08-30 19:53:43 +00:00
2021-01-02 16:41:33 +00:00
\(see ` chronometrist-file-hash ' )
2020-08-30 19:53:43 +00:00
2021-01-03 08:01:13 +00:00
LAST-START and LAST-END represent the start and the end of the
last s-expression.
2020-08-30 19:53:43 +00:00
2021-01-03 08:01:13 +00:00
REST-START and REST-END represent the start of the file and the
2021-01-03 07:37:52 +00:00
end of the second-last s-expression. " )
2020-08-30 19:53:43 +00:00
2021-01-03 08:01:13 +00:00
( defun chronometrist-file-hash ( &optional start end hash )
2020-08-30 19:53:43 +00:00
" Calculate hash of `chronometrist-file' between START and END.
START can be
2021-01-03 16:38:29 +00:00
a number or marker,
2020-08-30 19:53:43 +00:00
:before-last - the position at the start of the last s-expression
nil or any other value - the value of ` point-min '.
END can be
2021-01-03 16:38:29 +00:00
a number or marker,
2021-01-03 07:37:52 +00:00
:before-last - the position at the end of the second-last s-expression,
2021-01-02 16:41:33 +00:00
nil or any other value - the position at the end of the last s-expression.
2020-08-30 19:53:43 +00:00
2021-01-03 08:01:13 +00:00
Return ( START END ) if HASH is nil , else ( START END HASH ) .
2020-08-30 19:53:43 +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
2021-01-03 16:38:29 +00:00
( 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 ) ) ) ) )
2021-01-03 08:01:13 +00:00
( if hash
( --> ( buffer-substring-no-properties start end )
( secure-hash 'sha1 it )
( list start end it ) )
( list start end ) ) ) ) )
2020-08-30 19:53:43 +00:00
2021-01-03 07:37:52 +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 ) ) ) ) )
;; rest-start rest-end last-start last-end
;; :append - rest same, last same, new expr after last-end
;; :modify - rest same, last not same, no expr after last-end
;; :remove - rest same, last not same, no expr after last-start
;; nil - rest same, last same, no expr after last-end
;; t - rest changed
2021-01-02 16:41:33 +00:00
;; tests -
;; add newline after last expression and save
;; remove newline afer last expession and save
;; remove a key-value from last expression
2021-01-03 07:37:52 +00:00
;; remove the last expression
2021-01-02 16:41:33 +00:00
2021-01-03 08:01:13 +00:00
( defun chronometrist-file-change-type ( state )
2020-08-30 19:53:43 +00:00
" Determine the type of change made to `chronometrist-file' .
2021-01-03 08:01:13 +00:00
STATE must be a plist. ( see ` chronometrist--file-state ' )
2020-08-30 19:53:43 +00:00
Return
:append if a new s-expression was added to the end,
2021-01-03 07:37:52 +00:00
:modify if the last s-expression was modified,
:remove if the last s-expression was removed,
2020-08-30 19:53:43 +00:00
nil if the contents didn 't change, and
t for any other change. "
2021-01-03 08:01:13 +00:00
( -let* ( ( ( last-start last-end ) ( plist-get state :last ) )
( ( rest-start rest-end rest-hash ) ( plist-get state :rest ) )
2021-01-02 16:41:33 +00:00
;; Using a hash for the last expression can cause issues -
;; the last expression may shrink, and if we try to hash the
;; old region again to determine if it has changed, we will
2021-01-03 07:37:52 +00:00
;; 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 ) ) )
;; If the last expression is removed,
;; `delete-trailing-whitespace' will also squeeze the two
;; remaining trailing newlines, which makes file-new-length
;; shorter than rest-end, and gives an erroneous result of t
;; ("other change") rather than :removed
( rest-same-p ( unless ( < file-new-length rest-end )
( equal rest-hash
2021-01-27 07:11:01 +00:00
( cl-third ( chronometrist-file-hash rest-start rest-end t ) ) ) ) ) )
2021-01-02 16:41:33 +00:00
( cond ( ( not rest-same-p ) t )
2021-01-03 07:37:52 +00:00
( 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 ) ) ) )
2020-08-30 19:53:43 +00:00
2021-02-02 13:18:54 +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-01-27 15:54:23 +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 ) ) ) )
( 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-01-30 06:38:57 +00:00
( defun chronometrist-refresh-file ( fs-event )
2019-09-07 07:08:16 +00:00
" Re-read `chronometrist-file' and refresh the `chronometrist' buffer.
2019-11-22 04:25:52 +00:00
Argument _FS-EVENT is ignored. "
2020-05-01 10:26:25 +00:00
( run-hooks 'chronometrist-file-change-hook )
2021-01-30 06:38:57 +00:00
;; (message "chronometrist - file %s" fs-event)
2021-01-03 08:01:13 +00:00
;; `chronometrist-file-change-type' must be run /before/ we update `chronometrist--file-state'
2021-01-02 16:41:33 +00:00
;; (the latter represents the old state of the file, which
;; `chronometrist-file-change-type' compares with the new one)
2021-01-30 06:38:57 +00:00
( -let* ( ( ( descriptor action file . . . ) fs-event )
( change ( 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
( setq chronometrist--fs-watch nil chronometrist--file-state nil ) )
( chronometrist-events-populate )
2021-02-02 13:18:54 +00:00
( setq chronometrist-task-list ( chronometrist-task-list ) ) )
2021-01-30 06:38:57 +00:00
( 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 ) ) )
2019-04-08 15:30:56 +00:00
2019-11-29 11:08:44 +00:00
( defun chronometrist-query-stop ( )
" Ask the user if they would like to clock out. "
( let ( ( task ( chronometrist-current-task ) ) )
( and task
2020-08-30 06:35:01 +00:00
( yes-or-no-p ( format " Stop tracking time for %s? " task ) )
2019-11-29 11:08:44 +00:00
( chronometrist-out ) )
t ) )
2020-05-15 04:11:46 +00:00
( defun chronometrist-in ( task &optional _prefix )
" Clock in to TASK; record current time in `chronometrist-file' .
2020-08-30 06:35:01 +00:00
TASK is the name of the task, a string. PREFIX is ignored. "
2020-05-15 04:11:46 +00:00
( interactive " P " )
2020-06-25 09:04:12 +00:00
( let ( ( plist ` ( :name , task :start , ( chronometrist-format-time-iso8601 ) ) ) )
2020-05-15 09:44:22 +00:00
( chronometrist-sexp-new plist )
( chronometrist-refresh ) ) )
2020-05-15 04:11:46 +00:00
( defun chronometrist-out ( &optional _prefix )
" Record current moment as stop time to last s-exp in `chronometrist-file' .
PREFIX is ignored. "
( interactive " P " )
2020-08-30 06:35:01 +00:00
( let ( ( plist ( plist-put ( chronometrist-last ) :stop ( chronometrist-format-time-iso8601 ) ) ) )
2020-05-15 04:11:46 +00:00
( chronometrist-sexp-replace-last plist ) ) )
2018-09-27 22:16:55 +00:00
;; ## HOOKS ##
2020-09-07 03:07:33 +00:00
( defvar chronometrist-mode-hook nil
" Normal hook run at the very end of `chronometrist-mode' . " )
2020-09-06 08:43:35 +00:00
( defvar chronometrist-list-format-transformers nil
" List of functions to transform `tabulated-list-format' (which see).
2021-01-04 03:14:48 +00:00
This is called with ` chronometrist-run-transformers ' in ` chronometrist-mode ', which see.
2020-09-06 08:43:35 +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 '. " )
( defvar chronometrist-entry-transformers nil
" List of functions to transform each entry of `tabulated-list-entries' .
2021-01-04 03:14:48 +00:00
This is called with ` chronometrist-run-transformers ' in ` chronometrist-entries ', which see.
2020-09-06 08:43:35 +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 '. " )
2018-09-27 22:16:55 +00:00
2019-09-11 18:00:52 +00:00
( defvar chronometrist-before-in-functions nil
2019-11-29 04:41:14 +00:00
" Functions to run before a task is clocked in.
2019-08-06 11:36:38 +00:00
Each function in this hook must accept a single argument, which
2019-11-29 04:41:14 +00:00
is the name of the task to be clocked-in.
2018-09-27 22:16:55 +00:00
2019-11-29 04:41:14 +00:00
The commands ` chronometrist-toggle-task-button ',
2020-05-02 07:24:16 +00:00
` chronometrist-add-new-task-button ', ` chronometrist-toggle-task ',
and ` chronometrist-add-new-task ' will run this hook. " )
2018-09-27 22:16:55 +00:00
2019-09-11 18:00:52 +00:00
( defvar chronometrist-after-in-functions nil
2019-11-29 04:41:14 +00:00
" Functions to run after a task is clocked in.
2019-09-11 18:00:52 +00:00
Each function in this hook must accept a single argument, which
2019-11-29 04:41:14 +00:00
is the name of the task to be clocked-in.
2019-09-11 18:00:52 +00:00
2019-11-29 04:41:14 +00:00
The commands ` chronometrist-toggle-task-button ',
2020-05-02 07:24:16 +00:00
` chronometrist-add-new-task-button ', ` chronometrist-toggle-task ',
and ` chronometrist-add-new-task ' will run this hook. " )
2019-09-11 18:00:52 +00:00
( defvar chronometrist-before-out-functions nil
2019-11-29 04:41:14 +00:00
" Functions to run before a task is clocked out.
2019-08-09 02:36:20 +00:00
Each function in this hook must accept a single argument, which
2019-11-29 04:41:14 +00:00
is the name of the task to be clocked out of.
2019-08-09 03:22:44 +00:00
2019-11-29 04:41:14 +00:00
The task will be stopped only if all functions in this list
2019-08-09 03:22:44 +00:00
return a non-nil value. " )
2019-09-11 18:00:52 +00:00
( defvar chronometrist-after-out-functions nil
2019-11-29 04:41:14 +00:00
" Functions to run after a task is clocked out.
2019-08-09 03:22:44 +00:00
Each function in this hook must accept a single argument, which
2019-11-29 04:41:14 +00:00
is the name of the task to be clocked out of. " )
2019-08-09 02:36:20 +00:00
2020-04-29 14:57:05 +00:00
( defvar chronometrist-file-change-hook nil
" Functions to be run after `chronometrist-file' is changed on disk. " )
2019-09-11 18:00:52 +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 ) )
2019-08-09 02:36:20 +00:00
2019-09-11 18:00:52 +00:00
( defun chronometrist-run-functions-and-clock-out ( task )
2019-09-07 04:13:03 +00:00
" Run hooks and clock out of TASK. "
2019-09-11 18:00:52 +00:00
( when ( run-hook-with-args-until-failure 'chronometrist-before-out-functions task )
( chronometrist-out )
( run-hook-with-args 'chronometrist-after-out-functions task ) ) )
2019-08-09 03:38:28 +00:00
2018-09-01 12:31:25 +00:00
;; ## MAJOR-MODE ##
2018-09-28 12:28:37 +00:00
( defvar chronometrist-mode-map
( let ( ( map ( make-sparse-keymap ) ) )
2019-11-29 04:41:14 +00:00
( define-key map ( kbd " RET " ) #' chronometrist-toggle-task )
2020-05-02 07:24:16 +00:00
( define-key map ( kbd " M-RET " ) #' chronometrist-toggle-task-no-hooks )
2020-05-15 03:32:18 +00:00
( define-key map ( kbd " l " ) #' chronometrist-open-log )
2018-09-28 12:28:37 +00:00
( define-key map ( kbd " r " ) #' chronometrist-report )
2019-11-29 04:41:14 +00:00
( define-key map [ mouse-1 ] #' chronometrist-toggle-task )
2020-05-02 07:24:16 +00:00
( define-key map [ mouse-3 ] #' chronometrist-toggle-task-no-hooks )
2019-11-29 04:41:14 +00:00
( define-key map ( kbd " a " ) #' chronometrist-add-new-task )
2018-09-28 12:28:37 +00:00
map )
" Keymap used by `chronometrist-mode' . " )
2018-09-18 21:21:29 +00:00
( define-derived-mode chronometrist-mode tabulated-list-mode " Chronometrist "
" Major mode for `chronometrist' . "
2018-09-11 12:39:38 +00:00
( make-local-variable 'tabulated-list-format )
2020-09-07 03:07:33 +00:00
( --> [ ( " # " 3 t ) ( " Task " 25 t ) ( " Time " 10 t ) ( " Active " 10 t ) ]
2021-01-04 03:14:48 +00:00
( chronometrist-run-transformers chronometrist-list-format-transformers it )
2020-09-07 03:07:33 +00:00
( setq tabulated-list-format it ) )
2018-09-11 12:39:38 +00:00
( make-local-variable 'tabulated-list-entries )
2018-09-18 21:21:29 +00:00
( setq tabulated-list-entries 'chronometrist-entries )
2018-09-11 12:39:38 +00:00
( make-local-variable 'tabulated-list-sort-key )
2019-11-29 04:41:14 +00:00
( setq tabulated-list-sort-key ' ( " Task " . nil ) )
2019-01-16 11:23:41 +00:00
( tabulated-list-init-header )
2020-09-07 03:07:33 +00:00
( setq revert-buffer-function #' chronometrist-refresh )
( run-hooks 'chronometrist-mode-hook ) )
2018-09-26 19:18:14 +00:00
2018-09-25 14:45:55 +00:00
;; ## BUTTONS ##
2018-09-01 12:31:25 +00:00
2019-11-29 04:41:14 +00:00
( defun chronometrist-toggle-task-button ( _button )
" Button action to toggle a task.
2019-10-31 15:13:50 +00:00
2019-11-22 04:25:52 +00:00
Argument _BUTTON is for the purpose of using this as a button
2019-10-31 15:13:50 +00:00
action, and is ignored. "
2020-06-25 13:04:06 +00:00
( when current-prefix-arg
( chronometrist-goto-nth-task ( prefix-numeric-value current-prefix-arg ) ) )
2019-09-05 18:56:41 +00:00
( let ( ( current ( chronometrist-current-task ) )
2019-11-29 04:41:14 +00:00
( at-point ( chronometrist-task-at-point ) ) )
2018-09-25 21:18:52 +00:00
;; clocked in + point on current = clock out
2019-11-29 04:41:14 +00:00
;; clocked in + point on some other task = clock out, clock in to task
2018-09-25 21:18:52 +00:00
;; clocked out = clock in
( when current
2019-09-07 04:13:03 +00:00
( chronometrist-run-functions-and-clock-out current ) )
2018-09-25 21:18:52 +00:00
( unless ( equal at-point current )
2019-11-16 12:26:07 +00:00
( chronometrist-run-functions-and-clock-in at-point ) ) ) )
2018-09-23 14:36:47 +00:00
2019-11-29 04:41:14 +00:00
( defun chronometrist-add-new-task-button ( _button )
" Button action to add a new task.
2019-10-31 15:13:50 +00:00
2019-11-22 04:25:52 +00:00
Argument _BUTTON is for the purpose of using this as a button
2019-10-31 15:13:50 +00:00
action, and is ignored. "
2019-09-05 18:56:41 +00:00
( let ( ( current ( chronometrist-current-task ) ) )
2018-09-25 21:18:52 +00:00
( when current
2019-09-07 04:13:03 +00:00
( chronometrist-run-functions-and-clock-out current ) )
2019-09-07 16:48:19 +00:00
( let ( ( task ( read-from-minibuffer " New task name: " nil nil nil nil nil t ) ) )
2021-01-27 15:56:38 +00:00
( chronometrist-run-functions-and-clock-in task ) ) ) )
2018-09-25 14:45:55 +00:00
;; ## COMMANDS ##
2019-11-29 04:41:14 +00:00
;; TODO - if clocked in and point not on a task, just clock out
2020-05-02 07:24:16 +00:00
( defun chronometrist-toggle-task ( &optional prefix inhibit-hooks )
2019-11-29 04:41:14 +00:00
" Start or stop the task at point.
2018-09-21 18:50:46 +00:00
2019-11-29 04:41:14 +00:00
If there is no task at point, do nothing.
2019-08-06 11:36:38 +00:00
2019-11-29 04:41:14 +00:00
With numeric prefix argument PREFIX, toggle the Nth task in
2020-05-02 07:24:16 +00:00
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. "
2018-09-03 07:50:14 +00:00
( interactive " P " )
2020-08-11 20:01:22 +00:00
( 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.
2018-09-26 17:06:26 +00:00
( ( and prefix ( not nth ) ) )
2019-11-29 04:41:14 +00:00
( target ;; do nothing if there's no task at point
2018-09-26 17:06:26 +00:00
;; clocked in + target is current = clock out
2019-11-29 04:41:14 +00:00
;; clocked in + target is some other task = clock out, clock in to task
2018-09-26 17:06:26 +00:00
;; clocked out = clock in
( when current
2020-08-11 20:01:22 +00:00
( funcall out-function current ) )
2018-09-26 17:06:26 +00:00
( unless ( equal target current )
2020-08-11 20:01:22 +00:00
( funcall in-function target ) ) ) ) ) )
2018-09-11 12:27:34 +00:00
2020-05-02 07:24:16 +00:00
( defun chronometrist-toggle-task-no-hooks ( &optional prefix )
2020-06-26 21:17:27 +00:00
" Like `chronometrist-toggle-task' , but don't run hooks.
2019-08-06 11:36:38 +00:00
2019-11-29 04:41:14 +00:00
With numeric prefix argument PREFIX, toggle the Nth task. If there
is no corresponding task, do nothing. "
2018-09-25 14:45:55 +00:00
( interactive " P " )
2020-05-02 07:24:16 +00:00
( chronometrist-toggle-task prefix t ) )
2018-09-25 14:45:55 +00:00
2019-11-29 04:41:14 +00:00
( defun chronometrist-add-new-task ( )
" Add a new task. "
2018-09-25 14:45:55 +00:00
( interactive )
2019-11-29 04:41:14 +00:00
( chronometrist-add-new-task-button nil ) )
2018-09-23 19:24:34 +00:00
2019-08-04 19:27:22 +00:00
;;;###autoload
2018-09-18 21:21:29 +00:00
( defun chronometrist ( &optional arg )
2019-10-31 13:33:18 +00:00
" Display the user's tasks and the time spent on them today.
2019-08-06 11:36:38 +00:00
2019-10-31 13:33:18 +00:00
Based on their timelog file ` chronometrist-file '. This is the
2019-08-06 11:36:38 +00:00
'listing command ' for ` chronometrist-mode '.
2018-11-02 08:28:54 +00:00
2019-08-06 11:36:38 +00:00
If numeric argument ARG is 1 , run ` chronometrist-report '.
If numeric argument ARG is 2 , run ` chronometrist-statistics '. "
2018-09-01 16:19:47 +00:00
( interactive " P " )
2019-10-25 07:47:27 +00:00
( chronometrist-migrate-check )
2018-10-03 10:36:24 +00:00
( let ( ( buffer ( get-buffer-create chronometrist-buffer-name ) )
2020-05-14 04:18:37 +00:00
( w ( save-excursion
( get-buffer-window chronometrist-buffer-name t ) ) ) )
2018-10-03 10:36:24 +00:00
( cond
2019-11-22 04:31:21 +00:00
( arg ( cl-case arg
2018-11-02 08:28:54 +00:00
( 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
2019-09-05 15:59:58 +00:00
( cond ( ( or ( not ( file-exists-p chronometrist-file ) )
( chronometrist-common-file-empty-p chronometrist-file ) )
2018-11-02 08:28:54 +00:00
;; first run
2020-05-14 04:17:20 +00:00
( chronometrist-common-create-file )
2018-11-02 08:28:54 +00:00
( let ( ( inhibit-read-only t ) )
( chronometrist-common-clear-buffer buffer )
( insert " Welcome to Chronometrist! Hit RET to " )
2019-11-29 04:41:14 +00:00
( insert-text-button " start a new task. "
'action #' chronometrist-add-new-task-button
2018-11-02 08:28:54 +00:00
'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 )
2019-08-08 08:19:06 +00:00
( if ( hash-table-keys chronometrist-events )
( chronometrist-refresh )
( chronometrist-refresh-file nil ) )
2018-11-02 08:28:54 +00:00
( if chronometrist--point
( goto-char chronometrist--point )
2019-11-29 04:41:14 +00:00
( chronometrist-goto-last-task ) ) ) )
2019-10-31 13:31:43 +00:00
( unless chronometrist--fs-watch
( setq chronometrist--fs-watch
2020-08-30 06:35:01 +00:00
( file-notify-add-watch chronometrist-file ' ( change ) #' chronometrist-refresh-file ) ) ) ) ) ) ) )
2018-09-11 12:27:34 +00:00
2019-11-17 13:16:34 +00:00
( provide 'chronometrist )
2019-07-29 10:59:17 +00:00
;;; chronometrist.el ends here