brady
/
tacc
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Made core state structure buffer local, more idiomatic and denested logic

Browse Source
master
Brady McDonough 3 years ago
parent c6a96d6cca
commit bea9e8e11c
1 changed files with 75 additions and 84 deletions
Show Stats Download Patch File Download Diff File

125
tacc.el
Unescape View File

@ -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))
(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)))))
(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 . ""))
tacc-timer '()))
"State information related to the timer")
(defvar tacc-timer nil
"Timer object controlling tacc's second-by-second update")
;; 06.2 State checks
;; 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))))
"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)
nil))
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))))
(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))))
(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)) "<None>")
(concat "Tag: " (propertize (alist-get 'tag tacc-info "<None>")
'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))))
(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")))
(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)))
(kill-buffer))
;; 09 Hooks setup
(add-hook 'after-init-hook 'tacc-load-tag-history)

Write Preview
Loading…
Cancel
Save