account: filtering and adding a payment method option

* account.el (account-capture-content): Add an option for the payment
  methods.

  (org-capture): This is required so that the capture templates
  variable is available.

  (account-collect-into-vec, account-agenda-command)
  (account-match-item, account-agenda-add-filter)
  (account-agenda-match, account-agenda-remove-filter)
  (account-mode-map): Add the functionality of filtering.  Now the
  user can filter items based on some properties, like the payment
  method, the purpose, or the shop name, et cetera.

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 ()