Created lisp/ldg-account.el
This commit is contained in:
John Wiegley
parent
7e719c42dc
commit
f672ddafc3
3 changed files with 136 additions and 14 deletions
122
lisp/ldg-account.el
Normal file
122
lisp/ldg-account.el
Normal 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)
|
||||
|
|
@ -67,29 +67,28 @@
|
|||
(defconst ledger-regex-full-note-group--count
|
||||
ledger-regex-note-group--count)
|
||||
|
||||
(defconst ledger-regex-transaction-line
|
||||
(defconst ledger-regex-xact-line
|
||||
(macroexpand
|
||||
`(rx (and line-start
|
||||
(regexp ,ledger-regex-full-date)
|
||||
(? (and (+ space) (regexp ,ledger-regex-state)))
|
||||
(? (and (+ space) (regexp ,ledger-regex-code)))
|
||||
(+ space) (+? nonl)
|
||||
(? (and (regexp ,ledger-regex-long-space) ?\;
|
||||
(regexp ,ledger-regex-note)))
|
||||
(? (regexp ,ledger-regex-end-note))
|
||||
line-end))))
|
||||
|
||||
(defconst ledger-regex-transaction-line-group-actual-date
|
||||
(defconst ledger-regex-xact-line-group-actual-date
|
||||
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)
|
||||
(defconst ledger-regex-transaction-line-group-state
|
||||
(defconst ledger-regex-xact-line-group-state
|
||||
(+ ledger-regex-full-date-group--count
|
||||
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-state-group--count
|
||||
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-state-group--count
|
||||
ledger-regex-code-group--count
|
||||
|
|
@ -100,9 +99,9 @@
|
|||
ledger-regex-code-group--count
|
||||
ledger-regex-note-group--count))
|
||||
|
||||
(defun ledger-regex-transaction-line-actual-date
|
||||
(defun ledger-regex-xact-line-actual-date
|
||||
(&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
|
||||
(rx (group (and (not (any ?:)) (*? nonl)))))
|
||||
|
|
@ -154,14 +153,15 @@
|
|||
(regexp ,ledger-regex-commoditized-amount)))))
|
||||
|
||||
(defconst ledger-regex-full-amount
|
||||
(macroexpand `(rx (and line-start (+ space)
|
||||
?\; (regexp ,ledger-regex-note)))))
|
||||
(macroexpand `(rx (group (+? (not (any ?\;)))))))
|
||||
|
||||
(defconst ledger-regex-posting-line
|
||||
(defconst ledger-regex-post-line
|
||||
(macroexpand
|
||||
`(rx (and line-start
|
||||
(? (and (+ space) (regexp ,ledger-regex-state)))
|
||||
(+ space) (regexp ,ledger-regex-full-account)
|
||||
(+ space) (regexp ,ledger-regex-full-amount)
|
||||
(? (regexp ,ledger-regex-end-note))
|
||||
line-end))))
|
||||
|
||||
(provide 'ldg-regex)
|
||||
|
|
|
|||
|
|
@ -1226,7 +1226,7 @@ the default."
|
|||
"Align amounts in the current region.
|
||||
This is done so that the last digit falls in COLUMN, which defaults to 52."
|
||||
(interactive "p")
|
||||
(if (= column 1)
|
||||
(if (or (null column) (= column 1))
|
||||
(setq column 52))
|
||||
(save-excursion
|
||||
(let* ((mark-first (< (mark) (point)))
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue