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.
This commit is contained in:
John Wiegley
parent
9618057215
commit
d516c64bec
1 changed files with 135 additions and 162 deletions
297
ledger.el
297
ledger.el
|
|
@ -4,7 +4,7 @@
|
||||||
|
|
||||||
;; Emacs Lisp Archive Entry
|
;; Emacs Lisp Archive Entry
|
||||||
;; Filename: ledger.el
|
;; Filename: ledger.el
|
||||||
;; Version: 1.1
|
;; Version: 1.2
|
||||||
;; Date: Thu 02-Apr-2004
|
;; Date: Thu 02-Apr-2004
|
||||||
;; Keywords: data
|
;; Keywords: data
|
||||||
;; Author: John Wiegley (johnw AT gnu DOT org)
|
;; 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-a add a new entry, based on previous entries
|
||||||
;; C-c C-y set default year for entry mode
|
;; C-c C-y set default year for entry mode
|
||||||
;; C-c C-m set default month 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
|
;; 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")
|
"The version of ledger.el currently loaded")
|
||||||
|
|
||||||
(defgroup ledger nil
|
(defgroup ledger nil
|
||||||
|
|
@ -55,14 +57,7 @@
|
||||||
:type 'file
|
:type 'file
|
||||||
:group 'ledger)
|
: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 bold 'bold)
|
||||||
|
|
||||||
(defvar ledger-font-lock-keywords
|
(defvar ledger-font-lock-keywords
|
||||||
'(("^[0-9./]+\\s-+\\(?:([^)]+)\\s-+\\)?\\([^*].+\\)" 1 bold)
|
'(("^[0-9./]+\\s-+\\(?:([^)]+)\\s-+\\)?\\([^*].+\\)" 1 bold)
|
||||||
("^\\s-+.+?\\( \\|\t\\|\\s-+$\\)" . font-lock-keyword-face))
|
("^\\s-+.+?\\( \\|\t\\|\\s-+$\\)" . font-lock-keyword-face))
|
||||||
|
|
@ -70,14 +65,12 @@
|
||||||
|
|
||||||
(defsubst ledger-current-year ()
|
(defsubst ledger-current-year ()
|
||||||
(format-time-string "%Y"))
|
(format-time-string "%Y"))
|
||||||
|
|
||||||
(defsubst ledger-current-month ()
|
(defsubst ledger-current-month ()
|
||||||
(format-time-string "%m"))
|
(format-time-string "%m"))
|
||||||
|
|
||||||
(defvar ledger-year (ledger-current-year)
|
(defvar ledger-year (ledger-current-year)
|
||||||
"Start a ledger session with the current year, but make it
|
"Start a ledger session with the current year, but make it
|
||||||
customizable to ease retro-entry.")
|
customizable to ease retro-entry.")
|
||||||
|
|
||||||
(defvar ledger-month (ledger-current-month)
|
(defvar ledger-month (ledger-current-month)
|
||||||
"Start a ledger session with the current month, but make it
|
"Start a ledger session with the current month, but make it
|
||||||
customizable to ease retro-entry.")
|
customizable to ease retro-entry.")
|
||||||
|
|
@ -135,7 +128,9 @@ Return the difference in the format of a time value."
|
||||||
(list
|
(list
|
||||||
(read-string "Entry: " (concat ledger-year "/" ledger-month "/"))))
|
(read-string "Entry: " (concat ledger-year "/" ledger-month "/"))))
|
||||||
(let* ((date (car (split-string entry-text)))
|
(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)
|
(if (string-match "\\([0-9]+\\)/\\([0-9]+\\)/\\([0-9]+\\)" date)
|
||||||
(setq date (encode-time 0 0 0 (string-to-int (match-string 3 date))
|
(setq date (encode-time 0 0 0 (string-to-int (match-string 3 date))
|
||||||
(string-to-int (match-string 2 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
|
(with-temp-buffer
|
||||||
(setq exit-code
|
(setq exit-code
|
||||||
(ledger-run-ledger
|
(ledger-run-ledger
|
||||||
"entry"
|
ledger-buf "entry"
|
||||||
(with-temp-buffer
|
(with-temp-buffer
|
||||||
(insert entry-text)
|
(insert entry-text)
|
||||||
(goto-char (point-min))
|
(goto-char (point-min))
|
||||||
|
|
@ -163,14 +158,6 @@ Return the difference in the format of a time value."
|
||||||
(concat (if insert-year entry-text
|
(concat (if insert-year entry-text
|
||||||
(substring entry-text 6)) "\n"))) "\n"))))
|
(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 ()
|
(defun ledger-toggle-current ()
|
||||||
(interactive)
|
(interactive)
|
||||||
(let (clear)
|
(let (clear)
|
||||||
|
|
@ -185,11 +172,6 @@ Return the difference in the format of a time value."
|
||||||
(setq clear t))))
|
(setq clear t))))
|
||||||
clear))
|
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)
|
(defvar ledger-mode-abbrev-table)
|
||||||
|
|
||||||
(define-derived-mode ledger-mode text-mode "Ledger"
|
(define-derived-mode ledger-mode text-mode "Ledger"
|
||||||
|
|
@ -205,43 +187,128 @@ 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 ?y)] 'ledger-set-year)
|
||||||
(define-key map [(control ?c) (control ?m)] 'ledger-set-month)
|
(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 ?c)] 'ledger-toggle-current)
|
||||||
(define-key map [(control ?c) (control ?p)] 'ledger-print-result)
|
|
||||||
(define-key map [(control ?c) (control ?r)] 'ledger-reconcile)))
|
(define-key map [(control ?c) (control ?r)] 'ledger-reconcile)))
|
||||||
|
|
||||||
(defun ledger-parse-entries (account &optional all-p)
|
;; Reconcile mode
|
||||||
(let (total entries)
|
|
||||||
(ledger-iterate-entries
|
(defvar ledger-buf nil)
|
||||||
(function
|
(defvar ledger-acct nil)
|
||||||
(lambda (start date mark desc)
|
|
||||||
(when (or all-p (not mark))
|
(defun ledger-display-balance ()
|
||||||
(forward-line)
|
(let ((buffer ledger-buf)
|
||||||
(setq total 0.0)
|
(account ledger-acct))
|
||||||
(while (looking-at
|
(with-temp-buffer
|
||||||
(concat "\\s-+\\([A-Za-z_].+?\\)\\(\\s-*$\\| \\s-*"
|
(let ((exit-code (ledger-run-ledger buffer "-C" "balance" account)))
|
||||||
"\\([^0-9]+\\)\\s-*\\([0-9,.]+\\)\\)?"
|
(if (/= 0 exit-code)
|
||||||
"\\(\\s-+;.+\\)?$"))
|
(message "Error determining cleared balance")
|
||||||
(let ((acct (match-string 1))
|
(goto-char (point-min))
|
||||||
(amt (match-string 4)))
|
(delete-horizontal-space)
|
||||||
(when amt
|
(skip-syntax-forward "^ ")
|
||||||
(while (string-match "," amt)
|
(message "Cleared balance = %s"
|
||||||
(setq amt (replace-match "" nil nil amt)))
|
(buffer-substring-no-properties (point-min) (point))))))))
|
||||||
(setq amt (string-to-number amt)
|
|
||||||
total (+ total amt)))
|
(defun ledger-reconcile-toggle ()
|
||||||
(if (string= account acct)
|
(interactive)
|
||||||
(setq entries
|
(let ((where (get-text-property (point) 'where))
|
||||||
(cons (list (copy-marker start)
|
(account ledger-acct)
|
||||||
mark date desc (or amt total))
|
(inhibit-read-only t)
|
||||||
entries)
|
cleared)
|
||||||
all-p t)))
|
(with-current-buffer ledger-buf
|
||||||
(forward-line))))))
|
(goto-char where)
|
||||||
entries))
|
(setq cleared (ledger-toggle-current)))
|
||||||
|
(if cleared
|
||||||
|
(add-text-properties (line-beginning-position)
|
||||||
|
(line-end-position)
|
||||||
|
(list 'face 'bold))
|
||||||
|
(remove-text-properties (line-beginning-position)
|
||||||
|
(line-end-position)
|
||||||
|
(list 'face)))
|
||||||
|
(forward-line)))
|
||||||
|
|
||||||
|
(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)
|
||||||
|
(dolist (item items)
|
||||||
|
(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 'where (nth 0 item)))))))
|
||||||
|
(goto-char (point-min))
|
||||||
|
(set-buffer-modified-p nil)
|
||||||
|
(toggle-read-only t))))
|
||||||
|
|
||||||
(defvar ledger-reconcile-text "Reconcile")
|
|
||||||
(defvar ledger-reconcile-mode-abbrev-table)
|
(defvar ledger-reconcile-mode-abbrev-table)
|
||||||
|
|
||||||
(define-derived-mode ledger-reconcile-mode text-mode 'ledger-reconcile-text
|
(define-derived-mode ledger-reconcile-mode text-mode "Reconcile"
|
||||||
"A mode for reconciling ledger entries."
|
"A mode for reconciling ledger entries."
|
||||||
(let ((map (make-sparse-keymap)))
|
(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 [? ] 'ledger-reconcile-toggle)
|
||||||
(define-key map [?q]
|
(define-key map [?q]
|
||||||
(function
|
(function
|
||||||
|
|
@ -250,103 +317,7 @@ Return the difference in the format of a time value."
|
||||||
(kill-buffer (current-buffer)))))
|
(kill-buffer (current-buffer)))))
|
||||||
(use-local-map map)))
|
(use-local-map map)))
|
||||||
|
|
||||||
(add-to-list 'minor-mode-alist
|
;; A sample function for $ users
|
||||||
'(ledger-reconcile-mode ledger-reconcile-text))
|
|
||||||
|
|
||||||
(defvar ledger-buf nil)
|
|
||||||
(defvar ledger-acct nil)
|
|
||||||
|
|
||||||
(defun ledger-update-balance-display ()
|
|
||||||
(let ((account ledger-acct))
|
|
||||||
(with-temp-buffer
|
|
||||||
(let ((exit-code (ledger-run-ledger "-C" "balance"
|
|
||||||
(concat "\"" account "\""))))
|
|
||||||
(if (/= 0 exit-code)
|
|
||||||
(setq ledger-reconcile-text "Reconcile [ERR]")
|
|
||||||
(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))
|
|
||||||
|
|
||||||
(defun ledger-reconcile-toggle (&optional no-update)
|
|
||||||
(interactive)
|
|
||||||
(let ((where (get-text-property (point) 'where))
|
|
||||||
(account ledger-acct)
|
|
||||||
cleared)
|
|
||||||
(with-current-buffer ledger-buf
|
|
||||||
(goto-char where)
|
|
||||||
(setq cleared (ledger-toggle-current))
|
|
||||||
(save-buffer))
|
|
||||||
(if cleared
|
|
||||||
(add-text-properties (line-beginning-position)
|
|
||||||
(line-end-position)
|
|
||||||
(list 'face 'bold))
|
|
||||||
(remove-text-properties (line-beginning-position)
|
|
||||||
(line-end-position)
|
|
||||||
(list 'face)))
|
|
||||||
(forward-line)
|
|
||||||
(unless no-update
|
|
||||||
(ledger-update-balance-display))))
|
|
||||||
|
|
||||||
(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)))
|
|
||||||
(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)
|
|
||||||
(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))))))
|
|
||||||
|
|
||||||
(defun ledger-align-dollars (&optional column)
|
(defun ledger-align-dollars (&optional column)
|
||||||
(interactive "p")
|
(interactive "p")
|
||||||
|
|
@ -372,14 +343,16 @@ Return the difference in the format of a time value."
|
||||||
(insert " ")))
|
(insert " ")))
|
||||||
(forward-line))))
|
(forward-line))))
|
||||||
|
|
||||||
(defun ledger-run-ledger (&rest args)
|
;; General helper functions
|
||||||
|
|
||||||
|
(defun ledger-run-ledger (buffer &rest args)
|
||||||
"run ledger with supplied arguments"
|
"run ledger with supplied arguments"
|
||||||
(let ((command
|
(let ((buf (current-buffer)))
|
||||||
(mapconcat 'identity
|
(with-current-buffer buffer
|
||||||
(append (list ledger-binary-path
|
(apply #'call-process-region
|
||||||
"-f" ledger-data-file) args) " ")))
|
(append (list (point-min) (point-max)
|
||||||
(insert (shell-command-to-string command)))
|
ledger-binary-path nil buf nil "-f" "-")
|
||||||
0)
|
args)))))
|
||||||
|
|
||||||
(defun ledger-set-year (newyear)
|
(defun ledger-set-year (newyear)
|
||||||
"Set ledger's idea of the current year to the prefix argument."
|
"Set ledger's idea of the current year to the prefix argument."
|
||||||
|
|
|
||||||
Loading…
Add table
Reference in a new issue