summaryrefslogtreecommitdiff
path: root/account.el
diff options
context:
space:
mode:
Diffstat (limited to 'account.el')
-rw-r--r--account.el158
1 files changed, 143 insertions, 15 deletions
diff --git a/account.el b/account.el
index a39f350..b17f304 100644
--- a/account.el
+++ b/account.el
@@ -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 ()