Add key-value presets

Inspired by the Android application "My Expenses" by Michael
Totschnig.

CHANGELOG.md

@@ -5,7 +5,10 @@ The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/),
 and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0.html).
 
 ## unreleased
+### Added
 1. `chronometrist-third`, an extension to add support for the [Third Time](https://www.lesswrong.com/posts/RWu8eZqbwgB9zaerh/third-time-a-better-way-to-work) system.
+2. New custom variable `chronometrist-key-value-preset-alist`, to define completion suggestions in advance.
+3. New custom variable `chronometrist-key-value-use-database-history`, to control whether database history is used for key-value suggestions.
 
 ## [0.10.0] - 2022-02-15
 ### Changed

elisp/chronometrist-key-values.el

@@ -192,6 +192,29 @@ used in `chronometrist-before-out-functions'."
   "Add key-values to Chronometrist time intervals."
   :group 'chronometrist)
 
+(defcustom chronometrist-key-value-use-database-history t
+  "If non-nil, use database to generate key-value suggestions.
+If nil, only `chronometrist-key-value-preset-alist' is used."
+  :type 'boolean
+  :group 'chronometrist-key-value)
+
+(defcustom chronometrist-key-value-preset-alist nil
+  "Alist of key-value suggestions for `chronometrist-key-value' prompts.
+Each element must be in the form (\"TASK\" <KEYWORD> <VALUE> ...)"
+  :type
+  '(repeat
+    (cons
+     (string :tag "Task name")
+     (repeat :tag "Property preset"
+             (plist :tag "Property"
+                    ;; :key-type 'keyword :value-type 'sexp
+                    ))))
+  :group 'chronometrist-key-values)
+
+(defun chronometrist-key-value-get-presets (task)
+  "Return presets for TASK from `chronometrist-key-value-preset-alist' as a list of plists."
+  (alist-get task chronometrist-key-value-preset-alist nil nil #'equal))
+
 (defcustom chronometrist-kv-buffer-name "*Chronometrist-Key-Values*"
   "Name of buffer in which key-values are entered."
   :group 'chronometrist-key-values
@@ -404,30 +427,34 @@ used in `chronometrist-before-out-functions'."
     ["Change tags and key-values for active/last interval"
      chronometrist-key-values-unified-prompt]))
 
-(cl-defun chronometrist-key-values-unified-prompt (&optional (task (plist-get (chronometrist-latest-record (chronometrist-active-backend)) :name)))
+(cl-defun chronometrist-key-values-unified-prompt
+    (&optional (task (plist-get (chronometrist-latest-record (chronometrist-active-backend)) :name)))
   "Query user for tags and key-values to be added for TASK.
 Return t, to permit use in `chronometrist-before-out-functions'."
   (interactive)
   (let* ((backend (chronometrist-active-backend))
+         (presets (chronometrist-key-value-get-presets task))
          (key-values
-          (cl-loop for plist in (chronometrist-to-list backend)
-            when (equal (plist-get plist :name) task)
-            collect
-            (let ((plist (chronometrist-plist-remove plist :name :start :stop)))
-              (when plist (format "%S" plist)))
-            into key-value-plists
-            finally return
-            (--> (seq-filter #'identity key-value-plists)
-                 (cl-remove-duplicates it :test #'equal :from-end t))))
+          (when chronometrist-key-value-use-database-history
+            (cl-loop for plist in (chronometrist-to-list backend)
+              when (equal (plist-get plist :name) task)
+              collect
+              (let ((plist (chronometrist-plist-remove plist :name :start :stop)))
+                (when plist (format "%S" plist)))
+              into key-value-plists
+              finally return
+              (--> (seq-filter #'identity key-value-plists)
+                   (cl-remove-duplicates it :test #'equal :from-end t)))))
          (latest (chronometrist-latest-record backend)))
-    (if (null key-values)
+    (if (and (null presets) (null key-values))
         (progn (chronometrist-tags-add) (chronometrist-kv-add))
-      (chronometrist-replace-last
-       backend
-       (chronometrist-plist-update
-        latest
-        (read (completing-read (format "Key-values for %s: " task)
-                               key-values nil nil nil 'chronometrist-key-values-unified-prompt-history))))))
+      (let* ((candidates (append presets key-values))
+             (input      (completing-read
+                          (format "Key-values for %s: " task)
+                          candidates nil nil nil 'chronometrist-key-values-unified-prompt-history)))
+        (chronometrist-replace-last backend
+                        (chronometrist-plist-update latest
+                                        (read input))))))
   t)
 
 (provide 'chronometrist-key-values)

elisp/chronometrist-key-values.org

@@ -330,6 +330,39 @@ used in `chronometrist-before-out-functions'."
   "Add key-values to Chronometrist time intervals."
   :group 'chronometrist)
 #+END_SRC
+
+*** use-database-history                                  :custom:variable:
+#+BEGIN_SRC emacs-lisp
+(defcustom chronometrist-key-value-use-database-history t
+  "If non-nil, use database to generate key-value suggestions.
+If nil, only `chronometrist-key-value-preset-alist' is used."
+  :type 'boolean
+  :group 'chronometrist-key-value)
+#+END_SRC
+
+*** preset-alist                                          :custom:variable:
+#+BEGIN_SRC emacs-lisp
+(defcustom chronometrist-key-value-preset-alist nil
+  "Alist of key-value suggestions for `chronometrist-key-value' prompts.
+Each element must be in the form (\"TASK\" <KEYWORD> <VALUE> ...)"
+  :type
+  '(repeat
+    (cons
+     (string :tag "Task name")
+     (repeat :tag "Property preset"
+             (plist :tag "Property"
+                    ;; :key-type 'keyword :value-type 'sexp
+                    ))))
+  :group 'chronometrist-key-values)
+#+END_SRC
+
+**** get-presets
+#+BEGIN_SRC emacs-lisp
+(defun chronometrist-key-value-get-presets (task)
+  "Return presets for TASK from `chronometrist-key-value-preset-alist' as a list of plists."
+  (alist-get task chronometrist-key-value-preset-alist nil nil #'equal))
+#+END_SRC
+
 *** kv-buffer-name                                        :custom:variable:
 #+BEGIN_SRC emacs-lisp
 (defcustom chronometrist-kv-buffer-name "*Chronometrist-Key-Values*"
@@ -337,6 +370,7 @@ used in `chronometrist-before-out-functions'."
   :group 'chronometrist-key-values
   :type 'string)
 #+END_SRC
+
 *** key-history                                                  :variable:
 :PROPERTIES:
 :VALUE:    hash table
@@ -707,34 +741,39 @@ Return t, to permit use in `chronometrist-before-out-functions'."
 :CUSTOM_ID: unified-prompt
 :END:
 1. [ ] Improve appearance - is there an easy way to syntax highlight the plists?
+
 #+BEGIN_SRC emacs-lisp
-(cl-defun chronometrist-key-values-unified-prompt (&optional (task (plist-get (chronometrist-latest-record (chronometrist-active-backend)) :name)))
+(cl-defun chronometrist-key-values-unified-prompt
+    (&optional (task (plist-get (chronometrist-latest-record (chronometrist-active-backend)) :name)))
   "Query user for tags and key-values to be added for TASK.
 Return t, to permit use in `chronometrist-before-out-functions'."
   (interactive)
   (let* ((backend (chronometrist-active-backend))
+         (presets (chronometrist-key-value-get-presets task))
          (key-values
-          (cl-loop for plist in (chronometrist-to-list backend)
-            when (equal (plist-get plist :name) task)
-            collect
-            (let ((plist (chronometrist-plist-remove plist :name :start :stop)))
-              (when plist (format "%S" plist)))
-            into key-value-plists
-            finally return
-            (--> (seq-filter #'identity key-value-plists)
-                 (cl-remove-duplicates it :test #'equal :from-end t))))
+          (when chronometrist-key-value-use-database-history
+            (cl-loop for plist in (chronometrist-to-list backend)
+              when (equal (plist-get plist :name) task)
+              collect
+              (let ((plist (chronometrist-plist-remove plist :name :start :stop)))
+                (when plist (format "%S" plist)))
+              into key-value-plists
+              finally return
+              (--> (seq-filter #'identity key-value-plists)
+                   (cl-remove-duplicates it :test #'equal :from-end t)))))
          (latest (chronometrist-latest-record backend)))
-    (if (null key-values)
+    (if (and (null presets) (null key-values))
         (progn (chronometrist-tags-add) (chronometrist-kv-add))
-      (chronometrist-replace-last
-       backend
-       (chronometrist-plist-update
-        latest
-        (read (completing-read (format "Key-values for %s: " task)
-                               key-values nil nil nil 'chronometrist-key-values-unified-prompt-history))))))
+      (let* ((candidates (append presets key-values))
+             (input      (completing-read
+                          (format "Key-values for %s: " task)
+                          candidates nil nil nil 'chronometrist-key-values-unified-prompt-history)))
+        (chronometrist-replace-last backend
+                        (chronometrist-plist-update latest
+                                        (read input))))))
   t)
-
 #+END_SRC
+
 * Provide
 #+BEGIN_SRC emacs-lisp
 (provide 'chronometrist-key-values)
@@ -743,5 +782,6 @@ Return t, to permit use in `chronometrist-before-out-functions'."
 
 * Local variables                                                  :noexport:
 # Local Variables:
+# my-org-src-default-lang: "emacs-lisp"
 # eval: (when (package-installed-p 'literate-elisp) (require 'literate-elisp) (literate-elisp-load (buffer-file-name)))
 # End: