Add Track-Values version

track-values.el

@@ -0,0 +1,144 @@
+;;; 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