*** empty log message ***

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

src/scm/html-generator.scm

@@ -80,6 +80,8 @@
 ;; report-sort-spec-structure
 ;;  get-value-proc:  given the entry, finds the value.  Required.
 ;;  sort-pred:  usually <.  Required.
+;;  equal-pred: usually =.  Required.  This is used during sorting for
+;;              multi-key sorting.
 ;;  subsection-pred: often = or #f.  Returns #t if both values are in
 ;;                   the same subsection
 ;;  subsection-title-proc: returns the title of the subsection given a
@@ -87,7 +89,8 @@
 (define report-sort-spec-structure
   (make-record-type
    "report-sort-spec-structure"
-   '(get-value-proc sort-pred subsection-pred subsection-title-proc)))
+   '(get-value-proc sort-pred equal-pred subsection-pred
+		    subsection-title-proc)))
 
 (define make-report-sort-spec
   (record-constructor report-sort-spec-structure))
@@ -98,6 +101,9 @@
 (define report-sort-spec-get-sort-pred
   (record-accessor report-sort-spec-structure 'sort-pred))
 
+(define report-sort-spec-get-equal-pred
+  (record-accessor report-sort-spec-structure 'equal-pred))
+
 (define report-sort-spec-get-subsection-pred
   (record-accessor report-sort-spec-structure 'subsection-pred))
 
@@ -134,45 +140,45 @@
 (define report-spec-get-first-last-preference
   (record-accessor report-spec-structure 'first-last-preference))
 
-;; convert table to html.  Subentries follow entries
-(define (html-table-entries-first lst specs false-proc)
-  (map  ;; map-in-order when it's fixed
-   (lambda (line)
-     (html-table-row-group
-      (list
-       (html-table-row-manual (html-table-do-entry line specs))
+;; convert a list of entries into html
+(define (html-table-render-entries entry-list specs sort-specs line-render-proc false-proc)
+  (html-table-do-subsection
+   (html-table-sort entry-list sort-specs)
+   specs sort-specs line-render-proc false-proc 1))
+
+;; the next 3 functions can be passed to html-table-render-entries
+
+;; convert an entry into html.  subentries follow entries
+(define (html-table-entry-render-entries-first line specs false-proc)
+  (html-table-row-group
+   (cons
+    (html-table-row-manual (html-table-do-entry line specs))
+    (map
+     html-table-row-manual
+     (html-table-collect-subentries line specs false-proc)))))
+
+;; convert an entry into html.  first subentry is merged with the entry
+(define (html-table-entry-render-subentries-merged line specs false-proc)
+  (let ((subs-lines (html-table-collect-subentries line specs false-proc)))
+    (html-table-row-group
+     (list
+      (html-table-row-manual
        (map
-	html-table-row-manual
-	(html-table-collect-subentries line specs false-proc)))))
-   lst))
+	(lambda (entry sub)
+	  (if (not sub) entry sub))
+	(html-table-do-entry line specs)
+	(car subs-lines)))
+      (map html-table-row-manual (cdr subs-lines))))))
 
-;; convert table to html.  The first subentry is merged with the
-;; entries on the first line.     
-(define (html-table-subentries-merged lst specs false-proc)
-  (map ;; map-in-order
-   (lambda (line)
-     (let ((subs-lines (html-table-collect-subentries line specs false-proc)))
-       (html-table-row-group
-	(list
-	(html-table-row-manual
-	 (map
-	  (lambda (entry sub)
-	    (if (not sub) entry sub))
-	  (html-table-do-entry line specs)
-	  (car subs-lines)))
-	(map html-table-row-manual (cdr subs-lines))))))
-   lst))
 
-;; convert table to html.  Entries only
-(define (html-table-entries-only lst specs false-proc)
-  (map ;; map-in-order
-   (lambda (line)
-     (html-table-row-manual (html-table-do-entry line specs)))
-   lst))
+;; convert an entry into html.  ignore sub entries
+(define (html-table-entry-render-entries-only line specs false-proc)
+  (html-table-row-group
+   (html-table-row-manual (html-table-do-entry line specs))))
 
 ;; convert totals to html
 (define (html-table-totals lst specs)
-  (html-table-row-manual
+  (html-table-totals-row
    (map
     (lambda (spec)
       (cond ((report-spec-get-total-html-proc spec)
@@ -185,20 +191,165 @@
 
 ;; convert headers to html
 (define (html-table-headers specs)
-  (map
-   (lambda (spec) 
-     (html-header-cell 
-      (report-spec-get-header spec)))
-   specs))
+  (html-table-headers-row
+   (map
+    (lambda (spec) 
+      (html-header-cell 
+       (report-spec-get-header spec)))
+    specs)))
+
+;;;;;;;;;;;;;;;;
+;; the rest are just helper functions
+
+;; convert subtotals to html
+(define (html-table-subtotals lst sort-spec specs depth)
+  (html-table-subtotals-row
+   depth
+   (map
+    (lambda (spec)
+      (cond ((report-spec-get-subtotal-html-proc spec)
+	     ((report-spec-get-subtotal-html-proc spec)
+	      (apply
+	       (report-spec-get-total-proc spec)
+	       (map (report-spec-get-get-value-proc spec) lst))))
+	    (else #f)))
+    specs)))
+
+
+;(define (html-table-subtotals subtotals sort-spec specs depth)
+;  (html-table-subtotals-row 
+;   depth
+;   (map
+;    (lambda (subtotal spec)
+;      (cond 
+;       ((report-spec-get-subtotal-html-proc spec)
+;	((report-spec-get-subtotal-html-proc spec) subtotal))
+;       (else #f)))
+;    subtotals specs)))
+
+;(define (html-table-init-subtotals specs sort-specs)
+;  (map
+;   (lambda (sort-spec)
+;     (map
+;      (lambda (spec) 0.0)
+;      specs))
+;   sort-specs))
+
+;(define (html-table-accumulate-subtotals subtotals specs sort-specs line)
+;  (map
+;   (lambda (subtotal sort-spec)
+;     (cond 
+;      ((report-sort-spec-get-subsection-pred sort-spec)
+;       (map
+;	(lambda (sub spec)
+;	  (cond
+;	   ((report-spec-get-subtotal-html-proc spec)
+;	    (+ sub ((report-spec-get-get-value-proc spec) line)))
+;	   (else 0.0)))
+;	subtotal specs))
+;      (else '())))
+;   subtotals sort-specs))
+
+(define (html-table-sort lst sort-specs)
+  (sort lst (html-table-make-sort-pred sort-specs)))
+
+(define (html-table-do-subsection lst specs sort-specs line-render-proc false-proc depth)
+  (cond
+   ((null? sort-specs)
+    (map 
+     (lambda (line) (line-render-proc line specs false-proc))
+     lst))
+   (else
+    (let loop ((lst2 lst))
+      (cond 
+       ((null? lst2) '())
+       (else
+	(let* ((front '())
+	       (back '())
+	       (sort-spec (car sort-specs))
+	       (subsection-pred (report-sort-spec-get-subsection-pred sort-spec))
+	       (get-value-proc (report-sort-spec-get-get-value-proc sort-spec))
+	       (value1 (get-value-proc (car lst2))))
+	  (cond 
+	   (subsection-pred
+	    (set! front
+		  (remove-if-not
+		   (lambda (line)
+		     (subsection-pred value1 (get-value-proc line)))
+		   lst2))
+	    (set! back (set-difference lst2 front)))
+	   (else
+	    (set! front lst2)
+	    (set! back '())))
+	  (list
+	   (cond ((report-sort-spec-get-subsection-title-proc sort-spec)
+		  (html-table-subsection-title 
+		   ((report-sort-spec-get-subsection-title-proc sort-spec)
+		    (get-value-proc (car front)))
+		   depth))
+		 (else '()))
+	   (html-table-do-subsection 
+	    front specs (cdr sort-specs) line-render-proc false-proc (+ depth 1))
+	   (cond (subsection-pred
+		  (html-table-subtotals front sort-spec specs depth))
+		 (else '()))
+	   (loop back)))))))))
+	    
+     
+;(define (html-table-do-subsection-stuff line1 line2 sort-specs report-specs subtotals)
+;  (let loop ((depth 1)
+;	     (specs sort-specs)
+;	     (totals subtotals))
+;    (cond 
+;     ((null? specs) '())
+;     ((not line1)
+;      (if (report-sort-spec-get-subsection-title-proc (car specs))
+;	  (cons
+;	   (html-table-subsection-title 
+;	    ((report-sort-spec-get-subsection-title-proc (car specs))
+;	     ((report-sort-spec-get-get-value-proc (car specs)) line2))
+;	    depth)
+;	   (loop (+ depth 1) (cdr specs) (cdr totals)))
+;	  (loop (+ depth 1) (cdr specs) (cdr totals))))
+;     (else
+;      (cond
+;       ((report-sort-spec-get-subsection-pred (car specs))
+;	(let ((get-value-proc (report-sort-spec-get-get-value-proc (car specs)))
+;	      (subtitle-proc (report-sort-spec-get-subsection-title-proc (car specs))))
+;	  (cond
+;	   ((not
+;	     ((report-sort-spec-get-subsection-pred (car specs))
+;	      (get-value-proc line1) (get-value-proc line2)))
+;	    (if subtitle-proc
+;		(cons
+;		 (html-table-subtotals (car totals) (car specs) report-specs depth)
+;		 (cons
+;		  (html-table-subsection-title
+;		   (subtitle-proc (get-value-proc line2)) depth)
+;		  (loop (+ depth 1) (cdr specs) (cdr totals))))
+;		(loop (+ depth 1) (cdr specs) (cdr totals))))
+;	   (else (loop (+ depth 1) (cdr specs) (cdr totals))))))
+;       (else '()))))))
+	   
+(define (html-table-make-sort-pred sort-specs)
+  (lambda (entry1 entry2)
+    (let loop ((specs sort-specs))
+      (cond ((null? specs) #f)
+	    (else
+	     (let* ((spec (car specs))
+		    (gv-proc (report-sort-spec-get-get-value-proc spec))
+		    (value1 (gv-proc entry1))
+		    (value2 (gv-proc entry2)))
+	       (cond (((report-sort-spec-get-sort-pred spec) value1 value2) #t)
+		     (((report-sort-spec-get-equal-pred spec) value1 value2)
+		      (loop (cdr specs)))
+		     (else #f))))))))
 
 ;; converts from col order to row order.
 ;; ex.  ((a b) (c d) (e f)) -> ((a c e) (b d f))
 (define (col-list->row-list lst)
   (apply map list lst))
 
-;;;;;;;;;;;;;;;;
-;; the rest are just helper functions
-
 ;; converts subentries into html and collects into a list of lists of
 ;; html cells.
 (define (html-table-collect-subentries line specs false-proc)
@@ -222,20 +373,59 @@
 	   (else #f)))
    specs))
 
+(define (html-table-headers-row headers)
+  (list
+   "<TR bgcolor=#ffccff cellspacing=10 rules=\"rows\">"
+   headers
+   "</TR>\n"))
+
+(define (html-table-totals-row cells)
+  (list
+   "<TR bgcolor=#ffccff cellspacing=10 rules=\"rows\">"
+   (map
+    (lambda (cell)
+      (cond (cell cell)
+	    (else html-blank-cell)))
+    cells)
+   "</TR>\n"))
+
+(define (html-table-subtotals-row depth cells)
+  (list
+   "<TR bgcolor=#ffff99 cellspacing=10 rules=\"rows\">"
+   (map
+    (lambda (cell)
+      (cond (cell cell)
+	    (else html-blank-cell)))
+    cells)
+   "</TR>\n"))
+   
+
 (define (html-table-row-manual items)
   (list
-   "<TR>"
+   "<TR bgcolor=" html-table-group-color ">"
    (map
     (lambda (cell)
       (cond (cell cell)
 	    (else html-blank-cell)))
     items)
-   "</TR>"))
+   "</TR>\n"))
+
+(define (html-table-subsection-title title depth)
+  (list "<TR bgcolor=#ffff99><TH>" title "</TH></TR>"))
 
 ;; help! this doesn't work!  I want something to group several rows
 ;; together so that an "entry" is noticably one unit.
-(define (html-table-row-group rows)
-  (list  "<TBODY>" rows  "</TBODY>"))
+;; netscape & our html widget do not support tbody.
+;;(define (html-table-row-group rows)
+;;  (list  "</TR><TBODY>" rows  "</TBODY>"))
+
+(define html-table-group-color "#99ccff")
+
+(define (html-table-row-group row)
+  (if (string=? html-table-group-color "#99ccff")
+      (set! html-table-group-color "#ffffff")
+      (set! html-table-group-color "#99ccff"))
+  row)
 
 (define (html-strong html)
   (if html 
@@ -328,7 +518,7 @@
    "</HTML>"))
 
 (define (html-start-table)
-  (list "<TABLE border=2 rules=\"groups\">"))
+  (list "<TABLE>"))  ;; border=2 rules=\"groups\"
 
 (define (html-end-table)
   (list "</table>"))

src/scm/report-utilities.scm

@@ -72,12 +72,26 @@
 	(gnc:for-loop thunk (+ first step) last step))
       #f))
 
+(define (gnc:map-for thunk first last step)
+  (if (< first last)
+      (cons
+	(thunk first)
+	(gnc:map-for thunk (+ first step) last step))
+      '()))
+
 ;;; applies thunk to each split in account account
 (define (gnc:for-each-split-in-account account thunk)
   (gnc:for-loop (lambda (x) 
 		  (thunk (gnc:account-get-split account x)))
                 0 (gnc:account-get-split-count account) 1))
 
+;;; applies thunk to each split in account account
+(define (gnc:map-splits-in-account thunk account)
+  (gnc:map-for (lambda (x) 
+		 (thunk (gnc:account-get-split account x)))
+	       0 (gnc:account-get-split-count account) 1))
+
+
 (define (gnc:group-map-accounts thunk group)
   (let ((num-accounts (gnc:group-get-num-accounts group)))
     (let loop 
@@ -99,6 +113,16 @@
               (gnc:ith-split split-array (+ index 1))
               (cons split slist)))))
 
+;; pull a scheme list of splits from an account
+(define (gnc:account-get-split-list account)
+  (let ((num-splits (gnc:account-get-split-count account)))
+    (let loop ((index 0))
+      (if (= index num-splits)
+	  '()
+	  (cons
+	   (gnc:account-get-split account index)
+	   (loop (+ index 1)))))))
+
 ;; Pull a scheme list of accounts (including subaccounts) from group grp
 (define (gnc:group-get-account-list grp)
   (if (pointer-token-null? grp)

src/scm/report/budget-report.scm

@@ -30,7 +30,7 @@
 (define budget-entry-structure
   (make-record-type 
    "budget-entry-structure" 
-   '(description accounts subentries action)))
+   '(description accounts filter-pred subentries action)))
 
 (define budget-subentry-structure 
   (make-record-type
@@ -75,11 +75,20 @@
 (define make-nominal-mechanism
   (record-constructor budget-nominal-mechanism-structure))
 
+;;; useful filter-pred's for a budget entry
+
+(define (budget-filter-pred-debit split budget-line)
+  (> (gnc:split-get-value split) 0))
+
 ;; make-budget-entry:  
 ;;  1: description, 
 ;;  2: list of accounts
-;;  3: list of subentries.
-;;  4: action:  #t: normal budget line
+;;  3: filter pred: given the split and the budget line, return #t if
+;;                  the split should be added to the budget.  (before
+;;                  calling, the transaction is already filtered on
+;;                  date & accounts).
+;;  4: list of subentries.
+;;  5: action:  #t: normal budget line
 ;;              'gnc:budget-comment:  display, but do not total
 ;;              #f: ignore
 
@@ -119,62 +128,169 @@
 
 (define gnc:budget-entries
   (list
-   (make-budget-entry "gross" '("Income:Gross Employment Income") (list
-     (make-budget-subentry #f -342.27 1 'gnc:budget-month (make-bill-mechanism -1 2))) #t)	
-   (make-budget-entry "bank interest" '("Expense:Bank Charges:Interest") (list
-     (make-budget-subentry "interest loc" 40 1 'gnc:budget-month (make-bill-mechanism -4 0))
-     (make-budget-subentry "interest rrsp" 40 1 'gnc:budget-month (make-bill-mechanism 8 10))) #t)
-   (make-budget-entry "cell phone" '("Expense:Bills:Cell phone") (list
-     (make-budget-subentry #f 60 1 'gnc:budget-month (make-bill-mechanism -4 -1))) #t)
-   (make-budget-entry "hydro" '("Expense:Bills:Hydro") (list
-     (make-budget-subentry #f 20 1 'gnc:budget-month (make-bill-mechanism 15 19))) #t)
-   (make-budget-entry "life insurance" '("Expense:Bills:Life Insurance") (list
-     (make-budget-subentry #f 15 1 'gnc:budget-month (make-bill-mechanism 1 3))) #t)
-   (make-budget-entry "diesel" '("Expense:Car:Diesel") (list
-     (make-budget-subentry #f 30 6 'gnc:budget-week (make-recurring-mechanism))) #t)
-   (make-budget-entry "licenses" '("Expense:Car:Licenses") (list
-     (make-budget-subentry #f 1000 1 'gnc:budget-year (make-bill-mechanism -122 -108))) #t)
-   (make-budget-entry "car maintenance" '("Expense:Car:Maintenance") (list
-     (make-budget-subentry #f 100 6 'gnc:budget-month (make-recurring-mechanism))) #t)
-   (make-budget-entry "car misc" '("Expense:Car:Miscellaneous") (list
-     (make-budget-subentry #f 5 1 'gnc:budget-week (make-recurring-mechanism))) #t)
-   (make-budget-entry "charitable" 
-		      '("Expense:Charitable:Non-taxable" "Expense:Charitable:Taxable") (list
-     (make-budget-subentry #f 200 1 'gnc:budget-year (make-recurring-mechanism))) #t)
-   (make-budget-entry "entertainment" 
-		      '("Expense:Entertainment:Beer (out)" "Expense:Entertainment:Cover"
-			"Expense:Entertainment:Date" "Expense:Entertainment:Dining"
-			"Expense:Entertainment:Dues" "Expense:Entertainment:Goodwill"
-			"Expense:Entertainment:Liquor (home)") (list
-     (make-budget-subentry #f 50 1 'gnc:budget-week (make-recurring-mechanism))) #t)
-   (make-budget-entry "groceries" '("Expense:Food:Groceries") (list
-     (make-budget-subentry #f 125 1 'gnc:budget-month (make-recurring-mechanism))) #t)
-   (make-budget-entry "junk food" '("Expense:Food:Junk") (list
-     (make-budget-subentry #f 0.5 1 'gnc:budget-day (make-recurring-mechanism))) #t)
-   (make-budget-entry "lunch" '("Expense:Food:Lunch") (list
-     (make-budget-subentry #f 8 1 'gnc:budget-day (make-recurring-mechanism))) #t)
-   (make-budget-entry "gifts" '("Expense:Gifts") (list
-     (make-budget-subentry #f 400 1 'gnc:budget-year (make-recurring-mechanism))
-     (make-budget-subentry "xmas" 400 1 'gnc:budget-year (make-bill-mechanism -30 -5))) #t)
-   (make-budget-entry "rent" '("Expense:Household:Rent") (list
-     (make-budget-subentry #f 312.50 1 'gnc:budget-month (make-bill-mechanism 1 2))) #t)
-   (make-budget-entry "house junk" '("Expense:Household:Stuff") (list
-     (make-budget-subentry #f 25 1 'gnc:budget-month (make-recurring-mechanism))) #t)
-   (make-budget-entry "medical" '("Expense:Medical:Dental" "Expense:Medical:Optical"
-				  "Expense:Medical:Other") (list
-     (make-budget-subentry #f 1000 1 'gnc:budget-year (make-contingency-mechanism))) #t)
-   (make-budget-entry "clothes" '("Expense:Personal:Clothes") (list
-     (make-budget-subentry #f 150 3 'gnc:budget-month (make-recurring-mechanism))) #t)
-   (make-budget-entry "hygeine" '("Expense:Personal:Personal maintenance") (list
-     (make-budget-subentry #f 30 1 'gnc:budget-month (make-recurring-mechanism))) #t)
-   (make-budget-entry "newspapers" '("Expense:Stuff:Newspapers") (list
-     (make-budget-subentry #f 20.52 1 'gnc:budget-month (make-bill-mechanism 14 14))) #t)
-   (make-budget-entry "stuff" '("Expense:Stuff:CD's" "Expense:Stuff:Electronic entertainment"
-				"Expense:Stuff:Fiction" "Expense:Stuff:Games"
-				"Expense:Stuff:Magazines" "Expense:Stuff:Musical Equipment"
-				"Expense:Stuff:Software" "Expense:Stuff:Sports equipment"
-				"Expense:Stuff:Videos") (list
-     (make-budget-subentry #f 250 1 'gnc:budget-month (make-recurring-mechanism))) #t)))
+   (make-budget-entry 
+    "gross" '("Income:Gross Employment Income") #f 
+    (list
+     (make-budget-subentry #f -9999999.99 1 'gnc:budget-month 
+			   (make-bill-mechanism -1 2))) #t)	
+   (make-budget-entry 
+    "bank interest" '("Expense:Bank Charges:Interest") #f 
+    (list
+     (make-budget-subentry #f 40 1 'gnc:budget-month 
+			   (make-bill-mechanism -4 0))) #t)
+   (make-budget-entry 
+    "bank feed" '("Expense:Bank Charges:Fees") #f 
+    (list
+     (make-budget-subentry #f 50 1 'gnc:budget-year 
+       (make-bill-mechanism 27 27))) #t)
+   (make-budget-entry 
+    "cell phone" '("Expense:Bills:Cell phone") #f 
+    (list
+     (make-budget-subentry #f 60 1 'gnc:budget-month 
+			   (make-bill-mechanism -4 -1))) #t)
+   (make-budget-entry 
+    "hydro" '("Expense:Bills:Hydro") #f 
+    (list
+     (make-budget-subentry #f 20 1 'gnc:budget-month
+			   (make-bill-mechanism 15 19))) #t)
+   (make-budget-entry 
+    "life insurance" '("Expense:Bills:Life Insurance") #f 
+    (list
+     (make-budget-subentry #f 15 1 'gnc:budget-month 
+			   (make-bill-mechanism 1 3))) #t)
+   (make-budget-entry 
+    "diesel" '("Expense:Car:Diesel") #f 
+    (list
+     (make-budget-subentry #f 30 4 'gnc:budget-week
+			   (make-recurring-mechanism))) #t)
+   (make-budget-entry 
+    "licenses" '("Expense:Car:Licenses") #f 
+    (list
+     (make-budget-subentry #f 1000 1 'gnc:budget-year
+			   (make-bill-mechanism -122 -108))) #t)
+   (make-budget-entry
+    "car maintenance" '("Expense:Car:Maintenance") #f 
+    (list
+     (make-budget-subentry #f 100 6 'gnc:budget-month
+			   (make-recurring-mechanism))) #t)
+   (make-budget-entry
+    "car misc" '("Expense:Car:Miscellaneous") #f 
+    (list
+     (make-budget-subentry #f 5 1 'gnc:budget-week
+			   (make-recurring-mechanism))) #t)
+   (make-budget-entry
+    "charitable" '("Expense:Charitable:Non-taxable"
+		   "Expense:Charitable:Taxable") #f 
+    (list
+     (make-budget-subentry #f 200 1 'gnc:budget-year
+			   (make-recurring-mechanism))) #t)
+   (make-budget-entry
+    "entertainment" '("Expense:Entertainment:Beer (out)" 
+		      "Expense:Entertainment:Cover"
+		      "Expense:Entertainment:Date"
+		      "Expense:Entertainment:Dining"
+		      "Expense:Entertainment:Dues"
+		      "Expense:Entertainment:Goodwill"
+		      "Expense:Entertainment:Liquor (home)") #f 
+    (list
+     (make-budget-subentry #f 50 1 'gnc:budget-week
+			   (make-recurring-mechanism))) #t)
+   (make-budget-entry
+    "groceries" '("Expense:Food:Groceries") #f 
+    (list
+     (make-budget-subentry #f 125 1 'gnc:budget-month
+			   (make-recurring-mechanism))) #t)
+   (make-budget-entry
+    "junk food" '("Expense:Food:Junk") #f 
+    (list
+     (make-budget-subentry #f 0.5 1 'gnc:budget-day
+			   (make-recurring-mechanism))) #t)
+   (make-budget-entry
+    "lunch" '("Expense:Food:Lunch") #f
+    (list
+     (make-budget-subentry #f 8 1 'gnc:budget-day
+			   (make-recurring-mechanism))) #t)
+   (make-budget-entry
+    "gifts" '("Expense:Gifts") #f 
+    (list
+     (make-budget-subentry #f 400 1 'gnc:budget-year
+			   (make-recurring-mechanism))
+     (make-budget-subentry "xmas" 400 1 'gnc:budget-year
+			   (make-bill-mechanism -30 -5))) #t)
+   (make-budget-entry 
+    "rent" '("Expense:Household:Rent") #f 
+    (list
+     (make-budget-subentry #f 312.50 1 'gnc:budget-month
+			   (make-bill-mechanism 1 2))) #t)
+   (make-budget-entry
+    "house junk" '("Expense:Household:Stuff") #f 
+    (list
+     (make-budget-subentry #f 25 1 'gnc:budget-month
+			   (make-recurring-mechanism))) #t)
+   (make-budget-entry
+    "medical" '("Expense:Medical:Dental" 
+		"Expense:Medical:Optical"
+		"Expense:Medical:Other") #f 
+    (list
+     (make-budget-subentry #f 1000 1 'gnc:budget-year
+			   (make-contingency-mechanism))) #t)
+   (make-budget-entry
+    "clothes" '("Expense:Personal:Clothes") #f 
+    (list
+     (make-budget-subentry #f 150 3 'gnc:budget-month
+			   (make-recurring-mechanism))) #t)
+   (make-budget-entry
+    "hygeine" '("Expense:Personal:Personal maintenance") #f 
+    (list
+     (make-budget-subentry #f 30 1 'gnc:budget-month
+			   (make-recurring-mechanism))) #t)
+   (make-budget-entry
+    "newspapers" '("Expense:Stuff:Newspapers") #f 
+    (list
+     (make-budget-subentry #f 20.52 1 'gnc:budget-month
+			   (make-bill-mechanism 14 14))) #t)
+   (make-budget-entry "stuff" '("Expense:Stuff:CD's"
+				"Expense:Stuff:Electronic entertainment"
+				"Expense:Stuff:Fiction" 
+				"Expense:Stuff:Games"
+				"Expense:Stuff:Magazines" 
+				"Expense:Stuff:Musical Equipment"
+				"Expense:Stuff:Software"
+				"Expense:Stuff:Sports equipment"
+				"Expense:Stuff:Videos") #f 
+    (list
+     (make-budget-subentry #f 250 1 'gnc:budget-month
+			   (make-recurring-mechanism))) #t)
+   (make-budget-entry
+    "student loan" '("Expense:Bills:Student Loan Interest"
+		     "Loans:student loan") #f 
+    (list
+     (make-budget-subentry #f 94.54 1 'gnc:budget-month
+			   (make-bill-mechanism -1 -1))) #t)
+   (make-budget-entry
+    "car loan" '("Expense:Car:Loan Interest"
+				   "Loans:Car Loan") #f 
+    (list
+     (make-budget-subentry #f 374.18 1 'gnc:budget-month
+			   (make-bill-mechanism 15 17))) #t)
+   (make-budget-entry
+    "RRSP loan" '("Expense:Investment Expenses:RRSP LOC Interest"
+		  "Loans:Scotia Bank RRSP Line of Credit") 
+    budget-filter-pred-debit
+    (list
+     (make-budget-subentry #f 100 1 'gnc:budget-month
+			   (make-bill-mechanism 5 8))) #t)
+   (make-budget-entry 
+    "cash write off" '("Expense:Cash write-off") #f 
+    (list
+     (make-budget-subentry #f 60 1 'gnc:budget-month
+			   (make-recurring-mechanism))) #t)
+   (make-budget-entry
+    "taxes" '("Expense:Taxes:CPP" "Expense:Taxes:EI" 
+	      "Expense:Taxes:Federal Income Tax") #f 
+    (list
+     (make-budget-subentry #f 1034.38 1 'gnc:budget-month
+			   (make-bill-mechanism -1 -2))) #t)))
 
 
 ;; these are the "other collectors".  This is where all transactions
@@ -182,30 +298,39 @@
 ;; by account-type, which is an integer.
 (define gnc:budget-others
   (list
-   (make-budget-entry "other bank" '() (list
-     (make-budget-subentry #f 0 1 'gnc:budget-month (make-nominal-mechanism))) #f)
-   (make-budget-entry "other cash" '() (list
-     (make-budget-subentry #f 0 1 'gnc:budget-month (make-nominal-mechanism))) #f)
-   (make-budget-entry "other asset" '() (list
-     (make-budget-subentry #f 0 1 'gnc:budget-month (make-nominal-mechanism))) #f)
-   (make-budget-entry "other credit" '() (list
-     (make-budget-subentry #f 0 1 'gnc:budget-month (make-nominal-mechanism))) #f)
-   (make-budget-entry "other liability" '() (list
-     (make-budget-subentry #f 0 1 'gnc:budget-month (make-nominal-mechanism))) #f)
-   (make-budget-entry "other stock" '() (list
-     (make-budget-subentry #f 0 1 'gnc:budget-month (make-nominal-mechanism))) #f)
-   (make-budget-entry "other mutual" '() (list
-     (make-budget-subentry #f 0 1 'gnc:budget-month (make-nominal-mechanism))) #f)
-   (make-budget-entry "other currency" '() (list
-     (make-budget-subentry #f 0 1 'gnc:budget-month (make-nominal-mechanism))) #f)
-   (make-budget-entry "other income" '() (list
-     (make-budget-subentry #f 0 1 'gnc:budget-month (make-nominal-mechanism)))
-		      'gnc:budget-comment)
-   (make-budget-entry "other expense" '() (list
-     (make-budget-subentry #f 0 1 'gnc:budget-month (make-nominal-mechanism))) 
-		      'gnc:budget-comment)
-   (make-budget-entry "other equity" '() (list
-     (make-budget-subentry #f 0 1 'gnc:budget-month (make-nominal-mechanism))) #f)))
+   (make-budget-entry "other bank" '() #f (list
+     (make-budget-subentry #f 0 1 'gnc:budget-month
+			   (make-nominal-mechanism))) #f)
+   (make-budget-entry "other cash" '() #f (list
+     (make-budget-subentry #f 0 1 'gnc:budget-month
+			   (make-nominal-mechanism))) #f)
+   (make-budget-entry "other asset" '() #f (list
+     (make-budget-subentry #f 0 1 'gnc:budget-month
+			   (make-nominal-mechanism))) #f)
+   (make-budget-entry "other credit" '() #f (list
+     (make-budget-subentry #f 0 1 'gnc:budget-month
+			   (make-nominal-mechanism))) #f)
+   (make-budget-entry "other liability" '() #f (list
+     (make-budget-subentry #f 0 1 'gnc:budget-month
+			   (make-nominal-mechanism))) #f)
+   (make-budget-entry "other stock" '() #f (list
+     (make-budget-subentry #f 0 1 'gnc:budget-month
+			   (make-nominal-mechanism))) #f)
+   (make-budget-entry "other mutual" '() #f (list
+     (make-budget-subentry #f 0 1 'gnc:budget-month
+			   (make-nominal-mechanism))) #f)
+   (make-budget-entry "other currency" '() #f (list
+     (make-budget-subentry #f 0 1 'gnc:budget-month
+			   (make-nominal-mechanism))) #f)
+   (make-budget-entry "other income" '() #f (list
+     (make-budget-subentry #f -10000 5 'gnc:budget-year
+		     (make-contingency-mechanism))) 'gnc:budget-comment)
+   (make-budget-entry "other expense" '() #f (list
+     (make-budget-subentry #f 10000 5 'gnc:budget-year
+		     (make-contingency-mechanism))) 'gnc:budget-comment)
+   (make-budget-entry "other equity" '() #f (list
+     (make-budget-subentry #f 10000 5 'gnc:budget-year
+			   (make-contingency-mechanism))) #f)))
 
 (define budget-entry-get-description
   (record-accessor budget-entry-structure 'description))
@@ -222,6 +347,9 @@
 (define budget-entry-get-action
   (record-accessor budget-entry-structure 'action))
 
+(define budget-entry-get-filter-pred
+  (record-accessor budget-entry-structure 'filter-pred))
+
 (define budget-subentry-get-amount
   (record-accessor budget-subentry-structure 'amount))
 
@@ -344,7 +472,8 @@
 (define (budget-report-accumulate-actual! value budget-line)
   (budget-report-set-actual!
    (budget-line-get-report budget-line)
-   (+ value (budget-report-get-actual (budget-line-get-report budget-line)))))
+   (+ value (budget-report-get-actual
+	     (budget-line-get-report budget-line)))))
 
 (define budget-subreport-set-min-expected!
   (record-modifier budget-subreport-structure 'minimum-expected))
@@ -402,7 +531,7 @@
 	       ((budget-nominal-pred mechanism)
 		(budget-calculate-nominal-subreport!
 		 subentry subreport mechanism begin-date end-date))
-	       (else (gnc:debug "invalid mechanism!")))
+	       (else (gnc:error "invalid mechanism!")))
 	 (budget-report-accumulate-min-expected! 
 	  report (budget-subreport-get-minimum-expected subreport))
 	 (budget-report-accumulate-max-expected! 
@@ -444,7 +573,9 @@
   (let ((np (budget-num-periods subentry begin end))
 	(amount (budget-subentry-get-amount subentry)))
     (let ((min
-	   (max 0 (* (- np 1.0) amount))))
+	   (if (>= amount 0)
+	       (max 0 (* (- np 1.0) amount))
+	       (min 0 (* (- np 1.0) amount)))))
       (budget-subreport-set-min-expected! subreport min)
       (budget-subreport-set-max-expected! subreport (+ min amount)))))
 
@@ -529,45 +660,63 @@
 
 (define (budget-calculate-actual! budget-hash others begin-date-secs end-date-secs)
   (let loop ((group (gnc:get-current-group)))
-    (cond ((not (pointer-token-null? group))
-	   (gnc:group-map-accounts
-	    (lambda (account)
-	      (let* ((line
-		      (budget-get-line-hash
-		       budget-hash
-		       (gnc:account-get-full-name account)))
-		     (line2 (cond (line line) 
-				  (else 
-				   (vector-ref others (gnc:account-get-type account)))))
-		     (acc 0))
-		(budget-report-set-account-type! (budget-line-get-report line2)
-						 (gnc:account-get-type account))
-		(cond ((budget-entry-get-action (budget-line-get-entry line2))
-		       (set! acc 0)
-		       (gnc:for-each-split-in-account 
-			account
-			(lambda (split)
-			  (let ((date 
-				 (car (gnc:transaction-get-date-posted
-				       (gnc:split-get-parent split)))))
-			    (if (and (>= date begin-date-secs)
-				     (<= date end-date-secs))
-				(set! acc (+ acc (gnc:split-get-value split)))))))
-		       (budget-report-accumulate-actual! acc line2)))
-		(loop (gnc:account-get-children account))))
-	    group)))))
+    (cond 
+     ((not (pointer-token-null? group))
+      (gnc:group-map-accounts
+       (lambda (account)
+	 (let* ((line
+		 (budget-get-line-hash budget-hash (gnc:account-get-full-name account)))
+		(line2 (cond (line line) 
+			     (else 
+			      (vector-ref others (gnc:account-get-type account)))))
+		(acc 0)
+		(filter-pred (budget-entry-get-filter-pred 
+			      (budget-line-get-entry line2))))
+	   (budget-report-set-account-type! (budget-line-get-report line2)
+					    (gnc:account-get-type account))
+	   (cond 
+	    ((budget-entry-get-action (budget-line-get-entry line2))
+	     (set! acc 0)
+	     (gnc:for-each-split-in-account 
+	      account
+	      (lambda (split)
+		(let ((date 
+		       (car (gnc:timepair-canonical-day-time 
+			     (gnc:transaction-get-date-posted
+			      (gnc:split-get-parent split))))))
+		  (cond 
+		   ((and (>= date begin-date-secs)
+			 (<= date end-date-secs))
+		    (cond
+		     ((not line)
+		      (gnc:debug (list 
+				  (gnc:account-get-full-name account)
+				  (gnc:split-get-value split)))))
+		    (cond 
+		     (filter-pred 
+		      (cond
+		       ((filter-pred split line2)
+			(set! acc (+ acc (gnc:split-get-value split))))))
+		     (else
+		      (set! acc (+ acc (gnc:split-get-value split))))))))))
+	     (budget-report-accumulate-actual! acc line2)))
+	   (loop (gnc:account-get-children account))))
+       group)))))
 
 (define (budget-calculate-delta! line)
   (let ((entry (budget-line-get-entry line))
 	(report (budget-line-get-report line)))
-    (let ((min (budget-report-get-minimum-expected report))
-	  (max (budget-report-get-maximum-expected report))
+    (let ((minimum (budget-report-get-minimum-expected report))
+	  (maximum (budget-report-get-maximum-expected report))
 	  (actual (budget-report-get-actual report)))
-      (budget-report-set-delta! 
-       report 
-       (cond ((<= actual min) (- min actual))
-	     ((>= actual max) (- max actual))
-	     (else 0.0))))))
+       ;; note: for income, min > max, so swap if necessary
+      (let ((mn (min minimum maximum))
+	    (mx (max minimum maximum)))
+	(budget-report-set-delta! 
+	 report 
+	 (cond ((<= actual mn) (- mn actual))
+	       ((>= actual mx) (- mx actual))
+	       (else 0.0)))))))
 
 ;;; Hash search
 (define budget-get-line-hash
@@ -614,7 +763,7 @@
    (gnc:make-multichoice-option
     "Report Options" "View"
     "c" "Type of budget report"
-    'full
+    'status
     (list #(full
 	    "Full"
 	    "Show all columns")
@@ -632,7 +781,7 @@
     ((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)))
+    (else (gnc:error "undefined period type in budget!") #f)))
 
 (define (gnc:date-N-delta caltime1 caltime2 type)
   (case type
@@ -646,7 +795,7 @@
      (- (gnc:date-to-month-fraction caltime2)
 	(gnc:date-to-month-fraction caltime1)))
     ((gnc:budget-year) (gnc:date-year-delta caltime1 caltime2))
-    (else (gnc:debug "undefined period type in budget!") #f)))
+    (else (gnc:error "undefined period type in budget!") #f)))
 
 ;; returns the "day number" of the specified period.  For example,
 ;; December 31 is day #92 in a 3 month period.
@@ -682,7 +831,7 @@
 				  0
 				  (+ (loop (- year 1))
 				     (gnc:days-in-year year))))))
-      (else (gnc:debug "undefined period type in budget!") #f))))
+      (else (gnc:error "undefined period type in budget!") #f))))
 
 
 ;; describe a time type
@@ -733,17 +882,17 @@
     (budget-line-make-subentry-list-proc budget-subentry-get-description)
     (html-make-left-cell (html-make-ital html-string)))
    ;; fixme:  accounts
-   (make-report-spec 
-    "Account Type"
-    (budget-line-make-report-proc budget-report-get-account-type)
-    (html-make-left-cell 
-     (lambda (acc) (symbol->string (gnc:account-type->symbol acc))))
-    #f ; total-proc
-    #f ; subtotal-html-proc
-    #f ; total-html-proc
-    #t ; first-last-preference
-    #f ; subentry-list-proc
-    #f) ; subentry-html-proc
+;   (make-report-spec 
+;    "Account Type"
+;    (budget-line-make-report-proc budget-report-get-account-type)
+;    (html-make-left-cell 
+;     (lambda (acc) (symbol->string (gnc:account-type->symbol acc))))
+;    #f ; total-proc
+;    #f ; subtotal-html-proc
+;    #f ; total-html-proc
+;    #t ; first-last-preference
+;    #f ; subentry-list-proc
+;    #f) ; subentry-html-proc
    (make-report-spec 
     "Amount"
     #f ; get-value-proc
@@ -828,6 +977,21 @@
     #f) ; subentry-html-proc
    ))
 
+(define gnc:budget-full-report-sort-specs
+  (list
+   (make-report-sort-spec
+    (budget-line-make-report-proc budget-report-get-account-type)
+    <
+    =
+    =
+    (lambda (acc) (symbol->string (gnc:account-type->symbol acc))))
+   (make-report-sort-spec
+    (budget-line-make-report-proc budget-report-get-actual)
+    <
+    =
+    #f
+    #f)))
+
 (define gnc:budget-balance-report-specs
   (list
    (make-report-spec 
@@ -884,6 +1048,21 @@
     (html-make-right-cell (html-make-ital html-currency)))
    ))
 
+(define gnc:budget-balance-report-sort-specs
+  (list
+   (make-report-sort-spec
+    (budget-line-make-report-proc budget-report-get-account-type)
+    <
+    =
+    =
+    (lambda (acc) (symbol->string (gnc:account-type->symbol acc))))
+   (make-report-sort-spec
+    (budget-line-make-report-proc budget-report-get-nominal)
+    <
+    =
+    #f
+    #f)))
+
 (define gnc:budget-status-report-specs
   (list
    (make-report-spec 
@@ -938,6 +1117,21 @@
     #f) ; subentry-html-proc
    ))
 
+(define gnc:budget-status-report-sort-specs
+  (list
+   (make-report-sort-spec
+    (budget-line-make-report-proc budget-report-get-account-type)
+    <
+    =
+    =
+    (lambda (acc) (symbol->string (gnc:account-type->symbol acc))))
+   (make-report-sort-spec
+    (budget-line-make-report-proc budget-report-get-delta)
+    <
+    =
+    #f
+    #f)))
+
 (define (gnc:budget-renderer options)
   (let* ((begindate (gnc:lookup-option options "Report Options" "From"))
          (enddate (gnc:lookup-option options "Report Options" "To"))
@@ -993,8 +1187,11 @@
 	(html-para "This is the full debug report.  It is mainly useful for debugging the budget report.")
 	(html-start-table)
 	(html-table-headers gnc:budget-full-report-specs)
-	(html-table-entries-first budget-list gnc:budget-full-report-specs
-				  budget-line-get-false-subentries)
+	(html-table-render-entries budget-list
+				   gnc:budget-full-report-specs
+				   gnc:budget-full-report-sort-specs
+				   html-table-entry-render-entries-first
+				   budget-line-get-false-subentries)
 	(html-table-totals budget-list gnc:budget-full-report-specs)
 	(html-end-table)
 	(html-end-document)))
@@ -1005,8 +1202,11 @@
 	(html-para "This is the balancing view.  It is supposed to be useful when you are balancing your budget.")
 	(html-start-table)
 	(html-table-headers gnc:budget-balance-report-specs)
-	(html-table-subentries-merged budget-list gnc:budget-balance-report-specs
-				  budget-line-get-false-subentries)
+	(html-table-render-entries budget-list 
+				   gnc:budget-balance-report-specs
+				   gnc:budget-balance-report-sort-specs
+				   html-table-entry-render-subentries-merged
+				   budget-line-get-false-subentries)
 	(html-table-totals budget-list gnc:budget-balance-report-specs)
 	(html-end-table)
 	(html-end-document)))
@@ -1017,8 +1217,11 @@
 	(html-para "This is the status view.  It is supposed to tell you the current status of your budget.")
 	(html-start-table)
 	(html-table-headers gnc:budget-status-report-specs)
-	(html-table-entries-only budget-list gnc:budget-status-report-specs
-				  budget-line-get-false-subentries)
+	(html-table-render-entries budget-list 
+				   gnc:budget-status-report-specs
+				   gnc:budget-status-report-sort-specs
+				   html-table-entry-render-entries-only
+				   budget-line-get-false-subentries)
 	(html-table-totals budget-list gnc:budget-status-report-specs)
 	(html-end-table)
 	(html-end-document))))))

src/scm/report/report-list.scm

@@ -7,4 +7,5 @@
 (gnc:depend "report/hello-world.scm")
 (gnc:depend "report/transaction-report.scm")
 (gnc:depend "report/budget-report.scm")
+(gnc:depend "report/transaction-report-2.scm")
 

src/scm/report/transaction-report-2.scm

@@ -0,0 +1,295 @@
+;; -*-scheme-*-
+;; transaction-report.scm
+;; Report on all transactions in an account
+;; Robert Merkel (rgmerk@mira.net)
+
+(gnc:support "report/transaction-report.scm")
+(gnc:depend "report-utilities.scm")
+(gnc:depend "date-utilities.scm")
+(gnc:depend "html-generator.scm")
+
+(let ()
+
+  (define (trans-report-make-split-parent-proc parent-proc)
+    (lambda (split)
+      (parent-proc (gnc:split-get-parent split))))
+
+  ;; given a split, find the account-full-name from the other split.
+  ;; not useful when there is more than one split in a transaction
+  (define (split-get-other-account-full-name split)
+    (gnc:account-get-full-name
+     (gnc:split-get-account
+      (let ((trans (gnc:split-get-parent split)))
+	(let ((split0 (gnc:transaction-get-split trans 0))
+	      (split1 (gnc:transaction-get-split trans 1)))
+	  (if (equal? split0 split) split1 split0))))))
+  
+  (define trans-report-specs
+    (list
+     (make-report-spec 
+      "Date"
+      (trans-report-make-split-parent-proc gnc:transaction-get-date-posted)
+      (html-make-left-cell
+       (lambda (date) (html-string (gnc:print-date date))))
+      #f ; total-proc
+      #f ; subtotal-html-proc
+      #f ; total-html-proc
+      #t ; first-last-preference
+      #f ; subs-list-proc
+      #f) ; subentry-html-proc
+     (make-report-spec 
+      "Num"
+      (trans-report-make-split-parent-proc gnc:transaction-get-num)
+      (html-make-left-cell html-string)
+      #f ; total-proc
+      #f ; subtotal-html-proc
+      #f ; total-html-proc
+      #t ; first-last-preference
+      #f ; subs-list-proc
+      #f) ; subentry-html-proc
+     (make-report-spec 
+      "Description"
+      (trans-report-make-split-parent-proc gnc:transaction-get-description)
+      (html-make-left-cell html-string)
+      #f ; total-proc
+      #f ; subtotal-html-proc
+      #f ; total-html-proc
+      #t ; first-last-preference
+      #f ; subs-list-proc
+      #f) ; subentry-html-proc
+     (make-report-spec 
+      "Memo"
+      gnc:split-get-memo
+      (html-make-left-cell html-string)
+      #f ; total-proc
+      #f ; subtotal-html-proc
+      #f ; total-html-proc
+      #t ; first-last-preference
+      #f ; subs-list-proc
+      #f) ; subentry-html-proc
+     (make-report-spec 
+      "Account"
+      split-get-other-account-full-name
+      (html-make-left-cell html-string)			   
+      #f ; total-proc
+      #f ; subtotal-html-proc
+      #f ; total-html-proc
+      #t ; first-last-preference
+      #f ; subs-list-proc
+      #f) ; subentry-html-proc
+     (make-report-spec
+      "Amount"
+      gnc:split-get-value
+      (html-make-right-cell html-currency)
+      + ; total-proc
+      (html-make-right-cell (html-make-strong html-currency))
+      (html-make-right-cell (html-make-strong html-currency))
+      #t ; first-last-preference
+      #f ; subentry-list-proc
+      #f))) ; subentry-html-proc
+
+  (define trans-report-sort-specs
+    (list
+     (make-report-sort-spec
+      (lambda (split) (gnc:account-get-full-name (gnc:split-get-account split)))
+      string-ci<?
+      string-ci=?
+      string-ci=?
+      (lambda (x) x))
+     (make-report-sort-spec
+      (trans-report-make-split-parent-proc gnc:transaction-get-date-posted)
+      (lambda (a b) (< (car a) (car b)))
+      (lambda (a b) (= (car a) (car b)))
+      #f
+      #f)))
+
+  (define (make-split-list account split-filter-pred)
+    (remove-if-not 
+     split-filter-pred 
+     (gnc:account-get-split-list account)))
+
+  ;; returns a predicate that returns true only if a split-scm is
+  ;; between early-date and late-date
+  (define (gnc:tr-report-make-date-filter-predicate begin-date-secs end-date-secs)
+    (lambda (split) 
+      (let ((date 
+	     (car (gnc:timepair-canonical-day-time 
+		   (gnc:transaction-get-date-posted
+		    (gnc:split-get-parent split))))))
+	(and (>= date begin-date-secs)
+	     (<= date end-date-secs)))))
+
+  ;; register a configuration option for the transaction report
+  (define (trep-options-generator)
+    (define gnc:*transaction-report-options* (gnc:new-options))
+    (define (gnc:register-trep-option new-option)
+      (gnc:register-option gnc:*transaction-report-options* new-option))
+    ;; from date
+    ;; hack alert - could somebody set this to an appropriate date?
+    (gnc:register-trep-option
+     (gnc:make-date-option
+      "Report Options" "From"
+      "a" "Report Items from this 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-trep-option
+     (gnc:make-date-option
+      "Report Options" "To"
+      "b" "Report items up to and including this date"
+      (lambda () (cons (current-time) 0))
+      #f))
+
+    ;; account to do report on
+    (gnc:register-trep-option
+     (gnc:make-account-list-option
+      "Report Options" "Account"
+      "c" "Do transaction report on these accounts"
+      (lambda ()
+        (let ((current-accounts (gnc:get-current-accounts))
+              (num-accounts (gnc:group-get-num-accounts
+                             (gnc:get-current-group)))
+              (first-account (gnc:group-get-account
+                              (gnc:get-current-group) 0)))
+          (cond ((not (null? current-accounts)) (list (car current-accounts)))
+                ((> num-accounts 0) (list first-account))
+                (else ()))))
+      #f #t))
+
+    ;; primary sorting criterion
+    (gnc:register-trep-option
+     (gnc:make-multichoice-option
+      "Sorting" "Primary Key"
+      "a" "Sort by this criterion first"
+      'date
+      (list #(date
+              "Date"
+              "Sort by date")
+            #(time
+              "Time"
+              "Sort by EXACT entry time")
+            #(corresponding-acc
+              "Transfer from/to"
+              "Sort by account transferred from/to's name")
+            #(amount
+              "Amount"
+              "Sort by amount")
+            #(description
+              "Description"
+              "Sort by description")
+            #(number
+              "Number"
+              "Sort by check/transaction number")
+            #(memo
+              "Memo"
+              "Sort by memo"))))
+
+    (gnc:register-trep-option
+     (gnc:make-multichoice-option
+      "Sorting" "Primary Sort Order"
+      "b" "Order of primary sorting"
+      'ascend
+      (list
+       #(ascend "Ascending" "smallest to largest, earliest to latest")
+       #(descend "Descending" "largest to smallest, latest to earliest"))))
+
+    (gnc:register-trep-option
+     (gnc:make-multichoice-option
+      "Sorting" "Secondary Key"
+      "c"
+      "Sort by this criterion second"
+      'corresponding-acc
+      (list #(date
+              "Date"
+              "Sort by date")
+            #(time
+              "Time"
+              "Sort by EXACT entry time")
+            #(corresponding-acc
+              "Transfer from/to"
+              "Sort by account transferred from/to's name")
+            #(amount
+              "Amount"
+              "Sort by amount")
+            #(description
+              "Description"
+              "Sort by description")
+            #(number
+              "Number"
+              "Sort by check/transaction number")
+            #(memo
+              "Memo"
+              "Sort by memo"))))
+
+    (gnc:register-trep-option
+     (gnc:make-multichoice-option
+      "Sorting" "Secondary Sort Order"
+      "d" "Order of Secondary sorting"
+      'ascend
+      (list
+       #(ascend "Ascending" "smallest to largest, earliest to latest")
+       #(descend "Descending" "largest to smallest, latest to earliest"))))
+
+    gnc:*transaction-report-options*)
+
+  (define string-db (gnc:make-string-database))
+
+  (define (gnc:titles)
+    (map (lambda (key) (string-append "<TH>" (string-db 'lookup key) "</TH>"))
+         (list 'date 'num 'desc 'memo 'category 'credit 'debit 'balance)))
+
+  (define (gnc:trep-renderer 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"))
+           (tr-report-primary-key-op (gnc:lookup-option options
+                                                        "Sorting"
+                                                        "Primary Key"))
+           (tr-report-primary-order-op (gnc:lookup-option
+                                        options "Sorting"
+                                        "Primary Sort Order"))
+           (tr-report-secondary-key-op (gnc:lookup-option options
+                                                          "Sorting"
+                                                          "Secondary Key"))
+           (tr-report-secondary-order-op
+            (gnc:lookup-option options "Sorting" "Secondary Sort Order"))
+           (accounts (gnc:option-value tr-report-account-op))
+           (date-filter-pred (gnc:tr-report-make-date-filter-predicate
+                              (car (gnc:option-value begindate))
+                              (car (gnc:option-value enddate))))	   
+	   (split-list 
+	    (apply
+	     append
+	     (map
+	      (lambda (account)
+		(make-split-list account date-filter-pred))
+	      accounts))))
+      (gnc:debug split-list)
+      (list
+       (html-start-document-title "Transaction Report")
+	(html-para "Transaction report using the new reporting framework in html-generator.scm")
+	(html-start-table)
+	(html-table-headers trans-report-specs)
+	(html-table-render-entries split-list
+				   trans-report-specs
+				   trans-report-sort-specs
+				   html-table-entry-render-entries-only
+				   #f)
+	(html-table-totals split-list trans-report-specs)
+	(html-end-table)
+	(html-end-document))))
+
+  (gnc:define-report
+   'version 1
+   'name "Transactions 2"
+   'options-generator trep-options-generator
+   'renderer gnc:trep-renderer))