diff options
| -rw-r--r-- | lisp/ldg-exec.el | 45 | ||||
| -rw-r--r-- | lisp/ldg-reconcile.el | 41 | ||||
| -rw-r--r-- | lisp/ldg-register.el | 60 |
3 files changed, 84 insertions, 62 deletions
diff --git a/lisp/ldg-exec.el b/lisp/ldg-exec.el index d740fccc..3881f8e9 100644 --- a/lisp/ldg-exec.el +++ b/lisp/ldg-exec.el @@ -1,4 +1,4 @@ -(defgroup ledger-binary nil +(defgroup ledger-exec nil "Interface to the Ledger command-line accounting program." :group 'ledger) @@ -7,27 +7,28 @@ :type 'file :group 'ledger) -(defvar ledger-delete-after nil) +(defun ledger-exec-ledger (input-buffer &optional output-buffer &rest args) + "Run Ledger." + (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))) -(defun ledger-run-ledger (buffer &rest args) - "run ledger with supplied arguments" - ;; Let's try again, just in case they moved it while we were sleeping. - (cond - ((null ledger-binary-path) - (error "The variable `ledger-binary-path' has not been set")) - (t - (let ((buf (current-buffer))) - (with-current-buffer buffer - (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 ledger-delete-after - buf nil "-f" "-") - args)))))))) - -(defun ledger-run-ledger-and-delete (buffer &rest args) - (let ((ledger-delete-after t)) - (apply #'ledger-run-ledger buffer args))) +(defun ledger-exec-read (&optional input-buffer &rest args) + (with-current-buffer + (apply #'ledger-exec-ledger input-buffer nil "emacs" args) + (goto-char (point-min)) + (prog1 + (read (current-buffer)) + (kill-buffer (current-buffer))))) (provide 'ldg-exec) diff --git a/lisp/ldg-reconcile.el b/lisp/ldg-reconcile.el index e19e0705..3be882f4 100644 --- a/lisp/ldg-reconcile.el +++ b/lisp/ldg-reconcile.el @@ -105,46 +105,7 @@ (ledger-reconcile-save)) (defun ledger-do-reconcile () - (let* ((buf ledger-buf) - (account ledger-acct) - (items - (with-temp-buffer - (let ((exit-code - (ledger-run-ledger buf "--uncleared" "emacs" account))) - (when (= 0 exit-code) - (goto-char (point-min)) - (unless (eobp) - (unless (looking-at "(") - (error (buffer-string))) - (read (current-buffer)))))))) - (dolist (item items) - (let ((index 1)) - (dolist (xact (nthcdr 5 item)) - (let ((beg (point)) - (where - (with-current-buffer buf - (cons - (nth 0 item) - (if ledger-clear-whole-entries - (save-excursion - (goto-line (nth 1 item)) - (point-marker)) - (save-excursion - (goto-line (nth 0 xact)) - (point-marker))))))) - (insert (format "%s %-30s %-25s %15s\n" - (format-time-string "%m/%d" (nth 2 item)) - (nth 4 item) (nth 1 xact) (nth 2 xact))) - (if (nth 3 xact) - (set-text-properties beg (1- (point)) - (list 'face 'bold - 'where where)) - (set-text-properties beg (1- (point)) - (list 'where where)))) - (setq index (1+ index))))) - (goto-char (point-min)) - (set-buffer-modified-p nil) - (toggle-read-only t))) + ) (defun ledger-reconcile (account) (interactive "sAccount to reconcile: ") diff --git a/lisp/ldg-register.el b/lisp/ldg-register.el index 8f0c8195..93611345 100644 --- a/lisp/ldg-register.el +++ b/lisp/ldg-register.el @@ -1,7 +1,67 @@ (require 'ldg-post) +(require 'ldg-state) (defgroup ledger-register nil "" :group 'ledger) +(defcustom ledger-register-date-format "%m/%d/%y" + "*The date format used for ledger register reports." + :type 'string + :group 'ledger-register) + +(defcustom ledger-register-line-format "%s %-30.30s %-25.25s %15s\n" + "*The date format used for ledger register reports." + :type 'string + :group 'ledger-register) + +(defface ledger-register-pending-face + '((((background light)) (:weight bold)) + (((background dark)) (:weight bold))) + "Face used to highlight pending entries in a register report." + :group 'ledger-register) + +(defun ledger-register-render (data-buffer posts) + (dolist (post posts) + (let ((index 1)) + (dolist (xact (nthcdr 5 post)) + (let ((beg (point)) + (where + (with-current-buffer data-buffer + (cons + (nth 0 post) + (if ledger-clear-whole-entries + (save-excursion + (goto-line (nth 1 post)) + (point-marker)) + (save-excursion + (goto-line (nth 0 xact)) + (point-marker))))))) + (insert (format ledger-register-line-format + (format-time-string ledger-register-date-format + (nth 2 post)) + (nth 4 post) (nth 1 xact) (nth 2 xact))) + (if (nth 3 xact) + (set-text-properties beg (1- (point)) + (list 'face 'ledger-register-pending-face + 'where where)) + (set-text-properties beg (1- (point)) + (list 'where where)))) + (setq index (1+ index))))) + (goto-char (point-min)) + ) + +(defun ledger-register-generate (&optional data-buffer &rest args) + (let ((buf (or data-buffer (current-buffer)))) + (with-current-buffer (get-buffer-create "*ledger-register*") + (let ((pos (point)) + (inhibit-read-only t)) + (erase-buffer) + (ledger-register-render + buf (apply #'ledger-exec-read buf args)) + (goto-char pos)) + (set-buffer-modified-p nil) + (toggle-read-only t) + (display-buffer (current-buffer) t)))) + (provide 'ldg-register) |