Merge branch 'next'

23 files changed, 3122 insertions, 3679 deletions

diff --git a/lisp/CMakeLists.txt b/lisp/CMakeLists.txt
index 949171b3..876b3548 100644
--- a/lisp/CMakeLists.txt
+++ b/lisp/CMakeLists.txt
@@ -1,19 +1,21 @@
 set(EMACS_LISP_SOURCES
+  ldg-commodities.el
   ldg-complete.el
   ldg-exec.el
+  ldg-fonts.el
+  ldg-init.el
   ldg-mode.el
   ldg-new.el
+  ldg-occur.el
   ldg-post.el
   ldg-reconcile.el
   ldg-regex.el
-  ldg-register.el
   ldg-report.el
+  ldg-sort.el
   ldg-state.el
   ldg-test.el
   ldg-texi.el
-  ldg-xact.el
-  ledger.el
-  timeclock.el)
+  ldg-xact.el)
 
 # find emacs and complain if not found
 find_program(EMACS_EXECUTABLE emacs)
diff --git a/lisp/ldg-commodities.el b/lisp/ldg-commodities.el
new file mode 100644
index 00000000..031bddeb
--- /dev/null
+++ b/lisp/ldg-commodities.el
@@ -0,0 +1,144 @@
+;;; ldg-commodities.el --- Helper code for use with the "ledger" command-line tool
+
+;; Copyright (C) 2003-2013 John Wiegley (johnw AT gnu DOT org)
+
+;; This file is not part of GNU Emacs.
+
+;; This is free software; you can redistribute it and/or modify it under
+;; the terms of the GNU General Public License as published by the Free
+;; Software Foundation; either version 2, or (at your option) any later
+;; version.
+;;
+;; This is distributed in the hope that it will be useful, but WITHOUT
+;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+;; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+;; for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+;; MA 02111-1307, USA.
+
+;;; Commentary:
+;; Helper functions to deal with commoditized numbers.  A commoditized
+;; number will be a list of value and string where the string contains
+;; the commodity
+
+;;; Code:
+
+(require 'ldg-regex)
+
+(defcustom ledger-reconcile-default-commodity "$"
+  "The default commodity for use in target calculations in ledger reconcile."
+  :type 'string
+  :group 'ledger-reconcile)
+
+(defun ledger-split-commodity-string (str)
+  "Split a commoditized string, STR, into two parts.
+Returns a list with (value commodity)."
+  (if (> (length str) 0) 
+      (let ((number-regex (if (assoc "decimal-comma" ledger-environment-alist)
+			      ledger-amount-decimal-comma-regex
+			      ledger-amount-decimal-period-regex)))
+	(with-temp-buffer
+	  (insert str)
+	  (goto-char (point-min))
+	  (cond 
+	    ((re-search-forward "\"\\(.*\\)\"" nil t) ; look for quoted commodities
+	     (let ((com (delete-and-extract-region 
+			 (match-beginning 1)       
+			 (match-end 1))))
+	       (if (re-search-forward number-regex nil t)
+		   (list 
+		    (string-to-number
+		     (ledger-commodity-string-number-decimalize
+		      (delete-and-extract-region (match-beginning 0) (match-end 0)) :from-user))
+		    com))))
+	    ((re-search-forward number-regex nil t)
+	     ;; found a number in the current locale, return it in
+	     ;; the car.  Anything left over is annotation,
+	     ;; the first thing should be the commodity, separated
+	     ;; by whitespace, return it in the cdr.  I can't think of any
+	     ;; counterexamples
+	     (list
+	      (string-to-number
+	       (ledger-commodity-string-number-decimalize 
+		(delete-and-extract-region (match-beginning 0) (match-end 0)) :from-user))
+	      (nth 0 (split-string (buffer-substring-no-properties (point-min) (point-max))))))
+	    ((re-search-forward "0" nil t)
+	     ;; couldn't find a decimal number, look for a single 0,
+	     ;; indicating account with zero balance
+	     (list 0 ledger-reconcile-default-commodity)))))
+      ;; nothing found, return 0
+      (list 0 ledger-reconcile-default-commodity)))
+
+(defun ledger-string-balance-to-commoditized-amount (str)
+  "Return a commoditized amount (val, 'comm') from STR."
+  (let ((fields (split-string str "[\n\r]"))) ; break any balances
+					      ; with multi commodities
+					      ; into a list
+    (mapcar #'(lambda (str)
+	      (ledger-split-commodity-string str))
+	    fields)))
+
+(defun -commodity (c1 c2)
+  "Subtract C2 from C1, ensuring their commodities match."
+  (if (string= (cadr c1) (cadr c2))
+      (list (- (car c1) (car c2)) (cadr c1))
+      (error "Can't subtract different commodities %S from %S" c2 c1)))
+
+(defun +commodity (c1 c2)
+  "Add C1 and C2, ensuring their commodities match."
+  (if (string= (cadr c1) (cadr c2))
+      (list (+ (car c1) (car c2)) (cadr c1))
+      (error "Can't add different commodities, %S to %S" c1 c2)))
+
+(defun ledger-commodity-string-number-decimalize (number-string direction)
+  "Take NUMBER-STRING and ensure proper decimalization for use by string-to-number and number-to-string.  
+
+DIRECTION can be :to-user or :from-user.  All math calculations
+are done with decimal-period, some users may prefer decimal-comma
+which must be translated both directions."
+  (let ((val number-string))
+    (if (assoc "decimal-comma" ledger-environment-alist)
+	(cond ((eq direction :from-user)
+	       ;; change string to decimal-period
+	       (while (string-match "," val)
+		 (setq val (replace-match "." nil nil val)))) ;; switch to period separator
+	      ((eq direction :to-user)
+	     ;; change to decimal-comma
+	       (while (string-match "\\." val)
+		 (setq val (replace-match "," nil nil val)))) ;; gets rid of periods
+	      (t
+	       (error "ledger-commodity-string-number-decimalize: direction not properly specified %S" direction)))
+	(while (string-match "," val)
+	  (setq val (replace-match "" nil nil val))))
+    val))
+      
+	  
+      
+(defun ledger-commodity-to-string (c1)
+  "Return string representing C1.
+Single character commodities are placed ahead of the value,
+longer ones are after the value."
+(let ((val (ledger-commodity-string-number-decimalize
+	    (number-to-string (car c1)) :to-user))
+      (commodity (cadr c1)))
+  (if (> (length commodity) 1)
+      (concat val " " commodity)
+      (concat commodity " " val))))
+
+(defun ledger-read-commodity-string (prompt)
+  (let ((str (read-from-minibuffer
+	      (concat prompt " (" ledger-reconcile-default-commodity "): ")))
+	comm)
+    (if (> (length str) 0)
+	(progn
+	  (setq comm (ledger-split-commodity-string str))
+	  (if (cadr comm)
+	      comm
+	      (list (car comm) ledger-reconcile-default-commodity))))))
+
+(provide 'ldg-commodities)
+
+;;; ldg-commodities.el ends here
diff --git a/lisp/ldg-complete.el b/lisp/ldg-complete.el
index 7b4b0471..bd907bc8 100644
--- a/lisp/ldg-complete.el
+++ b/lisp/ldg-complete.el
@@ -1,29 +1,41 @@
-;;(require 'esh-util)
-;;(require 'esh-arg)
+;;; ldg-complete.el --- Helper code for use with the "ledger" command-line tool
+
+;; Copyright (C) 2003-2013 John Wiegley (johnw AT gnu DOT org)
+
+;; This file is not part of GNU Emacs.
+
+;; This is free software; you can redistribute it and/or modify it under
+;; the terms of the GNU General Public License as published by the Free
+;; Software Foundation; either version 2, or (at your option) any later
+;; version.
+;;
+;; This is distributed in the hope that it will be useful, but WITHOUT
+;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+;; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+;; for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+;; MA 02111-1307, USA.
+
+;;; Commentary:
+;; Functions providing payee and account auto complete.
+
 (require 'pcomplete)
 
 ;; 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))
-           'entry)
-          ((looking-at "^\\s-+\\([*!]\\s-+\\)?[[(]?\\(.\\)")
-           (goto-char (match-beginning 2))
-           'transaction)
-          ((looking-at "^\\(sun\\|mon\\|tue\\|wed\\|thu\\|fri\\|sat\\)\\s-+")
-           (goto-char (match-end 0))
-           'entry)
-          (t
-           (ignore (goto-char here))))))
+;;; Code:
 
 (defun ledger-parse-arguments ()
   "Parse whitespace separated arguments in the current region."
-  (let* ((info (save-excursion
-                 (cons (ledger-thing-at-point) (point))))
-         (begin (cdr info))
+  ;; this is more complex than it appears to need, so that it can work
+  ;; with pcomplete.  See pcomplete-parse-arguments-function for
+  ;; details
+  (let* ((begin (save-excursion
+		 (ledger-thing-at-point) ;; leave point at beginning of thing under point
+                 (point)))
          (end (point))
          begins args)
     (save-excursion
@@ -36,115 +48,126 @@
                          args)))
       (cons (reverse args) (reverse begins)))))
 
-(defun ledger-entries ()
+
+(defun ledger-payees-in-buffer ()
+  "Scan buffer and return list of all payees."
   (let ((origin (point))
-        entries-list)
+        payees-list)
     (save-excursion
       (goto-char (point-min))
       (while (re-search-forward
-              (concat "^[0-9/.=-]+\\(\\s-+\\*\\)?\\(\\s-+(.*?)\\)?\\s-+"
-                      "\\(.+?\\)\\(\t\\|\n\\| [ \t]\\)") nil t)
+              ledger-payee-any-status-regex nil t)  ;; matches first line
         (unless (and (>= origin (match-beginning 0))
                      (< origin (match-end 0)))
-          (setq entries-list (cons (match-string-no-properties 3)
-                                   entries-list)))))
-    (pcomplete-uniqify-list (nreverse entries-list))))
+          (setq payees-list (cons (match-string-no-properties 3)
+                                   payees-list)))))  ;; add the payee
+						     ;; to the list
+    (pcomplete-uniqify-list (nreverse payees-list))))
 
-(defvar ledger-account-tree nil)
-
-(defun ledger-find-accounts ()
-  (let ((origin (point)) account-path elements)
+(defun ledger-find-accounts-in-buffer ()
+  "Search through buffer and build tree of accounts.
+Return tree structure"
+  (let ((origin (point))
+	(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)
+              ledger-account-any-status-regex 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)))
-                (if entry
-                    (setq root (cdr entry))
-                  (setq entry (cons (car elements) (list t)))
-                  (nconc root (list entry))
-                  (setq root (cdr entry))))
-              (setq elements (cdr elements)))))))))
+          (setq account-elements
+		(split-string
+		 (match-string-no-properties 2) ":"))
+          (let ((root account-tree))
+	    (while account-elements
+	      (let ((xact (assoc (car account-elements) root)))
+		(if xact
+                    (setq root (cdr xact))
+		    (setq xact (cons (car account-elements) (list t)))
+		    (nconc root (list xact))
+		    (setq root (cdr xact))))
+              (setq account-elements (cdr account-elements)))))))
+    account-tree))
 
 (defun ledger-accounts ()
-  (ledger-find-accounts)
+  "Return a tree of all accounts in the buffer."
   (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)))
