Custom status rendering support, entry total amount.

package.lisp

@@ -1,6 +1,7 @@
 (defpackage #:pta-ledger
   (:use #:cl #:smug)
   (:export #:*posting-length*
+           #:*allowed-statuses*
            #:amount
            #:make-amount
            #:amount-quantity
@@ -22,6 +23,7 @@
            #:entry-description
            #:entry-comment
            #:entry-postings
+           #:entry-total-amount
            #:parse-date
            #:parse-account
            #:parse-amount

pta-ledger.lisp

@@ -92,6 +92,13 @@
                         (:f (posting-virtual posting)))))))
     (remove-if-not #'valid (entry-postings entry))))
 
+(defun entry-total-amount (entry)
+  (labels ((negativep (e p)
+             (declare (ignore e))
+             (minusp (amount-quantity (posting-amount p)))))
+    (format nil "~{~A~^, ~}"
+            (mapcar #'render (complement-amounts (select-postings entry :predicate #'negativep))))))
+
 (defun account-parents (account &key tree)
   (append
    (when (eq tree :t)

render.lisp

@@ -1,11 +1,15 @@
 (in-package #:pta-ledger)
 
 (defvar *posting-length* 46 "Length of posting without amount")
+(defvar *allowed-statuses* '(#\! #\*))
 
 (defun render-date (universal-time)
   (when universal-time
     (format nil "~{~4,'0D/~2,'0D/~2,'0D~}" (get-date universal-time))))
 
+(defun when-allowed (status)
+  (find status *allowed-statuses*))
+
 (defgeneric render (object &optional stream)
   (:documentation "Render OBJECT to STREAM in text format."))
 
@@ -18,7 +22,7 @@
 (defmethod render ((posting posting) &optional stream)
   (with-slots (status virtual account amount unit-price total-price comment) posting
     (let* ((amount-text (render amount))
-           (status-text (format nil "~@[~A ~]" status))
+           (status-text (format nil "~@[~A ~]" (when-allowed status)))
            (account (if virtual
                         (format nil "~A~A~A" virtual account
                                 (ecase virtual
@@ -44,7 +48,7 @@
   (with-slots (date secondary-date status code description comment postings) entry
     (let* ((text (format nil "~A~@[=~A~]~@[ ~A~]~@[ (~A)~]~@[ ~A~]"
                          (render-date date) (render-date secondary-date)
-                         status code description))
+                         (when-allowed status) code description))
            (comments (split comment))
            (first-comment (first comments))
            (rest-comments (rest comments)))