Render virtual postings, better query options parsing

parsing.lisp

@@ -399,10 +399,24 @@
                       (or (not start) (>= value start))
                       (or (not end) (< value end))))))))
 
+(defun .query-coloned-option (option-parser value-parser)
+  (.let* ((option option-parser)
+          (_ (.char= #\:))
+          (value value-parser))
+    (.identity (cons option value))))
+(defun .query-option (option)
+  (.progn (.string= (string-downcase (symbol-name option)))
+          (.identity option)))
+(defun .query-value-boolean ()
+  (.let* ((value (.optional (.chars #\t #\f))))
+    (.identity (ecase value
+                 ((nil #\t) :t)
+                 (#\f :f)))))
+
 (defun .query-term ()
-  (.or (.progn (.string= "^cost") (.identity (cons :cost t)))
-       (.progn (.string= "^tree") (.identity (cons :tree t)))
-       (.progn (.string= "^real") (.identity (cons :real t)))
+  (.or (.query-coloned-option (.query-option :cost) (.query-value-boolean))
+       (.query-coloned-option (.query-option :tree) (.query-value-boolean))
+       (.query-coloned-option (.query-option :real) (.query-value-boolean))
        (.query-coloned :acct (.query-postingp "acct" #'posting-account)
                        (.query-value-regex))
        (.query-coloned :amt (.progn (.string= "amt")
@@ -444,28 +458,24 @@
                    word))))
 
 (defun make-options (terms)
-  (let (desc acct status other cost tree real)
+  (let (options desc acct status other)
     (loop for (type . f) in terms
        do (case type
             (:desc (push f desc))
             (:comment (push f desc))
             (:acct (push f acct))
             (:status (push f status))
-            (:cost (setf cost f))
-            (:real (setf real f))
-            (:tree (setf tree f))
+            ((:cost :real :tree) (setf (getf options type) f))
             (otherwise (push f other))))
-    (list :predicate
-          #'(lambda (entry posting)
-              (labels ((any (predicates)
-                         (or (not predicates)
-                             (find-if #'(lambda (p) (funcall p entry posting)) predicates)))
-                       (all (predicates)
-                         (not (find-if-not #'(lambda (p) (funcall p entry posting)) predicates))))
-                (and (any desc) (any acct) (any status) (all other))))
-          :cost cost
-          :tree tree
-          :real real)))
+    (append options
+            (list :predicate
+                  #'(lambda (entry posting)
+                      (labels ((any (predicates)
+                                 (or (not predicates)
+                                     (find-if #'(lambda (p) (funcall p entry posting)) predicates)))
+                               (all (predicates)
+                                 (not (find-if-not #'(lambda (p) (funcall p entry posting)) predicates))))
+                        (and (any desc) (any acct) (any status) (all other))))))))
 
 (defun .query ()
   (.let* ((args (.mapcar* (.prog1 (.arg) (.optional (.whitespace))))))

pta-ledger.lisp

@@ -63,7 +63,7 @@
         (unit-price (posting-unit-price posting))
         (total-price (posting-total-price posting)))
     (if amount
-        (if cost
+        (if (eq cost :t)
             (if total-price (list total-price)
                 (if unit-price
                     (list (make-amount :commodity (amount-commodity unit-price)
@@ -77,20 +77,23 @@
   (remove-if (lambda (e)
                (let ((postings (entry-postings e)))
                  (or (and predicate (not (member nil postings :key #'(lambda (p) (funcall predicate e p)) :test-not #'eql)))
-                     (and real (not (member nil (entry-postings e) :key #'posting-virtual))))))
+                     (and (eq real :t) (not (member nil (entry-postings e) :key #'posting-virtual)))
+                     (and (eq real :f) (not (member nil (entry-postings e) :key #'posting-virtual :test-not #'eql))))))
              (mapcar #'cdr (remove :entry journal :key #'car :test-not #'eql))))
 
 (defun select-postings (entry &key predicate real)
   (labels ((valid (posting)
              (and (or (null predicate)
                       (funcall predicate entry posting))
-                  (or (null real)
-                      (null (posting-virtual posting))))))
+                  (or (ecase real
+                        (:t (null (posting-virtual posting)))
+                        (:f (posting-virtual posting))
+                        (nil t))))))
     (remove-if-not #'valid (entry-postings entry))))
 
 (defun account-parents (account &key tree)
   (append
-   (when tree
+   (when (eq tree :t)
      (loop for start = 0 then (1+ pos)
         for pos = (position #\: account :start start)
         while pos collect (subseq account 0 pos)))
@@ -117,7 +120,7 @@
           (dolist (account (account-parents (posting-account posting) :tree tree))
             (setf (gethash account balance)
                   (add-amounts! (gethash account balance) amounts))))))
-    (when tree
+    (when (eq tree :t)
       (remove-extra-parents! balance))
     balance))
 

render.lisp

@@ -16,9 +16,15 @@
   (format stream "~$ ~A" (amount-quantity amount) (amount-commodity amount)))
 
 (defmethod render ((posting posting) &optional stream)
-  (with-slots (status account amount unit-price total-price comment) posting
+  (with-slots (status virtual account amount unit-price total-price comment) posting
     (let* ((amount-text (render amount))
            (status-text (format nil "~@[~A ~]" status))
+           (account (if virtual
+                        (format nil "~A~A~A" virtual account
+                                (ecase virtual
+                                  (#\( #\))
+                                  (#\[ #\])))
+                        account))
            (text (format nil "    ~A~vA~@[  ~A~]~@[ @ ~A~]~@[ @@ ~A~]"
                          status-text
                          (if amount-text (- *posting-length*