Moved around most of the files so that source code is in src/, documentation

is in doc/, etc.

2 files changed, 2673 insertions, 0 deletions

diff --git a/lisp/ledger.el b/lisp/ledger.el
new file mode 100644
index 00000000..2ce949d9
--- /dev/null
+++ b/lisp/ledger.el
@@ -0,0 +1,1311 @@
+;;; ledger.el --- Helper code for use with the "ledger" command-line tool
+
+;; Copyright (C) 2008 John Wiegley (johnw AT gnu DOT org)
+
+;; Emacs Lisp Archive Entry
+;; Filename: ledger.el
+;; Version: 2.7
+;; 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), or C-c C-r to attempt an auto-reconcilation based on the
+;; statement's ending date and balance.
+;;
+;; 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.2"
+  "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
+  `((,(concat "^[0-9/.=-]+\\(\\s-+\\*\\)?\\(\\s-+(.*?)\\)?\\s-+"
+	      "\\(.+?\\)\\(\t\\|\n\\| [ \t]\\)") 3 bold)
+    (";.+" . font-lock-comment-face)
+    ("^\\s-+.+?\\(  \\|\t\\|\n\\|\\s-+$\\)" . font-lock-keyword-face))
+  "Default 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)
+  (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))))
+	 (date (car args))
+	 (insert-year t)
+	 (ledger-buf (current-buffer))
+	 exit-code)
+    (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
+      (if (re-search-backward "^Y " nil t)
+	  (setq insert-year nil)))
+    (save-excursion
+      (insert
+       (with-temp-buffer
+	 (setq exit-code
+	       (apply #'ledger-run-ledger ledger-buf "entry"
+		      (mapcar 'eval args)))
+	 (if (= 0 exit-code)
+	     (if insert-year
+		 (buffer-substring 2 (point-max))
+	       (buffer-substring 7 (point-max)))
+	   (concat (if insert-year entry-text
+		     (substring entry-text 6)) "\n"))) "\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 ledger-clear-whole-entries
+      (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."
+  (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 (equal (car where) "<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-auto-reconcile (balance date)
+  (interactive "sReconcile to balance (negative for a liability): \nsStatement date (default: now): ")
+  (let ((buffer ledger-buf)
+	(account ledger-acct) cleared)
+    ;; attempt to auto-reconcile in the background
+    (with-temp-buffer
+      (let ((exit-code
+	     (ledger-run-ledger buffer "--format" "%xb\\n"
+	      "--reconcile" balance "--reconcile-date" date
+	      "register" account)))
+	(if (/= 0 exit-code)
+	    (error "Failed to reconcile account '%s' to balance '%s'"
+		   account balance)
+	  (goto-char (point-min))
+	  (unless (looking-at "[0-9]")
+	    (error (buffer-string)))
+	  (while (not (eobp))
+	    (setq cleared
+		  (cons (save-excursion
+			  (goto-line (1+ (read (current-buffer))))
+			  (point-marker)) cleared))
+	    (forward-line)))))
+    (goto-char (point-min))
+    (with-current-buffer ledger-buf
+      (setq cleared (mapcar 'copy-marker (nreverse cleared))))
+    (let ((inhibit-redisplay t))
+      (dolist (pos cleared)
+	(while (and (not (eobp))
+		    (/= pos (cdr (get-text-property (point) 'where))))
+	  (forward-line))
+	(unless (eobp)
+	  (ledger-reconcile-toggle))))
+    (goto-char (point-min))))
+
+(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 (equal (car where) "<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 (equal (car where) "<stdin>")
+      (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)
+		 (equal (car where) "<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" "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 &optional arg)
+  (interactive "sAccount to reconcile: \nP")
+  (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)
+      (when arg
+	(sit-for 0 0)
+	(call-interactively #'ledger-auto-reconcile)))))
+
+(defvar ledger-reconcile-mode-abbrev-table)
+
+(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 ?c) (control ?r)] 'ledger-auto-reconcile)
+    (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 [?r] 'ledger-auto-reconcile)
+    (define-key map [?s] 'ledger-reconcile-save)
+    (define-key map [?q] 'ledger-reconcile-quit)
+    (use-local-map 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)
+
+(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 [?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)))
+
+(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))))
+
+(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" 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)
+  (erase-buffer)
+  (ledger-do-report ledger-report-cmd))
+
+(defun ledger-report-quit ()
+  "Quit the ledger report buffer."
+  (interactive)
+  (ledger-report-goto)
+  (set-window-configuration ledger-original-window-cfg))
+
+(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)
+	  (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)
+	      (ledger-entries)
+	    (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 (= 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
+	(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)))
+
+(provide 'ledger)
+
+;;; ledger.el ends here
diff --git a/lisp/timeclock.el b/lisp/timeclock.el
new file mode 100644
index 00000000..03159e94
--- /dev/null
+++ b/lisp/timeclock.el
@@ -0,0 +1,1362 @@
+;;; 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