sfos/ledger
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Merge branch 'ledger-mode-bbug-875-configurable-reconcile-line'

Browse source
This commit is contained in:
Craig Earls 2014-07-03 21:50:33 -07:00
commit 8efc3e3795
1 changed files with 73 additions and 28 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

101
lisp/ledger-reconcile.el
View file

@ -44,7 +44,8 @@
:group 'ledger-reconcile)
(defcustom ledger-narrow-on-reconcile t
"If t, limit transactions shown in main buffer to those matching the reconcile regex."
"If t, limit transactions shown in main buffer to those
matching the reconcile regex."
:type 'boolean
:group 'ledger-reconcile)
@ -55,7 +56,8 @@ Then that transaction will be shown in its source buffer."
:group 'ledger-reconcile)
(defcustom ledger-reconcile-force-window-bottom nil
"If t make the reconcile window appear along the bottom of the register window and resize."
"If t make the reconcile window appear along the bottom of the
register window and resize."
:type 'boolean
:group 'ledger-reconcile)
@ -75,8 +77,26 @@ reconcile-finish will mark all pending posting cleared."
:type 'string
:group 'ledger-reconcile)
(defcustom ledger-reconcile-buffer-header "Reconciling account %s\n\n"
"Default header string for the reconcile buffer. If non-nil,
the name of the account being reconciled will be substituted
into the '%s'. If nil, no header willbe displayed."
:type 'string
:group 'ledger-reconcile)
(defcustom ledger-reconcile-buffer-line-format "%(date)s %-4(code)s %-50(payee)s %-30(account)s %15(amount)s\n"
"Format string for the ledger reconcile posting
format. Available fields are date, status, code, payee, account,
amount. The format for each field is %WIDTH(FIELD), WIDTH can be
preced by a minus sign which mean to left justify and pad the
field."
:type 'string
:group 'ledger-reconcile)
(defcustom ledger-reconcile-sort-key "(0)"
"Default key for sorting reconcile buffer. Possible values are '(date)', '(amount)', '(payee)'. For no sorting, i.e. using ledger file order, use '(0)'."
"Default key for sorting reconcile buffer. Possible values are
'(date)', '(amount)', '(payee)'. For no sorting, i.e. using
ledger file order, use '(0)'."
:type 'string
:group 'ledger-reconcile)
@ -298,6 +318,51 @@ POSTING is used in `ledger-clear-whole-transactions' is nil."
(nth 1 emacs-xact) ;; return line-no of xact
(nth 0 posting))))) ;; return line-no of posting
(defun ledger-reconcile-compile-format-string (fstr)
"return a function that implements the format string in fstr"
(let (fields
(start 0))
(while (string-match "(\\(.*?\\))" fstr start)
(setq fields (list fields (intern (substring fstr (match-beginning 1) (match-end 1)))))
(setq start (match-end 0)))
(setq fields (flatten (list 'format (replace-regexp-in-string "(.*?)" "" fstr) (cdr (flatten fields)))))
`(lambda (date code status payee account amount)
,fields)))
(defun ledger-reconcile-format-posting (beg where fmt date code status payee account amount)
(insert (funcall fmt date code status payee account amount))
; Set face depending on cleared status
(if status
(if (eq status 'pending)
(set-text-properties beg (1- (point))
(list 'face 'ledger-font-reconciler-pending-face
'where where))
(set-text-properties beg (1- (point))
(list 'face 'ledger-font-reconciler-cleared-face
'where where)))
(set-text-properties beg (1- (point))
(list 'face 'ledger-font-reconciler-uncleared-face
'where where))))
(defun ledger-reconcile-format-xact (xact fmt)
(let ((date-format (or (cdr (assoc "date-format" ledger-environment-alist))
ledger-default-date-format)))
(dolist (posting (nthcdr 5 xact))
(let ((beg (point))
(where (ledger-marker-where-xact-is xact posting)))
(ledger-reconcile-format-posting beg
where
fmt
(format-time-string date-format (nth 2 xact)) ; date
(if (nth 3 xact) (nth 3 xact) "") ; code
(nth 3 posting) ; status
(nth 4 xact) ; payee
(nth 1 posting) ; account
(nth 2 posting)))))) ; amount
(defun ledger-do-reconcile (&optional sort)
"Return the number of uncleared transactions in the account and display them in the *Reconcile* buffer."
(let* ((buf ledger-buf)
@ -314,33 +379,13 @@ POSTING is used in `ledger-clear-whole-transactions' is nil."
(goto-char (point-min))
(unless (eobp)
(if (looking-at "(")
(read (current-buffer)))))))) ;current-buffer is the *temp* created above
(read (current-buffer))))))) ;current-buffer is the *temp* created above
(fmt (ledger-reconcile-compile-format-string ledger-reconcile-buffer-line-format)))
(if (and ledger-success (> (length xacts) 0))
(let ((date-format (or (cdr (assoc "date-format" ledger-environment-alist))
ledger-default-date-format)))
(progn
(insert (format ledger-reconcile-buffer-header account))
(dolist (xact xacts)
(dolist (posting (nthcdr 5 xact))
(let ((beg (point))
(where (ledger-marker-where-xact-is xact posting)))
(insert (format "%s %-4s %-50s %-30s %15s\n"
(format-time-string date-format (nth 2 xact))
(if (nth 3 xact)
(nth 3 xact)
"")
(truncate-string-to-width
(nth 4 xact) 49)
(nth 1 posting) (nth 2 posting)))
(if (nth 3 posting)
(if (eq (nth 3 posting) 'pending)
(set-text-properties beg (1- (point))
(list 'face 'ledger-font-reconciler-pending-face
'where where))
(set-text-properties beg (1- (point))
(list 'face 'ledger-font-reconciler-cleared-face
'where where)))
(set-text-properties beg (1- (point))
(list 'face 'ledger-font-reconciler-uncleared-face
'where where)))) ))
(ledger-reconcile-format-xact xact fmt))
(goto-char (point-max))
(delete-char -1)) ;gets rid of the extra line feed at the bottom of the list
(if ledger-success