ovidiu 02/03/04 00:14:01
Modified: src/scratchpad/schecoon/scheme sitemap.scm
Log:
Added support for aggregation.
Revision Changes Path
1.11 +47 -10 xml-cocoon2/src/scratchpad/schecoon/scheme/sitemap.scm
Index: sitemap.scm
===================================================================
RCS file: /home/cvs/xml-cocoon2/src/scratchpad/schecoon/scheme/sitemap.scm,v
retrieving revision 1.10
retrieving revision 1.11
diff -u -r1.10 -r1.11
--- sitemap.scm 13 Feb 2002 01:51:20 -0000 1.10
+++ sitemap.scm 4 Mar 2002 08:14:01 -0000 1.11
@@ -340,16 +340,52 @@
(define (match-generate pipeline args-are-numbers?)
(let* ((nodelist ((node-pos 1) pipeline))
(node (if (null? nodelist) '() (car nodelist))))
- (if (not (eq? (sxml:element-name node) 'generate))
- #f
- (begin
- (let ((args (get-attributes node '(src) '(type) #t
- args-are-numbers?)))
- (match-transform
- (rest-of-nodes pipeline)
- `(sitemap:generate sitemap env ,@args)
- args-are-numbers?)
- )))))
+ (cond
+ ((eq? (sxml:element-name node) 'generate)
+ (let ((args (get-attributes node '(src) '(type) #t
+ args-are-numbers?)))
+ (match-transform
+ (rest-of-nodes pipeline)
+ `(sitemap:generate sitemap env ,@args)
+ args-are-numbers?)))
+ (else #f))))
+
+ ;; Translate a <aggregate> element.
+ (define (match-aggregate pipeline args-are-numbers?)
+ (let* ((nodelist ((node-pos 1) pipeline))
+ (node (if (null? nodelist) '() (car nodelist))))
+ (cond
+ ((eq? (sxml:element-name node) 'aggregate)
+ (let ((args (get-attributes node '(element) '(ns prefix) #f
+ args-are-numbers?)))
+ (match-parts (rest-of-nodes pipeline)
+ (sxml:content node)
+ `(sitemap:aggregate sitemap env ,@args)
+ args-are-numbers?)))
+ (else #f))))
+
+ (define (match-parts pipeline elements compfunc args-are-numbers?)
+ (let ((setup-part-fns ;; Generate the code for the <part>
+ ;; elements. Applies take-until on
+ ;; `elements' with function to setup
+ ;; parts.
+ (map
+ (lambda (node)
+ (cond
+ ((null? node) #f)
+ ((not (eq? (sxml:element-name node) 'part))
+ (xml-error "Only <part> elements allowed inside <aggregate>"))
+ (else
+ (let ((args (get-attributes node '(src)
+ '(element ns strip-root prefix)
+ #f args-are-numbers?)))
+ `(sitemap:part sitemap env ,@args pipeline)))))
+ elements)))
+ (match-transform pipeline
+ `(let ((pipeline ,compfunc))
+ ,@setup-part-fns
+ pipeline)
+ args-are-numbers?)))
;; Translate zero or more <transform> elements
(define (match-transform pipeline compfunc args-are-numbers?)
@@ -489,6 +525,7 @@
,(or
(match-generate pipeline args-are-numbers?)
(match-reader pipeline args-are-numbers?)
+ (match-aggregate pipeline args-are-numbers?)
(let* ((nodelist ((node-pos 1) pipeline))
(node (if (null? nodelist) '() (car nodelist))))
(xml-error node "Invalid pipeline definition")))))))
----------------------------------------------------------------------
In case of troubles, e-mail: [EMAIL PROTECTED]
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
