Refactoring and style.

lisp/ldg-context.el

@@ -41,6 +41,15 @@
 (defconst code-string "\\((\\(.*\\))\\)?")
 (defconst payee-string "\\(.*\\)")
 
+(defmacro line-regex (&rest elements)
+  (let (regex-string)
+    (concat (dolist (e elements regex-string)
+	      (setq regex-string 
+		    (concat regex-string 
+			    (eval 
+			     (intern 
+			      (concat (symbol-name e) "-string")))))) "[ \t]*$")))
+
 (defmacro single-line-config (&rest elements)
 "Take list of ELEMENTS and return regex and element list for use in context-at-point"
   (let (regex-string)

lisp/ldg-init.el

@@ -30,16 +30,16 @@
 
 (defvar ledger-environment-alist nil)
 
-(defun ledger-init-parse-initialization (file)
+(defun ledger-init-parse-initialization (buffer)
-  (with-current-buffer file
+  (with-current-buffer buffer
-    (setq ledger-environment-alist nil)
+    (let (environment-alist)
       (goto-char (point-min))
       (while (re-search-forward ledger-init-string-regex nil t )
 	(let ((matchb (match-beginning 0)) ;; save the match data, string-match stamp on it
 	      (matche (match-end 0)))
 	  (end-of-line)
-	(setq ledger-environment-alist 
+	  (setq environment-alist 
-	      (append ledger-environment-alist
+		(append environment-alist
 			(list (cons (let ((flag (buffer-substring-no-properties (+ 2 matchb) matche)))
 				      (if (string-match "[ \t\n\r]+\\'" flag)
 					  (replace-match "" t t flag)
@@ -48,7 +48,7 @@
 				      (if (> (length value) 0)
 					  value
 					  t))))))))
-    ledger-environment-alist))
+      environment-alist)))
 
 (defun ledger-init-load-init-file ()
   (interactive)
@@ -59,7 +59,8 @@
 		  (file-exists-p ledger-init-file-name)
 		  (file-readable-p ledger-init-file-name))	 
 	 (find-file-noselect ledger-init-file-name)
-	 (ledger-init-parse-initialization init-base-name)
+	 (setq ledger-environment-alist 
+	       (ledger-init-parse-initialization init-base-name))
 	 (kill-buffer init-base-name)))))
 
 (provide 'ldg-init)

lisp/ldg-mode.el

@@ -41,8 +41,7 @@
 
 (defun ledger-read-account-with-prompt (prompt) 
   (let* ((context (ledger-context-at-point))
-	 (default
+	 (default (if (and (eq (ledger-context-line-type context) 'acct-transaction)
-	  (if (and (eq (ledger-context-line-type context) 'acct-transaction)
 			   (eq (ledger-context-current-field context) 'account))
 		      (regexp-quote (ledger-context-field-value context 'account))
 		      nil)))
@@ -50,17 +49,16 @@
 
 (defun ledger-read-string-with-default (prompt default)
   "Return user supplied string after PROMPT, or DEFAULT."
-  (let ((default-prompt (concat prompt
+  (read-string (concat prompt
 		       (if default
 			   (concat " (" default "): ")
-				    ": "))))
+			   ": ")) 
-    (read-string default-prompt nil 'ledger-minibuffer-history default)))
+	       nil 'ledger-minibuffer-history default))
 
 (defun ledger-display-balance-at-point ()
   "Display the cleared-or-pending balance.
 And calculate the target-delta of the account being reconciled."
   (interactive)
-  
   (let* ((account (ledger-read-account-with-prompt "Account balance to show"))
 	 (buffer (current-buffer))
 	 (balance (with-temp-buffer
@@ -188,18 +186,7 @@ Can be pcomplete, or align-posting"
       (define-key map [reconcile] '(menu-item "Reconcile Account" ledger-reconcile :enable ledger-works))
       (define-key map [reconcile] '(menu-item "Narrow to REGEX" ledger-occur))))
 
-(defun ledger-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, T1 - T2.
-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-set-year (newyear)
@@ -216,57 +203,7 @@ Return the difference in the format of a time value."
       (setq ledger-month (read-string "Month: " (ledger-current-month)))
       (setq ledger-month (format "%02d" newmonth))))
 
-(defun ledger-add-transaction (transaction-text &optional insert-at-point)
-  "Use ledger xact TRANSACTION-TEXT to add a transaction to the buffer.
-If INSERT-AT-POINT is non-nil insert the transaction
-there, otherwise call `ledger-xact-find-slot' to insert it at the
-correct chronological place in the buffer."
-  (interactive (list
-		(read-string "Transaction: " (concat ledger-year "/" ledger-month "/"))))
-  (let* ((args (with-temp-buffer
-                 (insert transaction-text)
-                 (eshell-parse-arguments (point-min) (point-max))))
-         (ledger-buf (current-buffer))
-         exit-code)
-    (unless insert-at-point
-      (let ((date (car args)))
-        (if (string-match ledger-iso-date-regexp date)
-            (setq date
-                  (encode-time 0 0 0 (string-to-number (match-string 4 date))
-                               (string-to-number (match-string 3 date))
-                               (string-to-number (match-string 2 date)))))
-        (ledger-xact-find-slot date)))
-    (if (> (length args) 1)
-	(save-excursion
-	  (insert
-	   (with-temp-buffer
-	     (setq exit-code
-		   (apply #'ledger-exec-ledger ledger-buf (current-buffer) "xact"
-			  (mapcar 'eval args)))
-	     (goto-char (point-min))
-	     (if (looking-at "Error: ")
-		 (error (concat "Error in ledger-add-transaction: " (buffer-string)))
-		 (buffer-string)))
-	   "\n"))
-	(progn
-	  (insert (car args) " \n\n")
-	  (end-of-line -1)))))
 
-(defun ledger-current-transaction-bounds ()
-  "Return markers for the beginning and end of transaction surrounding point."
-  (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-transaction ()
-  "Delete the transaction surrounging point."
-  (interactive)
-  (let ((bounds (ledger-current-transaction-bounds)))
-    (delete-region (car bounds) (cdr bounds))))
 
 (provide 'ldg-mode)
 

lisp/ldg-new.el

@@ -65,33 +65,6 @@
 (defconst ledger-version "3.0"
   "The version of ledger.el currently loaded.")
 
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(defun ledger-create-test ()
-  "Create a regression test."
-  (interactive)
-  (save-restriction
-    (org-narrow-to-subtree)
-    (save-excursion
-      (let (text beg)
-        (goto-char (point-min))
-        (forward-line 1)
-        (setq beg (point))
-        (search-forward ":PROPERTIES:")
-        (goto-char (line-beginning-position))
-        (setq text (buffer-substring-no-properties beg (point)))
-        (goto-char (point-min))
-        (re-search-forward ":ID:\\s-+\\([^-]+\\)")
-        (find-file-other-window
-         (format "~/src/ledger/test/regress/%s.test" (match-string 1)))
-        (sit-for 0)
-        (insert text)
-        (goto-char (point-min))
-        (while (not (eobp))
-          (goto-char (line-beginning-position))
-          (delete-char 3)
-          (forward-line 1))))))
-
 (defun ledger-mode-dump-variable (var)
   (if var
    (insert (format "         %s: %S\n" (symbol-name var) (eval var)))))

lisp/ldg-occur.el

@@ -96,8 +96,8 @@ When REGEX is nil, unhide everything, and remove higlight"
   (interactive
    (if ledger-occur-mode
        (list nil)
-       (list (read-string (concat "Regexp<" (ledger-occur-prompt)
+       (list (read-string (concat "Regexp<" (ledger-occur-prompt) ">: ") 
-				  ">: ") nil 'ledger-occur-history (ledger-occur-prompt)))))
+			  nil 'ledger-occur-history (ledger-occur-prompt)))))
   (ledger-occur-mode regex (current-buffer)))
 
 (defun ledger-occur-prompt ()
@@ -121,21 +121,12 @@ When REGEX is nil, unhide everything, and remove higlight"
 (defun ledger-occur-create-narrowed-overlays(buffer-matches)
   (if buffer-matches
       (let ((overlays
-             (let ((prev-end (point-min))
+             (let ((prev-end (point-min)))
-                   (temp (point-max)))
                (mapcar (lambda (match)
-                         (progn
+                         (prog1
-                           (setq temp prev-end) ;; need a swap so that
+			     (make-overlay prev-end (car match)
-						;; the last form in
+					   (current-buffer) t nil)
-						;; the lambda is the
+                           (setq prev-end (1+ (cadr match)))))
-						;; (make-overlay)
-                           (setq prev-end (1+ (cadr match)))
-					;; add 1 so that we skip the
-					;; empty line after the xact
-                           (make-overlay
-                            temp
-                            (car match)
-                            (current-buffer) t nil)))
                        buffer-matches))))
         (mapcar (lambda (ovl)
                   (overlay-put ovl ledger-occur-overlay-property-name t)
@@ -151,8 +142,7 @@ When REGEX is nil, unhide everything, and remove higlight"
 Argument OVL-BOUNDS contains bounds for the transactions to be left visible."
   (let ((overlays
          (mapcar (lambda (bnd)
-                   (make-overlay
+                   (make-overlay (car bnd)
-                    (car bnd)
 				 (cadr bnd)
 				 (current-buffer) t nil))
                  ovl-bounds)))
@@ -196,8 +186,8 @@ Used for coordinating `ledger-occur' with other buffers, like reconcile."
   (save-excursion
     (goto-char (point-min))
     ;; Set initial values for variables
-    (let ((curpoint nil)
+    (let (curpoint 
-          (endpoint nil)
+	  endpoint
 	  (lines (list)))
       ;; Search loop
       (while (not (eobp))

lisp/ldg-post.el

@@ -69,14 +69,14 @@
 
 (declare-function iswitchb-read-buffer "iswitchb"
                   (prompt &optional default require-match start matches-set))
+
 (defvar iswitchb-temp-buflist)
 
 (defun ledger-post-completing-read (prompt choices)
   "Use iswitchb as a `completing-read' replacement to choose from choices.
-PROMPT is a string to prompt with.  CHOICES is a list of
+PROMPT is a string to prompt with.  CHOICES is a list of strings
-   strings to choose from."
+to choose from."
-  (cond
+  (cond ((eq ledger-post-use-completion-engine :iswitchb)
-    ((eq ledger-post-use-completion-engine :iswitchb)
 	 (let* ((iswitchb-use-virtual-buffers nil)
 		(iswitchb-make-buflist-hook
 		 (lambda ()

lisp/ldg-sort.el

@@ -28,8 +28,7 @@
 
 (defun ledger-next-record-function ()
   "Move point to next transaction."
-  (if (re-search-forward  ledger-payee-any-status-regex
+  (if (re-search-forward  ledger-payee-any-status-regex nil t)
-       			 nil t)
       (goto-char (match-beginning 0))
       (goto-char (point-max))))
 

lisp/ldg-state.el

@@ -30,15 +30,6 @@
   :type 'boolean
   :group 'ledger)
 
-(defun ledger-toggle-state (state &optional style)
-  "Return the correct toggle state given the current STATE, and STYLE."
-  (if (not (null state))
-      (if (and style (eq style 'cleared))
-          'cleared)
-      (if (and style (eq style 'pending))
-	  'pending
-	  'cleared)))
-
 (defun ledger-transaction-state ()
   "Return the state of the transaction at point."
   (save-excursion
@@ -69,14 +60,10 @@
 
 (defun ledger-state-from-char (state-char)
   "Get state from STATE-CHAR."
-  (cond ((eql state-char ?\!)
+  (cond ((eql state-char ?\!) 'pending)
-	 'pending)
+	((eql state-char ?\*) 'cleared)
-	((eql state-char ?\*)
+	((eql state-char ?\;) 'comment)
-	 'cleared)
+	(t nil)))
-	((eql state-char ?\;)
-	 'comment)
-	(t
-	 nil)))
 
 (defun ledger-toggle-current-posting (&optional style)
   "Toggle the cleared status of the transaction under point.
@@ -90,7 +77,7 @@ achieved more certainly by passing the xact to ledger for
 formatting, but doing so causes inline math expressions to be
 dropped."
   (interactive)
-  (let ((bounds (ledger-current-transaction-bounds))
+  (let ((bounds (ledger-find-xact-extents (point)))
         new-status cur-status)
     ;; Uncompact the xact, to make it easier to toggle the
     ;; transaction
@@ -232,7 +219,6 @@ dropped."
 (defun ledger-toggle-current-transaction (&optional style)
   "Toggle the transaction at point using optional STYLE."
   (interactive)
-  (let (status)
   (save-excursion
     (when (or (looking-at "^[0-9]")
 	      (re-search-backward "^[0-9]" nil t))
@@ -244,15 +230,14 @@ dropped."
 	    (delete-char 1)
 	    (when (and style (eq style 'cleared))		
 	      (insert " *")
-		(setq status 'cleared)))
+	      'cleared))
 	  (if (and style (eq style 'pending))
 	      (progn
 		(insert " ! ")
-		  (setq status 'pending))
+		'pending)
 	      (progn
 		(insert " * ")
-		  (setq status 'cleared))))))
+		'cleared))))))
-    status))
 
 (provide 'ldg-state)
 

lisp/ldg-test.el

@@ -33,6 +33,33 @@
   :type 'file
   :group 'ledger-test)
 
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defun ledger-create-test ()
+  "Create a regression test."
+  (interactive)
+  (save-restriction
+    (org-narrow-to-subtree)
+    (save-excursion
+      (let (text beg)
+        (goto-char (point-min))
+        (forward-line 1)
+        (setq beg (point))
+        (search-forward ":PROPERTIES:")
+        (goto-char (line-beginning-position))
+        (setq text (buffer-substring-no-properties beg (point)))
+        (goto-char (point-min))
+        (re-search-forward ":ID:\\s-+\\([^-]+\\)")
+        (find-file-other-window
+         (format "~/src/ledger/test/regress/%s.test" (match-string 1)))
+        (sit-for 0)
+        (insert text)
+        (goto-char (point-min))
+        (while (not (eobp))
+          (goto-char (line-beginning-position))
+          (delete-char 3)
+          (forward-line 1))))))
+
 (defun ledger-test-org-narrow-to-entry ()
   (outline-back-to-heading)
   (narrow-to-region (point) (progn (outline-next-heading) (point)))

lisp/ldg-xact.el

@@ -39,17 +39,14 @@ within the transaction."
   (interactive "d")
   (save-excursion
     (goto-char pos)
-    (let ((end-pos pos)
+    (list (progn
-	  (beg-pos pos))
 	    (backward-paragraph)
 	    (if (/= (point) (point-min))
 		(forward-line))
-      (setq beg-pos (line-beginning-position))
+	    (line-beginning-position))
+	  (progn
 	    (forward-paragraph)
-      (forward-line -1)
+	    (line-beginning-position)))))
-      (setq end-pos (1+ (line-end-position)))
-      (list beg-pos end-pos))))
-
 
 (defun ledger-highlight-xact-under-point ()
   "Move the highlight overlay to the current transaction."
@@ -76,6 +73,12 @@ within the transaction."
           (ledger-context-field-value context-info 'payee)
 	  nil))))
 
+(defun ledger-time-less-p (t1 t2)
+  "Say whether time value T1 is less than time value T2."
+  (or (< (car t1) (car t2))
+      (and (= (car t1) (car t2))
+           (< (nth 1 t1) (nth 1 t2)))))
+
 (defun ledger-xact-find-slot (moment)
   "Find the right place in the buffer for a transaction at MOMENT.
 MOMENT is an encoded date"
@@ -138,6 +141,49 @@ MOMENT is an encoded date"
     (replace-match date)
     (ledger-next-amount)))
 
+(defun ledger-delete-current-transaction (pos)
+  "Delete the transaction surrounging point."
+  (interactive "d")
+  (let ((bounds (ledger-find-xact-extents pos)))
+    (delete-region (car bounds) (cadr bounds))))
+
+(defun ledger-add-transaction (transaction-text &optional insert-at-point)
+  "Use ledger xact TRANSACTION-TEXT to add a transaction to the buffer.
+If INSERT-AT-POINT is non-nil insert the transaction
+there, otherwise call `ledger-xact-find-slot' to insert it at the
+correct chronological place in the buffer."
+  (interactive (list
+		(read-string "Transaction: " (concat ledger-year "/" ledger-month "/"))))
+  (let* ((args (with-temp-buffer
+                 (insert transaction-text)
+                 (eshell-parse-arguments (point-min) (point-max))))
+         (ledger-buf (current-buffer))
+         exit-code)
+    (unless insert-at-point
+      (let ((date (car args)))
+        (if (string-match ledger-iso-date-regexp date)
+            (setq date
+                  (encode-time 0 0 0 (string-to-number (match-string 4 date))
+                               (string-to-number (match-string 3 date))
+                               (string-to-number (match-string 2 date)))))
+        (ledger-xact-find-slot date)))
+    (if (> (length args) 1)
+	(save-excursion
+	  (insert
+	   (with-temp-buffer
+	     (setq exit-code
+		   (apply #'ledger-exec-ledger ledger-buf (current-buffer) "xact"
+			  (mapcar 'eval args)))
+	     (goto-char (point-min))
+	     (if (looking-at "Error: ")
+		 (error (concat "Error in ledger-add-transaction: " (buffer-string)))
+		 (buffer-string)))
+	   "\n"))
+	(progn
+	  (insert (car args) " \n\n")
+	  (end-of-line -1)))))
+
+
 (provide 'ldg-xact)
 
 ;;; ldg-xact.el ends here