account: add a command to view accounts by shop

* account.el (account-agenda-shop-command): This command lists
  expenses grouped by shop names.  It is sometimes useful to know the
  shops I spent the most in.

(org-agenda-custom-commands): Adjust the agenda command accordingly.

1 files changed, 102 insertions, 1 deletions

diff --git a/account.el b/account.el
index f0117da..d21a2e8 100644
--- a/account.el
+++ b/account.el
@@ -592,6 +592,100 @@ MATCH is required by Org-agenda, and relentlessly ignored by us."
     (goto-char (point-min))
     (account-mode)))
 
+(defun account-agenda-shop-command (match)
+  "The command for inserting acccount information to agenda.
+The vector of titles is provided by the variable
+`account-day-offsets' and the collector function is provided by
+the variable `account-agenda-collector'
+
+The difference with `account-agenda-command' is that this
+function displays account information by shops, instead of by
+days.
+
+MATCH is required by Org-agenda, and relentlessly ignored by us."
+  (ignore match)
+  (setq
+   account-day-offsets
+   (number-sequence 0 (1- account-number-of-days)))
+  (insert
+   (propertize
+    "Account:"
+    'face 'org-agenda-structure
+    'org-agenda-structural-header t
+    'org-agenda-type 'account
+    'org-date-line t))
+  (newline)
+  (let* ((titles (make-vector (length account-day-offsets) nil))
+         (all-cost 0)
+         (file (expand-file-name
+                "account.org"
+                (expand-file-name "account" org-directory)))
+         (buffer (progn (org-check-agenda-file file)
+                        (org-get-agenda-file-buffer file)))
+         info shop-cost-alist)
+    (mapc
+     (lambda (n)
+       (let* ((date (decode-time))
+              (day (nth 3 date))
+              (month (nth 4 date))
+              (year (nth 5 date)))
+         (aset
+          titles
+          n
+          (account-agenda-format-date
+           (calendar-gregorian-from-absolute
+            (calendar-absolute-from-gregorian
+             (list month (- day n) year)))))))
+     account-day-offsets)
+    (setq
+     info
+     (with-current-buffer buffer
+       (account-collect-into-vec
+        titles account-agenda-collector)))
+    (mapc
+     (lambda (element)
+       (let ((cost (car (cdr element))))
+         (setq all-cost (+ all-cost cost))
+         (mapc
+          (lambda (shop-info)
+            (let ((assoc-result
+                   (assoc (car shop-info) shop-cost-alist #'equal)))
+              (cond
+               (assoc-result
+                (setcdr assoc-result
+                        (+ (cadr shop-info)
+                           (cdr assoc-result))))
+               ((setq shop-cost-alist
+                      (cons
+                       (cons (car shop-info) (cadr shop-info))
+                       shop-cost-alist))))))
+          (caddr element))))
+     info)
+    (setq shop-cost-alist
+          (sort
+           shop-cost-alist
+           (lambda (cell1 cell2)
+             (>= (cdr cell1) (cdr cell2)))))
+    (mapc
+     (lambda (cell)
+       (insert
+        (propertize
+         (format
+          "%s: %d"
+          (car cell)
+          (cdr cell))
+         'face 'org-agenda-calendar-event))
+       (newline))
+     shop-cost-alist)
+    (newline 2)
+    (insert
+     (propertize
+      (format "all: %d" all-cost)
+      'face 'org-agenda-calendar-event))
+    (newline)
+    (goto-char (point-min))
+    (account-mode)))
+
 (defvar account-number-of-days 7
   "The number of days to display.")
 
@@ -658,9 +752,16 @@ the displayed information.")
 (define-key account-mode-map (vector 3 5)
             #'account-agenda-export-to-svg)
 
+(add-to-list 'org-agenda-custom-commands
+             (cons "m" "account related views"))
+
+(add-to-list
+ 'org-agenda-custom-commands
+ '("mm" "account default view" ((account-agenda-command))))
+
 (add-to-list
  'org-agenda-custom-commands
- '("m" "account" ((account-agenda-command))))
+ (list "ms" "account view by shop" '((account-agenda-shop-command))))
 
 ;;; Exporting information as graphs