You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
731 lines
24 KiB
731 lines
24 KiB
;;; -*- lexical-binding: t -*-
|
|
;;; tacc.el --- A pomidoro timer supporting tags and customizable export
|
|
|
|
;; Author: Brady McDonough <me@bradymcd.ca>
|
|
;; URL: git.bradymcd.ca/brady/tacc
|
|
;; Keywords: tools, time, pomidoro, accountability
|
|
;; Version: 0.0.1
|
|
;;
|
|
|
|
;; This program is free software; you can redistribute it and/or modify
|
|
;; it under the terms of the GNU General Public License as published by
|
|
;; the Free Software Foundation; either version 2, or version 3 at your
|
|
;; option.
|
|
;;
|
|
;; This program is distributed in the hope that it will be useful,
|
|
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
;; GNU General Public License for more details.
|
|
;;
|
|
;; You should have received a copy of the GNU General Public License
|
|
;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
|
|
|
|
;;; Commentary:
|
|
|
|
;; This implements a slightly modified pomidoro timer with a focus on
|
|
;; programmer customizability.
|
|
;; By default it is just a timer and the serialization and recording of your
|
|
;; time data is up to you (if that's something you even need)
|
|
;; Each successive work and break timer may be longer than the last. Work time
|
|
;; can also be tagged for better time accounting.
|
|
|
|
;;; Index:
|
|
;; 01.1 Indexed settings variables
|
|
;; 01.2 Indexed face settings
|
|
;; 02 Error types
|
|
;; 03 Behaviour group
|
|
;; 03.1 Tag prompt text completion
|
|
;; 03.2 Sound
|
|
;; 04 Record keeping
|
|
;; 05 Timer display buffer
|
|
;; 05.2 State checks
|
|
;; 05.3 State manipulation
|
|
;; 05.4 Timer buffer rendering
|
|
;; 07 Initialization
|
|
;; 08.1 Interactive helpers
|
|
;; 08.2 Interactive functions
|
|
;; 09 Hooks registration
|
|
;; 10 Provides
|
|
|
|
;;; Code:
|
|
|
|
;; TODOS:
|
|
;; ERROR: timer shutdown seems to leave things in a wrong state and buffer doesn't die properly
|
|
;; Check on the logic of push-current, needs predicates rather than lazy if conditions
|
|
;; I'm not calling anything to destroy the buffer on desched
|
|
;; BUG: The buffer is immortal?
|
|
;;
|
|
|
|
;; Optional
|
|
(require 'icicles nil t)
|
|
|
|
;; 01.1 Customs and Indexed Variables
|
|
(defconst tacc-dir (file-name-directory load-file-name))
|
|
|
|
(defgroup tacc nil
|
|
"Root group definition for tacc"
|
|
:prefix "tacc-"
|
|
:group 'applications)
|
|
|
|
(defcustom tacc-buffer-name "*Work Timer*"
|
|
"The name used for the timer display buffer"
|
|
:type 'string :group 'tacc)
|
|
|
|
(defcustom tacc-suppress-tag-prompt t
|
|
"If set nil tacc will ask for a new tag every time a work period begins"
|
|
:type 'boolean :group 'tacc)
|
|
|
|
(defvar tacc-display-buffer-settings '((display-buffer-below-selected)
|
|
(inhibit-same-window . t)
|
|
(dedicated . t))
|
|
"Passed into display-buffer. How a window should be created or reused")
|
|
|
|
(defvar tacc-display-buffer-window-settings '((window-min-height . 10)
|
|
(window-height . 0.25))
|
|
"Passed into display-buffer. The window's overall size")
|
|
|
|
(defun m:s (mins secs)
|
|
"Readability function for minute and second values"
|
|
(+ secs (* 60 mins)))
|
|
|
|
(defcustom tacc-work-seconds (m:s 30 0)
|
|
"The length of a base pomidoro round"
|
|
:type 'integer :group 'tacc)
|
|
|
|
(defcustom tacc-work-seconds-increment 0
|
|
"The time to add to each successive work cycle"
|
|
:type 'integer :group 'tacc)
|
|
|
|
(defcustom tacc-break-seconds (m:s 5 0)
|
|
"The length of a base break round"
|
|
:type 'integer :group 'tacc)
|
|
|
|
(defcustom tacc-break-seconds-increment 0
|
|
"The time to add to each successive break cycle"
|
|
:type 'integer :group 'tacc)
|
|
|
|
(defcustom tacc-chime-interval (m:s 0 27)
|
|
"The time between alerts for timers running past their length"
|
|
:type 'integer :group 'tacc)
|
|
|
|
;; 01.2 Faces
|
|
(defgroup tacc-faces nil
|
|
"Custom faces for tacc"
|
|
:group 'tacc
|
|
:group 'faces
|
|
:prefix "tacc-")
|
|
|
|
(defface tacc-graph-work
|
|
'((t :inherit success))
|
|
"For work graph bars"
|
|
:group 'tacc-faces)
|
|
|
|
(defface tacc-graph-break
|
|
'((t :inherit warning))
|
|
"For break graph bars"
|
|
:group 'tacc-faces)
|
|
|
|
(defface tacc-graph-void
|
|
'((t :inherit shadow))
|
|
"For filler graph bars"
|
|
:group 'tacc-faces)
|
|
|
|
(defface tacc-clock
|
|
'((t :height 3.0))
|
|
"For the clock and timer"
|
|
:group 'tacc-faces)
|
|
|
|
(defface tacc-clock-pause
|
|
'((t :inherit (tacc-clock italic ansi-slow-blink)))
|
|
"For the timer while the timer isn't running"
|
|
:group 'tacc-faces)
|
|
|
|
(defface tacc-overwork
|
|
'((t :inherit (tacc-clock error)))
|
|
"for the timer whenever we are in overwork"
|
|
:group 'tacc-faces)
|
|
|
|
(defface tacc-tag
|
|
'((t :inherit link-visited))
|
|
"The face the tag is printed in"
|
|
:group 'tacc-faces)
|
|
|
|
;; 02 Errors
|
|
(define-error 'tacc-error "Generic error from the tacc-timer module" 'error)
|
|
(define-error 'tacc-error-illegal-buffer-state
|
|
"Precondition failed, the timer buffer is in an invalid state" 'tacc-error)
|
|
(define-error 'tacc-error-serialization-registered
|
|
"Failed to register a serialization, serializations must have unique names"
|
|
'tacc-error)
|
|
|
|
;; 03 Behavior group
|
|
(defgroup tacc-behavior nil
|
|
"Low level behavior settings for tacc"
|
|
:group 'tacc
|
|
:prefix "tacc-")
|
|
|
|
;; 03.1 Tag prompts and completion
|
|
(defvar tacc-tag-history nil
|
|
"Tag name history, used for completions")
|
|
|
|
(defcustom tacc-tag-history-file
|
|
(expand-file-name "tags-history" tacc-dir)
|
|
"Tag history storage file, for completions"
|
|
:type '(file :must-match t)
|
|
:group 'tacc-behavior)
|
|
|
|
(defcustom tacc-tag-completion-functions nil
|
|
"A list of user defined functions for generating completions for tagging.
|
|
Each function must have no required arguments and return a list of strings"
|
|
:type 'hook
|
|
:group 'tacc-behavior)
|
|
|
|
(defun tacc-load-tag-history ()
|
|
"Load completions for tags"
|
|
(with-temp-buffer
|
|
(insert-file-contents tacc-tag-history-file)
|
|
(setq tacc-tag-history (split-string (buffer-string) "\n"))))
|
|
|
|
(defun tacc-save-tag-history ()
|
|
"Save completions for tags"
|
|
(with-temp-file tacc-tag-history-file
|
|
(insert (mapconcat 'identity
|
|
tacc-tag-history
|
|
"\n"))))
|
|
|
|
;; 03.2 Sound
|
|
(defcustom tacc-sound-tick
|
|
(expand-file-name "tick.wav" tacc-dir)
|
|
"The 'Tick' sound of the timer"
|
|
:type '(file :must-match t)
|
|
:group 'tacc-behavior)
|
|
|
|
(defcustom tacc-sound-chime
|
|
(expand-file-name "chime.wav" tacc-dir)
|
|
"The break and work alarm sound of the timer"
|
|
:type '(file :must-match t)
|
|
:group 'tacc-behavior)
|
|
|
|
(defun tacc-play-sound-file-emacs (file)
|
|
"Play some file in a child emacs process"
|
|
(if (fboundp 'play-sound-internal)
|
|
(start-process "tacc-play-sound"
|
|
nil
|
|
(car command-line-args)
|
|
"--batch"
|
|
"--eval" (format "(play-sound-file \"%s\")" file))
|
|
(warn "Emacs lacks builtin sound support")))
|
|
|
|
(defcustom tacc-play-sound-file #'tacc-play-sound-file-emacs
|
|
"Asyncronous function to play sounds. Set to nil to disable sound"
|
|
:type '(choice (const nil)
|
|
function)
|
|
:group 'tacc-behavior)
|
|
|
|
;; 04 Record keeping
|
|
(defvar tacc-serials '()
|
|
"A list of serialization functions keyed with names registered at runtime")
|
|
|
|
(defun tacc-register-serialization (name serialize)
|
|
"The supplied `serialize' function will be run every time a work session has
|
|
ended, either because `tacc-end-timer' was called by the user or when emacs
|
|
closes with a session still live. Supplied serialize function must take as an
|
|
argument a cons list of records.
|
|
A record is an alist layed out as follows:
|
|
`(:ts . <unix timestamp>)
|
|
(:end . <unix timestamp>)
|
|
(:state . <:break | :work>)
|
|
(:tag . <an assigned tag name>)'
|
|
The supplied `name' will be used to generate a new (empty) abnormal hook,
|
|
`tacc-<name>-output-functions'. Each function added to this hook will be
|
|
called with the output of the `serialize' function as an argument. Keep in
|
|
mind that this is *not* a copy, if your output function mutates its input for
|
|
any reason it should copy the argument first."
|
|
(let* ((sym-name (format "tacc-%s-output-functions" name)))
|
|
(if (intern-soft sym-name)
|
|
(error "tacc-register-serialization failed, it seems %s is already \
|
|
registered" sym-name)
|
|
(set (intern sym-name) '())
|
|
(push (cons name serialize) tacc-serials))))
|
|
|
|
(defun tacc-save-record (records)
|
|
"Calls all user-defined serializers and output functions"
|
|
(dolist (ser tacc-serials)
|
|
(let* ((sym-name (format "tacc-%s-output-functions" (car ser)))
|
|
(fn (cdr ser))
|
|
(data (funcall fn records)))
|
|
(run-hook-with-args (intern sym-name) data))))
|
|
|
|
;; 05 Timer display buffer
|
|
(defvar tacc-timer-mode-map
|
|
(let ((map (make-sparse-keymap)))
|
|
map))
|
|
|
|
(define-derived-mode tacc-timer-mode
|
|
special-mode tacc-buffer-name
|
|
"Major mode for the tacc timer"
|
|
(setq-local show-trailing-whitespace nil
|
|
tacc-locs `((clock-start . ,(copy-marker 0))
|
|
(clock-end . ,(copy-marker 0))
|
|
(graph-start . ,(copy-marker 0))
|
|
(graph-end . ,(copy-marker 0)))))
|
|
|
|
(defun tacc-info-initial ()
|
|
"Returns the initial state of tacc-info"
|
|
(copy-alist `((history . ())
|
|
(cycle . 0)
|
|
(work-ts . nil)
|
|
(break-ts . nil)
|
|
(end-ts . nil)
|
|
(state . stop)
|
|
(tag . ""))))
|
|
|
|
(defvar tacc-info (tacc-info-initial)
|
|
"State information related to the timer")
|
|
|
|
(defvar tacc-timer nil
|
|
"Timer object controlling tacc's second-by-second update")
|
|
|
|
;; 05.2 State checks
|
|
;; TODO: tacc-running? needs to be replaced by tacc-session? and tacc-live? depending on context
|
|
|
|
|
|
(defun tacc-buffer ()
|
|
"Gets the tacc-timer buffer if there is one"
|
|
(get-buffer tacc-buffer-name))
|
|
|
|
(defun tacc-live-state? (state)
|
|
"Checks if the state supplied indicates a live timer"
|
|
(cond ((eq state 'pause) nil)
|
|
((eq state 'stop) nil)
|
|
((eq state 'work) t)
|
|
((eq state 'break) t)
|
|
('t (signal 'tacc-error-illegal-buffer-state state))))
|
|
|
|
(defun tacc-live? ()
|
|
"Checks if there is a live timer running"
|
|
(timerp tacc-timer))
|
|
|
|
(defun tacc-session-state? (state)
|
|
"Checks if the state supplied indicates there should be session information"
|
|
(cond ((eq state 'pause) t)
|
|
((eq state 'stop) nil)
|
|
((eq state 'work) t)
|
|
((eq state 'break) t)
|
|
('t (signal 'tacc-error-illegal-buffer-state state))))
|
|
|
|
(defun tacc-session? ()
|
|
"Checks if tacc session info indicates there should be session information"
|
|
(tacc-running-state? (alist-get 'state tacc-info)))
|
|
|
|
(defun tacc-history? ()
|
|
"Checks if tacc session has history information"
|
|
(if (> 0 (length (alist-get 'history tacc-info)))
|
|
t
|
|
nil))
|
|
|
|
(defun tacc-invariant ()
|
|
"Returns t if tacc is in a legal state for mutating tacc-info
|
|
Note, if there is no tacc-buffer then you shouldn't be touching tacc-info"
|
|
(if (bufferp (tacc-buffer))
|
|
(if (and (tacc-running?)
|
|
(tacc-live?))
|
|
t)
|
|
(signal 'tacc-error-illegal-buffer-state (tacc-buffer))))
|
|
|
|
;; 05.3 Predicates and helpers
|
|
(defun tacc-chime-p (countdown-ts)
|
|
"Should I play a chime on this second?"
|
|
(if (time-less-p countdown-ts 0)
|
|
(= 0 (mod (time-to-seconds countdown-ts)
|
|
tacc-chime-interval))))
|
|
|
|
(defun tacc-work-period (cycle)
|
|
"How long is the current work period?"
|
|
(+ tacc-work-seconds
|
|
(* cycle tacc-work-seconds-increment)))
|
|
|
|
(defun tacc-break-period (cycle)
|
|
"How long is the current break period?"
|
|
(+ tacc-break-seconds
|
|
(* cycle tacc-break-seconds-increment)))
|
|
|
|
(defun tacc-start-ts (state work-ts break-ts)
|
|
"Given the state, which timestamp did we start on?"
|
|
(if (eq state 'work) work-ts break-ts))
|
|
|
|
(defun tacc-est-ts (state cycle work-ts break-ts)
|
|
"Given the state and cycle, how long is the current time segment?"
|
|
(let ((start-ts (tacc-start-ts state work-ts break-ts)))
|
|
(time-add start-ts
|
|
(if (eq state 'work)
|
|
(tacc-work-period cycle)
|
|
(tacc-break-period cycle)))))
|
|
|
|
;; 05.3 State manipulation
|
|
|
|
(defun tacc-tick ()
|
|
"Time marches on. Called every second while a tacc timer is running"
|
|
(let* ((now (current-time))
|
|
(state (alist-get 'state tacc-info))
|
|
(cycle (alist-get 'cycle tacc-info))
|
|
(work-ts (alist-get 'work-ts tacc-info))
|
|
(break-ts (alist-get 'break-ts tacc-info))
|
|
(est (tacc-est-ts state cycle work-ts break-ts))
|
|
(countdown (time-subtract est now)))
|
|
(tacc-timer-buffer-update state est countdown now)
|
|
(if (functionp tacc-play-sound-file)
|
|
(cond ((tacc-chime-p countdown)
|
|
(funcall tacc-play-sound-file tacc-sound-chime))
|
|
(t (funcall tacc-play-sound-file tacc-sound-tick))))))
|
|
|
|
(defun tacc-timer-buffer-redraw ()
|
|
(let ((now (current-time))
|
|
(state (alist-get 'state tacc-info)))
|
|
(tacc-timer-buffer-update state)))
|
|
;; TODO
|
|
|
|
(defun tacc-schedule ()
|
|
"Note the time and schedule the first tick"
|
|
(setcdr (assoc 'state tacc-info) 'work)
|
|
(setcdr (assoc 'work-ts tacc-info) (current-time))
|
|
(setq tacc-timer (run-with-timer 't 1 'tacc-tick)))
|
|
|
|
(defun tacc-deschedule ()
|
|
"Deschedule the timer"
|
|
(setcdr (assoc 'end-ts tacc-info) (current-time))
|
|
(setq tacc-timer (cancel-timer tacc-timer)))
|
|
|
|
(defun tacc-push-current ()
|
|
"Push the current period into the record"
|
|
(let* ((stack (assoc 'history tacc-info))
|
|
(work-place (assoc 'work-ts tacc-info))
|
|
(break-place (assoc 'break-ts tacc-info))
|
|
(end-place (assoc 'end-ts tacc-info))
|
|
(tag (alist-get 'tag tacc-info "")))
|
|
(let ((work-cond (if (cdr work-place) 't nil))
|
|
(break-cond (if (cdr break-place) 't nil)))
|
|
(if work-cond
|
|
(let ((ts (time-to-seconds (cdr work-place)))
|
|
(end (time-to-seconds (if break-cond
|
|
(cdr break-place)
|
|
(cdr end-place)))))
|
|
(push `((ts . ,ts)
|
|
(end . ,end)
|
|
(state . work)
|
|
(tag . ,tag))
|
|
stack)))
|
|
(if break-cond
|
|
(let ((ts (time-to-seconds (cdr break-place)))
|
|
(end (time-to-seconds (cdr end-place))))
|
|
(push `((ts . ,ts)
|
|
(end . ,end)
|
|
(state . break)
|
|
(tag . ,tag))
|
|
stack))))
|
|
(setcdr work-place nil)
|
|
(setcdr break-place nil)
|
|
(setcdr end-place nil)))
|
|
|
|
(defun tacc-kill-buffer-confirm ()
|
|
"Ask for confirmation if a timer is still running"
|
|
(if (tacc-running?)
|
|
(yes-or-no-p "Are you sure you want to kill the timer buffer? This will\
|
|
end the current timer session as well.")
|
|
t))
|
|
|
|
(defun tacc-buffer-cleanup ()
|
|
"Save and cleanup the timer state if a timer is still live"
|
|
(if (tacc-running?)
|
|
(progn (tacc-deschedule)
|
|
(tacc-push-current))))
|
|
|
|
;; 06.4 Rendering
|
|
|
|
(defun space-divider (width segments)
|
|
(let ((ticker 0)
|
|
(rem (mod width segments))
|
|
(len (/ width segments)))
|
|
(lambda ()
|
|
(setf ticker (1+ ticker))
|
|
(+ len (if (<= ticker rem) 1 0)))))
|
|
|
|
(defun gradient-string (width chars)
|
|
(mapconcat (let ((ticker 0)
|
|
(rem (mod width (length chars)))
|
|
(len (/ width (length chars))))
|
|
(lambda (c)
|
|
(make-string (+ len (if (<= (setq ticker (1+ ticker)) rem) 1 0))
|
|
c)))
|
|
chars ""))
|
|
|
|
(defun tacc-header-render (width)
|
|
"Returns a string for the header of the tacc timer"
|
|
(propertize (gradient-string width "'\"'") ;▓░ ▒█
|
|
'face 'shadow))
|
|
|
|
(defmacro tacc-render-with-buffer (&rest body)
|
|
"Executes the body in tacc-buffer with (let-alist tacc-info), suppress read only"
|
|
`(let* ((buffer (tacc-buffer))
|
|
(window (get-buffer-window buffer t)))
|
|
(with-current-buffer buffer
|
|
(let ((width (window-total-width window 'floor))
|
|
(inhibit-read-only t))
|
|
(let-alist (buffer-local-value 'tacc-locs buffer)
|
|
(goto-char (point-min))
|
|
,@body)))))
|
|
|
|
(defmacro tacc-insert-between (start end &rest strings)
|
|
"Replace the text in the region between start and end with string"
|
|
`(save-restriction
|
|
(narrow-to-region ,start ,end)
|
|
(delete-region ,start ,end)
|
|
(goto-char ,start)
|
|
(insert ,@strings)
|
|
(set-marker ,start (point-min))
|
|
(set-marker ,end (point-max))))
|
|
|
|
(defconst tacc-pause-glyph ?⏸)
|
|
(defconst tacc-run-glyph ?▶)
|
|
(defconst tacc-graph-char ?█)
|
|
|
|
(defun tacc-init-timer-buffer ()
|
|
"Initialized the timer buffer display. Sets needed edit positions"
|
|
(let* ((buffer (get-buffer-create tacc-buffer-name))
|
|
(window (display-buffer buffer
|
|
(append tacc-display-buffer-settings
|
|
tacc-display-buffer-window-settings))))
|
|
(with-current-buffer buffer
|
|
(tacc-timer-mode)
|
|
(make-local-variable 'kill-buffer-query-functions)
|
|
(add-hook 'kill-buffer-query-functions 'tacc-kill-buffer-confirm)
|
|
(let ((width (window-total-width window 'floor))
|
|
(inhibit-read-only t))
|
|
(goto-char (point-min))
|
|
(let-alist (buffer-local-value 'tacc-locs buffer)
|
|
(insert (tacc-header-render width))
|
|
(set-marker .clock-start (point))
|
|
(set-marker .clock-end (point-max))
|
|
(tacc-insert-between
|
|
.clock-start .clock-end
|
|
(tacc-clock-render 'work 1 0))
|
|
(insert "\n")
|
|
(set-marker .graph-start (point))
|
|
(set-marker .graph-end (point-max))
|
|
(tacc-insert-between
|
|
.graph-start .graph-end
|
|
"Tag: \n"
|
|
(tacc-graph-bar-render width 0.0 0.0 1.0)))))))
|
|
|
|
|
|
(defun tacc-clock-glyph (state)
|
|
"Returns the correct play or pause glyph for each state"
|
|
(string
|
|
(cond ((eq state 'work) tacc-run-glyph)
|
|
((eq state 'break) tacc-run-glyph)
|
|
((eq state 'pause) tacc-pause-glyph)
|
|
((eq state 'stop) tacc-pause-glyph))))
|
|
|
|
(defun tacc-clock-render (state countdown now)
|
|
"Draw the clock"
|
|
(let* ((overwork (time-less-p countdown 1))
|
|
(count-fmt (if overwork "+%M:%S" "-%M:%S"))
|
|
(count-face (cond (overwork 'tacc-overwork)
|
|
((eq state 'pause) 'tacc-clock-pause)
|
|
('t 'tacc-clock))))
|
|
(concat
|
|
(propertize (format-time-string "%T" now) 'face 'tacc-clock)
|
|
(propertize (format-time-string count-fmt countdown) 'face count-face)
|
|
(propertize (tacc-clock-glyph state) 'face 'tacc-clock))))
|
|
|
|
(defun tacc-graph-bar-render (width work break void)
|
|
"Return a graph bar width characters wide with the given proportions as \
|
|
float"
|
|
(let ((width (- width 5)))
|
|
(concat
|
|
" "
|
|
(propertize (make-string (round (* width work)) tacc-graph-char)
|
|
'face 'tacc-graph-work)
|
|
(propertize (make-string (round (* width break)) tacc-graph-char)
|
|
'face 'tacc-graph-break)
|
|
(propertize (make-string (round (* width void)) tacc-graph-char)
|
|
'face 'tacc-graph-void)
|
|
" \n")))
|
|
|
|
(defun tacc-tag-render (tag)
|
|
(concat " Tag: "
|
|
(propertize (if (string= tag "") "<None>" tag)
|
|
'face 'tacc-tag)
|
|
"\n"))
|
|
|
|
(defun tacc-timer-buffer-update (state est-ts countdown now)
|
|
"Update the timer buffer rendering"
|
|
(tacc-render-with-buffer
|
|
(tacc-insert-between
|
|
.clock-start .clock-end
|
|
(let-alist tacc-info
|
|
(tacc-clock-render state countdown now)))
|
|
(tacc-insert-between
|
|
.graph-start .graph-end
|
|
(let-alist tacc-info
|
|
(concat (tacc-tag-render .tag)
|
|
(let* ((est-s (time-to-seconds est-ts))
|
|
(now-s (time-to-seconds now))
|
|
(end-s (if (< est-s now-s) now-s est-s))
|
|
(work-s (time-to-seconds .work-ts))
|
|
(break-s (time-to-seconds .break-ts))
|
|
|
|
(total (- end-s work-s))
|
|
(work-prop (/ (- (if (numberp break-s) break-s now-s) work-s) total))
|
|
(break-prop (/ (if (numberp break-s) (- now-s break-s) 0) total))
|
|
(void-prop (- 1 (+ work-prop break-prop))))
|
|
(tacc-graph-bar-render width work-prop break-prop void-prop)))))))
|
|
|
|
(defun tacc-new-graph-bar-render ()
|
|
(tacc-render-with-buffer
|
|
(save-restriction
|
|
(narrow-to-region .graph-start .graph-start)
|
|
(goto-char (point-min))
|
|
(insert "\n")
|
|
(set-marker .graph-start (point-min))
|
|
(set-marker .graph-end (point-max))
|
|
(insert "\n"))))
|
|
|
|
;; 07 Init
|
|
|
|
(defun tacc-init ()
|
|
"Orchestrates all initialization functions"
|
|
(let ((tag (tacc-tag-prompt)))
|
|
(tacc-init-timer-buffer)
|
|
(setcdr (assoc 'tag tacc-info) tag)
|
|
(tacc-schedule)))
|
|
|
|
;; 08.1 Interactive Helpers
|
|
|
|
(defun tacc-tag-prompt ()
|
|
"Prompt for a tag and return the user's input"
|
|
(let ((last-tag (if (bufferp (tacc-buffer))
|
|
(alist-get 'tag tacc-info)
|
|
nil))
|
|
(completions (append (flatten-tree
|
|
(apply 'funcall (if tacc-tag-completion-functions
|
|
tacc-tag-completion-functions
|
|
`(,(lambda () "")))))
|
|
tacc-tag-history)))
|
|
(completing-read (concat "Enter a tag name"
|
|
(if (< (length last-tag) 0)
|
|
(format " (currently %s)" last-tag) "")
|
|
": ")
|
|
completions
|
|
'stringp
|
|
nil
|
|
nil
|
|
'tacc-tag-history)))
|
|
|
|
(defun tacc-tag-prompt-soft ()
|
|
"Prompt for a tag unless the user doesn't want us to
|
|
Returns the current tag if no prompt is made"
|
|
(if tacc-suppress-tag-prompt
|
|
(alist-get 'tag tacc-info)
|
|
(tacc-tag-prompt)))
|
|
|
|
;; 08.2 Interactive
|
|
|
|
(defun tacc-start-timer ()
|
|
"Starts the tacc timer"
|
|
(interactive)
|
|
(if (bufferp (tacc-buffer))
|
|
(message "A timer is already running")
|
|
(tacc-init)))
|
|
|
|
(defun tacc-set-tag ()
|
|
"Sets a tag for live timer sessions going forward"
|
|
(interactive)
|
|
(if (tacc-running?)
|
|
(setcdr (assoc 'tag tacc-info) (tacc-tag-prompt))
|
|
(message "There isn't a live timer session to tag")))
|
|
|
|
(defun tacc-cycle-increment (state)
|
|
"Increments the cycle counter if the current state is a 'break"
|
|
(if (eq state 'break)
|
|
(let* ((cycle-place (assoc 'cycle tacc-info))
|
|
(cycle (cdr cycle-place)))
|
|
(setcdr cycle-place (1+ cycle)))))
|
|
|
|
(defun tacc-timer-state-forward ()
|
|
"Move the tacc timer state forward"
|
|
(interactive)
|
|
(if (tacc-running?)
|
|
(let* ((state-place (assoc 'state tacc-info))
|
|
(state (cdr state-place))
|
|
(work-ts (assoc 'work-ts tacc-info))
|
|
(break-ts (assoc 'break-ts tacc-info))
|
|
(end-ts (assoc 'end-ts tacc-info))
|
|
(ts (current-time)))
|
|
(if (eq state 'work)
|
|
(progn (setcdr break-ts ts)
|
|
(setcdr state-place 'break))
|
|
(progn (setcdr end-ts ts)
|
|
(tacc-push-current)
|
|
(setcdr work-ts ts)
|
|
(setcdr state-place 'work)
|
|
(tacc-new-graph-bar-render)))
|
|
(tacc-cycle-increment state))
|
|
(message "There is no timer to advance")))
|
|
|
|
(defun tacc-timer-state-skip ()
|
|
"Move the tacc timer state to a new work cycle"
|
|
(interactive)
|
|
(if (tacc-running?)
|
|
(let* ((state-place (assoc 'state tacc-info))
|
|
(work-ts (assoc 'work-ts tacc-info))
|
|
(end-ts (assoc 'end-ts tacc-info))
|
|
(ts (current-time)))
|
|
(setcdr end-ts ts)
|
|
(tacc-push-current)
|
|
(tacc-cycle-increment 'break)
|
|
(setcdr work-ts ts)
|
|
(setcdr state-place 'work)
|
|
(tacc-new-graph-bar-render))))
|
|
|
|
(defun tacc-pause-timer ()
|
|
"Pause the tacc timer session"
|
|
(tacc-deschedule)
|
|
(tacc-push-current)
|
|
(setcdr (assoc 'state tacc-info) 'pause))
|
|
|
|
(defun tacc-unpause-timer ()
|
|
"Unpause the tacc timer session"
|
|
(tacc-new-graph-bar-render)
|
|
(tacc-schedule))
|
|
|
|
(defun tacc-hold-timer ()
|
|
"Pause/unpause the tacc timer session"
|
|
(interactive)
|
|
(if (tacc-running?)
|
|
(let ((state (alist-get 'state tacc-info)))
|
|
(if (eq state 'pause)
|
|
(tacc-unpause-timer)
|
|
(tacc-pause-timer))
|
|
(tacc-timer-buffer-redraw)))
|
|
(message "There isn't a live timer session to pause/unpause"))
|
|
|
|
(defun tacc-end-timer ()
|
|
"Ends the current timer session, runs serialization and kills the buffer"
|
|
(interactive)
|
|
(tacc-deschedule)
|
|
(tacc-push-current)
|
|
(tacc-save-record (assoc 'history tacc-info))
|
|
(setcdr (assoc 'state tacc-info) 'stop)
|
|
(kill-buffer (tacc-buffer)))
|
|
|
|
;; 09 Hooks setup
|
|
(add-hook 'after-init-hook 'tacc-load-tag-history)
|
|
(add-hook 'kill-emacs-hook 'tacc-save-tag-history)
|
|
|
|
;; 10 Provides
|
|
|
|
(provide 'tacc)
|
|
|
|
;;; tacc.el ends here
|