Created lisp/ldg-account.el

This commit is contained in:
John Wiegley 2010-03-11 00:36:43 -05:00
parent 7e719c42dc
commit f672ddafc3
3 changed files with 136 additions and 14 deletions

122
lisp/ldg-account.el Normal file
View file

@ -0,0 +1,122 @@
(require 'ldg-regex)
(defgroup ledger-account nil
""
:group 'ledger)
(defcustom ledger-account-auto-adjust-amounts t
"If non-nil, ."
:type 'boolean
:group 'ledger-account)
(declare-function iswitchb-read-buffer "iswitchb"
(prompt &optional default require-match start matches-set))
(defvar iswitchb-temp-buflist)
(defvar ledger-account-current-list nil)
(defun ledger-account-find-all ()
(let ((origin (point))
(ledger-account-list nil)
account-path elements)
(save-excursion
(goto-char (point-min))
(while (re-search-forward
"^[ \t]+\\([*!]\\s-+\\)?[[(]?\\(.+?\\)\\(\t\\|\n\\| [ \t]\\)" nil t)
(unless (and (>= origin (match-beginning 0))
(< origin (match-end 0)))
(setq account-path (match-string-no-properties 2))
(unless (string-match "\\`\\s-*;" account-path)
(add-to-list 'ledger-account-list account-path))))
(setq ledger-account-current-list
(nreverse ledger-account-list)))))
(defun ledger-account-completing-read (prompt choices)
"Use iswitchb as a completing-read replacement to choose from choices.
PROMPT is a string to prompt with. CHOICES is a list of strings
to choose from."
(let* ((iswitchb-use-virtual-buffers nil)
(iswitchb-make-buflist-hook
(lambda ()
(setq iswitchb-temp-buflist choices))))
(iswitchb-read-buffer prompt)))
(defun ledger-account-select ()
(interactive)
(let* ((account
(ledger-account-completing-read "Account: "
(or ledger-account-current-list
(ledger-account-find-all))))
(account-len (length account))
(pos (point)))
(goto-char (line-beginning-position))
(when (re-search-forward ledger-regex-post-line (line-end-position) t)
(let ((existing-len (length (match-string 3))))
(goto-char (match-beginning 3))
(delete-region (match-beginning 3) (match-end 3))
(insert account)
(cond
((> existing-len account-len)
(insert (make-string (- existing-len account-len) ? )))
((< existing-len account-len)
(dotimes (n (- account-len existing-len))
(if (looking-at "[ \t]\\( [ \t]\\|\t\\)")
(delete-char 1)))))))
(goto-char pos)))
(defun ledger-account-align-amount ()
(interactive)
(save-excursion
(set-mark (line-beginning-position))
(goto-char (1+ (line-end-position)))
(ledger-align-amounts)))
(defun ledger-account-maybe-align (beg end len)
(save-excursion
(goto-char beg)
(when (< end (line-end-position))
(goto-char (line-beginning-position))
(if (looking-at ledger-regex-post-line)
(ledger-account-align-amount)))))
(defun ledger-account-edit-amount ()
(interactive)
(goto-char (line-beginning-position))
(when (re-search-forward ledger-regex-post-line (line-end-position) t)
(goto-char (match-end 3))
(when (re-search-forward "[-.,0-9]+" (line-end-position) t)
(let ((val (match-string 0)))
(goto-char (match-beginning 0))
(delete-region (match-beginning 0) (match-end 0))
(calc)
(while (string-match "," val)
(setq val (replace-match "" nil nil val)))
(calc-eval val 'push)))))
(defun ledger-account-prev-xact ()
(interactive)
(backward-paragraph)
(when (re-search-backward ledger-regex-xact-line nil t)
(goto-char (match-beginning 0))
(re-search-forward ledger-regex-post-line)
(goto-char (match-end 3))))
(defun ledger-account-next-xact ()
(interactive)
(when (re-search-forward ledger-regex-xact-line nil t)
(goto-char (match-beginning 0))
(re-search-forward ledger-regex-post-line)
(goto-char (match-end 3))))
(defun ledger-account-setup ()
(let ((map (current-local-map)))
(define-key map [(meta ?p)] 'ledger-account-prev-xact)
(define-key map [(meta ?n)] 'ledger-account-next-xact)
(define-key map [(control ?c) (control ?c)] 'ledger-account-select)
(define-key map [(control ?c) (control ?e)] 'ledger-account-select))
(if ledger-account-auto-adjust-amounts
(add-hook 'after-change-functions 'ledger-account-maybe-align t t)))
(add-hook 'ledger-mode-hook 'ledger-account-setup)
(provide 'ldg-account)

View file

@ -67,29 +67,28 @@
(defconst ledger-regex-full-note-group--count (defconst ledger-regex-full-note-group--count
ledger-regex-note-group--count) ledger-regex-note-group--count)
(defconst ledger-regex-transaction-line (defconst ledger-regex-xact-line
(macroexpand (macroexpand
`(rx (and line-start `(rx (and line-start
(regexp ,ledger-regex-full-date) (regexp ,ledger-regex-full-date)
(? (and (+ space) (regexp ,ledger-regex-state))) (? (and (+ space) (regexp ,ledger-regex-state)))
(? (and (+ space) (regexp ,ledger-regex-code))) (? (and (+ space) (regexp ,ledger-regex-code)))
(+ space) (+? nonl) (+ space) (+? nonl)
(? (and (regexp ,ledger-regex-long-space) ?\; (? (regexp ,ledger-regex-end-note))
(regexp ,ledger-regex-note)))
line-end)))) line-end))))
(defconst ledger-regex-transaction-line-group-actual-date (defconst ledger-regex-xact-line-group-actual-date
ledger-regex-full-date-group-actual) ledger-regex-full-date-group-actual)
(defconst ledger-regex-transaction-line-group-effective-date (defconst ledger-regex-xact-line-group-effective-date
ledger-regex-full-date-group-effective) ledger-regex-full-date-group-effective)
(defconst ledger-regex-transaction-line-group-state (defconst ledger-regex-xact-line-group-state
(+ ledger-regex-full-date-group--count (+ ledger-regex-full-date-group--count
ledger-regex-state-group)) ledger-regex-state-group))
(defconst ledger-regex-transaction-line-group-code (defconst ledger-regex-xact-line-group-code
(+ ledger-regex-full-date-group--count (+ ledger-regex-full-date-group--count
ledger-regex-state-group--count ledger-regex-state-group--count
ledger-regex-code-group)) ledger-regex-code-group))
(defconst ledger-regex-transaction-line-group-note (defconst ledger-regex-xact-line-group-note
(+ ledger-regex-full-date-group--count (+ ledger-regex-full-date-group--count
ledger-regex-state-group--count ledger-regex-state-group--count
ledger-regex-code-group--count ledger-regex-code-group--count
@ -100,9 +99,9 @@
ledger-regex-code-group--count ledger-regex-code-group--count
ledger-regex-note-group--count)) ledger-regex-note-group--count))
(defun ledger-regex-transaction-line-actual-date (defun ledger-regex-xact-line-actual-date
(&optional string) (&optional string)
(match-string ledger-regex-transaction-line-group-actual-date string)) (match-string ledger-regex-xact-line-group-actual-date string))
(defconst ledger-regex-account (defconst ledger-regex-account
(rx (group (and (not (any ?:)) (*? nonl))))) (rx (group (and (not (any ?:)) (*? nonl)))))
@ -154,14 +153,15 @@
(regexp ,ledger-regex-commoditized-amount))))) (regexp ,ledger-regex-commoditized-amount)))))
(defconst ledger-regex-full-amount (defconst ledger-regex-full-amount
(macroexpand `(rx (and line-start (+ space) (macroexpand `(rx (group (+? (not (any ?\;)))))))
?\; (regexp ,ledger-regex-note)))))
(defconst ledger-regex-posting-line (defconst ledger-regex-post-line
(macroexpand (macroexpand
`(rx (and line-start `(rx (and line-start
(? (and (+ space) (regexp ,ledger-regex-state)))
(+ space) (regexp ,ledger-regex-full-account) (+ space) (regexp ,ledger-regex-full-account)
(+ space) (regexp ,ledger-regex-full-amount) (+ space) (regexp ,ledger-regex-full-amount)
(? (regexp ,ledger-regex-end-note)) (? (regexp ,ledger-regex-end-note))
line-end)))) line-end))))
(provide 'ldg-regex)

View file

@ -1226,7 +1226,7 @@ the default."
"Align amounts in the current region. "Align amounts in the current region.
This is done so that the last digit falls in COLUMN, which defaults to 52." This is done so that the last digit falls in COLUMN, which defaults to 52."
(interactive "p") (interactive "p")
(if (= column 1) (if (or (null column) (= column 1))
(setq column 52)) (setq column 52))
(save-excursion (save-excursion
(let* ((mark-first (< (mark) (point))) (let* ((mark-first (< (mark) (point)))