[literate migration] add missing function - plist-update

This commit is contained in:
contrapunctus 2021-02-11 17:21:43 +05:30
parent 3fb016cd75
commit dd17413f06
2 changed files with 74 additions and 86 deletions

View File

@ -52,41 +52,36 @@ reversed and will have duplicate elements removed."
it) it)
list)) list))
(defun chronometrist-append-to-last (tags plist) (defun chronometrist-plist-update (old-plist new-plist)
"Add TAGS and PLIST to the last entry in `chronometrist-file'. "Add tags and keyword-values from NEW-PLIST to OLD-PLIST.
TAGS should be a list of symbols and/or strings. OLD-PLIST and NEW-PLIST should be a property lists.
PLIST should be a property list. Properties reserved by Keywords reserved by Chronometrist - :name, :start, and :stop -
Chronometrist - currently :name, :tags, :start, and :stop - will will not be updated. Keywords in OLD-PLIST with new values in
be removed." NEW-PLIST will be updated. Tags in OLD-PLIST will be preserved
(let* ((old-expr (chronometrist-last)) alongside new tags from NEW-PLIST."
(old-name (plist-get old-expr :name)) (-let* (((&plist :name old-name :tags old-tags
(old-start (plist-get old-expr :start)) :start old-start :stop old-stop) old-plist)
(old-stop (plist-get old-expr :stop)) ;; Anything that's left will be the user's key-values.
(old-tags (plist-get old-expr :tags)) (old-kvs (chronometrist-plist-remove old-plist :name :tags :start :stop))
;; Anything that's left will be the user's key-values. ;; Prevent the user from adding reserved key-values.
(old-kvs (chronometrist-plist-remove old-expr :name :tags :start :stop)) (plist (chronometrist-plist-remove new-plist :name :tags :start :stop))
;; Prevent the user from adding reserved key-values. (new-tags (-> (append old-tags (plist-get new-plist :tags))
(plist (chronometrist-plist-remove plist :name :tags :start :stop)) (cl-remove-duplicates :test #'equal)))
(new-tags (if old-tags ;; In case there is an overlap in key-values, we use
(-> (append old-tags tags) ;; plist-put to replace old ones with new ones.
(cl-remove-duplicates :test #'equal)) (new-kvs (cl-copy-list old-plist))
tags)) (new-kvs (if plist
;; In case there is an overlap in key-values, we use (-> (cl-loop for (key val) on plist by #'cddr
;; plist-put to replace old ones with new ones. do (plist-put new-kvs key val)
(new-kvs (cl-copy-list old-expr)) finally return new-kvs)
(new-kvs (if plist (chronometrist-plist-remove :name :tags :start :stop))
(-> (cl-loop for (key val) on plist by #'cddr old-kvs)))
do (plist-put new-kvs key val) (append `(:name ,old-name)
finally return new-kvs) (when new-tags `(:tags ,new-tags))
(chronometrist-plist-remove :name :tags :start :stop)) new-kvs
old-kvs)) `(:start ,old-start)
(plist (append `(:name ,old-name) (when old-stop `(:stop ,old-stop)))))
(when new-tags `(:tags ,new-tags))
new-kvs
`(:start ,old-start)
(when old-stop `(:stop ,old-stop)))))
(chronometrist-sexp-replace-last plist)))
(defvar chronometrist-tags-history (make-hash-table :test #'equal) (defvar chronometrist-tags-history (make-hash-table :test #'equal)
"Hash table of tasks and past tag combinations. "Hash table of tasks and past tag combinations.
@ -186,7 +181,7 @@ INITIAL-INPUT is as used in `completing-read'."
(reverse it) (reverse it)
(cl-remove-duplicates it :test #'equal) (cl-remove-duplicates it :test #'equal)
(reverse it) (reverse it)
(chronometrist-append-to-last it nil))))) (chronometrist-plist-update it nil)))))
t) t)
(defgroup chronometrist-key-values nil (defgroup chronometrist-key-values nil
@ -305,10 +300,10 @@ of `chronometrist-kv-add'."
(defun chronometrist-value-prompt (key) (defun chronometrist-value-prompt (key)
"Prompt the user to enter values. "Prompt the user to enter values.
KEY should be a string for the just-entered key." KEY should be a string for the just-entered key."
(setq chronometrist--value-suggestions :variable: (gethash key chronometrist-value-history)) (setq chronometrist--value-suggestions (gethash key chronometrist-value-history))
(completing-read (format "Value (%s to quit): " (chronometrist-kv-completion-quit-key)) (completing-read (format "Value (%s to quit): " (chronometrist-kv-completion-quit-key))
chronometrist--value-suggestions :variable: nil nil nil 'chronometrist--value-suggestions)) chronometrist--value-suggestions nil nil nil 'chronometrist--value-suggestions))
(defun chronometrist-value-insert (value) (defun chronometrist-value-insert (value)
"Insert VALUE into the key-value entry buffer." "Insert VALUE into the key-value entry buffer."
@ -383,7 +378,7 @@ used in `chronometrist-before-out-functions'."
(setq user-kv-expr (ignore-errors (read (current-buffer)))) (setq user-kv-expr (ignore-errors (read (current-buffer))))
(kill-buffer chronometrist-kv-buffer-name)) (kill-buffer chronometrist-kv-buffer-name))
(if user-kv-expr (if user-kv-expr
(chronometrist-append-to-last nil user-kv-expr) (chronometrist-plist-update nil user-kv-expr)
(chronometrist-refresh)))) (chronometrist-refresh))))
(defun chronometrist-kv-reject () (defun chronometrist-kv-reject ()
@ -410,7 +405,7 @@ This function always returns t, so it can be used in `chronometrist-before-out-f
(yes-or-no-p (yes-or-no-p
(format "Skip prompt and use last-used tags/key-values? %S " plist)) (format "Skip prompt and use last-used tags/key-values? %S " plist))
(setq chronometrist--skip-detail-prompts t) (setq chronometrist--skip-detail-prompts t)
(chronometrist-append-to-last (plist-get plist :tags) plist)) (chronometrist-plist-update (plist-get plist :tags) plist))
t)) t))
(defun chronometrist-skip-query-reset (_task) (defun chronometrist-skip-query-reset (_task)
@ -467,5 +462,3 @@ Return t, to permit use in `chronometrist-before-out-functions'."
(provide 'chronometrist-key-values) (provide 'chronometrist-key-values)
;;; chronometrist-key-values.el ends here ;;; chronometrist-key-values.el ends here

View File

@ -74,43 +74,38 @@ reversed and will have duplicate elements removed."
it) it)
list)) list))
#+END_SRC #+END_SRC
**** chronometrist-append-to-last :function:mutator: **** chronometrist-plist-update :function:mutator:
#+BEGIN_SRC emacs-lisp #+BEGIN_SRC emacs-lisp
(defun chronometrist-append-to-last (tags plist) (defun chronometrist-plist-update (old-plist new-plist)
"Add TAGS and PLIST to the last entry in `chronometrist-file'. "Add tags and keyword-values from NEW-PLIST to OLD-PLIST.
TAGS should be a list of symbols and/or strings. OLD-PLIST and NEW-PLIST should be a property lists.
PLIST should be a property list. Properties reserved by Keywords reserved by Chronometrist - :name, :start, and :stop -
Chronometrist - currently :name, :tags, :start, and :stop - will will not be updated. Keywords in OLD-PLIST with new values in
be removed." NEW-PLIST will be updated. Tags in OLD-PLIST will be preserved
(let* ((old-expr (chronometrist-last)) alongside new tags from NEW-PLIST."
(old-name (plist-get old-expr :name)) (-let* (((&plist :name old-name :tags old-tags
(old-start (plist-get old-expr :start)) :start old-start :stop old-stop) old-plist)
(old-stop (plist-get old-expr :stop)) ;; Anything that's left will be the user's key-values.
(old-tags (plist-get old-expr :tags)) (old-kvs (chronometrist-plist-remove old-plist :name :tags :start :stop))
;; Anything that's left will be the user's key-values. ;; Prevent the user from adding reserved key-values.
(old-kvs (chronometrist-plist-remove old-expr :name :tags :start :stop)) (plist (chronometrist-plist-remove new-plist :name :tags :start :stop))
;; Prevent the user from adding reserved key-values. (new-tags (-> (append old-tags (plist-get new-plist :tags))
(plist (chronometrist-plist-remove plist :name :tags :start :stop)) (cl-remove-duplicates :test #'equal)))
(new-tags (if old-tags ;; In case there is an overlap in key-values, we use
(-> (append old-tags tags) ;; plist-put to replace old ones with new ones.
(cl-remove-duplicates :test #'equal)) (new-kvs (cl-copy-list old-plist))
tags)) (new-kvs (if plist
;; In case there is an overlap in key-values, we use (-> (cl-loop for (key val) on plist by #'cddr
;; plist-put to replace old ones with new ones. do (plist-put new-kvs key val)
(new-kvs (cl-copy-list old-expr)) finally return new-kvs)
(new-kvs (if plist (chronometrist-plist-remove :name :tags :start :stop))
(-> (cl-loop for (key val) on plist by #'cddr old-kvs)))
do (plist-put new-kvs key val) (append `(:name ,old-name)
finally return new-kvs) (when new-tags `(:tags ,new-tags))
(chronometrist-plist-remove :name :tags :start :stop)) new-kvs
old-kvs)) `(:start ,old-start)
(plist (append `(:name ,old-name) (when old-stop `(:stop ,old-stop)))))
(when new-tags `(:tags ,new-tags))
new-kvs
`(:start ,old-start)
(when old-stop `(:stop ,old-stop)))))
(chronometrist-sexp-replace-last plist)))
#+END_SRC #+END_SRC
*** Tags *** Tags
**** chronometrist-tags-history :variable:hash_table: **** chronometrist-tags-history :variable:hash_table:
@ -227,7 +222,7 @@ INITIAL-INPUT is as used in `completing-read'."
(reverse it) (reverse it)
(cl-remove-duplicates it :test #'equal) (cl-remove-duplicates it :test #'equal)
(reverse it) (reverse it)
(chronometrist-append-to-last it nil))))) (chronometrist-plist-update it nil)))))
t) t)
#+END_SRC #+END_SRC
*** Key-Values *** Key-Values
@ -370,12 +365,12 @@ of `chronometrist-kv-add'."
#+END_SRC #+END_SRC
**** chronometrist-value-prompt :function: **** chronometrist-value-prompt :function:
#+BEGIN_SRC emacs-lisp #+BEGIN_SRC emacs-lisp
(defun chronometrist-value-prompt (key) (defun chronometrist-value-prompt (key)
"Prompt the user to enter values. "Prompt the user to enter values.
KEY should be a string for the just-entered key." KEY should be a string for the just-entered key."
(setq chronometrist--value-suggestions :variable: (gethash key chronometrist-value-history)) (setq chronometrist--value-suggestions (gethash key chronometrist-value-history))
(completing-read (format "Value (%s to quit): " (chronometrist-kv-completion-quit-key)) (completing-read (format "Value (%s to quit): " (chronometrist-kv-completion-quit-key))
chronometrist--value-suggestions :variable: nil nil nil 'chronometrist--value-suggestions)) chronometrist--value-suggestions nil nil nil 'chronometrist--value-suggestions))
#+END_SRC #+END_SRC
**** chronometrist-value-insert :function: **** chronometrist-value-insert :function:
#+BEGIN_SRC emacs-lisp #+BEGIN_SRC emacs-lisp
@ -456,7 +451,7 @@ used in `chronometrist-before-out-functions'."
(setq user-kv-expr (ignore-errors (read (current-buffer)))) (setq user-kv-expr (ignore-errors (read (current-buffer))))
(kill-buffer chronometrist-kv-buffer-name)) (kill-buffer chronometrist-kv-buffer-name))
(if user-kv-expr (if user-kv-expr
(chronometrist-append-to-last nil user-kv-expr) (chronometrist-plist-update nil user-kv-expr)
(chronometrist-refresh)))) (chronometrist-refresh))))
#+END_SRC #+END_SRC
**** chronometrist-kv-reject :command: **** chronometrist-kv-reject :command:
@ -490,7 +485,7 @@ This function always returns t, so it can be used in `chronometrist-before-out-f
(yes-or-no-p (yes-or-no-p
(format "Skip prompt and use last-used tags/key-values? %S " plist)) (format "Skip prompt and use last-used tags/key-values? %S " plist))
(setq chronometrist--skip-detail-prompts t) (setq chronometrist--skip-detail-prompts t)
(chronometrist-append-to-last (plist-get plist :tags) plist)) (chronometrist-plist-update (plist-get plist :tags) plist))
t)) t))
#+END_SRC #+END_SRC
**** chronometrist-skip-query-reset :function: **** chronometrist-skip-query-reset :function: