track-calorie-values.el 3.7 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118
  1. ;;; track-calorie-values.el --- Track calorie values for various foods
  2. ;; Copyright (C) 2020 Samuel W. Flint <swflint@flintfam.org>
  3. ;; author: Samuel W. Flint <swflint@flintfam.org>
  4. ;; Version: 0.1
  5. ;; Keywords: diet, tracking
  6. ;; URL: https://git.sr.ht/~swflint/track-calorie-values
  7. ;; This file is NOT part of Emacs.
  8. ;;
  9. ;; This file is licensed under the GNU GPLv3 or later.
  10. ;;; Commentary:
  11. ;;
  12. ;;; Code:
  13. (require 'cl-lib)
  14. ;;; Customizeable values
  15. (defgroup track-calorie-values nil
  16. "Track calorie values for various foods"
  17. :tag "Track Calorie Values"
  18. :group 'org
  19. :link '(url-link "https://git.sr.ht/~swflint/track-calorie-values")
  20. :prefix "track-calorie-values-")
  21. (defcustom track-calorie-values-save-file
  22. (locate-user-emacs-file "track-calorie-values-data.el")
  23. "File to store calorie values of food items."
  24. :type '(file :must-match t))
  25. ;;; Hashing
  26. ;; Taken from emacs documentation
  27. (defun case-fold-string= (a b)
  28. (eq t (compare-strings a nil nil b nil nil t)))
  29. (defun case-fold-string-hash (a)
  30. (sxhash-equal (upcase a)))
  31. (define-hash-table-test 'case-fold
  32. 'case-fold-string= 'case-fold-string-hash)
  33. ;;; Internal Data
  34. (defvar track-calorie-values-data (make-hash-table :weakness nil :test 'case-fold)
  35. "Storage for calorie values.
  36. Keys are names, values are calories.")
  37. (defvar track-calorie-values-foods nil
  38. "Storage for food names.")
  39. (defvar track-calorie-values-loaded-p nil
  40. "Have calorie values been loaded?")
  41. (defvar track-calorie-values-modified-p t
  42. "Have calorie values been modified?")
  43. (defvar track-calorie-values-current-food nil
  44. "Current food being recorded.")
  45. ;;; I/O functions
  46. (defun track-calorie-values-load-data ()
  47. "Load calorie data."
  48. (when (file-exists-p track-calorie-values-save-file)
  49. (load track-calorie-values-save-file t t t)
  50. (setf track-calorie-values-loaded-p t
  51. track-calorie-values-foods (hash-table-keys track-calorie-values-data)
  52. track-calorie-values-modified-p nil)))
  53. (defun track-calorie-values-save-data ()
  54. "Write calorie data."
  55. (when track-calorie-values-modified-p
  56. (with-temp-buffer
  57. (insert ";; generated by track-calorie-values.el -*- mode: lisp-data -*-\n"
  58. ";; do not modify by hand\n\n")
  59. (let ((standard-output (current-buffer)))
  60. (print `(setq track-calorie-values-data ,track-calorie-values-data)))
  61. (write-region (point-min) (point-max) track-calorie-values-save-file)
  62. (setf track-calorie-values-modified-p nil))))
  63. ;;; Primary interaction functions
  64. (defun track-calorie-values-food ()
  65. "Get a food item to retrieve or prompt for calories."
  66. (unless track-calorie-values-loaded-p
  67. (track-calorie-values-load-data))
  68. (let ((food (completing-read "Food item: " track-calorie-values-foods
  69. #'identity nil nil nil nil t)))
  70. (if food
  71. (setf track-calorie-values-current-food (downcase food))
  72. (user-error "A food name must be provided"))))
  73. (defun track-calorie-values-calories ()
  74. "Get or prompt for the number of calories in the current food item."
  75. (let ((calories (gethash track-calorie-values-current-food track-calorie-values-data)))
  76. (if calories
  77. (progn
  78. (setf track-calorie-values-current-food nil)
  79. (format "%d" calories))
  80. (let ((calories (read-number (format "Calories in \"%s\": " track-calorie-values-current-food))))
  81. (puthash track-calorie-values-current-food calories track-calorie-values-data)
  82. (cl-pushnew track-calorie-values-current-food track-calorie-values-foods :test #'string=)
  83. (setf track-calorie-values-current-food nil
  84. track-calorie-values-modified-p t)
  85. (format "%d" calories)))))
  86. (provide 'track-calorie-values)
  87. ;;; track-calorie-values.el ends here