(in-package #:pta-ledger) (defvar *posting-length* 46 "Length of posting without amount") (defun render-date (universal-time) (when universal-time (format nil "~{~4,'0D/~2,'0D/~2,'0D~}" (get-date universal-time)))) (defgeneric render (object &optional stream) (:documentation "Render OBJECT to STREAM in text format.")) (defmethod render ((null null) &optional stream) (declare (ignore stream))) (defmethod render ((amount amount) &optional stream) (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 (let* ((amount-text (render amount)) (status-text (format nil "~@[~A ~]" status)) (text (format nil " ~A~vA~@[ ~A~]~@[ @ ~A~]~@[ @@ ~A~]" status-text (if amount-text (- *posting-length* (position #\Space amount-text) (length status-text)) 0) account amount-text (when unit-price (render unit-price)) (when total-price (render total-price)))) (comments (split comment)) (first-comment (first comments)) (rest-comments (rest comments))) (format stream "~A~@[ ; ~A~]~{~%~vA ; ~A~}" text first-comment (loop for comment in rest-comments append (list (length text) "" comment)))))) (defmethod render ((entry entry) &optional stream) (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)) (comments (split comment)) (first-comment (first comments)) (rest-comments (rest comments))) (format stream "~A~@[ ; ~A~]~{~%~vA ; ~A~}~{~%~A~}" text first-comment (loop for comment in rest-comments append (list (length text) "" comment)) (loop for posting in postings collect (render posting))))))