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

Initial commit, begin cleanup!

Browse Source
master
Brady McDonough 3 years ago
commit 5f63fa6587
6 changed files with 766 additions and 0 deletions
Show Stats Download Patch File Download Diff File

61
Makefile
Unescape View File

@ -0,0 +1,61 @@
BASE_PKG = tacc-pkg.el
DEFINE_PACKAGE = $(shell sed 's/"/\\"/g' $(BASE_PKG))
NAME_SCRIPT = "(princ (cadr '$(DEFINE_PACKAGE)))"
VERSION_SCRIPT = "(princ (caddr '$(DEFINE_PACKAGE)))"
EMACS := $(shell command -v emacs 2> /dev/null)
ifndef EMACS
EMACS = $(error "emacs installation not found in PATH")
endif
EMACS_BATCH = $(EMACS) --batch --eval
NAME = $(shell $(EMACS_BATCH) $(NAME_SCRIPT))
MAIN_EL = $(NAME).el
VERSION = $(shell $(EMACS_BATCH) $(VERSION_SCRIPT))
QUALIFIED_NAME = $(NAME)-$(VERSION)
PACKAGE = $(QUALIFIED_NAME).tar
SUPPLEMENTAL = chime.wav tick.wav tags-history
SUPPLEMENTAL_NESTED = $(SUPPLEMENTAL:%=$(QUALIFIED_NAME)/%)
INSTALL_SCRIPT = "(package-install-file \"./$(PACKAGE)\")"
DELETE_SCRIPT = "(progn (package-initialize) (package-delete \"$(NAME)\"))"
all: $(PACKAGE)
.PHONY: all load-test install uninstall cleanup clean
.SILENT:
$(QUALIFIED_NAME):
echo "Making package directory"
mkdir $(QUALIFIED_NAME)
$(QUALIFIED_NAME)/$(MAIN_EL) $(QUALIFIED_NAME)/$(BASE_PKG) $(SUPPLEMENTAL_NESTED): $(QUALIFIED_NAME)/%: % $(QUALIFIED_NAME)
cp -v $< $(QUALIFIED_NAME)
$(PACKAGE): load-test $(SUPPLEMENTAL_NESTED) $(QUALIFIED_NAME)/$(BASE_PKG) $(QUALIFIED_NAME)/$(MAIN_EL)
echo "Packing..."
tar -cf $(PACKAGE) $(QUALIFIED_NAME)
echo "Done. $(PACKAGE) is a portable emacs package"
load-test:
echo "Checking script correctness"
$(EMACS) -q -nw --script $(MAIN_EL)
install: $(PACKAGE)
echo "Installing..."
$(EMACS_BATCH) $(INSTALL_SCRIPT)
echo "$(PACKAGE) installed."
# There's no good uninstall?
uninstall:
echo "There is no good way to uninstall an emacs package from command line."
echo "You need to run M-x package-delete $(NAME) from inside emacs."
echo "Sorry :/"
# Cleanup gets rid intermediates and clutter, never the target
cleanup:
rm -rfv $(QUALIFIED_NAME)
rm -fv *~
# Clean leaves the source tree in it's base state
clean: cleanup
rm -fv $(PACKAGE)

BIN
chime.wav
View File

Binary file not shown.

4
tacc-pkg.el
Unescape View File

@ -0,0 +1,4 @@
(define-package
"tacc"
"0.0.1"
"A pomidoro timer supporting tags, custom timer length and data export")

701
tacc.el
Unescape View File

