More robustly execute ledger

- Always check exit code, and consider non-zero to be a failure
- Redirect stderr to avoid warnings from polluting captured output (fixes #38)
- Fix ledger-add-transaction, which wrapped ledger execution with its own (broken) error handling

3 files changed, 47 insertions, 42 deletions

diff --git a/ledger-exec.el b/ledger-exec.el
index e7ad269..22f824e 100644
--- a/ledger-exec.el
+++ b/ledger-exec.el
@@ -45,38 +45,48 @@
   :type 'file
   :group 'ledger-exec)
 
-(defun ledger-exec-handle-error (ledger-output)
-  "Deal with ledger errors contained in LEDGER-OUTPUT."
+(defun ledger-exec-handle-error (ledger-errfile)
+  "Deal with ledger errors contained in LEDGER-ERRFILE."
   (with-current-buffer (get-buffer-create "*Ledger Error*")
-    (insert-buffer-substring ledger-output)
+    (let ((buffer-read-only nil))
+      (delete-region (point-min) (point-max))
+      (insert-file-contents ledger-errfile))
     (view-mode)
-    (setq buffer-read-only t)))
+    (setq buffer-read-only t)
+    (current-buffer)))
 
-(defun ledger-exec-success-p (ledger-output-buffer)
-  "Return t if the ledger output in LEDGER-OUTPUT-BUFFER is successful."
+(defun ledger-exec-success-p (exit-code ledger-output-buffer)
+  "Return t if EXIT-CODE is non-zero and output in LEDGER-OUTPUT-BUFFER is successful."
   (with-current-buffer ledger-output-buffer
     (goto-char (point-min))
-    (if (and (> (buffer-size) 1) (looking-at (regexp-quote "While")))
+    (if (or (not (zerop exit-code))
+            (and (> (buffer-size) 1) (looking-at (regexp-quote "While"))))
         nil  ;; failure, there is an error starting with "While"
       ledger-output-buffer)))
 
 (defun ledger-exec-ledger (input-buffer &optional output-buffer &rest args)
-  "Run Ledger using INPUT-BUFFER and optionally capturing output in OUTPUT-BUFFER with ARGS."
+  "Run Ledger using INPUT-BUFFER.
+Optionally capture output in OUTPUT-BUFFER, and pass ARGS on the
+command line.  Returns OUTPUT-BUFFER if ledger succeeded,
+otherwise the error output is displayed and an error is raised."
   (if (null ledger-binary-path)
       (error "The variable `ledger-binary-path' has not been set")
     (let ((buf (or input-buffer (find-file-noselect (ledger-master-file))))
           (outbuf (or output-buffer
-                      (generate-new-buffer " *ledger-tmp*"))))
+                      (generate-new-buffer " *ledger-tmp*")))
+          (errfile (make-temp-file "ledger-errors")))
       (with-current-buffer buf
-        (let ((coding-system-for-write 'utf-8)
-              (coding-system-for-read 'utf-8))
-          (apply #'call-process-region
-                 (append (list (point-min) (point-max)
-                               ledger-binary-path nil outbuf nil "-f" "-")
-                         args)))
-        (if (ledger-exec-success-p outbuf)
-            outbuf
-          (ledger-exec-handle-error outbuf))))))
+        (let ((exit-code
+               (let ((coding-system-for-write 'utf-8)
+                     (coding-system-for-read 'utf-8))
+                 (apply #'call-process-region
+                        (append (list (point-min) (point-max)
+                                      ledger-binary-path nil (list outbuf errfile) nil "-f" "-")
+                                args)))))
+          (if (ledger-exec-success-p exit-code outbuf)
+              outbuf
+            (display-buffer (ledger-exec-handle-error errfile))
+            (error "Ledger execution failed")))))))
 
 (defun ledger-version-greater-p (needed)
   "Verify the ledger binary is usable for `ledger-mode' (version greater than NEEDED)."
diff --git a/ledger-reconcile.el b/ledger-reconcile.el
index 25f1f04..b78a947 100644
--- a/ledger-reconcile.el
+++ b/ledger-reconcile.el
@@ -179,11 +179,11 @@ Possible values are '(date)', '(amount)', '(payee)' or '(0)' for no sorting, i.e
     ;; separated from the actual format string.  emacs does not
     ;; split arguments like the shell does, so you need to
     ;; specify the individual fields in the command line.
-    (if (ledger-exec-ledger buffer (current-buffer)
-                            "balance" "--limit" "cleared or pending" "--empty" "--collapse"
-                            "--format" "%(scrub(display_total))" account)
-        (ledger-split-commodity-string
-         (buffer-substring-no-properties (point-min) (point-max))))))
+    (ledger-exec-ledger buffer (current-buffer)
+                        "balance" "--limit" "cleared or pending" "--empty" "--collapse"
+                        "--format" "%(scrub(display_total))" account)
+    (ledger-split-commodity-string
+     (buffer-substring-no-properties (point-min) (point-max)))))
 
 (defun ledger-display-balance ()
   "Display the cleared-or-pending balance.
@@ -441,21 +441,19 @@ POSTING is used in `ledger-clear-whole-transactions' is nil."
 Return a count of the uncleared transactions."
   (let* ((buf ledger-buf)
          (account ledger-acct)
-         (ledger-success nil)
          (sort-by (if sort
                       sort
                     "(date)"))
          (xacts
           (with-temp-buffer
-            (when (ledger-exec-ledger buf (current-buffer)
-                                      "--uncleared" "--real" "emacs" "--sort" sort-by account)
-              (setq ledger-success t)
-              (goto-char (point-min))
-              (unless (eobp)
-                (if (looking-at "(")
-                    (read (current-buffer)))))))  ;current-buffer is the *temp* created above
+            (ledger-exec-ledger buf (current-buffer)
+                                "--uncleared" "--real" "emacs" "--sort" sort-by account)
+            (goto-char (point-min))
+            (unless (eobp)
+              (if (looking-at "(")
+                  (read (current-buffer))))))
          (fmt (ledger-reconcile-compile-format-string ledger-reconcile-buffer-line-format)))
-    (if (and ledger-success (> (length xacts) 0))
+    (if (> (length xacts) 0)
         (progn
           (if ledger-reconcile-buffer-header
               (insert (format ledger-reconcile-buffer-header account)))
@@ -463,9 +461,7 @@ Return a count of the uncleared transactions."
             (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
-          (insert (concat "There are no uncleared entries for " account))
-        (insert "Ledger has reported a problem.  Check *Ledger Error* buffer.")))
+      (insert (concat "There are no uncleared entries for " account)))
     (goto-char (point-min))
     (set-buffer-modified-p nil)
     (setq buffer-read-only t)
diff --git a/ledger-xact.el b/ledger-xact.el
index 38e619c..90ec419 100644
--- a/ledger-xact.el
+++ b/ledger-xact.el
@@ -73,6 +73,7 @@
 
 (defun ledger-time-less-p (t1 t2)
   "Say whether time value T1 is less than time value T2."
+  ;; TODO: assert listp, or support when both are strings
   (or (< (car t1) (car t2))
       (and (= (car t1) (car t2))
            (< (nth 1 t1) (nth 1 t2)))))
@@ -178,19 +179,17 @@ correct chronological place in the buffer."
       (let* ((date (car args))
              (parsed-date (ledger-parse-iso-date date)))
         (setq ledger-add-transaction-last-date parsed-date)
+        ;; TODO: what about when it can't be parsed?
         (ledger-xact-find-slot (or parsed-date date))))
     (if (> (length args) 1)
         (save-excursion
           (insert
            (with-temp-buffer
-             (setq exit-code
-                   (apply #'ledger-exec-ledger ledger-buf (current-buffer) "xact"
-                          (mapcar 'eval args)))
+             (apply #'ledger-exec-ledger ledger-buf (current-buffer) "xact"
+                    (mapcar 'eval args))
              (goto-char (point-min))
-             (if (looking-at "Error: ")
-                 (error (concat "Error in ledger-add-transaction: " (buffer-string)))
-               (ledger-post-align-postings (point-min) (point-max))
-               (buffer-string)))
+             (ledger-post-align-postings (point-min) (point-max))
+             (buffer-string))
            "\n"))
       (progn
         (insert (car args) " \n\n")