diff --git a/tacc.el b/tacc.el index 86ff159..4206a25 100644 --- a/tacc.el +++ b/tacc.el @@ -32,13 +32,14 @@ ;; 01.1 Indexed settings variables ;; 01.2 Indexed face settings ;; 02 Error types -;; 03 Tag prompt text completion -;; 04 Sound -;; 05 Record keeping apparatus -;; 06.1 Timer buffer definiton -;; 06.2 Timer buffer state predicates, sanity checks -;; 06.3 Timer buffer state manipulators -;; 06.4 Timer buffer rendering +;; 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 @@ -150,13 +151,13 @@ "Failed to register a serialization, serializations must have unique names" 'tacc-error) -;; Behavior group +;; 03 Behavior group (defgroup tacc-behavior nil "Low level behavior settings for tacc" :group 'tacc :prefix "tacc-") -;; 03 Tag Prompts and Completion +;; 03.1 Tag prompts and completion (defvar tacc-tag-history nil "Tag name history, used for completions") @@ -185,7 +186,7 @@ Each function must have no required arguments and return a list of strings" tacc-tag-history "\n")))) -;; 04 Sound +;; 03.2 Sound (defcustom tacc-sound-tick (expand-file-name "tick.wav" tacc-dir) "The 'Tick' sound of the timer" @@ -216,7 +217,7 @@ It's best to use something asynchronous (like spawning a child emacs process)" function) :group 'tacc-behavior) -;; 05 Record Keeping +;; 04 Record keeping (defvar tacc-serials '() "A list of serialization functions keyed with names registered at runtime") @@ -250,7 +251,7 @@ registered" sym-name) (data (funcall fn records))) (run-hook-with-args (intern sym-name) data)))) -;; 06.1 Timer display buffer +;; 05 Timer display buffer (defvar tacc-timer-mode-map (let ((map (make-sparse-keymap))) map)) @@ -262,21 +263,28 @@ registered" sym-name) tacc-locs `((clock-start . ,(copy-marker 0)) (clock-end . ,(copy-marker 0)) (graph-start . ,(copy-marker 0)) - (graph-end . ,(copy-marker 0))) - tacc-info `((history . ()) - (cycle . ,(let ((ticker 0)) - (lambda (&optional state) - (cond ((eq state 'break) - (setq ticker (1+ ticker))) - ('t ticker))))) - (work-ts . nil) - (break-ts . nil) - (end-ts . nil) - (state . work) - (tag . "")) - tacc-timer '())) - -;; 06.2 State checks + (graph-end . ,(copy-marker 0))))) + +(defun cycle-ticker () + "A closure with an internal count, only increments when fed 'break timer state" + (let ((ticker 0)) + (lambda (&optional state) + (cond ((eq state 'break) (setq ticker (1+ ticker))) + ( 't ticker))))) + +(defvar tacc-info '((history . ()) + (cycle . ,(cycle-ticker)) + (work-ts . nil) + (break-ts . nil) + (end-ts . nil) + (state . work) + (tag . "")) + "State information related to the timer") + +(defvar tacc-timer nil + "Timer object controlling tacc's second-by-second update") + +;; 05.2 State checks (defun tacc-buffer () "Gets the tacc-timer buffer if there is one" @@ -284,7 +292,7 @@ registered" sym-name) (defun tacc-running? () "Checks if there is a live timer running" - (timerp (buffer-local-value 'tacc-timer (tacc-buffer)))) + (timerp tacc-timer)) (defun tacc-running-state? (state) "Checks if the state supplied indicates a live timer" @@ -295,53 +303,47 @@ registered" sym-name) ('t (signal 'tacc-error-illegal-buffer-state state)))) (defun tacc-invariant () - "Signals an illegal-buffer-state error or returns t" - (if (let ((buffer (tacc-buffer))) - (if (bufferp buffer) - (with-current-buffer buffer - (let ((timer (buffer-local-value 'tacc-timer buffer)) - (tacc-info (buffer-local-value 'tacc-info buffer))) - (eq (timerp (buffer-local-value 'tacc-timer buffer)) - (tacc-running-state? (alist-get 'state tacc-info)))) - t) - nil)) - t + "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 (timerp tacc-timer) + (tacc-running-state? tacc-info)) + 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) (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))) (if (eq state 'work) (tacc-work-period cycle) (tacc-break-period cycle)))) -;; 06.3 State manipulation -(defmacro tacc-with-buffer (&rest body) - "Execute the body in the tacc buffer. Expose tacc-info" - `(let ((buffer (tacc-buffer))) - (with-current-buffer buffer - (let ((tacc-info (buffer-local-value 'tacc-info buffer))) - ,@body)))) +;; 05.3 State manipulation (defun tacc-tick () "Time marches on. Called every second while a tacc timer is running" (let* ((now (current-time)) - (tacc-info (buffer-local-value 'tacc-info (tacc-buffer))) (state (alist-get 'state tacc-info)) (cycle (funcall (alist-get 'cycle tacc-info))) (work-ts (alist-get 'work-ts tacc-info)) @@ -357,22 +359,19 @@ registered" sym-name) (defun tacc-schedule () "Note the time and schedule the first tick" - (let ((tacc-info (buffer-local-value 'tacc-info (tacc-buffer)))) - (setcdr (assoc 'state tacc-info) 'work) - (setcdr (assoc 'work-ts tacc-info) (current-time)) - (setq-local tacc-timer (run-with-timer 't 1 'tacc-tick - :timer-max-repeats 1)))) + (setcdr (assoc 'state tacc-info) 'work) + (setcdr (assoc 'work-ts tacc-info) (current-time)) + (setq tacc-timer (run-with-timer 't 1 'tacc-tick + :timer-max-repeats 1))) (defun tacc-deschedule () "Deschedule the timer" - (let ((tacc-info (buffer-local-value 'tacc-info (tacc-buffer)))) - (setcdr (assoc 'end-ts tacc-info) (current-time)) - (setq-local tacc-timer (cancel-timer tacc-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* ((tacc-info (buffer-local-value 'tacc-info (tacc-buffer))) - (stack (assoc 'history tacc-info)) + (let* ((stack (assoc 'history tacc-info)) (work-ts (assoc 'work-ts tacc-info)) (break-ts (assoc 'break-ts tacc-info)) (end-ts (assoc 'end-ts tacc-info)) @@ -513,7 +512,7 @@ registered" sym-name) (defun tacc-current-tag-render () "Draw the tag name" - (concat "Tag: " (propertize (alist-get 'tag (buffer-local-value 'tacc-info (tacc-buffer)) "") + (concat "Tag: " (propertize (alist-get 'tag tacc-info "") 'tacc-tag))) (defun tacc-graph-bar-render (width work break void) @@ -535,21 +534,18 @@ float" (tacc-render-with-buffer (tacc-insert-between .clock-start .clock-end - (let-alist - (buffer-local-value 'tacc-info - (tacc-buffer)) + (let-alist tacc-info) (tacc-clock-render state .work-ts .end-ts now))) (tacc-insert-between .graph-start .graph-end (tacc-current-tag-render) - (let-alist (buffer-local-value 'tacc-info - (tacc-buffer)) + (let-alist tacc-info) (let* ((end (if (> now .end-ts) now .end-ts)) (total (- end .work-ts)) (work-prop (/ (- (if .break-ts .break-ts now) .work-ts) total)) (break-prop (/ (if .break-ts (- now .break-ts) 0) total)) (void-prop (- 1 (+ work-prop break-prop)))) - (tacc-graph-bar-render width work-prop break-prop void-prop)))))) + (tacc-graph-bar-render width work-prop break-prop void-prop)))) (defun tacc-new-graph-bar-render () (tacc-render-with-buffer @@ -568,16 +564,15 @@ float" "Orchestrates all initialization functions" (let ((tag (tacc-tag-prompt))) (tacc-init-timer-buffer) - (tacc-with-buffer - (setcdr (assoc 'tag tacc-info) tag) - (tacc-schedule)))) + (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 (buffer-local-value 'tacc-info (tacc-buffer))) + (alist-get 'tag tacc-info)) nil)) (completions (append (flatten-tree (apply 'eval (if tacc-tag-completion-functions @@ -592,13 +587,13 @@ float" 'stringp nil nil - 'tacc-tag-history))) + '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 (buffer-local-value 'tacc-info (tacc-buffer))) + (alist-get 'tag tacc-info) (tacc-tag-prompt))) ;; 08.2 Interactive @@ -614,15 +609,13 @@ Returns the current tag if no prompt is made" "Sets a tag for live timer sessions going forward" (interactive) (if (tacc-running?) - (tacc-with-buffer - (setcdr (assoc 'tag tacc-info) (tacc-tag-prompt))) - (message "There isn't a live timer session to tag"))) + (setcdr (assoc 'tag tacc-info) (tacc-tag-prompt))) + (message "There isn't a live timer session to tag")) (defun tacc-timer-state-forward () "Move the tacc timer state forward" (interactive) (if (tacc-running?) - (tacc-with-buffer (let* ((state-place (assoc 'state tacc-info)) (state (cdr state-place)) (work-ts (assoc 'work-ts tacc-info)) @@ -639,13 +632,12 @@ Returns the current tag if no prompt is made" (tacc-new-graph-bar-render))) (funcall (alist-get 'cycle tacc-info) state) ) - (message "There is no timer to advance")))) + (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?) - (tacc-with-buffer (let* ((state-place (assoc 'state tacc-info)) (state (cdr state-place)) (work-ts (assoc 'work-ts tacc-info)) @@ -656,13 +648,13 @@ Returns the current tag if no prompt is made" (funcall (alist-get 'cycle tacc-info) 'break) (setcdr work-ts ts) (setcdr state-place 'work) - (tacc-new-graph-bar-render))))) + (tacc-new-graph-bar-render)))) (defun tacc-pause-timer () "Pause the tacc timer session" (tacc-deschedule) (tacc-push-current) - (setcdr (assoc 'state (buffer-local-value 'tacc-info (tacc-buffer))) 'pause)) + (setcdr (assoc 'state tacc-info) 'pause)) (defun tacc-unpause-timer () "Unpause the tacc timer session" @@ -683,12 +675,11 @@ Returns the current tag if no prompt is made" (defun tacc-end-timer () "Ends the current timer session, runs serialization and kills the buffer" (interactive) - (tacc-with-buffer - (tacc-deschedule) - (tacc-push-current) - (tacc-save-record (assoc 'history tacc-info)) - (setcdr (assoc 'state tacc-info) 'stop) - (kill-buffer))) + (tacc-deschedule) + (tacc-push-current) + (tacc-save-record (assoc 'history tacc-info)) + (setcdr (assoc 'state tacc-info) 'stop) + (kill-buffer)) ;; 09 Hooks setup (add-hook 'after-init-hook 'tacc-load-tag-history)