36 lines
1.4 KiB
Scheme
36 lines
1.4 KiB
Scheme
|
; $Id: sxml-utils.scm,v 1.1 2006/03/02 04:32:58 olpa Exp $
|
||
|
|
; A copy-paste of a part of the SXML library
|
||
|
|
|
||
|
|
; from CVS: SSAX/lib/SXML-tree-trans.scm
|
||
|
|
(define (pre-post-order tree bindings)
|
||
|
|
(let* ((default-binding (assq '*default* bindings))
|
||
|
|
(text-binding (or (assq '*text* bindings) default-binding))
|
||
|
|
(text-handler ; Cache default and text bindings
|
||
|
|
(and text-binding
|
||
|
|
(if (procedure? (cdr text-binding))
|
||
|
|
(cdr text-binding) (cddr text-binding)))))
|
||
|
|
(let loop ((tree tree))
|
||
|
|
(cond
|
||
|
|
((null? tree) '())
|
||
|
|
((not (pair? tree))
|
||
|
|
(let ((trigger '*text*))
|
||
|
|
(if text-handler (text-handler trigger tree)
|
||
|
|
(error "Unknown binding for " trigger " and no default"))))
|
||
|
|
((not (symbol? (car tree))) (map loop tree)) ; tree is a nodelist
|
||
|
|
(else ; tree is an SXML node
|
||
|
|
(let* ((trigger (car tree))
|
||
|
|
(binding (or (assq trigger bindings) default-binding)))
|
||
|
|
(cond
|
||
|
|
((not binding)
|
||
|
|
(error "Unknown binding for " trigger " and no default"))
|
||
|
|
((not (pair? (cdr binding))) ; must be a procedure: handler
|
||
|
|
(apply (cdr binding) trigger (map loop (cdr tree))))
|
||
|
|
((eq? '*preorder* (cadr binding))
|
||
|
|
(apply (cddr binding) tree))
|
||
|
|
((eq? '*macro* (cadr binding))
|
||
|
|
(loop (apply (cddr binding) tree)))
|
||
|
|
(else ; (cadr binding) is a local binding
|
||
|
|
(apply (cddr binding) trigger
|
||
|
|
(pre-post-order (cdr tree) (append (cadr binding) bindings)))
|
||
|
|
))))))))
|