r23022 - gnucash/trunk/src/report/report-system - Reports: Add collector-into-list function.. turns the idea of adding stuff to a

[Geert Janssens]

Author: gjanssens
Date: 2013-06-02 06:31:39 -0400 (Sun, 02 Jun 2013)
New Revision: 23022
Trac: http://svn.gnucash.org/trac/changeset/23022

Modified:
   gnucash/trunk/src/report/report-system/collectors.scm
   gnucash/trunk/src/report/report-system/test/test-collectors.scm
Log:
Reports: Add collector-into-list function.. turns the idea of adding stuff to a
list into a collector.

Author:    Peter Broadbery <p.broadbery at gmail.com>

Modified: gnucash/trunk/src/report/report-system/collectors.scm
===================================================================
--- gnucash/trunk/src/report/report-system/collectors.scm	2013-06-02 10:31:26 UTC (rev 23021)
+++ gnucash/trunk/src/report/report-system/collectors.scm	2013-06-02 10:31:39 UTC (rev 23022)
@@ -11,6 +11,7 @@
 (export make-collector)
 (export collector-accumulate-from)
 (export collector-count-from)
+(export collector-into-list)
 (export collector-per-property)
 (export collector-filtered-list)
 (export collector-split)
@@ -174,6 +175,12 @@
   (make-collector (lambda (x) (collector-count-from (+ total 1)))
 		  (lambda () total)))
 
+(define (collector-into-list)
+  (define (collect-into l)
+    (make-collector (lambda (x) (collect-into (cons x l)))
+		    (lambda () (reverse! l))))
+  (collect-into '()))
+
 (define (collector-per-property items make-property-filter make-per-property-collector)
   (let ((collectors (map (lambda (item)
 			   (cons (make-property-filter item)

Modified: gnucash/trunk/src/report/report-system/test/test-collectors.scm
===================================================================
--- gnucash/trunk/src/report/report-system/test/test-collectors.scm	2013-06-02 10:31:26 UTC (rev 23021)
+++ gnucash/trunk/src/report/report-system/test/test-collectors.scm	2013-06-02 10:31:39 UTC (rev 23022)
@@ -15,6 +15,7 @@
        (test test-slotset)
        (test test-collector-from-slotset)
        (test test-binary-search-lt)
+       (test test-collector-into-list)
        #t))
 
 
@@ -94,6 +95,15 @@
     (and (equal? '(10 4) (collector-add-all (make-list-collector (list c1 c2)) '(1 2 3 4))))))
 
 
+(define (test-collector-into-list)
+  (define (check l)
+    (equal? l (collector-add-all (collector-into-list) l)))
+  (logging-and (check '())
+       (check '(1))
+       (check '(1 2))
+       (check '(1 2 3))
+       (check '(1 2 3 4))))
+
 (define (test-collector-from-slotset)
   ;;(define (add-trace name collector)
   ;;   (collector-print #t name collector))