Updated the Emacs interface to use the ledger executable more fully

(it doesn't do its own parsing anymore, for example).  Many things
should be faster, and things should work for users of earlier Emacsen.

1 files changed, 117 insertions, 144 deletions

diff --git a/ledger.el b/ledger.el
index 524fa80e..f957368c 100644
--- a/ledger.el
+++ b/ledger.el
@@ -4,7 +4,7 @@
 
 ;; Emacs Lisp Archive Entry
 ;; Filename: ledger.el
-;; Version: 1.1
+;; Version: 1.2
 ;; Date: Thu 02-Apr-2004
 ;; Keywords: data
 ;; Author: John Wiegley (johnw AT gnu DOT org)
@@ -38,12 +38,14 @@
 ;;   C-c C-a  add a new entry, based on previous entries
 ;;   C-c C-y  set default year for entry mode
 ;;   C-c C-m  set default month for entry mode
-;;   C-c C-r  reconcile the entries related to an account
+;;   C-c C-r  reconcile uncleared entries related to an account
 ;;
 ;; In the reconcile buffer, use SPACE to toggle the cleared status of
-;; a transaction.
+;; a transaction, C-x C-s to save changes (to the ledger file as
+;; well), or C-c C-r to attempt an auto-reconcilation based on the
+;; statement's ending date and balance.
 
-(defvar ledger-version "1.1"
+(defvar ledger-version "1.2"
   "The version of ledger.el currently loaded")
 
 (defgroup ledger nil
@@ -55,14 +57,7 @@
   :type 'file
   :group 'ledger)
 
-(defcustom ledger-data-file (or (getenv "LEDGER_FILE")
-				(getenv "LEDGER"))
-  "Path to the ledger data file."
-  :type 'file
-  :group 'ledger)
-
 (defvar bold 'bold)
-
 (defvar ledger-font-lock-keywords
   '(("^[0-9./]+\\s-+\\(?:([^)]+)\\s-+\\)?\\([^*].+\\)" 1 bold)
     ("^\\s-+.+?\\(  \\|\t\\|\\s-+$\\)" . font-lock-keyword-face))
@@ -70,14 +65,12 @@
 
 (defsubst ledger-current-year ()
   (format-time-string "%Y"))
-
 (defsubst ledger-current-month ()
   (format-time-string "%m"))
 
 (defvar ledger-year (ledger-current-year)
   "Start a ledger session with the current year, but make it
 customizable to ease retro-entry.")
-
 (defvar ledger-month (ledger-current-month)
   "Start a ledger session with the current month, but make it
 customizable to ease retro-entry.")
@@ -135,7 +128,9 @@ Return the difference in the format of a time value."
    (list
     (read-string "Entry: " (concat ledger-year "/" ledger-month "/"))))
   (let* ((date (car (split-string entry-text)))
-	 (insert-year t) exit-code)
+	 (insert-year t)
+	 (ledger-buf (current-buffer))
+	 exit-code)
     (if (string-match "\\([0-9]+\\)/\\([0-9]+\\)/\\([0-9]+\\)" date)
 	(setq date (encode-time 0 0 0 (string-to-int (match-string 3 date))
 				(string-to-int (match-string 2 date))
@@ -149,7 +144,7 @@ Return the difference in the format of a time value."
        (with-temp-buffer
 	 (setq exit-code
 	       (ledger-run-ledger
-		"entry"
+		ledger-buf "entry"
 		(with-temp-buffer
 		  (insert entry-text)
 		  (goto-char (point-min))
@@ -163,14 +158,6 @@ Return the difference in the format of a time value."
 	   (concat (if insert-year entry-text
 		     (substring entry-text 6)) "\n"))) "\n"))))
 
-(defun ledger-expand-entry ()
-  (interactive)
-  (ledger-add-entry (prog1
-			(buffer-substring (line-beginning-position)
-					  (line-end-position))
-		      (delete-region (line-beginning-position)
-				     (1+ (line-end-position))))))
-
 (defun ledger-toggle-current ()
   (interactive)
   (let (clear)
@@ -185,11 +172,6 @@ Return the difference in the format of a time value."
 	  (setq clear t))))
     clear))
 
-(defun ledger-print-result (command)
-  (interactive "sLedger command: ")
-  (shell-command (format "%s -f %s %s" ledger-binary-path
-			 buffer-file-name command)))
-
 (defvar ledger-mode-abbrev-table)
 
 (define-derived-mode ledger-mode text-mode "Ledger"
@@ -205,82 +187,35 @@ Return the difference in the format of a time value."
     (define-key map [(control ?c) (control ?y)] 'ledger-set-year)
     (define-key map [(control ?c) (control ?m)] 'ledger-set-month)
     (define-key map [(control ?c) (control ?c)] 'ledger-toggle-current)
-    (define-key map [(control ?c) (control ?p)] 'ledger-print-result)
     (define-key map [(control ?c) (control ?r)] 'ledger-reconcile)))
 
-(defun ledger-parse-entries (account &optional all-p)
-  (let (total entries)
-    (ledger-iterate-entries
-     (function
-      (lambda (start date mark desc)
-	(when (or all-p (not mark))
-	  (forward-line)
-	  (setq total 0.0)
-	  (while (looking-at
-		  (concat "\\s-+\\([A-Za-z_].+?\\)\\(\\s-*$\\|  \\s-*"
-			  "\\([^0-9]+\\)\\s-*\\([0-9,.]+\\)\\)?"
-			  "\\(\\s-+;.+\\)?$"))
-	    (let ((acct (match-string 1))
-		  (amt (match-string 4)))
-	      (when amt
-		(while (string-match "," amt)
-		  (setq amt (replace-match "" nil nil amt)))
-		(setq amt (string-to-number amt)
-		      total (+ total amt)))
-	      (if (string= account acct)
-		  (setq entries
-			(cons (list (copy-marker start)
-				    mark date desc (or amt total))
-			      entries)
-			all-p t)))
-	    (forward-line))))))
-    entries))
-
-(defvar ledger-reconcile-text "Reconcile")
-(defvar ledger-reconcile-mode-abbrev-table)
-
-(define-derived-mode ledger-reconcile-mode text-mode 'ledger-reconcile-text
-  "A mode for reconciling ledger entries."
-  (let ((map (make-sparse-keymap)))
-    (define-key map [? ] 'ledger-reconcile-toggle)
-    (define-key map [?q]
-      (function
-       (lambda ()
-	 (interactive)
-	 (kill-buffer (current-buffer)))))
-    (use-local-map map)))
-
-(add-to-list 'minor-mode-alist
-	     '(ledger-reconcile-mode ledger-reconcile-text))
+;; Reconcile mode
 
 (defvar ledger-buf nil)
 (defvar ledger-acct nil)
 
-(defun ledger-update-balance-display ()
-  (let ((account ledger-acct))
+(defun ledger-display-balance ()
+  (let ((buffer ledger-buf)
+	(account ledger-acct))
     (with-temp-buffer
-      (let ((exit-code (ledger-run-ledger "-C" "balance"
-					  (concat "\"" account "\""))))
+      (let ((exit-code (ledger-run-ledger buffer "-C" "balance" account)))
 	(if (/= 0 exit-code)
-	    (setq ledger-reconcile-text "Reconcile [ERR]")
+	    (message "Error determining cleared balance")
 	  (goto-char (point-min))
 	  (delete-horizontal-space)
 	  (skip-syntax-forward "^ ")
-	  (setq ledger-reconcile-text
-		(concat "Reconcile ["
-			(buffer-substring-no-properties (point-min) (point))
-			"]"))))))
-  (force-mode-line-update))
+	  (message "Cleared balance = %s"
+		   (buffer-substring-no-properties (point-min) (point))))))))
 
-(defun ledger-reconcile-toggle (&optional no-update)
+(defun ledger-reconcile-toggle ()
   (interactive)
   (let ((where (get-text-property (point) 'where))
 	(account ledger-acct)
+	(inhibit-read-only t)
 	cleared)
     (with-current-buffer ledger-buf
       (goto-char where)
-      (setq cleared (ledger-toggle-current))
-      (save-buffer))
+      (setq cleared (ledger-toggle-current)))
     (if cleared
 	(add-text-properties (line-beginning-position)
 			     (line-end-position)
@@ -288,65 +223,101 @@ Return the difference in the format of a time value."
       (remove-text-properties (line-beginning-position)
 			      (line-end-position)
 			      (list 'face)))
-    (forward-line)
-    (unless no-update
-      (ledger-update-balance-display))))
+    (forward-line)))
 
-(defun ledger-reconcile (account &optional arg)
-  (interactive "sAccount to reconcile: \nP")
-  (let* ((items (save-excursion
-		  (goto-char (point-min))
-		  (ledger-parse-entries account)))
-	 (buf (current-buffer)))
+(defun ledger-auto-reconcile (balance date)
+  (interactive "sReconcile to balance: \nsStatement date: ")
+  (let ((buffer ledger-buf)
+	(account ledger-acct) cleared)
+    ;; attempt to auto-reconcile in the background
+    (with-temp-buffer
+      (let ((exit-code
+	     (ledger-run-ledger
+	      buffer "--format" "\"%B\\n\"" "--reconcile"
+	      (with-temp-buffer
+		(insert balance)
+		(goto-char (point-min))
+		(while (re-search-forward "\\([&$]\\)" nil t)
+		  (replace-match "\\\\\\1"))
+		(buffer-string))
+	      "--reconcile-date" date "register" account)))
+	(when (= 0 exit-code)
+	  (goto-char (point-min))
+	  (unless (looking-at "[0-9]")
+	    (error (buffer-string)))
+	  (while (not (eobp))
+	    (setq cleared
+		  (cons (1+ (read (current-buffer))) cleared))
+	    (forward-line)))))
+    (goto-char (point-min))
+    (with-current-buffer ledger-buf
+      (setq cleared (mapcar 'copy-marker (nreverse cleared))))
+    (let ((inhibit-redisplay t))
+      (dolist (pos cleared)
+	(while (and (not (eobp))
+		    (/= pos (get-text-property (point) 'where)))
+	  (forward-line))
+	(unless (eobp)
+	  (ledger-reconcile-toggle))))
+    (goto-char (point-min))))
+
+(defun ledger-reconcile-save ()
+  (interactive)
+  (with-current-buffer ledger-buf
+    (write-region (point-min) (point-max) (buffer-file-name) nil 1)
+    (set-buffer-modified-p nil))
+  (set-buffer-modified-p nil)
+  (ledger-display-balance))
+
+(defun ledger-reconcile (account)
+  (interactive "sAccount to reconcile: ")
+  (let* ((buf (current-buffer))
+	 (items
+	  (with-temp-buffer
+	    (let ((exit-code
+		   (ledger-run-ledger buf "--reconcilable" "emacs" account)))
+	      (when (= 0 exit-code)
+		(goto-char (point-min))
+		(unless (looking-at "(")
+		  (error (buffer-string)))
+		(read (current-buffer)))))))
     (with-current-buffer
 	(pop-to-buffer (generate-new-buffer "*Reconcile*"))
       (ledger-reconcile-mode)
       (set (make-local-variable 'ledger-buf) buf)
       (set (make-local-variable 'ledger-acct) account)
-      (ledger-update-balance-display)
       (dolist (item items)
-	(let ((beg (point)))
-	  (insert (format "%s %-30s %8.2f\n"
-			  (format-time-string "%Y/%m/%d" (nth 2 item))
-			  (nth 3 item) (nth 4 item)))
-	  (if (nth 1 item)
+	(dolist (xact (nthcdr 5 item))
+	  (let ((beg (point)))
+	    (insert (format "%s %-30s %-25s %15s\n"
+			    (format-time-string "%m/%d" (nth 2 item))
+			    (nth 4 item) (nth 0 xact) (nth 1 xact)))
+	    (if (nth 1 item)
+		(set-text-properties beg (1- (point))
+				     (list 'face 'bold
+					   'where (nth 0 item)))
 	      (set-text-properties beg (1- (point))
-				   (list 'face 'bold
-					 'where (nth 0 item)))
-	    (set-text-properties beg (1- (point))
-				 (list 'where (nth 0 item)))))
-	(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))))))
+				   (list 'where (nth 0 item)))))))
+      (goto-char (point-min))
+      (set-buffer-modified-p nil)
+      (toggle-read-only t))))
+
+(defvar ledger-reconcile-mode-abbrev-table)
+
+(define-derived-mode ledger-reconcile-mode text-mode "Reconcile"
+  "A mode for reconciling ledger entries."
+  (let ((map (make-sparse-keymap)))
+    (define-key map [(control ?c) (control ?r)] 'ledger-auto-reconcile)
+    (define-key map [(control ?x) (control ?s)] 'ledger-reconcile-save)
+    (define-key map [? ] 'ledger-reconcile-toggle)
+    (define-key map [?q]
+      (function
+       (lambda ()
+	 (interactive)
+	 (kill-buffer (current-buffer)))))
+    (use-local-map map)))
+
+;; A sample function for $ users
 
 (defun ledger-align-dollars (&optional column)
   (interactive "p")
@@ -372,14 +343,16 @@ Return the difference in the format of a time value."
 	  (insert "  ")))
       (forward-line))))
 
-(defun ledger-run-ledger (&rest args)
+;; General helper functions
+
+(defun ledger-run-ledger (buffer &rest args)
   "run ledger with supplied arguments"
-  (let ((command
-	 (mapconcat 'identity
-		    (append (list ledger-binary-path
-				  "-f" ledger-data-file) args) " ")))
-    (insert (shell-command-to-string command)))
-  0)
+  (let ((buf (current-buffer)))
+    (with-current-buffer buffer
+      (apply #'call-process-region
+	     (append (list (point-min) (point-max)
+			   ledger-binary-path nil buf nil "-f" "-")
+		     args)))))
 
 (defun ledger-set-year (newyear)
   "Set ledger's idea of the current year to the prefix argument."