463 lines
20 KiB
EmacsLisp
463 lines
20 KiB
EmacsLisp
;;; chronometrist-key-values.el --- add key-values to Chronometrist data -*- lexical-binding: t; -*-
|
|
|
|
;; Author: contrapunctus <xmpp:contrapunctus@jabjab.de>
|
|
;; Maintainer: contrapunctus <xmpp:contrapunctus@jabjab.de>
|
|
;; Keywords: calendar
|
|
;; Homepage: https://tildegit.org/contrapunctus/chronometrist
|
|
;; Package-Requires: ((chronometrist "0.7.0"))
|
|
;; Version: 0.1.0
|
|
|
|
;; This is free and unencumbered software released into the public domain.
|
|
;;
|
|
;; Anyone is free to copy, modify, publish, use, compile, sell, or
|
|
;; distribute this software, either in source code form or as a compiled
|
|
;; binary, for any purpose, commercial or non-commercial, and by any
|
|
;; means.
|
|
;;
|
|
;; For more information, please refer to <https://unlicense.org>
|
|
|
|
;;; Commentary:
|
|
;;
|
|
;; This package lets users attach tags and key-values to their tracked time, similar to tags and properties in Org mode.
|
|
;;
|
|
;; To use, add one or more of these functions to any chronometrist hook except `chronometrist-before-in-functions'.
|
|
;; * `chronometrist-tags-add'
|
|
;; * `chronometrist-kv-add'
|
|
;; * `chronometrist-key-values-unified-prompt'
|
|
|
|
;;; Code:
|
|
(require 'chronometrist)
|
|
|
|
(defun chronometrist-history-prep (key history-table)
|
|
"Prepare history of KEY in HISTORY-TABLE for use in prompts.
|
|
Each value in hash table TABLE must be a list. Each value will be reversed and will have duplicate elements removed."
|
|
(--> (gethash key history-table)
|
|
(cl-remove-duplicates it :test #'equal :from-end t)
|
|
(puthash key it history-table)))
|
|
|
|
(defun chronometrist-keyword-to-string (keyword)
|
|
"Return KEYWORD as a string, with the leading \":\" removed."
|
|
(replace-regexp-in-string "^:?" "" (symbol-name keyword)))
|
|
|
|
(defun chronometrist-maybe-string-to-symbol (list)
|
|
"For each string in LIST, if it has no spaces, convert it to a symbol."
|
|
(cl-loop for string in list
|
|
if (string-match-p "[[:space:]]" string)
|
|
collect string
|
|
else collect (intern string)))
|
|
|
|
(defun chronometrist-maybe-symbol-to-string (list)
|
|
"Convert each symbol in LIST to a string."
|
|
(--map (if (symbolp it)
|
|
(symbol-name it)
|
|
it)
|
|
list))
|
|
|
|
(defun chronometrist-plist-update (old-plist new-plist)
|
|
"Add tags and keyword-values from NEW-PLIST to OLD-PLIST.
|
|
OLD-PLIST and NEW-PLIST should be a property lists.
|
|
|
|
Keywords reserved by Chronometrist - :name, :start, and :stop -
|
|
will not be updated. Keywords in OLD-PLIST with new values in
|
|
NEW-PLIST will be updated. Tags in OLD-PLIST will be preserved
|
|
alongside new tags from NEW-PLIST."
|
|
(-let* (((&plist :name old-name :tags old-tags
|
|
:start old-start :stop old-stop) old-plist)
|
|
;; Anything that's left will be the user's key-values.
|
|
(old-kvs (chronometrist-plist-key-values old-plist))
|
|
;; Prevent the user from adding reserved key-values.
|
|
(plist (chronometrist-plist-key-values new-plist))
|
|
(new-tags (-> (append old-tags (plist-get new-plist :tags))
|
|
(cl-remove-duplicates :test #'equal)))
|
|
;; In case there is an overlap in key-values, we use
|
|
;; plist-put to replace old ones with new ones.
|
|
(new-kvs (cl-copy-list old-plist))
|
|
(new-kvs (if plist
|
|
(-> (cl-loop for (key val) on plist by #'cddr
|
|
do (plist-put new-kvs key val)
|
|
finally return new-kvs)
|
|
(chronometrist-plist-key-values))
|
|
old-kvs)))
|
|
(append `(:name ,old-name)
|
|
(when new-tags `(:tags ,new-tags))
|
|
new-kvs
|
|
`(:start ,old-start)
|
|
(when old-stop `(:stop ,old-stop)))))
|
|
|
|
(defvar chronometrist-tags-history (make-hash-table :test #'equal)
|
|
"Hash table of tasks and past tag combinations.
|
|
Each value is a list of tag combinations, in reverse
|
|
chronological order. Each combination is a list containing tags
|
|
as symbol and/or strings.")
|
|
|
|
(defun chronometrist-tags-history-populate (task history-table backend)
|
|
"Store tag history for TASK in HISTORY-TABLE from FILE.
|
|
Return the new value inserted into HISTORY-TABLE.
|
|
|
|
HISTORY-TABLE must be a hash table. (see `chronometrist-tags-history')"
|
|
(puthash task nil history-table)
|
|
(cl-loop for plist in (chronometrist-to-list backend) do
|
|
(let ((new-tag-list (plist-get plist :tags))
|
|
(old-tag-lists (gethash task history-table)))
|
|
(and (equal task (plist-get plist :name))
|
|
new-tag-list
|
|
(puthash task
|
|
(if old-tag-lists
|
|
(append old-tag-lists (list new-tag-list))
|
|
(list new-tag-list))
|
|
history-table))))
|
|
(chronometrist-history-prep task history-table))
|
|
|
|
(defvar chronometrist--tag-suggestions nil
|
|
"Suggestions for tags.
|
|
Used as history by `chronometrist-tags-prompt'.")
|
|
|
|
(defun chronometrist-tags-history-add (plist)
|
|
"Add tags from PLIST to `chronometrist-tags-history'."
|
|
(let* ((table chronometrist-tags-history)
|
|
(name (plist-get plist :name))
|
|
(tags (plist-get plist :tags))
|
|
(old-tags (gethash name table)))
|
|
(when tags
|
|
(--> (cons tags old-tags)
|
|
(puthash name it table)))))
|
|
|
|
(defun chronometrist-tags-history-combination-strings (task)
|
|
"Return list of past tag combinations for TASK.
|
|
Each combination is a string, with tags separated by commas.
|
|
|
|
This is used to provide history for `completing-read-multiple' in
|
|
`chronometrist-tags-prompt'."
|
|
(->> (gethash task chronometrist-tags-history)
|
|
(mapcar (lambda (list)
|
|
(->> list
|
|
(mapcar (lambda (elt)
|
|
(if (stringp elt)
|
|
elt
|
|
(symbol-name elt))))
|
|
(-interpose ",")
|
|
(apply #'concat))))))
|
|
|
|
(defun chronometrist-tags-history-individual-strings (task)
|
|
"Return list of tags for TASK, with each tag being a single string.
|
|
This is used to provide completion for individual tags, in
|
|
`completing-read-multiple' in `chronometrist-tags-prompt'."
|
|
(--> (gethash task chronometrist-tags-history)
|
|
(-flatten it)
|
|
(cl-remove-duplicates it :test #'equal)
|
|
(cl-loop for elt in it
|
|
collect (if (stringp elt)
|
|
elt
|
|
(symbol-name elt)))))
|
|
|
|
(defun chronometrist-tags-prompt (task &optional initial-input)
|
|
"Read one or more tags from the user and return them as a list of strings.
|
|
TASK should be a string.
|
|
INITIAL-INPUT is as used in `completing-read'."
|
|
(setq chronometrist--tag-suggestions (chronometrist-tags-history-combination-strings task))
|
|
(completing-read-multiple (concat "Tags for " task " (optional): ")
|
|
(chronometrist-tags-history-individual-strings task)
|
|
nil
|
|
'confirm
|
|
initial-input
|
|
'chronometrist--tag-suggestions))
|
|
|
|
(defun chronometrist-tags-add (&rest _args)
|
|
"Read tags from the user; add them to the last entry in `chronometrist-file'.
|
|
_ARGS are ignored. This function always returns t, so it can be
|
|
used in `chronometrist-before-out-functions'."
|
|
(interactive)
|
|
(let* ((backend (chronometrist-active-backend))
|
|
(last-expr (chronometrist-latest-record backend))
|
|
(last-name (plist-get last-expr :name))
|
|
(_history (chronometrist-tags-history-populate last-name chronometrist-tags-history backend))
|
|
(last-tags (plist-get last-expr :tags))
|
|
(input (->> (chronometrist-maybe-symbol-to-string last-tags)
|
|
(-interpose ",")
|
|
(apply #'concat)
|
|
(chronometrist-tags-prompt last-name)
|
|
(chronometrist-maybe-string-to-symbol))))
|
|
(when input
|
|
(--> (append last-tags input)
|
|
(reverse it)
|
|
(cl-remove-duplicates it :test #'equal)
|
|
(reverse it)
|
|
(list :tags it)
|
|
(chronometrist-plist-update
|
|
(chronometrist-latest-record backend) it)
|
|
(chronometrist-replace-last backend it)))
|
|
t))
|
|
|
|
(defgroup chronometrist-key-values nil
|
|
"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
|
|
:type 'string)
|
|
|
|
(defvar chronometrist-key-history
|
|
(make-hash-table :test #'equal)
|
|
"Hash table to store previously-used user-keys.
|
|
Each hash key is the name of a task. Each hash value is a list
|
|
containing keywords used with that task, in reverse chronological
|
|
order. The keywords are stored as strings and their leading \":\"
|
|
is removed.")
|
|
|
|
(defun chronometrist-key-history-populate (task history-table backend)
|
|
"Store key history for TASK in HISTORY-TABLE from FILE.
|
|
Return the new value inserted into HISTORY-TABLE.
|
|
|
|
HISTORY-TABLE must be a hash table (see `chronometrist-key-history')."
|
|
(puthash task nil history-table)
|
|
(cl-loop for plist in backend do
|
|
(catch 'quit
|
|
(let* ((name (plist-get plist :name))
|
|
(_check (unless (equal name task) (throw 'quit nil)))
|
|
(keys (--> (chronometrist-plist-key-values plist)
|
|
(seq-filter #'keywordp it)
|
|
(cl-loop for key in it collect
|
|
(chronometrist-keyword-to-string key))))
|
|
(_check (unless keys (throw 'quit nil)))
|
|
(old-keys (gethash name history-table)))
|
|
(puthash name
|
|
(if old-keys (append old-keys keys) keys)
|
|
history-table))))
|
|
(chronometrist-history-prep task history-table))
|
|
|
|
(defvar chronometrist-value-history
|
|
(make-hash-table :test #'equal)
|
|
"Hash table to store previously-used values for user-keys.
|
|
The hash table keys are user-key names (as strings), and the
|
|
values are lists containing values (as strings).")
|
|
|
|
(defun chronometrist-value-history-populate (history-table backend)
|
|
"Store value history in HISTORY-TABLE from FILE.
|
|
HISTORY-TABLE must be a hash table. (see `chronometrist-value-history')"
|
|
(clrhash history-table)
|
|
;; Note - while keys are Lisp keywords, values may be any Lisp
|
|
;; object, including lists
|
|
(cl-loop for plist in (chronometrist-to-list backend) do
|
|
;; We call them user-key-values because we filter out Chronometrist's
|
|
;; reserved key-values
|
|
(let ((user-key-values (chronometrist-plist-key-values plist)))
|
|
(cl-loop for (key value) on user-key-values by #'cddr do
|
|
(let* ((key-string (chronometrist-keyword-to-string key))
|
|
(old-values (gethash key-string history-table))
|
|
(value (if (not (stringp value)) ;; why?
|
|
(list (format "%S" value))
|
|
(list value))))
|
|
(puthash key-string
|
|
(if old-values (append old-values value) value)
|
|
history-table)))))
|
|
(maphash (lambda (key _values)
|
|
(chronometrist-history-prep key history-table))
|
|
history-table))
|
|
|
|
(defvar chronometrist--value-suggestions nil
|
|
"Suggestions for values.
|
|
Used as history by `chronometrist-value-prompt'.")
|
|
|
|
(defvar chronometrist-kv-read-mode-map
|
|
(let ((map (make-sparse-keymap)))
|
|
(define-key map (kbd "C-c C-c") #'chronometrist-kv-accept)
|
|
(define-key map (kbd "C-c C-k") #'chronometrist-kv-reject)
|
|
map)
|
|
"Keymap used by `chronometrist-kv-read-mode'.")
|
|
|
|
(define-derived-mode chronometrist-kv-read-mode emacs-lisp-mode "Key-Values"
|
|
"Mode used by `chronometrist' to read key values from the user."
|
|
(->> ";; Use \\[chronometrist-kv-accept] to accept, or \\[chronometrist-kv-reject] to cancel\n"
|
|
(substitute-command-keys)
|
|
(insert)))
|
|
|
|
(defun chronometrist-kv-completion-quit-key ()
|
|
"Return appropriate keybinding (as a string) to quit from `completing-read'.
|
|
It currently supports ido, ido-ubiquitous, ivy, and helm."
|
|
(substitute-command-keys
|
|
(cond ((or (bound-and-true-p ido-mode)
|
|
(bound-and-true-p ido-ubiquitous-mode))
|
|
"\\<ido-completion-map>\\[ido-select-text]")
|
|
((bound-and-true-p ivy-mode)
|
|
"\\<ivy-minibuffer-map>\\[ivy-immediate-done]")
|
|
((bound-and-true-p helm-mode)
|
|
"\\<helm-comp-read-map>\\[helm-cr-empty-string]")
|
|
(t "leave blank"))))
|
|
|
|
(defun chronometrist-key-prompt (used-keys)
|
|
"Prompt the user to enter keys.
|
|
USED-KEYS are keys they have already added since the invocation
|
|
of `chronometrist-kv-add'."
|
|
(let ((key-suggestions (--> (chronometrist-latest-record (chronometrist-active-backend))
|
|
(plist-get it :name)
|
|
(gethash it chronometrist-key-history))))
|
|
(completing-read (format "Key (%s to quit): "
|
|
(chronometrist-kv-completion-quit-key))
|
|
;; don't suggest keys which have already been used
|
|
(cl-loop for used-key in used-keys do
|
|
(setq key-suggestions
|
|
(seq-remove (lambda (key)
|
|
(equal key used-key))
|
|
key-suggestions))
|
|
finally return key-suggestions)
|
|
nil nil nil 'key-suggestions)))
|
|
|
|
(defun chronometrist-value-prompt (key)
|
|
"Prompt the user to enter values.
|
|
KEY should be a string for the just-entered key."
|
|
(setq chronometrist--value-suggestions (gethash key chronometrist-value-history))
|
|
(completing-read (format "Value (%s to quit): "
|
|
(chronometrist-kv-completion-quit-key))
|
|
chronometrist--value-suggestions nil nil nil
|
|
'chronometrist--value-suggestions))
|
|
|
|
(defun chronometrist-value-insert (value)
|
|
"Insert VALUE into the key-value entry buffer."
|
|
(insert " ")
|
|
(cond ((or
|
|
;; list or vector
|
|
(and (string-match-p (rx (and bos (or "(" "\"" "["))) value)
|
|
(string-match-p (rx (and (or ")" "\"" "]") eos)) value))
|
|
;; int or float
|
|
(string-match-p "^[0-9]*\\.?[0-9]*$" value))
|
|
(insert value))
|
|
(t (insert "\"" value "\"")))
|
|
(insert "\n"))
|
|
|
|
(defun chronometrist-kv-add (&rest _args)
|
|
"Read key-values from user, adding them to a temporary buffer for review.
|
|
In the resulting buffer, users can run `chronometrist-kv-accept'
|
|
to add them to the last s-expression in `chronometrist-file', or
|
|
`chronometrist-kv-reject' to cancel.
|
|
|
|
_ARGS are ignored. This function always returns t, so it can be
|
|
used in `chronometrist-before-out-functions'."
|
|
(interactive)
|
|
(let* ((buffer (get-buffer-create chronometrist-kv-buffer-name))
|
|
(first-key-p t)
|
|
(backend (chronometrist-active-backend))
|
|
(last-sexp (chronometrist-latest-record backend))
|
|
(last-name (plist-get last-sexp :name))
|
|
(last-kvs (chronometrist-plist-key-values last-sexp))
|
|
(used-keys (--map (chronometrist-keyword-to-string it)
|
|
(seq-filter #'keywordp last-kvs))))
|
|
(chronometrist-key-history-populate last-name chronometrist-key-history backend)
|
|
(chronometrist-value-history-populate chronometrist-value-history backend)
|
|
(switch-to-buffer buffer)
|
|
(with-current-buffer buffer
|
|
(erase-buffer)
|
|
(chronometrist-kv-read-mode)
|
|
(if (and (chronometrist-current-task (chronometrist-active-backend)) last-kvs)
|
|
(progn
|
|
(funcall chronometrist-sexp-pretty-print-function last-kvs buffer)
|
|
(down-list -1)
|
|
(insert "\n "))
|
|
(insert "()")
|
|
(down-list -1))
|
|
(catch 'empty-input
|
|
(let (input key value)
|
|
(while t
|
|
(setq key (chronometrist-key-prompt used-keys)
|
|
input key
|
|
used-keys (append used-keys
|
|
(list key)))
|
|
(if (string-empty-p input)
|
|
(throw 'empty-input nil)
|
|
(unless first-key-p
|
|
(insert " "))
|
|
(insert ":" key)
|
|
(setq first-key-p nil))
|
|
(setq value (chronometrist-value-prompt key)
|
|
input value)
|
|
(if (string-empty-p input)
|
|
(throw 'empty-input nil)
|
|
(chronometrist-value-insert value)))))
|
|
(chronometrist-sexp-reindent-buffer))
|
|
t))
|
|
|
|
(defun chronometrist-kv-accept ()
|
|
"Accept the plist in `chronometrist-kv-buffer-name' and add it to `chronometrist-file'."
|
|
(interactive)
|
|
(let* ((backend (chronometrist-active-backend))
|
|
(latest (chronometrist-latest-record backend))
|
|
user-kv-expr)
|
|
(with-current-buffer (get-buffer chronometrist-kv-buffer-name)
|
|
(goto-char (point-min))
|
|
(setq user-kv-expr (ignore-errors (read (current-buffer))))
|
|
(kill-buffer chronometrist-kv-buffer-name))
|
|
(if user-kv-expr
|
|
(chronometrist-replace-last backend (chronometrist-plist-update latest user-kv-expr))
|
|
(chronometrist-refresh))))
|
|
|
|
(defun chronometrist-kv-reject ()
|
|
"Reject the property list in `chronometrist-kv-buffer-name'."
|
|
(interactive)
|
|
(kill-buffer chronometrist-kv-buffer-name)
|
|
(chronometrist-refresh))
|
|
|
|
(easy-menu-define chronometrist-key-value-menu chronometrist-mode-map
|
|
"Key value menu for Chronometrist mode."
|
|
'("Key-Values"
|
|
["Change tags for active/last interval" chronometrist-tags-add]
|
|
["Change key-values for active/last interval" chronometrist-kv-add]
|
|
["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)))
|
|
"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 (--map (format "%S" it)
|
|
(chronometrist-key-value-get-presets task)))
|
|
(key-values
|
|
(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 (and (null presets) (null key-values))
|
|
(progn (chronometrist-tags-add) (chronometrist-kv-add))
|
|
(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)
|
|
;;; chronometrist-key-values.el ends here
|