Merge pull request #227 from 4ourbit/patch-2

More context-aware ledger pcomplete rules.

Thanks.

5 files changed, 84 insertions, 34 deletions

diff --git a/doc/ledger-mode.texi b/doc/ledger-mode.texi
index c8af96cb..e81045c6 100644
--- a/doc/ledger-mode.texi
+++ b/doc/ledger-mode.texi
@@ -175,6 +175,11 @@ typing a close match to the payee. Ledger-mode will call @command{ledger
 xact} with the data you enter and place the transaction in the proper
 chronological place in the ledger.
 
+To complete just the part of the transaction where your cursor is at,
+Ledger-mode supports Emacs' universal @command{completion-at-point}
+command. You may bind this command to @kbd{C-M-i} since this is the
+default for Emacs programming modes.
+
 @node Reconciliation, Reports, Quick Add, Quick Demo
 @subsection Reconciliation
 @kindex C-c C-r
diff --git a/lisp/ledger-complete.el b/lisp/ledger-complete.el
index c4ac43ef..5bb69dc2 100644
--- a/lisp/ledger-complete.el
+++ b/lisp/ledger-complete.el
@@ -145,9 +145,38 @@ Return list."
                   (cdr root))
           'string-lessp))))
 
+(defun ledger-command-at-point ()
+  "Do appropriate completion for current context."
+  (let ((context (mapcar*
+                  (lambda(x) (if (symbolp x) (symbol-name x)))
+                  (ledger-context-at-point))))
+       (cond
+        ((string= "acct-transaction" (car context))
+         (concat (car context) "/" (nth 1 context)))
+        ((string= "pmnt-transaction" (car context))
+         (concat (car context) "/" (nth 1 context)))
+        (t
+         (car context)))))
+
 (defun ledger-complete-at-point ()
-  "Do appropriate completion for the thing at point."
-  (interactive)
+  "Calls the right completion function for first argument completions."
+  (ignore
+   (funcall (or (pcomplete-find-completion-function
+                 (ledger-command-at-point))
+                pcomplete-default-completion-function))))
+
+(defun pcomplete/ledger-mode/empty-line ()
+  "Complete when at empty line."
+  (ignore
+   (ledger-add-transaction (read-string "Transaction: "
+                                        (ledger-year-and-month)) (point))))
+
+(defun pcomplete/ledger-mode/pmnt-transaction/date ()
+  "Complete when at date in transaction."
+  (ignore))
+
+(defun pcomplete/ledger-mode/pmnt-transaction/payee ()
+  "Complete when at payee in transaction."
   (while (pcomplete-here
           (if (eq (save-excursion
                     (ledger-thing-at-point)) 'transaction)
@@ -168,8 +197,24 @@ Return list."
 		    (goto-char (line-end-position))
 		    (search-backward ";" (line-beginning-position) t)
 		    (skip-chars-backward " \t0123456789.,")
-		    (throw 'pcompleted t)))
-	      (ledger-accounts)))))
+		    (throw 'pcompleted t)))))))
+
+(defun pcomplete/ledger-mode/acct-transaction/indent ()
+  "Complete when at indent in transaction."
+  (ignore (ledger-thing-at-point)))
+
+(defun pcomplete/ledger-mode/acct-transaction/account ()
+  "Complete when at account in transaction."
+  (set (make-local-variable 'pcomplete-termination-string) "  ")
+  (pcomplete-here (ledger-accounts)))
+
+(defun pcomplete/ledger-mode/acct-transaction/amount ()
+  "Complete when at amount in transaction."
+  (ignore (ledger-post-edit-amount)))
+
+(defun pcomplete/ledger-mode/acct-transaction/comment ()
+  "Complete when at amount in transaction."
+  (pcomplete-here (ledger-find-metadata-in-buffer)))
 
 (defun ledger-fully-complete-xact ()
   "Completes a transaction if there is another matching payee in the buffer.
diff --git a/lisp/ledger-context.el b/lisp/ledger-context.el
index 44ad3a30..e9b1264b 100644
--- a/lisp/ledger-context.el
+++ b/lisp/ledger-context.el
@@ -42,16 +42,7 @@
 (defconst ledger-code-string "\\((.*)\\)?")
 (defconst ledger-payee-string "\\(.*\\)")
 
-(defmacro ledger-line-regex (&rest elements)
-  (let (regex-string)
-    (concat (dolist (e elements regex-string)
-	      (setq regex-string
-		    (concat regex-string
-			    (eval
-			     (intern
-			      (concat "ledger-" (symbol-name e) "-string")))))) "[ \t]*$")))
-
-(defmacro ledger-single-line-config2 (&rest elements)
+(defmacro ledger-single-line-config (&rest elements)
   "Take list of ELEMENTS and return regex and element list for use in context-at-point"
   (let (regex-string)
     `'(,(concat (dolist (e elements regex-string)
@@ -62,23 +53,25 @@
 				  (concat "ledger-" (symbol-name e) "-string")))))) "[ \t]*$")
        ,elements)))
 
-(defmacro ledger-single-line-config (&rest elements)
-  "Take list of ELEMENTS and return regex and element list for use in context-at-point"
-  `'(,(eval `(ledger-line-regex ,@elements))
-     ,elements))
-
 (defconst ledger-line-config
-  (list (list 'xact (list (ledger-single-line-config date nil status nil code nil payee nil comment)
-			  (ledger-single-line-config date nil status nil code nil payee)
-			  (ledger-single-line-config date nil status nil payee)))
-	(list 'acct-transaction (list (ledger-single-line-config indent comment)
-				      (ledger-single-line-config2 indent status account nil commodity amount nil comment)
-				      (ledger-single-line-config2 indent status account nil commodity amount)
-				      (ledger-single-line-config2 indent status account nil amount nil commodity comment)
-				      (ledger-single-line-config2 indent status account nil amount nil commodity)
-				      (ledger-single-line-config2 indent status account nil amount)
-				      (ledger-single-line-config2 indent status account nil comment)
-				      (ledger-single-line-config2 indent status account)))))
+  (list
+   (list 'pmnt-transaction
+         (list (ledger-single-line-config date nil status nil code nil payee nil comment)
+               (ledger-single-line-config date nil status nil code nil payee)
+               (ledger-single-line-config date nil status nil payee)
+               (ledger-single-line-config date nil code nil payee nil comment)
+               (ledger-single-line-config date nil code nil payee)
+               (ledger-single-line-config date nil payee)
+               (ledger-single-line-config date)))
+   (list 'acct-transaction
+         (list (ledger-single-line-config indent comment)
+               (ledger-single-line-config indent status account nil commodity amount nil comment)
+               (ledger-single-line-config indent status account nil commodity amount)
+               (ledger-single-line-config indent status account nil amount nil commodity comment)
+               (ledger-single-line-config indent status account nil amount nil commodity)
+               (ledger-single-line-config indent status account nil amount)
+               (ledger-single-line-config indent status account nil comment)
+               (ledger-single-line-config indent status account)))))
 
 (defun ledger-extract-context-info (line-type pos)
   "Get context info for current line with LINE-TYPE.
@@ -138,7 +131,7 @@ the fields in the line in a association list."
               ((memq first-char '(?\ ?\t))
                (ledger-extract-context-info 'acct-transaction pos))
               ((memq first-char '(?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9))
-               (ledger-extract-context-info 'xact pos))
+               (ledger-extract-context-info 'pmnt-transaction pos))
               ((equal first-char ?\=)
                '(automated-xact nil nil))
               ((equal first-char ?\~)
diff --git a/lisp/ledger-mode.el b/lisp/ledger-mode.el
index 28856bd4..0d683168 100644
--- a/lisp/ledger-mode.el
+++ b/lisp/ledger-mode.el
@@ -145,6 +145,11 @@ Can indent, complete or align depending on context."
 
 (defvar ledger-mode-abbrev-table)
 
+(defvar ledger-date-string-today
+  (format-time-string (or
+        (cdr (assoc "date-format" ledger-environment-alist))
+        ledger-default-date-format)))
+
 (defun ledger-remove-effective-date ()
   "Removes the effective date from a transaction or posting."
   (interactive)
@@ -153,7 +158,7 @@ Can indent, complete or align depending on context."
       (save-restriction
         (narrow-to-region (point-at-bol) (point-at-eol))
         (beginning-of-line)
-        (cond ((eq 'xact context)
+        (cond ((eq 'pmnt-transaction context)
                (re-search-forward ledger-iso-date-regexp)
                (when (= (char-after) ?=)
                  (let ((eq-pos (point)))
@@ -187,7 +192,7 @@ With a prefix argument, remove the effective date. "
       (save-restriction
         (narrow-to-region (point-at-bol) (point-at-eol))
         (cond
-         ((eq 'xact context)
+         ((eq 'pmnt-transaction context)
           (beginning-of-line)
           (re-search-forward ledger-iso-date-regexp)
           (when (= (char-after) ?=)
@@ -320,7 +325,7 @@ With a prefix argument, remove the effective date. "
 			 'ledger-parse-arguments)
 	(set (make-local-variable 'pcomplete-command-completion-function)
 			 'ledger-complete-at-point)
-	(set (make-local-variable 'pcomplete-termination-string) "")
+  (add-to-list 'completion-at-point-functions 'pcomplete-completions-at-point)
 
 	(add-hook 'post-command-hook 'ledger-highlight-xact-under-point nil t)
 	(add-hook 'before-revert-hook 'ledger-occur-remove-all-overlays nil t)
diff --git a/lisp/ledger-regex.el b/lisp/ledger-regex.el
index 06564a4a..cf10895a 100644
--- a/lisp/ledger-regex.el
+++ b/lisp/ledger-regex.el
@@ -79,6 +79,8 @@
 (defconst ledger-account-cleared-regex
   "\\(^[ \t]+\\)\\(*\\s-*.*?\\)\\(  \\|\t\\|$\\)")
 
+(defconst ledger-metadata-regex
+  "[ \t]+\\(?2:;[ \t]+.+\\)$")
 
 (defmacro ledger-define-regexp (name regex docs &rest args)
   "Simplify the creation of a Ledger regex and helper functions."