(require 'widget)
(defgroup workout-tracker nil
"Workout tracker."
:prefix "workout-tracker-"
:group 'applications)
(defvar workout-tracker-data
nil
"Buffer local database of workout tracking data.")
(make-variable-buffer-local 'workout-tracker-data)
(defvar workout-tracker-data-file
nil
"Buffer local data file (to store workout data).")
(make-variable-buffer-local 'workout-tracker-data-file)
(defvar workout-tracker-data-file-extension
".wtd"
"Data file extension, including period.")
(defvar workout-tracker-data-file-extension-match
(concat
(replace-regexp-in-string "\\." "\\\\\." workout-tracker-data-file-extension)
"$")
"Data file extension match.")
(defcustom workout-tracker-data-dir
(expand-file-name "~/.workout-tracker")
"Directory to store workout data files."
:type 'directory
:group 'workout-traker)
(defvar workout-tracker-buffer-name-prefix
"workout-tracker"
"Buffer name (prefix) to use for workout tracker.")
(defvar workout-tracker-select-server-buffer-name
"*Workout-Tracker-Select-Server*"
"Buffer name to use for select server menu.")
(defvar workout-tracker-buffers
nil
"Association list of active workout tracker buffers and their files.
\nList is in the following format:
((FILE . BUFFER) ...)")
(defmacro workout-tracker-set-data (data)
"Set local `workout-tracker-data' to DATA."
`(setq workout-tracker-data ,data))
(defmacro workout-tracker-file-name (file)
"Returns FILE sans directory and extension parts."
`(file-name-sans-extension (file-name-nondirectory ,file)))
(defmacro workout-tracker-set-data-file (file)
"Set local `workout-tracker-data-file' to FILE."
`(setq workout-tracker-data-file ,file))
(defun workout-tracker-buffer-name (file)
"Generate buffer name from `workout-tracker-buffer-name-prefix' and FILE."
(concat workout-tracker-buffer-name-prefix ":" (workout-tracker-file-name file)))
(defun workout-tracker-set-data-file-extension (extension)
"Set `workout-tracker-data-file-extension' and `workout-tracker-data-file-extension-match'."
(setq workout-tracker-data-file-extension extension)
(setq workout-tracker-data-file-extension-match
(concat
(replace-regexp-in-string "\\." "\\\\\." workout-tracker-data-file-extension)
"$")))
(defun workout-tracker-switch-to-data-file (file)
"Return buffer of and switches to an existing data FILE.
\nReturn nil if not found."
(interactive "F")
(let ((buffer (assoc file workout-tracker-buffers)))
(when buffer
(switch-to-buffer (cdr buffer))
(cdr buffer))))
(defun workout-tracker-load-data-file (file)
"Load data FILE."
(interactive "F")
(let ((file (expand-file-name file))
data
buffer)
(unless (workout-tracker-switch-to-data-file file)
(if (file-exists-p file)
(progn
(with-temp-buffer
(insert-file-contents file)
(setq data (buffer-substring-no-properties (point-min) (point-max))))
(setq buffer (get-buffer-create (workout-tracker-buffer-name file)))
(switch-to-buffer buffer)
(workout-tracker-set-file file)
(workout-tracker-set-data (eval data)))
(message "Data file not found: %s" file)))))
(defun workout-tracker-save-data-file (file)
"Save data FILE."
(interactive "F")
(let ((dir (file-name-directory file)))
(unless (file-directory-p dir)
(make-directory dir t)))
(let ((file (expand-file-name file)))
(with-temp-buffer
(workout-tracker-set-file file)
(when (and (boundp 'workout-tracker-database)
workout-tracker-database)
(insert workout-tracker-database))
(write-file file))))
(defun workout-tracker-create-data-file (file)
"Create empty data FILE.
\nIf FILE already exists, user is prompted to overwrite."
(interactive "F")
(unless (workout-tracker-switch-to-data-file file)
(with-temp-buffer
(workout-tracker-set-file file)
(workout-tracker-set-data nil)
(workout-tracker-save-data-file file))))
(defun workout-tracker-open-data-file (file)
"Open data FILE."
(interactive "F")
(unless (workout-tracker-switch-to-data-file file)
(workout-tracker-load-data-file file)
)
(defun workout-tracker-dir-files (dir &optional match)
"List all files in directory DIR that match pattern MATCH."
(setq dir (expand-file-name dir))
(when (file-directory-p dir)
(let ((match (or match ".*"))
items (files (nreverse (directory-files dir t)))) (dolist (file files)
(when (file-readable-p file)
(cond
((string-match "^\\.\\.?$" (file-name-nondirectory file))
t)
((string-match match file)
(unless (file-directory-p file)
(let ((file-name (file-name-sans-extension (file-name-nondirectory file))))
(push (list
file-name
file)
items)))
t))))
items)))
(defun workout-tracker (&optional file)
"Start workout tracking.
\nIf FILE is given, use that workout data file.
Otherwise, call `workout-tracker-select-data-file'."
(interactive)
(if file
(workout-tracker-open-data-file file)
(workout-tracker-select-data-file)))
(defvar widget-data-file)
(defun workout-tracker-select-data-file ()
"Present a list of data files the user may select from."
(interactive)
(when (get-buffer workout-tracker-select-server-buffer-name)
(kill-buffer workout-tracker-select-server-buffer-name))
(let ((buffer (get-buffer-create workout-tracker-select-server-buffer-name)))
(set-buffer buffer)
(kill-all-local-variables)
(widget-insert "Workout Tracker\n\n")
(widget-insert "Select an existing data file or create a new one:\n\n")
(let ((files (workout-tracker-dir-files workout-tracker-data-dir workout-tracker-data-file-extension-match)))
(dolist (file files)
(widget-create 'push-button
:value (car file)
:notify (lambda (widget &rest ignore)
(let* ((value (widget-value widget))
(file (expand-file-name (concat value workout-tracker-data-file-extension)
workout-tracker-data-dir)))
(kill-buffer nil)
(workout-tracker-open-data-file file))))
(widget-insert "\n"))
(widget-insert "\n"))
(make-local-variable 'widget-data-file)
(widget-insert "Data File: ")
(widget-create 'editable-field
:size 40
:notify (lambda (widget &rest ignore)
(let* ((value (widget-value widget))
(len-value (length value))
(len-ext (length workout-tracker-data-file-extension)))
(setq widget-data-file
(expand-file-name (concat value workout-tracker-data-file-extension)
workout-tracker-data-dir))
(when (and (> len-value len-ext)
(string= (substring value (- 0 len-ext))
workout-tracker-data-file-extension))
(setq widget-data-file (substring file 0 (- 0 len-ext)))))))
(widget-insert " ")
(widget-create 'push-button
:value "Create"
:notify (lambda (widget &rest ignore)
(let ((file widget-data-file))
(if (file-exists-p file)
(message "File already exists: %s" file)
(progn
(kill-buffer nil)
(workout-tracker-create-data-file file))))))
(widget-insert "\n")
(use-local-map widget-keymap)
(widget-setup)
(switch-to-buffer buffer)
(goto-char (point-min))
(widget-forward 1))))
(provide 'workout-tracker)