Cleaned up commodities and completion code.

lisp/ledger-commodities.el

@@ -33,11 +33,6 @@
   :type 'string
   :group 'ledger-reconcile)
 
-(defcustom ledger-scale  10000
-  "The 10 ^ maximum number of digits you would expect to appear in your reports.
-This is a cheap way of getting around floating point silliness in subtraction"
-  :group 'ledger)
-
 (defun ledger-split-commodity-string (str)
   "Split a commoditized string, STR, into two parts.
 Returns a list with (value commodity)."
@@ -86,11 +81,7 @@ Returns a list with (value commodity)."
 (defun -commodity (c1 c2)
   "Subtract C2 from C1, ensuring their commodities match."
   (if (string= (cadr c1) (cadr c2))
-                                        ; the scaling below is to get around inexact
+      (list (-(car c1) (car c2)) (cadr c1))
-                                        ; subtraction results where, for example 1.23
-                                        ; - 4.56 = -3.3299999999999996 instead of
-                                        ; -3.33
-      (list (/ (-  (* ledger-scale (car c1)) (* ledger-scale (car c2))) ledger-scale) (cadr c1))
     (error "Can't subtract different commodities %S from %S" c2 c1)))
 
 (defun +commodity (c1 c2)
@@ -100,22 +91,21 @@ Returns a list with (value commodity)."
     (error "Can't add different commodities, %S to %S" c1 c2)))
 
 (defun ledger-strip (str char)
-  (let (new-str)
+	"Return STR with CHAR removed."
-    (concat (dolist (ch (append str nil) new-str)
+	(replace-regexp-in-string char "" str))
-              (unless (= ch char)
-                (setq new-str (append new-str (list ch))))))))
 
 (defun ledger-string-to-number (str &optional decimal-comma)
   "improve builtin string-to-number by handling internationalization, and return nil if number can't be parsed"
   (let ((nstr (if (or decimal-comma
                       (assoc "decimal-comma" ledger-environment-alist))
-                  (ledger-strip str ?.)
+                  (ledger-strip str ".")
-                (ledger-strip str ?,))))
+                (ledger-strip str ","))))
     (while (string-match "," nstr)  ;if there is a comma now, it is a thousands separator
       (setq nstr (replace-match "." nil nil nstr)))
     (string-to-number nstr)))
 
 (defun ledger-number-to-string (n &optional decimal-comma)
+	"number-to-string that handles comma as decimal."
   (let ((str (number-to-string n)))
     (when (or decimal-comma
               (assoc "decimal-comma" ledger-environment-alist))
@@ -134,6 +124,7 @@ longer ones are after the value."
       (concat commodity " " str))))
 
 (defun ledger-read-commodity-string (prompt)
+	"Read an amount from mini-buffer using PROMPT."
   (let ((str (read-from-minibuffer
               (concat prompt " (" ledger-reconcile-default-commodity "): ")))
         comm)

lisp/ledger-complete.el

@@ -157,9 +157,7 @@
             (ledger-accounts)))))
 
 (defun ledger-trim-trailing-whitespace (str)
-  (let ((s str))
+	(replace-regexp-in-string "[ \t]*$" "" str))
-    (when (string-match "[ \t]*$" s)
-      (replace-match "" nil nil s))))
 
 (defun ledger-fully-complete-xact ()
   "Completes a transaction if there is another matching payee in the buffer.

lisp/ledger-mode.el

@@ -273,7 +273,7 @@ With a prefix argument, remove the effective date. "
     ["Narrow to REGEX" ledger-occur]
     ["Ledger Statistics" ledger-display-ledger-stats ledger-works]
     "---"
-    ["Show upcoming transactions" ledger-schedule-upcoming ledger-schedule-available]
+    ["Show upcoming transactions" ledger-schedule-upcoming]
     ["Add Transaction (ledger xact)" ledger-add-transaction ledger-works]
     ["Complete Transaction" ledger-fully-complete-xact]
     ["Delete Transaction" ledger-delete-current-transaction]
@@ -312,8 +312,6 @@ With a prefix argument, remove the effective date. "
 (define-derived-mode ledger-mode text-mode "Ledger"
   "A mode for editing ledger data files."
   (ledger-check-version)
-  (ledger-schedule-check-available)
-
   (if (boundp 'font-lock-defaults)
       (setq-local font-lock-defaults
 									'(ledger-font-lock-keywords t t nil nil

lisp/ledger-schedule.el

@@ -22,7 +22,7 @@
 ;;; Commentary:
 ;;
 ;; This module provides for automatically adding transactions to a
-;; ledger buffer on a periodic basis. Recurrence expressions are
+;; ledger buffer on a periodic basis.  Recurrence expressions are
 ;; inspired by Martin Fowler's "Recurring Events for Calendars",
 ;; martinfowler.com/apsupp/recurring.pdf
 
@@ -32,12 +32,14 @@
 
 (require 'ledger-init)
 
+;;; Code:
+
 (defgroup ledger-schedule nil
   "Support for automatically recommendation transactions."
   :group 'ledger)
 
 (defcustom ledger-schedule-buffer-name "*Ledger Schedule*"
-  "Name for the schedule buffer"
+  "Name for the schedule buffer."
   :type 'string
   :group 'ledger-schedule)
 
@@ -47,7 +49,7 @@
   :group 'ledger-schedule)
 
 (defcustom ledger-schedule-look-forward 14
-  "Number of days auto look forward to recommend transactions"
+  "Number of days auto look forward to recommend transactions."
   :type 'integer
   :group 'ledger-schedule)
 
@@ -56,37 +58,40 @@
   :type 'file
   :group 'ledger-schedule)
 
-(defvar ledger-schedule-available nil)
+(defcustom ledger-schedule-week-days '(("Mo" 1)
+																			 ("Tu" 2)
+																			 ("We" 3)
+																			 ("Th" 4)
+																			 ("Fr" 5)
+																			 ("Sa" 6)
+																			 ("Su" 7))
+	"List of weekday abbreviations.  There must be exactly seven
+entries each with a two character abbreviation for a day and the
+number of that day in the week. "
+	:type '(alist :value-type (group integer))
+	:group 'ledger-schedule)
 
 (defsubst between (val low high)
-  (and (>= val low) (<= val high)))
+	"Return TRUE if VAL > LOW and < HIGH."
-
+	(and (>= val low) (<= val high)))
-(defun ledger-schedule-check-available ()
-  (setq ledger-schedule-available (and ledger-schedule-file
-                                       (file-exists-p ledger-schedule-file))))
 
 (defun ledger-schedule-days-in-month (month year)
   "Return number of days in the MONTH, MONTH is from 1 to 12.
-If year is nil, assume it is not a leap year"
+If YEAR is nil, assume it is not a leap year"
   (if (between month 1 12)
       (if (and year (date-leap-year-p year) (= 2 month))
           29
         (nth (1- month) '(31 28 31 30 31 30 31 31 30 31 30 31)))
     (error "Month out of range, MONTH=%S" month)))
 
-(defun ledger-schedule-encode-day-of-week ( day-string)
+(defun ledger-schedule-encode-day-of-week (day-string)
-	"return the numerical day of week corresponding to DAY-STRING"
+	"Return the numerical day of week corresponding to DAY-STRING."
-	(cond ((string= day-string "Su") 7)
+	(cadr (assoc day-string ledger-schedule-week-days)))
-				((string= day-string "Mo") 1)
+
-				((string= day-string "Tu") 2)
-				((string= day-string "We") 3)
-				((string= day-string "Th") 4)
-				((string= day-string "Fr") 5)
-				((string= day-string "Sa") 6)))
 ;; Macros to handle date expressions
 
 (defun ledger-schedule-constrain-day-in-month (count day-of-week)
-  "Return a form that evaluates DATE that returns true for the COUNT DAY-OF-WEEK.
+  "Return a form that returns TRUE for the  the COUNT DAY-OF-WEEK.
 For example, return true if date is the 3rd Thursday of the
 month.  Negative COUNT starts from the end of the month. (EQ
 COUNT 0) means EVERY day-of-week (eg. every Saturday)"
@@ -118,7 +123,7 @@ COUNT 0) means EVERY day-of-week (eg. every Saturday)"
            day-of-week)))
 
 (defun ledger-schedule-constrain-every-count-day (day-of-week skip start-date)
-  "Return a form that is true for every DAY skipping SKIP, starting on START.
+  "Return a form that is true for every DAY-OF-WEEK skipping SKIP, starting on START-DATE.
 For example every second Friday, regardless of month."
   (let ((start-day (nth 6 (decode-time start-date))))
     (if (eq start-day day-of-week)  ;; good, can proceed
@@ -139,12 +144,9 @@ For example every second Friday, regardless of month."
                  (< ,target-day ,day2))))))
 
 
-(defun ledger-schedule-is-holiday (date)
-  "Return true if DATE is a holiday."
-	nil)
 
 (defun ledger-schedule-scan-transactions (schedule-file)
-  "Scans SCHEDULE-FILE and returns a list of transactions with date predicates.
+  "Scan SCHEDULE-FILE and return a list of transactions with date predicates.
 The car of each item is a function of date that returns true if
 the transaction should be logged for that day."
   (interactive "fFile name: ")
@@ -156,13 +158,13 @@ the transaction should be logged for that day."
         (let ((date-descriptor "")
               (transaction nil)
               (xact-start (match-end 0)))
-          (setq date-descriptors
+          (setq date-descriptor
                 (ledger-schedule-read-descriptor-tree
                  (buffer-substring-no-properties
                   (match-beginning 0)
                   (match-end 0))))
           (forward-paragraph)
-          (setq transaction (list date-descriptors
+          (setq transaction (list date-descriptor
                                   (buffer-substring-no-properties
                                    xact-start
                                    (point))))
@@ -170,10 +172,13 @@ the transaction should be logged for that day."
       xact-list)))
 
 (defun ledger-schedule-read-descriptor-tree (descriptor-string)
-	(ledger-schedule-transform-auto-tree (split-string (substring descriptor-string 1 (string-match "]" descriptor-string)) " ")))
+	"Read DESCRIPTOR-STRING and return a form that evaluates dates."
+	(ledger-schedule-transform-auto-tree
+	 (split-string
+		(substring descriptor-string 1 (string-match "]" descriptor-string)) " ")))
 
 (defun ledger-schedule-transform-auto-tree (descriptor-string-list)
-  "Takes a lisp list of date descriptor strings, TREE, and returns a string with a lambda function of date."
+  "Take DESCRIPTOR-STRING-LIST, and return a string with a lambda function of date."
   ;; use funcall to use the lambda function spit out here
   (if (consp descriptor-string-list)
       (let (result)
@@ -194,7 +199,7 @@ the transaction should be logged for that day."
            ,(nconc (list 'or) (nreverse result) descriptor-string-list)))))
 
 (defun ledger-schedule-compile-constraints (descriptor-string)
-  "Return a list with the year, month and day fields split"
+  "Return a list with the year, month and day fields split."
   (let ((fields (split-string descriptor-string "[/\\-]" t)))
 		(if (string-match "[A-Za-z]" descriptor-string)
 				(ledger-schedule-constrain-day (nth 0 fields) (nth 1 fields) (nth 2 fields))
@@ -204,6 +209,10 @@ the transaction should be logged for that day."
 						(ledger-schedule-constrain-month (nth 0 fields) (nth 1 fields) (nth 2 fields))))))
 
 (defun ledger-schedule-constrain-year (year-desc month-desc day-desc)
+	"Return a form that constrains the year.
+
+YEAR-DESC, MONT-DESC, and DAY-DESC are the string portions of the
+date descriptor."
 	(cond ((string= year-desc "*") t)
 				((/= 0 (string-to-number year-desc))
 				 `(memq (nth 5 (decode-time date)) ',(mapcar 'string-to-number (split-string year-desc ","))))
@@ -211,6 +220,10 @@ the transaction should be logged for that day."
 				 (error "Improperly specified year constraint: %s %s %s" year-desc month-desc day-desc))))
 
 (defun ledger-schedule-constrain-month (year-desc month-desc day-desc)
+	"Return a form that constrains the month.
+
+YEAR-DESC, MONT-DESC, and DAY-DESC are the string portions of the
+date descriptor."
 	(cond ((string= month-desc "*")
 				 t)  ;; always match
 				((string= month-desc "E")  ;; Even
@@ -223,6 +236,10 @@ the transaction should be logged for that day."
 				 (error "Improperly specified month constraint: %s %s %s" year-desc month-desc day-desc))))
 
 (defun ledger-schedule-constrain-day (year-desc month-desc day-desc)
+	"Return a form that constrains the day.
+
+YEAR-DESC, MONT-DESC, and DAY-DESC are the string portions of the
+date descriptor."
 	(cond ((string= day-desc "*")
 				 t)
 				((string-match "[A-Za-z]" day-desc)  ;; There is something other than digits and commas
@@ -235,6 +252,7 @@ the transaction should be logged for that day."
 
 
 (defun ledger-schedule-parse-complex-date (year-desc month-desc day-desc)
+	"Parse day descriptors that have repeats."
 	(let ((years (mapcar 'string-to-number (split-string year-desc ",")))
 				(months (mapcar 'string-to-number (split-string month-desc ",")))
 				(day-parts (split-string day-desc "+"))
@@ -252,7 +270,7 @@ the transaction should be logged for that day."
 				(ledger-schedule-constrain-day-in-month count day-of-week)))))
 
 (defun ledger-schedule-list-upcoming-xacts (candidate-items early horizon)
-	"Search CANDIDATE-ITEMS for xacts that occur within the period today - EARLY  to today + HORIZON"
+	"Search CANDIDATE-ITEMS for xacts that occur within the period today - EARLY  to today + HORIZON."
 	(let ((start-date (time-subtract (current-time) (days-to-time early)))
 				test-date items)
 		(loop for day from 0 to (+ early horizon) by 1 do
@@ -262,12 +280,6 @@ the transaction should be logged for that day."
 								(setq items (append items (list (list test-date (cadr candidate))))))))
 		items))
 
-(defun ledger-schedule-already-entered (candidate buffer)
-	"return TRUE if CANDIDATE is already in BUFFER"
-  (let ((target-date (format-time-string date-format (car candidate)))
-        (target-payee (cadr candidate)))
-    nil))
-
 (defun ledger-schedule-create-auto-buffer (candidate-items early horizon ledger-buf)
   "Format CANDIDATE-ITEMS for display."
   (let ((candidates (ledger-schedule-list-upcoming-xacts candidate-items early horizon))
@@ -283,7 +295,7 @@ the transaction should be logged for that day."
     (length candidates)))
 
 (defun ledger-schedule-upcoming (file look-backward look-forward)
-  "Generate upcoming transaction
+  "Generate upcoming transactions.
 
 FILE is the file containing the scheduled transaction,
 default to `ledger-schedule-file'.
@@ -298,12 +310,16 @@ Use a prefix arg to change the default value"
                          (read-number "Look backward: " ledger-schedule-look-backward)
                          (read-number "Look forward: " ledger-schedule-look-forward))
                  (list ledger-schedule-file ledger-schedule-look-backward ledger-schedule-look-forward)))
-  (ledger-schedule-create-auto-buffer
+  (if (and ledger-schedule-file
-   (ledger-schedule-scan-transactions file)
+				 (file-exists-p ledger-schedule-file))
-   look-backward
+			(progn
-   look-forward
+				(ledger-schedule-create-auto-buffer
-   (current-buffer))
+				 (ledger-schedule-scan-transactions file)
-  (pop-to-buffer ledger-schedule-buffer-name))
+				 look-backward
+				 look-forward
+				 (current-buffer))
+				(pop-to-buffer ledger-schedule-buffer-name))
+		(error "Could not find ledger schedule file at %s" ledger-schedule-file)))
 
 
 (provide 'ledger-schedule)