*** empty log message ***

git-svn-id: svn+ssh://svn.gnucash.org/repo/gnucash/trunk@2065 57a11ea4-9604-0410-9ed3-97b8803252fd

README

@@ -245,8 +245,6 @@ fr_CH
 de_CH
 
 
-
-
 Other Tools
 -----------
 A tool to generate (ascii) reports from gnucash/xacc files can be found 

src/scm/date-utilities.scm

@@ -0,0 +1,82 @@
+;; -*-scheme-*-
+;; dateutils.scm
+;; date utility functions.  mainly used by budget
+;; Bryan Larsen (blarsen@ada-works.com)
+
+(gnc:support "dateutils.scm")
+
+;; get stuff from localtime date vector
+(define (gnc:date-get-year datevec)
+  (vector-ref datevec 5))
+(define (gnc:date-get-month-day datevec)
+  (vector-ref datevec 3))
+;; get month with january==1
+(define (gnc:date-get-month datevec)
+  (+ (vector-ref datevec 4) 1))
+(define (gnc:date-get-week-day datevec)
+  (vector-ref datevec 6))
+(define (gnc:date-get-year-day datevec)
+  (vector-ref datevec 7))
+
+;; is leap year?
+(define (gnc:leap-year? year)
+  (if (= (remainder year 4) 0)
+      (if (= (remainder year 100) 0)
+	  (if (= (remainder year 400) 0) #t #f)
+	  #t)
+      #f))
+
+;; number of days in year
+(define (gnc:days-in-year year)
+  (if (gnc:leap-year? year) 366 365))
+
+;; number of days in month
+(define (gnc:days-in-month month year)
+  (case month
+    ((1 3 5 7 8 10 12) 31)
+    ((4 6 9 11) 30)
+    ((2) (if (gnc:leap-year? year) 29 28))))
+
+;; convert a date in seconds since 1970 into # of years since 1970 as
+;; a fraction.
+(define (gnc:date-to-year-fraction caltime)
+  (let ((lt (localtime caltime)))
+    (+ (- (gnc:date-get-year lt) 1970)
+       (/ (gnc:date-get-year-day lt) (* 1.0 (gnc:days-in-year 
+					     (gnc:date-get-year lt)))))))
+
+;; convert a date in seconds since 1970 into # of months since 1970
+(define (gnc:date-to-month-fraction caltime)
+  (let ((lt (localtime caltime)))
+    (+ (* 12 (- (gnc:date-get-year lt) 1970.0))
+       (/ (- (gnc:date-get-month-day lt) 1.0) (gnc:days-in-month 
+					       (gnc:date-get-month lt)
+					       (gnc:date-get-year lt))))))
+
+;; convert a date in seconds since 1970 into # of weeks since Jan 4, 1970
+;; ignoring leap-seconds
+(define (gnc:date-to-week-fraction caltime)
+  (/ (- (/ (/ caltime 3600.0) 24) 3) 7))
+
+;; convert a date in seconds since 1970 into # of days since Jan 1, 1970
+;; ignoring leap-seconds
+(define (gnc:date-to-day-fraction caltime)
+  (/ (/ caltime 3600.0) 24))
+
+;; convert a date to a defined fraction
+(define (gnc:date-to-N-fraction caltime type)
+  (case type
+    ((gnc:budget-day) (gnc:date-to-day-fraction caltime))
+    ((gnc:budget-week) (gnc:date-to-week-fraction caltime))
+    ((gnc:budget-month) (gnc:date-to-month-fraction caltime))
+    ((gnc:budget-year) (gnc:date-to-year-fraction caltime))
+    (else (gnc:debug "undefined period type in budget!") #f)))
+
+;; describe a time type
+(define (gnc:date-describe-type type)
+  (case type
+    ((gnc:budget-day) "days")
+    ((gnc:budget-week) "weeks")
+    ((gnc:budget-month) "months")
+    ((gnc:budget-year) "years")))
+

src/scm/html-generator.scm

@@ -3,14 +3,18 @@
 
 (gnc:support "html-generator.scm")
 
-(define (html-table-row header? . items)
+(define (html-table-row-manual items)
-  (let loop
+  (list
-      ((cline "<TR>")
+   '("<TR>")
-       (ilist items))
+   items
-    (if (pair? ilist)
+   '("</TR>")))
-	(loop (add-html-cell header? cline (car ilist))
+   
-	      (cdr ilist))
+(define (html-table-row-guess header? strong? items)
-	(string-append cline "</TR>"))))
+  (html-table-row-manual
+   (map
+    (lambda (item)
+      (html-cell header? strong? item))
+    items)))
 
 (define (html-strong cell)
   (string-append
@@ -18,28 +22,79 @@
    cell
    "</STRONG>"))
 
-(define (add-html-cell header? cline item)
+(define (html-currency-cell header? strong? amount)
-  (string-append cline (make-html-cell header? item)))
+  (html-generic-cell
+   #t
+   header?
+   strong?
+   (string-append
+    "<font face=\"Courier\""
+    (if (< amount 0)
+	(string-append
+	 "color=#ff0000>("
+	 (sprintf #f "%.2f" (- amount))
+	 ")")
+	(string-append
+	 ">&nbsp;"
+	 (sprintf #f "%.2f" amount)
+	 "&nbsp;"))
+    "</font>")))
 
-(define (make-html-cell header? item)
+(define (html-generic-cell right-align? header? strong? item)
-  (let ((pre    ;;; Opening tag
+  (string-append
-	 (cond
+   (if header? "<TH justify=center" "<TD")
-	      (header? "<TH justify=center>")
+   (if right-align? " align=right>" ">")
-	      ((number? item) "<TD ALIGN=RIGHT>")
+   (if strong? "<strong>" "")
-	      (else "<TD>")))
+   item
-	(post   ;;; Closing tag
+   (if strong? "</strong>" "")
-	 (if header? "</TH>" "</TD>")))
+   (if header? "</TH>" "</TD>")))
-    (sprintf #f 
-	     (string-append 
-	      pre   ;;; Start with opening tag
-	      (cond ;;; Body 
-	       ((string? item) item) 
-	       ((number? item) (sprintf #f "%.2f" item))
-	       (else ""))
-	      post))))  ;;; closing tag
 
-(define (make-html-cell-header item)
+(define (html-number-cell header? strong? format number)
-  (make-html-cell #t item))
+  (html-generic-cell
+   #t
+   header?
+   strong?
+   (sprintf #f format number)))
+
+(define (html-add-cell header? strong? cline item)
+  (string-append cline (html-cell header? strong? item)))
+
+;; guess at what type they want
+(define (html-cell header? strong? item)
+  (cond ((string? item) 
+	 (html-generic-cell #f header? strong? item))
+	((number? item)
+	 (html-currency-cell header? strong? item))
+	(else "")))
+
+(define (html-cell-header item)
+  (html-cell #t #f item))
+
+(define (html-cell-body item)
+  (html-cell #f #f item))
+
+(define (html-cell-header-strong item)
+  (html-cell #t #t item))
+
+(define (html-cell-body-strong item)
+  (html-cell #f #t item))
+
+(define (html-cell-header-right item)
+  (html-generic-cell #t #t #f item))
+
+(define (html-start-document)
+  (list 
+   "<HTML>"
+   "<BODY bgcolor=#99ccff>"))
+
+(define (html-end-document)
+  (list
+   "</BODY>"
+   "</HTML>"))
+
+(define (html-start-table)
+  (list "<TABLE border=1>"))
+
+(define (html-end-table)
+  (list "</table>"))
 
-(define (make-html-cell-body item)
-  (make-html-cell #f item))

src/scm/report-utilities.scm

@@ -131,3 +131,70 @@
       (if (equal? x (car lst))
 	  lst	; found, quit search and don't add again
 	  (cons (car lst) (addunique (cdr lst) x))))) ; keep searching
+
+
+;; find's biggest number in recursive set of vectors
+(define (find-largest-in-vector input)
+  (let loop ((i 0)
+	     (max 0))  ; fixme: should be most negative number
+    (if (= i (vector-length input)) max
+	(let subloop ((x (vector-ref input i)))
+	  (cond ((vector? x) (subloop (find-largest-in-vector x)))
+		((number? x) (if (> x max) (loop (+ i 1) x) (loop (+ i 1) max)))
+		(else (loop (+ i 1) max)))))))
+		
+
+;; takes in a vector consisting of integers, #f's and vectors (which
+;; take integers, #f's and vectors ...)
+;; the output vector will contain references to integer N in position N.
+;;
+;; example:
+;;  #(1 #(0 #f 2) 3) ->  #( (1 0) (0) (1 2) (2) )
+
+(define (find-vector-mappings input)
+  (let ((outvec (make-vector (+ 1 (find-largest-in-vector input)) #f)))
+    (let loop ((i 0)
+	       (refs '())
+	       (vec input))
+      (cond ((= i (vector-length vec)) outvec)
+	    (else
+	     (let ((item (vector-ref vec i)))
+	       (if (vector? item) (loop 0 (cons i refs) item))
+	       (if (integer? item)
+		   (if (>= item 0)
+		       (vector-set! outvec item (reverse (cons i refs)))))
+	       (loop (+ i 1) refs vec)))))
+    outvec))
+
+;; recursively apply vector-ref
+(define (vector-N-ref vector ref-list)
+  (cond ((eqv? ref-list '()) vector)
+	(else (vector-N-ref (vector-ref vector (car ref-list)) (cdr ref-list)))))
+
+;; map's a recursive vector in a given order (returning a list).  the
+;; order is as generated by find-vector-mappings.  
+(define (vector-map-in-specified-order proc vector order)
+  (let loop ((i 0))
+    (cond ((= i (vector-length order)) '())
+	  (else
+	   (let ((ref-list (vector-ref order i)))
+	     (cond ((not ref-list) (loop (+ 1 i)))
+		   (else 
+		    (cons (proc (vector-N-ref vector ref-list))
+			  (loop (+ 1 i))))))))))
+
+;; map's a recursive vector in a given order (returning a list).  the
+;; order is as generated by find-vector-mappings.  the procedure is a
+;; vector itself, with the same structure as the input vector.
+(define (vector-map-in-specified-order-uniquely procvec vector order)
+  (let loop ((i 0))
+    (cond ((= i (vector-length order)) '())
+	  (else
+	   (let ((ref-list (vector-ref order i)))
+	     (cond ((not ref-list) (loop (+ 1 i)))
+		   (else 
+		    (cons ((vector-N-ref procvec ref-list)
+			   (vector-N-ref vector ref-list))
+			  (loop (+ 1 i))))))))))
+
+

src/scm/report/budget-report.scm

@@ -1,25 +1,33 @@
 ;; -*-scheme-*-
 ;; budget-report.scm
 ;; Report on budget
-;; uses some functions from transaction-report
 ;; Bryan Larsen (blarsen@ada-works.com)
 
 ;; situations I want to handle
-;; lunch M-F
+;; lunch M-F -- funny period
 ;; xmas gifts & birthday gifts in same budget line
-;; car repairs
+;; car repairs -- contingency
-;; car fuel-ups
+;; car fuel-ups -- known amount, variable period
-;; paychecks & rent payments
+;; paychecks & rent payments -- specific dates
 
 (require 'sort)
-;(require 'time)
 (gnc:depend "report-utilities.scm")
+(gnc:depend "html-generator.scm")
+(gnc:depend "date-utilities.scm")
+
 
 ;; time values
-(define gnc:budget-day 1)
+;(define gnc:budget-day 1)
-(define gnc:budget-week 2)
+;(define gnc:budget-week 2)
-(define gnc:budget-month 3)
+;(define gnc:budget-month 3)
-(define gnc:budget-year 4)
+;(define gnc:budget-year 4)
+
+;; budget types
+(define gnc:budget-recurring 1) ; regular, recurring budget expenses
+				; that happen once per period
+(define gnc:budget-contingency 2) ; a budget item where you estimate a
+				  ; value over a long period for
+				  ; unexpected expenses.
 
 ;; define the budget itself.  For prototype, define inline.
 ;; the budget is a vector of vectors.  the vectors contain:
@@ -31,8 +39,32 @@
 ;; 4 - period-type:
 ;; 5 - triggers:  as yet undefined
 (define gnc:budget 
-  #(#("lunch" 8 ("Food:Lunch") 1 gnc:budget-day)
+  #(#("lunch" 8 ("Food:Lunch") 1 gnc:budget-day gnc:budget-recurring)
-    #("junk food" 0.50 ("Food:Junk") 1 gnc:budget-day)))
+    #("junk food" 0.50 ("Food:Junk") 1 gnc:budget-day gnc:budget-recurring)
+    #("car repairs" 2500 ("Car:Repairs") 5 gnc:budget-year gnc:budget-contingency)))
+
+(define gnc:budget-headers
+  #(("" "Description")
+    ("Amount" "per Period")
+    ("" "Accounts")
+    ("Period" "Size")
+    ("Period" "Size Units")
+    ("Budget" "Type")))
+
+(define (gnc:budget-html-cell-pred)
+  (vector
+   (lambda (item) 
+     (html-generic-cell #f #f #f item))
+   (lambda (item)
+     (html-currency-cell #f #f item))
+   (lambda (item)
+     '())  ; todo: accounts
+   (lambda (item)
+     (html-number-cell #f #f "%i" item))
+   (lambda (item)
+     (html-generic-cell #f #f #f (gnc:date-describe-type item)))
+   (lambda (item)
+     '())))  ; todo: budget-type
 
 (define (gnc:budget-get-description budget-line)
   (vector-ref budget-line 0))
@@ -51,213 +83,179 @@
 
 ;; budget report:  a vector with indexes corresponding to the budget
 ;; 0 - actual:  the amount spend / recieved
-;; 1 - desired: the budgeted amount
+;; 1 - budgeted: the budgeted amount.  Simply the periods * amount
 ;; 2 - periods: the number of periods for the line in the report
+;; 3 - mimimum-expected: minimum you expected to spend during the
+;;          report period
+;; 4 - maximum-expected: the maximum you can spend in the report period
+;; 5 - time remaining: how much of a period is remaining until the end
+;;          of the budget period
+
+(define gnc:budget-report-headers
+  #(("Amount" "Spent")
+    ("Amount" "Budgeted")
+    ("Number of" "Periods")
+    ("Lower" "Limit")
+    ("Upper" "Limit")
+    ("Time" "Remaining")))
+
+(define (gnc:budget-report-html-cell-pred)
+  (vector
+   (lambda (item)
+     (html-currency-cell #f #f item))
+   (lambda (item)
+     (html-currency-cell #f #f item))
+   (lambda (item)
+     (html-number-cell #f #f "%.1f" item))
+   (lambda (item)
+     (html-currency-cell #f #f item))
+   (lambda (item)
+     (html-currency-cell #f #f item))
+   (lambda (item)
+     (html-number-cell #f #f "%.1f" item))))
 
 (define (gnc:budget-report-get-actual brep-line)
   (vector-ref brep-line 0))
 
-(define (gnc:budget-report-get-desired brep-line)
+(define (gnc:budget-report-get-budgeted brep-line)
   (vector-ref brep-line 1))
 
 (define (gnc:budget-report-get-periods brep-line)
   (vector-ref brep-line 2))
 
-;; accumulate the actual amounts for the budget given a split and
+(define (gnc:budget-report-get-minimum-expected brep-line)
-;; a budget.  returns the budget-report vector.  The split is a 2 item list: 
+  (vector-ref brep-line 3))
-;; account name and value
+
-;; obsolete
+(define (gnc:budget-report-get-maximum-expected brep-line)
-(define (gnc:budget-report-accumulate-actual sub-split budget budget-report)
+  (vector-ref brep-line 4))
-  (do ((i 0 (+ i 1)))
+
-      ((= i (vector-length budget)) budget-report)
+(define (gnc:budget-report-get-time-remaining brep-line)
-    (let ((budget-line (vector-ref budget i))
+  (vector-ref brep-line 5))
-	  (budget-report-line (vector-ref budget-report i))
-	  (name (car sub-split))
-	  (value (cadr sub-split)))
-      (for-each 
-       (lambda (budget-account-name)
-	 (if (string-ci=? name budget-account-name)
-	     (begin
-	       (vector-set! budget-report-line 0	
-			    (+ (gnc:budget-report-get-actual
-                                budget-report-line)
-			       value)))))
-       (gnc:budget-get-accounts budget-line)))))
 
 ;; add a value to the budget accumulator
-(define (gnc:budget-accumulate-actual value budget-report-line)
+(define (gnc:budget-accumulate-actual! value budget-report-line)
   (vector-set! budget-report-line 0 
 	       (+ (gnc:budget-report-get-actual budget-report-line)
-		  value))
+		  value)))
-  budget-report-line)
 
-
+;; calculate the # of periods on a budget line.
-;; convert budget-report to an html table
-(define (gnc:budget-report-to-html budget budget-report)
-  (let ((budget-html ()))
-    (do ((i 0 (+ i 1)))
-	((= i (vector-length budget)) budget-html)
-      (let ((budget-line (vector-ref budget i))
-	    (budget-report-line (vector-ref budget-report i)))
-	(set! budget-html
-	      (append
-	       budget-html
-	       (list
-		(string-append
-		 "<TR><TD>"
-		 (gnc:budget-get-description budget-line)
-		 "</TD><TD align=right>"
-		 (sprintf 
-		  #f "%.1f"
-		  (gnc:budget-report-get-periods budget-report-line))
-		 "</TD><TD align=right>"
-		 (sprintf 
-		  #f "%.2f" (gnc:budget-report-get-desired 
-			     budget-report-line))
-		 "</TD><TD align=right>"
-		 (sprintf 
-		  #f "%.2f" (gnc:budget-report-get-actual 
-			     budget-report-line))
-		 "</TD><TD align=right>"
-		 (sprintf 
-		  #f "%.2f" (- (gnc:budget-report-get-desired
-				budget-report-line)
-			       (gnc:budget-report-get-actual
-				budget-report-line)))
-		 "</TD></TR>"))))))))
-
-;; given an account name, return the budget line number
-;; return #f if there is no budget line for that account
-(define (gnc:budget-get-line-number account-name budget)
-  (let loop ((i 0))
-;    (gnc:debug i)
-;    (gnc:debug (car (gnc:budget-get-accounts (vector-ref budget i))))
-    (cond ((= i (vector-length budget)) #f)
-	  ((let loop2
-	       ((accounts (gnc:budget-get-accounts (vector-ref budget i)))) 
-	    (cond ((null? accounts) #f)
-		  (else (or (string=? account-name (car accounts))
-			    (loop2 (cdr accounts)))))) i)
-;	  ((string=? account-name (car (gnc:budget-get-accounts (vector-ref budget i)))) i)
-	  (else (loop (+ i 1))))))
-    
-
-;; get stuff from localtime date vector
-(define (gnc:date-get-year datevec)
-  (vector-ref datevec 5))
-(define (gnc:date-get-month-day datevec)
-  (vector-ref datevec 3))
-;; get month with january==1
-(define (gnc:date-get-month datevec)
-  (+ (vector-ref datevec 4) 1))
-(define (gnc:date-get-week-day datevec)
-  (vector-ref datevec 6))
-(define (gnc:date-get-year-day datevec)
-  (vector-ref datevec 7))
-
-;; is leap year?
-(define (gnc:leap-year? year)
-  (if (= (remainder year 4) 0)
-      (if (= (remainder year 100) 0)
-	  (if (= (remainder year 400) 0) #t #f)
-	  #t)
-      #f))
-
-;; number of days in year
-(define (gnc:days-in-year year)
-  (if (gnc:leap-year? year) 366 365))
-
-;; number of days in month
-(define (gnc:days-in-month month year)
-  (case month
-    ((1 3 5 7 8 10 12) 31)
-    ((4 6 9 11) 30)
-    ((2) (if (gnc:leap-year? year) 29 28))))
-
-;; convert a date in seconds since 1970 into # of years since 1970 as
-;; a fraction.
-(define (gnc:date-to-year-fraction caltime)
-  (let ((lt (localtime caltime)))
-    (+ (- (gnc:date-get-year lt) 1970)
-       (/ (gnc:date-get-year-day lt) (* 1.0 (gnc:days-in-year 
-					     (gnc:date-get-year lt)))))))
-
-;; convert a date in seconds since 1970 into # of months since 1970
-(define (gnc:date-to-month-fraction caltime)
-  (let ((lt (localtime caltime)))
-    (+ (* 12 (- (gnc:date-get-year lt) 1970.0))
-       (/ (- (gnc:date-get-month-day lt) 1.0) (gnc:days-in-month 
-					       (gnc:date-get-month lt))))))
-
-;; convert a date in seconds since 1970 into # of weeks since Jan 4, 1970
-;; ignoring leap-seconds
-(define (gnc:date-to-week-fraction caltime)
-  (/ (- (/ (/ caltime 3600.0) 24) 3) 7))
-
-;; convert a date in seconds since 1970 into # of days since Jan 1, 1970
-;; ignoring leap-seconds
-(define (gnc:date-to-day-fraction caltime)
-  (/ (/ caltime 3600.0) 24))
-
-;; convert a date to a defined fraction
-(define (gnc:date-to-N-fraction caltime type)
-  (case type
-    ((gnc:budget-day) (gnc:date-to-day-fraction caltime))
-    ((gnc:budget-week) (gnc:date-to-week-fraction caltime))
-    ((gnc:budget-month) (gnc:date-to-month-fraction caltime))
-    ((gnc:budget-year) (gnc:date-to-year-fraction caltime))
-    (else (gnc:debug "undefined period type in budget!") #f)))
-
-;; calculate the # of periods on a budget line.  return the budget report line
 ;; dates are in # seconds after 1970
-(define (gnc:budget-calculate-periods budget-line budget-report-line 
+(define (gnc:budget-calculate-periods! budget-line budget-report-line 
 				      begin-date end-date)
   (let* ((N-type (gnc:budget-get-period-type budget-line))
 	 (begin-N (gnc:date-to-N-fraction begin-date N-type))
 	 (end-N (gnc:date-to-N-fraction end-date N-type)))
     (vector-set! budget-report-line 2 
 		 (/ (- end-N begin-N)
-		    (gnc:budget-get-period budget-line)))
+		    (gnc:budget-get-period budget-line)))))
-    budget-report-line))
 
-;; return what you are passed
+;; calculate the budgeted value.
-(define (null-filter) 
+;; dependency: budget-calculate-periods!
-  (lambda(x) x))
+(define (gnc:budget-calculate-budgeted! budget-line budget-report-line)
+  (vector-set! budget-report-line 1
+	       (* (gnc:budget-get-amount budget-line)
+		  (gnc:budget-report-get-periods budget-report-line))))
 
-;; calculate the expected budget value.  return the budget report line
+;; calculate the values for minimum-expected and maxmimum-expected
-(define (gnc:budget-calculate-expected budget-line budget-report-line
+;; dependency: budget-calculate-periods!
-				       begin-date end-date)
+(define (gnc:budget-calculate-expected! budget-line budget-report-line)
   (begin
-    (vector-set! budget-report-line 1
+    (vector-set! 
-		 (* (gnc:budget-get-amount budget-line)
+     budget-report-line 3
-		    (gnc:budget-report-get-periods budget-report-line)))
+     (* (gnc:budget-get-amount budget-line)		    
-    budget-report-line))
+	(floor (gnc:budget-report-get-periods budget-report-line))))
+    (vector-set! 
+     budget-report-line 4
+     (* (gnc:budget-get-amount budget-line)
+	(ceiling (gnc:budget-report-get-periods budget-report-line))))))
+
+;; calculate the amount of time remaining in the budget period
+;; dependency: budget-calculate-periods!
+(define (gnc:budget-calculate-time-remaining! budget-line budget-report-line)
+  (vector-set! 
+   budget-report-line 5
+   (* (- (ceiling (gnc:budget-report-get-periods budget-report-line))
+	 (gnc:budget-report-get-periods budget-report-line))
+      (gnc:budget-get-period budget-line))))
+
+;; given an account name, return the budget line number
+;; return #f if there is no budget line for that account
+(define (gnc:budget-get-line-number account-name budget)
+  (let loop ((i 0))
+    (cond ((= i (vector-length budget)) #f)
+	  ((let loop2
+	       ((accounts (gnc:budget-get-accounts (vector-ref budget i)))) 
+	    (cond ((null? accounts) #f)
+		  (else (or (string=? account-name (car accounts))
+			    (loop2 (cdr accounts)))))) i)
+	  (else (loop (+ i 1))))))
+    
+
+;; register a configuration option for the budget report
+(define (budget-report-options-generator)
+
+  (define gnc:*budget-report-options* (gnc:new-options))
+
+  (define (gnc:register-budget-report-option new-option)
+    (gnc:register-option gnc:*budget-report-options* new-option))
+
+  ;; from date
+  ;; hack alert - could somebody set this to an appropriate date?
+  (gnc:register-budget-report-option
+   (gnc:make-date-option
+    "Report Options" "From"
+    "a" "Report start date" 
+    (lambda ()
+      (let ((bdtime (localtime (current-time))))
+        (set-tm:sec bdtime 0)
+        (set-tm:min bdtime 0)
+        (set-tm:hour bdtime 0)
+        (set-tm:mday bdtime 1)
+        (set-tm:mon bdtime 0)
+        (let ((time (car (mktime bdtime))))
+          (cons time 0))))
+    #f))
+
+  ;; to-date
+  (gnc:register-budget-report-option
+   (gnc:make-date-option
+    "Report Options" "To"
+    "b" "Report end date"
+    (lambda () (cons (current-time) 0))
+    #f))
+
+  ;; view
+  (gnc:register-budget-report-option
+   (gnc:make-multichoice-option
+    "Report Options" "View"
+    "c" "Type of budget report"
+    'status
+    (list #(full
+	    "Full"
+	    "Show all columns")
+	  #(balancing
+	    "Balancing"
+	    "A report useful for balancing the budget")
+	  #(status
+	    "Status"
+	    "How are you doing on your budget?"))))
   
 
+  gnc:*budget-report-options*)
+
+
+
 (gnc:define-report
  ;; version
  1
  ;; Name
  "Budget"
  ;; Options
- trep-options-generator
+ budget-report-options-generator
  ;; renderer
  (lambda (options)
    (let* ((begindate (gnc:lookup-option options "Report Options" "From"))
 	  (enddate (gnc:lookup-option options "Report Options" "To"))
-	  (tr-report-account-op (gnc:lookup-option options
-						   "Report Options" "Account"))
-	  (prefix  (list "<HTML>" "<BODY bgcolor=#99ccff>" 
-			 "<TABLE border=1>"
-			 "<TH>Description</TH>"
-			 "<TH>Number of Periods</TH>"
-			 "<TH>Amount Budgeted</TH>"
-			 "<TH>Amount Spent</TH>"
-			 "<TH>Delta</TH>"))
-	  (suffix  (list "</TABLE>" "</BODY>" "</HTML>"))
-	  (input-transactions '())
-	  (budget-report #())
-	  (budget-html "")
 	  (date-filter-pred (gnc:tr-report-make-filter-predicate
 			     (gnc:option-value begindate) 
 			     (gnc:option-value enddate)))
@@ -265,54 +263,87 @@
 				  (gnc:option-value begindate))))
 	  (end-date-secs (car (gnc:timepair-canonical-day-time
 			       (gnc:option-value enddate))))
-	  (accounts (gnc:option-value tr-report-account-op)))
+	  (budget-report (make-vector (vector-length gnc:budget)))
-     (set! budget-report (make-vector 
+	  (budget-order #())
-				(vector-length gnc:budget)))
+	  (budget-report-order #()))
+     (gnc:debug gnc:budget)
+     
      (do ((i 0 (+ i 1)))
 	 ((= i (vector-length gnc:budget)))
-       (vector-set! budget-report i (vector 0 0 0)))
+       (vector-set! budget-report i (vector 0 0 0 0 0 0)))
+
      (let loop ((group (gnc:get-current-group)))
        (if (not (pointer-token-null? group))
 	   (gnc:group-map-accounts
 	    (lambda (account)
-	      (let* ((name (gnc:account-get-full-name account))
+	      (let ((line 
-		     (line (gnc:budget-get-line-number name gnc:budget))
+		     (gnc:budget-get-line-number 
-		     (children (gnc:account-get-children account)))
+		      (gnc:account-get-full-name account)
+		      gnc:budget))
+		    (children (gnc:account-get-children account)))
 		(if line 
 		    (gnc:for-each-split-in-account 
 		     account
 		     (lambda (split)
-		       (vector-set! 
+			(gnc:budget-accumulate-actual!
-			budget-report line
-			(gnc:budget-accumulate-actual
 			 (gnc:split-get-value split)
-			 (vector-ref budget-report line))))))
+			 (vector-ref budget-report line)))))
-		(if (not (pointer-token-null? children)) (loop children))))
+		(loop children)))
 	    group)))
-     (gnc:debug budget-report)
-     (gnc:debug begin-date-secs)
-     (gnc:debug end-date-secs)
-     (gnc:debug (gnc:timepair-canonical-day-time 
-		 (gnc:option-value begindate)))
-     (gnc:debug (gnc:timepair-canonical-day-time 
-		 (gnc:option-value enddate)))
 
      (do ((i 0 (+ i 1)))
 	 ((= i (vector-length gnc:budget)))
-       (vector-set! budget-report i 
+       (let ((budget-line (vector-ref gnc:budget i))
-		    (gnc:budget-calculate-expected
+	     (budget-report-line (vector-ref budget-report i)))
-		     (vector-ref gnc:budget i)
+	 (gnc:budget-calculate-periods!
-		     (gnc:budget-calculate-periods
+	  budget-line budget-report-line begin-date-secs end-date-secs)
-		      (vector-ref gnc:budget i)
+	 (gnc:budget-calculate-budgeted! budget-line budget-report-line)
-		      (vector-ref budget-report i)
+	 (gnc:budget-calculate-expected! budget-line budget-report-line)
-		      begin-date-secs
+	 (gnc:budget-calculate-time-remaining! budget-line budget-report-line)))
-		      end-date-secs)
-		     begin-date-secs
-		     end-date-secs)))
      
      (gnc:debug budget-report)
-	   
+
-     (set! budget-html (gnc:budget-report-to-html
+     (case (gnc:option-value 
-			gnc:budget budget-report))
+	    (gnc:lookup-option options "Report Options" "View"))
-     
+       ((full)
-     (append prefix budget-html suffix))))
+	(set! budget-order (vector 1 2 #f 3 4 #f))
+	(set! budget-report-order (vector 5 6 7 8 9 10)))
+       ((balancing)
+	(set! budget-order #(1 2 #f 3 4 #f))
+	(set! budget-report-order #(#f 6 5 #f #f #f)))
+       ((status)
+	(set! budget-order #(1 #f #f #f 3 #f))
+	(set! budget-report-order #(10 #f #f 4 5 2)))
+       (else
+	(gnc:debug "Invalid view option")))
+
+     (let ((order (find-vector-mappings 
+		  (vector budget-order budget-report-order))))
+       (list
+	(html-start-document)
+	"<p>This is a budget report.  It is very preliminary, but you may find it useful.  To actually change the budget, currently you have to edit budget-report.scm.</p>"
+	(html-start-table)
+	(html-table-row-manual
+	 (vector-map-in-specified-order
+	  (lambda (item) (html-cell-header (car item)))
+	  (vector gnc:budget-headers gnc:budget-report-headers)
+	  order))
+	(html-table-row-manual
+	 (vector-map-in-specified-order
+	  (lambda (item) (html-cell-header (cadr item)))
+	  (vector gnc:budget-headers gnc:budget-report-headers)
+	  order))
+	(let loop ((row 0))
+	  (cond ((= row (vector-length gnc:budget)) '())
+		(else
+		 (cons
+		  (html-table-row-manual
+		   (vector-map-in-specified-order-uniquely
+		    (vector (gnc:budget-html-cell-pred) 
+			    (gnc:budget-report-html-cell-pred))
+		    (vector (vector-ref gnc:budget row) 
+			    (vector-ref budget-report row))
+		    order))
+		  (loop (+ row 1))))))
+	(html-end-table)
+	(html-end-document))))))