~swflint/track-calorie-values

track-calorie-values/track-values.el -rw-r--r-- 4.6 KiB
ca10957dSamuel W. Flint Fix value setting 5 months ago
                                                                                
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
;;; 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-value 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