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

159
tacc.el
Unescape View File

@ -32,13 +32,14 @@
;; 01.1 Indexed settings variables ;; 01.1 Indexed settings variables
;; 01.2 Indexed face settings ;; 01.2 Indexed face settings
;; 02 Error types ;; 02 Error types
;; 03 Tag prompt text completion ;; 03 Behaviour group
;; 04 Sound ;; 03.1 Tag prompt text completion
;; 05 Record keeping apparatus ;; 03.2 Sound
;; 06.1 Timer buffer definiton ;; 04 Record keeping
;; 06.2 Timer buffer state predicates, sanity checks ;; 05 Timer display buffer
;; 06.3 Timer buffer state manipulators ;; 05.2 State checks
;; 06.4 Timer buffer rendering ;; 05.3 State manipulation
;; 05.4 Timer buffer rendering
;; 07 Initialization ;; 07 Initialization
;; 08.1 Interactive helpers ;; 08.1 Interactive helpers
;; 08.2 Interactive functions ;; 08.2 Interactive functions
@ -150,13 +151,13 @@
"Failed to register a serialization, serializations must have unique names" "Failed to register a serialization, serializations must have unique names"
'tacc-error) 'tacc-error)
;; Behavior group ;; 03 Behavior group
(defgroup tacc-behavior nil (defgroup tacc-behavior nil
"Low level behavior settings for tacc" "Low level behavior settings for tacc"
:group 'tacc :group 'tacc
:prefix "tacc-") :prefix "tacc-")
;; 03 Tag Prompts and Completion ;; 03.1 Tag prompts and completion
(defvar tacc-tag-history nil (defvar tacc-tag-history nil
"Tag name history, used for completions") "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 tacc-tag-history
"\n")))) "\n"))))
;; 04 Sound ;; 03.2 Sound
(defcustom tacc-sound-tick (defcustom tacc-sound-tick
(expand-file-name "tick.wav" tacc-dir) (expand-file-name "tick.wav" tacc-dir)
"The 'Tick' sound of the timer" "The 'Tick' sound of the timer"
@ -216,7 +217,7 @@ It's best to use something asynchronous (like spawning a child emacs process)"
function) function)
:group 'tacc-behavior) :group 'tacc-behavior)
;; 05 Record Keeping ;; 04 Record keeping
(defvar tacc-serials '() (defvar tacc-serials '()
"A list of serialization functions keyed with names registered at runtime") "A list of serialization functions keyed with names registered at runtime")
@ -250,7 +251,7 @@ registered" sym-name)
(data (funcall fn records))) (data (funcall fn records)))
(run-hook-with-args (intern sym-name) data)))) (run-hook-with-args (intern sym-name) data))))
;; 06.1 Timer display buffer ;; 05 Timer display buffer
(defvar tacc-timer-mode-map (defvar tacc-timer-mode-map
(let ((map (make-sparse-keymap))) (let ((map (make-sparse-keymap)))
map)) map))
@ -262,21 +263,28 @@ registered" sym-name)
tacc-locs `((clock-start . ,(copy-marker 0)) tacc-locs `((clock-start . ,(copy-marker 0))
(clock-end . ,(copy-marker 0)) (clock-end . ,(copy-marker 0))
(graph-start . ,(copy-marker 0)) (graph-start . ,(copy-marker 0))
(graph-end . ,(copy-marker 0))) (graph-end . ,(copy-marker 0)))))
tacc-info `((history . ())
(cycle . ,(let ((ticker 0)) (defun cycle-ticker ()
(lambda (&optional state) "A closure with an internal count, only increments when fed 'break timer state"
(cond ((eq state 'break) (let ((ticker 0))
(setq ticker (1+ ticker))) (lambda (&optional state)
('t ticker))))) (cond ((eq state 'break) (setq ticker (1+ ticker)))
(work-ts . nil) ( 't ticker)))))
(break-ts . nil)
(end-ts . nil) (defvar tacc-info '((history . ())
(state . work) (cycle . ,(cycle-ticker))
(tag . "")) (work-ts . nil)
tacc-timer '())) (break-ts . nil)
(end-ts . nil)
;; 06.2 State checks (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 () (defun tacc-buffer ()
"Gets the tacc-timer buffer if there is one" "Gets the tacc-timer buffer if there is one"
@ -284,7 +292,7 @@ registered" sym-name)
(defun tacc-running? () (defun tacc-running? ()
"Checks if there is a live timer 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) (defun tacc-running-state? (state)
"Checks if the state supplied indicates a live timer" "Checks if the state supplied indicates a live timer"
@ -295,53 +303,47 @@ registered" sym-name)
('t (signal 'tacc-error-illegal-buffer-state state)))) ('t (signal 'tacc-error-illegal-buffer-state state))))
(defun tacc-invariant () (defun tacc-invariant ()
"Signals an illegal-buffer-state error or returns t" "Returns t if tacc is in a legal state for mutating tacc-info
(if (let ((buffer (tacc-buffer))) Note, if there is no tacc-buffer then you shouldn't be touching tacc-info"
(if (bufferp buffer) (if (bufferp (tacc-buffer))
(with-current-buffer buffer (if (and (timerp tacc-timer)
(let ((timer (buffer-local-value 'tacc-timer buffer)) (tacc-running-state? tacc-info))
(tacc-info (buffer-local-value 'tacc-info buffer))) t)
(eq (timerp (buffer-local-value 'tacc-timer buffer))
(tacc-running-state? (alist-get 'state tacc-info))))
t)
nil))
t
(signal 'tacc-error-illegal-buffer-state (tacc-buffer)))) (signal 'tacc-error-illegal-buffer-state (tacc-buffer))))
;; 05.3 Predicates and helpers
(defun tacc-chime-p (countdown-ts) (defun tacc-chime-p (countdown-ts)
"Should I play a chime on this second?"
(if (time-less-p countdown-ts 0) (if (time-less-p countdown-ts 0)
(mod (time-to-seconds countdown-ts) (mod (time-to-seconds countdown-ts)
tacc-chime-interval))) tacc-chime-interval)))
(defun tacc-work-period (cycle) (defun tacc-work-period (cycle)
"How long is the current work period?"
(+ tacc-work-seconds (+ tacc-work-seconds
(* cycle tacc-work-seconds-increment))) (* cycle tacc-work-seconds-increment)))
(defun tacc-break-period (cycle) (defun tacc-break-period (cycle)
"How long is the current break period?"
(+ tacc-break-seconds (+ tacc-break-seconds
(* cycle tacc-break-seconds-increment))) (* cycle tacc-break-seconds-increment)))
(defun tacc-start-ts (state work-ts break-ts) (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)) (if (eq state 'work) work-ts break-ts))
(defun tacc-est-ts (state cycle 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))) (let ((start-ts (tacc-start-ts state work-ts break-ts)))
(if (eq state 'work) (if (eq state 'work)
(tacc-work-period cycle) (tacc-work-period cycle)
(tacc-break-period cycle)))) (tacc-break-period cycle))))
;; 06.3 State manipulation ;; 05.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))))
(defun tacc-tick () (defun tacc-tick ()
"Time marches on. Called every second while a tacc timer is running" "Time marches on. Called every second while a tacc timer is running"
(let* ((now (current-time)) (let* ((now (current-time))
(tacc-info (buffer-local-value 'tacc-info (tacc-buffer)))
(state (alist-get 'state tacc-info)) (state (alist-get 'state tacc-info))
(cycle (funcall (alist-get 'cycle tacc-info))) (cycle (funcall (alist-get 'cycle tacc-info)))
(work-ts (alist-get 'work-ts tacc-info)) (work-ts (alist-get 'work-ts tacc-info))
@ -357,22 +359,19 @@ registered" sym-name)
(defun tacc-schedule () (defun tacc-schedule ()
"Note the time and schedule the first tick" "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 'state tacc-info) 'work) (setcdr (assoc 'work-ts tacc-info) (current-time))
(setcdr (assoc 'work-ts tacc-info) (current-time)) (setq tacc-timer (run-with-timer 't 1 'tacc-tick
(setq-local tacc-timer (run-with-timer 't 1 'tacc-tick :timer-max-repeats 1)))
:timer-max-repeats 1))))
(defun tacc-deschedule () (defun tacc-deschedule ()
"Deschedule the timer" "Deschedule the timer"
(let ((tacc-info (buffer-local-value 'tacc-info (tacc-buffer)))) (setcdr (assoc 'end-ts tacc-info) (current-time))
(setcdr (assoc 'end-ts tacc-info) (current-time)) (setq tacc-timer (cancel-timer tacc-timer)))
(setq-local tacc-timer (cancel-timer tacc-timer))))
(defun tacc-push-current () (defun tacc-push-current ()
"Push the current period into the record" "Push the current period into the record"
(let* ((tacc-info (buffer-local-value 'tacc-info (tacc-buffer))) (let* ((stack (assoc 'history tacc-info))
(stack (assoc 'history tacc-info))
(work-ts (assoc 'work-ts tacc-info)) (work-ts (assoc 'work-ts tacc-info))
(break-ts (assoc 'break-ts tacc-info)) (break-ts (assoc 'break-ts tacc-info))
(end-ts (assoc 'end-ts tacc-info)) (end-ts (assoc 'end-ts tacc-info))
@ -513,7 +512,7 @@ registered" sym-name)
(defun tacc-current-tag-render () (defun tacc-current-tag-render ()
"Draw the tag name" "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))) 'tacc-tag)))
(defun tacc-graph-bar-render (width work break void) (defun tacc-graph-bar-render (width work break void)
@ -535,21 +534,18 @@ float"
(tacc-render-with-buffer (tacc-render-with-buffer
(tacc-insert-between (tacc-insert-between
.clock-start .clock-end .clock-start .clock-end
(let-alist (let-alist tacc-info)
(buffer-local-value 'tacc-info
(tacc-buffer))
(tacc-clock-render state .work-ts .end-ts now))) (tacc-clock-render state .work-ts .end-ts now)))
(tacc-insert-between (tacc-insert-between
.graph-start .graph-end .graph-start .graph-end
(tacc-current-tag-render) (tacc-current-tag-render)
(let-alist (buffer-local-value 'tacc-info (let-alist tacc-info)
(tacc-buffer))
(let* ((end (if (> now .end-ts) now .end-ts)) (let* ((end (if (> now .end-ts) now .end-ts))
(total (- end .work-ts)) (total (- end .work-ts))
(work-prop (/ (- (if .break-ts .break-ts now) .work-ts) total)) (work-prop (/ (- (if .break-ts .break-ts now) .work-ts) total))
(break-prop (/ (if .break-ts (- now .break-ts) 0) total)) (break-prop (/ (if .break-ts (- now .break-ts) 0) total))
(void-prop (- 1 (+ work-prop break-prop)))) (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 () (defun tacc-new-graph-bar-render ()
(tacc-render-with-buffer (tacc-render-with-buffer
@ -568,16 +564,15 @@ float"
"Orchestrates all initialization functions" "Orchestrates all initialization functions"
(let ((tag (tacc-tag-prompt))) (let ((tag (tacc-tag-prompt)))
(tacc-init-timer-buffer) (tacc-init-timer-buffer)
(tacc-with-buffer (setcdr (assoc 'tag tacc-info) tag)
(setcdr (assoc 'tag tacc-info) tag) (tacc-schedule)))
(tacc-schedule))))
;; 08.1 Interactive Helpers ;; 08.1 Interactive Helpers
(defun tacc-tag-prompt () (defun tacc-tag-prompt ()
"Prompt for a tag and return the user's input" "Prompt for a tag and return the user's input"
(let ((last-tag (if (bufferp (tacc-buffer)) (let ((last-tag (if (bufferp (tacc-buffer))
(alist-get 'tag (buffer-local-value 'tacc-info (tacc-buffer))) (alist-get 'tag tacc-info))
nil)) nil))
(completions (append (flatten-tree (completions (append (flatten-tree
(apply 'eval (if tacc-tag-completion-functions (apply 'eval (if tacc-tag-completion-functions
@ -592,13 +587,13 @@ float"
'stringp 'stringp
nil nil
nil nil
'tacc-tag-history))) 'tacc-tag-history))
(defun tacc-tag-prompt-soft () (defun tacc-tag-prompt-soft ()
"Prompt for a tag unless the user doesn't want us to "Prompt for a tag unless the user doesn't want us to
Returns the current tag if no prompt is made" Returns the current tag if no prompt is made"
(if tacc-suppress-tag-prompt (if tacc-suppress-tag-prompt
(alist-get 'tag (buffer-local-value 'tacc-info (tacc-buffer))) (alist-get 'tag tacc-info)
(tacc-tag-prompt))) (tacc-tag-prompt)))
;; 08.2 Interactive ;; 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" "Sets a tag for live timer sessions going forward"
(interactive) (interactive)
(if (tacc-running?) (if (tacc-running?)
(tacc-with-buffer (setcdr (assoc 'tag tacc-info) (tacc-tag-prompt)))
(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 () (defun tacc-timer-state-forward ()
"Move the tacc timer state forward" "Move the tacc timer state forward"
(interactive) (interactive)
(if (tacc-running?) (if (tacc-running?)
(tacc-with-buffer
(let* ((state-place (assoc 'state tacc-info)) (let* ((state-place (assoc 'state tacc-info))
(state (cdr state-place)) (state (cdr state-place))
(work-ts (assoc 'work-ts tacc-info)) (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))) (tacc-new-graph-bar-render)))
(funcall (alist-get 'cycle tacc-info) state) (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 () (defun tacc-timer-state-skip ()
"Move the tacc timer state to a new work cycle" "Move the tacc timer state to a new work cycle"
(interactive) (interactive)
(if (tacc-running?) (if (tacc-running?)
(tacc-with-buffer
(let* ((state-place (assoc 'state tacc-info)) (let* ((state-place (assoc 'state tacc-info))
(state (cdr state-place)) (state (cdr state-place))
(work-ts (assoc 'work-ts tacc-info)) (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) (funcall (alist-get 'cycle tacc-info) 'break)
(setcdr work-ts ts) (setcdr work-ts ts)
(setcdr state-place 'work) (setcdr state-place 'work)
(tacc-new-graph-bar-render))))) (tacc-new-graph-bar-render))))
(defun tacc-pause-timer () (defun tacc-pause-timer ()
"Pause the tacc timer session" "Pause the tacc timer session"
(tacc-deschedule) (tacc-deschedule)
(tacc-push-current) (tacc-push-current)
(setcdr (assoc 'state (buffer-local-value 'tacc-info (tacc-buffer))) 'pause)) (setcdr (assoc 'state tacc-info) 'pause))
(defun tacc-unpause-timer () (defun tacc-unpause-timer ()
"Unpause the tacc timer session" "Unpause the tacc timer session"
@ -683,12 +675,11 @@ Returns the current tag if no prompt is made"
(defun tacc-end-timer () (defun tacc-end-timer ()
"Ends the current timer session, runs serialization and kills the buffer" "Ends the current timer session, runs serialization and kills the buffer"
(interactive) (interactive)
(tacc-with-buffer (tacc-deschedule)
(tacc-deschedule) (tacc-push-current)
(tacc-push-current) (tacc-save-record (assoc 'history tacc-info))
(tacc-save-record (assoc 'history tacc-info)) (setcdr (assoc 'state tacc-info) 'stop)
(setcdr (assoc 'state tacc-info) 'stop) (kill-buffer))
(kill-buffer)))
;; 09 Hooks setup ;; 09 Hooks setup
(add-hook 'after-init-hook 'tacc-load-tag-history) (add-hook 'after-init-hook 'tacc-load-tag-history)

Write Preview
Loading…
Cancel
Save