From 8f06e75e0509ea04065c8303a954a10465b28235 Mon Sep 17 00:00:00 2001
From: John Wiegley <johnw@newartisans.com>
Date: Wed, 10 Mar 2010 03:55:47 -0500
Subject: Began writing lisp/ldg-regex.el

---
 lisp/ldg-regex.el | 167 ++++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 167 insertions(+)
 create mode 100644 lisp/ldg-regex.el

(limited to 'lisp/ldg-regex.el')

diff --git a/lisp/ldg-regex.el b/lisp/ldg-regex.el
new file mode 100644
index 00000000..df9264f5
--- /dev/null
+++ b/lisp/ldg-regex.el
@@ -0,0 +1,167 @@
+(require 'rx)
+
+(defconst ledger-regex-date
+  (let ((sep '(or ?- (any ?. ?/))))	; can't do (any ?- ?. ?/) due to bug
+    (rx (group
+	 (and (? (= 4 num)
+		 (eval sep))
+	      (and num (? num))
+	      (eval sep)
+	      (and num (? num))))))
+  "Match a single date, in its 'written' form.")
+
+(defconst ledger-regex-date-group 1)
+(defconst ledger-regex-date-group--count 1)
+
+(defconst ledger-regex-full-date
+  (macroexpand
+   `(rx (and (regexp ,ledger-regex-date)
+	     (? (and ?= (regexp ,ledger-regex-date))))))
+  "Match a compound date, of the form ACTUAL=EFFECTIVE")
+
+(defconst ledger-regex-full-date-group-actual
+  ledger-regex-date-group)
+(defconst ledger-regex-full-date-group-effective
+  (+ ledger-regex-date-group--count
+     ledger-regex-date-group))
+(defconst ledger-regex-full-date-group--count
+  (* 2 ledger-regex-date-group--count))
+
+(defconst ledger-regex-state
+  (rx (group (any ?! ?*))))
+
+(defconst ledger-regex-state-group 1)
+(defconst ledger-regex-state-group--count 1)
+
+(defconst ledger-regex-code
+  (rx (and ?\( (group (+? (not (any ?\))))) ?\))))
+
+(defconst ledger-regex-code-group 1)
+(defconst ledger-regex-code-group--count 1)
+
+(defconst ledger-regex-long-space
+  (rx (and (*? space)
+	   (or (and ?  (or ?  ?\t)) ?\t))))
+
+(defconst ledger-regex-note
+  (rx (group (+ nonl))))
+
+(defconst ledger-regex-note-group 1)
+(defconst ledger-regex-note-group--count 1)
+
+(defconst ledger-regex-end-note
+  (macroexpand `(rx (and (regexp ,ledger-regex-long-space) ?\;
+			 (regexp ,ledger-regex-note)))))
+
+(defconst ledger-regex-end-note-group
+  ledger-regex-note-group)
+(defconst ledger-regex-end-note-group--count
+  ledger-regex-note-group--count)
+
+(defconst ledger-regex-full-note
+  (macroexpand `(rx (and line-start (+ space)
+			 ?\; (regexp ,ledger-regex-note)))))
+
+(defconst ledger-regex-full-note-group
+  ledger-regex-note-group)
+(defconst ledger-regex-full-note-group--count
+  ledger-regex-note-group--count)
+
+(defconst ledger-regex-transaction-line
+  (macroexpand
+   `(rx (and line-start
+	     (regexp ,ledger-regex-full-date)
+	     (? (and (+ space) (regexp ,ledger-regex-state)))
+	     (? (and (+ space) (regexp ,ledger-regex-code)))
+	     (+ space) (+? nonl)
+	     (? (and (regexp ,ledger-regex-long-space) ?\;
+		     (regexp ,ledger-regex-note)))
+	     line-end))))
+
+(defconst ledger-regex-transaction-line-group-actual-date
+  ledger-regex-full-date-group-actual)
+(defconst ledger-regex-transaction-line-group-effective-date
+  ledger-regex-full-date-group-effective)
+(defconst ledger-regex-transaction-line-group-state
+  (+ ledger-regex-full-date-group--count
+     ledger-regex-state-group))
+(defconst ledger-regex-transaction-line-group-code
+  (+ ledger-regex-full-date-group--count
+     ledger-regex-state-group--count
+     ledger-regex-code-group))
+(defconst ledger-regex-transaction-line-group-note
+  (+ ledger-regex-full-date-group--count
+     ledger-regex-state-group--count
+     ledger-regex-code-group--count
+     ledger-regex-note-group))
+(defconst ledger-regex-full-note-group--count
+  (+ ledger-regex-full-date-group--count
+     ledger-regex-state-group--count
+     ledger-regex-code-group--count
+     ledger-regex-note-group--count))
+
+(defun ledger-regex-transaction-line-actual-date
+  (&optional string)
+  (match-string ledger-regex-transaction-line-group-actual-date string))
+
+(defconst ledger-regex-account
+  (rx (group (and (not (any ?:)) (*? nonl)))))
+
+(defconst ledger-regex-full-account
+  (macroexpand
+   `(rx (and (group (? (any ?\[ ?\))))
+	     (regexp ,ledger-regex-account)
+	     (? (any ?\] ?\)))))))
+
+(defconst ledger-regex-commodity
+  (rx (or (and ?\" (+ (not (any ?\"))) ?\")
+	  (not (any space ?\n
+		    digit
+		    ?- ?\[ ?\]
+		    ?. ?, ?\; ?+ ?* ?/ ?^ ?? ?: ?& ?| ?! ?=
+		    ?\< ?\> ?\{ ?\} ?\( ?\) ?@)))))
+
+(defconst ledger-regex-amount
+  (rx (and (? ?-)
+	   (and (+ digit)
+		(*? (and (any ?. ?,) (+ digit))))
+	   (? (and (any ?. ?,) (+ digit))))))
+
+(defconst ledger-regex-commoditized-amount
+  (macroexpand
+   `(rx (or (and (regexp ,ledger-regex-commodity)
+		 (*? space)
+		 (regexp ,ledger-regex-amount))
+	    (and (regexp ,ledger-regex-amount)
+		 (*? space)
+		 (regexp ,ledger-regex-commodity))))))
+
+(defconst ledger-regex-commodity-annotations
+  (macroexpand
+   `(rx (* (+ space)
+	   (or (and ?\{ (regexp ,ledger-regex-commoditized-amount) ?\})
+	       (and ?\[ (regexp ,ledger-regex-date) ?\])
+	       (and ?\( (not (any ?\))) ?\)))))))
+
+(defconst ledger-regex-cost
+  (macroexpand
+   `(rx (and (or "@" "@@") (+ space)
+	     (regexp ,ledger-regex-commoditized-amount)))))
+
+(defconst ledger-regex-balance-assertion
+  (macroexpand
+   `(rx (and ?= (+ space)
+	     (regexp ,ledger-regex-commoditized-amount)))))
+
+(defconst ledger-regex-full-amount
+  (macroexpand `(rx (and line-start (+ space)
+			 ?\; (regexp ,ledger-regex-note)))))
+
+(defconst ledger-regex-posting-line
+  (macroexpand
+   `(rx (and line-start
+	     (+ space) (regexp ,ledger-regex-full-account)
+	     (+ space) (regexp ,ledger-regex-full-amount)
+	     (? (regexp ,ledger-regex-end-note))
+	     line-end))))
+
-- 
cgit v1.2.3


From f672ddafc3d88eee021a608fee532825e06059c3 Mon Sep 17 00:00:00 2001
From: John Wiegley <johnw@newartisans.com>
Date: Thu, 11 Mar 2010 00:36:43 -0500
Subject: Created lisp/ldg-account.el

---
 lisp/ldg-account.el | 122 ++++++++++++++++++++++++++++++++++++++++++++++++++++
 lisp/ldg-regex.el   |  26 +++++------
 lisp/ledger.el      |   2 +-
 3 files changed, 136 insertions(+), 14 deletions(-)
 create mode 100644 lisp/ldg-account.el

(limited to 'lisp/ldg-regex.el')

diff --git a/lisp/ldg-account.el b/lisp/ldg-account.el
new file mode 100644
index 00000000..402186dd
--- /dev/null
+++ b/lisp/ldg-account.el
@@ -0,0 +1,122 @@
+(require 'ldg-regex)
+
+(defgroup ledger-account nil
+  ""
+  :group 'ledger)
+
+(defcustom ledger-account-auto-adjust-amounts t
+  "If non-nil, ."
+  :type 'boolean
+  :group 'ledger-account)
+
+(declare-function iswitchb-read-buffer "iswitchb"
+                  (prompt &optional default require-match start matches-set))
+(defvar iswitchb-temp-buflist)
+
+(defvar ledger-account-current-list nil)
+
+(defun ledger-account-find-all ()
+  (let ((origin (point))
+	(ledger-account-list nil)
+	account-path elements)
+    (save-excursion
+      (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))
+	  (unless (string-match "\\`\\s-*;" account-path)
+	    (add-to-list 'ledger-account-list account-path))))
+      (setq ledger-account-current-list
+	    (nreverse ledger-account-list)))))
+
+(defun ledger-account-completing-read (prompt choices)
+  "Use iswitchb as a completing-read replacement to choose from choices.
+PROMPT is a string to prompt with.  CHOICES is a list of strings
+to choose from."
+  (let* ((iswitchb-use-virtual-buffers nil)
+	 (iswitchb-make-buflist-hook
+	  (lambda ()
+	    (setq iswitchb-temp-buflist choices))))
+    (iswitchb-read-buffer prompt)))
+
+(defun ledger-account-select ()
+  (interactive)
+  (let* ((account
+	  (ledger-account-completing-read "Account: "
+					  (or ledger-account-current-list
+					      (ledger-account-find-all))))
+	 (account-len (length account))
+	 (pos (point)))
+    (goto-char (line-beginning-position))
+    (when (re-search-forward ledger-regex-post-line (line-end-position) t)
+      (let ((existing-len (length (match-string 3))))
+	(goto-char (match-beginning 3))
+	(delete-region (match-beginning 3) (match-end 3))
+	(insert account)
+	(cond
+	 ((> existing-len account-len)
+	  (insert (make-string (- existing-len account-len) ? )))
+	 ((< existing-len account-len)
+	  (dotimes (n (- account-len existing-len))
+	    (if (looking-at "[ \t]\\( [ \t]\\|\t\\)")
+		(delete-char 1)))))))
+    (goto-char pos)))
+
+(defun ledger-account-align-amount ()
+  (interactive)
+  (save-excursion
+    (set-mark (line-beginning-position))
+    (goto-char (1+ (line-end-position)))
+    (ledger-align-amounts)))
+
+(defun ledger-account-maybe-align (beg end len)
+  (save-excursion
+    (goto-char beg)
+    (when (< end (line-end-position))
+      (goto-char (line-beginning-position))
+      (if (looking-at ledger-regex-post-line)
+	  (ledger-account-align-amount)))))
+
+(defun ledger-account-edit-amount ()
+  (interactive)
+  (goto-char (line-beginning-position))
+  (when (re-search-forward ledger-regex-post-line (line-end-position) t)
+    (goto-char (match-end 3))
+    (when (re-search-forward "[-.,0-9]+" (line-end-position) t)
+      (let ((val (match-string 0)))
+	(goto-char (match-beginning 0))
+	(delete-region (match-beginning 0) (match-end 0))
+	(calc)
+	(while (string-match "," val)
+	  (setq val (replace-match "" nil nil val)))
+	(calc-eval val 'push)))))
+
+(defun ledger-account-prev-xact ()
+  (interactive)
+  (backward-paragraph)
+  (when (re-search-backward ledger-regex-xact-line nil t)
+    (goto-char (match-beginning 0))
+    (re-search-forward ledger-regex-post-line)
+    (goto-char (match-end 3))))
+
+(defun ledger-account-next-xact ()
+  (interactive)
+  (when (re-search-forward ledger-regex-xact-line nil t)
+    (goto-char (match-beginning 0))
+    (re-search-forward ledger-regex-post-line)
+    (goto-char (match-end 3))))
+
+(defun ledger-account-setup ()
+  (let ((map (current-local-map)))
+    (define-key map [(meta ?p)] 'ledger-account-prev-xact)
+    (define-key map [(meta ?n)] 'ledger-account-next-xact)
+    (define-key map [(control ?c) (control ?c)] 'ledger-account-select)
+    (define-key map [(control ?c) (control ?e)] 'ledger-account-select))
+  (if ledger-account-auto-adjust-amounts
+      (add-hook 'after-change-functions 'ledger-account-maybe-align t t)))
+
+(add-hook 'ledger-mode-hook 'ledger-account-setup)
+
+(provide 'ldg-account)
diff --git a/lisp/ldg-regex.el b/lisp/ldg-regex.el
index df9264f5..14c41f63 100644
--- a/lisp/ldg-regex.el
+++ b/lisp/ldg-regex.el
@@ -67,29 +67,28 @@
 (defconst ledger-regex-full-note-group--count
   ledger-regex-note-group--count)
 
-(defconst ledger-regex-transaction-line
+(defconst ledger-regex-xact-line
   (macroexpand
    `(rx (and line-start
 	     (regexp ,ledger-regex-full-date)
 	     (? (and (+ space) (regexp ,ledger-regex-state)))
 	     (? (and (+ space) (regexp ,ledger-regex-code)))
 	     (+ space) (+? nonl)
-	     (? (and (regexp ,ledger-regex-long-space) ?\;
-		     (regexp ,ledger-regex-note)))
+	     (? (regexp ,ledger-regex-end-note))
 	     line-end))))
 
-(defconst ledger-regex-transaction-line-group-actual-date
+(defconst ledger-regex-xact-line-group-actual-date
   ledger-regex-full-date-group-actual)
-(defconst ledger-regex-transaction-line-group-effective-date
+(defconst ledger-regex-xact-line-group-effective-date
   ledger-regex-full-date-group-effective)
-(defconst ledger-regex-transaction-line-group-state
+(defconst ledger-regex-xact-line-group-state
   (+ ledger-regex-full-date-group--count
      ledger-regex-state-group))
-(defconst ledger-regex-transaction-line-group-code
+(defconst ledger-regex-xact-line-group-code
   (+ ledger-regex-full-date-group--count
      ledger-regex-state-group--count
      ledger-regex-code-group))
-(defconst ledger-regex-transaction-line-group-note
+(defconst ledger-regex-xact-line-group-note
   (+ ledger-regex-full-date-group--count
      ledger-regex-state-group--count
      ledger-regex-code-group--count
@@ -100,9 +99,9 @@
      ledger-regex-code-group--count
      ledger-regex-note-group--count))
 
-(defun ledger-regex-transaction-line-actual-date
+(defun ledger-regex-xact-line-actual-date
   (&optional string)
-  (match-string ledger-regex-transaction-line-group-actual-date string))
+  (match-string ledger-regex-xact-line-group-actual-date string))
 
 (defconst ledger-regex-account
   (rx (group (and (not (any ?:)) (*? nonl)))))
@@ -154,14 +153,15 @@
 	     (regexp ,ledger-regex-commoditized-amount)))))
 
 (defconst ledger-regex-full-amount
-  (macroexpand `(rx (and line-start (+ space)
-			 ?\; (regexp ,ledger-regex-note)))))
+  (macroexpand `(rx (group (+? (not (any ?\;)))))))
 
-(defconst ledger-regex-posting-line
+(defconst ledger-regex-post-line
   (macroexpand
    `(rx (and line-start
+	     (? (and (+ space) (regexp ,ledger-regex-state)))
 	     (+ space) (regexp ,ledger-regex-full-account)
 	     (+ space) (regexp ,ledger-regex-full-amount)
 	     (? (regexp ,ledger-regex-end-note))
 	     line-end))))
 
+(provide 'ldg-regex)
diff --git a/lisp/ledger.el b/lisp/ledger.el
index c2407261..4b3cf88f 100644
--- a/lisp/ledger.el
+++ b/lisp/ledger.el
@@ -1226,7 +1226,7 @@ the default."
   "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)
+  (if (or (null column) (= column 1))
       (setq column 52))
   (save-excursion
     (let* ((mark-first (< (mark) (point)))
-- 
cgit v1.2.3