Added menu entry for complete entry.

Refactored leg-complete to get rid of some side effect usage
This commit is contained in:
Craig Earls 2013-02-13 20:45:22 -07:00
parent d31913871f
commit c031fa4943
3 changed files with 37 additions and 35 deletions

View file

@ -25,21 +25,6 @@
;; In-place completion support ;; In-place completion support
(defun ledger-thing-at-point ()
(let ((here (point)))
(goto-char (line-beginning-position))
(cond ((looking-at "^[0-9/.=-]+\\(\\s-+\\*\\)?\\(\\s-+(.+?)\\)?\\s-+")
(goto-char (match-end 0))
'transaction)
((looking-at "^\\s-+\\([*!]\\s-+\\)?[[(]?\\(.\\)")
(goto-char (match-beginning 2))
'posting)
((looking-at "^\\(sun\\|mon\\|tue\\|wed\\|thu\\|fri\\|sat\\)\\s-+")
(goto-char (match-end 0))
'entry)
(t
(ignore (goto-char here))))))
(defun ledger-parse-arguments () (defun ledger-parse-arguments ()
"Parse whitespace separated arguments in the current region." "Parse whitespace separated arguments in the current region."
(let* ((info (save-excursion (let* ((info (save-excursion
@ -57,7 +42,7 @@
args))) args)))
(cons (reverse args) (reverse begins))))) (cons (reverse args) (reverse begins)))))
(defun ledger-payees () (defun ledger-payees-in-buffer ()
(let ((origin (point)) (let ((origin (point))
payees-list) payees-list)
(save-excursion (save-excursion
@ -72,36 +57,36 @@
;; to the list ;; to the list
(pcomplete-uniqify-list (nreverse payees-list)))) (pcomplete-uniqify-list (nreverse payees-list))))
(defvar ledger-account-tree nil) (defun ledger-find-accounts-in-buffer ()
"search through buffer and build tree of accounts. Return tree
(defun ledger-find-accounts () structure"
(let ((origin (point)) (let ((origin (point))
account-path (account-tree (list t))
elements) (account-elements nil))
(save-excursion (save-excursion
(setq ledger-account-tree (list t))
(goto-char (point-min)) (goto-char (point-min))
(while (re-search-forward (while (re-search-forward
"^[ \t]+\\([*!]\\s-+\\)?[[(]?\\(.+?\\)\\(\t\\|\n\\| [ \t]\\)" nil t) "^[ \t]+\\([*!]\\s-+\\)?[[(]?\\(.+?\\)\\(\t\\|\n\\| [ \t]\\)" nil t)
(unless (and (>= origin (match-beginning 0)) (unless (and (>= origin (match-beginning 0))
(< origin (match-end 0))) (< origin (match-end 0)))
(setq account-path (match-string-no-properties 2)) (setq account-elements
(setq elements (split-string account-path ":")) (split-string
(let ((root ledger-account-tree)) (match-string-no-properties 2) ":"))
(while elements (let ((root account-tree))
(let ((entry (assoc (car elements) root))) (while account-elements
(let ((entry (assoc (car account-elements) root)))
(if entry (if entry
(setq root (cdr entry)) (setq root (cdr entry))
(setq entry (cons (car elements) (list t))) (setq entry (cons (car account-elements) (list t)))
(nconc root (list entry)) (nconc root (list entry))
(setq root (cdr entry)))) (setq root (cdr entry))))
(setq elements (cdr elements))))))))) (setq account-elements (cdr account-elements)))))))
account-tree))
(defun ledger-accounts () (defun ledger-accounts ()
(ledger-find-accounts)
(let* ((current (caar (ledger-parse-arguments))) (let* ((current (caar (ledger-parse-arguments)))
(elements (and current (split-string current ":"))) (elements (and current (split-string current ":")))
(root ledger-account-tree) (root (ledger-find-accounts-in-buffer))
(prefix nil)) (prefix nil))
(while (cdr elements) (while (cdr elements)
(let ((entry (assoc (car elements) root))) (let ((entry (assoc (car elements) root)))
@ -131,7 +116,7 @@
(if (eq (save-excursion (if (eq (save-excursion
(ledger-thing-at-point)) 'transaction) (ledger-thing-at-point)) 'transaction)
(if (null current-prefix-arg) (if (null current-prefix-arg)
(ledger-payees) ;; this completes against payee names (ledger-payees-in-buffer) ;; this completes against payee names
(progn (progn
(let ((text (buffer-substring (line-beginning-position) (let ((text (buffer-substring (line-beginning-position)
(line-end-position)))) (line-end-position))))
@ -149,7 +134,8 @@
(ledger-accounts))))) (ledger-accounts)))))
(defun ledger-fully-complete-entry () (defun ledger-fully-complete-entry ()
"Do appropriate completion for the thing at point" "Completes a transaction if there is another matching payee in
the buffer. Does not use ledger xact"
(interactive) (interactive)
(let ((name (caar (ledger-parse-arguments))) (let ((name (caar (ledger-parse-arguments)))
xacts) xacts)
@ -157,7 +143,7 @@
(when (eq 'transaction (ledger-thing-at-point)) (when (eq 'transaction (ledger-thing-at-point))
(when (re-search-backward (when (re-search-backward
(concat "^[0-9/.=-]+\\(\\s-+\\*\\)?\\(\\s-+(.*?)\\)?\\s-+" (concat "^[0-9/.=-]+\\(\\s-+\\*\\)?\\(\\s-+(.*?)\\)?\\s-+"
(regexp-quote name) "\\(\t\\|\n\\| [ \t]\\)") nil t) (regexp-quote name) ) nil t) ;; "\\(\t\\|\n\\| [ \t]\\)"
(forward-line) (forward-line)
(while (looking-at "^\\s-+") (while (looking-at "^\\s-+")
(setq xacts (cons (buffer-substring-no-properties (setq xacts (cons (buffer-substring-no-properties

View file

@ -120,7 +120,8 @@ customizable to ease retro-entry.")
(define-key map [edit-amount] '(menu-item "Calc on Amount" ledger-post-edit-amount)) (define-key map [edit-amount] '(menu-item "Calc on Amount" ledger-post-edit-amount))
(define-key map [sep] '(menu-item "--")) (define-key map [sep] '(menu-item "--"))
(define-key map [delete-xact] '(menu-item "Delete Entry" ledger-delete-current-transaction)) (define-key map [delete-xact] '(menu-item "Delete Entry" ledger-delete-current-transaction))
(define-key map [add-xact] '(menu-item "Add Transaction" ledger-add-transaction :enable ledger-works)) (define-key map [cmp-xact] '(menu-item "Complete Transaction" ledger-fully-complete-entry))
(define-key map [add-xact] '(menu-item "Add Transaction (ledger xact)" ledger-add-transaction :enable ledger-works))
(define-key map [sep3] '(menu-item "--")) (define-key map [sep3] '(menu-item "--"))
(define-key map [reconcile] '(menu-item "Reconcile Account" ledger-reconcile :enable ledger-works)) (define-key map [reconcile] '(menu-item "Reconcile Account" ledger-reconcile :enable ledger-works))
(define-key map [reconcile] '(menu-item "Hide Xacts" ledger-occur)))) (define-key map [reconcile] '(menu-item "Hide Xacts" ledger-occur))))

View file

@ -77,4 +77,19 @@
(defsubst ledger-goto-line (line-number) (defsubst ledger-goto-line (line-number)
(goto-char (point-min)) (forward-line (1- line-number))) (goto-char (point-min)) (forward-line (1- line-number)))
(defun ledger-thing-at-point ()
(let ((here (point)))
(goto-char (line-beginning-position))
(cond ((looking-at "^[0-9/.=-]+\\(\\s-+\\*\\)?\\(\\s-+(.+?)\\)?\\s-+")
(goto-char (match-end 0))
'transaction)
((looking-at "^\\s-+\\([*!]\\s-+\\)?[[(]?\\(.\\)")
(goto-char (match-beginning 2))
'posting)
((looking-at "^\\(sun\\|mon\\|tue\\|wed\\|thu\\|fri\\|sat\\)\\s-+")
(goto-char (match-end 0))
'entry)
(t
(ignore (goto-char here))))))
(provide 'ldg-xact) (provide 'ldg-xact)