From c240ec23fa55fa5520b611d7f74ca9e19fe8b7d7 Mon Sep 17 00:00:00 2001 From: John Wiegley Date: Wed, 9 Feb 2005 12:13:21 +0000 Subject: (ledger-reconcile): If a prefix argument is passed to C-c C-r (ledger-reconcile), then it will attempt to use the auto-reconciler to pre-mark the uncleared transactions. Note that if it fails, and the uncleared list is long, it might appear to hang. It's far from fool-proof, but when it does work, it's like magic! --- ledger.el | 42 +++++++++++++++++++++++++++++++++++++----- 1 file changed, 37 insertions(+), 5 deletions(-) diff --git a/ledger.el b/ledger.el index 8fdffa90..524fa80e 100644 --- a/ledger.el +++ b/ledger.el @@ -272,7 +272,7 @@ Return the difference in the format of a time value." "]")))))) (force-mode-line-update)) -(defun ledger-reconcile-toggle () +(defun ledger-reconcile-toggle (&optional no-update) (interactive) (let ((where (get-text-property (point) 'where)) (account ledger-acct) @@ -289,10 +289,11 @@ Return the difference in the format of a time value." (line-end-position) (list 'face))) (forward-line) - (ledger-update-balance-display))) + (unless no-update + (ledger-update-balance-display)))) -(defun ledger-reconcile (account) - (interactive "sAccount to reconcile: ") +(defun ledger-reconcile (account &optional arg) + (interactive "sAccount to reconcile: \nP") (let* ((items (save-excursion (goto-char (point-min)) (ledger-parse-entries account))) @@ -314,7 +315,38 @@ Return the difference in the format of a time value." 'where (nth 0 item))) (set-text-properties beg (1- (point)) (list 'where (nth 0 item))))) - (goto-char (point-min)))))) + (goto-char (point-min))) + (when arg + (let (cleared) + ;; attempt to auto-reconcile in the background + (with-temp-buffer + (let ((exit-code + (ledger-run-ledger + "--format" "\"%B\\n\"" "reconcile" + (concat "\"" account "\"") + (with-temp-buffer + (insert (read-string "Reconcile account to: ")) + (goto-char (point-min)) + (while (re-search-forward "\\([&$]\\)" nil t) + (replace-match "\\\\\\1")) + (buffer-string))))) + (when (= 0 exit-code) + (goto-char (point-min)) + (while (not (eobp)) + (setq cleared + (cons (1+ (read (current-buffer))) cleared)) + (forward-line))))) + (goto-char (point-min)) + (with-current-buffer buf + (setq cleared (mapcar 'copy-marker (nreverse cleared)))) + (dolist (pos cleared) + (while (and (not (eobp)) + (/= pos (get-text-property (point) 'where))) + (forward-line)) + (unless (eobp) + (ledger-reconcile-toggle t))) + (goto-char (point-min)) + (ledger-update-balance-display)))))) (defun ledger-align-dollars (&optional column) (interactive "p") -- cgit v1.2.3