Commit | Line | Data |
---|---|---|
47f3ce52 AW |
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 | \f | |
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 |