123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144 |
- ;;; track-values.el --- Track calorie values for various foods
- ;; Copyright (C) 2020 Samuel W. Flint <swflint@flintfam.org>
- ;; author: Samuel W. Flint <swflint@flintfam.org>
- ;; Version: 0.1
- ;; Keywords: diet, tracking
- ;; URL: https://git.sr.ht/~swflint/track-calorie-values
- ;; This file is NOT part of Emacs.
- ;;
- ;; This file is licensed under the GNU GPLv3 or later.
- ;;; Commentary:
- ;;
- ;;; Code:
- (require 'cl-lib)
- ;;; Customizeable values
- (defgroup track-values nil
- "Track calorie values for various foods"
- :tag "Track Calorie Values"
- :group 'org
- :link '(url-link "https://git.sr.ht/~swflint/track-calorie-values")
- :prefix "track-values-")
- (defcustom track-values-save-file
- (locate-user-emacs-file "track-values-data.el")
- "File to store calorie values of food items."
- :type '(file :must-match t))
- ;;; Hashing
- ;; Taken from emacs documentation
- (defun case-fold-string= (a b)
- (eq t (compare-strings a nil nil b nil nil t)))
- (defun case-fold-string-hash (a)
- (sxhash-equal (upcase a)))
- (define-hash-table-test 'case-fold
- 'case-fold-string= 'case-fold-string-hash)
- ;;; Internal Data
- (defvar track-values-tables (list)
- "List of known track-values tables.")
- (defvar track-values-loaded-p nil
- "Have values been loaded?")
- (defvar track-values-modified-p t
- "Have values been modified?")
- (defvar track-values-current-key nil
- "Current item being recorded.")
- ;;; Table creation
- (defun track-values-make-table (name &optional pairs)
- (pushnew name track-values-tables)
- (let ((table-name (intern (format "track-values-%s-table" name)))
- (prompt-name (intern (format "track-values-%s-keys" name))))
- (set table-name (make-hash-table :weakness nil :test 'case-fold))
- (set prompt-name (mapcar #'first pairs))
- (mapcar #'(lambda (x) (puthash (first x) (second x) (symbol-value table-name))) pairs)
- (setf track-values-modified-p t)))
- ;;; Get and set values
- (defun track-values-get-value (table key)
- (gethash key (symbol-value (intern (format "track-values-%s-table" table)))))
- (defun track-values-set-value (table key value)
- (puthash key value (symbol-value (intern (format "track-values-%s-table" table))))
- (cl-pushnew key (symbol-value (intern (format "track-values-%s-keys" table))) :test #'string=)
- (setf track-values-modified-p t))
- ;;; I/O functions
- (defun track-values-load-data ()
- "Load calorie data."
- (when (file-exists-p track-values-save-file)
- (load track-values-save-file t t t)
- (setf track-values-loaded-p t
- track-values-modified-p nil)))
- (defun track-values-save-data ()
- "Write calorie data."
- (when track-values-modified-p
- (with-temp-buffer
- (insert ";; generated by track-values.el -*- mode: lisp-data -*-\n"
- ";; do not modify by hand\n\n")
- (let ((standard-output (current-buffer)))
- (mapcar #'(lambda (name)
- (print `(track-values-make-table ',name ',(mapcar (lambda (x)
- (list x (track-values-get-value name x)))
- (hash-table-keys (symbol-value (intern (format "track-values-%s-table" name))))))))
- track-values-tables))
- (write-region (point-min) (point-max) track-values-save-file)
- (setf track-values-modified-p nil))))
- ;;; Primary interaction functions
- (defun track-values-complete (&optional name)
- (let ((all-keys (remove-duplicates (loop for name in track-values-tables appending (symbol-value (intern (format "track-values-%s-keys" name)))))))
- (if name
- (completing-read "Item: " (symbol-value (intern (format "track-values-%s-keys" name)))
- #'identity nil nil nil nil t)
- (completing-read "Item: " all-keys
- #'identity nil nil nil nil t))))
- (defun track-values-start (&optional name)
- "Get a food item to retrieve or prompt for calories."
- (unless track-values-loaded-p
- (track-values-load-data))
- (let ((key (track-values-complete name)))
- (if key
- (setf track-values-current-key (downcase key))
- (user-error "A key must be provided"))))
- (defun track-values-insert (name)
- "Get or prompt for the number of calories in the current food item."
- (let ((item (track-values-get-value name track-values-current-key)))
- (if item
- (format "%s" item)
- (let ((item (read-string (format "%s in \"%s\": " name track-values-current-key))))
- (track-values-set-key name track-values-current-key item)
- (format "%s" item)))))
- (defun track-values-end ()
- (setf track-values-current-key nil))
- (provide 'track-values)
- ;;; track-values.el ends here
|