-        (if entry
+      (let ((xact (assoc (car elements) root)))
+        (if xact
             (setq prefix (concat prefix (and prefix ":")
                                  (car elements))
-                  root (cdr entry))
-          (setq root nil elements nil)))
+                  root (cdr xact))
+	    (setq root nil elements nil)))
       (setq elements (cdr elements)))
     (and root
          (sort
           (mapcar (function
                    (lambda (x)
-                     (let ((term (if prefix
-                                     (concat prefix ":" (car x))
-                                   (car x))))
-                       (if (> (length (cdr x)) 1)
-                           (concat term ":")
-                         term))))
+		    (let ((term (if prefix
+				    (concat prefix ":" (car x))
+				    (car x))))
+		      (if (> (length (cdr x)) 1)
+			  (concat term ":")
+			  term))))
                   (cdr root))
           'string-lessp))))
 
 (defun ledger-complete-at-point ()
-  "Do appropriate completion for the thing at point"
+  "Do appropriate completion for the thing at point."
   (interactive)
   (while (pcomplete-here
           (if (eq (save-excursion
-                    (ledger-thing-at-point)) 'entry)
+                    (ledger-thing-at-point)) 'transaction)
               (if (null current-prefix-arg)
-                  (ledger-entries)  ; this completes against entry names
-                (progn
-                  (let ((text (buffer-substring (line-beginning-position)
-                                                (line-end-position))))
-                    (delete-region (line-beginning-position)
-                                   (line-end-position))
-                    (condition-case err
-                        (ledger-add-entry text t)
-                      ((error)
-                       (insert text))))
-                  (forward-line)
-                  (goto-char (line-end-position))
-                  (search-backward ";" (line-beginning-position) t)
-                  (skip-chars-backward " \t0123456789.,")
-                  (throw 'pcompleted t)))
-            (ledger-accounts)))))
-
-(defun ledger-fully-complete-entry ()
-  "Do appropriate completion for the thing at point"
+                  (ledger-payees-in-buffer)  ;; this completes against payee names
+		  (progn
+		    (let ((text (buffer-substring-no-properties (line-beginning-position)
+								(line-end-position))))
+		      (delete-region (line-beginning-position)
+				     (line-end-position))
+		      (condition-case nil
+			  (ledger-add-transaction text t)
+			(error nil)))
+		    (forward-line)
+		    (goto-char (line-end-position))
+		    (search-backward ";" (line-beginning-position) t)
+		    (skip-chars-backward " \t0123456789.,")
+		    (throw 'pcompleted t)))
+	      (ledger-accounts)))))
+
+(defun ledger-fully-complete-xact ()
+  "Completes a transaction if there is another matching payee in the buffer.
+Does not use ledger xact"
   (interactive)
-  (let ((name (caar (ledger-parse-arguments)))
+  (let* ((name (caar (ledger-parse-arguments)))
+	(rest-of-name name)
         xacts)
     (save-excursion
-      (when (eq 'entry (ledger-thing-at-point))
+      (when (eq 'transaction (ledger-thing-at-point))
+	(delete-region (point) (+ (length name) (point)))
+	;; Search backward for a matching payee
         (when (re-search-backward
-               (concat "^[0-9/.=-]+\\(\\s-+\\*\\)?\\(\\s-+(.*?)\\)?\\s-+"
-                       (regexp-quote name) "\\(\t\\|\n\\| [ \t]\\)") nil t)
-          (forward-line)
-          (while (looking-at "^\\s-+")
+               (concat "^[0-9/.=-]+\\(\\s-+\\*\\)?\\(\\s-+(.*?)\\)?\\s-+\\(.*"
+                       (regexp-quote name) ".*\\)" ) nil t) 
+	  (setq rest-of-name (match-string 3))
+          ;; Start copying the postings
+	  (forward-line)
+          (while (looking-at ledger-account-any-status-regex)
             (setq xacts (cons (buffer-substring-no-properties
                                (line-beginning-position)
                                (line-end-position))
                               xacts))
             (forward-line))
           (setq xacts (nreverse xacts)))))
+    ;; Insert rest-of-name and the postings
     (when xacts
       (save-excursion
-        (insert ?\n)
+	(insert rest-of-name ?\n)
         (while xacts
           (insert (car xacts) ?\n)
           (setq xacts (cdr xacts))))
@@ -153,4 +176,51 @@
       (if (re-search-backward "\\(\t\\| [ \t]\\)" nil t)
           (goto-char (match-end 0))))))
 
+
+(defun ledger-pcomplete (&optional interactively)
+  "Complete rip-off of pcomplete from pcomplete.el, only added
+ledger-magic-tab in the previous commands list so that
+ledger-magic-tab would cycle properly"
+  (interactive "p")
+  (if (and interactively
+	   pcomplete-cycle-completions
+	   pcomplete-current-completions
+	   (memq last-command '(ledger-magic-tab
+				ledger-pcomplete
+				pcomplete-expand-and-complete
+				pcomplete-reverse)))
+      (progn
+	(delete-backward-char pcomplete-last-completion-length)
+	(if (eq this-command 'pcomplete-reverse)
+	    (progn
+              (push (car (last pcomplete-current-completions))
+                    pcomplete-current-completions)
+	      (setcdr (last pcomplete-current-completions 2) nil))
+	  (nconc pcomplete-current-completions
+		 (list (car pcomplete-current-completions)))
+	  (setq pcomplete-current-completions
+		(cdr pcomplete-current-completions)))
+	(pcomplete-insert-entry pcomplete-last-completion-stub
+                                (car pcomplete-current-completions)
+				nil pcomplete-last-completion-raw))
+    (setq pcomplete-current-completions nil
+	  pcomplete-last-completion-raw nil)
+    (catch 'pcompleted
+      (let* ((pcomplete-stub)
+	     pcomplete-seen pcomplete-norm-func
+	     pcomplete-args pcomplete-last pcomplete-index
+	     (pcomplete-autolist pcomplete-autolist)
+	     (pcomplete-suffix-list pcomplete-suffix-list)
+	     (completions (pcomplete-completions))
+	     (result (pcomplete-do-complete pcomplete-stub completions)))
+	(and result
+	     (not (eq (car result) 'listed))
+	     (cdr result)
+	     (pcomplete-insert-entry pcomplete-stub (cdr result)
+				     (memq (car result)
+					   '(sole shortest))
+				     pcomplete-last-completion-raw))))))
+
 (provide 'ldg-complete)
+
+;;; ldg-complete.el ends here
diff --git a/lisp/ldg-context.el b/lisp/ldg-context.el
new file mode 100644
index 00000000..ccaa39f2
--- /dev/null
+++ b/lisp/ldg-context.el
@@ -0,0 +1,210 @@
+;;; ldg-context.el --- Helper code for use with the "ledger" command-line tool
+
+;; Copyright (C) 2003-2013 John Wiegley (johnw AT gnu DOT org)
+
+;; This file is not part of GNU Emacs.
+
+;; This is free software; you can redistribute it and/or modify it under
+;; the terms of the GNU General Public License as published by the Free
+;; Software Foundation; either version 2, or (at your option) any later
+;; version.
+;;
+;; This is distributed in the hope that it will be useful, but WITHOUT
+;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+;; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+;; for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+;; MA 02111-1307, USA.
+
+
+;;; Commentary:
+;;  Provide facilities for reflection in ledger buffers
+
+;;; Code:
+
+(eval-when-compile
+  (require 'cl))
+
+;; *-string constants are assembled in the single-line-config macro to
+;; form the regex and list of elements
+(defconst indent-string "\\(^[ \t]+\\)")
+(defconst status-string "\\([*! ]?\\)")
+(defconst account-string "[\\[(]?\\(.*?\\)[])]?")
+(defconst amount-string "[ \t]?\\(-?[0-9]+\\.[0-9]*\\)")
+(defconst comment-string "[ \t]*;[ \t]*\\(.*?\\)")
+(defconst nil-string "\\([ \t]+\\)")
+(defconst commodity-string "\\(.+?\\)")
+(defconst date-string "^\\(\\([0-9]\\{4\\}[/-]\\)?[01]?[0-9][/-][0123]?[0-9]\\)")
+(defconst code-string "\\((\\(.*\\))\\)?")
+(defconst payee-string "\\(.*\\)")
+
+(defmacro line-regex (&rest elements)
+  (let (regex-string)
+    (concat (dolist (e elements regex-string)
+	      (setq regex-string 
+		    (concat regex-string 
+			    (eval 
+			     (intern 
+			      (concat (symbol-name e) "-string")))))) "[ \t]*$")))
+
+(defmacro single-line-config2 (&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)
+	   (setq regex-string 
+		 (concat regex-string 
+			 (eval 
+			  (intern 
+			   (concat (symbol-name e) "-string")))))) "[ \t]*$")
+       ,elements)))
+
+(defmacro single-line-config (&rest elements)
+  "Take list of ELEMENTS and return regex and element list for use in context-at-point"
+  `'(,(eval `(line-regex ,@elements))		  
+     ,elements))
+
+(defconst ledger-line-config
+  (list (list 'xact (list (single-line-config date nil status nil nil code payee comment)
+			  (single-line-config date nil status nil nil code payee)))
+	(list 'acct-transaction (list (single-line-config indent comment)
+				      (single-line-config indent status account nil commodity amount nil comment)
+				      (single-line-config indent status account nil commodity amount)
+				      (single-line-config indent status account nil amount nil commodity comment)
+				      (single-line-config indent status account nil amount nil commodity)
+				      (single-line-config indent status account nil amount)
+				      (single-line-config indent status account nil comment)
+				      (single-line-config indent status account)))))
+
+(defun ledger-extract-context-info (line-type pos)
+  "Get context info for current line with LINE-TYPE.
+
+Assumes point is at beginning of line, and the POS argument specifies
+where the \"users\" point was."
+  (let ((linfo (assoc line-type ledger-line-config))
+        found field fields)
+    (dolist (re-info (nth 1 linfo))
+      (let ((re (nth 0 re-info))
+            (names (nth 1 re-info)))
+        (unless found
+          (when (looking-at re)
+            (setq found t)
+            (dotimes (i (length names))
+              (when (nth i names)
+                (setq fields (append fields
+                                     (list
+                                      (list (nth i names)
+                                            (match-string-no-properties (1+ i))
+                                            (match-beginning (1+ i))))))))
+            (dolist (f fields)
+              (and (nth 1 f)
+                   (>= pos (nth 2 f))
+                   (setq field (nth 0 f))))))))
+    (list line-type field fields)))
+
+(defun ledger-thing-at-point ()
+  "Describe thing at points.  Return 'transaction, 'posting, or nil.
+Leave point at the beginning of the thing under 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))
+           'day)
+          (t
+           (ignore (goto-char here))))))
+
+(defun ledger-context-at-point ()
+  "Return a list describing the context around point.
+
+The contents of the list are the line type, the name of the field
+containing point, and for selected line types, the content of
+the fields in the line in a association list."
+  (let ((pos (point)))
+    (save-excursion
+      (beginning-of-line)
+      (let ((first-char (char-after)))
+        (cond ((equal (point) (line-end-position))
+               '(empty-line nil nil))
+              ((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))
+              ((equal first-char ?\=)
+               '(automated-xact nil nil))
+              ((equal first-char ?\~)
+               '(period-xact nil nil))
+              ((equal first-char ?\!)
+               '(command-directive))
+              ((equal first-char ?\;)
+               '(comment nil nil))
+              ((equal first-char ?Y)
+               '(default-year nil nil))
+              ((equal first-char ?P)
+               '(commodity-price nil nil))
+              ((equal first-char ?N)
+               '(price-ignored-commodity nil nil))
+              ((equal first-char ?D)
+               '(default-commodity nil nil))
+              ((equal first-char ?C)
+               '(commodity-conversion nil nil))
+              ((equal first-char ?i)
+               '(timeclock-i nil nil))
+              ((equal first-char ?o)
+               '(timeclock-o nil nil))
+              ((equal first-char ?b)
+               '(timeclock-b nil nil))
+              ((equal first-char ?h)
+               '(timeclock-h  nil nil))
+              (t
+               '(unknown nil nil)))))))
+
+(defun ledger-context-other-line (offset)
+  "Return a list describing context of line OFFSET from existing position.
+
+Offset can be positive or negative.  If run out of buffer before reaching
+specified line, returns nil."
+  (save-excursion
+    (let ((left (forward-line offset)))
+      (if (not (equal left 0))
+          nil
+	  (ledger-context-at-point)))))
+
+(defun ledger-context-line-type (context-info)
+  (nth 0 context-info))
+
+(defun ledger-context-current-field (context-info)
+  (nth 1 context-info))
+
+(defun ledger-context-field-info (context-info field-name)
+  (assoc field-name (nth 2 context-info)))
+
+(defun ledger-context-field-present-p (context-info field-name)
+  (not (null (ledger-context-field-info context-info field-name))))
+
+(defun ledger-context-field-value (context-info field-name)
+  (nth 1 (ledger-context-field-info context-info field-name)))
+
+(defun ledger-context-field-position (context-info field-name)
+  (nth 2 (ledger-context-field-info context-info field-name)))
+
+(defun ledger-context-field-end-position (context-info field-name)
+  (+ (ledger-context-field-position context-info field-name)
+     (length (ledger-context-field-value context-info field-name))))
+
+(defun ledger-context-goto-field-start (context-info field-name)
+  (goto-char (ledger-context-field-position context-info field-name)))
+
+(defun ledger-context-goto-field-end (context-info field-name)
+  (goto-char (ledger-context-field-end-position context-info field-name)))
+
+(provide 'ldg-context)
+
+;;; ldg-report.el ends here
diff --git a/lisp/ldg-exec.el b/lisp/ldg-exec.el
index bf3565b4..f6c3bb54 100644
--- a/lisp/ldg-exec.el
+++ b/lisp/ldg-exec.el
@@ -1,3 +1,36 @@
+;;; ldg-exec.el --- Helper code for use with the "ledger" command-line tool
+
+;; Copyright (C) 2003-2013 John Wiegley (johnw AT gnu DOT org)
+
+;; This file is not part of GNU Emacs.
+
+;; This is free software; you can redistribute it and/or modify it under
+;; the terms of the GNU General Public License as published by the Free
+;; Software Foundation; either version 2, or (at your option) any later
+;; version.
+;;
+;; This is distributed in the hope that it will be useful, but WITHOUT
+;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+;; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+;; for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+;; MA 02111-1307, USA.
+
+
+;;; Commentary:
+;; Code for executing ledger synchronously.
+
+;;; Code:
+
+(defconst ledger-version-needed "3.0.0"
+  "The version of ledger executable needed for interactive features.")
+
+(defvar ledger-works nil
+  "Flag showing whether the ledger binary can support `ledger-mode' interactive features.")
+
 (defgroup ledger-exec nil
   "Interface to the Ledger command-line accounting program."
   :group 'ledger)
@@ -5,30 +38,64 @@
 (defcustom ledger-binary-path "ledger"
   "Path to the ledger executable."
   :type 'file
-  :group 'ledger)
+  :group 'ledger-exec)
+
+(defun ledger-exec-handle-error (ledger-output)
+  "Deal with ledger errors contained in LEDGER-OUTPUT."
+  (with-current-buffer (get-buffer-create "*Ledger Error*")
+    (insert-buffer-substring ledger-output)
+    (view-mode)
+    (setq buffer-read-only t)))
+
+(defun ledger-exec-success-p (ledger-output-buffer)
+  (with-current-buffer ledger-output-buffer
+    (goto-char (point-min))
+    (if (and (> (buffer-size) 1) (looking-at (regexp-quote "While")))
+	nil  ;; failure, there is an error starting with "While"
+	ledger-output-buffer)))
 
 (defun ledger-exec-ledger (input-buffer &optional output-buffer &rest args)
-  "Run Ledger."
+  "Run Ledger using INPUT-BUFFER and optionally capturing output in OUTPUT-BUFFER with ARGS."
   (if (null ledger-binary-path)
-      (error "The variable `ledger-binary-path' has not been set"))
-  (let ((buf (or input-buffer (current-buffer)))
-        (outbuf (or output-buffer
-                    (generate-new-buffer " *ledger-tmp*"))))
-    (with-current-buffer buf
-      (let ((coding-system-for-write 'utf-8)
-            (coding-system-for-read 'utf-8))
-        (apply #'call-process-region
-               (append (list (point-min) (point-max)
-                             ledger-binary-path nil outbuf nil "-f" "-")
-                       args)))
-      outbuf)))
-
-(defun ledger-exec-read (&optional input-buffer &rest args)
-  (with-current-buffer
-      (apply #'ledger-exec-ledger input-buffer nil "emacs" args)
-    (goto-char (point-min))
-    (prog1
-        (read (current-buffer))
-      (kill-buffer (current-buffer)))))
+      (error "The variable `ledger-binary-path' has not been set")
+      (let ((buf (or input-buffer (current-buffer)))
+	    (outbuf (or output-buffer
+			(generate-new-buffer " *ledger-tmp*"))))
+	(with-current-buffer buf
+	  (let ((coding-system-for-write 'utf-8)
+		(coding-system-for-read 'utf-8))
+	    (apply #'call-process-region
+		   (append (list (point-min) (point-max)
+				 ledger-binary-path nil outbuf nil "-f" "-")
+			   args)))
+	  (if (ledger-exec-success-p outbuf)
+	      outbuf
+	      (ledger-exec-handle-error outbuf))))))
+
+(defun ledger-version-greater-p (needed)
+  "Verify the ledger binary is usable for `ledger-mode' (version greater than NEEDED)."
+  (let ((buffer ledger-buf)
+        (version-strings '()))
+    (with-temp-buffer
+      (when (ledger-exec-ledger (current-buffer) (current-buffer) "--version")	
+	(goto-char (point-min))
+	(delete-horizontal-space)
+	(setq version-strings (split-string
+			       (buffer-substring-no-properties (point)
+							       (point-max))))
+	(if (and (string-match (regexp-quote "Ledger") (car version-strings))
+		 (or (string= needed (cadr version-strings))
+		     (string< needed (cadr version-strings))))
+	    t ;; success
+	    nil))))) ;;failure
+
+(defun ledger-check-version ()
+  "Verify that ledger works and is modern enough."
+  (interactive)
+  (if (setq ledger-works (ledger-version-greater-p ledger-version-needed))
+      (message "Good Ledger Version")
+      (message "Bad Ledger Version")))
 
 (provide 'ldg-exec)
+
+;;; ldg-exec.el ends here
diff --git a/lisp/ldg-fonts.el b/lisp/ldg-fonts.el
new file mode 100644
index 00000000..cb7a81c0
--- /dev/null
+++ b/lisp/ldg-fonts.el
@@ -0,0 +1,137 @@
+;;; ldg-fonts.el --- Helper code for use with the "ledger" command-line tool
+
+;; Copyright (C) 2003-2013 John Wiegley (johnw AT gnu DOT org)
+
+;; This file is not part of GNU Emacs.
+
+;; This is free software; you can redistribute it and/or modify it under
+;; the terms of the GNU General Public License as published by the Free
+;; Software Foundation; either version 2, or (at your option) any later
+;; version.
+;;
+;; This is distributed in the hope that it will be useful, but WITHOUT
+;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+;; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+;; for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+;; MA 02111-1307, USA.
+
+
+
+;;; Commentary:
+;; All of the faces for ledger mode are defined here.
+
+;;; Code:
+
+(require 'ldg-regex)
+
+(defgroup ledger-faces nil "Ledger mode highlighting" :group 'ledger)
+(defface ledger-font-payee-uncleared-face
+    `((t :foreground "#dc322f" :weight bold ))
+  "Default face for Ledger"
+  :group 'ledger-faces)
+
+(defface ledger-font-payee-cleared-face
+    `((t :foreground "#657b83" :weight normal ))
+  "Default face for cleared (*) transactions"
+  :group 'ledger-faces)
+
+(defface ledger-font-xact-highlight-face
+    `((t :background "#eee8d5"))
+  "Default face for transaction under point"
+  :group 'ledger-faces)
+
+(defface ledger-font-pending-face
+    `((t :foreground "#cb4b16" :weight normal ))
+  "Default face for pending (!) transactions"
+  :group 'ledger-faces)
+
+(defface ledger-font-other-face
+    `((t :foreground "#657b83" ))
+  "Default face for other transactions"
+  :group 'ledger-faces)
+
+(defface ledger-font-posting-account-face
+    `((t :foreground "#268bd2" ))
+  "Face for Ledger accounts"
+  :group 'ledger-faces)
+
+(defface ledger-font-posting-account-cleared-face
+    `((t :foreground "#657b83" ))
+  "Face for Ledger accounts"
+  :group 'ledger-faces)
+
+(defface ledger-font-posting-account-pending-face
+    `((t :foreground "#cb4b16" ))
+  "Face for Ledger accounts"
+  :group 'ledger-faces)
+
+(defface ledger-font-posting-amount-face
+    `((t :foreground "#cb4b16" ))
+  "Face for Ledger amounts"
+  :group 'ledger-faces)
+
+(defface ledger-occur-narrowed-face
+    `((t :foreground "grey70" :invisible t ))
+  "Default face for Ledger occur mode hidden transactions"
+  :group 'ledger-faces)
+
+(defface ledger-occur-xact-face
+    `((t :background "#eee8d5" ))
+  "Default face for Ledger occur mode shown transactions"
+  :group 'ledger-faces)
+
+(defface ledger-font-comment-face
+    `((t :foreground "#93a1a1" :slant italic))
+  "Face for Ledger comments"
+  :group 'ledger-faces)
+
+(defface ledger-font-reconciler-uncleared-face
+    `((t :foreground "#dc322f" :weight bold ))
+  "Default face for uncleared transactions in the reconcile window"
+  :group 'ledger-faces)
+
+(defface ledger-font-reconciler-cleared-face
+    `((t :foreground "#657b83" :weight normal ))
+  "Default face for cleared (*) transactions in the reconcile window"
+  :group 'ledger-faces)
+
+(defface ledger-font-reconciler-pending-face
+    `((t :foreground "#cb4b16" :weight normal ))
+  "Default face for pending (!) transactions in the reconcile window"
+  :group 'ledger-faces)
+
+(defface ledger-font-report-clickable-face
+    `((t :foreground "#cb4b16" :weight normal ))
+  "Default face for pending (!) transactions in the reconcile window"
+  :group 'ledger-faces)
+
+
+(defvar ledger-font-lock-keywords
+  `( ;; (,ledger-other-entries-regex 1 
+     ;; 				  ledger-font-other-face)
+     (,ledger-comment-regex 2 
+			    'ledger-font-comment-face)
+     (,ledger-payee-pending-regex 2 
+				  'ledger-font-payee-pending-face) ; Works
+     (,ledger-payee-cleared-regex 2 
+ 				  'ledger-font-payee-cleared-face) ; Works
+     (,ledger-payee-uncleared-regex 2 
+ 				    'ledger-font-payee-uncleared-face) ; Works
+     (,ledger-account-cleared-regex 2 
+ 	      			    'ledger-font-posting-account-cleared-face) ; Works
+     (,ledger-account-pending-regex 2 
+ 	      			    'ledger-font-posting-account-pending-face) ; Works
+     (,ledger-account-any-status-regex 2 
+				       'ledger-font-posting-account-face) ; Works
+     (,ledger-other-entries-regex 1 
+				  'ledger-font-other-face))
+  "Expressions to highlight in Ledger mode.")
+    
+
+(provide 'ldg-fonts)
+
+;;; ldg-fonts.el ends here
diff --git a/lisp/ldg-init.el b/lisp/ldg-init.el
new file mode 100644
index 00000000..f283c77c
--- /dev/null
+++ b/lisp/ldg-init.el
@@ -0,0 +1,68 @@
+;;; ldg-init.el --- Helper code for use with the "ledger" command-line tool
+
+;; Copyright (C) 2003-2013 John Wiegley (johnw AT gnu DOT org)
+
+;; This file is not part of GNU Emacs.
+
+;; This is free software; you can redistribute it and/or modify it under
+;; the terms of the GNU General Public License as published by the Free
+;; Software Foundation; either version 2, or (at your option) any later
+;; version.
+;;
+;; This is distributed in the hope that it will be useful, but WITHOUT
+;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+;; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+;; for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+;; MA 02111-1307, USA.
+
+;;; Commentary:
+;; Determine the ledger environment
+
+(require 'ldg-regex)
+
+(defcustom ledger-init-file-name "~/.ledgerrc"
+  "Location of the ledger initialization file. nil if you don't have one"
+  :group 'ledger-exec)
+
+(defvar ledger-environment-alist nil)
+
+(defun ledger-init-parse-initialization (buffer)
+  (with-current-buffer buffer
+    (let (environment-alist)
+      (goto-char (point-min))
+      (while (re-search-forward ledger-init-string-regex nil t )
+	(let ((matchb (match-beginning 0)) ;; save the match data, string-match stamp on it
+	      (matche (match-end 0)))
+	  (end-of-line)
+	  (setq environment-alist 
+		(append environment-alist
+			(list (cons (let ((flag (buffer-substring-no-properties (+ 2 matchb) matche)))
+				      (if (string-match "[ \t\n\r]+\\'" flag)
+					  (replace-match "" t t flag)
+					  flag))
+				    (let ((value (buffer-substring-no-properties  matche (point) )))
+				      (if (> (length value) 0)
+					  value
+					  t))))))))
+      environment-alist)))
+
+(defun ledger-init-load-init-file ()
+  (interactive)
+  (let ((init-base-name (file-name-nondirectory ledger-init-file-name)))
+    (if (get-buffer init-base-name) ;; init file already loaded, parse it and leave it
+	(ledger-init-parse-initialization init-base-name)
+       (when (and ledger-init-file-name
+		  (file-exists-p ledger-init-file-name)
+		  (file-readable-p ledger-init-file-name))	 
+	 (find-file-noselect ledger-init-file-name)
+	 (setq ledger-environment-alist 
+	       (ledger-init-parse-initialization init-base-name))
+	 (kill-buffer init-base-name)))))
+
+(provide 'ldg-init)
+
+;;; ldg-init.el ends here
diff --git a/lisp/ldg-mode.el b/lisp/ldg-mode.el
index 4d13d7d2..4bc195ed 100644
--- a/lisp/ldg-mode.el
+++ b/lisp/ldg-mode.el
@@ -1,118 +1,210 @@
-(defcustom ledger-default-acct-transaction-indent "    "
-  "Default indentation for account transactions in an entry."
-  :type 'string
-  :group 'ledger)
-
-(defvar bold 'bold)
-(defvar ledger-font-lock-keywords
-  '(("\\(       \\|  \\|^\\)\\(;.*\\)" 2 font-lock-comment-face)
-    ("^[0-9]+[-/.=][-/.=0-9]+\\s-+\\(([^)]+)\\s-+\\)?\\([^*].+?\\)\\(\\(        ;\\|  ;\\|$\\)\\)" 2 bold)
-    ;;("^[0-9]+[-/.=][-/.=0-9]+\\s-+\\(([^)]+)\\s-+\\)?\\([*].+?\\)\\(\\(       ;\\|  ;\\|$\\)\\)"
-    ;; 2 font-lock-type-face)
-    ("^\\s-+\\([*]\\s-*\\)?\\(\\([[(]\\)?[^*:
-        ]+?:\\([^]);
-        ]\\|\\s-\\)+?\\([])]\\)?\\)\\(    \\|  \\|$\\)"
-     2 font-lock-keyword-face)
-    ("^\\([~=].+\\)" 1 font-lock-function-name-face)
-    ("^\\([A-Za-z]+ .+\\)" 1 font-lock-function-name-face))
-  "Expressions to highlight in Ledger mode.")
+;;; ldg-mode.el --- Helper code for use with the "ledger" command-line tool
+
+;; Copyright (C) 2003-2013 John Wiegley (johnw AT gnu DOT org)
+
+;; This file is not part of GNU Emacs.
+
+;; This is free software; you can redistribute it and/or modify it under
+;; the terms of the GNU General Public License as published by the Free
+;; Software Foundation; either version 2, or (at your option) any later
+;; version.
+;;
+;; This is distributed in the hope that it will be useful, but WITHOUT
+;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+;; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+;; for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+;; MA 02111-1307, USA.
+
+
+
+;;; Commentary:
+;; Most of the general ledger-mode code is here.
+
+;;; Code:
+
+(defsubst ledger-current-year ()
+  "The default current year for adding transactions."
+  (format-time-string "%Y"))
+(defsubst ledger-current-month ()
+  "The default current month for adding transactions."
+  (format-time-string "%m"))
+
+(defvar ledger-year (ledger-current-year)
+  "Start a ledger session with the current year, but make it customizable to ease retro-entry.")
+
+(defvar ledger-month (ledger-current-month)
+  "Start a ledger session with the current month, but make it customizable to ease retro-entry.")
+
+(defun ledger-read-account-with-prompt (prompt) 
+  (let* ((context (ledger-context-at-point))
+	 (default (if (and (eq (ledger-context-line-type context) 'acct-transaction)
+			   (eq (ledger-context-current-field context) 'account))
+		      (regexp-quote (ledger-context-field-value context 'account))
+		      nil)))
+    (ledger-read-string-with-default prompt default)))
+
+(defun ledger-read-string-with-default (prompt default)
+  "Return user supplied string after PROMPT, or DEFAULT."
+  (read-string (concat prompt
+		       (if default
+			   (concat " (" default "): ")
+			   ": ")) 
+	       nil 'ledger-minibuffer-history default))
+
+(defun ledger-display-balance-at-point ()
+  "Display the cleared-or-pending balance.
+And calculate the target-delta of the account being reconciled."
+  (interactive)
+  (let* ((account (ledger-read-account-with-prompt "Account balance to show"))
+	 (buffer (current-buffer))
+	 (balance (with-temp-buffer
+		    (ledger-exec-ledger buffer (current-buffer) "cleared" account)
+		    (buffer-substring-no-properties (point-min) (1- (point-max))))))
+    (when balance      
+      (message balance))))
+
+(defun ledger-magic-tab (&optional interactively)
+  "Decide what to with with <TAB> .
+Can be pcomplete, or align-posting"
+  (interactive "p")
+  (if (and (> (point) 1) 
+	   (looking-back "[:A-Za-z0-9]" 1))
+      (ledger-pcomplete interactively)
+      (ledger-post-align-postings)))
 
 (defvar ledger-mode-abbrev-table)
 
+(defun ledger-insert-effective-date ()
+  (interactive)
+  (let ((context (car (ledger-context-at-point)))
+	(date-string (format-time-string (cdr (assoc "date-format" ledger-environment-alist)))))
+   (cond ((eq 'xact context)
+	  (beginning-of-line)
+	  (insert date-string "="))
+	 ((eq 'acct-transaction context)
+	  (end-of-line)
+	  (insert "  ; [=" date-string "]")))))
+
 ;;;###autoload
 (define-derived-mode ledger-mode text-mode "Ledger"
-  "A mode for editing ledger data files."
-  (ledger-post-setup)
-
-  (set (make-local-variable 'comment-start) " ; ")
-  (set (make-local-variable 'comment-end) "")
-  (set (make-local-variable 'indent-tabs-mode) nil)
-
-  (if (boundp 'font-lock-defaults)
-      (set (make-local-variable 'font-lock-defaults)
-           '(ledger-font-lock-keywords nil t)))
-
-  (set (make-local-variable 'pcomplete-parse-arguments-function)
-       'ledger-parse-arguments)
-  (set (make-local-variable 'pcomplete-command-completion-function)
-       'ledger-complete-at-point)
-  (set (make-local-variable 'pcomplete-termination-string) "")
-
-  (let ((map (current-local-map)))
-    (define-key map [(control ?c) (control ?a)] 'ledger-add-entry)
-    (define-key map [(control ?c) (control ?d)] 'ledger-delete-current-entry)
-    (define-key map [(control ?c) (control ?y)] 'ledger-set-year)
-    (define-key map [(control ?c) (control ?m)] 'ledger-set-month)
-    (define-key map [(control ?c) (control ?c)] 'ledger-toggle-current)
-    (define-key map [(control ?c) (control ?e)] 'ledger-toggle-current-entry)
-    (define-key map [(control ?c) (control ?r)] 'ledger-reconcile)
-    (define-key map [(control ?c) (control ?s)] 'ledger-sort)
-    (define-key map [(control ?c) (control ?t)] 'ledger-test-run)
-    (define-key map [tab] 'pcomplete)
-    (define-key map [(control ?i)] 'pcomplete)
-    (define-key map [(control ?c) tab] 'ledger-fully-complete-entry)
-    (define-key map [(control ?c) (control ?i)] 'ledger-fully-complete-entry)))
-
-(defun ledger-time-less-p (t1 t2)
-  "Say whether time value T1 is less than time value T2."
-  (or (< (car t1) (car t2))
-      (and (= (car t1) (car t2))
-           (< (nth 1 t1) (nth 1 t2)))))
-
-(defun ledger-time-subtract (t1 t2)
-  "Subtract two time values.
-Return the difference in the format of a time value."
-  (let ((borrow (< (cadr t1) (cadr t2))))
-    (list (- (car t1) (car t2) (if borrow 1 0))
-          (- (+ (if borrow 65536 0) (cadr t1)) (cadr t2)))))
-
-(defun ledger-find-slot (moment)
-  (catch 'found
-    (ledger-iterate-entries
-     (function
-      (lambda (start date mark desc)
-        (if (ledger-time-less-p moment date)
-            (throw 'found t)))))))
-
-(defun ledger-add-entry (entry-text &optional insert-at-point)
-  (interactive "sEntry: ")
-  (let* ((args (with-temp-buffer
-                 (insert entry-text)
-                 (eshell-parse-arguments (point-min) (point-max))))
-         (ledger-buf (current-buffer))
-         exit-code)
-    (unless insert-at-point
-      (let ((date (car args)))
-        (if (string-match "\\([0-9]+\\)/\\([0-9]+\\)/\\([0-9]+\\)" date)
-            (setq date
-                  (encode-time 0 0 0 (string-to-number (match-string 3 date))
-                               (string-to-number (match-string 2 date))
-                               (string-to-number (match-string 1 date)))))
-        (ledger-find-slot date)))
-    (save-excursion
-      (insert
-       (with-temp-buffer
-         (setq exit-code
-               (apply #'ledger-run-ledger ledger-buf "entry"
-                      (mapcar 'eval args)))
-         (goto-char (point-min))
-         (if (looking-at "Error: ")
-             (error (buffer-string))
-           (buffer-string)))
-       "\n"))))
-
-(defun ledger-current-entry-bounds ()
-  (save-excursion
-    (when (or (looking-at "^[0-9]")
-              (re-search-backward "^[0-9]" nil t))
-      (let ((beg (point)))
-        (while (not (eolp))
-          (forward-line))
-        (cons (copy-marker beg) (point-marker))))))
-
-(defun ledger-delete-current-entry ()
-  (interactive)
-  (let ((bounds (ledger-current-entry-bounds)))
-    (delete-region (car bounds) (cdr bounds))))
+    "A mode for editing ledger data files."
+    (ledger-check-version)
+    (ledger-post-setup)
+
+    (set (make-local-variable 'comment-start) " ; ")
+    (set (make-local-variable 'comment-end) "")
+    (set (make-local-variable 'indent-tabs-mode) nil)
+
+    (if (boundp 'font-lock-defaults)
+	(set (make-local-variable 'font-lock-defaults)
+	     '(ledger-font-lock-keywords nil t)))
+
+    (set (make-local-variable 'pcomplete-parse-arguments-function)
+	 'ledger-parse-arguments)
+    (set (make-local-variable 'pcomplete-command-completion-function)
+	 'ledger-complete-at-point)
+    (set (make-local-variable 'pcomplete-termination-string) "")
+
+    (add-hook 'post-command-hook 'ledger-highlight-xact-under-point nil t)
+    (add-hook 'before-revert-hook 'ledger-occur-remove-all-overlays nil t)
+    (make-variable-buffer-local 'highlight-overlay)
+    
+    (ledger-init-load-init-file)
+
+    (set (make-local-variable 'indent-region-function) 'ledger-post-align-postings)
+
+    (let ((map (current-local-map)))
+      (define-key map [(control ?c) (control ?a)] 'ledger-add-transaction)
+      (define-key map [(control ?c) (control ?b)] 'ledger-post-edit-amount)
+      (define-key map [(control ?c) (control ?c)] 'ledger-toggle-current)
+      (define-key map [(control ?c) (control ?d)] 'ledger-delete-current-transaction)
+      (define-key map [(control ?c) (control ?e)] 'ledger-toggle-current-transaction)
+      (define-key map [(control ?c) (control ?f)] 'ledger-occur)
+      (define-key map [(control ?c) (control ?k)] 'ledger-copy-transaction-at-point)
+      (define-key map [(control ?c) (control ?m)] 'ledger-set-month)
+      (define-key map [(control ?c) (control ?r)] 'ledger-reconcile)
+      (define-key map [(control ?c) (control ?s)] 'ledger-sort-region)
+      (define-key map [(control ?c) (control ?t)] 'ledger-insert-effective-date)
+      (define-key map [(control ?c) (control ?u)] 'ledger-schedule-upcoming)
+      (define-key map [(control ?c) (control ?y)] 'ledger-set-year)
+      (define-key map [(control ?c) (control ?p)] 'ledger-display-balance-at-point)
+      (define-key map [tab] 'ledger-magic-tab)
+      (define-key map [(control ?i)] 'ledger-magic-tab)
+      (define-key map [(control ?c) tab] 'ledger-fully-complete-xact)
+      (define-key map [(control ?c) (control ?i)] 'ledger-fully-complete-xact)
+
+      (define-key map [(control ?c) (control ?o) (control ?a)] 'ledger-report-redo)
+      (define-key map [(control ?c) (control ?o) (control ?e)] 'ledger-report-edit)
+      (define-key map [(control ?c) (control ?o) (control ?g)] 'ledger-report-goto)
+      (define-key map [(control ?c) (control ?o) (control ?k)] 'ledger-report-kill)
+      (define-key map [(control ?c) (control ?o) (control ?r)] 'ledger-report)
+      (define-key map [(control ?c) (control ?o) (control ?s)] 'ledger-report-save)
+ 
+      (define-key map [(meta ?p)] 'ledger-post-prev-xact)
+      (define-key map [(meta ?n)] 'ledger-post-next-xact)
+
+      (define-key map [menu-bar] (make-sparse-keymap "ldg-menu"))
+      (define-key map [menu-bar ldg-menu] (cons "Ledger" map))
+
+      (define-key map [report-kill] '(menu-item "Kill Report" ledger-report-kill :enable ledger-works))
+      (define-key map [report-edit] '(menu-item "Edit Report" ledger-report-edit :enable ledger-works))
+      (define-key map [report-save] '(menu-item "Save Report" ledger-report-save :enable ledger-works))
+      (define-key map [report-rrun] '(menu-item "Re-run Report" ledger-report-redo :enable ledger-works))
+      (define-key map [report-goto] '(menu-item "Goto Report" ledger-report-goto :enable ledger-works))
+      (define-key map [report-run] '(menu-item "Run Report" ledger-report :enable ledger-works))
+      (define-key map [sep5] '(menu-item "--"))
+      (define-key map [set-month] '(menu-item "Set Month" ledger-set-month :enable ledger-works))
+      (define-key map [set-year] '(menu-item "Set Year" ledger-set-year :enable ledger-works))
+      (define-key map [cust] '(menu-item "Customize Ledger Mode"  (lambda ()
+								    (interactive)
+								    (customize-group 'ledger))))
+      (define-key map [sep1] '("--"))
+      (define-key map [effective-date] '(menu-item "Set effective date" ledger-insert-effective-date))
+      (define-key map [sort-end] '(menu-item "Mark Sort End" ledger-sort-insert-end-mark))
+      (define-key map [sort-start] '(menu-item "Mark Sort Beginning" ledger-sort-insert-start-mark))
+      (define-key map [sort-buff] '(menu-item "Sort Buffer" ledger-sort-buffer))
+      (define-key map [sort-reg] '(menu-item "Sort Region" ledger-sort-region :enable mark-active))
+      (define-key map [align-reg] '(menu-item "Align Region" ledger-post-align-postings :enable mark-active))
+      (define-key map [sep2] '(menu-item "--"))
+      (define-key map [copy-xact] '(menu-item "Copy Trans at Point" ledger-copy-transaction-at-point))
+      (define-key map [toggle-post] '(menu-item "Toggle Current Posting" ledger-toggle-current))
+      (define-key map [toggle-xact] '(menu-item "Toggle Current Transaction" ledger-toggle-current-transaction))
+      (define-key map [sep4] '(menu-item "--"))
+      (define-key map [recon-account] '(menu-item "Reconcile Account" ledger-reconcile))
+      (define-key map [check-balance] '(menu-item "Check Balance" ledger-display-balance-at-point))
+      (define-key map [sep6] '(menu-item "--"))
+      (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 Transaction" ledger-delete-current-transaction))
+      (define-key map [cmp-xact] '(menu-item "Complete Transaction" ledger-fully-complete-xact))
+      (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 "Narrow to REGEX" ledger-occur))))
+
+
+
+
+(defun ledger-set-year (newyear)
+  "Set ledger's idea of the current year to the prefix argument NEWYEAR."
+  (interactive "p")
+  (if (= newyear 1)
+      (setq ledger-year (read-string "Year: " (ledger-current-year)))
+      (setq ledger-year (number-to-string newyear))))
+
+(defun ledger-set-month (newmonth)
+  "Set ledger's idea of the current month to the prefix argument NEWMONTH."
+  (interactive "p")
+  (if (= newmonth 1)
+      (setq ledger-month (read-string "Month: " (ledger-current-month)))
+      (setq ledger-month (format "%02d" newmonth))))
+
+
 
 (provide 'ldg-mode)
+
+;;; ldg-mode.el ends here
diff --git a/lisp/ldg-new.el b/lisp/ldg-new.el
index 64377bb9..bed99ac0 100644
--- a/lisp/ldg-new.el
+++ b/lisp/ldg-new.el
@@ -31,15 +31,29 @@
 ;; MA 02111-1307, USA.
 
 ;;; Commentary:
-
-(require 'ldg-post)
-(require 'ldg-mode)
+;; Load up the ledger mode
+(require 'ldg-regex)
+(require 'esh-util)
+(require 'esh-arg)
+(require 'ldg-commodities)
 (require 'ldg-complete)
+(require 'ldg-context)
+(require 'ldg-exec)
+(require 'ldg-fonts)
+(require 'ldg-init)
+(require 'ldg-mode)
+(require 'ldg-occur)
+(require 'ldg-post)
+(require 'ldg-reconcile)
+(require 'ldg-report)
+(require 'ldg-sort)
 (require 'ldg-state)
+(require 'ldg-test)
+(require 'ldg-texi)
+(require 'ldg-xact)
+(require 'ldg-schedule)
 
-;(autoload #'ledger-mode "ldg-mode" nil t)
-;(autoload #'ledger-fully-complete-entry "ldg-complete" nil t)
-;(autoload #'ledger-toggle-current "ldg-state" nil t)
+;;; Code:
 
 (autoload #'ledger-texi-update-test "ldg-texi" nil t)
 (autoload #'ledger-texi-update-examples "ldg-texi" nil t)
@@ -49,34 +63,28 @@
   :group 'data)
 
 (defconst ledger-version "3.0"
-  "The version of ledger.el currently loaded")
+  "The version of ledger.el currently loaded.")
 
-(provide 'ledger)
+(defun ledger-mode-dump-variable (var)
+  (if var
+   (insert (format "         %s: %S\n" (symbol-name var) (eval var)))))
+  
+(defun ledger-mode-dump-group (group)
+  "Dump GROUP customizations to current buffer"
+  (let ((members (custom-group-members group nil)))
+    (dolist (member members)
+      (cond ((eq (cadr member) 'custom-group)
+	     (insert (format "Group %s:\n" (symbol-name (car member))))
+	     (ledger-mode-dump-group (car member)))
+	    ((eq (cadr member) 'custom-variable) 
+	     (ledger-mode-dump-variable (car member)))))))
 
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(defun ledger-mode-dump-configuration ()
+  "Dump all customizations"
+  (find-file "ledger-mode-dump")
+  (ledger-mode-dump-group 'ledger))
+ 
+(provide 'ledger)
 
-(defun ledger-create-test ()
-  (interactive)
-  (save-restriction
-    (org-narrow-to-subtree)
-    (save-excursion
-      (let (text beg)
-        (goto-char (point-min))
-        (forward-line 1)
-        (setq beg (point))
-        (search-forward ":PROPERTIES:")
-        (goto-char (line-beginning-position))
-        (setq text (buffer-substring-no-properties beg (point)))
-        (goto-char (point-min))
-        (re-search-forward ":ID:\\s-+\\([^-]+\\)")
-        (find-file-other-window
-         (format "~/src/ledger/test/regress/%s.test" (match-string 1)))
-        (sit-for 0)
-        (insert text)
-        (goto-char (point-min))
-        (while (not (eobp))
-          (goto-char (line-beginning-position))
-          (delete-char 3)
-          (forward-line 1))))))
+;;; ldg-new.el ends here
 
-;;; ledger.el ends here
diff --git a/lisp/ldg-occur.el b/lisp/ldg-occur.el
new file mode 100644
index 00000000..96c364d6
--- /dev/null
+++ b/lisp/ldg-occur.el
@@ -0,0 +1,210 @@
+;;; ldg-mode.el --- Helper code for use with the "ledger" command-line tool
+
+;; Copyright (C) 2003-2013 John Wiegley (johnw AT gnu DOT org)
+
+;; This file is not part of GNU Emacs.
+
+;; This is free software; you can redistribute it and/or modify it under
+;; the terms of the GNU General Public License as published by the Free
+;; Software Foundation; either version 2, or (at your option) any later
+;; version.
+;;
+;; This is distributed in the hope that it will be useful, but WITHOUT
+;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+;; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+;; for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+;; MA 02111-1307, USA.
+
+;;; Commentary:
+;; Provide buffer narrowing to ledger mode.  Adapted from original loccur
+;; mode by Alexey Veretennikov <alexey dot veretennikov at gmail dot
+;; com>
+;;
+;; Adapted to ledger mode by Craig Earls <enderww at gmail dot
+;; com>
+
+;;; Code:
+
+(defconst ledger-occur-overlay-property-name 'ledger-occur-custom-buffer-grep)
+
+(defcustom ledger-occur-use-face-shown t
+  "If non-nil, use a custom face for xacts shown in `ledger-occur' mode using ledger-occur-xact-face."
+  :type 'boolean
+  :group 'ledger)
+(make-variable-buffer-local 'ledger-occur-use-face-shown)
+
+
+(defvar ledger-occur-mode nil 
+"name of the minor mode, shown in the mode-line")
+
+(make-variable-buffer-local 'ledger-occur-mode)
+
+(or (assq 'ledger-occur-mode minor-mode-alist)
+    (nconc minor-mode-alist
+           (list '(ledger-occur-mode ledger-occur-mode))))
+
+(defvar ledger-occur-history nil
+  "History of previously searched expressions for the prompt.")
+;;(make-variable-buffer-local 'ledger-occur-history)
+
+(defvar ledger-occur-last-match nil
+  "Last match found.")
+(make-variable-buffer-local 'ledger-occur-last-match)
+
+(defvar ledger-occur-overlay-list nil
+  "A list of currently active overlays to the ledger buffer.")
+(make-variable-buffer-local 'ledger-occur-overlay-list)
+
+(defun ledger-remove-all-overlays ()
+  "Remove all overlays from the ledger buffer."
+  (interactive)
+  (remove-overlays))
+
+(defun ledger-occur-mode (regex buffer)
+  "Highlight transactions that match REGEX in BUFFER, hiding others.
+
+When REGEX is nil, unhide everything, and remove higlight"
+  (set-buffer buffer)
+  (setq ledger-occur-mode
+	(if (or (null regex)
+		(zerop (length regex)))
+	    nil
+	    (concat " Ledger-Narrowed: " regex)))
+  (force-mode-line-update)
+  (ledger-occur-remove-overlays)
+  (if ledger-occur-mode
+      (let* ((buffer-matches (ledger-occur-find-matches regex))
+	     (ovl-bounds (ledger-occur-create-xact-overlay-bounds buffer-matches)))
+	(setq ledger-occur-overlay-list
+	      (append (ledger-occur-create-xact-overlays ovl-bounds)
+		      (ledger-occur-create-narrowed-overlays buffer-matches)))
+	(setq ledger-occur-last-match regex)
+	(if (get-buffer-window buffer)
+	    (select-window (get-buffer-window buffer)))))
+  (recenter))
+
+(defun ledger-occur (regex)
+  "Perform a simple grep in current buffer for the regular expression REGEX.
+
+   This command hides all xact from the current buffer except
+   those containing the regular expression REGEX.  A second call
+   of the function unhides lines again"
+  (interactive
+   (if ledger-occur-mode
+       (list nil)
+       (list (read-string (concat "Regexp<" (ledger-occur-prompt) ">: ") 
+			  nil 'ledger-occur-history (ledger-occur-prompt)))))
+  (ledger-occur-mode regex (current-buffer)))
+
+(defun ledger-occur-prompt ()
+  "Return the default value of the prompt.
+
+   Default value for prompt is a current word or active
+   region(selection), if its size is 1 line"
+  (let ((prompt
+         (if (and transient-mark-mode
+                  mark-active)
+             (let ((pos1 (region-beginning))
+                   (pos2 (region-end)))
+               ;; Check if the start and the of an active region is on
+               ;; the same line
+               (if (= (line-number-at-pos pos1)
+                      (line-number-at-pos pos2))
+                   (buffer-substring-no-properties pos1 pos2)))
+	     (current-word))))
+    prompt))
+
+(defun ledger-occur-create-narrowed-overlays(buffer-matches)
+  (if buffer-matches
+      (let ((overlays
+             (let ((prev-end (point-min)))
+               (mapcar (lambda (match)
+                         (prog1
+			     (make-overlay prev-end (car match)
+					   (current-buffer) t nil)
+                           (setq prev-end (1+ (cadr match)))))
+                       buffer-matches))))
+        (mapcar (lambda (ovl)
+                  (overlay-put ovl ledger-occur-overlay-property-name t)
+                  (overlay-put ovl 'invisible t)
+                  (overlay-put ovl 'intangible t))
+                (push  (make-overlay (cadr (car(last buffer-matches)))
+                                     (point-max)
+                                     (current-buffer) t nil) overlays)))))
+
+
+(defun ledger-occur-create-xact-overlays (ovl-bounds)
+  "Create the overlay for the visible transactions.
+Argument OVL-BOUNDS contains bounds for the transactions to be left visible."
+  (let ((overlays
+         (mapcar (lambda (bnd)
+                   (make-overlay (car bnd)
+				 (cadr bnd)
+				 (current-buffer) t nil))
+                 ovl-bounds)))
+    (mapcar (lambda (ovl)
+	      (overlay-put ovl ledger-occur-overlay-property-name t)
+	      (if ledger-occur-use-face-shown
+		  (overlay-put ovl 'face 'ledger-occur-xact-face )))
+            overlays)))
+
+(defun ledger-occur-quit-buffer (buffer)
+  "Quits hidings transaction in the given BUFFER.
+Used for coordinating `ledger-occur' with other buffers, like reconcile."
+  (set-buffer buffer)
+  (setq ledger-occur-mode nil)
+  (force-mode-line-update)
+  (ledger-occur-remove-overlays)
+  (recenter))
+
+(defun ledger-occur-remove-overlays ()
+  "Remove the transaction hiding overlays."
+  (interactive)
+  (remove-overlays (point-min)
+		   (point-max) ledger-occur-overlay-property-name t)
+  (setq ledger-occur-overlay-list nil))
+
+
+(defun ledger-occur-create-xact-overlay-bounds (buffer-matches)
+  "Use BUFFER-MATCHES to produce the overlay for the visible transactions."
+  (let ((prev-end (point-min))
+        (overlays (list)))
+    (when buffer-matches
+      (mapc (lambda (line)
+	      (push (list (car line) (cadr line)) overlays)
+	      (setq prev-end (cadr line)))
+	    buffer-matches)
+      (setq overlays (nreverse overlays)))))
+
+
+(defun ledger-occur-find-matches (regex)
+  "Return a list of 2-number tuples describing the beginning and start of transactions meeting REGEX."
+  (save-excursion
+    (goto-char (point-min))
+    ;; Set initial values for variables
+    (let (curpoint 
+	  endpoint
+	  (lines (list)))
+      ;; Search loop
+      (while (not (eobp))
+        (setq curpoint (point))
+        ;; if something found
+        (when (setq endpoint (re-search-forward regex nil 'end))
+          (save-excursion
+	    (let ((bounds (ledger-find-xact-extents (match-beginning 0))))
+	      (push bounds lines)
+	      (setq curpoint (cadr bounds)))) ;; move to the end of
+	                                      ;; the xact, no need to
+	                                      ;; search inside it more
+          (goto-char curpoint))
+        (forward-line 1))
+      (setq lines (nreverse lines)))))
+
+
+(provide 'ldg-occur)
+
+;;; ldg-occur.el ends here
diff --git a/lisp/ldg-post.el b/lisp/ldg-post.el
index 05b9d352..37722fbc 100644
--- a/lisp/ldg-post.el
+++ b/lisp/ldg-post.el
@@ -1,30 +1,61 @@
+;;; ldg-post.el --- Helper code for use with the "ledger" command-line tool
+
+;; Copyright (C) 2003-2013 John Wiegley (johnw AT gnu DOT org)
+
+;; This file is not part of GNU Emacs.
+
+;; This is free software; you can redistribute it and/or modify it under
+;; the terms of the GNU General Public License as published by the Free
+;; Software Foundation; either version 2, or (at your option) any later
+;; version.
+;;
+;; This is distributed in the hope that it will be useful, but WITHOUT
+;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+;; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+;; for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+;; MA 02111-1307, USA.
+
+
+;;; Commentary:
+;; Utility functions for dealing with postings.
+
 (require 'ldg-regex)
 
+;;; Code:
+
 (defgroup ledger-post nil
-  ""
+  "Options for controlling how Ledger-mode deals with postings and completion"
   :group 'ledger)
 
-(defcustom ledger-post-auto-adjust-amounts nil
-  "If non-nil, ."
+(defcustom ledger-post-auto-adjust-postings t
+  "If non-nil, adjust account and amount to columns set below"
   :type 'boolean
   :group 'ledger-post)
 
-(defcustom ledger-post-amount-alignment-column 52
-  "If non-nil, ."
-  :type 'integer
+(defcustom ledger-post-account-alignment-column 4
+  "The column Ledger-mode attempts to align accounts to."
+  :type 'integer 
   :group 'ledger-post)
 
-(defcustom ledger-post-use-iswitchb nil
-  "If non-nil, ."
-  :type 'boolean
+(defcustom ledger-post-amount-alignment-column 52
+  "The column Ledger-mode attempts to align amounts to."
+  :type 'integer
   :group 'ledger-post)
 
-(defcustom ledger-post-use-ido nil
-  "If non-nil, ."
-  :type 'boolean
-  :group 'ledger-post)
+(defcustom ledger-post-use-completion-engine :built-in
+  "Which completion engine to use, :iswitchb or :ido chose those engines,
+:built-in uses built-in Ledger-mode completion"
+   :type '(radio (const :tag "built in completion" :built-in) 
+	   (const :tag "ido completion" :ido) 
+	   (const :tag "iswitchb completion" :iswitchb) )
+   :group 'ledger-post)
 
 (defun ledger-post-all-accounts ()
+  "Return a list of all accounts in the buffer."
   (let ((origin (point))
         (ledger-post-list nil)
         account elements)
@@ -38,27 +69,28 @@
 
 (declare-function iswitchb-read-buffer "iswitchb"
                   (prompt &optional default require-match start matches-set))
+
 (defvar iswitchb-temp-buflist)
 
 (defun ledger-post-completing-read (prompt choices)
-  "Use iswitchb as a completing-read replacement to choose from 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."
-  (cond
-   (ledger-post-use-iswitchb
-    (let* ((iswitchb-use-virtual-buffers nil)
-           (iswitchb-make-buflist-hook
-            (lambda ()
-              (setq iswitchb-temp-buflist choices))))
-      (iswitchb-read-buffer prompt)))
-   (ledger-post-use-ido
-    (ido-completing-read prompt choices))
-   (t
-    (completing-read prompt choices))))
+  (cond ((eq ledger-post-use-completion-engine :iswitchb)
+	 (let* ((iswitchb-use-virtual-buffers nil)
+		(iswitchb-make-buflist-hook
+		 (lambda ()
+		   (setq iswitchb-temp-buflist choices))))
+	   (iswitchb-read-buffer prompt)))
+	((eq ledger-post-use-completion-engine :ido)
+	 (ido-completing-read prompt choices))
+	(t
+	 (completing-read prompt choices))))
 
 (defvar ledger-post-current-list nil)
 
 (defun ledger-post-pick-account ()
+  "Insert an account entered by the user."
   (interactive)
   (let* ((account
           (ledger-post-completing-read
@@ -75,78 +107,129 @@ to choose from."
                        (match-end ledger-regex-post-line-group-account))
         (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)))))))
+	  ((> 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-next-amount (&optional end)
-  (when (re-search-forward "\\(  \\|\t\\| \t\\)[ \t]*-?\\([A-Z$]+ *\\)?\\(-?[0-9,]+?\\)\\(.[0-9]+\\)?\\( *[A-Z$]+\\)?\\([ \t]*@@?[^\n;]+?\\)?\\([ \t]+;.+?\\)?$" (marker-position end) t)
+
+
+(defsubst ledger-next-amount (&optional end)
+  "Move point to the next amount, as long as it is not past END.
+Return the width of the amount field as an integer and leave
+point at beginning of the commodity."
+  ;;(beginning-of-line)
+  (when (re-search-forward ledger-amount-regex end t)
     (goto-char (match-beginning 0))
     (skip-syntax-forward " ")
     (- (or (match-end 4)
            (match-end 3)) (point))))
 
-(defun ledger-align-amounts (&optional column)
-  "Align amounts in the current region.
-This is done so that the last digit falls in COLUMN, which defaults to 52."
-  (interactive "p")
-  (if (or (null column) (= column 1))
-      (setq column ledger-post-amount-alignment-column))
-  (save-excursion
-    (let* ((mark-first (< (mark) (point)))
-           (begin (if mark-first (mark) (point)))
-           (end (if mark-first (point-marker) (mark-marker)))
-           offset)
-      (goto-char begin)
-      (while (setq offset (ledger-next-amount end))
-        (let ((col (current-column))
-              (target-col (- column offset))
-              adjust)
-          (setq adjust (- target-col col))
-          (if (< col target-col)
-              (insert (make-string (- target-col col) ? ))
-            (move-to-column target-col)
-            (if (looking-back "  ")
-                (delete-char (- col target-col))
-              (skip-chars-forward "^ \t")
-              (delete-horizontal-space)
-              (insert "  ")))
-          (forward-line))))))
-
-(defun ledger-post-align-amount ()
+
+(defun ledger-next-account (&optional end)
+  "Move point to the beginning of the next account, or status marker (!*), as long as it is not past END.
+Return the column of the beginning of the account and leave point
+at beginning of account"
+    (if (> end (point))
+	(when (re-search-forward ledger-account-any-status-regex (1+ end) t)  
+	  ;; the 1+ is to make sure we can catch the newline
+	  (if (match-beginning 1)
+	      (goto-char (match-beginning 1))
+	      (goto-char (match-beginning 2)))
+	  (current-column))))
+
+(defun ledger-post-align-postings (&optional beg end)
+  "Align all accounts and amounts within region, if there is no
+region align the posting on the current line."
   (interactive)
+  (assert (eq major-mode 'ledger-mode))
+
   (save-excursion
-    (set-mark (line-beginning-position))
-    (goto-char (1+ (line-end-position)))
-    (ledger-align-amounts)))
+    (if (or (not (mark))
+	    (not (use-region-p)))
+	(set-mark (point)))
+    
+    (let* ((inhibit-modification-hooks t)
+	   (mark-first (< (mark) (point)))
+	   (begin-region (if beg
+			     beg
+			     (if mark-first (mark) (point))))
+	   (end-region (if end
+			   end
+			   (if mark-first (point) (mark))))
+	   acct-start-column acct-end-column acct-adjust amt-width  
+	   (lines-left 1))
+      ;; Condition point and mark to the beginning and end of lines
+      (goto-char end-region)
+      (setq end-region (line-end-position))
+      (goto-char begin-region)
+      (goto-char 
+       (setq begin-region
+	     (line-beginning-position)))
+      
+      ;; This is the guts of the alignment loop
+      (while (and (or (setq acct-start-column (ledger-next-account (line-end-position)))
+		      lines-left)
+		  (< (point) end-region))
+	(when acct-start-column 
+	  (setq acct-end-column (save-excursion 
+				  (goto-char (match-end 2))
+				  (current-column)))
+	  (when (/= (setq acct-adjust (- ledger-post-account-alignment-column acct-start-column)) 0)
+	    (setq acct-end-column (+ acct-end-column acct-adjust))  ;;adjust the account ending column
+	    (if (> acct-adjust 0)
+		(insert (make-string acct-adjust ? ))
+		(delete-char acct-adjust)))
+	  (when (setq amt-width (ledger-next-amount (line-end-position)))
+	    (if (/= 0 (setq amt-adjust (- (if (> (- ledger-post-amount-alignment-column amt-width) 
+						  (+ 2 acct-end-column))
+					      ledger-post-amount-alignment-column ;;we have room
+					      (+ acct-end-column 2 amt-width)) 
+					  amt-width 
+					  (current-column))))
+		(if (> amt-adjust 0)
+		    (insert (make-string amt-adjust ? ))
+		    (delete-char amt-adjust)))))  
+  	(forward-line)
+	(setq lines-left (not (eobp))))
+      (setq inhibit-modification-hooks nil))))
 
 (defun ledger-post-maybe-align (beg end len)
-  (save-excursion
-    (goto-char beg)
-    (when (< end (line-end-position))
-      (goto-char (line-beginning-position))
-      (if (looking-at ledger-post-line-regexp)
-          (ledger-post-align-amount)))))
+  "Align amounts only if point is in a posting.
+BEG, END, and LEN control how far it can align."
+  (if ledger-post-auto-adjust-postings
+      (save-excursion
+	(goto-char beg)
+	(when (<= end (line-end-position))
+	  (goto-char (line-beginning-position))
+	  (if (looking-at ledger-post-line-regexp)
+	      (ledger-post-align-postings))))))
 
 (defun ledger-post-edit-amount ()
+  "Call 'calc-mode' and push the amount in the posting to the top of stack."
   (interactive)
   (goto-char (line-beginning-position))
   (when (re-search-forward ledger-post-line-regexp (line-end-position) t)
-    (goto-char (match-end ledger-regex-post-line-group-account))
-    (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)))))
+    (goto-char (match-end ledger-regex-post-line-group-account)) ;; go to the and of the account
+    (let ((end-of-amount (re-search-forward "[-.,0-9]+" (line-end-position) t)))
+      ;; determine if there is an amount to edit
+      (if end-of-amount
+	  (let ((val (ledger-commodity-string-number-decimalize (match-string 0) :from-user)))
+	    (goto-char (match-beginning 0))
+	    (delete-region (match-beginning 0) (match-end 0))
+	    (calc)
+	    (calc-eval val 'push)) ;; edit the amount
+	  (progn ;;make sure there are two spaces after the account name and go to calc
+	    (if (search-backward "  " (- (point) 3) t)
+		(goto-char (line-end-position))
+		(insert "  "))
+	    (calc))))))
 
 (defun ledger-post-prev-xact ()
+  "Move point to the previous transaction."
   (interactive)
   (backward-paragraph)
   (when (re-search-backward ledger-xact-line-regexp nil t)
@@ -155,6 +238,7 @@ This is done so that the last digit falls in COLUMN, which defaults to 52."
     (goto-char (match-end ledger-regex-post-line-group-account))))
 
 (defun ledger-post-next-xact ()
+  "Move point to the next transaction."
   (interactive)
   (when (re-search-forward ledger-xact-line-regexp nil t)
     (goto-char (match-beginning 0))
@@ -162,13 +246,14 @@ This is done so that the last digit falls in COLUMN, which defaults to 52."
     (goto-char (match-end ledger-regex-post-line-group-account))))
 
 (defun ledger-post-setup ()
-  (let ((map (current-local-map)))
-    (define-key map [(meta ?p)] 'ledger-post-prev-xact)
-    (define-key map [(meta ?n)] 'ledger-post-next-xact)
-    (define-key map [(control ?c) (control ?c)] 'ledger-post-pick-account)
-    (define-key map [(control ?c) (control ?e)] 'ledger-post-edit-amount))
-  (if ledger-post-auto-adjust-amounts
-      (add-hook 'after-change-functions 'ledger-post-maybe-align t t))
-  (add-hook 'after-save-hook #'(lambda () (setq ledger-post-current-list nil))))
+  "Configure `ledger-mode' to auto-align postings."
+  (add-hook 'after-change-functions 'ledger-post-maybe-align t t)
+  (add-hook 'after-save-hook #'(lambda () (setq ledger-post-current-list nil)) t t))
+
+
 
 (provide 'ldg-post)
+
+
+
+;;; ldg-post.el ends here
diff --git a/lisp/ldg-reconcile.el b/lisp/ldg-reconcile.el
index baeadc33..ca4d0004 100644
--- a/lisp/ldg-reconcile.el
+++ b/lisp/ldg-reconcile.el
@@ -1,141 +1,462 @@
+;;; ldg-reconcile.el --- Helper code for use with the "ledger" command-line tool
+
+;; Copyright (C) 2003-2013 John Wiegley (johnw AT gnu DOT org)
+
+;; This file is not part of GNU Emacs.
+
+;; This is free software; you can redistribute it and/or modify it under
+;; the terms of the GNU General Public License as published by the Free
+;; Software Foundation; either version 2, or (at your option) any later
+;; version.
+;;
+;; This is distributed in the hope that it will be useful, but WITHOUT
+;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+;; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+;; for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+;; MA 02111-1307, USA.
+
 ;; Reconcile mode
 
+
+;;; Commentary:
+;; Code to handle reconciling Ledger files wiht outside sources
+
+;;; Code:
+
 (defvar ledger-buf nil)
+(defvar ledger-bufs nil)
 (defvar ledger-acct nil)
+(defvar ledger-target nil)
+
+(defgroup ledger-reconcile nil
+   "Options for Ledger-mode reconciliation"
+  :group 'ledger)
+
+(defcustom ledger-recon-buffer-name "*Reconcile*"
+  "Name to use for reconciliation window."
+  :group 'ledger-reconcile)
+
+(defcustom ledger-narrow-on-reconcile t
+  "If t, limit transactions shown in main buffer to those matching the reconcile regex."
+  :type 'boolean
+  :group 'ledger-reconcile)
+
+(defcustom ledger-buffer-tracks-reconcile-buffer t
+  "If t, then when the cursor is moved to a new xact in the recon window.
+Then that transaction will be shown in its source buffer."
+  :type 'boolean
+  :group 'ledger-reconcile)
+
+(defcustom ledger-reconcile-force-window-bottom nil
+  "If t make the reconcile window appear along the bottom of the register window and resize."
+  :type 'boolean
+  :group 'ledger-reconcile)
+
+(defcustom ledger-reconcile-toggle-to-pending t
+  "If true then toggle between uncleared and pending.
+reconcile-finish will mark all pending posting cleared."
+   :type 'boolean
+   :group 'ledger-reconcile)
+
+(defcustom ledger-reconcile-default-date-format "%Y/%m/%d"
+  "Default date format for the reconcile buffer"
+  :type 'string
+  :group 'ledger-reconcile)
+
+(defcustom ledger-reconcile-target-prompt-string "Target amount for reconciliation "
+  "Default prompt for recon target prompt"
+  :type 'string
+  :group 'ledger-reconcile)
+
+
+(defun ledger-reconcile-get-cleared-or-pending-balance (buffer account)
+  "Calculate the cleared or pending balance of the account."
+
+  ;; these vars are buffer local, need to hold them for use in the
+  ;; temp buffer below
+
+  (with-temp-buffer
+    ;; note that in the line below, the --format option is
+    ;; separated from the actual format string.  emacs does not
+    ;; split arguments like the shell does, so you need to
+    ;; specify the individual fields in the command line.
+    (if (ledger-exec-ledger buffer (current-buffer)
+			    "balance" "--limit" "cleared or pending" "--empty" "--collapse"
+			    "--format" "%(display_total)" account)
+	(ledger-split-commodity-string
+	 (buffer-substring-no-properties (point-min) (point-max))))))
 
 (defun ledger-display-balance ()
-  (let ((buffer ledger-buf)
-        (account ledger-acct))
-    (with-temp-buffer
-      (let ((exit-code (ledger-run-ledger buffer "-C" "balance" account)))
-        (if (/= 0 exit-code)
-            (message "Error determining cleared balance")
-          (goto-char (1- (point-max)))
-          (goto-char (line-beginning-position))
-          (delete-horizontal-space)
-          (message "Cleared balance = %s"
-                   (buffer-substring-no-properties (point)
-                                                   (line-end-position))))))))
+  "Display the cleared-or-pending balance.
+And calculate the target-delta of the account being reconciled."
+  (interactive)
+  (let* ((pending (ledger-reconcile-get-cleared-or-pending-balance ledger-buf ledger-acct)))
+    (when pending
+	(if ledger-target
+	    (message "Pending balance: %s,   Difference from target: %s"
+		     (ledger-commodity-to-string pending)
+		     (ledger-commodity-to-string (-commodity ledger-target pending)))
+	    (message "Pending balance: %s"
+		     (ledger-commodity-to-string pending))))))
+
+(defun is-stdin (file)
+  "True if ledger FILE is standard input."
+  (or
+   (equal file "")
+   (equal file "<stdin>")
+   (equal file "/dev/stdin")))
+
+(defun ledger-reconcile-get-buffer (where)
+  "Return a buffer from WHERE the transaction is."
+  (if (bufferp (car where))
+      (car where)
+      (error "Function ledger-reconcile-get-buffer: Buffer not set")))
 
 (defun ledger-reconcile-toggle ()
+  "Toggle the current transaction, and mark the recon window."
   (interactive)
+  (beginning-of-line)
   (let ((where (get-text-property (point) 'where))
-        (account ledger-acct)
         (inhibit-read-only t)
-        cleared)
-    (when (or (equal (car where) "<stdin>") (equal (car where) "/dev/stdin"))
-      (with-current-buffer ledger-buf
-          (goto-char (cdr where))
-        (setq cleared (ledger-toggle-current 'pending)))
-      (if cleared
-          (add-text-properties (line-beginning-position)
-                               (line-end-position)
-                               (list 'face 'bold))
-        (remove-text-properties (line-beginning-position)
-                                (line-end-position)
-                                (list 'face))))
-    (forward-line)))
+        status)
+    (when (ledger-reconcile-get-buffer where)
+      (with-current-buffer (ledger-reconcile-get-buffer where)
+	(ledger-goto-line (cdr where))
+	(forward-char)
+	(setq status (ledger-toggle-current (if ledger-reconcile-toggle-to-pending
+						'pending
+						'cleared))))
+	;; remove the existing face and add the new face
+      (remove-text-properties (line-beginning-position)
+			      (line-end-position)
+			      (list 'face))
+      (cond ((eq status 'pending)
+	     (add-text-properties (line-beginning-position)
+				  (line-end-position)
+				  (list 'face 'ledger-font-reconciler-pending-face )))
+	    ((eq status 'cleared)
+	     (add-text-properties (line-beginning-position)
+				  (line-end-position)
+				  (list 'face 'ledger-font-reconciler-cleared-face )))
+	    (t
+	     (add-text-properties (line-beginning-position)
+				  (line-end-position)
+				  (list 'face 'ledger-font-reconciler-uncleared-face )))))
+    (forward-line)
+    (beginning-of-line)
+    (ledger-display-balance)))
 
 (defun ledger-reconcile-refresh ()
+  "Force the reconciliation window to refresh.
+Return the number of uncleared xacts found."
   (interactive)
-  (let ((inhibit-read-only t)
-        (line (count-lines (point-min) (point))))
+  (let ((inhibit-read-only t))
     (erase-buffer)
-    (ledger-do-reconcile)
-    (set-buffer-modified-p t)
-    (goto-char (point-min))
-    (forward-line line)))
+    (prog1
+	(ledger-do-reconcile)
+      (set-buffer-modified-p t))))
 
 (defun ledger-reconcile-refresh-after-save ()
-  (let ((buf (get-buffer "*Reconcile*")))
-    (if buf
-        (with-current-buffer buf
-          (ledger-reconcile-refresh)
-          (set-buffer-modified-p nil)))))
+  "Refresh the recon-window after the ledger buffer is saved."
+  (let ((curbuf (current-buffer))
+	(curpoint (point))
+	(recon-buf (get-buffer ledger-recon-buffer-name)))
+    (when (buffer-live-p recon-buf)
+      (with-current-buffer recon-buf
+	(ledger-reconcile-refresh)
+	(set-buffer-modified-p nil))
+      (select-window  (get-buffer-window curbuf))
+      (goto-char curpoint))))
 
 (defun ledger-reconcile-add ()
+  "Use ledger xact to add a new transaction."
   (interactive)
   (with-current-buffer ledger-buf
-    (call-interactively #'ledger-add-entry))
+    (call-interactively #'ledger-add-transaction))
   (ledger-reconcile-refresh))
 
 (defun ledger-reconcile-delete ()
+  "Delete the transactions pointed to in the recon window."
   (interactive)
   (let ((where (get-text-property (point) 'where)))
-    (when (or (equal (car where) "<stdin>") (equal (car where) "/dev/stdin"))
-      (with-current-buffer ledger-buf
-        (goto-char (cdr where))
-        (ledger-delete-current-entry))
+    (when (ledger-reconcile-get-buffer where)
+      (with-current-buffer (ledger-reconcile-get-buffer where)
+        (ledger-goto-line (cdr where))
+        (ledger-delete-current-transaction))
       (let ((inhibit-read-only t))
         (goto-char (line-beginning-position))
         (delete-region (point) (1+ (line-end-position)))
         (set-buffer-modified-p t)))))
 
-(defun ledger-reconcile-visit ()
+(defun ledger-reconcile-visit (&optional come-back)
+  "Recenter ledger buffer on transaction and COME-BACK if non-nil."
   (interactive)
-  (let ((where (get-text-property (point) 'where)))
-    (when (or (equal (car where) "<stdin>") (equal (car where) "/dev/stdin"))
-      (switch-to-buffer-other-window ledger-buf)
-      (goto-char (cdr where)))))
+  (progn
+    (beginning-of-line)
+    (let* ((where (get-text-property (1+ (point)) 'where))
+	   (target-buffer (if where
+			      (ledger-reconcile-get-buffer where)
+			      nil))
+	   (cur-buf (get-buffer ledger-recon-buffer-name)))
+      (when target-buffer
+	(switch-to-buffer-other-window target-buffer)
+	(ledger-goto-line (cdr where))
+	(forward-char)
+	(recenter)
+	(ledger-highlight-xact-under-point)
+	(forward-char -1)
+	(if come-back
+	    (switch-to-buffer-other-window cur-buf))))))
 
 (defun ledger-reconcile-save ()
+  "Save the ledger buffer."
   (interactive)
-  (with-current-buffer ledger-buf
-    (save-buffer))
-  (set-buffer-modified-p nil)
-  (ledger-display-balance))
-
-(defun ledger-reconcile-quit ()
-  (interactive)
-  (kill-buffer (current-buffer)))
+  (let ((curpoint (point)))
+    (dolist (buf (cons ledger-buf ledger-bufs))
+      (with-current-buffer buf
+	(save-buffer)))
+    (with-current-buffer (get-buffer ledger-recon-buffer-name)
+      (set-buffer-modified-p nil)
+      (ledger-display-balance)
+      (goto-char curpoint)
+      (ledger-reconcile-visit t))))
 
 (defun ledger-reconcile-finish ()
+  "Mark all pending posting or transactions as cleared.
+Depends on ledger-reconcile-clear-whole-transactions, save the buffers
+and exit reconcile mode"
   (interactive)
   (save-excursion
     (goto-char (point-min))
     (while (not (eobp))
       (let ((where (get-text-property (point) 'where))
             (face  (get-text-property (point) 'face)))
-        (if (and (eq face 'bold)
-                 (or (equal (car where) "<stdin>") (equal (car where) "/dev/stdin")))
-            (with-current-buffer ledger-buf
-              (goto-char (cdr where))
+        (if (eq face 'ledger-font-reconciler-pending-face)
+            (with-current-buffer (ledger-reconcile-get-buffer where)
+              (ledger-goto-line (cdr where))
               (ledger-toggle-current 'cleared))))
       (forward-line 1)))
   (ledger-reconcile-save))
 
+
+(defun ledger-reconcile-quit ()
+  "Quit the reconcile window without saving ledger buffer."
+  (interactive)
+  (let ((recon-buf (get-buffer ledger-recon-buffer-name))
+	buf)
+    (if recon-buf
+	(with-current-buffer recon-buf
+	  (ledger-reconcile-quit-cleanup)
+	  (setq buf ledger-buf)
+	  ;; Make sure you delete the window before you delete the buffer,
+	  ;; otherwise, madness ensues
+	  (delete-window (get-buffer-window recon-buf))
+	  (kill-buffer recon-buf)
+	  (set-window-buffer (selected-window) buf)))))
+
+(defun ledger-reconcile-quit-cleanup ()
+  "Cleanup all hooks established by reconcile mode."
+  (interactive)
+  (let ((buf ledger-buf))
+    (if (buffer-live-p buf)
+	(with-current-buffer buf
+	  (remove-hook 'after-save-hook 'ledger-reconcile-refresh-after-save t)
+	  (when ledger-narrow-on-reconcile
+	    (ledger-occur-quit-buffer buf)
+	    (ledger-highlight-xact-under-point))))))
+
+(defun ledger-marker-where-xact-is (emacs-xact posting)
+  "Find the position of the EMACS-XACT in the `ledger-buf'.
+POSTING is used in `ledger-clear-whole-transactions' is nil."
+  (let ((buf (if (is-stdin (nth 0 emacs-xact))
+		 ledger-buf
+		 (find-file-noselect (nth 0 emacs-xact)))))
+    (cons
+     buf
+     (if ledger-clear-whole-transactions
+	 (nth 1 emacs-xact)  ;; return line-no of xact
+	 (nth 0 posting))))) ;; return line-no of posting
+
 (defun ledger-do-reconcile ()
-  )
-
-(defun ledger-reconcile (account)
-  (interactive "sAccount to reconcile: ")
-  (let ((buf (current-buffer))
-        (rbuf (get-buffer "*Reconcile*")))
-    (if rbuf
-        (kill-buffer rbuf))
-    (add-hook 'after-save-hook 'ledger-reconcile-refresh-after-save)
-    (with-current-buffer
-        (pop-to-buffer (get-buffer-create "*Reconcile*"))
-      (ledger-reconcile-mode)
-      (set (make-local-variable 'ledger-buf) buf)
-      (set (make-local-variable 'ledger-acct) account)
-      (ledger-do-reconcile))))
+  "Return the number of uncleared transactions in the account and display them in the *Reconcile* buffer."
+  (let* ((buf ledger-buf)
+         (account ledger-acct)
+	 (ledger-success nil)
+         (xacts
+          (with-temp-buffer
+	    (when (ledger-exec-ledger buf (current-buffer)
+				    "--uncleared" "--real" "emacs" account)
+	      (setq ledger-success t)
+	      (goto-char (point-min))
+	      (unless (eobp)
+		(if (looking-at "(")
+		    (read (current-buffer)))))))) ;current-buffer is the *temp* created above
+    (if (and ledger-success (> (length xacts) 0))
+	(let ((date-format (cdr (assoc "date-format" ledger-environment-alist))))
+	  (dolist (xact xacts)
+	      (dolist (posting (nthcdr 5 xact))
+		(let ((beg (point))
+		      (where (ledger-marker-where-xact-is xact posting)))
+		  (insert (format "%s %-4s %-30s %-30s %15s\n"
+				  (format-time-string (if date-format
+							  date-format
+							  ledger-reconcile-default-date-format) (nth 2 xact))
+				  (if (nth 3 xact)
+				      (nth 3 xact)
+				      "")
+				  (nth 4 xact) (nth 1 posting) (nth 2 posting)))
+		  (if (nth 3 posting)
+		      (if (eq (nth 3 posting) 'pending)
+			  (set-text-properties beg (1- (point))
+					       (list 'face 'ledger-font-reconciler-pending-face
+						     'where where))
+			  (set-text-properties beg (1- (point))
+					       (list 'face 'ledger-font-reconciler-cleared-face
+						     'where where)))
+		      (set-text-properties beg (1- (point))
+					   (list 'face 'ledger-font-reconciler-uncleared-face
+						 'where where))))  ))
+	  (goto-char (point-max))
+	  (delete-char -1)) ;gets rid of the extra line feed at the bottom of the list
+	(if ledger-success
+	    (insert (concat "There are no uncleared entries for " account))
+	    (insert "Ledger has reported a problem.  Check *Ledger Error* buffer.")))
+    (goto-char (point-min))
+    (set-buffer-modified-p nil)
+    (toggle-read-only t)
+
+    (ledger-reconcile-ensure-xacts-visible)
+    (length xacts)))
+
+(defun ledger-reconcile-ensure-xacts-visible ()
+  "Ensures that the last of the visible transactions in the
+ledger buffer is at the bottom of the main window.  The key to
+this is to ensure the window is selected when the buffer point is
+moved and recentered.  If they aren't strange things happen."
+
+    (let ((recon-window (get-buffer-window (get-buffer ledger-recon-buffer-name))))
+      (when recon-window
+	(fit-window-to-buffer recon-window)
+	(with-current-buffer buf
+	  (add-hook 'kill-buffer-hook 'ledger-reconcile-quit nil t)
+	  (if (get-buffer-window buf)
+	      (select-window (get-buffer-window buf)))
+	  (goto-char (point-max))
+	  (recenter -1))
+        (select-window recon-window)
+        (ledger-reconcile-visit t))
+      (add-hook 'post-command-hook 'ledger-reconcile-track-xact nil t)))
+
+(defun ledger-reconcile-track-xact ()
+  "Force the ledger buffer to recenter on the transaction at point in the reconcile buffer."
+  (if (and ledger-buffer-tracks-reconcile-buffer
+	   (member this-command (list 'next-line
+				      'previous-line
+				      'mouse-set-point
+				      'ledger-reconcile-toggle
+				      'end-of-buffer
+				      'beginning-of-buffer)))
+      (save-excursion
+	(ledger-reconcile-visit t))))
+
+(defun ledger-reconcile-open-windows (buf rbuf)
+  "Ensure that the ledger buffer BUF is split by RBUF."
+  (if ledger-reconcile-force-window-bottom
+      ;;create the *Reconcile* window directly below the ledger buffer.
+      (set-window-buffer (split-window (get-buffer-window buf) nil nil) rbuf)
+      (pop-to-buffer rbuf)))
+
+(defun ledger-reconcile ()
+  "Start reconciling, prompt for account."
+  (interactive)
+  (let ((account (ledger-read-account-with-prompt "Account to reconcile"))
+	(buf (current-buffer))
+        (rbuf (get-buffer ledger-recon-buffer-name)))
+    ;; this means only one *Reconcile* buffer, ever Set up the
+    ;; reconcile buffer
+    (if rbuf ;; *Reconcile* already exists
+	(with-current-buffer rbuf
+	  (set 'ledger-acct account) ;; already buffer local
+	  (when (not (eq buf rbuf))
+	    ;; called from some other ledger-mode buffer
+	    (ledger-reconcile-quit-cleanup)
+	    (set 'ledger-buf buf)) ;; should already be buffer-local
+
+	  (unless (get-buffer-window rbuf)
+	    (ledger-reconcile-open-windows buf rbuf)))
+
+	;; no recon-buffer, starting from scratch.
+	(add-hook 'after-save-hook 'ledger-reconcile-refresh-after-save nil t)
+
+	(with-current-buffer (setq rbuf
+				   (get-buffer-create ledger-recon-buffer-name))
+	  (ledger-reconcile-open-windows buf rbuf)
+	  (ledger-reconcile-mode)
+	  (make-local-variable 'ledger-target)
+	  (set (make-local-variable 'ledger-buf) buf)
+	  (set (make-local-variable 'ledger-acct) account)))
+
+    ;; Narrow the ledger buffer
+    (with-current-buffer rbuf
+      (save-excursion
+	(if ledger-narrow-on-reconcile
+	    (ledger-occur-mode account ledger-buf)))
+      (if (> (ledger-reconcile-refresh) 0)
+	  (ledger-reconcile-change-target))
+      (ledger-display-balance))))
 
 (defvar ledger-reconcile-mode-abbrev-table)
 
+(defun ledger-reconcile-change-target ()
+  "Change the target amount for the reconciliation process."
+  (interactive)
+  (setq ledger-target (ledger-read-commodity-string ledger-reconcile-target-prompt-string)))
+
 (define-derived-mode ledger-reconcile-mode text-mode "Reconcile"
-  "A mode for reconciling ledger entries."
-  (let ((map (make-sparse-keymap)))
-    (define-key map [(control ?m)] 'ledger-reconcile-visit)
-    (define-key map [return] 'ledger-reconcile-visit)
-    (define-key map [(control ?c) (control ?c)] 'ledger-reconcile-finish)
-    (define-key map [(control ?x) (control ?s)] 'ledger-reconcile-save)
-    (define-key map [(control ?l)] 'ledger-reconcile-refresh)
-    (define-key map [? ] 'ledger-reconcile-toggle)
-    (define-key map [?a] 'ledger-reconcile-add)
-    (define-key map [?d] 'ledger-reconcile-delete)
-    (define-key map [?n] 'next-line)
-    (define-key map [?p] 'previous-line)
-    (define-key map [?s] 'ledger-reconcile-save)
-    (define-key map [?q] 'ledger-reconcile-quit)
-    (use-local-map map)))
+   "A mode for reconciling ledger entries."
+   (let ((map (make-sparse-keymap)))
+     (define-key map [(control ?m)] 'ledger-reconcile-visit)
+     (define-key map [return] 'ledger-reconcile-visit)
+     (define-key map [(control ?l)] 'ledger-reconcile-refresh)
+     (define-key map [(control ?c) (control ?c)] 'ledger-reconcile-finish)
+     (define-key map [? ] 'ledger-reconcile-toggle)
+     (define-key map [?a] 'ledger-reconcile-add)
+     (define-key map [?d] 'ledger-reconcile-delete)
+     (define-key map [?g] 'ledger-reconcile);
+     (define-key map [?n] 'next-line)
+     (define-key map [?p] 'previous-line)
+     (define-key map [?t] 'ledger-reconcile-change-target)
+     (define-key map [?s] 'ledger-reconcile-save)
+     (define-key map [?q] 'ledger-reconcile-quit)
+     (define-key map [?b] 'ledger-display-balance)
+
+     (define-key map [menu-bar] (make-sparse-keymap "ldg-recon-menu"))
+     (define-key map [menu-bar ldg-recon-menu] (cons "Reconcile" map))
+     (define-key map [menu-bar ldg-recon-menu qui] '("Quit" . ledger-reconcile-quit))
+     (define-key map [menu-bar ldg-recon-menu sep1] '("--"))
+     (define-key map [menu-bar ldg-recon-menu pre] '("Previous Entry" . previous-line))
+     (define-key map [menu-bar ldg-recon-menu vis] '("Visit Source" . ledger-reconcile-visit))
+     (define-key map [menu-bar ldg-recon-menu nex] '("Next Entry" . next-line))
+     (define-key map [menu-bar ldg-recon-menu sep2] '("--"))
+     (define-key map [menu-bar ldg-recon-menu del] '("Delete Entry" . ledger-reconcile-delete))
+     (define-key map [menu-bar ldg-recon-menu add] '("Add Entry" . ledger-reconcile-add))
+     (define-key map [menu-bar ldg-recon-menu tog] '("Toggle Entry" . ledger-reconcile-toggle))
+     (define-key map [menu-bar ldg-recon-menu sep3] '("--"))
+     (define-key map [menu-bar ldg-recon-menu bal] '("Show Cleared Balance" . ledger-display-balance))
+     (define-key map [menu-bar ldg-recon-menu tgt] '("Change Target Balance" . ledger-reconcile-change-target))
+     (define-key map [menu-bar ldg-recon-menu sep4] '("--"))
+     (define-key map [menu-bar ldg-recon-menu rna] '("Reconcile New Account" . ledger-reconcile))
+     (define-key map [menu-bar ldg-recon-menu sep5] '("--"))
+     (define-key map [menu-bar ldg-recon-menu fin] '("Finish" . ledger-reconcile-finish))
+     (define-key map [menu-bar ldg-recon-menu ref] '("Refresh" . ledger-reconcile-refresh))
+     (define-key map [menu-bar ldg-recon-menu sav] '("Save" . ledger-reconcile-save))
+
+     (use-local-map map)))
+
+(provide 'ldg-reconcile)
+
+;;; ldg-reconcile.el ends here
diff --git a/lisp/ldg-regex.el b/lisp/ldg-regex.el
index 1c6b8f06..226475df 100644
--- a/lisp/ldg-regex.el
+++ b/lisp/ldg-regex.el
@@ -1,15 +1,83 @@
+;;; ldg-regex.el --- Helper code for use with the "ledger" command-line tool
+
+;; Copyright (C) 2003-2013 John Wiegley (johnw AT gnu DOT org)
+
+;; This file is not part of GNU Emacs.
+
+;; This is free software; you can redistribute it and/or modify it under
+;; the terms of the GNU General Public License as published by the Free
+;; Software Foundation; either version 2, or (at your option) any later
+;; version.
+;;
+;; This is distributed in the hope that it will be useful, but WITHOUT
+;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+;; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+;; for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+;; MA 02111-1307, USA.
+
 (require 'rx)
 
 (eval-when-compile
   (require 'cl))
 
+(defconst ledger-amount-regex
+  (concat "\\(  \\|\t\\| \t\\)[ \t]*-?"
+	  "\\([A-Z$€£_]+ *\\)?"
+	  "\\(-?[0-9,]+?\\)"
+	  "\\(.[0-9]+\\)?"
+	  "\\( *[[:word:]€£_\"]+\\)?"
+	  "\\([ \t]*[@={]@?[^\n;]+?\\)?"
+	  "\\([ \t]+;.+?\\|[ \t]*\\)?$"))
+
+(defconst ledger-amount-decimal-comma-regex
+  "-?[1-9][0-9.]*[,]?[0-9]*")
+
+(defconst ledger-amount-decimal-period-regex
+  "-?[1-9][0-9.]*[.]?[0-9]*")
+
+(defconst ledger-other-entries-regex
+  "\\(^[~=A-Za-z].+\\)+")
+
+(defconst ledger-comment-regex
+  "\\(       \\|  \\|^\\)\\(;.*\\)")
+
+(defconst ledger-payee-any-status-regex 
+  "^[0-9/.=-]+\\(\\s-+\\*\\)?\\(\\s-+(.*?)\\)?\\s-+\\(.+?\\)\\(\t\\|\n\\| [ \t]\\)")
+
+(defconst ledger-payee-pending-regex 
+  "^[0-9]+[-/][-/.=0-9]+\\s-\\!\\s-+\\(([^)]+)\\s-+\\)?\\([^*].+?\\)\\(;\\|$\\)")
+
+(defconst ledger-payee-cleared-regex
+  "^[0-9]+[-/][-/.=0-9]+\\s-\\*\\s-+\\(([^)]+)\\s-+\\)?\\([^*].+?\\)\\(;\\|$\\)")
+
+(defconst ledger-payee-uncleared-regex
+  "^[0-9]+[-/][-/.=0-9]+\\s-+\\(([^)]+)\\s-+\\)?\\([^*].+?\\)\\(;\\|$\\)")
+
+(defconst ledger-init-string-regex
+  "^--.+?\\($\\|[ ]\\)")
+
+(defconst ledger-account-any-status-regex
+  "^[ \t]+\\([*!]\\s-+\\)?\\([[(]?.+?\\)\\(\t\\|\n\\| [ \t]\\)")  
+
+(defconst ledger-account-pending-regex
+  "\\(^[ \t]+\\)\\(!.+?\\)\\(  \\|$\\)")  
+
+(defconst ledger-account-cleared-regex
+  "\\(^[ \t]+\\)\\(\\*.+?\\)\\(  \\|$\\)")  
+
+
+
 (defmacro ledger-define-regexp (name regex docs &rest args)
   "Simplify the creation of a Ledger regex and helper functions."
   (let ((defs
-          (list
-           `(defconst
-              ,(intern (concat "ledger-" (symbol-name name) "-regexp"))
-              ,(eval regex))))
+	 (list
+	  `(defconst
+	       ,(intern (concat "ledger-" (symbol-name name) "-regexp"))
+	     ,(eval regex))))
         (addend 0) last-group)
     (if (null args)
         (progn
@@ -17,104 +85,104 @@
            defs
            (list
             `(defconst
-               ,(intern
-                 (concat "ledger-regex-" (symbol-name name) "-group"))
+		 ,(intern
+		   (concat "ledger-regex-" (symbol-name name) "-group"))
                1)))
           (nconc
            defs
            (list
             `(defconst
-               ,(intern (concat "ledger-regex-" (symbol-name name)
-                                "-group--count"))
+		 ,(intern (concat "ledger-regex-" (symbol-name name)
+				  "-group--count"))
                1)))
           (nconc
            defs
            (list
             `(defmacro
-               ,(intern (concat "ledger-regex-" (symbol-name name)))
-               (&optional string)
+		 ,(intern (concat "ledger-regex-" (symbol-name name)))
+		 (&optional string)
                ,(format "Return the match string for the %s" name)
                (match-string
                 ,(intern (concat "ledger-regex-" (symbol-name name)
                                  "-group"))
                 string)))))
-      
-      (dolist (arg args)
-        (let (var grouping target)
-          (if (symbolp arg)
-              (setq var arg target arg)
-            (assert (listp arg))
-            (if (= 2 (length arg))
-                (setq var (car arg)
-                      target (cadr arg))
-              (setq var (car arg)
-                    grouping (cadr arg)
-                    target (caddr arg))))
-
-          (if (and last-group
-                   (not (eq last-group (or grouping target))))
-              (incf addend
-                    (symbol-value
-                     (intern-soft (concat "ledger-regex-"
-                                          (symbol-name last-group)
-                                          "-group--count")))))
-          (nconc
-           defs
-           (list
-            `(defconst
-               ,(intern (concat "ledger-regex-" (symbol-name name)
-                                "-group-" (symbol-name var)))
-               ,(+ addend
-                   (symbol-value
-                    (intern-soft
-                     (if grouping
-                         (concat "ledger-regex-" (symbol-name grouping)
-                                 "-group-" (symbol-name target))
-                       (concat "ledger-regex-" (symbol-name target)
-                               "-group"))))))))
-          (nconc
-           defs
-           (list
-            `(defmacro
-               ,(intern (concat "ledger-regex-" (symbol-name name)
-                                "-" (symbol-name var)))
-               (&optional string)
-               ,(format "Return the sub-group match for the %s %s."
-                        name var)
-               (match-string
-                ,(intern (concat "ledger-regex-" (symbol-name name)
-                                 "-group-" (symbol-name var)))
-                string))))
+	
+	(dolist (arg args)
+	  (let (var grouping target)
+	    (if (symbolp arg)
+		(setq var arg target arg)
+		(assert (listp arg))
+		(if (= 2 (length arg))
+		    (setq var (car arg)
+			  target (cadr arg))
+		    (setq var (car arg)
+			  grouping (cadr arg)
+			  target (caddr arg))))
+
+	    (if (and last-group
+		     (not (eq last-group (or grouping target))))
+		(incf addend
+		      (symbol-value
+		       (intern-soft (concat "ledger-regex-"
+					    (symbol-name last-group)
+					    "-group--count")))))
+	    (nconc
+	     defs
+	     (list
+	      `(defconst
+		   ,(intern (concat "ledger-regex-" (symbol-name name)
+				    "-group-" (symbol-name var)))
+		 ,(+ addend
+		     (symbol-value
+		      (intern-soft
+		       (if grouping
+			   (concat "ledger-regex-" (symbol-name grouping)
+				   "-group-" (symbol-name target))
+			   (concat "ledger-regex-" (symbol-name target)
+				   "-group"))))))))
+	    (nconc
+	     defs
+	     (list
+	      `(defmacro
+		   ,(intern (concat "ledger-regex-" (symbol-name name)
+				    "-" (symbol-name var)))
+		   (&optional string)
+		 ,(format "Return the sub-group match for the %s %s."
+			  name var)
+		 (match-string
+		  ,(intern (concat "ledger-regex-" (symbol-name name)
+				   "-group-" (symbol-name var)))
+		  string))))
 
-          (setq last-group (or grouping target))))
+	    (setq last-group (or grouping target))))
 
-      (nconc defs
-             (list
-              `(defconst ,(intern (concat "ledger-regex-" (symbol-name name)
-                                          "-group--count"))
-                 ,(length args)))))
+	(nconc defs
+	       (list
+		`(defconst ,(intern (concat "ledger-regex-" (symbol-name name)
+					    "-group--count"))
+		   ,(length args)))))
 
     (cons 'progn defs)))
 
 (put 'ledger-define-regexp 'lisp-indent-function 1)
 
-(ledger-define-regexp date
-  (let ((sep '(or ?- (any ?. ?/))))     ; can't do (any ?- ?. ?/) due to bug
+(ledger-define-regexp iso-date
+  ( let ((sep '(or ?-  ?/)))    
     (rx (group
-         (and (? (= 4 num)
-                 (eval sep))
-              (and num (? num))
+         (and (group (? (= 4 num)))
+	      (eval sep)
+              (group (and num (? num)))
               (eval sep)
-              (and num (? num))))))
+              (group (and num (? num)))))))
   "Match a single date, in its 'written' form.")
 
 (ledger-define-regexp full-date
   (macroexpand
-   `(rx (and (regexp ,ledger-date-regexp)
-             (? (and ?= (regexp ,ledger-date-regexp))))))
+   `(rx (and (regexp ,ledger-iso-date-regexp)
+             (? (and ?= (regexp ,ledger-iso-date-regexp))))))
   "Match a compound date, of the form ACTUAL=EFFECTIVE"
-  (actual date)
-  (effective date))
+  (actual iso-date)
+  (effective iso-date))
 
 (ledger-define-regexp state
   (rx (group (any ?! ?*)))
@@ -211,7 +279,7 @@
   (macroexpand
    `(rx (* (+ blank)
            (or (and ?\{ (regexp ,ledger-commoditized-amount-regexp) ?\})
-               (and ?\[ (regexp ,ledger-date-regexp) ?\])
+               (and ?\[ (regexp ,ledger-iso-date-regexp) ?\])
                (and ?\( (not (any ?\))) ?\))))))
   "")
 
@@ -247,4 +315,12 @@
   (amount full-amount)
   (note end-note))
 
+(defconst ledger-iterate-regex
+  (concat "\\(Y\\s-+\\([0-9]+\\)\\|"  ;; Catches a Y directive
+	  ledger-iso-date-regexp
+	  "\\([ *!]+\\)"  ;; mark
+	  "\\((.*)\\)"  ;; code
+	  "\\(.*\\)"   ;; desc
+	  "\\)"))
+
 (provide 'ldg-regex)
diff --git a/lisp/ldg-register.el b/lisp/ldg-register.el
deleted file mode 100644
index 7b5c0d0a..00000000
--- a/lisp/ldg-register.el
+++ /dev/null
@@ -1,66 +0,0 @@
-(require 'ldg-post)
-(require 'ldg-state)
-
-(defgroup ledger-register nil
-  ""
-  :group 'ledger)
-
-(defcustom ledger-register-date-format "%m/%d/%y"
-  "*The date format used for ledger register reports."
-  :type 'string
-  :group 'ledger-register)
-
-(defcustom ledger-register-line-format "%s %-30.30s %-25.25s %15s\n"
-  "*The date format used for ledger register reports."
-  :type 'string
-  :group 'ledger-register)
-
-(defface ledger-register-pending-face
-  '((((background light)) (:weight bold))
-    (((background dark)) (:weight bold)))
-  "Face used to highlight pending entries in a register report."
-  :group 'ledger-register)
-
-(defun ledger-register-render (data-buffer posts)
-  (dolist (post posts)
-    (let ((index 1))
-      (dolist (xact (nthcdr 5 post))
-        (let ((beg (point))
-              (where
-               (with-current-buffer data-buffer
-                 (cons
-                  (nth 0 post)
-                  (if ledger-clear-whole-entries
-                      (save-excursion
-                        (goto-line (nth 1 post))
-                        (point-marker))
-                    (save-excursion
-                      (goto-line (nth 0 xact))
-                      (point-marker)))))))
-          (insert (format ledger-register-line-format
-                          (format-time-string ledger-register-date-format
-                                              (nth 2 post))
-                          (nth 4 post) (nth 1 xact) (nth 2 xact)))
-          (if (nth 3 xact)
-              (set-text-properties beg (1- (point))
-                                   (list 'face 'ledger-register-pending-face
-                                         'where where))
-            (set-text-properties beg (1- (point))
-                                 (list 'where where))))
-        (setq index (1+ index)))))
-  (goto-char (point-min))
-  )
-
-(defun ledger-register-generate (&optional data-buffer &rest args)
-  (let ((buf (or data-buffer (current-buffer))))
-    (with-current-buffer (get-buffer-create "*ledger-register*")
-      (let ((pos (point))
-            (inhibit-read-only t))
-        (erase-buffer)
-        (ledger-register-render buf (apply #'ledger-exec-read buf args))
-        (goto-char pos))
-      (set-buffer-modified-p nil)
-      (toggle-read-only t)
-      (display-buffer (current-buffer) t))))
-
-(provide 'ldg-register)
diff --git a/lisp/ldg-report.el b/lisp/ldg-report.el
index 5a668847..c3b83f55 100644
--- a/lisp/ldg-report.el
+++ b/lisp/ldg-report.el
@@ -1,7 +1,41 @@
+;;; ldg-report.el --- Helper code for use with the "ledger" command-line tool
+
+;; Copyright (C) 2003-2013 John Wiegley (johnw AT gnu DOT org)
+
+;; This file is not part of GNU Emacs.
+
+;; This is free software; you can redistribute it and/or modify it under
+;; the terms of the GNU General Public License as published by the Free
+;; Software Foundation; either version 2, or (at your option) any later
+;; version.
+;;
+;; This is distributed in the hope that it will be useful, but WITHOUT
+;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+;; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+;; for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+;; MA 02111-1307, USA.
+
+
+;;; Commentary:
+;;  Provide facilities for running and saving reports in emacs
+
+;;; Code:
+
+(eval-when-compile
+  (require 'cl))
+
+(defgroup ledger-report nil
+  "Customization option for the Report buffer"
+  :group 'ledger)
+
 (defcustom ledger-reports
   '(("bal" "ledger -f %(ledger-file) bal")
     ("reg" "ledger -f %(ledger-file) reg")
-    ("payee" "ledger -f %(ledger-file) reg -- %(payee)")
+    ("payee" "ledger -f %(ledger-file) reg @%(payee)")
     ("account" "ledger -f %(ledger-file) reg %(account)"))
   "Definition of reports to run.
 
@@ -10,33 +44,25 @@ contain format specifiers that are replaced with context sensitive
 information.  Format specifiers have the format '%(<name>)' where
 <name> is an identifier for the information to be replaced.  The
 `ledger-report-format-specifiers' alist variable contains a mapping
-from format specifier identifier to a lisp function that implements
+from format specifier identifier to a Lisp function that implements
 the substitution.  See the documentation of the individual functions
 in that variable for more information on the behavior of each
 specifier."
   :type '(repeat (list (string :tag "Report Name")
-                       (string :tag "Command Line")))
-  :group 'ledger)
+		  (string :tag "Command Line")))
+  :group 'ledger-report)
 
 (defcustom ledger-report-format-specifiers
   '(("ledger-file" . ledger-report-ledger-file-format-specifier)
     ("payee" . ledger-report-payee-format-specifier)
-    ("account" . ledger-report-account-format-specifier))
-  "Alist mapping ledger report format specifiers to implementing functions
+    ("account" . ledger-report-account-format-specifier)
+    ("value" . ledger-report-value-format-specifier))
+  "An alist mapping ledger report format specifiers to implementing functions.
 
 The function is called with no parameters and expected to return the
 text that should replace the format specifier."
   :type 'alist
-  :group 'ledger)
-
-;;(define-key map [(control ?c) (control ?o) (control ?r)] 'ledger-report)
-;;(define-key map [(control ?c) (control ?o) (control ?g)] 'ledger-report-goto)
-;;(define-key map [(control ?c) (control ?o) (control ?a)] 'ledger-report-redo)
-;;(define-key map [(control ?c) (control ?o) (control ?s)] 'ledger-report-save)
-;;(define-key map [(control ?c) (control ?o) (control ?e)] 'ledger-report-edit)
-;;(define-key map [(control ?c) (control ?o) (control ?k)] 'ledger-report-kill)
-
-;; Ledger report mode
+  :group 'ledger-report)
 
 (defvar ledger-report-buffer-name "*Ledger Report*")
 
@@ -45,28 +71,64 @@ text that should replace the format specifier."
 (defvar ledger-report-name-prompt-history nil)
 (defvar ledger-report-cmd-prompt-history nil)
 (defvar ledger-original-window-cfg nil)
-
+(defvar ledger-report-saved nil)
+(defvar ledger-minibuffer-history nil)
 (defvar ledger-report-mode-abbrev-table)
 
+(defun ledger-report-reverse-lines ()
+  (interactive)
+  (goto-char (point-min))
+  (forward-paragraph)
+  (forward-line)
+  (save-excursion
+    (setq inhibit-read-only t)
+    (reverse-region (point) (point-max))))
+
 (define-derived-mode ledger-report-mode text-mode "Ledger-Report"
-  "A mode for viewing ledger reports."
-  (let ((map (make-sparse-keymap)))
-    (define-key map [? ] 'scroll-up)
-    (define-key map [backspace] 'scroll-down)
-    (define-key map [?r] 'ledger-report-redo)
-    (define-key map [?s] 'ledger-report-save)
-    (define-key map [?k] 'ledger-report-kill)
-    (define-key map [?e] 'ledger-report-edit)
-    (define-key map [?q] 'ledger-report-quit)
-    (define-key map [(control ?c) (control ?l) (control ?r)]
-      'ledger-report-redo)
-    (define-key map [(control ?c) (control ?l) (control ?S)]
-      'ledger-report-save)
-    (define-key map [(control ?c) (control ?l) (control ?k)]
-      'ledger-report-kill)
-    (define-key map [(control ?c) (control ?l) (control ?e)]
-      'ledger-report-edit)
-    (use-local-map map)))
+   "A mode for viewing ledger reports."
+   (let ((map (make-sparse-keymap)))
+     (define-key map [? ] 'scroll-up)
+     (define-key map [backspace] 'scroll-down)
+     (define-key map [?r] 'ledger-report-redo)
+     (define-key map [(shift ?r)] 'ledger-report-reverse-lines)
+     (define-key map [?s] 'ledger-report-save)
+     (define-key map [?k] 'ledger-report-kill)
+     (define-key map [?e] 'ledger-report-edit)
+     (define-key map [?q] 'ledger-report-quit)
+     (define-key map [(control ?c) (control ?l) (control ?r)]
+       'ledger-report-redo)
+     (define-key map [(control ?c) (control ?l) (control ?S)]
+       'ledger-report-save)
+     (define-key map [(control ?c) (control ?l) (control ?k)]
+       'ledger-report-kill)
+     (define-key map [(control ?c) (control ?l) (control ?e)]
+       'ledger-report-edit)
+     (define-key map [return] 'ledger-report-visit-source)
+
+     
+     (define-key map [menu-bar] (make-sparse-keymap "ldg-rep"))
+     (define-key map [menu-bar ldg-rep] (cons "Reports" map))
+
+     (define-key map [menu-bar ldg-rep lrq] '("Quit" . ledger-report-quit))
+     (define-key map [menu-bar ldg-rep s2] '("--"))
+     (define-key map [menu-bar ldg-rep lrd] '("Scroll Down" . scroll-down))
+     (define-key map [menu-bar ldg-rep vis] '("Visit Source" . ledger-report-visit-source))
+     (define-key map [menu-bar ldg-rep lru] '("Scroll Up" . scroll-up))
+     (define-key map [menu-bar ldg-rep s1] '("--"))
+     (define-key map [menu-bar ldg-rep rev] '("Reverse report order" . ledger-report-reverse-lines))
+     (define-key map [menu-bar ldg-rep s0] '("--"))
+     (define-key map [menu-bar ldg-rep lrk] '("Kill Report" . ledger-report-kill))
+     (define-key map [menu-bar ldg-rep lrr] '("Re-run Report" . ledger-report-redo))
+     (define-key map [menu-bar ldg-rep lre] '("Edit Report" . ledger-report-edit))
+     (define-key map [menu-bar ldg-rep lrs] '("Save Report" . ledger-report-save))
+
+     (use-local-map map)))
+
+(defun ledger-report-value-format-specifier ()
+  "Return a valid meta-data tag name"
+  ;; It is intended completion should be available on existing account
+  ;; names, but it remains to be implemented.
+  (ledger-read-string-with-default "Value: " nil))
 
 (defun ledger-report-read-name ()
   "Read the name of a ledger report to use, with completion.
@@ -79,13 +141,14 @@ The empty string and unknown names are allowed."
 (defun ledger-report (report-name edit)
   "Run a user-specified report from `ledger-reports'.
 
-Prompts the user for the name of the report to run.  If no name is
-entered, the user will be prompted for a command line to run.  The
-command line specified or associated with the selected report name
-is run and the output is made available in another buffer for viewing.
-If a prefix argument is given and the user selects a valid report
-name, the user is prompted with the corresponding command line for
-editing before the command is run.
+Prompts the user for the REPORT-NAME of the report to run or
+EDIT.  If no name is entered, the user will be prompted for a
+command line to run.  The command line specified or associated
+with the selected report name is run and the output is made
+available in another buffer for viewing.  If a prefix argument is
+given and the user selects a valid report name, the user is
+prompted with the corresponding command line for editing before
+the command is run.
 
 The output buffer will be in `ledger-report-mode', which defines
 commands for saving a new named report based on the command line
@@ -106,6 +169,7 @@ used to generate the buffer, navigating the buffer, etc."
     (with-current-buffer
         (pop-to-buffer (get-buffer-create ledger-report-buffer-name))
       (ledger-report-mode)
+      (set (make-local-variable 'ledger-report-saved) nil)
       (set (make-local-variable 'ledger-buf) buf)
       (set (make-local-variable 'ledger-report-name) report-name)
       (set (make-local-variable 'ledger-original-window-cfg) wcfg)
@@ -116,18 +180,19 @@ used to generate the buffer, navigating the buffer, etc."
       (message "q to quit; r to redo; e to edit; k to kill; s to save; SPC and DEL to scroll"))))
 
 (defun string-empty-p (s)
-  "Check for the empty string."
+  "Check S for the empty string."
   (string-equal "" s))
 
 (defun ledger-report-name-exists (name)
-  "Check to see if the given report name exists.
+  "Check to see if the given report NAME exists.
 
-If name exists, returns the object naming the report, otherwise returns nil."
+   If name exists, returns the object naming the report,
+   otherwise returns nil."
   (unless (string-empty-p name)
     (car (assoc name ledger-reports))))
 
 (defun ledger-reports-add (name cmd)
-  "Add a new report to `ledger-reports'."
+  "Add a new report NAME and CMD to `ledger-reports'."
   (setq ledger-reports (cons (list name cmd) ledger-reports)))
 
 (defun ledger-reports-custom-save ()
@@ -135,17 +200,18 @@ If name exists, returns the object naming the report, otherwise returns nil."
   (customize-save-variable 'ledger-reports ledger-reports))
 
 (defun ledger-report-read-command (report-cmd)
-  "Read the command line to create a report."
+  "Read the command line to create a report from REPORT-CMD."
   (read-from-minibuffer "Report command line: "
                         (if (null report-cmd) "ledger " report-cmd)
                         nil nil 'ledger-report-cmd-prompt-history))
 
 (defun ledger-report-ledger-file-format-specifier ()
-  "Substitute the full path to master or current ledger file
+  "Substitute the full path to master or current ledger file.
 
-The master file name is determined by the ledger-master-file buffer-local
-variable which can be set using file variables.  If it is set, it is used,
-otherwise the current buffer file is used."
+   The master file name is determined by the variable `ledger-master-file'
+   buffer-local variable which can be set using file variables.
+   If it is set, it is used, otherwise the current buffer file is
+   used."
   (ledger-master-file))
 
 ;; General helper functions
@@ -155,86 +221,128 @@ otherwise the current buffer file is used."
 (defun ledger-master-file ()
   "Return the master file for a ledger file.
 
-The master file is either the file for the current ledger buffer or the
-file specified by the buffer-local variable ledger-master-file.  Typically
-this variable would be set in a file local variable comment block at the
-end of a ledger file which is included in some other file."
+   The master file is either the file for the current ledger buffer or the
+   file specified by the buffer-local variable `ledger-master-file'.  Typically
+   this variable would be set in a file local variable comment block at the
+   end of a ledger file which is included in some other file."
   (if ledger-master-file
       (expand-file-name ledger-master-file)
-    (buffer-file-name)))
-
-(defun ledger-read-string-with-default (prompt default)
-  (let ((default-prompt (concat prompt
-                                (if default
-                                    (concat " (" default "): ")
-                                  ": "))))
-    (read-string default-prompt nil nil default)))
+      (buffer-file-name)))
 
 (defun ledger-report-payee-format-specifier ()
-  "Substitute a payee name
+  "Substitute a payee name.
 
-The user is prompted to enter a payee and that is substitued.  If
-point is in an entry, the payee for that entry is used as the
-default."
-  ;; It is intended copmletion should be available on existing
+   The user is prompted to enter a payee and that is substitued.  If
+   point is in an xact, the payee for that xact is used as the
+   default."
+  ;; It is intended completion should be available on existing
   ;; payees, but the list of possible completions needs to be
   ;; developed to allow this.
-  (ledger-read-string-with-default "Payee" (regexp-quote (ledger-entry-payee))))
+  (ledger-read-string-with-default "Payee" (regexp-quote (ledger-xact-payee))))
 
 (defun ledger-report-account-format-specifier ()
-  "Substitute an account name
+  "Substitute an account name.
 
-The user is prompted to enter an account name, which can be any
-regular expression identifying an account.  If point is on an account
-transaction line for an entry, the full account name on that line is
-the default."
+   The user is prompted to enter an account name, which can be any
+   regular expression identifying an account.  If point is on an account
+   posting line for an xact, the full account name on that line is
+   the default."
   ;; It is intended completion should be available on existing account
   ;; names, but it remains to be implemented.
-  (let* ((context (ledger-context-at-point))
-         (default
-          (if (eq (ledger-context-line-type context) 'acct-transaction)
-              (regexp-quote (ledger-context-field-value context 'account))
-            nil)))
-    (ledger-read-string-with-default "Account" default)))
+  (ledger-read-account-with-prompt "Account"))
 
 (defun ledger-report-expand-format-specifiers (report-cmd)
-  (let ((expanded-cmd report-cmd))
-    (while (string-match "%(\\([^)]*\\))" expanded-cmd)
-      (let* ((specifier (match-string 1 expanded-cmd))
-             (f (cdr (assoc specifier ledger-report-format-specifiers))))
-        (if f
-            (setq expanded-cmd (replace-match
-                                (save-match-data
-                                  (with-current-buffer ledger-buf
-                                    (shell-quote-argument (funcall f))))
-                                t t expanded-cmd))
-          (progn
-            (set-window-configuration ledger-original-window-cfg)
-            (error "Invalid ledger report format specifier '%s'" specifier)))))
-    expanded-cmd))
+  "Expand %(account) and %(payee) appearing in REPORT-CMD with thing under point."
+  (save-match-data
+    (let ((expanded-cmd report-cmd))
+      (set-match-data (list 0 0))
+      (while (string-match "%(\\([^)]*\\))" expanded-cmd (if (> (length expanded-cmd) (match-end 0))
+							     (match-end 0)
+							     (1- (length expanded-cmd))))
+	(let* ((specifier (match-string 1 expanded-cmd))
+	       (f (cdr (assoc specifier ledger-report-format-specifiers))))
+	  (if f
+	      (setq expanded-cmd (replace-match
+				  (save-match-data
+				    (with-current-buffer ledger-buf
+				      (shell-quote-argument (funcall f))))
+				  t t expanded-cmd)))))
+      expanded-cmd)))
 
 (defun ledger-report-cmd (report-name edit)
-  "Get the command line to run the report."
+  "Get the command line to run the report name REPORT-NAME.
+Optional EDIT the command."
   (let ((report-cmd (car (cdr (assoc report-name ledger-reports)))))
     ;; logic for substitution goes here
     (when (or (null report-cmd) edit)
-      (setq report-cmd (ledger-report-read-command report-cmd)))
+      (setq report-cmd (ledger-report-read-command report-cmd))
+      (setq ledger-report-saved nil)) ;; this is a new report, or edited report
     (setq report-cmd (ledger-report-expand-format-specifiers report-cmd))
     (set (make-local-variable 'ledger-report-cmd) report-cmd)
     (or (string-empty-p report-name)
         (ledger-report-name-exists report-name)
-        (ledger-reports-add report-name report-cmd)
-        (ledger-reports-custom-save))
+        (progn
+	  (ledger-reports-add report-name report-cmd)
+	  (ledger-reports-custom-save)))
     report-cmd))
 
 (defun ledger-do-report (cmd)
-  "Run a report command line."
+  "Run a report command line CMD."
   (goto-char (point-min))
   (insert (format "Report: %s\n" ledger-report-name)
           (format "Command: %s\n" cmd)
           (make-string (- (window-width) 1) ?=)
-          "\n")
-  (shell-command cmd t nil))
+          "\n\n")
+  (let ((data-pos (point))
+        (register-report (string-match " reg\\(ister\\)? " cmd))
+	files-in-report)
+    (shell-command
+     ;; --subtotal does not produce identifiable transactions, so don't
+     ;; prepend location information for them
+     (if (and register-report
+	      (not (string-match "--subtotal" cmd)))
+	 (concat cmd " --prepend-format='%(filename):%(beg_line):'")
+	 cmd)
+     t nil)
+    (when register-report
+      (goto-char data-pos)
+      (while (re-search-forward "^\\(/[^:]+\\)?:\\([0-9]+\\)?:" nil t)
+	(let ((file (match-string 1))
+	      (line (string-to-number (match-string 2))))
+	  (delete-region (match-beginning 0) (match-end 0))
+	  (when file 	    
+	    (set-text-properties (line-beginning-position) (line-end-position)
+				 (list 'ledger-source (cons file (save-window-excursion
+								   (save-excursion
+								     (find-file file)
+								     (widen)
+								     (ledger-goto-line line)
+								     (point-marker))))))
+	    (add-text-properties (line-beginning-position) (line-end-position)
+				 (list 'face 'ledger-font-report-clickable-face))
+	    (end-of-line)))))
+    (goto-char data-pos)))
+
+
+(defun ledger-report-visit-source ()
+  "Visit the transaction under point in the report window."
+  (interactive)
+  (let* ((prop (get-text-property (point) 'ledger-source))
+	 (file (if prop (car prop)))
+	 (line-or-marker (if prop (cdr prop))))
+    (when (and file line-or-marker)      
+      (find-file-other-window file)
+      (widen)
+      (if (markerp line-or-marker)
+	  (goto-char line-or-marker)
+	  (goto-char (point-min))
+	  (forward-line (1- line-or-marker))
+	  (re-search-backward "^[0-9]+")
+	  (beginning-of-line)
+	  (let ((start-of-txn (point)))
+	    (forward-paragraph)
+	    (narrow-to-region start-of-txn (point))
+	    (backward-paragraph))))))
 
 (defun ledger-report-goto ()
   "Goto the ledger report buffer."
@@ -288,161 +396,24 @@ the default."
     (when (string-empty-p ledger-report-name)
       (setq ledger-report-name (ledger-report-read-new-name)))
 
-    (while (setq existing-name (ledger-report-name-exists ledger-report-name))
-      (cond ((y-or-n-p (format "Overwrite existing report named '%s' "
-                               ledger-report-name))
-             (when (string-equal
-                    ledger-report-cmd
-                    (car (cdr (assq existing-name ledger-reports))))
-               (error "Current command is identical to existing saved one"))
-             (setq ledger-reports
-                   (assq-delete-all existing-name ledger-reports)))
-            (t
-             (setq ledger-report-name (ledger-report-read-new-name)))))
-
-    (ledger-reports-add ledger-report-name ledger-report-cmd)
-    (ledger-reports-custom-save)))
-
-(defconst ledger-line-config
-  '((entry
-     (("^\\(\\([0-9][0-9][0-9][0-9]/\\)?[01]?[0-9]/[0123]?[0-9]\\)[ \t]+\\(\\([!*]\\)[ \t]\\)?[ \t]*\\((\\(.*\\))\\)?[ \t]*\\(.*?\\)[ \t]*;\\(.*\\)[ \t]*$"
-       (date nil status nil nil code payee comment))
-      ("^\\(\\([0-9][0-9][0-9][0-9]/\\)?[01]?[0-9]/[0123]?[0-9]\\)[ \t]+\\(\\([!*]\\)[ \t]\\)?[ \t]*\\((\\(.*\\))\\)?[ \t]*\\(.*\\)[ \t]*$"
-       (date nil status nil nil code payee))))
-    (acct-transaction
-     (("\\(^[ \t]+\\)\\(.*?\\)[ \t]+\\([$]\\)\\(-?[0-9]*\\(\\.[0-9]*\\)?\\)[ \t]*;[ \t]*\\(.*?\\)[ \t]*$"
-       (indent account commodity amount nil comment))
-      ("\\(^[ \t]+\\)\\(.*?\\)[ \t]+\\([$]\\)\\(-?[0-9]*\\(\\.[0-9]*\\)?\\)[ \t]*$"
-       (indent account commodity amount nil))
-      ("\\(^[ \t]+\\)\\(.*?\\)[ \t]+\\(-?[0-9]+\\(\\.[0-9]*\\)?\\)[ \t]+\\(.*?\\)[ \t]*;[ \t]*\\(.*?\\)[ \t]*$"
-       (indent account amount nil commodity comment))
-      ("\\(^[ \t]+\\)\\(.*?\\)[ \t]+\\(-?[0-9]+\\(\\.[0-9]*\\)?\\)[ \t]+\\(.*?\\)[ \t]*$"
-       (indent account amount nil commodity))
-      ("\\(^[ \t]+\\)\\(.*?\\)[ \t]+\\(-?\\(\\.[0-9]*\\)\\)[ \t]+\\(.*?\\)[ \t]*;[ \t]*\\(.*?\\)[ \t]*$"
-       (indent account amount nil commodity comment))
-      ("\\(^[ \t]+\\)\\(.*?\\)[ \t]+\\(-?\\(\\.[0-9]*\\)\\)[ \t]+\\(.*?\\)[ \t]*$"
-       (indent account amount nil commodity))
-      ("\\(^[ \t]+\\)\\(.*?\\)[ \t]*;[ \t]*\\(.*?\\)[ \t]*$"
-       (indent account comment))
-      ("\\(^[ \t]+\\)\\(.*?\\)[ \t]*$"
-       (indent account))))))
-
-(defun ledger-extract-context-info (line-type pos)
-  "Get context info for current line.
-
-Assumes point is at beginning of line, and the pos argument specifies
-where the \"users\" point was."
-  (let ((linfo (assoc line-type ledger-line-config))
-        found field fields)
-    (dolist (re-info (nth 1 linfo))
-      (let ((re (nth 0 re-info))
-            (names (nth 1 re-info)))
-        (unless found
-          (when (looking-at re)
-            (setq found t)
-            (dotimes (i (length names))
-              (when (nth i names)
-                (setq fields (append fields
-                                     (list
-                                      (list (nth i names)
-                                            (match-string-no-properties (1+ i))
-                                            (match-beginning (1+ i))))))))
-            (dolist (f fields)
-              (and (nth 1 f)
-                   (>= pos (nth 2 f))
-                   (setq field (nth 0 f))))))))
-    (list line-type field fields)))
-
-(defun ledger-context-at-point ()
-  "Return a list describing the context around point.
-
-The contents of the list are the line type, the name of the field
-point containing point, and for selected line types, the content of
-the fields in the line in a association list."
-  (let ((pos (point)))
-    (save-excursion
-      (beginning-of-line)
-      (let ((first-char (char-after)))
-        (cond ((equal (point) (line-end-position))
-               '(empty-line nil nil))
-              ((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 'entry pos))
-              ((equal first-char ?\=)
-               '(automated-entry nil nil))
-              ((equal first-char ?\~)
-               '(period-entry nil nil))
-              ((equal first-char ?\!)
-               '(command-directive))
-              ((equal first-char ?\;)
-               '(comment nil nil))
-              ((equal first-char ?Y)
-               '(default-year nil nil))
-              ((equal first-char ?P)
-               '(commodity-price nil nil))
-              ((equal first-char ?N)
-               '(price-ignored-commodity nil nil))
-              ((equal first-char ?D)
-               '(default-commodity nil nil))
-              ((equal first-char ?C)
-               '(commodity-conversion nil nil))
-              ((equal first-char ?i)
-               '(timeclock-i nil nil))
-              ((equal first-char ?o)
-               '(timeclock-o nil nil))
-              ((equal first-char ?b)
-               '(timeclock-b nil nil))
-              ((equal first-char ?h)
-               '(timeclock-h  nil nil))
-              (t
-               '(unknown nil nil)))))))
-
-(defun ledger-context-other-line (offset)
-  "Return a list describing context of line offset for existing position.
-
-Offset can be positive or negative.  If run out of buffer before reaching
-specified line, returns nil."
-  (save-excursion
-    (let ((left (forward-line offset)))
-      (if (not (equal left 0))
-          nil
-        (ledger-context-at-point)))))
-
-(defun ledger-context-line-type (context-info)
-  (nth 0 context-info))
-
-(defun ledger-context-current-field (context-info)
-  (nth 1 context-info))
-
-(defun ledger-context-field-info (context-info field-name)
-  (assoc field-name (nth 2 context-info)))
-
-(defun ledger-context-field-present-p (context-info field-name)
-  (not (null (ledger-context-field-info context-info field-name))))
-
-(defun ledger-context-field-value (context-info field-name)
-  (nth 1 (ledger-context-field-info context-info field-name)))
-
-(defun ledger-context-field-position (context-info field-name)
-  (nth 2 (ledger-context-field-info context-info field-name)))
-
-(defun ledger-context-field-end-position (context-info field-name)
-  (+ (ledger-context-field-position context-info field-name)
-     (length (ledger-context-field-value context-info field-name))))
-
-(defun ledger-context-goto-field-start (context-info field-name)
-  (goto-char (ledger-context-field-position context-info field-name)))
-
-(defun ledger-context-goto-field-end (context-info field-name)
-  (goto-char (ledger-context-field-end-position context-info field-name)))
-
-(defun ledger-entry-payee ()
-  "Returns the payee of the entry containing point or nil."
-  (let ((i 0))
-    (while (eq (ledger-context-line-type (ledger-context-other-line i)) 'acct-transaction)
-      (setq i (- i 1)))
-    (let ((context-info (ledger-context-other-line i)))
-      (if (eq (ledger-context-line-type context-info) 'entry)
-          (ledger-context-field-value context-info 'payee)
-        nil))))
+    (if (setq existing-name (ledger-report-name-exists ledger-report-name))
+	(cond ((y-or-n-p (format "Overwrite existing report named '%s'? "
+				 ledger-report-name))
+	       (if (string-equal
+		    ledger-report-cmd
+		    (car (cdr (assq existing-name ledger-reports))))
+		   (message "Nothing to save. Current command is identical to existing saved one")
+		   (progn
+		     (setq ledger-reports
+			   (assq-delete-all existing-name ledger-reports))
+		     (ledger-reports-add ledger-report-name ledger-report-cmd)
+		     (ledger-reports-custom-save))))
+	      (t
+	       (progn
+		 (setq ledger-report-name (ledger-report-read-new-name))
+		 (ledger-reports-add ledger-report-name ledger-report-cmd)
+		 (ledger-reports-custom-save)))))))
+
+(provide 'ldg-report)
+
+;;; ldg-report.el ends here
diff --git a/lisp/ldg-schedule.el b/lisp/ldg-schedule.el
new file mode 100644
index 00000000..885c0876
--- /dev/null
+++ b/lisp/ldg-schedule.el
@@ -0,0 +1,330 @@
+;;; ldg-schedule.el --- Helper code for use with the "ledger" command-line tool
+
+;; Copyright (C) 2013 Craig Earls (enderw88 at gmail dot com)
+
+;; This file is not part of GNU Emacs.
+
+;; This is free software; you can redistribute it and/or modify it
+;; under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+;;
+;; This is distributed in the hope that it will be useful, but WITHOUT
+;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+;; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public
+;; License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+;; 
+;; This module provides for automatically adding transactions to a
+;; ledger buffer on a periodic basis. Recurrence expressions are
+;; inspired by Martin Fowler's "Recurring Events for Calendars",
+;; martinfowler.com/apsupp/recurring.pdf
+
+;; use (fset 'VARNAME (macro args)) to put the macro definition in the
+;; function slot of the symbol VARNAME.  Then use VARNAME as the
+;; function without have to use funcall.
+
+(defgroup ledger-schedule nil
+  "Support for automatically recommendation transactions."
+  :group 'ledger)
+
+(defcustom ledger-schedule-buffer-name "*Ledger Schedule*"
+  "Name for the schedule buffer"
+  :type 'string
+  :group 'ledger-schedule)
+
+(defcustom ledger-schedule-look-backward 7
+  "Number of days to look back in time for transactions."
+  :type 'integer
+  :group 'ledger-schedule)
+
+(defcustom ledger-schedule-look-forward 14
+  "Number of days auto look forward to recommend transactions"
+  :type 'integer
+  :group 'ledger-schedule)
+
+(defcustom ledger-schedule-file "~/FinanceData/ledger-schedule.ledger"
+  "File to find scheduled transactions."
+  :type 'file
+  :group 'ledger-schedule)
+
+(defsubst between (val low high)
+  (and (>= val low) (<= val high)))
+
+(defun ledger-schedule-days-in-month (month year)
+  "Return number of days in the MONTH, MONTH is from 1 to 12.
+If year is nil, assume it is not a leap year"
+  (if (between month 1 12)
+      (if (and year (date-leap-year-p year) (= 2 month))
+	  29
+	  (nth (1- month) '(31 28 31 30 31 30 31 31 30 31 30 31)))
+      (error "Month out of range, MONTH=%S" month)))
+
+;; Macros to handle date expressions
+      
+(defun ledger-schedule-constrain-day-in-month (count day-of-week)
+  "Return a form that evaluates DATE that returns true for the COUNT DAY-OF-WEEK.
+For example, return true if date is the 3rd Thursday of the
+month.  Negative COUNT starts from the end of the month. (EQ
+COUNT 0) means EVERY day-of-week (eg. every Saturday)"
+  (if (and (between count -6 6) (between day-of-week 0 6))
+      (cond ((zerop count) ;; Return true if day-of-week matches
+	     `(eq (nth 6 (decode-time date)) ,day-of-week))
+	    ((> count 0) ;; Positive count
+	     (let ((decoded (gensym)))
+	       `(let ((,decoded (decode-time date)))
+		  (and (eq (nth 6 ,decoded) ,day-of-week)
+		       (between  (nth 3 ,decoded) 
+				 ,(* (1- count) 7) 
+				 ,(* count 7))))))
+	    ((< count 0) 
+	     (let ((days-in-month (gensym))
+		   (decoded (gensym)))
+	       `(let* ((,decoded (decode-time date))
+		       (,days-in-month (ledger-schedule-days-in-month 
+					(nth 4 ,decoded) 
+					(nth 5 ,decoded))))
+		  (and (eq (nth 6 ,decoded) ,day-of-week)
+		       (between  (nth 3 ,decoded) 
+				 (+ ,days-in-month ,(* count 7)) 
+				 (+ ,days-in-month ,(* (1+ count) 7)))))))
+	    (t
+	     (error "COUNT out of range, COUNT=%S" count)))
+      (error "Invalid argument to ledger-schedule-day-in-month-macro %S %S" 
+	     count 
+	     day-of-week)))
+
+(defun ledger-schedule-constrain-every-count-day (day-of-week skip start-date)
+  "Return a form that is true for every DAY skipping SKIP, starting on START.
+For example every second Friday, regardless of month."
+  (let ((start-day (nth 6 (decode-time (eval start-date)))))
+     (if (eq start-day day-of-week)  ;; good, can proceed
+	`(zerop (mod (- (time-to-days date) ,(time-to-days (eval start-date))) ,(* skip 7)))
+	   (error "START-DATE day of week doesn't match DAY-OF-WEEK"))))
+
+(defun ledger-schedule-constrain-date-range (month1 day1 month2 day2)
+  "Return a form of DATE that is true if DATE falls between MONTH1 DAY1 and MONTH2 DAY2."
+  (let ((decoded (gensym))
+	(target-month (gensym))
+	(target-day (gensym)))
+    `(let* ((,decoded (decode-time date))
+	    (,target-month (nth 4 decoded))
+	    (,target-day (nth 3 decoded)))
+       (and (and (> ,target-month ,month1)
+		 (< ,target-month ,month2))
+	    (and (> ,target-day ,day1)
+		 (< ,target-day ,day2))))))
+
+
+(defun ledger-schedule-is-holiday (date)
+  "Return true if DATE is a holiday.")
+
+(defun ledger-schedule-scan-transactions (schedule-file)
+  "Scans AUTO_FILE and returns a list of transactions with date predicates.
+The car of each item is a fuction of date that returns true if
+the transaction should be logged for that day."
+  (interactive "fFile name: ")
+  (let ((xact-list (list)))
+    (with-current-buffer
+	(find-file-noselect schedule-file)
+      (goto-char (point-min))
+      (while (re-search-forward "^\\[\\(.*\\)\\] " nil t)
+	(let ((date-descriptor "")
+	      (transaction nil)
+	      (xact-start (match-end 0)))
+	  (setq date-descriptors 
+		(ledger-schedule-read-descriptor-tree
+		 (buffer-substring-no-properties 
+		  (match-beginning 0) 
+		  (match-end 0))))
+	  (forward-paragraph)
+	  (setq transaction (list date-descriptors
+				  (buffer-substring-no-properties
+				   xact-start
+				   (point))))
+	  (setq xact-list (cons transaction xact-list))))
+    xact-list)))
+	  
+(defun ledger-schedule-replace-brackets ()
+    "Replace all brackets with parens"
+    (goto-char (point-min))
+    (while (search-forward "]" nil t)
+      (replace-match ")" nil t))
+    (goto-char (point-min))
+    (while (search-forward "[" nil t)
+      (replace-match "(" nil t)))
+
+(defvar ledger-schedule-descriptor-regex
+   (concat "\\(20[0-9][0-9]\\|[\*]\\)[/\\-]"  ;; Year slot
+		      "\\([\*EO]\\|[01][0-9]\\)[/\\-]" ;; Month slot
+		      "\\([\*]\\|\\([0-3][0-9]\\)\\|"
+		      "\\([0-5]"
+		      "\\(\\(Su\\)\\|"
+		      "\\(Mo\\)\\|" 
+		      "\\(Tu\\)\\|"
+		      "\\(We\\)\\|"
+		      "\\(Th\\)\\|"
+		      "\\(Fr\\)\\|"
+		      "\\(Sa\\)\\)\\)\\)"))
+
+(defun ledger-schedule-read-descriptor-tree (descriptor-string)
+  "Take a date DESCRIPTOR-STRING and return a function of date that
+returns true if the date meets the requirements"
+  (with-temp-buffer
+    ;; copy the descriptor string into a temp buffer for manipulation
+    (let (pos)
+      ;; Replace brackets with parens
+      (insert descriptor-string)
+      (ledger-schedule-replace-brackets)
+      
+      (goto-char (point-max))
+      ;; double quote all the descriptors for string processing later
+      (while (re-search-backward ledger-schedule-descriptor-regex nil t) ;; Day slot
+	(goto-char 
+	 (match-end 0))
+	(insert ?\")
+	(goto-char (match-beginning 0))
+	(insert "\"" )))
+    
+    ;; read the descriptor string into a lisp object the transform the
+    ;; string descriptor into useable things
+    (ledger-schedule-transform-auto-tree 
+     (read (buffer-substring-no-properties (point-min) (point-max))))))
+
+(defun ledger-schedule-transform-auto-tree (descriptor-string-list)
+"Takes a lisp list of date descriptor strings, TREE, and returns a string with a lambda function of date."
+;; use funcall to use the lambda function spit out here
+  (if (consp descriptor-string-list)
+      (let (result)
+	(while (consp descriptor-string-list)
+	  (let ((newcar (car descriptor-string-list)))
+	    (if (consp newcar)
+		(setq newcar (ledger-schedule-transform-auto-tree (car descriptor-string-list))))
+	    ;; newcar may be a cons now, after ledger-schedule-transfrom-auto-tree
+	    (if (consp newcar) 
+		(push newcar result)
+		;; this is where we actually turn the string descriptor into useful lisp
+		(push (ledger-schedule-compile-constraints newcar) result)) )
+	  (setq descriptor-string-list (cdr descriptor-string-list)))
+
+	;; tie up all the clauses in a big or and lambda, and return
+	;; the lambda function as list to be executed by funcall
+	`(lambda (date) 
+	   ,(nconc (list 'or) (nreverse result) descriptor-string-list)))))
+
+(defun ledger-schedule-compile-constraints (descriptor-string)
+  "Return a list with the year, month and day fields split"
+  (let ((fields (split-string descriptor-string "[/\\-]" t))
+	constrain-year constrain-month constrain-day)
+    (setq constrain-year (ledger-schedule-constrain-year (nth 0 fields)))
+    (setq constrain-month (ledger-schedule-constrain-month (nth 1 fields)))
+    (setq constrain-day (ledger-schedule-constrain-day (nth 2 fields)))
+
+    (list 'and constrain-year constrain-month constrain-day)))
+
+(defun ledger-schedule-constrain-year (str)
+  (let ((year-match t))
+    (cond ((string= str "*")
+	   year-match)
+	  ((/= 0 (setq year-match (string-to-number str)))
+	   `(eq (nth 5 (decode-time date)) ,year-match))
+	  (t
+	   (error "Improperly specified year constraint: " str)))))
+
+(defun ledger-schedule-constrain-month (str)
+  
+  (let ((month-match t)) 
+    (cond ((string= str "*")
+	   month-match)  ;; always match
+	  ((/= 0 (setq month-match (string-to-number str)))
+	   (if (between month-match 1 12) ;; no month specified, assume 31 days.
+	       `(eq (nth 4 (decode-time date)) ,month-match)
+	       (error "ledger-schedule-constrain-numerical-month: month out of range %S" month-match)))
+	 (t
+	  (error "Improperly specified month constraint: " str)))))
+
+(defun ledger-schedule-constrain-day (str)
+  (let ((day-match t))
+    (cond ((string= str "*")
+	   t)
+	  ((/= 0 (setq day-match (string-to-number str)))
+	   `(eq (nth 3 (decode-time date)) ,day-match))
+	  (t
+	   (error "Improperly specified day constraint: " str)))))
+
+(defun ledger-schedule-parse-date-descriptor (descriptor)
+  "Parse the date descriptor, return the evaluator"
+  (ledger-schedule-compile-constraints descriptor))
+
+(defun ledger-schedule-list-upcoming-xacts (candidate-items early horizon)
+  "Search CANDIDATE-ITEMS for xacts that occur within the period today - EARLY  to today + HORIZON"
+  (let ((start-date (time-subtract (current-time) (days-to-time early)))
+	test-date items)
+    (loop for day from 0 to (+ early horizon) by 1 do
+	 (setq test-date (time-add start-date (days-to-time day)))
+	 (dolist (candidate candidate-items items)
+	   (if (funcall (car candidate) test-date)
+	       (setq items (append items (list (list test-date (cadr candidate))))))))
+    items))
+
+(defun ledger-schedule-already-entered (candidate buffer)
+  (let ((target-date (format-time-string date-format (car candidate)))
+	     (target-payee (cadr candidate)))
+    nil))
+
+(defun ledger-schedule-create-auto-buffer (candidate-items early horizon ledger-buf)
+  "Format CANDIDATE-ITEMS for display."
+  (let ((candidates (ledger-schedule-list-upcoming-xacts candidate-items early horizon))
+	(schedule-buf (get-buffer-create ledger-schedule-buffer-name))
+	(date-format (cdr (assoc "date-format" ledger-environment-alist))))
+    (with-current-buffer schedule-buf
+      (erase-buffer)
+     (dolist (candidate candidates)
+       (if (not (ledger-schedule-already-entered candidate ledger-buf))
+	   (insert (format-time-string date-format (car candidate) ) " " (cadr candidate) "\n")))
+     (ledger-mode))
+    (length candidates)))
+
+
+;;
+;;  Test harnesses for use in ielm
+;;
+(defvar auto-items)
+
+(defun ledger-schedule-test ( early horizon)
+   (ledger-schedule-create-auto-buffer 
+    (ledger-schedule-scan-transactions ledger-schedule-file) 
+    early 
+    horizon 
+    (get-buffer "2013.ledger")))
+
+
+(defun ledger-schedule-test-predict ()
+  (let ((today (current-time))
+	test-date items)
+    
+    (loop for day from 0 to ledger-schedule-look-forward by 1 do
+	 (setq test-date (time-add today (days-to-time day)))
+	 (dolist (item auto-items items)
+	   (if (funcall (car item) test-date)
+	       (setq items (append items (list (decode-time test-date) (cdr item)))))))
+    items))
+
+(defun ledger-schedule-upcoming ()
+  (interactive)
+  (ledger-schedule-create-auto-buffer 
+   (ledger-schedule-scan-transactions ledger-schedule-file) 
+   ledger-schedule-look-backward
+   ledger-schedule-look-forward
+   (current-buffer)))
+
+
+(provide 'ldg-schedule)
+
+;;; ldg-schedule.el ends here
diff --git a/lisp/ldg-sort.el b/lisp/ldg-sort.el
new file mode 100644
index 00000000..a50cd1cc
--- /dev/null
+++ b/lisp/ldg-sort.el
@@ -0,0 +1,113 @@
+;;; ldg-xact.el --- Helper code for use with the "ledger" command-line tool
+
+;; Copyright (C) 2003-2013 John Wiegley (johnw AT gnu DOT org)
+
+;; This file is not part of GNU Emacs.
+
+;; This is free software; you can redistribute it and/or modify it under
+;; the terms of the GNU General Public License as published by the Free
+;; Software Foundation; either version 2, or (at your option) any later
+;; version.
+;;
+;; This is distributed in the hope that it will be useful, but WITHOUT
+;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+;; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+;; for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+;; MA 02111-1307, USA.
+
+
+
+;;; Commentary:
+;; 
+
+;;; Code:
+
+(defun ledger-next-record-function ()
+  "Move point to next transaction."
+  (if (re-search-forward  ledger-payee-any-status-regex nil t)
+      (goto-char (match-beginning 0))
+      (goto-char (point-max))))
+
+(defun ledger-end-record-function ()
+  "Move point to end of transaction."
+  (forward-paragraph))
+
+(defun ledger-sort-find-start ()
+  (if (re-search-forward ";.*Ledger-mode:.*Start sort" nil t)
+      (match-end 0)))
+
+(defun ledger-sort-find-end ()
+  (if (re-search-forward ";.*Ledger-mode:.*End sort" nil t)
+      (match-end 0)))
+
+(defun ledger-sort-insert-start-mark ()
+  (interactive)  
+  (save-excursion
+    (goto-char (point-min))
+    (if (ledger-sort-find-start)
+	 (delete-region (match-beginning 0) (match-end 0))))
+  (beginning-of-line)
+  (insert "\n; Ledger-mode: Start sort\n\n"))
+
+(defun ledger-sort-insert-end-mark ()
+  (interactive)  
+  (save-excursion
+    (goto-char (point-min))
+    (if (ledger-sort-find-end)
+	(delete-region (match-beginning 0) (match-end 0))))
+  (beginning-of-line)
+  (insert "\n; Ledger-mode: End sort\n\n"))
+
+(defun ledger-sort-startkey ()
+  "Return the actual date so the sort-subr doesn't sort onthe entire first line."
+  (buffer-substring-no-properties (point) (+ 10 (point))))
+
+(defun ledger-sort-region (beg end)
+  "Sort the region from BEG to END in chronological order."
+  (interactive "r") ;; load beg and end from point and mark
+		    ;; automagically
+  (let ((new-beg beg)
+	(new-end end))
+    (setq inhibit-modification-hooks t)
+    (save-excursion 
+      (save-restriction
+	(goto-char beg)
+	(ledger-next-record-function) ;; make sure point is at the
+				      ;; beginning of a xact
+	(setq new-beg (point))
+	(goto-char end)
+	(ledger-next-record-function) ;; make sure end of region is at
+				      ;; the beginning of next record
+				      ;; after the region
+	(setq new-end (point))
+	(narrow-to-region new-beg new-end)
+	(goto-char new-beg)
+
+	(let ((inhibit-field-text-motion t))
+	  (sort-subr
+	   nil
+	   'ledger-next-record-function
+	   'ledger-end-record-function
+	   'ledger-sort-startkey))))
+    (setq inhibit-modification-hooks nil)))
+
+(defun ledger-sort-buffer ()
+  "Sort the entire buffer."
+  (interactive)
+  (goto-char (point-min))
+  (let ((sort-start (ledger-sort-find-start))
+	(sort-end (ledger-sort-find-end)))
+    (ledger-sort-region (if sort-start
+			    sort-start
+			    (point-min)) 
+			(if sort-end
+			    sort-end
+			    (point-max)))))
+
+(provide 'ldg-sort)
+
+;;; ldg-sort.el ends here
diff --git a/lisp/ldg-state.el b/lisp/ldg-state.el
index 6a841621..58777631 100644
--- a/lisp/ldg-state.el
+++ b/lisp/ldg-state.el
@@ -1,56 +1,94 @@
-(defcustom ledger-clear-whole-entries nil
-  "If non-nil, clear whole entries, not individual transactions."
+;;; ldg-state.el --- Helper code for use with the "ledger" command-line tool
+
+;; Copyright (C) 2003-2013 John Wiegley (johnw AT gnu DOT org)
+
+;; This file is not part of GNU Emacs.
+
+;; This is free software; you can redistribute it and/or modify it under
+;; the terms of the GNU General Public License as published by the Free
+;; Software Foundation; either version 2, or (at your option) any later
+;; version.
+;;
+;; This is distributed in the hope that it will be useful, but WITHOUT
+;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+;; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+;; for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+;; MA 02111-1307, USA.
+
+
+;;; Commentary:
+;; Utilities for dealing with transaction and posting status.
+
+;;; Code:
+
+(defcustom ledger-clear-whole-transactions nil
+  "If non-nil, clear whole transactions, not individual postings."
   :type 'boolean
   :group 'ledger)
 
-(defun ledger-toggle-state (state &optional style)
-  (if (not (null state))
-      (if (and style (eq style 'cleared))
-          'cleared)
-    (if (and style (eq style 'pending))
-        'pending
-      'cleared)))
-
-(defun ledger-entry-state ()
+(defun ledger-transaction-state ()
+  "Return the state of the transaction at point."
   (save-excursion
     (when (or (looking-at "^[0-9]")
               (re-search-backward "^[0-9]" nil t))
-      (skip-chars-forward "0-9./=")
+      (skip-chars-forward "0-9./=\\-")
       (skip-syntax-forward " ")
       (cond ((looking-at "!\\s-*") 'pending)
             ((looking-at "\\*\\s-*") 'cleared)
             (t nil)))))
 
-(defun ledger-transaction-state ()
+(defun ledger-posting-state ()
+  "Return the state of the posting."
   (save-excursion
     (goto-char (line-beginning-position))
     (skip-syntax-forward " ")
     (cond ((looking-at "!\\s-*") 'pending)
           ((looking-at "\\*\\s-*") 'cleared)
-          (t (ledger-entry-state)))))
+          (t (ledger-transaction-state)))))
 
-(defun ledger-toggle-current-transaction (&optional style)
+(defun ledger-char-from-state (state)
+  "Return the char representation of STATE."
+  (if state
+      (if (eq state 'pending)
+	  "!"
+	  "*")
+      ""))
+
+(defun ledger-state-from-char (state-char)
+  "Get state from STATE-CHAR."
+  (cond ((eql state-char ?\!) 'pending)
+	((eql state-char ?\*) 'cleared)
+	((eql state-char ?\;) 'comment)
+	(t nil)))
+
+(defun ledger-toggle-current-posting (&optional style)
   "Toggle the cleared status of the transaction under point.
 Optional argument STYLE may be `pending' or `cleared', depending
 on which type of status the caller wishes to indicate (default is
-`cleared').
+`cleared').  Returns the new status as 'pending 'cleared or nil.
 This function is rather complicated because it must preserve both
-the overall formatting of the ledger entry, as well as ensuring
+the overall formatting of the ledger xact, as well as ensuring
 that the most minimal display format is used.  This could be
-achieved more certainly by passing the entry to ledger for
+achieved more certainly by passing the xact to ledger for
 formatting, but doing so causes inline math expressions to be
 dropped."
   (interactive)
-  (let ((bounds (ledger-current-entry-bounds))
-        clear cleared)
-    ;; Uncompact the entry, to make it easier to toggle the
+  (let ((bounds (ledger-find-xact-extents (point)))
+        new-status cur-status)
+    ;; Uncompact the xact, to make it easier to toggle the
     ;; transaction
-    (save-excursion
-      (goto-char (car bounds))
-      (skip-chars-forward "0-9./= \t")
-      (setq cleared (and (member (char-after) '(?\* ?\!))
-                         (char-after)))
-      (when cleared
+    (save-excursion  ;; this excursion checks state of entire
+		     ;; transaction and unclears if marked
+      (goto-char (car bounds))  ;; beginning of xact
+      (skip-chars-forward "0-9./=\\- \t") ;; skip the date
+      (setq cur-status (and (member (char-after) '(?\* ?\!))
+			    (ledger-state-from-char (char-after))))
+      ;;if cur-status if !, or * then delete the marker
+      (when cur-status
         (let ((here (point)))
           (skip-chars-forward "*! ")
           (let ((width (- (point) here)))
@@ -59,69 +97,78 @@ dropped."
               (if (search-forward "  " (line-end-position) t)
                   (insert (make-string width ? ))))))
         (forward-line)
+	;; Shift the cleared/pending status to the postings
         (while (looking-at "[ \t]")
           (skip-chars-forward " \t")
-          (insert cleared " ")
-          (if (search-forward "  " (line-end-position) t)
-              (delete-char 2))
-          (forward-line))))
-    ;; Toggle the individual transaction
+	  (when (not (eq (ledger-state-from-char (char-after)) 'comment))
+	    (insert (ledger-char-from-state cur-status) " ")
+	    (if (search-forward "  " (line-end-position) t)
+		(delete-char 2)))
+	  (forward-line))
+	(setq new-status nil)))
+
+    ;;this excursion toggles the posting status
     (save-excursion
+      (setq inhibit-modification-hooks t)
+      
       (goto-char (line-beginning-position))
       (when (looking-at "[ \t]")
-        (skip-chars-forward " \t")
-        (let ((here (point))
-              (cleared (member (char-after) '(?\* ?\!))))
-          (skip-chars-forward "*! ")
-          (let ((width (- (point) here)))
-            (when (> width 0)
-              (delete-region here (point))
-              (save-excursion
-                (if (search-forward "  " (line-end-position) t)
-                    (insert (make-string width ? ))))))
-          (let (inserted)
-            (if cleared
-                (if (and style (eq style 'cleared))
-                    (progn
-                      (insert "* ")
-                      (setq inserted t)))
-              (if (and style (eq style 'pending))
-                  (progn
-                    (insert "! ")
-                    (setq inserted t))
-                (progn
-                  (insert "* ")
-                  (setq inserted t))))
-            (if (and inserted
-                     (re-search-forward "\\(\t\\| [ \t]\\)"
-                                        (line-end-position) t))
-                (cond
-                 ((looking-at "\t")
-                  (delete-char 1))
-                 ((looking-at " [ \t]")
-                  (delete-char 2))
-                 ((looking-at " ")
-                  (delete-char 1))))
-            (setq clear inserted)))))
-    ;; Clean up the entry so that it displays minimally
+	 (skip-chars-forward " \t")
+	 (let ((here (point))
+	       (cur-status (ledger-state-from-char (char-after))))
+	   (skip-chars-forward "*! ")
+	   (let ((width (- (point) here)))
+	     (when (> width 0)
+	       (delete-region here (point))
+	       (save-excursion
+		 (if (search-forward "  " (line-end-position) t)
+		     (insert (make-string width ? ))))))
+	   (let (inserted)
+	     (if cur-status
+		 (if (and style (eq style 'cleared))
+		     (progn
+		       (insert  "* ")
+		       (setq inserted 'cleared)))
+		 (if (and style (eq style 'pending))
+		     (progn
+		       (insert  "! ")
+		       (setq inserted 'pending))
+		     (progn
+		       (insert  "* ")
+		       (setq inserted 'cleared))))
+	     (if (and inserted
+		      (re-search-forward "\\(\t\\| [ \t]\\)"
+					 (line-end-position) t))
+		 (cond
+		   ((looking-at "\t")
+		    (delete-char 1))
+		   ((looking-at " [ \t]")
+		    (delete-char 2))
+		   ((looking-at " ")
+		    (delete-char 1))))
+	     (setq new-status inserted))))
+      (setq inhibit-modification-hooks nil))
+
+    ;; This excursion cleans up the xact so that it displays
+    ;; minimally.  This means that if all posts are cleared, remove
+    ;; the marks and clear the entire transaction.
     (save-excursion
       (goto-char (car bounds))
       (forward-line)
       (let ((first t)
-            (state ? )
+            (state nil)
             (hetero nil))
         (while (and (not hetero) (looking-at "[ \t]"))
           (skip-chars-forward " \t")
-          (let ((cleared (if (member (char-after) '(?\* ?\!))
-                             (char-after)
-                           ? )))
-            (if first
-                (setq state cleared
-                      first nil)
-              (if (/= state cleared)
-                  (setq hetero t))))
+          (let ((cur-status (ledger-state-from-char (char-after))))
+	    (if (not (eq cur-status 'comment))
+		(if first
+		    (setq state cur-status
+			  first nil)
+		    (if (not (eq state cur-status))
+			(setq hetero t)))))
           (forward-line))
-        (when (and (not hetero) (/= state ? ))
+        (when (and (not hetero) (not (eq state nil)))
           (goto-char (car bounds))
           (forward-line)
           (while (looking-at "[ \t]")
@@ -136,54 +183,62 @@ dropped."
                       (insert (make-string width ? ))))))
             (forward-line))
           (goto-char (car bounds))
-          (skip-chars-forward "0-9./= \t")
-          (insert state " ")
+          (skip-chars-forward "0-9./=\\- \t")
+          (insert (ledger-char-from-state state) " ")
+	  (setq new-status state)
           (if (re-search-forward "\\(\t\\| [ \t]\\)"
                                  (line-end-position) t)
               (cond
-               ((looking-at "\t")
-                (delete-char 1))
-               ((looking-at " [ \t]")
-                (delete-char 2))
-               ((looking-at " ")
-                (delete-char 1)))))))
-    clear))
+		((looking-at "\t")
+		 (delete-char 1))
+		((looking-at " [ \t]")
+		 (delete-char 2))
+		((looking-at " ")
+		 (delete-char 1)))))))
+    new-status))
 
 (defun ledger-toggle-current (&optional style)
+  "Toggle the current thing at point with optional STYLE."
   (interactive)
-  (if (or ledger-clear-whole-entries
-          (eq 'entry (ledger-thing-at-point)))
+  (if (or ledger-clear-whole-transactions
+          (eq 'transaction (ledger-thing-at-point)))
       (progn
         (save-excursion
           (forward-line)
           (goto-char (line-beginning-position))
           (while (and (not (eolp))
                       (save-excursion
-                        (not (eq 'entry (ledger-thing-at-point)))))
+                        (not (eq 'transaction (ledger-thing-at-point)))))
             (if (looking-at "\\s-+[*!]")
-                (ledger-toggle-current-transaction nil))
+                (ledger-toggle-current-posting style))
             (forward-line)
             (goto-char (line-beginning-position))))
-        (ledger-toggle-current-entry style))
-    (ledger-toggle-current-transaction style)))
+        (ledger-toggle-current-transaction style))
+      (ledger-toggle-current-posting style)))
 
-(defun ledger-toggle-current-entry (&optional style)
+(defun ledger-toggle-current-transaction (&optional style)
+  "Toggle the transaction at point using optional STYLE."
   (interactive)
-  (let (clear)
-    (save-excursion
-      (when (or (looking-at "^[0-9]")
-                (re-search-backward "^[0-9]" nil t))
-        (skip-chars-forward "0-9./=")
-        (delete-horizontal-space)
-        (if (member (char-after) '(?\* ?\!))
-            (progn
-              (delete-char 1)
-              (if (and style (eq style 'cleared))
-                  (insert " *")))
-          (if (and style (eq style 'pending))
-              (insert " ! ")
-            (insert " * "))
-          (setq clear t))))
-    clear))
+  (save-excursion
+    (when (or (looking-at "^[0-9]")
+	      (re-search-backward "^[0-9]" nil t))
+      (skip-chars-forward "0-9./=\\-")
+      (delete-horizontal-space)
+      (if (or (eq (ledger-state-from-char (char-after)) 'pending)
+	      (eq (ledger-state-from-char (char-after)) 'cleared))
+	  (progn
+	    (delete-char 1)
+	    (when (and style (eq style 'cleared))		
+	      (insert " *")
+	      'cleared))
+	  (if (and style (eq style 'pending))
+	      (progn
+		(insert " ! ")
+		'pending)
+	      (progn
+		(insert " * ")
+		'cleared))))))
 
 (provide 'ldg-state)
+
+;;; ldg-state.el ends here
diff --git a/lisp/ldg-test.el b/lisp/ldg-test.el
index 478c62d8..0c571caa 100644
--- a/lisp/ldg-test.el
+++ b/lisp/ldg-test.el
@@ -1,12 +1,64 @@
-(defcustom ledger-source-directory "~/src/ledger"
-  "Directory where the Ledger sources are located."
-  :type 'directory
+;;; ldg-test.el --- Helper code for use with the "ledger" command-line tool
+
+;; Copyright (C) 2003-2013 John Wiegley (johnw AT gnu DOT org)
+
+;; This file is not part of GNU Emacs.
+
+;; This is free software; you can redistribute it and/or modify it under
+;; the terms of the GNU General Public License as published by the Free
+;; Software Foundation; either version 2, or (at your option) any later
+;; version.
+;;
+;; This is distributed in the hope that it will be useful, but WITHOUT
+;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+;; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+;; for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+;; MA 02111-1307, USA.
+
+(defgroup ledger-test nil
+  "Definitions for the Ledger testing framework"
   :group 'ledger)
 
-(defcustom ledger-test-binary "~/Products/ledger/debug/ledger"
+(defcustom ledger-source-directory "~/ledger/"
   "Directory where the Ledger sources are located."
+  :type 'directory
+  :group 'ledger-test)
+
+(defcustom ledger-test-binary "/Products/ledger/debug/ledger"
+  "Directory where the Ledger debug binary is located."
   :type 'file
-  :group 'ledger)
+  :group 'ledger-test)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defun ledger-create-test ()
+  "Create a regression test."
+  (interactive)
+  (save-restriction
+    (org-narrow-to-subtree)
+    (save-excursion
+      (let (text beg)
+        (goto-char (point-min))
+        (forward-line 1)
+        (setq beg (point))
+        (search-forward ":PROPERTIES:")
+        (goto-char (line-beginning-position))
+        (setq text (buffer-substring-no-properties beg (point)))
+        (goto-char (point-min))
+        (re-search-forward ":ID:\\s-+\\([^-]+\\)")
+        (find-file-other-window
+         (format "~/src/ledger/test/regress/%s.test" (match-string 1)))
+        (sit-for 0)
+        (insert text)
+        (goto-char (point-min))
+        (while (not (eobp))
+          (goto-char (line-beginning-position))
+          (delete-char 3)
+          (forward-line 1))))))
 
 (defun ledger-test-org-narrow-to-entry ()
   (outline-back-to-heading)
@@ -46,9 +98,9 @@
         (ledger-mode)
         (if input
             (insert input)
-          (insert "2012-03-17 Payee\n")
-          (insert "    Expenses:Food                $20\n")
-          (insert "    Assets:Cash\n"))
+	    (insert "2012-03-17 Payee\n")
+	    (insert "    Expenses:Food                $20\n")
+	    (insert "    Assets:Cash\n"))
         (insert "\ntest reg\n")
         (if output
             (insert output))
@@ -69,7 +121,7 @@
         (let ((prev-directory default-directory))
           (cd ledger-source-directory)
           (unwind-protect
-              (async-shell-command (format "\"%s\" %s" command args))
+	       (async-shell-command (format "\"%s\" %s" command args))
             (cd prev-directory)))))))
 
 (provide 'ldg-test)
diff --git a/lisp/ldg-texi.el b/lisp/ldg-texi.el
index b0334099..84ba34c2 100644
--- a/lisp/ldg-texi.el
+++ b/lisp/ldg-texi.el
@@ -1,6 +1,37 @@
-(defvar ledger-path "/Users/johnw/bin/ledger")
-(defvar ledger-sample-doc-path "/Users/johnw/src/ledger/doc/sample.dat")
-(defvar ledger-normalization-args "--args-only --columns 80")
+;;; ldg-texi.el --- Helper code for use with the "ledger" command-line tool
+
+;; Copyright (C) 2003-2013 John Wiegley (johnw AT gnu DOT org)
+
+;; This file is not part of GNU Emacs.
+
+;; This is free software; you can redistribute it and/or modify it under
+;; the terms of the GNU General Public License as published by the Free
+;; Software Foundation; either version 2, or (at your option) any later
+;; version.
+;;
+;; This is distributed in the hope that it will be useful, but WITHOUT
+;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+;; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+;; for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+;; MA 02111-1307, USA.
+
+(defgroup ledger-texi nil
+"Options for working on Ledger texi documentation"
+:group 'ledger)
+
+(defcustom ledger-texi-sample-doc-path "~/ledger/doc/sample.dat"
+"Location for sample data to be used in texi tests"
+:type 'file
+:group 'ledger-texi)
+
+(defcustom ledger-texi-normalization-args "--args-only --columns 80"
+"texi normalization for producing ledger output"
+:type 'string
+:group 'ledger-texi)
 
 (defun ledger-update-test ()
   (interactive)
@@ -71,19 +102,19 @@
 
 (defun ledger-texi-expand-command (command data-file)
   (if (string-match "\\$LEDGER" command)
-      (replace-match (format "%s -f \"%s\" %s" ledger-path
-                             data-file ledger-normalization-args) t t command)
-    (concat (format "%s -f \"%s\" %s " ledger-path
-                    data-file ledger-normalization-args) command)))
+      (replace-match (format "%s -f \"%s\" %s" ledger-binary-path
+                             data-file ledger-texi-normalization-args) t t command)
+      (concat (format "%s -f \"%s\" %s " ledger-binary-path
+		      data-file ledger-texi-normalization-args) command)))
 
 (defun ledger-texi-invoke-command (command)
   (with-temp-buffer (shell-command command t (current-buffer))
-    (if (= (point-min) (point-max))
-        (progn
-          (push-mark nil t)
-          (message "Command '%s' yielded no result at %d" command (point))
-          (ding))
-      (buffer-string))))
+		    (if (= (point-min) (point-max))
+			(progn
+			  (push-mark nil t)
+			  (message "Command '%s' yielded no result at %d" command (point))
+			  (ding))
+			(buffer-string))))
 
 (defun ledger-texi-write-test-data (name input)
   (let ((path (expand-file-name name temporary-file-directory)))
@@ -101,7 +132,7 @@
       (let ((section (match-string 1))
             (example-name (match-string 2))
             (command (match-string 3)) expanded-command
-            (data-file ledger-sample-doc-path)
+            (data-file ledger-texi-sample-doc-path)
             input output)
         (goto-char (match-end 0))
         (forward-line)
@@ -128,7 +159,7 @@
 
         (let ((section-name (if (string= section "smex")
                                 "smallexample"
-                              "example"))
+				"example"))
               (output (ledger-texi-invoke-command
                        (ledger-texi-expand-command command data-file))))
           (insert "@" section-name ?\n output
diff --git a/lisp/ldg-xact.el b/lisp/ldg-xact.el
index e1f165a7..bf50dbe2 100644
--- a/lisp/ldg-xact.el
+++ b/lisp/ldg-xact.el
@@ -1,20 +1,189 @@
-;; A sample entry sorting function, which works if entry dates are of
-;; the form YYYY/mm/dd.
+;;; ldg-xact.el --- Helper code for use with the "ledger" command-line tool
 
-(defun ledger-sort ()
-  (interactive)
+;; Copyright (C) 2003-2013 John Wiegley (johnw AT gnu DOT org)
+
+;; This file is not part of GNU Emacs.
+
+;; This is free software; you can redistribute it and/or modify it under
+;; the terms of the GNU General Public License as published by the Free
+;; Software Foundation; either version 2, or (at your option) any later
+;; version.
+;;
+;; This is distributed in the hope that it will be useful, but WITHOUT
+;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+;; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+;; for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+;; MA 02111-1307, USA.
+
+
+;;; Commentary:
+;; Utilities for running ledger synchronously.
+
+;;; Code:
+
+(defcustom ledger-highlight-xact-under-point t
+  "If t highlight xact under point."
+  :type 'boolean
+  :group 'ledger)
+
+(defvar highlight-overlay (list))
+
+(defun ledger-find-xact-extents (pos)
+  "Return point for beginning of xact and and of xact containing position.
+Requires empty line separating xacts.  Argument POS is a location
+within the transaction."
+  (interactive "d")
   (save-excursion
-    (goto-char (point-min))
-    (sort-subr
-     nil
-     (function
-      (lambda ()
-        (if (re-search-forward
-             (concat "^[0-9/.=-]+\\(\\s-+\\*\\)?\\(\\s-+(.*?)\\)?\\s-+"
-                     "\\(.+?\\)\\(\t\\|\n\\| [ \t]\\)") nil t)
-            (goto-char (match-beginning 0))
-          (goto-char (point-max)))))
+    (goto-char pos)
+    (list (progn
+	    (backward-paragraph)
+	    (if (/= (point) (point-min))
+		(forward-line))
+	    (line-beginning-position))
+	  (progn
+	    (forward-paragraph)
+	    (line-beginning-position)))))
+
+(defun ledger-highlight-xact-under-point ()
+  "Move the highlight overlay to the current transaction."
+  (if ledger-highlight-xact-under-point
+      (let ((exts (ledger-find-xact-extents (point)))
+	    (ovl highlight-overlay))
+	(if (not highlight-overlay)
+	    (setq ovl
+		  (setq highlight-overlay
+			(make-overlay (car exts)
+				      (cadr exts)
+				      (current-buffer) t nil)))
+	    (move-overlay ovl (car exts) (cadr exts)))
+	(overlay-put ovl 'face 'ledger-font-xact-highlight-face)
+	(overlay-put ovl 'priority 100))))
+
+(defun ledger-xact-payee ()
+  "Return the payee of the transaction containing point or nil."
+  (let ((i 0))
+    (while (eq (ledger-context-line-type (ledger-context-other-line i)) 'acct-transaction)
+      (setq i (- i 1)))
+    (let ((context-info (ledger-context-other-line i)))
+      (if (eq (ledger-context-line-type context-info) 'xact)
+          (ledger-context-field-value context-info 'payee)
+	  nil))))
+
+(defun ledger-time-less-p (t1 t2)
+  "Say whether time value T1 is less than time value T2."
+  (or (< (car t1) (car t2))
+      (and (= (car t1) (car t2))
+           (< (nth 1 t1) (nth 1 t2)))))
+
+(defun ledger-xact-find-slot (moment)
+  "Find the right place in the buffer for a transaction at MOMENT.
+MOMENT is an encoded date"
+  (catch 'found
+    (ledger-xact-iterate-transactions
      (function
-      (lambda ()
-        (forward-paragraph))))))
+      (lambda (start date mark desc)
+       (if (ledger-time-less-p moment date)
+	   (throw 'found t)))))))
+
+(defun ledger-xact-iterate-transactions (callback)
+  "Iterate through each transaction call CALLBACK for each."
+  (goto-char (point-min))
+  (let* ((now (current-time))
+         (current-year (nth 5 (decode-time now))))
+    (while (not (eobp))
+      (when (looking-at ledger-iterate-regex)
+        (let ((found-y-p (match-string 2)))  
+          (if found-y-p  
+              (setq current-year (string-to-number found-y-p)) ;; a Y directive was found
+	      (let ((start (match-beginning 0))
+		    (year (match-string 4))
+		    (month (string-to-number (match-string 5)))
+		    (day (string-to-number (match-string 6)))
+		    (mark (match-string 7))
+		    (code (match-string 8))
+		    (desc (match-string 9)))
+		(if (and year (> (length year) 0))
+		    (setq year (string-to-number year)))
+		(funcall callback start
+			 (encode-time 0 0 0 day month
+				      (or year current-year))
+			 mark desc)))))
+      (forward-line))))
+
+(defsubst ledger-goto-line (line-number)
+  "Rapidly move point to line LINE-NUMBER."
+  (goto-char (point-min)) 
+  (forward-line (1- line-number)))
+
+
+(defun ledger-copy-transaction-at-point (date)
+  "Ask for a new DATE and copy the transaction under point to that date.  Leave point on the first amount."
+  (interactive  (list
+		 (read-string "Copy to date: " 
+			      (concat ledger-year "/" ledger-month "/") 'ledger-minibuffer-history)))
+  (let* ((here (point))
+	 (extents (ledger-find-xact-extents (point)))
+	 (transaction (buffer-substring-no-properties (car extents) (cadr extents)))
+	 encoded-date)
+    (if (string-match ledger-iso-date-regexp date)
+	(setq encoded-date
+	      (encode-time 0 0 0 (string-to-number (match-string 4 date))
+			   (string-to-number (match-string 3 date))
+			   (string-to-number (match-string 2 date)))))
+    (ledger-xact-find-slot encoded-date)
+    (insert transaction "\n")
+    (backward-paragraph 2)
+    (re-search-forward ledger-iso-date-regexp)
+    (replace-match date)
+    (ledger-next-amount)))
+
+(defun ledger-delete-current-transaction (pos)
+  "Delete the transaction surrounging point."
+  (interactive "d")
+  (let ((bounds (ledger-find-xact-extents pos)))
+    (delete-region (car bounds) (cadr bounds))))
+
+(defun ledger-add-transaction (transaction-text &optional insert-at-point)
+  "Use ledger xact TRANSACTION-TEXT to add a transaction to the buffer.
+If INSERT-AT-POINT is non-nil insert the transaction
+there, otherwise call `ledger-xact-find-slot' to insert it at the
+correct chronological place in the buffer."
+  (interactive (list
+		(read-string "Transaction: " (concat ledger-year "/" ledger-month "/"))))
+  (let* ((args (with-temp-buffer
+                 (insert transaction-text)
+                 (eshell-parse-arguments (point-min) (point-max))))
+         (ledger-buf (current-buffer))
+         exit-code)
+    (unless insert-at-point
+      (let ((date (car args)))
+        (if (string-match ledger-iso-date-regexp date)
+            (setq date
+                  (encode-time 0 0 0 (string-to-number (match-string 4 date))
+                               (string-to-number (match-string 3 date))
+                               (string-to-number (match-string 2 date)))))
+        (ledger-xact-find-slot date)))
+    (if (> (length args) 1)
+	(save-excursion
+	  (insert
+	   (with-temp-buffer
+	     (setq exit-code
+		   (apply #'ledger-exec-ledger ledger-buf (current-buffer) "xact"
+			  (mapcar 'eval args)))
+	     (goto-char (point-min))
+	     (if (looking-at "Error: ")
+		 (error (concat "Error in ledger-add-transaction: " (buffer-string)))
+		 (buffer-string)))
+	   "\n"))
+	(progn
+	  (insert (car args) " \n\n")
+	  (end-of-line -1)))))
+
+
+(provide 'ldg-xact)
 
+;;; ldg-xact.el ends here
diff --git a/lisp/ledger.el b/lisp/ledger.el
deleted file mode 100644
index 4fc21d6a..00000000
--- a/lisp/ledger.el
+++ /dev/null
@@ -1,1340 +0,0 @@
-;;; ledger.el --- Helper code for use with the "ledger" command-line tool
-
-;; Copyright (C) 2003-2009 John Wiegley (johnw AT gnu DOT org)
-
-;; Emacs Lisp Archive Entry
-;; Filename: ledger.el
-;; Version: 2.6.3
-;; Date: Fri 18-Jul-2008
-;; Keywords: data
-;; Author: John Wiegley (johnw AT gnu DOT org)
-;; Maintainer: John Wiegley (johnw AT gnu DOT org)
-;; Description: Helper code for using my "ledger" command-line tool
-;; URL: http://www.newartisans.com/johnw/emacs.html
-;; Compatibility: Emacs22
-
-;; This file is not part of GNU Emacs.
-
-;; This is free software; you can redistribute it and/or modify it under
-;; the terms of the GNU General Public License as published by the Free
-;; Software Foundation; either version 2, or (at your option) any later
-;; version.
-;;
-;; This is distributed in the hope that it will be useful, but WITHOUT
-;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
-;; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
-;; for more details.
-;;
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING.  If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-;; MA 02111-1307, USA.
-
-;;; Commentary:
-
-;; To use this module: Load this file, open a ledger data file, and
-;; type M-x ledger-mode.  Once this is done, you can type:
-;;
-;;   C-c C-a       add a new entry, based on previous entries
-;;   C-c C-e       toggle cleared status of an entry
-;;   C-c C-y       set default year for entry mode
-;;   C-c C-m       set default month for entry mode
-;;   C-c C-r       reconcile uncleared entries related to an account
-;;   C-c C-o C-r   run a ledger report
-;;   C-C C-o C-g   goto the ledger report buffer
-;;   C-c C-o C-e   edit the defined ledger reports
-;;   C-c C-o C-s   save a report definition based on the current report
-;;   C-c C-o C-a   rerun a ledger report
-;;   C-c C-o C-k   kill the ledger report buffer
-;;
-;; In the reconcile buffer, use SPACE to toggle the cleared status of
-;; a transaction, C-x C-s to save changes (to the ledger file as
-;; well).
-;;
-;; The ledger reports command asks the user to select a report to run
-;; then creates a report buffer containing the results of running the
-;; associated command line.  Its' behavior is modified by a prefix
-;; argument which, when given, causes the generated command line that
-;; will be used to create the report to be presented for editing
-;; before the report is actually run.  Arbitrary unnamed command lines
-;; can be run by specifying an empty name for the report.  The command
-;; line used can later be named and saved for future use as a named
-;; report from the generated reports buffer.
-;;
-;; In a report buffer, the following keys are available:
-;;   (space)  scroll up
-;;   e        edit the defined ledger reports
-;;   s        save a report definition based on the current report
-;;   q        quit the report (return to ledger buffer)
-;;   r        redo the report
-;;   k        kill the report buffer
-
-(require 'esh-util)
-(require 'esh-arg)
-(require 'pcomplete)
-
-(defvar ledger-version "1.3"
-  "The version of ledger.el currently loaded")
-
-(defgroup ledger nil
-  "Interface to the Ledger command-line accounting program."
-  :group 'data)
-
-(defcustom ledger-binary-path "ledger"
-  "Path to the ledger executable."
-  :type 'file
-  :group 'ledger)
-
-(defcustom ledger-clear-whole-entries nil
-  "If non-nil, clear whole entries, not individual transactions."
-  :type 'boolean
-  :group 'ledger)
-
-(defcustom ledger-reports
-  '(("bal" "ledger -f %(ledger-file) bal")
-    ("reg" "ledger -f %(ledger-file) reg")
-    ("payee" "ledger -f %(ledger-file) reg -- %(payee)")
-    ("account" "ledger -f %(ledger-file) reg %(account)"))
-  "Definition of reports to run.
-
-Each element has the form (NAME CMDLINE).  The command line can
-contain format specifiers that are replaced with context sensitive
-information.  Format specifiers have the format '%(<name>)' where
-<name> is an identifier for the information to be replaced.  The
-`ledger-report-format-specifiers' alist variable contains a mapping
-from format specifier identifier to a lisp function that implements
-the substitution.  See the documentation of the individual functions
-in that variable for more information on the behavior of each
-specifier."
-  :type '(repeat (list (string :tag "Report Name")
-                       (string :tag "Command Line")))
-  :group 'ledger)
-
-(defcustom ledger-report-format-specifiers
-  '(("ledger-file" . ledger-report-ledger-file-format-specifier)
-    ("payee" . ledger-report-payee-format-specifier)
-    ("account" . ledger-report-account-format-specifier))
-  "Alist mapping ledger report format specifiers to implementing functions
-
-The function is called with no parameters and expected to return the
-text that should replace the format specifier."
-  :type 'alist
-  :group 'ledger)
-
-(defcustom ledger-default-acct-transaction-indent "    "
-  "Default indentation for account transactions in an entry."
-  :type 'string
-  :group 'ledger)
-
-(defvar bold 'bold)
-(defvar ledger-font-lock-keywords
-  '(("\\(	\\|  \\|^\\)\\(;.*\\)" 2 font-lock-comment-face)
-    ("^[0-9]+[-/.=][-/.=0-9]+\\s-+\\(([^)]+)\\s-+\\)?\\([^*].+?\\)\\(\\(        ;\\|  ;\\|$\\)\\)" 2 bold)
-    ;;("^[0-9]+[-/.=][-/.=0-9]+\\s-+\\(([^)]+)\\s-+\\)?\\([*].+?\\)\\(\\(       ;\\|  ;\\|$\\)\\)"
-    ;; 2 font-lock-type-face)
-    ("^\\s-+\\([*]\\s-*\\)?\\(\\([[(]\\)?\\([^*;]\\)+?\\(:\\|\\s-\\)[^]);
-	]+?\\([])]\\)?\\)\\(	\\|  \\|$\\)"
-     2 font-lock-keyword-face)
-    ("^\\([~=].+\\)" 1 font-lock-function-name-face)
-    ("^\\([A-Za-z]+ .+\\)" 1 font-lock-function-name-face))
-  "Expressions to highlight in Ledger mode.")
-
-(defsubst ledger-current-year ()
-  (format-time-string "%Y"))
-(defsubst ledger-current-month ()
-  (format-time-string "%m"))
-
-(defvar ledger-year (ledger-current-year)
-  "Start a ledger session with the current year, but make it
-customizable to ease retro-entry.")
-(defvar ledger-month (ledger-current-month)
-  "Start a ledger session with the current month, but make it
-customizable to ease retro-entry.")
-
-(defun ledger-iterate-entries (callback)
-  (goto-char (point-min))
-  (let* ((now (current-time))
-         (current-year (nth 5 (decode-time now))))
-    (while (not (eobp))
-      (when (looking-at
-             (concat "\\(Y\\s-+\\([0-9]+\\)\\|"
-                     "\\([0-9]\\{4\\}+\\)?[./]?"
-                     "\\([0-9]+\\)[./]\\([0-9]+\\)\\s-+"
-                     "\\(\\*\\s-+\\)?\\(.+\\)\\)"))
-        (let ((found (match-string 2)))
-          (if found
-              (setq current-year (string-to-number found))
-            (let ((start (match-beginning 0))
-                  (year (match-string 3))
-                  (month (string-to-number (match-string 4)))
-                  (day (string-to-number (match-string 5)))
-                  (mark (match-string 6))
-                  (desc (match-string 7)))
-              (if (and year (> (length year) 0))
-                  (setq year (string-to-number year)))
-              (funcall callback start
-                       (encode-time 0 0 0 day month
-                                    (or year current-year))
-                       mark desc)))))
-      (forward-line))))
-
-(defun ledger-time-less-p (t1 t2)
-  "Say whether time value T1 is less than time value T2."
-  (or (< (car t1) (car t2))
-      (and (= (car t1) (car t2))
-           (< (nth 1 t1) (nth 1 t2)))))
-
-(defun ledger-time-subtract (t1 t2)
-  "Subtract two time values.
-Return the difference in the format of a time value."
-  (let ((borrow (< (cadr t1) (cadr t2))))
-    (list (- (car t1) (car t2) (if borrow 1 0))
-          (- (+ (if borrow 65536 0) (cadr t1)) (cadr t2)))))
-
-(defun ledger-find-slot (moment)
-  (catch 'found
-    (ledger-iterate-entries
-     (function
-      (lambda (start date mark desc)
-        (if (ledger-time-less-p moment date)
-            (throw 'found t)))))))
-
-(defun ledger-add-entry (entry-text &optional insert-at-point)
-  (interactive
-   (list
-    (read-string "Entry: " (concat ledger-year "/" ledger-month "/"))))
-  (let* ((args (with-temp-buffer
-                 (insert entry-text)
-                 (eshell-parse-arguments (point-min) (point-max))))
-         (ledger-buf (current-buffer))
-         exit-code)
-    (unless insert-at-point
-      (let ((date (car args)))
-        (if (string-match "\\([0-9]+\\)/\\([0-9]+\\)/\\([0-9]+\\)" date)
-            (setq date
-                  (encode-time 0 0 0 (string-to-number (match-string 3 date))
-                               (string-to-number (match-string 2 date))
-                               (string-to-number (match-string 1 date)))))
-        (ledger-find-slot date)))
-    (save-excursion
-      (insert
-       (with-temp-buffer
-         (setq exit-code
-               (apply #'ledger-run-ledger ledger-buf "entry"
-                      (mapcar 'eval args)))
-         (goto-char (point-min))
-         (if (looking-at "Error: ")
-             (error (buffer-string))
-           (buffer-string)))
-       "\n"))))
-
-(defun ledger-current-entry-bounds ()
-  (save-excursion
-    (when (or (looking-at "^[0-9]")
-              (re-search-backward "^[0-9]" nil t))
-      (let ((beg (point)))
-        (while (not (eolp))
-          (forward-line))
-        (cons (copy-marker beg) (point-marker))))))
-
-(defun ledger-delete-current-entry ()
-  (interactive)
-  (let ((bounds (ledger-current-entry-bounds)))
-    (delete-region (car bounds) (cdr bounds))))
-
-(defun ledger-toggle-current-entry (&optional style)
-  (interactive)
-  (let (clear)
-    (save-excursion
-      (when (or (looking-at "^[0-9]")
-                (re-search-backward "^[0-9]" nil t))
-        (skip-chars-forward "0-9./=")
-        (delete-horizontal-space)
-        (if (member (char-after) '(?\* ?\!))
-            (progn
-              (delete-char 1)
-              (if (and style (eq style 'cleared))
-                  (insert " *")))
-          (if (and style (eq style 'pending))
-              (insert " ! ")
-            (insert " * "))
-          (setq clear t))))
-    clear))
-
-(defun ledger-move-to-next-field ()
-  (re-search-forward "\\(  \\|\t\\)" (line-end-position) t))
-
-(defun ledger-toggle-state (state &optional style)
-  (if (not (null state))
-      (if (and style (eq style 'cleared))
-          'cleared)
-    (if (and style (eq style 'pending))
-        'pending
-      'cleared)))
-
-(defun ledger-entry-state ()
-  (save-excursion
-    (when (or (looking-at "^[0-9]")
-              (re-search-backward "^[0-9]" nil t))
-      (skip-chars-forward "0-9./=")
-      (skip-syntax-forward " ")
-      (cond ((looking-at "!\\s-*") 'pending)
-            ((looking-at "\\*\\s-*") 'cleared)
-            (t nil)))))
-
-(defun ledger-transaction-state ()
-  (save-excursion
-    (goto-char (line-beginning-position))
-    (skip-syntax-forward " ")
-    (cond ((looking-at "!\\s-*") 'pending)
-          ((looking-at "\\*\\s-*") 'cleared)
-          (t (ledger-entry-state)))))
-
-(defun ledger-toggle-current-transaction (&optional style)
-  "Toggle the cleared status of the transaction under point.
-Optional argument STYLE may be `pending' or `cleared', depending
-on which type of status the caller wishes to indicate (default is
-`cleared').
-This function is rather complicated because it must preserve both
-the overall formatting of the ledger entry, as well as ensuring
-that the most minimal display format is used.  This could be
-achieved more certainly by passing the entry to ledger for
-formatting, but doing so causes inline math expressions to be
-dropped."
-  (interactive)
-  (let ((bounds (ledger-current-entry-bounds))
-        clear cleared)
-    ;; Uncompact the entry, to make it easier to toggle the
-    ;; transaction
-    (save-excursion
-      (goto-char (car bounds))
-      (skip-chars-forward "0-9./= \t")
-      (setq cleared (and (member (char-after) '(?\* ?\!))
-                         (char-after)))
-      (when cleared
-        (let ((here (point)))
-          (skip-chars-forward "*! ")
-          (let ((width (- (point) here)))
-            (when (> width 0)
-              (delete-region here (point))
-              (if (search-forward "  " (line-end-position) t)
-                  (insert (make-string width ? ))))))
-        (forward-line)
-        (while (looking-at "[ \t]")
-          (skip-chars-forward " \t")
-          (insert cleared " ")
-          (if (search-forward "  " (line-end-position) t)
-              (delete-char 2))
-          (forward-line))))
-    ;; Toggle the individual transaction
-    (save-excursion
-      (goto-char (line-beginning-position))
-      (when (looking-at "[ \t]")
-        (skip-chars-forward " \t")
-        (let ((here (point))
-              (cleared (member (char-after) '(?\* ?\!))))
-          (skip-chars-forward "*! ")
-          (let ((width (- (point) here)))
-            (when (> width 0)
-              (delete-region here (point))
-              (save-excursion
-                (if (search-forward "  " (line-end-position) t)
-                    (insert (make-string width ? ))))))
-          (let (inserted)
-            (if cleared
-                (if (and style (eq style 'cleared))
-                    (progn
-                      (insert "* ")
-                      (setq inserted t)))
-              (if (and style (eq style 'pending))
-                  (progn
-                    (insert "! ")
-                    (setq inserted t))
-                (progn
-                  (insert "* ")
-                  (setq inserted t))))
-            (if (and inserted
-                     (re-search-forward "\\(\t\\| [ \t]\\)"
-                                        (line-end-position) t))
-                (cond
-                 ((looking-at "\t")
-                  (delete-char 1))
-                 ((looking-at " [ \t]")
-                  (delete-char 2))
-                 ((looking-at " ")
-                  (delete-char 1))))
-            (setq clear inserted)))))
-    ;; Clean up the entry so that it displays minimally
-    (save-excursion
-      (goto-char (car bounds))
-      (forward-line)
-      (let ((first t)
-            (state ? )
-            (hetero nil))
-        (while (and (not hetero) (looking-at "[ \t]"))
-          (skip-chars-forward " \t")
-          (let ((cleared (if (member (char-after) '(?\* ?\!))
-                             (char-after)
-                           ? )))
-            (if first
-                (setq state cleared
-                      first nil)
-              (if (/= state cleared)
-                  (setq hetero t))))
-          (forward-line))
-        (when (and (not hetero) (/= state ? ))
-          (goto-char (car bounds))
-          (forward-line)
-          (while (looking-at "[ \t]")
-            (skip-chars-forward " \t")
-            (let ((here (point)))
-              (skip-chars-forward "*! ")
-              (let ((width (- (point) here)))
-                (when (> width 0)
-                  (delete-region here (point))
-                  (if (re-search-forward "\\(\t\\| [ \t]\\)"
-                                         (line-end-position) t)
-                      (insert (make-string width ? ))))))
-            (forward-line))
-          (goto-char (car bounds))
-          (skip-chars-forward "0-9./= \t")
-          (insert state " ")
-          (if (re-search-forward "\\(\t\\| [ \t]\\)"
-                                 (line-end-position) t)
-              (cond
-               ((looking-at "\t")
-                (delete-char 1))
-               ((looking-at " [ \t]")
-                (delete-char 2))
-               ((looking-at " ")
-                (delete-char 1)))))))
-    clear))
-
-(defun ledger-toggle-current (&optional style)
-  (interactive)
-  (if (or ledger-clear-whole-entries
-          (eq 'entry (ledger-thing-at-point)))
-      (progn
-        (save-excursion
-          (forward-line)
-          (goto-char (line-beginning-position))
-          (while (and (not (eolp))
-                      (save-excursion
-                        (not (eq 'entry (ledger-thing-at-point)))))
-            (if (looking-at "\\s-+[*!]")
-                (ledger-toggle-current-transaction nil))
-            (forward-line)
-            (goto-char (line-beginning-position))))
-        (ledger-toggle-current-entry style))
-    (ledger-toggle-current-transaction style)))
-
-(defvar ledger-mode-abbrev-table)
-
-;;;###autoload
-(define-derived-mode ledger-mode text-mode "Ledger"
-  "A mode for editing ledger data files.
-
-\\{ledger-mode-map}"
-  (set (make-local-variable 'comment-start) " ; ")
-  (set (make-local-variable 'comment-end) "")
-  (set (make-local-variable 'indent-tabs-mode) nil)
-
-  (if (boundp 'font-lock-defaults)
-      (set (make-local-variable 'font-lock-defaults)
-           '(ledger-font-lock-keywords nil t)))
-
-  (set (make-local-variable 'pcomplete-parse-arguments-function)
-       'ledger-parse-arguments)
-  (set (make-local-variable 'pcomplete-command-completion-function)
-       'ledger-complete-at-point)
-  (set (make-local-variable 'pcomplete-termination-string) "")
-
-  (let ((map (current-local-map)))
-    (define-key map [(control ?c) (control ?a)] 'ledger-add-entry)
-    (define-key map [(control ?c) (control ?d)] 'ledger-delete-current-entry)
-    (define-key map [(control ?c) (control ?y)] 'ledger-set-year)
-    (define-key map [(control ?c) (control ?m)] 'ledger-set-month)
-    (define-key map [(control ?c) (control ?c)] 'ledger-toggle-current)
-    (define-key map [(control ?c) (control ?e)] 'ledger-toggle-current-entry)
-    (define-key map [(control ?c) (control ?r)] 'ledger-reconcile)
-    (define-key map [(control ?c) (control ?s)] 'ledger-sort)
-    (define-key map [tab] 'pcomplete)
-    (define-key map [(control ?i)] 'pcomplete)
-    (define-key map [(control ?c) tab] 'ledger-fully-complete-entry)
-    (define-key map [(control ?c) (control ?i)] 'ledger-fully-complete-entry)
-    (define-key map [(control ?c) (control ?o) (control ?r)] 'ledger-report)
-    (define-key map [(control ?c) (control ?o) (control ?g)] 'ledger-report-goto)
-    (define-key map [(control ?c) (control ?o) (control ?a)] 'ledger-report-redo)
-    (define-key map [(control ?c) (control ?o) (control ?s)] 'ledger-report-save)
-    (define-key map [(control ?c) (control ?o) (control ?e)] 'ledger-report-edit)
-    (define-key map [(control ?c) (control ?o) (control ?k)] 'ledger-report-kill)))
-
-;; Reconcile mode
-
-(defvar ledger-buf nil)
-(defvar ledger-acct nil)
-
-(defun ledger-display-balance ()
-  (let ((buffer ledger-buf)
-        (account ledger-acct))
-    (with-temp-buffer
-      (let ((exit-code (ledger-run-ledger buffer "-C" "balance" account)))
-        (if (/= 0 exit-code)
-            (message "Error determining cleared balance")
-          (goto-char (1- (point-max)))
-          (goto-char (line-beginning-position))
-          (delete-horizontal-space)
-          (message "Cleared balance = %s"
-                   (buffer-substring-no-properties (point)
-                                                   (line-end-position))))))))
-
-(defun ledger-reconcile-toggle ()
-  (interactive)
-  (let ((where (get-text-property (point) 'where))
-        (account ledger-acct)
-        (inhibit-read-only t)
-        cleared)
-    (when (or (equal (car where) "<stdin>") (equal (car where) "/dev/stdin"))
-      (with-current-buffer ledger-buf
-          (goto-char (cdr where))
-        (setq cleared (ledger-toggle-current 'pending)))
-      (if cleared
-          (add-text-properties (line-beginning-position)
-                               (line-end-position)
-                               (list 'face 'bold))
-        (remove-text-properties (line-beginning-position)
-                                (line-end-position)
-                                (list 'face))))
-    (forward-line)))
-
-(defun ledger-reconcile-refresh ()
-  (interactive)
-  (let ((inhibit-read-only t)
-        (line (count-lines (point-min) (point))))
-    (erase-buffer)
-    (ledger-do-reconcile)
-    (set-buffer-modified-p t)
-    (goto-char (point-min))
-    (forward-line line)))
-
-(defun ledger-reconcile-refresh-after-save ()
-  (let ((buf (get-buffer "*Reconcile*")))
-    (if buf
-        (with-current-buffer buf
-          (ledger-reconcile-refresh)
-          (set-buffer-modified-p nil)))))
-
-(defun ledger-reconcile-add ()
-  (interactive)
-  (with-current-buffer ledger-buf
-    (call-interactively #'ledger-add-entry))
-  (ledger-reconcile-refresh))
-
-(defun ledger-reconcile-delete ()
-  (interactive)
-  (let ((where (get-text-property (point) 'where)))
-    (when (or (equal (car where) "<stdin>") (equal (car where) "/dev/stdin"))
-      (with-current-buffer ledger-buf
-        (goto-char (cdr where))
-        (ledger-delete-current-entry))
-      (let ((inhibit-read-only t))
-        (goto-char (line-beginning-position))
-        (delete-region (point) (1+ (line-end-position)))
-        (set-buffer-modified-p t)))))
-
-(defun ledger-reconcile-visit ()
-  (interactive)
-  (let ((where (get-text-property (point) 'where)))
-    (when (markerp (cdr where))
-      (switch-to-buffer-other-window ledger-buf)
-      (goto-char (cdr where)))))
-
-(defun ledger-reconcile-save ()
-  (interactive)
-  (with-current-buffer ledger-buf
-    (save-buffer))
-  (set-buffer-modified-p nil)
-  (ledger-display-balance))
-
-(defun ledger-reconcile-quit ()
-  (interactive)
-  (kill-buffer (current-buffer)))
-
-(defun ledger-reconcile-finish ()
-  (interactive)
-  (save-excursion
-    (goto-char (point-min))
-    (while (not (eobp))
-      (let ((where (get-text-property (point) 'where))
-            (face  (get-text-property (point) 'face)))
-        (if (and (eq face 'bold)
-                 (or (equal (car where) "<stdin>")
-                     (equal (car where) "/dev/stdin")))
-            (with-current-buffer ledger-buf
-              (goto-char (cdr where))
-              (ledger-toggle-current 'cleared))))
-      (forward-line 1)))
-  (ledger-reconcile-save))
-
-(defun ledger-do-reconcile ()
-  (let* ((buf ledger-buf)
-         (account ledger-acct)
-         (items
-          (with-temp-buffer
-            (let ((exit-code
-                   (ledger-run-ledger buf "--uncleared" "--real"
-                                      "emacs" account)))
-              (when (= 0 exit-code)
-                (goto-char (point-min))
-                (unless (eobp)
-                  (unless (looking-at "(")
-                    (error (buffer-string)))
-                  (read (current-buffer))))))))
-    (dolist (item items)
-      (let ((index 1))
-        (dolist (xact (nthcdr 5 item))
-          (let ((beg (point))
-                (where
-                 (with-current-buffer buf
-                   (cons
-                    (nth 0 item)
-                    (if ledger-clear-whole-entries
-                        (save-excursion
-                          (goto-line (nth 1 item))
-                          (point-marker))
-                      (save-excursion
-                        (goto-line (nth 0 xact))
-                        (point-marker)))))))
-            (insert (format "%s %-30s %-25s %15s\n"
-                            (format-time-string "%m/%d" (nth 2 item))
-                            (nth 4 item) (nth 1 xact) (nth 2 xact)))
-            (if (nth 3 xact)
-                (set-text-properties beg (1- (point))
-                                     (list 'face 'bold
-                                           'where where))
-              (set-text-properties beg (1- (point))
-                                   (list 'where where))))
-          (setq index (1+ index)))))
-    (goto-char (point-min))
-    (set-buffer-modified-p nil)
-    (toggle-read-only t)))
-
-(defun ledger-reconcile (account)
-  (interactive "sAccount to reconcile: ")
-  (let ((buf (current-buffer))
-        (rbuf (get-buffer "*Reconcile*")))
-    (if rbuf
-        (kill-buffer rbuf))
-    (add-hook 'after-save-hook 'ledger-reconcile-refresh-after-save)
-    (with-current-buffer
-        (pop-to-buffer (get-buffer-create "*Reconcile*"))
-      (ledger-reconcile-mode)
-      (set (make-local-variable 'ledger-buf) buf)
-      (set (make-local-variable 'ledger-acct) account)
-      (ledger-do-reconcile))))
-
-(defvar ledger-reconcile-mode-abbrev-table)
-
-(defvar ledger-reconcile-mode-map
-  (let ((map (make-sparse-keymap)))
-    (define-key map [(control ?m)] 'ledger-reconcile-visit)
-    (define-key map [return] 'ledger-reconcile-visit)
-    (define-key map [(control ?c) (control ?c)] 'ledger-reconcile-finish)
-    (define-key map [(control ?x) (control ?s)] 'ledger-reconcile-save)
-    (define-key map [(control ?l)] 'ledger-reconcile-refresh)
-    (define-key map [? ] 'ledger-reconcile-toggle)
-    (define-key map [?a] 'ledger-reconcile-add)
-    (define-key map [?d] 'ledger-reconcile-delete)
-    (define-key map [?n] 'next-line)
-    (define-key map [?p] 'previous-line)
-    (define-key map [?s] 'ledger-reconcile-save)
-    (define-key map [?q] 'ledger-reconcile-quit)
-    map))
-
-(define-derived-mode ledger-reconcile-mode text-mode "Reconcile"
-  "A mode for reconciling ledger entries.
-
-\\{ledger-reconcile-mode-map}")
-
-;; Context sensitivity
-
-(defconst ledger-line-config
-  '((entry
-     (("^\\(\\([0-9][0-9][0-9][0-9]/\\)?[01]?[0-9]/[0123]?[0-9]\\)[ \t]+\\(\\([!*]\\)[ \t]\\)?[ \t]*\\((\\(.*\\))\\)?[ \t]*\\(.*?\\)[ \t]*;\\(.*\\)[ \t]*$"
-       (date nil status nil nil code payee comment))
-      ("^\\(\\([0-9][0-9][0-9][0-9]/\\)?[01]?[0-9]/[0123]?[0-9]\\)[ \t]+\\(\\([!*]\\)[ \t]\\)?[ \t]*\\((\\(.*\\))\\)?[ \t]*\\(.*\\)[ \t]*$"
-       (date nil status nil nil code payee))))
-    (acct-transaction
-     (("\\(^[ \t]+\\)\\(.*?\\)[ \t]+\\([$]\\)\\(-?[0-9]*\\(\\.[0-9]*\\)?\\)[ \t]*;[ \t]*\\(.*?\\)[ \t]*$"
-       (indent account commodity amount nil comment))
-      ("\\(^[ \t]+\\)\\(.*?\\)[ \t]+\\([$]\\)\\(-?[0-9]*\\(\\.[0-9]*\\)?\\)[ \t]*$"
-       (indent account commodity amount nil))
-      ("\\(^[ \t]+\\)\\(.*?\\)[ \t]+\\(-?[0-9]+\\(\\.[0-9]*\\)?\\)[ \t]+\\(.*?\\)[ \t]*;[ \t]*\\(.*?\\)[ \t]*$"
-       (indent account amount nil commodity comment))
-      ("\\(^[ \t]+\\)\\(.*?\\)[ \t]+\\(-?[0-9]+\\(\\.[0-9]*\\)?\\)[ \t]+\\(.*?\\)[ \t]*$"
-       (indent account amount nil commodity))
-      ("\\(^[ \t]+\\)\\(.*?\\)[ \t]+\\(-?\\(\\.[0-9]*\\)\\)[ \t]+\\(.*?\\)[ \t]*;[ \t]*\\(.*?\\)[ \t]*$"
-       (indent account amount nil commodity comment))
-      ("\\(^[ \t]+\\)\\(.*?\\)[ \t]+\\(-?\\(\\.[0-9]*\\)\\)[ \t]+\\(.*?\\)[ \t]*$"
-       (indent account amount nil commodity))
-      ("\\(^[ \t]+\\)\\(.*?\\)[ \t]*;[ \t]*\\(.*?\\)[ \t]*$"
-       (indent account comment))
-      ("\\(^[ \t]+\\)\\(.*?\\)[ \t]*$"
-       (indent account))))))
-
-(defun ledger-extract-context-info (line-type pos)
-  "Get context info for current line.
-
-Assumes point is at beginning of line, and the pos argument specifies
-where the \"users\" point was."
-  (let ((linfo (assoc line-type ledger-line-config))
-        found field fields)
-    (dolist (re-info (nth 1 linfo))
-      (let ((re (nth 0 re-info))
-            (names (nth 1 re-info)))
-        (unless found
-          (when (looking-at re)
-            (setq found t)
-            (dotimes (i (length names))
-              (when (nth i names)
-                (setq fields (append fields
-                                     (list
-                                      (list (nth i names)
-                                            (match-string-no-properties (1+ i))
-                                            (match-beginning (1+ i))))))))
-            (dolist (f fields)
-              (and (nth 1 f)
-                   (>= pos (nth 2 f))
-                   (setq field (nth 0 f))))))))
-    (list line-type field fields)))
-
-(defun ledger-context-at-point ()
-  "Return a list describing the context around point.
-
-The contents of the list are the line type, the name of the field
-point containing point, and for selected line types, the content of
-the fields in the line in a association list."
-  (let ((pos (point)))
-    (save-excursion
-      (beginning-of-line)
-      (let ((first-char (char-after)))
-        (cond ((equal (point) (line-end-position))
-               '(empty-line nil nil))
-              ((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 'entry pos))
-              ((equal first-char ?\=)
-               '(automated-entry nil nil))
-              ((equal first-char ?\~)
-               '(period-entry nil nil))
-              ((equal first-char ?\!)
-               '(command-directive))
-              ((equal first-char ?\;)
-               '(comment nil nil))
-              ((equal first-char ?Y)
-               '(default-year nil nil))
-              ((equal first-char ?P)
-               '(commodity-price nil nil))
-              ((equal first-char ?N)
-               '(price-ignored-commodity nil nil))
-              ((equal first-char ?D)
-               '(default-commodity nil nil))
-              ((equal first-char ?C)
-               '(commodity-conversion nil nil))
-              ((equal first-char ?i)
-               '(timeclock-i nil nil))
-              ((equal first-char ?o)
-               '(timeclock-o nil nil))
-              ((equal first-char ?b)
-               '(timeclock-b nil nil))
-              ((equal first-char ?h)
-               '(timeclock-h  nil nil))
-              (t
-               '(unknown nil nil)))))))
-
-(defun ledger-context-other-line (offset)
-  "Return a list describing context of line offset for existing position.
-
-Offset can be positive or negative.  If run out of buffer before reaching
-specified line, returns nil."
-  (save-excursion
-    (let ((left (forward-line offset)))
-      (if (not (equal left 0))
-          nil
-        (ledger-context-at-point)))))
-
-(defun ledger-context-line-type (context-info)
-  (nth 0 context-info))
-
-(defun ledger-context-current-field (context-info)
-  (nth 1 context-info))
-
-(defun ledger-context-field-info (context-info field-name)
-  (assoc field-name (nth 2 context-info)))
-
-(defun ledger-context-field-present-p (context-info field-name)
-  (not (null (ledger-context-field-info context-info field-name))))
-
-(defun ledger-context-field-value (context-info field-name)
-  (nth 1 (ledger-context-field-info context-info field-name)))
-
-(defun ledger-context-field-position (context-info field-name)
-  (nth 2 (ledger-context-field-info context-info field-name)))
-
-(defun ledger-context-field-end-position (context-info field-name)
-  (+ (ledger-context-field-position context-info field-name)
-     (length (ledger-context-field-value context-info field-name))))
-
-(defun ledger-context-goto-field-start (context-info field-name)
-  (goto-char (ledger-context-field-position context-info field-name)))
-
-(defun ledger-context-goto-field-end (context-info field-name)
-  (goto-char (ledger-context-field-end-position context-info field-name)))
-
-(defun ledger-entry-payee ()
-  "Returns the payee of the entry containing point or nil."
-  (let ((i 0))
-    (while (eq (ledger-context-line-type (ledger-context-other-line i)) 'acct-transaction)
-      (setq i (- i 1)))
-    (let ((context-info (ledger-context-other-line i)))
-      (if (eq (ledger-context-line-type context-info) 'entry)
-          (ledger-context-field-value context-info 'payee)
-        nil))))
-
-;; Ledger report mode
-
-(defvar ledger-report-buffer-name "*Ledger Report*")
-
-(defvar ledger-report-name nil)
-(defvar ledger-report-cmd nil)
-(defvar ledger-report-name-prompt-history nil)
-(defvar ledger-report-cmd-prompt-history nil)
-(defvar ledger-original-window-cfg nil)
-
-(defvar ledger-report-mode-abbrev-table)
-
-(defvar ledger-report-mode-map
-  (let ((map (make-sparse-keymap)))
-    (define-key map [? ] 'scroll-up)
-    (define-key map [backspace] 'scroll-down)
-    (define-key map [?r] 'ledger-report-redo)
-    (define-key map [?s] 'ledger-report-save)
-    (define-key map [?k] 'ledger-report-kill)
-    (define-key map [?e] 'ledger-report-edit)
-    (define-key map [?q] 'ledger-report-quit)
-    (define-key map [(control ?c) (control ?l) (control ?r)]
-      'ledger-report-redo)
-    (define-key map [(control ?c) (control ?l) (control ?S)]
-      'ledger-report-save)
-    (define-key map [(control ?c) (control ?l) (control ?k)]
-      'ledger-report-kill)
-    (define-key map [(control ?c) (control ?l) (control ?e)]
-      'ledger-report-edit)
-    map))
-
-(define-derived-mode ledger-report-mode text-mode "Ledger-Report"
-  "A mode for viewing ledger reports.")
-
-(defun ledger-report-read-name ()
-  "Read the name of a ledger report to use, with completion.
-
-The empty string and unknown names are allowed."
-  (completing-read "Report name: "
-                   ledger-reports nil nil nil
-                   'ledger-report-name-prompt-history nil))
-
-(defun ledger-report (report-name edit)
-  "Run a user-specified report from `ledger-reports'.
-
-Prompts the user for the name of the report to run.  If no name is
-entered, the user will be prompted for a command line to run.  The
-command line specified or associated with the selected report name
-is run and the output is made available in another buffer for viewing.
-If a prefix argument is given and the user selects a valid report
-name, the user is prompted with the corresponding command line for
-editing before the command is run.
-
-The output buffer will be in `ledger-report-mode', which defines
-commands for saving a new named report based on the command line
-used to generate the buffer, navigating the buffer, etc."
-  (interactive
-   (progn
-     (when (and (buffer-modified-p)
-                (y-or-n-p "Buffer modified, save it? "))
-       (save-buffer))
-     (let ((rname (ledger-report-read-name))
-           (edit (not (null current-prefix-arg))))
-       (list rname edit))))
-  (let ((buf (current-buffer))
-        (rbuf (get-buffer ledger-report-buffer-name))
-        (wcfg (current-window-configuration)))
-    (if rbuf
-        (kill-buffer rbuf))
-    (with-current-buffer
-        (pop-to-buffer (get-buffer-create ledger-report-buffer-name))
-      (ledger-report-mode)
-      (set (make-local-variable 'ledger-buf) buf)
-      (set (make-local-variable 'ledger-report-name) report-name)
-      (set (make-local-variable 'ledger-original-window-cfg) wcfg)
-      (ledger-do-report (ledger-report-cmd report-name edit))
-      (shrink-window-if-larger-than-buffer)
-      (set-buffer-modified-p nil)
-      (setq buffer-read-only t)
-      (message "q to quit; r to redo; e to edit; k to kill; s to save; SPC and DEL to scroll"))))
-
-(defun string-empty-p (s)
-  "Check for the empty string."
-  (string-equal "" s))
-
-(defun ledger-report-name-exists (name)
-  "Check to see if the given report name exists.
-
-If name exists, returns the object naming the report, otherwise returns nil."
-  (unless (string-empty-p name)
-    (car (assoc name ledger-reports))))
-
-(defun ledger-reports-add (name cmd)
-  "Add a new report to `ledger-reports'."
-  (setq ledger-reports (cons (list name cmd) ledger-reports)))
-
-(defun ledger-reports-custom-save ()
-  "Save the `ledger-reports' variable using the customize framework."
-  (customize-save-variable 'ledger-reports ledger-reports))
-
-(defun ledger-report-read-command (report-cmd)
-  "Read the command line to create a report."
-  (read-from-minibuffer "Report command line: "
-                        (if (null report-cmd) "ledger " report-cmd)
-                        nil nil 'ledger-report-cmd-prompt-history))
-
-(defun ledger-report-ledger-file-format-specifier ()
-  "Substitute the full path to master or current ledger file
-
-The master file name is determined by the ledger-master-file buffer-local
-variable which can be set using file variables.  If it is set, it is used,
-otherwise the current buffer file is used."
-  (ledger-master-file))
-
-(defun ledger-read-string-with-default (prompt default)
-  (let ((default-prompt (concat prompt
-                                (if default
-                                    (concat " (" default "): ")
-                                  ": "))))
-    (read-string default-prompt nil nil default)))
-
-(defun ledger-report-payee-format-specifier ()
-  "Substitute a payee name
-
-The user is prompted to enter a payee and that is substitued.  If
-point is in an entry, the payee for that entry is used as the
-default."
-  ;; It is intended copmletion should be available on existing
-  ;; payees, but the list of possible completions needs to be
-  ;; developed to allow this.
-  (ledger-read-string-with-default "Payee" (regexp-quote (ledger-entry-payee))))
-
-(defun ledger-report-account-format-specifier ()
-  "Substitute an account name
-
-The user is prompted to enter an account name, which can be any
-regular expression identifying an account.  If point is on an account
-transaction line for an entry, the full account name on that line is
-the default."
-  ;; It is intended completion should be available on existing account
-  ;; names, but it remains to be implemented.
-  (let* ((context (ledger-context-at-point))
-         (default
-          (if (eq (ledger-context-line-type context) 'acct-transaction)
-              (regexp-quote (ledger-context-field-value context 'account))
-            nil)))
-    (ledger-read-string-with-default "Account" default)))
-
-(defun ledger-report-expand-format-specifiers (report-cmd)
-  (let ((expanded-cmd report-cmd))
-    (while (string-match "%(\\([^)]*\\))" expanded-cmd)
-      (let* ((specifier (match-string 1 expanded-cmd))
-             (f (cdr (assoc specifier ledger-report-format-specifiers))))
-        (if f
-            (setq expanded-cmd (replace-match
-                                (save-match-data
-                                  (with-current-buffer ledger-buf
-                                    (shell-quote-argument (funcall f))))
-                                t t expanded-cmd))
-          (progn
-            (set-window-configuration ledger-original-window-cfg)
-            (error "Invalid ledger report format specifier '%s'" specifier)))))
-    expanded-cmd))
-
-(defun ledger-report-cmd (report-name edit)
-  "Get the command line to run the report."
-  (let ((report-cmd (car (cdr (assoc report-name ledger-reports)))))
-    ;; logic for substitution goes here
-    (when (or (null report-cmd) edit)
-      (setq report-cmd (ledger-report-read-command report-cmd)))
-    (setq report-cmd (ledger-report-expand-format-specifiers report-cmd))
-    (set (make-local-variable 'ledger-report-cmd) report-cmd)
-    (or (string-empty-p report-name)
-        (ledger-report-name-exists report-name)
-        (ledger-reports-add report-name report-cmd)
-        (ledger-reports-custom-save))
-    report-cmd))
-
-(defun ledger-do-report (cmd)
-  "Run a report command line."
-  (goto-char (point-min))
-  (insert (format "Report: %s\n" ledger-report-name)
-          (format "Command: %s\n" cmd)
-          (make-string (- (window-width) 1) ?=)
-          "\n")
-  (shell-command cmd t nil))
-
-(defun ledger-report-goto ()
-  "Goto the ledger report buffer."
-  (interactive)
-  (let ((rbuf (get-buffer ledger-report-buffer-name)))
-    (if (not rbuf)
-        (error "There is no ledger report buffer"))
-    (pop-to-buffer rbuf)
-    (shrink-window-if-larger-than-buffer)))
-
-(defun ledger-report-redo ()
-  "Redo the report in the current ledger report buffer."
-  (interactive)
-  (ledger-report-goto)
-  (setq buffer-read-only nil)
-  (erase-buffer)
-  (ledger-do-report ledger-report-cmd)
-  (setq buffer-read-only nil))
-
-(defun ledger-report-quit ()
-  "Quit the ledger report buffer by burying it."
-  (interactive)
-  (ledger-report-goto)
-  (set-window-configuration ledger-original-window-cfg)
-  (bury-buffer (get-buffer ledger-report-buffer-name)))
-
-(defun ledger-report-kill ()
-  "Kill the ledger report buffer."
-  (interactive)
-  (ledger-report-quit)
-  (kill-buffer (get-buffer ledger-report-buffer-name)))
-
-(defun ledger-report-edit ()
-  "Edit the defined ledger reports."
-  (interactive)
-  (customize-variable 'ledger-reports))
-
-(defun ledger-report-read-new-name ()
-  "Read the name for a new report from the minibuffer."
-  (let ((name ""))
-    (while (string-empty-p name)
-      (setq name (read-from-minibuffer "Report name: " nil nil nil
-                                       'ledger-report-name-prompt-history)))
-    name))
-
-(defun ledger-report-save ()
-  "Save the current report command line as a named report."
-  (interactive)
-  (ledger-report-goto)
-  (let (existing-name)
-    (when (string-empty-p ledger-report-name)
-      (setq ledger-report-name (ledger-report-read-new-name)))
-
-    (while (setq existing-name (ledger-report-name-exists ledger-report-name))
-      (cond ((y-or-n-p (format "Overwrite existing report named '%s' "
-                               ledger-report-name))
-             (when (string-equal
-                    ledger-report-cmd
-                    (car (cdr (assq existing-name ledger-reports))))
-               (error "Current command is identical to existing saved one"))
-             (setq ledger-reports
-                   (assq-delete-all existing-name ledger-reports)))
-            (t
-             (setq ledger-report-name (ledger-report-read-new-name)))))
-
-    (ledger-reports-add ledger-report-name ledger-report-cmd)
-    (ledger-reports-custom-save)))
-
-;; 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))
-           'entry)
-          ((looking-at "^\\s-+\\([*!]\\s-+\\)?[[(]?\\(.\\)")
-           (goto-char (match-beginning 2))
-           'transaction)
-          ((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
-                 (cons (ledger-thing-at-point) (point))))
-         (begin (cdr info))
-         (end (point))
-         begins args)
-    (save-excursion
-      (goto-char begin)
-      (when (< (point) end)
-        (skip-chars-forward " \t\n")
-        (setq begins (cons (point) begins))
-        (setq args (cons (buffer-substring-no-properties
-                          (car begins) end)
-                         args)))
-      (cons (reverse args) (reverse begins)))))
-
-(defun ledger-entries ()
-  (let ((origin (point))
-        entries-list)
-    (save-excursion
-      (goto-char (point-min))
-      (while (re-search-forward
-              (concat "^[0-9/.=-]+\\(\\s-+\\*\\)?\\(\\s-+(.*?)\\)?\\s-+"
-                      "\\(.+?\\)\\(\t\\|\n\\| [ \t]\\)") nil t)
-        (unless (and (>= origin (match-beginning 0))
-                     (< origin (match-end 0)))
-          (setq entries-list (cons (match-string-no-properties 3)
-                                   entries-list)))))
-    (pcomplete-uniqify-list (nreverse entries-list))))
-
-(defvar ledger-account-tree nil)
-
-(defun ledger-find-accounts ()
-  (let ((origin (point)) account-path elements)
-    (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)))
-                (if entry
-                    (setq root (cdr entry))
-                  (setq entry (cons (car elements) (list t)))
-                  (nconc root (list entry))
-                  (setq root (cdr entry))))
-              (setq elements (cdr elements)))))))))
-
-(defun ledger-accounts ()
-  (ledger-find-accounts)
-  (let* ((current (caar (ledger-parse-arguments)))
-         (elements (and current (split-string current ":")))
-         (root ledger-account-tree)
-         (prefix nil))
-    (while (cdr elements)
-      (let ((entry (assoc (car elements) root)))
-        (if entry
-            (setq prefix (concat prefix (and prefix ":")
-                                 (car elements))
-                  root (cdr entry))
-          (setq root nil elements nil)))
-      (setq elements (cdr elements)))
-    (and root
-         (sort
-          (mapcar (function
-                   (lambda (x)
-                     (let ((term (if prefix
-                                     (concat prefix ":" (car x))
-                                   (car x))))
-                       (if (> (length (cdr x)) 1)
-                           (concat term ":")
-                         term))))
-                  (cdr root))
-          'string-lessp))))
-
-(defun ledger-complete-at-point ()
-  "Do appropriate completion for the thing at point"
-  (interactive)
-  (while (pcomplete-here
-          (if (eq (save-excursion
-                    (ledger-thing-at-point)) 'entry)
-              (if (null current-prefix-arg)
-                  (ledger-entries)  ; this completes against entry names
-                (progn
-                  (let ((text (buffer-substring (line-beginning-position)
-                                                (line-end-position))))
-                    (delete-region (line-beginning-position)
-                                   (line-end-position))
-                    (condition-case err
-                        (ledger-add-entry text t)
-                      ((error)
-                       (insert text))))
-                  (forward-line)
-                  (goto-char (line-end-position))
-                  (search-backward ";" (line-beginning-position) t)
-                  (skip-chars-backward " \t0123456789.,")
-                  (throw 'pcompleted t)))
-            (ledger-accounts)))))
-
-(defun ledger-fully-complete-entry ()
-  "Do appropriate completion for the thing at point"
-  (interactive)
-  (let ((name (caar (ledger-parse-arguments)))
-        xacts)
-    (save-excursion
-      (when (eq 'entry (ledger-thing-at-point))
-        (when (re-search-backward
-               (concat "^[0-9/.=-]+\\(\\s-+\\*\\)?\\(\\s-+(.*?)\\)?\\s-+"
-                       (regexp-quote name) "\\(\t\\|\n\\| [ \t]\\)") nil t)
-          (forward-line)
-          (while (looking-at "^\\s-+")
-            (setq xacts (cons (buffer-substring-no-properties
-                               (line-beginning-position)
-                               (line-end-position))
-                              xacts))
-            (forward-line))
-          (setq xacts (nreverse xacts)))))
-    (when xacts
-      (save-excursion
-        (insert ?\n)
-        (while xacts
-          (insert (car xacts) ?\n)
-          (setq xacts (cdr xacts))))
-      (forward-line)
-      (goto-char (line-end-position))
-      (if (re-search-backward "\\(\t\\| [ \t]\\)" nil t)
-          (goto-char (match-end 0))))))
-
-;; A sample function for $ users
-
-(defun ledger-next-amount (&optional end)
-  (when (re-search-forward "\\(  \\|\t\\| \t\\)[ \t]*-?\\([A-Z$€£]+ *\\)?\\(-?[0-9,]+?\\)\\(.[0-9]+\\)?\\( *[A-Z$€£]+\\)?\\([ \t]*@@?[^\n;]+?\\)?\\([ \t]+;.+?\\)?$" (marker-position end) t)
-    (goto-char (match-beginning 0))
-    (skip-syntax-forward " ")
-    (- (or (match-end 4)
-           (match-end 3)) (point))))
-
-(defun ledger-align-amounts (&optional column)
-  "Align amounts in the current region.
-This is done so that the last digit falls in COLUMN, which defaults to 52."
-  (interactive "p")
-  (if (or (null column) (= column 1))
-      (setq column 52))
-  (save-excursion
-    (let* ((mark-first (< (mark) (point)))
-           (begin (if mark-first (mark) (point)))
-           (end (if mark-first (point-marker) (mark-marker)))
-           offset)
-      (goto-char begin)
-      (while (setq offset (ledger-next-amount end))
-        (let ((col (current-column))
-              (target-col (- column offset))
-              adjust)
-          (setq adjust (- target-col col))
-          (if (< col target-col)
-              (insert (make-string (- target-col col) ? ))
-            (move-to-column target-col)
-            (if (looking-back "  ")
-                (delete-char (- col target-col))
-              (skip-chars-forward "^ \t")
-              (delete-horizontal-space)
-              (insert "  ")))
-          (forward-line))))))
-
-(defalias 'ledger-align-dollars 'ledger-align-amounts)
-
-;; A sample entry sorting function, which works if entry dates are of
-;; the form YYYY/mm/dd.
-
-(defun ledger-sort ()
-  (interactive)
-  (save-excursion
-    (goto-char (point-min))
-    (sort-subr
-     nil
-     (function
-      (lambda ()
-        (if (re-search-forward
-             (concat "^[0-9/.=-]+\\(\\s-+\\*\\)?\\(\\s-+(.*?)\\)?\\s-+"
-                     "\\(.+?\\)\\(\t\\|\n\\| [ \t]\\)") nil t)
-            (goto-char (match-beginning 0))
-          (goto-char (point-max)))))
-     (function
-      (lambda ()
-        (forward-paragraph))))))
-
-;; General helper functions
-
-(defvar ledger-delete-after nil)
-
-(defun ledger-run-ledger (buffer &rest args)
-  "run ledger with supplied arguments"
-  ;; Let's try again, just in case they moved it while we were sleeping.
-  (cond
-   ((null ledger-binary-path)
-    (error "The variable `ledger-binary-path' has not been set"))
-   (t
-    (let ((buf (current-buffer)))
-      (with-current-buffer buffer
-        (let ((coding-system-for-write 'utf-8)
-              (coding-system-for-read 'utf-8))
-          (apply #'call-process-region
-                 (append (list (point-min) (point-max)
-                               ledger-binary-path ledger-delete-after
-                               buf nil "-f" "-")
-                         args))))))))
-
-(defun ledger-run-ledger-and-delete (buffer &rest args)
-  (let ((ledger-delete-after t))
-    (apply #'ledger-run-ledger buffer args)))
-
-(defun ledger-set-year (newyear)
-  "Set ledger's idea of the current year to the prefix argument."
-  (interactive "p")
-  (if (= newyear 1)
-      (setq ledger-year (read-string "Year: " (ledger-current-year)))
-    (setq ledger-year (number-to-string newyear))))
-
-(defun ledger-set-month (newmonth)
-  "Set ledger's idea of the current month to the prefix argument."
-  (interactive "p")
-  (if (= newmonth 1)
-      (setq ledger-month (read-string "Month: " (ledger-current-month)))
-    (setq ledger-month (format "%02d" newmonth))))
-
-(defvar ledger-master-file nil)
-
-(defun ledger-master-file ()
-  "Return the master file for a ledger file.
-
-The master file is either the file for the current ledger buffer or the
-file specified by the buffer-local variable ledger-master-file.  Typically
-this variable would be set in a file local variable comment block at the
-end of a ledger file which is included in some other file."
-  (if ledger-master-file
-      (expand-file-name ledger-master-file)
-    (buffer-file-name)))
-
-(easy-menu-define ledger-menu ledger-mode-map 
-  "Ledger menu"
-  '("Ledger"
-    ["New entry" ledger-add-entry t]
-    ["Toggle cleared status of current entry" ledger-toggle-current-entry t]
-    ["Set default year for entry" ledger-set-year t]
-    ["Set default month for entry" ledger-set-month t]
-    "--"
-    ["Reconcile uncleared entries for account" ledger-reconcile t]
-    "--"
-    "Reports"
-    ["Run a report" ledger-report t]
-    ["Go to report buffer" ledger-report-goto t]
-    ["Edit defined reports" ledger-report-edit t]
-    ["Save report definition" ledger-report-save t]
-    ["Re-run ledger report" ledger-report-redo t]
-    ["Kill report buffer" ledger-report-kill t]))
-
-(provide 'ledger)
-
-;;; ledger.el ends here
diff --git a/lisp/timeclock.el b/lisp/timeclock.el
deleted file mode 100644
index 2cafa8eb..00000000
--- a/lisp/timeclock.el
+++ /dev/null
@@ -1,1362 +0,0 @@
-;;; timeclock.el --- mode for keeping track of how much you work
-
-;; Copyright (C) 1999, 2000, 2001, 2003, 2004 Free Software Foundation, Inc.
-
-;; Author: John Wiegley <johnw@gnu.org>
-;; Created: 25 Mar 1999
-;; Version: 2.6
-;; Keywords: calendar data
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING.  If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-;;; Commentary:
-
-;; This mode is for keeping track of time intervals.  You can use it
-;; for whatever purpose you like, but the typical scenario is to keep
-;; track of how much time you spend working on certain projects.
-;;
-;; Use `timeclock-in' when you start on a project, and `timeclock-out'
-;; when you're done.  Once you've collected some data, you can use
-;; `timeclock-workday-remaining' to see how much time is left to be
-;; worked today (where `timeclock-workday' specifies the length of the
-;; working day), and `timeclock-when-to-leave' to calculate when you're free.
-
-;; You'll probably want to bind the timeclock commands to some handy
-;; keystrokes.  At the moment, C-x t is unused:
-;;
-;;   (require 'timeclock)
-;;
-;;   (define-key ctl-x-map "ti" 'timeclock-in)
-;;   (define-key ctl-x-map "to" 'timeclock-out)
-;;   (define-key ctl-x-map "tc" 'timeclock-change)
-;;   (define-key ctl-x-map "tr" 'timeclock-reread-log)
-;;   (define-key ctl-x-map "tu" 'timeclock-update-modeline)
-;;   (define-key ctl-x-map "tw" 'timeclock-when-to-leave-string)
-
-;; If you want Emacs to display the amount of time "left" to your
-;; workday in the modeline, you can either set the value of
-;; `timeclock-modeline-display' to t using M-x customize, or you
-;; can add this code to your .emacs file:
-;;
-;;   (require 'timeclock)
-;;   (timeclock-modeline-display)
-;;
-;; To cancel this modeline display at any time, just call
-;; `timeclock-modeline-display' again.
-
-;; You may also want Emacs to ask you before exiting, if you are
-;; currently working on a project.  This can be done either by setting
-;; `timeclock-ask-before-exiting' to t using M-x customize (this is
-;; the default), or by adding the following to your .emacs file:
-;;
-;;   (add-hook 'kill-emacs-query-functions 'timeclock-query-out)
-
-;; NOTE: If you change your .timelog file without using timeclock's
-;; functions, or if you change the value of any of timeclock's
-;; customizable variables, you should run the command
-;; `timeclock-reread-log'.  This will recompute any discrepancies in
-;; your average working time, and will make sure that the various
-;; display functions return the correct value.
-
-;;; History:
-
-;;; Code:
-
-(defgroup timeclock nil
-  "Keeping track time of the time that gets spent."
-  :group 'data)
-
-;;; User Variables:
-
-(defcustom timeclock-file (convert-standard-filename "~/.timelog")
-  "*The file used to store timeclock data in."
-  :type 'file
-  :group 'timeclock)
-
-(defcustom timeclock-workday (* 8 60 60)
-  "*The length of a work period."
-  :type 'integer
-  :group 'timeclock)
-
-(defcustom timeclock-relative t
-  "*Whether to maken reported time relative to `timeclock-workday'.
-For example, if the length of a normal workday is eight hours, and you
-work four hours on Monday, then the amount of time \"remaining\" on
-Tuesday is twelve hours -- relative to an averaged work period of
-eight hours -- or eight hours, non-relative.  So relative time takes
-into account any discrepancy of time under-worked or over-worked on
-previous days.  This only affects the timeclock modeline display."
-  :type 'boolean
-  :group 'timeclock)
-
-(defcustom timeclock-get-project-function 'timeclock-ask-for-project
-  "*The function used to determine the name of the current project.
-When clocking in, and no project is specified, this function will be
-called to determine what is the current project to be worked on.
-If this variable is nil, no questions will be asked."
-  :type 'function
-  :group 'timeclock)
-
-(defcustom timeclock-get-reason-function 'timeclock-ask-for-reason
-  "*A function used to determine the reason for clocking out.
-When clocking out, and no reason is specified, this function will be
-called to determine what is the reason.
-If this variable is nil, no questions will be asked."
-  :type 'function
-  :group 'timeclock)
-
-(defcustom timeclock-get-workday-function nil
-  "*A function used to determine the length of today's workday.
-The first time that a user clocks in each day, this function will be
-called to determine what is the length of the current workday.  If
-the return value is nil, or equal to `timeclock-workday', nothing special
-will be done.  If it is a quantity different from `timeclock-workday',
-however, a record will be output to the timelog file to note the fact that
-that day has a length that is different from the norm."
-  :type '(choice (const nil) function)
-  :group 'timeclock)
-
-(defcustom timeclock-ask-before-exiting t
-  "*If non-nil, ask if the user wants to clock out before exiting Emacs.
-This variable only has effect if set with \\[customize]."
-  :set (lambda (symbol value)
-         (if value
-             (add-hook 'kill-emacs-query-functions 'timeclock-query-out)
-           (remove-hook 'kill-emacs-query-functions 'timeclock-query-out))
-         (setq timeclock-ask-before-exiting value))
-  :type 'boolean
-  :group 'timeclock)
-
-(defvar timeclock-update-timer nil
-  "The timer used to update `timeclock-mode-string'.")
-
-;; For byte-compiler.
-(defvar display-time-hook)
-(defvar timeclock-modeline-display)
-
-(defcustom timeclock-use-display-time t
-  "*If non-nil, use `display-time-hook' for doing modeline updates.
-The advantage of this is that one less timer has to be set running
-amok in Emacs' process space.  The disadvantage is that it requires
-you to have `display-time' running.  If you don't want to use
-`display-time', but still want the modeline to show how much time is
-left, set this variable to nil.  Changing the value of this variable
-while timeclock information is being displayed in the modeline has no
-effect.  You should call the function `timeclock-modeline-display' with
-a positive argument to force an update."
-  :set (lambda (symbol value)
-         (let ((currently-displaying
-                (and (boundp 'timeclock-modeline-display)
-                     timeclock-modeline-display)))
-           ;; if we're changing to the state that
-           ;; `timeclock-modeline-display' is already using, don't
-           ;; bother toggling it.  This happens on the initial loading
-           ;; of timeclock.el.
-           (if (and currently-displaying
-                    (or (and value
-                             (boundp 'display-time-hook)
-                             (memq 'timeclock-update-modeline
-                                   display-time-hook))
-                        (and (not value)
-                             timeclock-update-timer)))
-               (setq currently-displaying nil))
-           (and currently-displaying
-                (set-variable 'timeclock-modeline-display nil))
-           (setq timeclock-use-display-time value)
-           (and currently-displaying
-                (set-variable 'timeclock-modeline-display t))
-           timeclock-use-display-time))
-  :type 'boolean
-  :group 'timeclock
-  :require 'time)
-
-(defcustom timeclock-first-in-hook nil
-  "*A hook run for the first \"in\" event each day.
-Note that this hook is run before recording any events.  Thus the
-value of `timeclock-hours-today', `timeclock-last-event' and the
-return value of function `timeclock-last-period' are relative previous
-to today."
-  :type 'hook
-  :group 'timeclock)
-
-(defcustom timeclock-load-hook nil
-  "*Hook that gets run after timeclock has been loaded."
-  :type 'hook
-  :group 'timeclock)
-
-(defcustom timeclock-in-hook nil
-  "*A hook run every time an \"in\" event is recorded."
-  :type 'hook
-  :group 'timeclock)
-
-(defcustom timeclock-day-over-hook nil
-  "*A hook that is run when the workday has been completed.
-This hook is only run if the current time remaining is being displayed
-in the modeline.  See the variable `timeclock-modeline-display'."
-  :type 'hook
-  :group 'timeclock)
-
-(defcustom timeclock-out-hook nil
-  "*A hook run every time an \"out\" event is recorded."
-  :type 'hook
-  :group 'timeclock)
-
-(defcustom timeclock-done-hook nil
-  "*A hook run every time a project is marked as completed."
-  :type 'hook
-  :group 'timeclock)
-
-(defcustom timeclock-event-hook nil
-  "*A hook run every time any event is recorded."
-  :type 'hook
-  :group 'timeclock)
-
-(defvar timeclock-last-event nil
-  "A list containing the last event that was recorded.
-The format of this list is (CODE TIME PROJECT).")
-
-(defvar timeclock-last-event-workday nil
-  "The number of seconds in the workday of `timeclock-last-event'.")
-
-;;; Internal Variables:
-
-(defvar timeclock-discrepancy nil
-  "A variable containing the time discrepancy before the last event.
-Normally, timeclock assumes that you intend to work for
-`timeclock-workday' seconds every day.  Any days in which you work
-more or less than this amount is considered either a positive or
-a negative discrepancy.  If you work in such a manner that the
-discrepancy is always brought back to zero, then you will by
-definition have worked an average amount equal to `timeclock-workday'
-each day.")
-
-(defvar timeclock-elapsed nil
-  "A variable containing the time elapsed for complete periods today.
-This value is not accurate enough to be useful by itself.  Rather,
-call `timeclock-workday-elapsed', to determine how much time has been
-worked so far today.  Also, if `timeclock-relative' is nil, this value
-will be the same as `timeclock-discrepancy'.") ; ? gm
-
-(defvar timeclock-last-period nil
-  "Integer representing the number of seconds in the last period.
-Note that you shouldn't access this value, but instead should use the
-function `timeclock-last-period'.")
-
-(defvar timeclock-mode-string nil
-  "The timeclock string (optionally) displayed in the modeline.
-The time is bracketed by <> if you are clocked in, otherwise by [].")
-
-(defvar timeclock-day-over nil
-  "The date of the last day when notified \"day over\" for.")
-
-;;; User Functions:
-
-;;;###autoload
-(defun timeclock-modeline-display (&optional arg)
-  "Toggle display of the amount of time left today in the modeline.
-If `timeclock-use-display-time' is non-nil (the default), then
-the function `display-time-mode' must be active, and the modeline
-will be updated whenever the time display is updated.  Otherwise,
-the timeclock will use its own sixty second timer to do its
-updating.  With prefix ARG, turn modeline display on if and only
-if ARG is positive.  Returns the new status of timeclock modeline
-display (non-nil means on)."
-  (interactive "P")
-  ;; cf display-time-mode.
-  (setq timeclock-mode-string "")
-  (or global-mode-string (setq global-mode-string '("")))
-  (let ((on-p (if arg
-                  (> (prefix-numeric-value arg) 0)
-                (not timeclock-modeline-display))))
-    (if on-p
-        (progn
-          (or (memq 'timeclock-mode-string global-mode-string)
-              (setq global-mode-string
-                    (append global-mode-string '(timeclock-mode-string))))
-          (unless (memq 'timeclock-update-modeline timeclock-event-hook)
-            (add-hook 'timeclock-event-hook 'timeclock-update-modeline))
-          (when timeclock-update-timer
-            (cancel-timer timeclock-update-timer)
-            (setq timeclock-update-timer nil))
-          (if (boundp 'display-time-hook)
-              (remove-hook 'display-time-hook 'timeclock-update-modeline))
-          (if timeclock-use-display-time
-              (progn
-                ;; Update immediately so there is a visible change
-                ;; on calling this function.
-                (if display-time-mode (timeclock-update-modeline)
-                  (message "Activate `display-time-mode' to see \
-timeclock information"))
-                (add-hook 'display-time-hook 'timeclock-update-modeline))
-            (setq timeclock-update-timer
-                  (run-at-time nil 60 'timeclock-update-modeline))))
-      (setq global-mode-string
-            (delq 'timeclock-mode-string global-mode-string))
-      (remove-hook 'timeclock-event-hook 'timeclock-update-modeline)
-      (if (boundp 'display-time-hook)
-          (remove-hook 'display-time-hook
-                       'timeclock-update-modeline))
-      (when timeclock-update-timer
-        (cancel-timer timeclock-update-timer)
-        (setq timeclock-update-timer nil)))
-    (force-mode-line-update)
-    (setq timeclock-modeline-display on-p)))
-
-;; This has to be here so that the function definition of
-;; `timeclock-modeline-display' is known to the "set" function.
-(defcustom timeclock-modeline-display nil
-  "Toggle modeline display of time remaining.
-You must modify via \\[customize] for this variable to have an effect."
-  :set (lambda (symbol value)
-         (setq timeclock-modeline-display
-               (timeclock-modeline-display (or value 0))))
-  :type 'boolean
-  :group 'timeclock
-  :require 'timeclock)
-
-(defsubst timeclock-time-to-date (time)
-  "Convert the TIME value to a textual date string."
-  (format-time-string "%Y/%m/%d" time))
-
-;;;###autoload
-(defun timeclock-in (&optional arg project find-project)
-  "Clock in, recording the current time moment in the timelog.
-With a numeric prefix ARG, record the fact that today has only that
-many hours in it to be worked.  If arg is a non-numeric prefix arg
-\(non-nil, but not a number), 0 is assumed (working on a holiday or
-weekend).  *If not called interactively, ARG should be the number of
-_seconds_ worked today*.  This feature only has effect the first time
-this function is called within a day.
-
-PROJECT is the project being clocked into.  If PROJECT is nil, and
-FIND-PROJECT is non-nil -- or the user calls `timeclock-in'
-interactively -- call the function `timeclock-get-project-function' to
-discover the name of the project."
-  (interactive
-   (list (and current-prefix-arg
-              (if (numberp current-prefix-arg)
-                  (* current-prefix-arg 60 60)
-                0))))
-  (if (equal (car timeclock-last-event) "i")
-      (error "You've already clocked in!")
-    (unless timeclock-last-event
-      (timeclock-reread-log))
-    ;; Either no log file, or day has rolled over.
-    (unless (and timeclock-last-event
-                 (equal (timeclock-time-to-date
-                         (cadr timeclock-last-event))
-                        (timeclock-time-to-date (current-time))))
-      (let ((workday (or (and (numberp arg) arg)
-                         (and arg 0)
-                         (and timeclock-get-workday-function
-                              (funcall timeclock-get-workday-function))
-                         timeclock-workday)))
-        (run-hooks 'timeclock-first-in-hook)
-        ;; settle the discrepancy for the new day
-        (setq timeclock-discrepancy
-              (- (or timeclock-discrepancy 0) workday))
-        (if (not (= workday timeclock-workday))
-            (timeclock-log "h" (and (numberp arg)
-                                    (number-to-string arg))))))
-    (timeclock-log "i" (or project
-                           (and timeclock-get-project-function
-                                (or find-project (interactive-p))
-                                (funcall timeclock-get-project-function))))
-    (run-hooks 'timeclock-in-hook)))
-
-;;;###autoload
-(defun timeclock-out (&optional arg reason find-reason)
-  "Clock out, recording the current time moment in the timelog.
-If a prefix ARG is given, the user has completed the project that was
-begun during the last time segment.
-
-REASON is the user's reason for clocking out.  If REASON is nil, and
-FIND-REASON is non-nil -- or the user calls `timeclock-out'
-interactively -- call the function `timeclock-get-reason-function' to
-discover the reason."
-  (interactive "P")
-  (or timeclock-last-event
-      (error "You haven't clocked in!"))
-  (if (equal (downcase (car timeclock-last-event)) "o")
-      (error "You've already clocked out!")
-    (timeclock-log
-     (if arg "O" "o")
-     (or reason
-         (and timeclock-get-reason-function
-              (or find-reason (interactive-p))
-              (funcall timeclock-get-reason-function))))
-    (run-hooks 'timeclock-out-hook)
-    (if arg
-        (run-hooks 'timeclock-done-hook))))
-
-;; Should today-only be removed in favour of timeclock-relative? - gm
-(defsubst timeclock-workday-remaining (&optional today-only)
-  "Return the number of seconds until the workday is complete.
-The amount returned is relative to the value of `timeclock-workday'.
-If TODAY-ONLY is non-nil, the value returned will be relative only to
-the time worked today, and not to past time."
-  (let ((discrep (timeclock-find-discrep)))
-    (if discrep
-        (- (if today-only (cadr discrep)
-             (car discrep)))
-      0.0)))
-
-;;;###autoload
-(defun timeclock-status-string (&optional show-seconds today-only)
-  "Report the overall timeclock status at the present moment.
-If SHOW-SECONDS is non-nil, display second resolution.
-If TODAY-ONLY is non-nil, the display will be relative only to time
-worked today, ignoring the time worked on previous days."
-  (interactive "P")
-  (let ((remainder (timeclock-workday-remaining)) ; today-only?
-        (last-in (equal (car timeclock-last-event) "i"))
-        status)
-    (setq status
-          (format "Currently %s since %s (%s), %s %s, leave at %s"
-                  (if last-in "IN" "OUT")
-                  (if show-seconds
-                      (format-time-string "%-I:%M:%S %p"
-                                          (nth 1 timeclock-last-event))
-                    (format-time-string "%-I:%M %p"
-                                        (nth 1 timeclock-last-event)))
-                  (or (nth 2 timeclock-last-event)
-                      (if last-in "**UNKNOWN**" "workday over"))
-                  (timeclock-seconds-to-string remainder show-seconds t)
-                  (if (> remainder 0)
-                      "remaining" "over")
-                  (timeclock-when-to-leave-string show-seconds today-only)))
-    (if (interactive-p)
-        (message status)
-      status)))
-
-;;;###autoload
-(defun timeclock-change (&optional arg project)
-  "Change to working on a different project.
-This clocks out of the current project, then clocks in on a new one.
-With a prefix ARG, consider the previous project as finished at the
-time of changeover.  PROJECT is the name of the last project you were
-working on."
-  (interactive "P")
-  (timeclock-out arg)
-  (timeclock-in nil project (interactive-p)))
-
-;;;###autoload
-(defun timeclock-query-out ()
-  "Ask the user whether to clock out.
-This is a useful function for adding to `kill-emacs-query-functions'."
-  (and (equal (car timeclock-last-event) "i")
-       (y-or-n-p "You're currently clocking time, clock out? ")
-       (timeclock-out))
-  ;; Unconditionally return t for `kill-emacs-query-functions'.
-  t)
-
-;;;###autoload
-(defun timeclock-reread-log ()
-  "Re-read the timeclock, to account for external changes.
-Returns the new value of `timeclock-discrepancy'."
-  (interactive)
-  (setq timeclock-discrepancy nil)
-  (timeclock-find-discrep)
-  (if (and timeclock-discrepancy timeclock-modeline-display)
-      (timeclock-update-modeline))
-  timeclock-discrepancy)
-
-(defun timeclock-seconds-to-string (seconds &optional show-seconds
-                                            reverse-leader)
-  "Convert SECONDS into a compact time string.
-If SHOW-SECONDS is non-nil, make the resolution of the return string
-include the second count.  If REVERSE-LEADER is non-nil, it means to
-output a \"+\" if the time value is negative, rather than a \"-\".
-This is used when negative time values have an inverted meaning (such
-as with time remaining, where negative time really means overtime)."
-  (if show-seconds
-      (format "%s%d:%02d:%02d"
-              (if (< seconds 0) (if reverse-leader "+" "-") "")
-              (truncate (/ (abs seconds) 60 60))
-              (% (truncate (/ (abs seconds) 60)) 60)
-              (% (truncate (abs seconds)) 60))
-    (format "%s%d:%02d"
-            (if (< seconds 0) (if reverse-leader "+" "-") "")
-            (truncate (/ (abs seconds) 60 60))
-            (% (truncate (/ (abs seconds) 60)) 60))))
-
-(defsubst timeclock-currently-in-p ()
-  "Return non-nil if the user is currently clocked in."
-  (equal (car timeclock-last-event) "i"))
-
-;;;###autoload
-(defun timeclock-workday-remaining-string (&optional show-seconds
-                                                     today-only)
-  "Return a string representing the amount of time left today.
-Display second resolution if SHOW-SECONDS is non-nil.  If TODAY-ONLY
-is non-nil, the display will be relative only to time worked today.
-See `timeclock-relative' for more information about the meaning of
-\"relative to today\"."
-  (interactive)
-  (let ((string (timeclock-seconds-to-string
-                 (timeclock-workday-remaining today-only)
-                 show-seconds t)))
-    (if (interactive-p)
-        (message string)
-      string)))
-
-(defsubst timeclock-workday-elapsed ()
-  "Return the number of seconds worked so far today.
-If RELATIVE is non-nil, the amount returned will be relative to past
-time worked.  The default is to return only the time that has elapsed
-so far today."
-  (let ((discrep (timeclock-find-discrep)))
-    (if discrep
-        (nth 2 discrep)
-      0.0)))
-
-;;;###autoload
-(defun timeclock-workday-elapsed-string (&optional show-seconds)
-  "Return a string representing the amount of time worked today.
-Display seconds resolution if SHOW-SECONDS is non-nil.  If RELATIVE is
-non-nil, the amount returned will be relative to past time worked."
-  (interactive)
-  (let ((string (timeclock-seconds-to-string (timeclock-workday-elapsed)
-                                             show-seconds)))
-    (if (interactive-p)
-        (message string)
-      string)))
-
-(defsubst timeclock-time-to-seconds (time)
-  "Convert TIME to a floating point number."
-  (+ (* (car time) 65536.0)
-     (cadr time)
-     (/ (or (car (cdr (cdr time))) 0) 1000000.0)))
-
-(defsubst timeclock-seconds-to-time (seconds)
-  "Convert SECONDS (a floating point number) to an Emacs time structure."
-  (list (floor seconds 65536)
-        (floor (mod seconds 65536))
-        (floor (* (- seconds (ffloor seconds)) 1000000))))
-
-;; Should today-only be removed in favour of timeclock-relative? - gm
-(defsubst timeclock-when-to-leave (&optional today-only)
-  "Return a time value representing the end of today's workday.
-If TODAY-ONLY is non-nil, the value returned will be relative only to
-the time worked today, and not to past time."
-  (timeclock-seconds-to-time
-   (- (timeclock-time-to-seconds (current-time))
-      (let ((discrep (timeclock-find-discrep)))
-        (if discrep
-            (if today-only
-                (cadr discrep)
-              (car discrep))
-          0.0)))))
-
-;;;###autoload
-(defun timeclock-when-to-leave-string (&optional show-seconds
-                                                 today-only)
-  "Return a string representing the end of today's workday.
-This string is relative to the value of `timeclock-workday'.  If
-SHOW-SECONDS is non-nil, the value printed/returned will include
-seconds.  If TODAY-ONLY is non-nil, the value returned will be
-relative only to the time worked today, and not to past time."
-  ;; Should today-only be removed in favour of timeclock-relative? - gm
-  (interactive)
-  (let* ((then (timeclock-when-to-leave today-only))
-         (string
-          (if show-seconds
-              (format-time-string "%-I:%M:%S %p" then)
-            (format-time-string "%-I:%M %p" then))))
-    (if (interactive-p)
-        (message string)
-      string)))
-
-;;; Internal Functions:
-
-(defvar timeclock-project-list nil)
-(defvar timeclock-last-project nil)
-
-(defun timeclock-completing-read (prompt alist &optional default)
-  "A version of `completing-read' that works on both Emacs and XEmacs."
-  (if (featurep 'xemacs)
-      (let ((str (completing-read prompt alist)))
-        (if (or (null str) (= (length str) 0))
-            default
-          str))
-    (completing-read prompt alist nil nil nil nil default)))
-
-(defun timeclock-ask-for-project ()
-  "Ask the user for the project they are clocking into."
-  (timeclock-completing-read
-   (format "Clock into which project (default \"%s\"): "
-           (or timeclock-last-project
-               (car timeclock-project-list)))
-   (mapcar 'list timeclock-project-list)
-   (or timeclock-last-project
-       (car timeclock-project-list))))
-
-(defvar timeclock-reason-list nil)
-
-(defun timeclock-ask-for-reason ()
-  "Ask the user for the reason they are clocking out."
-  (timeclock-completing-read "Reason for clocking out: "
-                             (mapcar 'list timeclock-reason-list)))
-
-(defun timeclock-update-modeline ()
-  "Update the `timeclock-mode-string' displayed in the modeline.
-The value of `timeclock-relative' affects the display as described in
-that variable's documentation."
-  (interactive)
-  (let ((remainder (timeclock-workday-remaining (not timeclock-relative)))
-        (last-in (equal (car timeclock-last-event) "i")))
-    (when (and (< remainder 0)
-               (not (and timeclock-day-over
-                         (equal timeclock-day-over
-                                (timeclock-time-to-date
-                                 (current-time))))))
-      (setq timeclock-day-over
-            (timeclock-time-to-date (current-time)))
-      (run-hooks 'timeclock-day-over-hook))
-    (setq timeclock-mode-string
-          (propertize
-           (format " %c%s%c "
-                   (if last-in ?< ?[)
-                   (timeclock-seconds-to-string remainder nil t)
-                   (if last-in ?> ?]))
-           'help-echo "timeclock: time remaining"))))
-
-(put 'timeclock-mode-string 'risky-local-variable t)
-
-(defun timeclock-log (code &optional project)
-  "Log the event CODE to the timeclock log, at the time of call.
-If PROJECT is a string, it represents the project which the event is
-being logged for.  Normally only \"in\" events specify a project."
-  (with-current-buffer (find-file-noselect timeclock-file)
-    (goto-char (point-max))
-    (if (not (bolp))
-        (insert "\n"))
-    (let ((now (current-time)))
-      (insert code " "
-              (format-time-string "%Y/%m/%d %H:%M:%S" now)
-              (or (and project
-                       (stringp project)
-                       (> (length project) 0)
-                       (concat " " project))
-                  "")
-              "\n")
-      (if (equal (downcase code) "o")
-          (setq timeclock-last-period
-                (- (timeclock-time-to-seconds now)
-                   (timeclock-time-to-seconds
-                    (cadr timeclock-last-event)))
-                timeclock-discrepancy
-                (+ timeclock-discrepancy
-                   timeclock-last-period)))
-      (setq timeclock-last-event (list code now project)))
-    (save-buffer)
-    (run-hooks 'timeclock-event-hook)
-    (kill-buffer (current-buffer))))
-
-(defvar timeclock-moment-regexp
-  (concat "\\([bhioO]\\)\\s-+"
-          "\\([0-9]+\\)/\\([0-9]+\\)/\\([0-9]+\\)\\s-+"
-          "\\([0-9]+\\):\\([0-9]+\\):\\([0-9]+\\)[ \t]*" "\\([^\n]*\\)"))
-
-(defsubst timeclock-read-moment ()
-  "Read the moment under point from the timelog."
-  (if (looking-at timeclock-moment-regexp)
-      (let ((code (match-string 1))
-            (year (string-to-number (match-string 2)))
-            (mon  (string-to-number (match-string 3)))
-            (mday (string-to-number (match-string 4)))
-            (hour (string-to-number (match-string 5)))
-            (min  (string-to-number (match-string 6)))
-            (sec  (string-to-number (match-string 7)))
-            (project (match-string 8)))
-        (list code (encode-time sec min hour mday mon year) project))))
-
-(defun timeclock-last-period (&optional moment)
-  "Return the value of the last event period.
-If the last event was a clock-in, the period will be open ended, and
-growing every second.  Otherwise, it is a fixed amount which has been
-recorded to disk.  If MOMENT is non-nil, use that as the current time.
-This is only provided for coherency when used by
-`timeclock-discrepancy'."
-  (if (equal (car timeclock-last-event) "i")
-      (- (timeclock-time-to-seconds (or moment (current-time)))
-         (timeclock-time-to-seconds
-          (cadr timeclock-last-event)))
-    timeclock-last-period))
-
-(defsubst timeclock-entry-length (entry)
-  (- (timeclock-time-to-seconds (cadr entry))
-     (timeclock-time-to-seconds (car entry))))
-
-(defsubst timeclock-entry-begin (entry)
-  (car entry))
-
-(defsubst timeclock-entry-end (entry)
-  (cadr entry))
-
-(defsubst timeclock-entry-project (entry)
-  (nth 2 entry))
-
-(defsubst timeclock-entry-comment (entry)
-  (nth 3 entry))
-
-
-(defsubst timeclock-entry-list-length (entry-list)
-  (let ((length 0))
-    (while entry-list
-      (setq length (+ length (timeclock-entry-length (car entry-list))))
-      (setq entry-list (cdr entry-list)))
-    length))
-
-(defsubst timeclock-entry-list-begin (entry-list)
-  (timeclock-entry-begin (car entry-list)))
-
-(defsubst timeclock-entry-list-end (entry-list)
-  (timeclock-entry-end (car (last entry-list))))
-
-(defsubst timeclock-entry-list-span (entry-list)
-  (- (timeclock-time-to-seconds (timeclock-entry-list-end entry-list))
-     (timeclock-time-to-seconds (timeclock-entry-list-begin entry-list))))
-
-(defsubst timeclock-entry-list-break (entry-list)
-  (- (timeclock-entry-list-span entry-list)
-     (timeclock-entry-list-length entry-list)))
-
-(defsubst timeclock-entry-list-projects (entry-list)
-  (let (projects)
-    (while entry-list
-      (let ((project (timeclock-entry-project (car entry-list))))
-        (if projects
-            (add-to-list 'projects project)
-          (setq projects (list project))))
-      (setq entry-list (cdr entry-list)))
-    projects))
-
-
-(defsubst timeclock-day-required (day)
-  (or (car day) timeclock-workday))
-
-(defsubst timeclock-day-length (day)
-  (timeclock-entry-list-length (cdr day)))
-
-(defsubst timeclock-day-debt (day)
-  (- (timeclock-day-required day)
-     (timeclock-day-length day)))
-
-(defsubst timeclock-day-begin (day)
-  (timeclock-entry-list-begin (cdr day)))
-
-(defsubst timeclock-day-end (day)
-  (timeclock-entry-list-end (cdr day)))
-
-(defsubst timeclock-day-span (day)
-  (timeclock-entry-list-span (cdr day)))
-
-(defsubst timeclock-day-break (day)
-  (timeclock-entry-list-break (cdr day)))
-
-(defsubst timeclock-day-projects (day)
-  (timeclock-entry-list-projects (cdr day)))
-
-(defmacro timeclock-day-list-template (func)
-  `(let ((length 0))
-     (while day-list
-       (setq length (+ length (,(eval func) (car day-list))))
-       (setq day-list (cdr day-list)))
-     length))
-
-(defun timeclock-day-list-required (day-list)
-  (timeclock-day-list-template 'timeclock-day-required))
-
-(defun timeclock-day-list-length (day-list)
-  (timeclock-day-list-template 'timeclock-day-length))
-
-(defun timeclock-day-list-debt (day-list)
-  (timeclock-day-list-template 'timeclock-day-debt))
-
-(defsubst timeclock-day-list-begin (day-list)
-  (timeclock-day-begin (car day-list)))
-
-(defsubst timeclock-day-list-end (day-list)
-  (timeclock-day-end (car (last day-list))))
-
-(defun timeclock-day-list-span (day-list)
-  (timeclock-day-list-template 'timeclock-day-span))
-
-(defun timeclock-day-list-break (day-list)
-  (timeclock-day-list-template 'timeclock-day-break))
-
-(defun timeclock-day-list-projects (day-list)
-  (let (projects)
-    (while day-list
-      (let ((projs (timeclock-day-projects (car day-list))))
-        (while projs
-          (if projects
-              (add-to-list 'projects (car projs))
-            (setq projects (list (car projs))))
-          (setq projs (cdr projs))))
-      (setq day-list (cdr day-list)))
-    projects))
-
-
-(defsubst timeclock-current-debt (&optional log-data)
-  (nth 0 (or log-data (timeclock-log-data))))
-
-(defsubst timeclock-day-alist (&optional log-data)
-  (nth 1 (or log-data (timeclock-log-data))))
-
-(defun timeclock-day-list (&optional log-data)
-  (let ((alist (timeclock-day-alist log-data))
-        day-list)
-    (while alist
-      (setq day-list (cons (cdar alist) day-list)
-            alist (cdr alist)))
-    day-list))
-
-(defsubst timeclock-project-alist (&optional log-data)
-  (nth 2 (or log-data (timeclock-log-data))))
-
-
-(defun timeclock-log-data (&optional recent-only filename)
-  "Return the contents of the timelog file, in a useful format.
-If the optional argument RECENT-ONLY is non-nil, only show the contents
-from the last point where the time debt (see below) was set.
-If the optional argument FILENAME is non-nil, it is used instead of
-the file specified by `timeclock-file.'
-
-A timelog contains data in the form of a single entry per line.
-Each entry has the form:
-
-  CODE YYYY/MM/DD HH:MM:SS [COMMENT]
-
-CODE is one of: b, h, i, o or O.  COMMENT is optional when the code is
-i, o or O.  The meanings of the codes are:
-
-  b  Set the current time balance, or \"time debt\".  Useful when
-     archiving old log data, when a debt must be carried forward.
-     The COMMENT here is the number of seconds of debt.
-
-  h  Set the required working time for the given day.  This must
-     be the first entry for that day.  The COMMENT in this case is
-     the number of hours in this workday.  Floating point amounts
-     are allowed.
-
-  i  Clock in.  The COMMENT in this case should be the name of the
-     project worked on.
-
-  o  Clock out.  COMMENT is unnecessary, but can be used to provide
-     a description of how the period went, for example.
-
-  O  Final clock out.  Whatever project was being worked on, it is
-     now finished.  Useful for creating summary reports.
-
-When this function is called, it will return a data structure with the
-following format:
-
-  (DEBT ENTRIES-BY-DAY ENTRIES-BY-PROJECT)
-
-DEBT is a floating point number representing the number of seconds
-\"owed\" before any work was done.  For a new file (one without a 'b'
-entry), this is always zero.
-
-The two entries lists have similar formats.  They are both alists,
-where the CAR is the index, and the CDR is a list of time entries.
-For ENTRIES-BY-DAY, the CAR is a textual date string, of the form
-YYYY/MM/DD.  For ENTRIES-BY-PROJECT, it is the name of the project
-worked on, or t for the default project.
-
-The CDR for ENTRIES-BY-DAY is slightly different than for
-ENTRIES-BY-PROJECT.  It has the following form:
-
-  (DAY-LENGTH TIME-ENTRIES...)
-
-For ENTRIES-BY-PROJECT, there is no DAY-LENGTH member.  It is simply a
-list of TIME-ENTRIES.  Note that if DAY-LENGTH is nil, it means
-whatever is the default should be used.
-
-A TIME-ENTRY is a recorded time interval.  It has the following format
-\(although generally one does not have to manipulate these entries
-directly; see below):
-
-  (BEGIN-TIME END-TIME PROJECT [COMMENT] [FINAL-P])
-
-Anyway, suffice it to say there are a lot of structures.  Typically
-the user is expected to manipulate to the day(s) or project(s) that he
-or she wants, at which point the following helper functions may be
-used:
-
-  timeclock-day-required
-  timeclock-day-length
-  timeclock-day-debt
-  timeclock-day-begin
-  timeclock-day-end
-  timeclock-day-span
-  timeclock-day-break
-  timeclock-day-projects
-
-  timeclock-day-list-required
-  timeclock-day-list-length
-  timeclock-day-list-debt
-  timeclock-day-list-begin
-  timeclock-day-list-end
-  timeclock-day-list-span
-  timeclock-day-list-break
-  timeclock-day-list-projects
-
-  timeclock-entry-length
-  timeclock-entry-begin
-  timeclock-entry-end
-  timeclock-entry-project
-  timeclock-entry-comment
-
-  timeclock-entry-list-length
-  timeclock-entry-list-begin
-  timeclock-entry-list-end
-  timeclock-entry-list-span
-  timeclock-entry-list-break
-  timeclock-entry-list-projects
-
-A few comments should make the use of the above functions obvious:
-
-  `required' is the amount of time that must be spent during a day, or
-  sequence of days, in order to have no debt.
-
-  `length' is the actual amount of time that was spent.
-
-  `debt' is the difference between required time and length.  A
-  negative debt signifies overtime.
-
-  `begin' is the earliest moment at which work began.
-
-  `end' is the final moment work was done.
-
-  `span' is the difference between begin and end.
-
-  `break' is the difference between span and length.
-
-  `project' is the project that was worked on, and `projects' is a
-  list of all the projects that were worked on during a given period.
-
-  `comment', where it applies, could mean anything.
-
-There are a few more functions available, for locating day and entry
-lists:
-
-  timeclock-day-alist LOG-DATA
-  timeclock-project-alist LOG-DATA
-  timeclock-current-debt LOG-DATA
-
-See the documentation for the given function if more info is needed."
-  (let* ((log-data (list 0.0 nil nil))
-         (now (current-time))
-         (todays-date (timeclock-time-to-date now))
-         last-date-limited last-date-seconds last-date
-         (line 0) last beg day entry event)
-    (with-temp-buffer
-      (insert-file-contents (or filename timeclock-file))
-      (when recent-only
-        (goto-char (point-max))
-        (unless (re-search-backward "^b\\s-+" nil t)
-          (goto-char (point-min))))
-      (while (or (setq event (timeclock-read-moment))
-                 (and beg (not last)
-                      (setq last t event (list "o" now))))
-        (setq line (1+ line))
-        (cond ((equal (car event) "b")
-               (setcar log-data (string-to-number (nth 2 event))))
-              ((equal (car event) "h")
-               (setq last-date-limited (timeclock-time-to-date (cadr event))
-                     last-date-seconds (* (string-to-number (nth 2 event))
-                                          3600.0)))
-              ((equal (car event) "i")
-               (if beg
-                   (error "Error in format of timelog file, line %d" line)
-                 (setq beg t))
-               (setq entry (list (cadr event) nil
-                                 (and (> (length (nth 2 event)) 0)
-                                      (nth 2 event))))
-               (let ((date (timeclock-time-to-date (cadr event))))
-                 (if (and last-date
-                          (not (equal date last-date)))
-                     (progn
-                       (setcar (cdr log-data)
-                               (cons (cons last-date day)
-                                     (cadr log-data)))
-                       (setq day (list (and last-date-limited
-                                            last-date-seconds))))
-                   (unless day
-                     (setq day (list (and last-date-limited
-                                          last-date-seconds)))))
-                 (setq last-date date
-                       last-date-limited nil)))
-              ((equal (downcase (car event)) "o")
-               (if (not beg)
-                   (error "Error in format of timelog file, line %d" line)
-                 (setq beg nil))
-               (setcar (cdr entry) (cadr event))
-               (let ((desc (and (> (length (nth 2 event)) 0)
-                                (nth 2 event))))
-                 (if desc
-                     (nconc entry (list (nth 2 event))))
-                 (if (equal (car event) "O")
-                     (nconc entry (if desc
-                                      (list t)
-                                    (list nil t))))
-                 (nconc day (list entry))
-                 (setq desc (nth 2 entry))
-                 (let ((proj (assoc desc (nth 2 log-data))))
-                   (if (null proj)
-                       (setcar (cddr log-data)
-                               (cons (cons desc (list entry))
-                                     (car (cddr log-data))))
-                     (nconc (cdr proj) (list entry)))))))
-        (forward-line))
-      (if day
-          (setcar (cdr log-data)
-                  (cons (cons last-date day)
-                        (cadr log-data))))
-      log-data)))
-
-(defun timeclock-find-discrep ()
-  "Calculate time discrepancies, in seconds.
-The result is a three element list, containing the total time
-discrepancy, today's discrepancy, and the time worked today."
-  ;; This is not implemented in terms of the functions above, because
-  ;; it's a bit wasteful to read all of that data in, just to throw
-  ;; away more than 90% of the information afterwards.
-  ;;
-  ;; If it were implemented using those functions, it would look
-  ;; something like this:
-  ;;  (let ((days (timeclock-day-alist (timeclock-log-data)))
-  ;;        (total 0.0))
-  ;;    (while days
-  ;;      (setq total (+ total (- (timeclock-day-length (cdar days))
-  ;;                              (timeclock-day-required (cdar days))))
-  ;;            days (cdr days)))
-  ;;    total)
-  (let* ((now (current-time))
-         (todays-date (timeclock-time-to-date now))
-         (first t) (accum 0) (elapsed 0)
-         event beg last-date avg
-         last-date-limited last-date-seconds)
-    (unless timeclock-discrepancy
-      (when (file-readable-p timeclock-file)
-        (setq timeclock-project-list nil
-              timeclock-last-project nil
-              timeclock-reason-list nil
-              timeclock-elapsed 0)
-        (with-temp-buffer
-          (insert-file-contents timeclock-file)
-          (goto-char (point-max))
-          (unless (re-search-backward "^b\\s-+" nil t)
-            (goto-char (point-min)))
-          (while (setq event (timeclock-read-moment))
-            (cond ((equal (car event) "b")
-                   (setq accum (string-to-number (nth 2 event))))
-                  ((equal (car event) "h")
-                   (setq last-date-limited
-                         (timeclock-time-to-date (cadr event))
-                         last-date-seconds
-                         (* (string-to-number (nth 2 event)) 3600.0)))
-                  ((equal (car event) "i")
-                   (when (and (nth 2 event)
-                              (> (length (nth 2 event)) 0))
-                     (add-to-list 'timeclock-project-list (nth 2 event))
-                     (setq timeclock-last-project (nth 2 event)))
-                   (let ((date (timeclock-time-to-date (cadr event))))
-                     (if (if last-date
-                             (not (equal date last-date))
-                           first)
-                         (setq first nil
-                               accum (- accum (if last-date-limited
-                                                  last-date-seconds
-                                                timeclock-workday))))
-                     (setq last-date date
-                           last-date-limited nil)
-                     (if beg
-                         (error "Error in format of timelog file!")
-                       (setq beg (timeclock-time-to-seconds (cadr event))))))
-                  ((equal (downcase (car event)) "o")
-                   (if (and (nth 2 event)
-                            (> (length (nth 2 event)) 0))
-                       (add-to-list 'timeclock-reason-list (nth 2 event)))
-                   (if (not beg)
-                       (error "Error in format of timelog file!")
-                     (setq timeclock-last-period
-                           (- (timeclock-time-to-seconds (cadr event)) beg)
-                           accum (+ timeclock-last-period accum)
-                           beg nil))
-                   (if (equal last-date todays-date)
-                       (setq timeclock-elapsed
-                             (+ timeclock-last-period timeclock-elapsed)))))
-            (setq timeclock-last-event event
-                  timeclock-last-event-workday
-                  (if (equal (timeclock-time-to-date now) last-date-limited)
-                      last-date-seconds
-                    timeclock-workday))
-            (forward-line))
-          (setq timeclock-discrepancy accum))))
-    (unless timeclock-last-event-workday
-      (setq timeclock-last-event-workday timeclock-workday))
-    (setq accum (or timeclock-discrepancy 0)
-          elapsed (or timeclock-elapsed elapsed))
-    (if timeclock-last-event
-        (if (equal (car timeclock-last-event) "i")
-            (let ((last-period (timeclock-last-period now)))
-              (setq accum (+ accum last-period)
-                    elapsed (+ elapsed last-period)))
-          (if (not (equal (timeclock-time-to-date
-                           (cadr timeclock-last-event))
-                          (timeclock-time-to-date now)))
-              (setq accum (- accum timeclock-last-event-workday)))))
-    (list accum (- elapsed timeclock-last-event-workday)
-          elapsed)))
-
-;;; A reporting function that uses timeclock-log-data
-
-(defun timeclock-day-base (&optional time)
-  "Given a time within a day, return 0:0:0 within that day.
-If optional argument TIME is non-nil, use that instead of the current time."
-  (let ((decoded (decode-time (or time (current-time)))))
-    (setcar (nthcdr 0 decoded) 0)
-    (setcar (nthcdr 1 decoded) 0)
-    (setcar (nthcdr 2 decoded) 0)
-    (apply 'encode-time decoded)))
-
-(defun timeclock-geometric-mean (l)
-  "Compute the geometric mean of the values in the list L."
-  (let ((total 0)
-        (count 0))
-    (while l
-      (setq total (+ total (car l))
-            count (1+ count)
-            l (cdr l)))
-    (if (> count 0)
-        (/ total count)
-      0)))
-
-(defun timeclock-generate-report (&optional html-p)
-  "Generate a summary report based on the current timelog file.
-By default, the report is in plain text, but if the optional argument
-HTML-P is non-nil, HTML markup is added."
-  (interactive)
-  (let ((log (timeclock-log-data))
-        (today (timeclock-day-base)))
-    (if html-p (insert "<p>"))
-    (insert "Currently ")
-    (let ((project (nth 2 timeclock-last-event))
-          (begin (nth 1 timeclock-last-event))
-          done)
-      (if (timeclock-currently-in-p)
-          (insert "IN")
-        (if (or (null project) (= (length project) 0))
-            (progn (insert "Done Working Today")
-                   (setq done t))
-          (insert "OUT")))
-      (unless done
-        (insert " since " (format-time-string "%Y/%m/%d %-I:%M %p" begin))
-        (if html-p
-            (insert "<br>\n<b>")
-          (insert "\n*"))
-        (if (timeclock-currently-in-p)
-            (insert "Working on "))
-        (if html-p
-            (insert project "</b><br>\n")
-          (insert project "*\n"))
-        (let ((proj-data (cdr (assoc project (timeclock-project-alist log))))
-              (two-weeks-ago (timeclock-seconds-to-time
-                              (- (timeclock-time-to-seconds today)
-                                 (* 2 7 24 60 60))))
-              two-week-len today-len)
-          (while proj-data
-            (if (not (time-less-p
-                      (timeclock-entry-begin (car proj-data)) today))
-                (setq today-len (timeclock-entry-list-length proj-data)
-                      proj-data nil)
-              (if (and (null two-week-len)
-                       (not (time-less-p
-                             (timeclock-entry-begin (car proj-data))
-                             two-weeks-ago)))
-                  (setq two-week-len (timeclock-entry-list-length proj-data)))
-              (setq proj-data (cdr proj-data))))
-          (if (null two-week-len)
-              (setq two-week-len today-len))
-          (if html-p (insert "<p>"))
-          (if today-len
-              (insert "\nTime spent on this task today: "
-                      (timeclock-seconds-to-string today-len)
-                      ".  In the last two weeks: "
-                      (timeclock-seconds-to-string two-week-len))
-            (if two-week-len
-                (insert "\nTime spent on this task in the last two weeks: "
-                        (timeclock-seconds-to-string two-week-len))))
-          (if html-p (insert "<br>"))
-          (insert "\n"
-                  (timeclock-seconds-to-string (timeclock-workday-elapsed))
-                  " worked today, "
-                  (timeclock-seconds-to-string (timeclock-workday-remaining))
-                  " remaining, done at "
-                  (timeclock-when-to-leave-string) "\n")))
-      (if html-p (insert "<p>"))
-      (insert "\nThere have been "
-              (number-to-string
-               (length (timeclock-day-alist log)))
-              " days of activity, starting "
-              (caar (last (timeclock-day-alist log))))
-      (if html-p (insert "</p>"))
-      (when html-p
-        (insert "<p>
-<table>
-<td width=\"25\"><br></td><td>
-<table border=1 cellpadding=3>
-<tr><th><i>Statistics</i></th>
-    <th>Entire</th>
-    <th>-30 days</th>
-    <th>-3 mons</th>
-    <th>-6 mons</th>
-    <th>-1 year</th>
-</tr>")
-        (let* ((day-list (timeclock-day-list))
-               (thirty-days-ago (timeclock-seconds-to-time
-                                 (- (timeclock-time-to-seconds today)
-                                    (* 30 24 60 60))))
-               (three-months-ago (timeclock-seconds-to-time
-                                  (- (timeclock-time-to-seconds today)
-                                     (* 90 24 60 60))))
-               (six-months-ago (timeclock-seconds-to-time
-                                (- (timeclock-time-to-seconds today)
-                                   (* 180 24 60 60))))
-               (one-year-ago (timeclock-seconds-to-time
-                              (- (timeclock-time-to-seconds today)
-                                 (* 365 24 60 60))))
-               (time-in  (vector (list t) (list t) (list t) (list t) (list t)))
-               (time-out (vector (list t) (list t) (list t) (list t) (list t)))
-               (breaks   (vector (list t) (list t) (list t) (list t) (list t)))
-               (workday  (vector (list t) (list t) (list t) (list t) (list t)))
-               (lengths  (vector '(0 0) thirty-days-ago three-months-ago
-                                 six-months-ago one-year-ago)))
-          ;; collect statistics from complete timelog
-          (while day-list
-            (let ((i 0) (l 5))
-              (while (< i l)
-                (unless (time-less-p
-                         (timeclock-day-begin (car day-list))
-                         (aref lengths i))
-                  (let ((base (timeclock-time-to-seconds
-                               (timeclock-day-base
-                                (timeclock-day-begin (car day-list))))))
-                    (nconc (aref time-in i)
-                           (list (- (timeclock-time-to-seconds
-                                     (timeclock-day-begin (car day-list)))
-                                    base)))
-                    (let ((span (timeclock-day-span (car day-list)))
-                          (len (timeclock-day-length (car day-list)))
-                          (req (timeclock-day-required (car day-list))))
-                      ;; If the day's actual work length is less than
-                      ;; 70% of its span, then likely the exit time
-                      ;; and break amount are not worthwhile adding to
-                      ;; the statistic
-                      (when (and (> span 0)
-                                 (> (/ (float len) (float span)) 0.70))
-                        (nconc (aref time-out i)
-                               (list (- (timeclock-time-to-seconds
-                                         (timeclock-day-end (car day-list)))
-                                        base)))
-                        (nconc (aref breaks i) (list (- span len))))
-                      (if req
-                          (setq len (+ len (- timeclock-workday req))))
-                      (nconc (aref workday i) (list len)))))
-                (setq i (1+ i))))
-            (setq day-list (cdr day-list)))
-          ;; average statistics
-          (let ((i 0) (l 5))
-            (while (< i l)
-              (aset time-in i (timeclock-geometric-mean
-                               (cdr (aref time-in i))))
-              (aset time-out i (timeclock-geometric-mean
-                                (cdr (aref time-out i))))
-              (aset breaks i (timeclock-geometric-mean
-                              (cdr (aref breaks i))))
-              (aset workday i (timeclock-geometric-mean
-                               (cdr (aref workday i))))
-              (setq i (1+ i))))
-          ;; Output the HTML table
-          (insert "<tr>\n")
-          (insert "<td align=\"center\">Time in</td>\n")
-          (let ((i 0) (l 5))
-            (while (< i l)
-              (insert "<td align=\"right\">"
-                      (timeclock-seconds-to-string (aref time-in i))
-                      "</td>\n")
-              (setq i (1+ i))))
-          (insert "</tr>\n")
-
-          (insert "<tr>\n")
-          (insert "<td align=\"center\">Time out</td>\n")
-          (let ((i 0) (l 5))
-            (while (< i l)
-              (insert "<td align=\"right\">"
-                      (timeclock-seconds-to-string (aref time-out i))
-                      "</td>\n")
-              (setq i (1+ i))))
-          (insert "</tr>\n")
-
-          (insert "<tr>\n")
-          (insert "<td align=\"center\">Break</td>\n")
-          (let ((i 0) (l 5))
-            (while (< i l)
-              (insert "<td align=\"right\">"
-                      (timeclock-seconds-to-string (aref breaks i))
-                      "</td>\n")
-              (setq i (1+ i))))
-          (insert "</tr>\n")
-
-          (insert "<tr>\n")
-          (insert "<td align=\"center\">Workday</td>\n")
-          (let ((i 0) (l 5))
-            (while (< i l)
-              (insert "<td align=\"right\">"
-                      (timeclock-seconds-to-string (aref workday i))
-                      "</td>\n")
-              (setq i (1+ i))))
-          (insert "</tr>\n"))
-        (insert "<tfoot>
-<td colspan=\"6\" align=\"center\">
-  <i>These are approximate figures</i></td>
-</tfoot>
-</table>
-</td></table>")))))
-
-;;; A helpful little function
-
-(defun timeclock-visit-timelog ()
-  "Open the file named by `timeclock-file' in another window."
-  (interactive)
-  (find-file-other-window timeclock-file))
-
-(provide 'timeclock)
-
-(run-hooks 'timeclock-load-hook)
-
-;; make sure we know the list of reasons, projects, and have computed
-;; the last event and current discrepancy.
-(if (file-readable-p timeclock-file)
-    (timeclock-reread-log))
-
-;;; arch-tag: a0be3377-deb6-44ec-b9a2-a7be28436a40
-;;; timeclock.el ends here