Added menu entry for complete entry.
Refactored leg-complete to get rid of some side effect usage
This commit is contained in:
parent
d31913871f
commit
c031fa4943
3 changed files with 37 additions and 35 deletions
|
|
@ -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
|
||||||
|
|
|
||||||
|
|
@ -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))))
|
||||||
|
|
|
||||||
|
|
@ -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)
|
||||||
Loading…
Add table
Reference in a new issue