diff options
| -rw-r--r-- | account.el | 158 |
1 files changed, 143 insertions, 15 deletions
@@ -195,7 +195,9 @@ lines around the point." (purpose (completing-read "Purpose? " account-purposes-list nil t)) (record-time (format-time-string "[%Y-%m-%d %a %H:%M]")) - (from (completing-read "From: " (list "cash" "card")))) + (from (completing-read + "From: " + (list "cash" "card" "Line Pay Money")))) (format "** %s\n:PROPERTIES:\n:purpose: %s\n:from: %s\n\ :record_time: %s\n:END:\n" @@ -231,6 +233,8 @@ lines around the point." :hook #'account-capture-mode) "The template for capturing account information.") +(require 'org-capture) + (cond ((assoc "m" org-capture-templates #'equal) (setcdr (assoc "m" org-capture-templates #'equal) @@ -349,6 +353,10 @@ for which the collector gives N as its index, and ALIST-OF-SHOPS is the associative list of all associated shop-names and respective costs, if SHOP-NAME is non-nil. +In addition, an item is collected if and only if the function +`account-match-item' returns non-nil when called on +`account-agenda-filters' and the item. + This function does not move point, nor does it modify match data." (save-match-data (save-excursion @@ -475,15 +483,18 @@ This function does not move point, nor does it modify match data." (or (car-safe (alist-get name res-list)) 0))) - (setcar (cdr res-element) - (+ res-value value)) (cond - (name - (setf - (alist-get name (car (cddr res-element))) - (cons - (+ name-old-value value) - shop-marker))))))))) + ((account-match-item + account-agenda-match account-item) + (setcar (cdr res-element) + (+ res-value value)) + (cond + (name + (setf + (alist-get name (car (cddr res-element))) + (cons + (+ name-old-value value) + shop-marker))))))))))) ((user-error "Invalid level %d" level))))) (let ((n 0)) (while (< n len) @@ -492,11 +503,12 @@ This function does not move point, nor does it modify match data." (date (get-text-property 0 'date title)) (date-encoded - (encode-time - (list 0 0 0 - (cadr date) - (car date) - (caddr date)))) + (ignore-errors + (encode-time + (list 0 0 0 + (cadr date) + (car date) + (caddr date))))) (date-marker (gethash date-encoded date-markers))) (cond @@ -575,7 +587,7 @@ MATCH is required by Org-agenda, and relentlessly ignored by us." 'face 'org-agenda-calendar-event 'org-marker (cddr shop-info))) (newline)) - (caddr element)) + (reverse (caddr element))) (insert (propertize (format " all: %d" cost) @@ -764,6 +776,122 @@ the displayed information.") 'org-agenda-custom-commands (list "ms" "account view by shop" '((account-agenda-shop-command)))) +;;; Filtering account information + +(defvar account-agenda-match nil + "The conditions to filter account information for display. +See the documentation of the function `account-match-item' for +the valid value.") + +(defun account-match-item (match item) + "Return non-nil if and only if MATCH matches ITEM. +ITEM is a valid item if and only if the function +`account-is-item-p' returns t. + +MATCH is a list of cons cells, whose `car' is one of the +following symbols: + +- date +- shop +- item +- cost +- purpose +- method (from) +- time + +The `cdr' of the cell can be of the following types: + +- nil: the item must have nil value to match +- string: a regular expression to match the item value +- function: return non-nil if and only if item value matches. + +The first element of MATCH can be the special symbol 'or', in +which case the item matches if one of the conditions matches; +otherwise all conditions must match for the item to be considered +a match." + (let ((temp match) + (result t) + car-temp item-value cdar-temp + temp-result or-mode) + (cond + ((eq (car-safe temp) 'or) + (setq temp (cdr temp)) + (setq or-mode t))) + (while (consp temp) + (setq car-temp (car temp)) + (setq cdar-temp (cdr car-temp)) + (setq temp (cdr temp)) + (cond + ((eq (car car-temp) 'date) + (setq item-value (plist-get (cdr item) :date))) + ((eq (car car-temp) 'shop) + (setq item-value (plist-get (cdr item) :shop-name))) + ((eq (car car-temp) 'item) + (setq item-value (plist-get (cdr item) :item-name))) + ((eq (car car-temp) 'cost) + (setq item-value (plist-get (cdr item) :cost))) + ((eq (car car-temp) 'purpose) + (setq item-value (plist-get (cdr item) :purpose))) + ((or (eq (car car-temp) 'method) + (eq (car car-temp) 'from)) + (setq item-value (plist-get (cdr item) :payment-method))) + ((eq (car car-temp) 'time) + (setq item-value (plist-get (cdr item) :record-time))) + ((error "Wrong symbol %S" (car car-temp)))) + (cond + ((null cdar-temp) (setq temp-result (null item-value))) + ((stringp cdar-temp) + (setq temp-result + (and (stringp item-value) + (string-match-p cdar-temp item-value)))) + ((functionp cdar-temp) + (setq temp-result (funcall cdar-temp item-value))) + ((error "Wrong condition: %S" cdar-temp))) + (cond + (or-mode + (cond + (temp-result + (setq result t) + (setq temp nil)))) + (t + (cond + ((not temp-result) + (setq result nil) + (setq temp nil)))))) + result)) + +(defun account-agenda-add-filter (prop value) + "Add a filtering condition for PROP matching VALUE." + (interactive + (let* ((prop + (completing-read + "Property: " + (list + "date" "shop" "item" "purpose" "cost" "from" "time") + nil t)) + (val (read-string (format "Match %s: " prop)))) + (list prop val))) + (let ((prop (intern prop))) + (cond + ((eq (car-safe account-agenda-match) 'or) + (setcdr account-agenda-match + (cons + (cons prop value) + (cdr account-agenda-match)))) + ((setq account-agenda-match + (cons + (cons prop value) + account-agenda-match)))))) + +(defun account-agenda-remove-filter () + "Set `account-agenda-match' to nil." + (interactive) + (setq account-agenda-match nil)) + +(define-key account-mode-map (vector ?/) #'account-agenda-add-filter) +(define-key account-mode-map (vector ?|) + #'account-agenda-remove-filter) + ;;; Exporting information as graphs (defun account-agenda-export-to-svg () |