@ -0,0 +1,701 @@
;;; tacc.el --- A pomidoro timer supporting tags and customizable export
;; Author: Brady McDonough <me@bradymcd.ca>
;; URL: git.bradymcd.ca/tacc
;; Keywords: tools, time, pomodoro, 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 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
;; 07 Initialization
;; 08.1 Interactive helpers
;; 08.2 Interactive functions
;; 09 Hooks registration
;; 10 Provides
;;; Code:
;;; -*- lexical-binding: t -*-
;; 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 pomodoro round"
:type 'integer :group 'tacc)
(defcustom tacc-work-seconds-increment (m:s 5 0)
"The time to add to each successive work cycle"
:type 'integer :group 'tacc)
(defcustom tacc-break-seconds (m:s 7 0)
"The length of a base break round"
:type 'integer :group 'tacc)
(defcustom tacc-break-seconds-increment (m:s 1 30)
"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 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)
;; Behavior group
(defgroup tacc-behavior nil
"Low level behavior settings for tacc"
:group 'tacc
:prefix "tacc-")
;; 03 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"))))
;; 04 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 using an asynchronous subprocess"
(if (fboundp 'play-sound-internal)
(start-process "tacc-play-sound"
tacc-buffer-name
(car command-line-args)
"-Q"
"--batch"
"--eval" (format "(play-sound-file \"%s\")" file))
(warn "Emacs lacks builtin sound support")))
(defcustom tacc-play-sound-file #'tacc-play-sound-file-emacs
"Function used to play sounds. Set to nil to disable sound.
It's best to use something asynchronous (like spawning a child emacs process)"
:type '(choice (const nil)
function)
:group 'tacc-behavior)
;; 05 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))))
;; 06.1 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 lexical-binding t
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
(defun tacc-buffer ()
"Gets the tacc-timer buffer if there is one"
(get-buffer tacc-buffer-name))
(defun tacc-running? ()
"Checks if there is a live timer running"
(timerp (buffer-local-value 'tacc-timer (tacc-buffer))))
(defun tacc-running-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-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
(signal 'tacc-error-illegal-buffer-state (tacc-buffer))))
(defun tacc-chime-p (countdown-ts)
(if (time-less-p countdown-ts 0)
(mod (time-to-seconds countdown-ts)
tacc-chime-interval)))
(defun tacc-work-period (cycle)
(+ tacc-work-seconds
(* cycle tacc-work-seconds-increment)))
(defun tacc-break-period (cycle)
(+ tacc-break-seconds
(* cycle tacc-break-seconds-increment)))
(defun tacc-start-ts (state work-ts break-ts)
(if (eq state 'work) work-ts break-ts))
(defun tacc-est-ts (state cycle work-ts break-ts)
(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))))
(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))
(break-ts (alist-get 'break-ts tacc-info))
(start-ts (tacc-start-ts state work-ts break-ts))
(est (tacc-est-ts state cycle work-ts break-ts))
(countdown (time-subtract est now)))
(tacc-timer-buffer-update state now )
(if 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-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))))
(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))))
(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))
(work-ts (assoc 'work-ts tacc-info))
(break-ts (assoc 'break-ts tacc-info))
(end-ts (assoc 'end-ts tacc-info))
(tag (alist-get 'tag tacc-info)))
(if work-ts
(push `((ts . ,work-ts)
(end . ,(if (cdr break-ts)
(cdr break-ts)
(cdr end-ts)))
(state . work)
(tag . ,(cdr tag)))
(cdr stack)))
(if break-ts
(push `((ts . ,(cdr break-ts))
(end . ,(cdr end-ts))
(state . break)
(tag . ,tag))
(cdr stack)))
(setcdr work-ts nil)
(setcdr break-ts nil)
(setcdr end-ts 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.")))
(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))
(lambda (c) (let ((rem (mod width (length chars)))
(len (/ width (length chars))))
(make-string (progn (setf ticker (1+ ticker))
(+ len (if (<= 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))
(defun tacc-spacer-render (width)
"Returns a string for spacing vertically"
"\n")
(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)
(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
(let ((ts (current-time)))
(tacc-clock-render 'work ts ts ts)))
(insert (tacc-spacer-render width))
(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"
(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 start est now)
"Draw the clock"
(let* ((elapsed (time-subtract now start))
(overwork (time-less-p elapsed est))
(countdown (if overwork (time-subtract elapsed est)
(time-subtract est elapsed)))
(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) 'tacc-clock)
(propertize (format-time-string count-fmt count-face))
(propertize (tacc-clock-glyph state) 'tacc-clock))))
(defun tacc-current-tag-render ()
"Draw the tag name"
(concat "Tag: " (propertize (alist-get 'tag (buffer-local-value 'tacc-info (tacc-buffer)) "<None>")
'tacc-tag)))
(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 2)))
(concat
""
(propertize (make-string (round (* width work)) tacc-graph-char)
'tacc-graph-work)
(propertize (make-string (round (* width break)) tacc-graph-char)
'tacc-graph-break)
(propertize (make-string (round (* width void)) tacc-graph-char)
'tacc-graph-void)
" \n")))
(defun tacc-timer-buffer-update (state now)
"Update the timer buffer rendering"
(tacc-render-with-buffer
(tacc-insert-between
.clock-start .clock-end
(let-alist
(buffer-local-value 'tacc-info
(tacc-buffer))
(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* ((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))))))
(defun tacc-new-graph-bar-render ()
(tacc-render-with-buffer
(save-restriction
(narrow-to-region .graph-start .graph-start)
(goto-char (point-min))
(insert (tacc-current-tag-render)
(tacc-graph-bar-render width 0 0 1)
"\n")
(set-marker .graph-start (point-min))
(set-marker .graph-end (point-max)))))
;; 07 Init
(defun tacc-init ()
"Orchestrates all initialization functions"
(let ((tag (tacc-tag-prompt)))
(tacc-init-timer-buffer)
(tacc-with-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 (buffer-local-value 'tacc-info (tacc-buffer)))
nil))
(completions (append (flatten-tree
(apply 'eval (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 (buffer-local-value 'tacc-info (tacc-buffer)))
(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?)
(tacc-with-buffer
(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))
(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)))
(funcall (alist-get 'cycle tacc-info) 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?)
(tacc-with-buffer
(let* ((state-place (assoc 'state tacc-info))
(state (cdr state-place))
(work-ts (assoc 'work-ts tacc-info))
(end-ts (assoc 'end-ts tacc-info))
(ts (current-time)))
(setcdr end-ts ts)
(tacc-push-current)
(funcall (alist-get 'cycle tacc-info) '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 (buffer-local-value 'tacc-info (tacc-buffer))) '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?)
(tacc-with-buffer
(let ((state (alist-get 'state tacc-info)))
(if (eq state 'pause)
(tacc-unpause-timer)
(tacc-pause-timer))))
(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-with-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)
(add-hook 'kill-emacs-hook 'tacc-save-tag-history)
;; 10 Provides
(provide 'tacc)
;;; tacc.el ends here

0
tags-history
Unescape View File

BIN
tick.wav
View File

Binary file not shown.
Write Preview
Loading…
Cancel
Save