|
|
|
|
@ -49,11 +49,16 @@
|
|
|
|
|
|
|
|
|
|
;;; 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?
|
|
|
|
|
;; TODOS: Buffer kill hook not triggered on exit?
|
|
|
|
|
;; Split buffer update into clock and graph sections
|
|
|
|
|
;; - As it is, pausing the timer can't draw a full buffer and ends up
|
|
|
|
|
;; erasing the previous time graph
|
|
|
|
|
;; The buffer could render in smoother, just set points don't render empty data
|
|
|
|
|
;; Center the clock-countdown display
|
|
|
|
|
;;
|
|
|
|
|
;; ERROR: Check on the logic of push-current, needs predicates rather than lazy if conditions
|
|
|
|
|
;; history field is not populating
|
|
|
|
|
;; BUG: Break timer displays wrong time and sign
|
|
|
|
|
;;
|
|
|
|
|
|
|
|
|
|
;; Optional
|
|
|
|
|
@ -154,6 +159,8 @@
|
|
|
|
|
(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-dirty-state
|
|
|
|
|
"Precondition failed, tacc state wasn't clean" 'tacc-error)
|
|
|
|
|
(define-error 'tacc-error-serialization-registered
|
|
|
|
|
"Failed to register a serialization, serializations must have unique names"
|
|
|
|
|
'tacc-error)
|
|
|
|
|
@ -272,13 +279,13 @@ registered" sym-name)
|
|
|
|
|
|
|
|
|
|
(defun tacc-info-initial ()
|
|
|
|
|
"Returns the initial state of tacc-info"
|
|
|
|
|
`((history . ())
|
|
|
|
|
(cycle . 0)
|
|
|
|
|
(work-ts . nil)
|
|
|
|
|
(break-ts . nil)
|
|
|
|
|
(end-ts . nil)
|
|
|
|
|
(state . stop)
|
|
|
|
|
(tag . "")))
|
|
|
|
|
(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")
|
|
|
|
|
@ -292,26 +299,61 @@ registered" sym-name)
|
|
|
|
|
"Gets the tacc-timer buffer if there is one"
|
|
|
|
|
(get-buffer tacc-buffer-name))
|
|
|
|
|
|
|
|
|
|
(defun tacc-running? ()
|
|
|
|
|
(defun tacc-live-state? ()
|
|
|
|
|
"Checks if tacc-info's state indicates a live timer"
|
|
|
|
|
(let ((state (alist-get 'state tacc-info)))
|
|
|
|
|
(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-running-state? (state)
|
|
|
|
|
"Checks if the state supplied indicates a live timer"
|
|
|
|
|
(cond ((eq state 'pause) nil)
|
|
|
|
|
(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-session-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"
|
|
|
|
|
"Returns t when state indicates tacc-info can be mutated. Signals error if not"
|
|
|
|
|
(if (bufferp (tacc-buffer))
|
|
|
|
|
(if (tacc-live?)
|
|
|
|
|
(if (tacc-live-state?)
|
|
|
|
|
t
|
|
|
|
|
;; Timer running without reason in logic
|
|
|
|
|
(signal 'tacc-error-illegal-buffer-state tacc-timer))
|
|
|
|
|
(if (tacc-session-state? (alist-get 'state tacc-info))
|
|
|
|
|
t
|
|
|
|
|
;; Buffer is live without reason in logic
|
|
|
|
|
(signal 'tacc-error-illegal-buffer-state (tacc-buffer))))
|
|
|
|
|
;; We shouldn't be calling this when the buffer is dead
|
|
|
|
|
(signal 'tacc-error-illegal-buffer-state "No buffer")))
|
|
|
|
|
|
|
|
|
|
(defun tacc-cleanup-invariant ()
|
|
|
|
|
"Returns t if tacc is in a cleaned up state, signals an error otherwise"
|
|
|
|
|
(if (bufferp (tacc-buffer))
|
|
|
|
|
(if (and (timerp tacc-timer)
|
|
|
|
|
(tacc-running-state? tacc-info))
|
|
|
|
|
t)
|
|
|
|
|
(signal 'tacc-error-illegal-buffer-state (tacc-buffer))))
|
|
|
|
|
(signal 'tacc-error-dirty-state (tacc-buffer))
|
|
|
|
|
(if (tacc-live?)
|
|
|
|
|
(signal 'tacc-error-dirty-state tacc-timer)
|
|
|
|
|
(if (tacc-session?)
|
|
|
|
|
(signal 'tacc-error-dirty-state tacc-info)
|
|
|
|
|
t))))
|
|
|
|
|
|
|
|
|
|
;; 05.3 Predicates and helpers
|
|
|
|
|
(defun tacc-chime-p (countdown-ts)
|
|
|
|
|
@ -340,25 +382,38 @@ Note, if there is no tacc-buffer then you shouldn't be touching tacc-info"
|
|
|
|
|
(time-add start-ts
|
|
|
|
|
(if (eq state 'work)
|
|
|
|
|
(tacc-work-period cycle)
|
|
|
|
|
(tacc-break-period cycle)))))
|
|
|
|
|
(if (eq state 'break)
|
|
|
|
|
(tacc-break-period cycle))
|
|
|
|
|
0))))
|
|
|
|
|
|
|
|
|
|
;; 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))
|
|
|
|
|
(defun tacc-draw-buffer (now state)
|
|
|
|
|
"Redraws the timer buffer and returns the calculated countdown seconds"
|
|
|
|
|
(let* ((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)
|
|
|
|
|
countdown))
|
|
|
|
|
|
|
|
|
|
(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))
|
|
|
|
|
(countdown (tacc-draw-buffer now state)))
|
|
|
|
|
(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 ()
|
|
|
|
|
"Force a redraw of the timer buffer"
|
|
|
|
|
(let ((now (current-time))
|
|
|
|
|
(state (alist-get 'state tacc-info)))
|
|
|
|
|
(tacc-draw-buffer now state)))
|
|
|
|
|
|
|
|
|
|
(defun tacc-schedule ()
|
|
|
|
|
"Note the time and schedule the first tick"
|
|
|
|
|
(setcdr (assoc 'state tacc-info) 'work)
|
|
|
|
|
@ -403,14 +458,14 @@ Note, if there is no tacc-buffer then you shouldn't be touching tacc-info"
|
|
|
|
|
|
|
|
|
|
(defun tacc-kill-buffer-confirm ()
|
|
|
|
|
"Ask for confirmation if a timer is still running"
|
|
|
|
|
(if (tacc-running?)
|
|
|
|
|
(if (tacc-session?)
|
|
|
|
|
(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?)
|
|
|
|
|
(if (tacc-session?)
|
|
|
|
|
(progn (tacc-deschedule)
|
|
|
|
|
(tacc-push-current))))
|
|
|
|
|
|
|
|
|
|
@ -488,13 +543,14 @@ Note, if there is no tacc-buffer then you shouldn't be touching tacc-info"
|
|
|
|
|
(set-marker .graph-end (point-max))
|
|
|
|
|
(tacc-insert-between
|
|
|
|
|
.graph-start .graph-end
|
|
|
|
|
"Tag: \n"
|
|
|
|
|
" 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)
|
|
|
|
|
(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))))
|
|
|
|
|
@ -602,6 +658,18 @@ Returns the current tag if no prompt is made"
|
|
|
|
|
(alist-get 'tag tacc-info)
|
|
|
|
|
(tacc-tag-prompt)))
|
|
|
|
|
|
|
|
|
|
(defun tacc-end-session ()
|
|
|
|
|
"Ends the current timer session, runs serialization and kills the buffer"
|
|
|
|
|
(if (tacc-session?)
|
|
|
|
|
(progn
|
|
|
|
|
(if (tacc-live?)
|
|
|
|
|
(progn (tacc-deschedule)
|
|
|
|
|
(tacc-push-current)))
|
|
|
|
|
(tacc-save-record (assoc 'history tacc-info))
|
|
|
|
|
(setq tacc-info (tacc-info-initial))
|
|
|
|
|
(kill-buffer (tacc-buffer))
|
|
|
|
|
(tacc-cleanup-invariant))))
|
|
|
|
|
|
|
|
|
|
;; 08.2 Interactive
|
|
|
|
|
|
|
|
|
|
(defun tacc-start-timer ()
|
|
|
|
|
@ -614,7 +682,7 @@ Returns the current tag if no prompt is made"
|
|
|
|
|
(defun tacc-set-tag ()
|
|
|
|
|
"Sets a tag for live timer sessions going forward"
|
|
|
|
|
(interactive)
|
|
|
|
|
(if (tacc-running?)
|
|
|
|
|
(if (tacc-session?)
|
|
|
|
|
(setcdr (assoc 'tag tacc-info) (tacc-tag-prompt))
|
|
|
|
|
(message "There isn't a live timer session to tag")))
|
|
|
|
|
|
|
|
|
|
@ -628,7 +696,7 @@ Returns the current tag if no prompt is made"
|
|
|
|
|
(defun tacc-timer-state-forward ()
|
|
|
|
|
"Move the tacc timer state forward"
|
|
|
|
|
(interactive)
|
|
|
|
|
(if (tacc-running?)
|
|
|
|
|
(if (tacc-live?)
|
|
|
|
|
(let* ((state-place (assoc 'state tacc-info))
|
|
|
|
|
(state (cdr state-place))
|
|
|
|
|
(work-ts (assoc 'work-ts tacc-info))
|
|
|
|
|
@ -649,7 +717,7 @@ Returns the current tag if no prompt is made"
|
|
|
|
|
(defun tacc-timer-state-skip ()
|
|
|
|
|
"Move the tacc timer state to a new work cycle"
|
|
|
|
|
(interactive)
|
|
|
|
|
(if (tacc-running?)
|
|
|
|
|
(if (tacc-live?)
|
|
|
|
|
(let* ((state-place (assoc 'state tacc-info))
|
|
|
|
|
(work-ts (assoc 'work-ts tacc-info))
|
|
|
|
|
(end-ts (assoc 'end-ts tacc-info))
|
|
|
|
|
@ -675,26 +743,34 @@ Returns the current tag if no prompt is made"
|
|
|
|
|
(defun tacc-hold-timer ()
|
|
|
|
|
"Pause/unpause the tacc timer session"
|
|
|
|
|
(interactive)
|
|
|
|
|
(if (tacc-running?)
|
|
|
|
|
(if (tacc-session?)
|
|
|
|
|
(let ((state (alist-get 'state tacc-info)))
|
|
|
|
|
(if (eq state 'pause)
|
|
|
|
|
(tacc-unpause-timer)
|
|
|
|
|
(tacc-pause-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)))
|
|
|
|
|
(tacc-end-session))
|
|
|
|
|
|
|
|
|
|
;; 09 Hooks setup
|
|
|
|
|
|
|
|
|
|
(defun tacc-kill-emacs-confirm ()
|
|
|
|
|
"Ask for confirmation if a timer is still running"
|
|
|
|
|
(if (and (tacc-session?) ;; Redundant, but more re-use this way
|
|
|
|
|
(yes-or-no-p "You still have a work timer running, are you sure you want\
|
|
|
|
|
to quit emacs?"))
|
|
|
|
|
(tacc-end-session)
|
|
|
|
|
t))
|
|
|
|
|
|
|
|
|
|
;; 09 Hooks setup
|
|
|
|
|
(add-hook 'after-init-hook 'tacc-load-tag-history)
|
|
|
|
|
(add-hook 'kill-emacs-query-functions 'tacc-kill-emacs-confirm)
|
|
|
|
|
(add-hook 'kill-emacs-hook 'tacc-save-tag-history)
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
;; 10 Provides
|
|
|
|
|
|
|
|
|
|
(provide 'tacc)
|
|
|
|
|
|