Added menu entry for complete entry.

Refactored leg-complete to get rid of some side effect usage

3 files changed, 37 insertions, 35 deletions

diff --git a/lisp/ldg-complete.el b/lisp/ldg-complete.el
index b841bae9..a0508a98 100644
--- a/lisp/ldg-complete.el
+++ b/lisp/ldg-complete.el
@@ -25,21 +25,6 @@
 
 ;; 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 ()
   "Parse whitespace separated arguments in the current region."
   (let* ((info (save-excursion
@@ -57,7 +42,7 @@
                          args)))
       (cons (reverse args) (reverse begins)))))
 
-(defun ledger-payees ()
+(defun ledger-payees-in-buffer ()
   (let ((origin (point))
         payees-list)
     (save-excursion
@@ -72,36 +57,36 @@
 						     ;; to the list
     (pcomplete-uniqify-list (nreverse payees-list))))
 
-(defvar ledger-account-tree nil)
-
-(defun ledger-find-accounts ()
+(defun ledger-find-accounts-in-buffer ()
+  "search through buffer and build tree of accounts.  Return tree
+   structure"
   (let ((origin (point)) 
-	account-path 
-	elements)
+	(account-tree (list t))
+	(account-elements nil))
     (save-excursion
-      (setq ledger-account-tree (list t))
       (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))
-          (setq elements (split-string account-path ":"))
-          (let ((root ledger-account-tree))
-            (while elements
-              (let ((entry (assoc (car elements) root)))
+          (setq account-elements 
+		(split-string 
+		 (match-string-no-properties 2) ":"))
+          (let ((root account-tree))
+            (while account-elements
+              (let ((entry (assoc (car account-elements) root)))
                 (if entry
                     (setq root (cdr entry))
-		    (setq entry (cons (car elements) (list t)))
+		    (setq entry (cons (car account-elements) (list t)))
 		    (nconc root (list entry))
 		    (setq root (cdr entry))))
-              (setq elements (cdr elements)))))))))
+              (setq account-elements (cdr account-elements)))))))
+    account-tree))
 
 (defun ledger-accounts ()
-  (ledger-find-accounts)
   (let* ((current (caar (ledger-parse-arguments)))
          (elements (and current (split-string current ":")))
-         (root ledger-account-tree)
+         (root (ledger-find-accounts-in-buffer))
          (prefix nil))
     (while (cdr elements)
       (let ((entry (assoc (car elements) root)))
@@ -131,7 +116,7 @@
           (if (eq (save-excursion
                     (ledger-thing-at-point)) 'transaction)
               (if (null current-prefix-arg)
-                  (ledger-payees)  ;; this completes against payee names
+                  (ledger-payees-in-buffer)  ;; this completes against payee names
 		  (progn
 		    (let ((text (buffer-substring (line-beginning-position)
 						  (line-end-position))))
@@ -149,7 +134,8 @@
 	      (ledger-accounts)))))
 
 (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)
   (let ((name (caar (ledger-parse-arguments)))
         xacts)
@@ -157,7 +143,7 @@
       (when (eq 'transaction (ledger-thing-at-point))
         (when (re-search-backward
                (concat "^[0-9/.=-]+\\(\\s-+\\*\\)?\\(\\s-+(.*?)\\)?\\s-+"
-                       (regexp-quote name) "\\(\t\\|\n\\| [ \t]\\)") nil t)
+                       (regexp-quote name) ) nil t)  ;; "\\(\t\\|\n\\| [ \t]\\)"
           (forward-line)
           (while (looking-at "^\\s-+")
             (setq xacts (cons (buffer-substring-no-properties
diff --git a/lisp/ldg-mode.el b/lisp/ldg-mode.el
index df277ee0..ea780279 100644
--- a/lisp/ldg-mode.el
+++ b/lisp/ldg-mode.el
@@ -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 [sep] '(menu-item "--"))
       (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 [reconcile] '(menu-item "Reconcile Account" ledger-reconcile :enable ledger-works))
       (define-key map [reconcile] '(menu-item "Hide Xacts" ledger-occur))))
diff --git a/lisp/ldg-xact.el b/lisp/ldg-xact.el
index 4b73b2ea..306401af 100644
--- a/lisp/ldg-xact.el
+++ b/lisp/ldg-xact.el
@@ -77,4 +77,19 @@
 (defsubst ledger-goto-line (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)
\ No newline at end of file