Added Ledger error handling. No more lisp backtraces!

This commit is contained in:
Craig Earls 2013-03-08 00:08:25 -05:00
parent cdd7f0675c
commit 8f4b0e8962
2 changed files with 77 additions and 57 deletions

View file

@ -40,10 +40,26 @@
:type 'file :type 'file
:group 'ledger-exec) :group 'ledger-exec)
(defun ledger-exec-handle-error (ledger-output)
"Deal with ledger errors contained in LEDGER-OUTPUT."
(with-current-buffer (get-buffer-create "*Ledger Error*")
(insert-buffer-substring ledger-output)
(make-frame)
(fit-frame)
(view-mode)
(toggle-read-only)))
(defun ledger-exec-success-p (ledger-output-buffer)
(with-current-buffer ledger-output-buffer
(goto-char (point-min))
(if (and (> (buffer-size) 1) (looking-at (regexp-quote "While")))
nil
ledger-output-buffer)))
(defun ledger-exec-ledger (input-buffer &optional output-buffer &rest args) (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 and optionally capturing output in OUTPUT-BUFFER with ARGS."
(if (null ledger-binary-path) (if (null ledger-binary-path)
(error "The variable `ledger-binary-path' has not been set")) (error "The variable `ledger-binary-path' has not been set")
(let ((buf (or input-buffer (current-buffer))) (let ((buf (or input-buffer (current-buffer)))
(outbuf (or output-buffer (outbuf (or output-buffer
(generate-new-buffer " *ledger-tmp*")))) (generate-new-buffer " *ledger-tmp*"))))
@ -54,16 +70,18 @@
(append (list (point-min) (point-max) (append (list (point-min) (point-max)
ledger-binary-path nil outbuf nil "-f" "-") ledger-binary-path nil outbuf nil "-f" "-")
args))) args)))
outbuf))) (if (ledger-exec-success-p outbuf)
outbuf
(ledger-exec-handle-error outbuf))))))
(defun ledger-exec-read (&optional input-buffer &rest args) ;; (defun ledger-exec-read (&optional input-buffer &rest args)
"Run ledger from option INPUT-BUFFER using ARGS, return a list structure of the ledger Emacs output." ;; "Run ledger from option INPUT-BUFFER using ARGS, return a list structure of the ledger Emacs output."
(with-current-buffer ;; (with-current-buffer
(apply #'ledger-exec-ledger input-buffer nil "emacs" args) ;; (apply #'ledger-exec-ledger input-buffer nil "emacs" args)
(goto-char (point-min)) ;; (goto-char (point-min))
(prog1 ;; (prog1
(read (current-buffer)) ;; (read (current-buffer))
(kill-buffer (current-buffer))))) ;; (kill-buffer (current-buffer)))))
(defun ledger-version-greater-p (needed) (defun ledger-version-greater-p (needed)
"Verify the ledger binary is usable for `ledger-mode' (version greater than NEEDED)." "Verify the ledger binary is usable for `ledger-mode' (version greater than NEEDED)."
@ -71,17 +89,18 @@
(version-strings '()) (version-strings '())
(version-number)) (version-number))
(with-temp-buffer (with-temp-buffer
(ledger-exec-ledger buffer (current-buffer) "--version") (if (ledger-exec-ledger (current-buffer) (current-buffer) "--version")
(progn
(goto-char (point-min)) (goto-char (point-min))
(delete-horizontal-space) (delete-horizontal-space)
(setq version-strings (split-string (setq version-strings (split-string
(buffer-substring-no-properties (point) (buffer-substring-no-properties (point)
(+ (point) 12)))) (point-max))))
(if (and (string-match (regexp-quote "Ledger") (car version-strings)) (if (and (string-match (regexp-quote "Ledger") (car version-strings))
(or (string= needed (car (cdr version-strings))) (or (string= needed (car (cdr version-strings)))
(string< needed (car (cdr version-strings))))) (string< needed (car (cdr version-strings)))))
t t
nil)))) nil))))))
(defun ledger-check-version () (defun ledger-check-version ()
"Verify that ledger works and is modern enough." "Verify that ledger works and is modern enough."

View file

@ -74,28 +74,25 @@ reconcile-finish will mark all pending posting cleared."
;; separated from the actual format string. emacs does not ;; separated from the actual format string. emacs does not
;; split arguments like the shell does, so you need to ;; split arguments like the shell does, so you need to
;; specify the individual fields in the command line. ;; specify the individual fields in the command line.
(ledger-exec-ledger buffer (current-buffer) (if (ledger-exec-ledger buffer (current-buffer)
"balance" "--limit" "cleared or pending" "--empty" "balance" "--limit" "cleared or pending" "--empty"
"--format" "%(display_total)" account) "--format" "%(display_total)" account)
(setq val (setq val
(ledger-split-commodity-string (ledger-split-commodity-string
(buffer-substring-no-properties (point-min) (point-max))))))) (buffer-substring-no-properties (point-min) (point-max))))))))
(defun ledger-display-balance () (defun ledger-display-balance ()
"Display the cleared-or-pending balance. "Display the cleared-or-pending balance.
And calculate the target-delta of the account being reconciled." And calculate the target-delta of the account being reconciled."
(interactive) (interactive)
(let* ((pending (ledger-reconcile-get-cleared-or-pending-balance)) (let* ((pending (ledger-reconcile-get-cleared-or-pending-balance)))
(target-delta (if ledger-target (if pending
(-commodity ledger-target pending) (if ledger-target
nil)))
(if target-delta
(message "Pending balance: %s, Difference from target: %s" (message "Pending balance: %s, Difference from target: %s"
(ledger-commodity-to-string pending) (ledger-commodity-to-string pending)
(ledger-commodity-to-string target-delta)) (ledger-commodity-to-string (-commodity ledger-target pending)))
(message "Pending balance: %s" (message "Pending balance: %s"
(ledger-commodity-to-string pending))))) (ledger-commodity-to-string pending))))))
@ -276,16 +273,18 @@ POSTING is used in `ledger-clear-whole-transactions' is nil."
"Get the uncleared transactions in the account and display them in the *Reconcile* buffer." "Get the uncleared transactions in the account and display them in the *Reconcile* buffer."
(let* ((buf ledger-buf) (let* ((buf ledger-buf)
(account ledger-acct) (account ledger-acct)
(ledger-success nil)
(xacts (xacts
(with-temp-buffer (with-temp-buffer
(ledger-exec-ledger buf (current-buffer) (if (ledger-exec-ledger buf (current-buffer)
"--uncleared" "--real" "emacs" account) "--uncleared" "--real" "emacs" account)
(progn
(setq ledger-success t)
(goto-char (point-min)) (goto-char (point-min))
(unless (eobp) (unless (eobp)
(unless (looking-at "(") (if (looking-at "(")
(error (concat "ledger-do-reconcile: " (buffer-string)))) (read (current-buffer))))))))) ;current-buffer is the *temp* created above
(read (current-buffer)))))) ;current-buffer is the *temp* created above (if (and ledger-success (> (length xacts) 0))
(if (> (length xacts) 0)
(progn (progn
(dolist (xact xacts) (dolist (xact xacts)
(dolist (posting (nthcdr 5 xact)) (dolist (posting (nthcdr 5 xact))
@ -310,7 +309,9 @@ POSTING is used in `ledger-clear-whole-transactions' is nil."
'where where)))) )) 'where where)))) ))
(goto-char (point-max)) (goto-char (point-max))
(delete-char -1)) ;gets rid of the extra line feed at the bottom of the list (delete-char -1)) ;gets rid of the extra line feed at the bottom of the list
(insert (concat "There are no uncleared entries for " account))) (if ledger-success
(insert (concat "There are no uncleared entries for " account))
(insert "Ledger has reported a problem. Check *Ledger Error* buffer.")))
(goto-char (point-min)) (goto-char (point-min))
(set-buffer-modified-p nil) (set-buffer-modified-p nil)
(toggle-read-only t) (toggle-read-only t)