Added Ledger error handling. No more lisp backtraces!
This commit is contained in:
Craig Earls
parent
cdd7f0675c
commit
8f4b0e8962
2 changed files with 77 additions and 57 deletions
|
|
@ -40,30 +40,48 @@
|
|||
:type 'file
|
||||
: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)
|
||||
"Run Ledger using INPUT-BUFFER and optionally capturing output in OUTPUT-BUFFER with ARGS."
|
||||
(if (null ledger-binary-path)
|
||||
(error "The variable `ledger-binary-path' has not been set"))
|
||||
(let ((buf (or input-buffer (current-buffer)))
|
||||
(outbuf (or output-buffer
|
||||
(generate-new-buffer " *ledger-tmp*"))))
|
||||
(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)))
|
||||
outbuf)))
|
||||
(error "The variable `ledger-binary-path' has not been set")
|
||||
(let ((buf (or input-buffer (current-buffer)))
|
||||
(outbuf (or output-buffer
|
||||
(generate-new-buffer " *ledger-tmp*"))))
|
||||
(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))))))
|
||||
|
||||
(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."
|
||||
(with-current-buffer
|
||||
(apply #'ledger-exec-ledger input-buffer nil "emacs" args)
|
||||
(goto-char (point-min))
|
||||
(prog1
|
||||
(read (current-buffer))
|
||||
(kill-buffer (current-buffer)))))
|
||||
;; (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."
|
||||
;; (with-current-buffer
|
||||
;; (apply #'ledger-exec-ledger input-buffer nil "emacs" args)
|
||||
;; (goto-char (point-min))
|
||||
;; (prog1
|
||||
;; (read (current-buffer))
|
||||
;; (kill-buffer (current-buffer)))))
|
||||
|
||||
(defun ledger-version-greater-p (needed)
|
||||
"Verify the ledger binary is usable for `ledger-mode' (version greater than NEEDED)."
|
||||
|
|
@ -71,17 +89,18 @@
|
|||
(version-strings '())
|
||||
(version-number))
|
||||
(with-temp-buffer
|
||||
(ledger-exec-ledger buffer (current-buffer) "--version")
|
||||
(goto-char (point-min))
|
||||
(delete-horizontal-space)
|
||||
(setq version-strings (split-string
|
||||
(buffer-substring-no-properties (point)
|
||||
(+ (point) 12))))
|
||||
(if (and (string-match (regexp-quote "Ledger") (car version-strings))
|
||||
(or (string= needed (car (cdr version-strings)))
|
||||
(string< needed (car (cdr version-strings)))))
|
||||
t
|
||||
nil))))
|
||||
(if (ledger-exec-ledger (current-buffer) (current-buffer) "--version")
|
||||
(progn
|
||||
(goto-char (point-min))
|
||||
(delete-horizontal-space)
|
||||
(setq version-strings (split-string
|
||||
(buffer-substring-no-properties (point)
|
||||
(point-max))))
|
||||
(if (and (string-match (regexp-quote "Ledger") (car version-strings))
|
||||
(or (string= needed (car (cdr version-strings)))
|
||||
(string< needed (car (cdr version-strings)))))
|
||||
t
|
||||
nil))))))
|
||||
|
||||
(defun ledger-check-version ()
|
||||
"Verify that ledger works and is modern enough."
|
||||
|
|
|
|||
|
|
@ -74,28 +74,25 @@ reconcile-finish will mark all pending posting cleared."
|
|||
;; 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.
|
||||
(ledger-exec-ledger buffer (current-buffer)
|
||||
"balance" "--limit" "cleared or pending" "--empty"
|
||||
"--format" "%(display_total)" account)
|
||||
(setq val
|
||||
(ledger-split-commodity-string
|
||||
(buffer-substring-no-properties (point-min) (point-max)))))))
|
||||
(if (ledger-exec-ledger buffer (current-buffer)
|
||||
"balance" "--limit" "cleared or pending" "--empty"
|
||||
"--format" "%(display_total)" account)
|
||||
(setq val
|
||||
(ledger-split-commodity-string
|
||||
(buffer-substring-no-properties (point-min) (point-max))))))))
|
||||
|
||||
(defun ledger-display-balance ()
|
||||
"Display the cleared-or-pending balance.
|
||||
And calculate the target-delta of the account being reconciled."
|
||||
(interactive)
|
||||
(let* ((pending (ledger-reconcile-get-cleared-or-pending-balance))
|
||||
(target-delta (if ledger-target
|
||||
(-commodity ledger-target pending)
|
||||
nil)))
|
||||
|
||||
(if target-delta
|
||||
(message "Pending balance: %s, Difference from target: %s"
|
||||
(ledger-commodity-to-string pending)
|
||||
(ledger-commodity-to-string target-delta))
|
||||
(message "Pending balance: %s"
|
||||
(ledger-commodity-to-string pending)))))
|
||||
(let* ((pending (ledger-reconcile-get-cleared-or-pending-balance)))
|
||||
(if pending
|
||||
(if ledger-target
|
||||
(message "Pending balance: %s, Difference from target: %s"
|
||||
(ledger-commodity-to-string pending)
|
||||
(ledger-commodity-to-string (-commodity ledger-target pending)))
|
||||
(message "Pending balance: %s"
|
||||
(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."
|
||||
(let* ((buf ledger-buf)
|
||||
(account ledger-acct)
|
||||
(ledger-success nil)
|
||||
(xacts
|
||||
(with-temp-buffer
|
||||
(ledger-exec-ledger buf (current-buffer)
|
||||
"--uncleared" "--real" "emacs" account)
|
||||
(goto-char (point-min))
|
||||
(unless (eobp)
|
||||
(unless (looking-at "(")
|
||||
(error (concat "ledger-do-reconcile: " (buffer-string))))
|
||||
(read (current-buffer)))))) ;current-buffer is the *temp* created above
|
||||
(if (> (length xacts) 0)
|
||||
(if (ledger-exec-ledger buf (current-buffer)
|
||||
"--uncleared" "--real" "emacs" account)
|
||||
(progn
|
||||
(setq ledger-success t)
|
||||
(goto-char (point-min))
|
||||
(unless (eobp)
|
||||
(if (looking-at "(")
|
||||
(read (current-buffer))))))))) ;current-buffer is the *temp* created above
|
||||
(if (and ledger-success (> (length xacts) 0))
|
||||
(progn
|
||||
(dolist (xact xacts)
|
||||
(dolist (posting (nthcdr 5 xact))
|
||||
|
|
@ -310,7 +309,9 @@ POSTING is used in `ledger-clear-whole-transactions' is nil."
|
|||
'where where)))) ))
|
||||
(goto-char (point-max))
|
||||
(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))
|
||||
(set-buffer-modified-p nil)
|
||||
(toggle-read-only t)
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue