1;;;; (sxml apply-templates) -- xslt-like transformation for sxml 2;;;; 3;;;; Copyright (C) 2009 Free Software Foundation, Inc. 4;;;; Copyright 2004 by Andy Wingo <wingo at pobox dot com>. 5;;;; Written 2003 by Oleg Kiselyov <oleg at pobox dot com> as apply-templates.scm. 6;;;; 7;;;; This library is free software; you can redistribute it and/or 8;;;; modify it under the terms of the GNU Lesser General Public 9;;;; License as published by the Free Software Foundation; either 10;;;; version 3 of the License, or (at your option) any later version. 11;;;; 12;;;; This library is distributed in the hope that it will be useful, 13;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of 14;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 15;;;; Lesser General Public License for more details. 16;;;; 17;;;; You should have received a copy of the GNU Lesser General Public 18;;;; License along with this library; if not, write to the Free Software 19;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA 20;;;; 21 22;;; Commentary: 23;; 24;; Pre-order traversal of a tree and creation of a new tree: 25;; 26;;@smallexample 27;; apply-templates:: tree x <templates> -> <new-tree> 28;;@end smallexample 29;; where 30;;@smallexample 31;; <templates> ::= (<template> ...) 32;; <template> ::= (<node-test> <node-test> ... <node-test> . <handler>) 33;; <node-test> ::= an argument to node-typeof? above 34;; <handler> ::= <tree> -> <new-tree> 35;;@end smallexample 36;; 37;; This procedure does a @emph{normal}, pre-order traversal of an SXML 38;; tree. It walks the tree, checking at each node against the list of 39;; matching templates. 40;; 41;; If the match is found (which must be unique, i.e., unambiguous), the 42;; corresponding handler is invoked and given the current node as an 43;; argument. The result from the handler, which must be a @code{<tree>}, 44;; takes place of the current node in the resulting tree. 45;; 46;; The name of the function is not accidental: it resembles rather 47;; closely an @code{apply-templates} function of XSLT. 48;; 49;;; Code: 50 51(define-module (sxml apply-templates) 52 #:use-module (sxml ssax) 53 #:use-module ((sxml xpath) :hide (filter)) 54 55 #:export (apply-templates)) 56 57(define (apply-templates tree templates) 58 59 ; Filter the list of templates. If a template does not 60 ; contradict the given node (that is, its head matches 61 ; the type of the node), chop off the head and keep the 62 ; rest as the result. All contradicting templates are removed. 63 (define (filter-templates node templates) 64 (cond 65 ((null? templates) templates) 66 ((not (pair? (car templates))) ; A good template must be a list 67 (filter-templates node (cdr templates))) 68 (((node-typeof? (caar templates)) node) 69 (cons (cdar templates) (filter-templates node (cdr templates)))) 70 (else 71 (filter-templates node (cdr templates))))) 72 73 ; Here <templates> ::= [<template> | <handler>] 74 ; If there is a <handler> in the above list, it must 75 ; be only one. If found, return it; otherwise, return #f 76 (define (find-handler templates) 77 (and (pair? templates) 78 (cond 79 ((procedure? (car templates)) 80 (if (find-handler (cdr templates)) 81 (error "ambiguous template match")) 82 (car templates)) 83 (else (find-handler (cdr templates)))))) 84 85 (let loop ((tree tree) (active-templates '())) 86 ;(cout "active-templates: " active-templates nl "tree: " tree nl) 87 (if (nodeset? tree) 88 (map-union (lambda (a-tree) (loop a-tree active-templates)) tree) 89 (let ((still-active-templates 90 (append 91 (filter-templates tree active-templates) 92 (filter-templates tree templates)))) 93 (cond 94 ;((null? still-active-templates) '()) 95 ((find-handler still-active-templates) => 96 (lambda (handler) (handler tree))) 97 ((not (pair? tree)) '()) 98 (else 99 (loop (cdr tree) still-active-templates))))))) 100 101;;; arch-tag: 88cd87de-8825-4ab3-9721-cf99694fb787 102;;; templates.scm ends here 103