r in the spirit of SSAX's @ref{sxml transform pre-post-order,,pre-post-order}. @code{fold-layout} was originally presented in Andy Wingo's 2007 paper, @emph{Applications of fold to XML transformation}. @example bindings := (...) binding := ( ...) | (*default* . ) | (*text* . ) tag := handler-pair := (pre-layout . ) | (post . ) | (bindings . ) | (pre . ) | (macro . ) @end example @table @var @item pre-layout-handler A function of three arguments: @table @var @item kids the kids of the current node, before traversal @item params the params of the current node @item layout the layout coming into this node @end table @var{pre-layout-handler} is expected to use this information to return a layout to pass to the kids. The default implementation returns the layout given in the arguments. @item post-handler A function of five arguments: @table @var @item tag the current tag being processed @item params the params of the current node @item layout the layout coming into the current node, before any kids were processed @item klayout the layout after processing all of the children @item kids the already-processed child nodes @end table @var{post-handler} should return two values, the layout to pass to the next node and the final tree. @item text-handler @var{text-handler} is a function of three arguments: @table @var @item text the string @item params the current params @item layout the current layout @end table @var{text-handler} should return two values, the layout to pass to the next node and the value to which the string should transform. @end table " (define (err . args) (error "no binding available" args)) (define (fdown tree bindings pcont params layout ret) (define (fdown-helper new-bindings new-layout cont) (let ((cont-with-tag (lambda args (apply cont (car tree) args))) (bindings (if new-bindings (append new-bindings bindings) bindings)) (style-params (assq-ref stylesheet (car tree) '()))) (cond ((null? (cdr tree)) (values '() bindings cont-with-tag (cons style-params params) new-layout '())) ((and (pair? (cadr tree)) (eq? (caadr tree) '@)) (let ((params (cons (append (cdadr tree) style-params) params))) (values (cddr tree) bindings cont-with-tag params new-layout '()))) (else (values (cdr tree) bindings cont-with-tag (cons style-params params) new-layout '()))))) (define (no-bindings) (fdown-helper #f layout (assq-ref bindings '*default* err))) (define (macro macro-handler) (fdown (apply macro-handler tree) bindings pcont params layout ret)) (define (pre pre-handler) (values '() bindings (lambda (params layout old-layout kids) (values layout (reverse kids))) params layout (apply pre-handler tree))) (define (have-bindings tag-bindings) (fdown-helper (assq-ref tag-bindings 'bindings #f) ((assq-ref tag-bindings 'pre-layout (lambda (tag params layout) layout)) tree params layout) (assq-ref tag-bindings 'post (assq-ref bindings '*default* err)))) (let ((tag-bindings (assq-ref bindings (car tree) #f))) (cond ((not tag-bindings) (no-bindings)) ((assq-ref tag-bindings 'macro #f) => macro) ((assq-ref tag-bindings 'pre #f) => pre) (else (have-bindings tag-bindings))))) (define (fup tree bindings cont params layout ret kbindings kcont kparams klayout kret) (call-with-values (lambda () (kcont kparams layout klayout (reverse kret))) (lambda (klayout kret) (values bindings cont params klayout (cons kret ret))))) (define (fhere tree bindings cont params layout ret) (call-with-values (lambda () ((assq-ref bindings '*text* err) tree params layout)) (lambda (tlayout tret) (values bindings cont params tlayout (cons tret ret))))) (call-with-values (lambda () (foldts*-values fdown fup fhere tree bindings #f (cons params '()) layout '())) (lambda (bindings cont params layout ret) (values (car ret) layout))))