diff options
Diffstat (limited to 'lisp/ledger-reconcile.el')
| -rw-r--r-- | lisp/ledger-reconcile.el | 307 |
1 files changed, 183 insertions, 124 deletions
diff --git a/lisp/ledger-reconcile.el b/lisp/ledger-reconcile.el index 80e27ae3..326266b7 100644 --- a/lisp/ledger-reconcile.el +++ b/lisp/ledger-reconcile.el @@ -40,7 +40,7 @@ :group 'ledger) (defcustom ledger-recon-buffer-name "*Reconcile*" - "Name to use for reconciliation window." + "Name to use for reconciliation buffer." :group 'ledger-reconcile) (defcustom ledger-narrow-on-reconcile t @@ -49,54 +49,67 @@ :group 'ledger-reconcile) (defcustom ledger-buffer-tracks-reconcile-buffer t - "If t, then when the cursor is moved to a new xact in the recon window. + "If t, then when the cursor is moved to a new transaction in the reconcile buffer. Then that transaction will be shown in its source buffer." :type 'boolean :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) (defcustom ledger-reconcile-toggle-to-pending t - "If true then toggle between uncleared and pending. + "If t, then toggle between uncleared and pending. reconcile-finish will mark all pending posting cleared." :type 'boolean :group 'ledger-reconcile) (defcustom ledger-reconcile-default-date-format ledger-default-date-format - "Default date format for the reconcile buffer." + "Date format for the reconcile buffer. +Default is ledger-default-date-format." :type 'string :group 'ledger-reconcile) (defcustom ledger-reconcile-target-prompt-string "Target amount for reconciliation " - "Default prompt for recon target prompt." + "Prompt for recon target." :type 'string :group 'ledger-reconcile) (defcustom ledger-reconcile-buffer-header "Reconciling account %s\n\n" - "Default header string for the reconcile buffer. + "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) + into the '%s'. If nil, no header will be 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. + "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) +field. WIDTH is the minimum number of characters to display; +if string is longer, it is not truncated unless +ledger-reconcile-buffer-payee-max-chars or +ledger-reconcile-buffer-account-max-chars is defined." + :type 'string + :group 'ledger-reconcile) + +(defcustom ledger-reconcile-buffer-payee-max-chars -1 + "If positive, truncate payee name right side to max number of characters." + :type 'integer + :group 'ledger-reconcile) + +(defcustom ledger-reconcile-buffer-account-max-chars -1 + "If positive, truncate account name left side to max number of characters." + :type 'integer + :group 'ledger-reconcile) (defcustom ledger-reconcile-sort-key "(0)" - "Default key for sorting reconcile buffer. + "Key for sorting reconcile buffer. -Possible values are '(date)', '(amount)', '(payee)'. For no sorting, i.e. using -ledger file order, use '(0)'." +Possible values are '(date)', '(amount)', '(payee)' or '(0)' for no sorting, i.e. using ledger file order." :type 'string :group 'ledger-reconcile) @@ -105,6 +118,47 @@ ledger file order, use '(0)'." :type 'boolean :group 'ledger-reconcile) +(defcustom ledger-reconcile-finish-force-quit nil + "If t, will force closing reconcile window after \\[ledger-reconcile-finish]." + :type 'boolean + :group 'ledger-reconcile) + +;; s-functions below are copied from Magnars' s.el +;; prefix ledger-reconcile- is added to not conflict with s.el +(defun ledger-reconcile-s-pad-left (len padding s) + "If S is shorter than LEN, pad it with PADDING on the left." + (let ((extra (max 0 (- len (length s))))) + (concat (make-string extra (string-to-char padding)) + s))) +(defun ledger-reconcile-s-pad-right (len padding s) + "If S is shorter than LEN, pad it with PADDING on the right." + (let ((extra (max 0 (- len (length s))))) + (concat s + (make-string extra (string-to-char padding))))) +(defun ledger-reconcile-s-left (len s) + "Return up to the LEN first chars of S." + (if (> (length s) len) + (substring s 0 len) + s)) +(defun ledger-reconcile-s-right (len s) + "Return up to the LEN last chars of S." + (let ((l (length s))) + (if (> l len) + (substring s (- l len) l) + s))) + +(defun ledger-reconcile-truncate-right (str len) + "Truncate STR right side with max LEN characters, and pad with '…' if truncated." + (if (and (>= len 0) (> (length str) len)) + (ledger-reconcile-s-pad-right len "…" (ledger-reconcile-s-left (- len 1) str)) + str)) + +(defun ledger-reconcile-truncate-left (str len) + "Truncate STR left side with max LEN characters, and pad with '…' if truncated." + (if (and (>= len 0) (> (length str) len)) + (ledger-reconcile-s-pad-left len "…" (ledger-reconcile-s-right (- len 1) str)) + str)) + (defun ledger-reconcile-get-cleared-or-pending-balance (buffer account) "Use BUFFER to Calculate the cleared or pending balance of the ACCOUNT." @@ -204,9 +258,9 @@ Return the number of uncleared xacts found." (with-current-buffer recon-buf (ledger-reconcile-refresh) (set-buffer-modified-p nil)) - (when curbufwin - (select-window curbufwin) - (goto-char curpoint))))) + (when curbufwin + (select-window curbufwin) + (goto-char curpoint))))) (defun ledger-reconcile-add () "Use ledger xact to add a new transaction." @@ -232,40 +286,40 @@ Return the number of uncleared xacts found." (defun ledger-reconcile-visit (&optional come-back) "Recenter ledger buffer on transaction and COME-BACK if non-nil." (interactive) - (beginning-of-line) - (let* ((where (get-text-property (1+ (point)) 'where)) - (target-buffer (if where - (ledger-reconcile-get-buffer where) - nil)) - (cur-win (get-buffer-window (get-buffer ledger-recon-buffer-name)))) - (when target-buffer - (switch-to-buffer-other-window target-buffer) - (ledger-navigate-to-line (cdr where)) - (forward-char) - (recenter) - (ledger-highlight-xact-under-point) - (forward-char -1) - (when (and come-back cur-win) - (select-window cur-win) - (get-buffer ledger-recon-buffer-name))))) + (beginning-of-line) + (let* ((where (get-text-property (1+ (point)) 'where)) + (target-buffer (if where + (ledger-reconcile-get-buffer where) + nil)) + (cur-win (get-buffer-window (get-buffer ledger-recon-buffer-name)))) + (when target-buffer + (switch-to-buffer-other-window target-buffer) + (ledger-navigate-to-line (cdr where)) + (forward-char) + (recenter) + (ledger-highlight-xact-under-point) + (forward-char -1) + (when (and come-back cur-win) + (select-window cur-win) + (get-buffer ledger-recon-buffer-name))))) (defun ledger-reconcile-save () "Save the ledger buffer." (interactive) - (let ((cur-buf (current-buffer)) - (cur-point (point))) - (dolist (buf (cons ledger-buf ledger-bufs)) - (with-current-buffer buf - (basic-save-buffer))) - (switch-to-buffer-other-window cur-buf) - (goto-char cur-point))) + (let ((cur-buf (current-buffer)) + (cur-point (point))) + (dolist (buf (cons ledger-buf ledger-bufs)) + (with-current-buffer buf + (basic-save-buffer))) + (switch-to-buffer-other-window cur-buf) + (goto-char cur-point))) (defun ledger-reconcile-finish () "Mark all pending posting or transactions as cleared. Depends on ledger-reconcile-clear-whole-transactions, save the buffers -and exit reconcile mode" +and exit reconcile mode if `ledger-reconcile-finish-force-quit'" (interactive) (save-excursion (goto-char (point-min)) @@ -278,7 +332,8 @@ and exit reconcile mode" (ledger-toggle-current 'cleared)))) (forward-line 1))) (ledger-reconcile-save) - (ledger-reconcile-quit)) + (when ledger-reconcile-finish-force-quit + (ledger-reconcile-quit))) (defun ledger-reconcile-quit () @@ -320,51 +375,55 @@ POSTING is used in `ledger-clear-whole-transactions' is nil." (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 (cons (intern (match-string 1 fstr)) fields)) - (setq start (match-end 0))) - (setq fields (list* 'format (replace-regexp-in-string "(.*?)" "" fstr) (nreverse fields))) - `(lambda (date code status payee account amount) - ,fields))) + "Return a function that implements the format string in FSTR." + (let (fields + (start 0)) + (while (string-match "(\\(.*?\\))" fstr start) + (setq fields (cons (intern (match-string 1 fstr)) fields)) + (setq start (match-end 0))) + (setq fields (list* 'format (replace-regexp-in-string "(.*?)" "" fstr) (nreverse fields))) + `(lambda (date code status payee account amount) + ,fields))) (defun ledger-reconcile-format-posting (beg where fmt date code status payee account amount) - "Format posting for the reconcile buffer." - (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)))) + "Format posting for the reconcile buffer." + (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) - "Format XACT using 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 + "Format XACT using 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 + (ledger-reconcile-truncate-right + (nth 4 xact) ; payee + ledger-reconcile-buffer-payee-max-chars) + (ledger-reconcile-truncate-left + (nth 1 posting) ; account + ledger-reconcile-buffer-account-max-chars) + (nth 2 posting)))))) ; amount (defun ledger-do-reconcile (&optional sort) "SORT the uncleared transactions in the account and display them in the *Reconcile* buffer. @@ -384,10 +443,10 @@ Return a count of the uncleared transactions." (unless (eobp) (if (looking-at "(") (read (current-buffer))))))) ;current-buffer is the *temp* created above - (fmt (ledger-reconcile-compile-format-string ledger-reconcile-buffer-line-format))) + (fmt (ledger-reconcile-compile-format-string ledger-reconcile-buffer-line-format))) (if (and ledger-success (> (length xacts) 0)) (progn - (insert (format ledger-reconcile-buffer-header account)) + (insert (format ledger-reconcile-buffer-header account)) (dolist (xact xacts) (ledger-reconcile-format-xact xact fmt)) (goto-char (point-max)) @@ -440,11 +499,11 @@ moved and recentered. If they aren't strange things happen." (pop-to-buffer rbuf))) (defun ledger-reconcile-check-valid-account (account) - "Check to see if ACCOUNT exists in the ledger file" - (if (> (length account) 0) - (save-excursion - (goto-char (point-min)) - (search-forward account nil t)))) + "Check to see if ACCOUNT exists in the ledger file" + (if (> (length account) 0) + (save-excursion + (goto-char (point-min)) + (search-forward account nil t)))) (defun ledger-reconcile () "Start reconciling, prompt for account." @@ -453,38 +512,38 @@ moved and recentered. If they aren't strange things happen." (buf (current-buffer)) (rbuf (get-buffer ledger-recon-buffer-name))) - (when (ledger-reconcile-check-valid-account account) - (add-hook 'after-save-hook 'ledger-reconcile-refresh-after-save nil t) - - (if rbuf ;; *Reconcile* already exists - (with-current-buffer rbuf - (set 'ledger-acct account) ;; already buffer local - (when (not (eq buf rbuf)) - ;; called from some other ledger-mode buffer - (ledger-reconcile-quit-cleanup) - (setq ledger-buf buf)) ;; should already be buffer-local - - (unless (get-buffer-window rbuf) - (ledger-reconcile-open-windows buf rbuf))) - - ;; no recon-buffer, starting from scratch. - - (with-current-buffer (setq rbuf - (get-buffer-create ledger-recon-buffer-name)) - (ledger-reconcile-open-windows buf rbuf) - (ledger-reconcile-mode) - (make-local-variable 'ledger-target) - (set (make-local-variable 'ledger-buf) buf) - (set (make-local-variable 'ledger-acct) account))) - - ;; Narrow the ledger buffer - (with-current-buffer rbuf - (save-excursion - (if ledger-narrow-on-reconcile - (ledger-occur account))) - (if (> (ledger-reconcile-refresh) 0) - (ledger-reconcile-change-target)) - (ledger-display-balance))))) + (when (ledger-reconcile-check-valid-account account) + (add-hook 'after-save-hook 'ledger-reconcile-refresh-after-save nil t) + + (if rbuf ;; *Reconcile* already exists + (with-current-buffer rbuf + (set 'ledger-acct account) ;; already buffer local + (when (not (eq buf rbuf)) + ;; called from some other ledger-mode buffer + (ledger-reconcile-quit-cleanup) + (setq ledger-buf buf)) ;; should already be buffer-local + + (unless (get-buffer-window rbuf) + (ledger-reconcile-open-windows buf rbuf))) + + ;; no recon-buffer, starting from scratch. + + (with-current-buffer (setq rbuf + (get-buffer-create ledger-recon-buffer-name)) + (ledger-reconcile-open-windows buf rbuf) + (ledger-reconcile-mode) + (make-local-variable 'ledger-target) + (set (make-local-variable 'ledger-buf) buf) + (set (make-local-variable 'ledger-acct) account))) + + ;; Narrow the ledger buffer + (with-current-buffer rbuf + (save-excursion + (if ledger-narrow-on-reconcile + (ledger-occur account))) + (if (> (ledger-reconcile-refresh) 0) + (ledger-reconcile-change-target)) + (ledger-display-balance))))) (defvar ledger-reconcile-mode-abbrev-table) @@ -495,7 +554,7 @@ moved and recentered. If they aren't strange things happen." (defmacro ledger-reconcile-change-sort-key-and-refresh (sort-by) "Set the sort-key to SORT-BY." - `(lambda () + `(lambda () (interactive) (setq ledger-reconcile-sort-key ,sort-by) |