Module: stx-engine

 $Id: stx-engine.scm,v 1.9403 2002/12/25 19:33:48 kl Exp kl $


f: stx:version
f: stx:error
f: stx:read-content
f: stx:clean-feed
f: sxml:clean-feed
This functions will be probably moved to sxml-tools
f: sxml:refactor-ns
f: sxml:xml->sxml-autoprefix
f: sxml:extract-prefix-assigs

Tree transformation
f: stx:apply-templates
f: stx:find-template
f: stx:load-sst
f: stx:stx->tmpl+env
f: stx:write-ss
f: stx:transform-dynamic
f: stx:write-transformer
f: stx:eval-transformer
f: stx:transform
f: stx:translate
f: stx:make-stx-stylesheet
Transformers for XSL stylesheet elements
f: stx:scm->stx
f: stx:stx-var->stx
f: stx:xsl-var->stx
f: stx:attr->html
f: stx:xsl->stx
m: stx:call-function

Wrappers

stx:version

(define stx:version
... Full Code ... )
 Auxilliary 


stx:error

(define (stx:error . messages)
... Full Code ... )


stx:read-content

(define (stx:read-content obj objname)
... Full Code ... )
 Reads content of a given SXML element 'obj' using Scheme reader.
 The content has to be a list of strings (first of them will be read).
 If the content is empty, "" is returned.


stx:clean-feed

(define (stx:clean-feed . fragments)
... Full Code ... )


sxml:clean-feed

(define (sxml:clean-feed . fragments)
... Full Code ... )
 DL: Borrowed from the older version of SXML Tools
 Filter the 'fragments'
 The fragments are a list of strings, characters,
 numbers, thunks, #f -- and other fragments.
 The function traverses the tree depth-first, and returns a list
 of strings, characters and executed thunks, and ignores #f and '().

 If all the meaningful fragments are strings, then
  (apply string-append ... )
 to a result of this function will return its string-value 

 It may be considered as a variant of Oleg Kiselyov's SRV:send-reply:
 While SRV:send-reply displays fragments, this function returns the list 
 of meaningful fragments and filter out the garbage.



This functions will be probably moved to sxml-tools


sxml:refactor-ns

(define (sxml:refactor-ns tree)
... Full Code ... )
 Transforms top-level *NAMESPACES* in SXML document 
 parsed using SSAX 4.9 to aux-list representation compatible to
 SXML-spec. ver. 2.5


sxml:xml->sxml-autoprefix

(define (sxml:xml->sxml-autoprefix name)
... Full Code ... )
 Reads XML document as SXML tree. NS prefixes declared in XML document
 are used as namespace-id's.


sxml:extract-prefix-assigs

(define (sxml:extract-prefix-assigs file)
... Full Code ... )
 of NS-prefix/URIs declared as a list of pairs.



Tree transformation


stx:apply-templates

(define (stx:apply-templates tree templates root environment)
... Full Code ... )
 stx:apply-templates:: <tree> x <templates> x <root> x <environment> -> <new-tree>
 where
 <templates> ::= <default-template> <text-template> <template>*
 <default-template> ::= (*default* . <handler>)
 <text-template> ::= (*text* . <handler>)
 <template>  ::= (<matcher> <handler>) | ( XMLname <handler>)
 <root>     ::= <document-root>
 <environment> ::= <lambda-tuple>
 <matcher>  ::= <node> <root> -> <nodeset>
 <handler> :: <node> <templates> <root> <environment> -> <new-node>

 The stx:apply-templates function visits top-level nodes of a given tree and 
 process them in accordance with a list of templates given. 
 If a node is a textual one then it is processed usind 'text-template',
 which has to be second element in given list of templates. 
 If a node is a pair then stx:apply-templates looks up a corresponding template
 among  given <templates> using stx:find-template function. 
 If failed, stx:apply-templates tries to locate a *default* template, 
 which has to be first element in given list of templates. It's an
 error if this latter attempt fails as well.  
 Having found a template, its handler is applied to the current node. 
 The result of the handler application, which should
 also be a <tree>, replaces the current node in output tree.

 This function is slightly similar to Oleg Kiselyov's "pre-post-order" function
 with *preorder* bindings. 


stx:find-template

(define (stx:find-template node templates root)
... Full Code ... )
  stx:find-template: <node> x <templates> x <root> -> <template>
  This function returns first template in <templates> whouse <matcher>
  matches given <node>
  <matcher> matches node if:
    - if it is a symbol and its the same as the name of the node matched
    - if it is a procedure (sxpath/txpath generated one) then it is 
     applyed (with respect to given <root>) sequentially to the matched node 
     and its parents until the matched node is a member of a resulting nodeset 
     or root node is reached. In the first case the node matches successfuly, 
     in the second case it does not. 


stx:load-sst

(define (stx:load-sst link)
... Full Code ... )
 Returns SXML tree for a given link.
 A link is a lambda-tuple of its attributes.


stx:stx->tmpl+env

(define (stx:stx->tmpl+env stx-objects)
... Full Code ... )
 Transform top-level objects of stx:stylesheet 
 to a list whose car is corresponding template (#f no templates generated) 
 and whose cadr is corresponding environment binding (#f if no bindings),


stx:write-ss

(define (stx:write-ss t+e fname)
... Full Code ... )


stx:transform-dynamic

(define (stx:transform-dynamic doc sst-sxml)
... Full Code ... )
 transformate given SXML document <doc> using stylesheet <sst> in SXML
 format


stx:write-transformer

(define (stx:write-transformer sst file)
... Full Code ... )


stx:eval-transformer

(define (stx:eval-transformer sst-scm)
... Full Code ... )
 evalutes components  of given (in Scheme) STX stylesheet and returns a "prepared"
 stylesheet where all the necessary S-expressions are evaluated 


stx:transform

(define (stx:transform doc sst-lambda)
... Full Code ... )
 transforms given SXML document <doc> using prepared (compiled or eval'uated)
 stylesheet <sst-lambda>


stx:translate

(define (stx:translate sst)
... Full Code ... )
 translate given STX stylesheet <sst> from SXML to Scheme 


stx:make-stx-stylesheet

(define (stx:make-stx-stylesheet stx-tree)
... Full Code ... )
 Generates an stx:stylesheet from a stylesheet represented as <stx-tree>
 in SXML format



Transformers for XSL stylesheet elements


stx:scm->stx

(define (stx:scm->stx tmplt)
... Full Code ... )
 Transforms element stx:template (extracted from XSL stylesheet and
 represented in SXML format) to stx:template


stx:stx-var->stx

(define (stx:stx-var->stx var)
... Full Code ... )
 Transforms STX element stx:var to stx:variable


stx:xsl-var->stx

(define (stx:xsl-var->stx var)
... Full Code ... )
 Transforms XSL element xsl:var to stx:variable


stx:attr->html

(define (stx:attr->html attr)
... Full Code ... )


stx:xsl->stx

(define (stx:xsl->stx tmplt output-attr doc-string-out custom-prefixes c-root)
... Full Code ... )
 transforms an xsl:template to stx:template


stx:call-function

(define-macro stx:call-function (lambda (name type tpl-node $-env)
... Full Code ... )
 A helper for stx:xsl->stx 



Wrappers

Code

stx:version

Index
 Auxilliary 
(define stx:version 
  (string-append " $Revision: 1.9403 $" nl " $Date: 2002/12/25 19:33:48 $"))

stx:error

Index
(define (stx:error . messages)
  (cerr nl "STX: ")
  (apply cerr messages)
  (cerr nl)
  (exit -1))

stx:read-content

Index
 Reads content of a given SXML element 'obj' using Scheme reader.
 The content has to be a list of strings (first of them will be read).
 If the content is empty, "" is returned.
(define (stx:read-content obj objname)
  (let ((ct (sxml:content obj)))
    (cond 
      ((null? ct) "")
      ((string? (car ct))
       (with-exception-handler         
        (lambda(mes)
          (apply stx:error 
                 `("Error " ,nl ,mes ,nl "reading " ,objname " code:" ,nl
                   ,(car ct) ,nl "from element" ,nl
                   ,@(sxml:clean-feed (sxml:sxml->xml obj)) ,nl))
          (exit))
        (lambda()
          (call-with-input-string (car ct) read))))
      (else 
	    (stx:error "Invalid " objname " element:" nl obj)))
      ))

stx:clean-feed

Index
(define (stx:clean-feed . fragments)
  (reverse
  (let loop ((fragments fragments) (result '()))
    (cond
      ((null? fragments) result)
      ((not (car fragments)) (loop (cdr fragments) result))
      ((null? (car fragments)) (loop (cdr fragments) result))
      (else
        (loop (cdr fragments) 
	      (cons (car fragments) result)))))))

sxml:clean-feed

Index
 DL: Borrowed from the older version of SXML Tools
 Filter the 'fragments'
 The fragments are a list of strings, characters,
 numbers, thunks, #f -- and other fragments.
 The function traverses the tree depth-first, and returns a list
 of strings, characters and executed thunks, and ignores #f and '().

 If all the meaningful fragments are strings, then
  (apply string-append ... )
 to a result of this function will return its string-value 

 It may be considered as a variant of Oleg Kiselyov's SRV:send-reply:
 While SRV:send-reply displays fragments, this function returns the list 
 of meaningful fragments and filter out the garbage.
(define (sxml:clean-feed . fragments)
  (reverse
  (let loop ((fragments fragments) (result '()))
    (cond
      ((null? fragments) result)
      ((not (car fragments)) (loop (cdr fragments) result))
      ((null? (car fragments)) (loop (cdr fragments) result))
      ((pair? (car fragments))
        (loop (cdr fragments) 
	      (loop (car fragments) result)))
 ;      ((procedure? (car fragments))
 ;         (loop (cdr fragments) 
 ;              (cons ((car fragments))
 ;	       result)))
      (else
        (loop (cdr fragments) 
	      (cons (car fragments) result)))))))

sxml:refactor-ns

Index
 Transforms top-level *NAMESPACES* in SXML document 
 parsed using SSAX 4.9 to aux-list representation compatible to
 SXML-spec. ver. 2.5
(define (sxml:refactor-ns tree)
  (if (and (pair? tree) (pair? (cdr tree)) (pair? (cadr tree))
	   (eq? '*NAMESPACES* (caadr tree)))
    `(,(car tree) (@@ (*NAMESPACES* ,@(cdadr tree))) ,@(cddr tree))
    tree))

sxml:xml->sxml-autoprefix

Index
 Reads XML document as SXML tree. NS prefixes declared in XML document
 are used as namespace-id's.
(define (sxml:xml->sxml-autoprefix name)
  (sxml:refactor-ns ; workaround for SSAX 4.9
    (let ((ns-list (sxml:extract-prefix-assigs name)))  
    (ssax:xml->sxml
      (open-input-resource name)
      ns-list))))

sxml:extract-prefix-assigs

Index
 of NS-prefix/URIs declared as a list of pairs.
(define (sxml:extract-prefix-assigs file)
  (call-with-input-file
      file
    (lambda (p)
      (ssax:skip-S p)
      (let loop ((lst (ssax:read-markup-token p)))
        (case (car lst)
          ((PI)  ; Processing instruction           
           (ssax:skip-pi p)  ; ignore until the end           
           (ssax:skip-S p)
           (loop (ssax:read-markup-token p)))
          ((START)
           (filter-and-map
            (lambda(x)
              (and (pair? (car x)) (eq? 'xmlns (caar x))))
            (lambda(x)
              (cons (cdar x) (cdr x)))
            (ssax:read-attributes p '())))
          (else
           (display "Unknown token type: ")
           (display (car lst))
           (exit)))))))

stx:apply-templates

Index
 stx:apply-templates:: <tree> x <templates> x <root> x <environment> -> <new-tree>
 where
 <templates> ::= <default-template> <text-template> <template>*
 <default-template> ::= (*default* . <handler>)
 <text-template> ::= (*text* . <handler>)
 <template>  ::= (<matcher> <handler>) | ( XMLname <handler>)
 <root>     ::= <document-root>
 <environment> ::= <lambda-tuple>
 <matcher>  ::= <node> <root> -> <nodeset>
 <handler> :: <node> <templates> <root> <environment> -> <new-node>

 The stx:apply-templates function visits top-level nodes of a given tree and 
 process them in accordance with a list of templates given. 
 If a node is a textual one then it is processed usind 'text-template',
 which has to be second element in given list of templates. 
 If a node is a pair then stx:apply-templates looks up a corresponding template
 among  given <templates> using stx:find-template function. 
 If failed, stx:apply-templates tries to locate a *default* template, 
 which has to be first element in given list of templates. It's an
 error if this latter attempt fails as well.  
 Having found a template, its handler is applied to the current node. 
 The result of the handler application, which should
 also be a <tree>, replaces the current node in output tree.

 This function is slightly similar to Oleg Kiselyov's "pre-post-order" function
 with *preorder* bindings. 
(define (stx:apply-templates tree templates root environment)
  (cond
    ((nodeset? tree)
     (map (lambda (a-tree) 
	    (stx:apply-templates a-tree templates root environment)) 
	  tree))
    ((pair? tree) 
     (cond
       ((tee-4 "Template: " 
	(stx:find-template tree 
		      (cddr templates) ; *default* and *text* skipped
		      root)) 
	=> (lambda (template) 
	     ((cadr template) tree templates root environment)))
       (else 
	 (if (eq? '*default* (caar templates))
	   ((cadar templates) tree templates root environment)
	   (stx:error "stx:apply-templates: There is no template in: " templates
		      ; nl "for: " tree
		      )) 
	 )))
    ((string? tree) ; *text*
	 (if (eq? '*text* (caadr templates))
	   ((cadadr templates) tree)
	   (stx:error "stx:apply-templates: There is no *text* templates for: " 
		      templates))) 
    (else (stx:error "Unexpected type of node: " tree))))

stx:find-template

Index
  stx:find-template: <node> x <templates> x <root> -> <template>
  This function returns first template in <templates> whouse <matcher>
  matches given <node>
  <matcher> matches node if:
    - if it is a symbol and its the same as the name of the node matched
    - if it is a procedure (sxpath/txpath generated one) then it is 
     applyed (with respect to given <root>) sequentially to the matched node 
     and its parents until the matched node is a member of a resulting nodeset 
     or root node is reached. In the first case the node matches successfuly, 
     in the second case it does not. 
(define (stx:find-template node templates root)
  (let ((pattern-matches? 
	  (lambda (node pattern-test) 
	    (let rpt ((context-node node))
	      (cond 
		((null? context-node) #f)
		((memq node (pattern-test context-node
                                          `((*root* ,root))))
		 #t)
		(else ; try PARENT
		  (rpt ((sxml:node-parent root) context-node))))))))  
    (let rpt ((bnd templates)) 
      (cond ((null? bnd) #f)
	    ((and (symbol? (caar bnd)) (eq? (caar bnd) (car node)))
	     (car bnd))
	    ((and (procedure? (caar bnd)) ; redundant?
		  (pattern-matches? node (caar bnd)))
	     (car bnd))
	    (else (rpt (cdr bnd)))))))

stx:load-sst

Index
 Returns SXML tree for a given link.
 A link is a lambda-tuple of its attributes.
(define (stx:load-sst link)
 ((cond 
    ((equal? (link 'type) "stx")
       (lambda(x)
	 (call-with-input-file x read)))
    ((equal? (link 'type) "sxml")
     (stx:make-stx-stylesheet
       (lambda(x)
	 (call-with-input-file x read))))
    ; default is xml
    (else 
       (lambda(x)
         (stx:make-stx-stylesheet
          (sxml:xml->sxml-autoprefix x)))))
   (link 'href)))

stx:stx->tmpl+env

Index
 Transform top-level objects of stx:stylesheet 
 to a list whose car is corresponding template (#f no templates generated) 
 and whose cadr is corresponding environment binding (#f if no bindings),
(define (stx:stx->tmpl+env stx-objects)
 (let rpt ((objs stx-objects)
	   (templts '())
	   (envrt '()))
  (cond
    ((null? objs) (list (reverse templts)
			envrt))
    ; templates
    ((eq? (caar objs) 'stx:template)
     (let* ((obj (car objs))
	(handler (caddr obj)))
       (rpt 
	 (cdr objs)
	 (cond 
	   ((sxml:attr obj 'match) 
	    => (lambda (x) 
		 (cons 
		   (list `(sxpath ,x) handler)
		   ;(list `(sxp:xpath+root ,x) handler)
		   templts)))
	   ((sxml:attr obj 'match-lambda)
	    => (lambda (x) 
		 (cons (list x handler) templts)))
	   (else 
	     (verb-2 nl "NO match for: " (cadr obj))
	     templts))
	 (cond 
	   ((sxml:attr obj 'name)
	    => (lambda (x) 
		 (cons  
		   (list (string->symbol x) handler) envrt)))
	   (else 
	     (verb-2 nl "NO name for: " (cadr obj) 
		     "==" (sxml:attr obj 'name))
	     envrt)))))
    ((eq? (caar objs) 'stx:variable)
      (let* ((obj (car objs))
	     (name (sxml:attr obj 'name)) 
	     (code  (caddr obj)))              ; (sxml:content obj)
	(rpt 
	(cdr objs)
	templts
	(cons (list (string->symbol name) code) envrt))))
    (else
      (verb-2 nl "Unrecognized object: " (caar objs) nl)
      (rpt (cdr objs) templts envrt)))))

stx:write-ss

Index
(define (stx:write-ss t+e fname)
  (let* ((of
          ; DL: replacing this non-R5RS call with the following piece of code
          ;(open-output-file fname 'replace)
          (begin 
            (when (file-exists? fname) (delete-file fname))
            (open-output-file fname)))
	 (wrt (lambda x 
		(for-each (lambda(y) (display y of)) x))))
    (wrt    "#cs(module transform mzscheme" nl 
            "(require" nl
            "(rename (lib \"list.ss\") sort mergesort)" nl
            "(lib \"stx-engine.ss\" \"sxml\")" nl
            "(lib \"util.ss\" \"ssax\")" nl 
            "(lib \"txpath.ss\" \"sxml\")" nl
            "(lib \"sxpath-ext.ss\" \"sxml\")" nl 
            "(lib \"sxml-tools.ss\" \"sxml\")" nl
            "(lib \"sxpathlib.ss\" \"sxml\")" nl
            "(lib \"libmisc.ss\" \"sxml\")" nl
            "(lib \"myenv.ss\" \"ssax\")" nl
            "(lib \"common.ss\" \"sxml\"))" nl
	    "(provide stylesheet)" nl)
    
    (wrt nl "(define stylesheet (list " nl "(list ; templates:")
  (for-each
    (lambda(x)
      (wrt nl "(list ") 
      (pp (car x) of)
      (wrt "") 
      (pp (cadr x) of)
      (wrt ")" nl))
    (car t+e))
    (wrt ") ; end templates" nl nl "( list ; environment:")
  (for-each
    (lambda(x)
      (wrt nl "(list '" (car x) nl) 
      (pp (cadr x) of)
      (wrt ") ; end of `" (car x) "'" nl))
    (cadr t+e))
    (wrt ")  ; end environment" nl)
    (wrt ")) ; end stylesheet" nl)
    (wrt ")" nl) ; end module 
  ))

stx:transform-dynamic

Index
 transformate given SXML document <doc> using stylesheet <sst> in SXML
 format
(define (stx:transform-dynamic doc sst-sxml)
  (stx:transform
    doc
    (stx:eval-transformer
      (stx:translate sst-sxml))))

stx:write-transformer

Index
(define (stx:write-transformer sst file)
     (stx:write-ss (stx:translate sst) file))

stx:eval-transformer

Index
 evalutes components  of given (in Scheme) STX stylesheet and returns a "prepared"
 stylesheet where all the necessary S-expressions are evaluated 
(define (stx:eval-transformer sst-scm)
  (list 
	(map 
	  (lambda(x)
	    (list (eval (car x))
		  (eval (cadr x))))
	  (car sst-scm))
	(map 
	  (lambda(x)
	    (list (car x)
		  (eval (cadr x))))
	  (cadr sst-scm))))

stx:transform

Index
 transforms given SXML document <doc> using prepared (compiled or eval'uated)
 stylesheet <sst-lambda>
(define (stx:transform doc sst-lambda)
  (let ((string-out sxml:sxml->html))
   (stx:apply-templates doc
      ; bindings
      (tee-3
	"Templates: "
       (append
	 `((*default* 
	       ,(lambda (node bindings root environment)
		   (stx:apply-templates (sxml:content node) 
				      bindings 
				      root environment)))
	   (*text* 
	      ,string-out))
	  (car sst-lambda)))
      ;root 
      doc
      ; environment
      (apply 
	lambda-tuple
	(tee-3 
	  "Environment: "
	  (append 
	    `((stx:version ,stx:version))
	  (cadr sst-lambda) 
	    ))))))

stx:translate

Index
 translate given STX stylesheet <sst> from SXML to Scheme 
(define (stx:translate sst)
  (let* 
    (
 ;     (output-attr
 ;       ; lambda tuple of 'xsl:output' attributes
 ;       (apply lambda-tuple
 ;	      (cond
 ;		(((if-car-sxpath '(xsl:stylesheet xsl:output @)) sst)
 ;		 =>  cdr)
 ;		(else '((method "html"))))))
 ;     ((string-out)
 ;      (case (string->symbol (output-attr 'method))
 ;	((text) self)
 ;	((xml)  sxml:string->xml)
 ;	(else   sxml:sxml->html)))
     (stx-sst
       (tee-2
	 "STX stylesheets: "
	 (append sst
		 (apply append
			(map
			  (lambda(x)
			    (tee-2 
			      "IMPORTED: " 
			      ; just stx:template and stx:variable elements
			      ; are used from imported _STX_ stylesheets
			      ((sxpath '((*or* stx:template stx:variable))) 
			       (stx:load-sst (apply lambda-tuple 
						    (sxml:attr-list x))))))
			  ((sxpath '((*or* xsl:import stx:import))) sst))))))
     (templates+env
       (tee-2
	 "templates+env"
	 (stx:stx->tmpl+env
	  ((sxpath '(*)) stx-sst))))
     )
   templates+env))

stx:make-stx-stylesheet

Index
 Generates an stx:stylesheet from a stylesheet represented as <stx-tree>
 in SXML format
(define (stx:make-stx-stylesheet stx-tree)
  (let* 
    ((output-attr
       ; lambda tuple of 'xsl:output' attributes
       (apply lambda-tuple
	      (cond
		(((if-car-sxpath '(xsl:stylesheet xsl:output @)) stx-tree)
		 =>  cdr)
		(else '((method "html"))))))
     (string-out
      (case (string->symbol (output-attr 'method))
	((text) 'self)
	((xml)  'sxml:string->xml)
	(else   'sxml:sxml->html)))
     (custom-prefixes 
       (map string->symbol
	    ((sxpath '(xsl:stylesheet stx:import @ prefix *text*))
	     stx-tree))))
     (cons 'stx:stylesheet
   (map
      (lambda(x)
	(cond 
	  ; xsl:template
	  ((eq? (car x) 'xsl:template)
	   (stx:xsl->stx x output-attr string-out custom-prefixes
			 stx-tree))
	  ; stx:template
	  ((eq? (car x) 'stx:template)
	   (stx:scm->stx x))
	  ; stx:variable
	  ((eq? (car x) 'stx:variable)
	   (stx:stx-var->stx x))
	  ; xsl:variable
	  ((eq? (car x) 'xsl:variable)
	   (stx:xsl-var->stx x))
	  (else x)))
      ((sxpath `(xsl:stylesheet *)) stx-tree)))
    ))

stx:scm->stx

Index
 Transforms element stx:template (extracted from XSL stylesheet and
 represented in SXML format) to stx:template
(define (stx:scm->stx tmplt)
  `(stx:template (@ ,@(sxml:attr-list tmplt))
	(lambda (current-node stx:templates current-root $)
		 ,(stx:read-content tmplt "<stx:template@match>"))))

stx:stx-var->stx

Index
 Transforms STX element stx:var to stx:variable
(define (stx:stx-var->stx var)
  `(stx:variable (@ ,@(sxml:attr-list var))
		 ,(stx:read-content var "<stx:variable")))

stx:xsl-var->stx

Index
 Transforms XSL element xsl:var to stx:variable
(define (stx:xsl-var->stx var)
  `(stx:variable (@ ,@(sxml:attr-list var))
		 ',(sxml:content var)))

stx:attr->html

Index
(define (stx:attr->html attr)
	 (if (equal? "" (cadr attr))
              `(list " " ,(sxml:ncname attr))
              `(list " " ,(sxml:ncname attr) "='" ,(cadr attr) "'")))

stx:xsl->stx

Index
 transforms an xsl:template to stx:template
(define (stx:xsl->stx tmplt output-attr doc-string-out 
		       custom-prefixes c-root)
  (let* 
    ; list of template's attributes
    ((attr-list (sxml:attr-list tmplt))
     (sst-method (cond 
		   ((sxml:attr-from-list attr-list 'stx:method)
		    => string->symbol)
	           ; xml is default
		   (else 'xml)))
     ; output string for _template_  (not document!) conversion
     (sst-string-out
       (case sst-method
	 ((text) self)
	 ((html)  sxml:string->html)
	 (else   sxml:sxml->xml))))

  `(stx:template (@ ,@attr-list)
	(lambda (current-node stx:templates current-root $)
	  ,(cons 'list
	  ;(stx:clean-feed
	  (stx:apply-templates 
	    (sxml:content tmplt)
	    `((*default* 
		 ,(lambda (tt-node bindings root environment)
		     (if (cond ((sxml:name->ns-id (car tt-node)) 
				=> (lambda(x) 
				     (member (string->symbol x)
					     custom-prefixes)))
			       (else #f))	 
		       ; user-defined tag 
		       `(stx:call-function ,(sxml:ncname tt-node) 
					   "Custom Tag"
					   ,tt-node
					   $)
		       ; XHTML tag
		       (let ((nm (sxml:ncname tt-node))
			     (content (sxml:content tt-node)))
			 (if (null? content)
			   `(list "<" ,nm ,@(map stx:attr->html 
					   (sxml:attr-list tt-node)) "/>")
			   `(list "<" ,nm ,@(map stx:attr->html 
					   (sxml:attr-list tt-node)) ">"
			     ,@(stx:apply-templates content 
						    bindings root environment)
			     "</" ,nm ">" ))))
		     ))
	      (*text*  ; text string in template 
		 ,sst-string-out)
	      (xsl:apply-templates ; t-node is <xsl:apply-templates/>
		 ,(lambda (t-node bindings root environment) 
		     `(stx:apply-templates
			,(cond 
			   ((sxml:attr t-node 'select)
			    => (lambda (lp)
				 `((sxpath ,lp) current-node current-root)
				 ;`((sxp:xpath+root ,lp) current-node current-root)
				 ))
			   (else '(sxml:content current-node)))
			stx:templates current-root $)))
              (xsl:if
                ,(lambda (t-node bindings root environment)
			       ``(stx:apply-templates
                                 ,(sxml:content ,t-node)
                                 bindings
                                 root
                                 environment)
                             ))
	      (xsl:call-template ; t-node is <xsl:call-template/>
		 ,(lambda (t-node bindings root environment) 
		     `(stx:call-function ,(sxml:attr t-node 'name)
					"Named Template"
					,t-node
					$)))
	      (xsl:value-of  ; t-node is <xsl:value-of/>
		 ,(lambda (t-node bindings root environment) 
		     `(,(if (equal? "yes" 
				      (sxml:attr t-node 'disable-output-escaping))
			   'self
			   doc-string-out)
			(sxml:string 
			   ((sxpath ,(sxml:attr t-node 'select)) 
			   ;((sxp:xpath ,(sxml:attr t-node 'select)) 
			    current-node))))) 
	      ; <xsl:copy-of/>
	      (xsl:copy-of  
		 ,(lambda (t-node bindings root environment) 
		     `((sxpath ,(sxml:attr t-node 'select)) current-node))) 
		     ;`((sxp:xpath ,(sxml:attr t-node 'select)) current-node))) 
	      (stx:eval      ; t-node is <stx:eval/>
		 ,(lambda (t-node bindings root environment)  
		     (let ((content
			     (stx:read-content t-node "<stx:eval>")))
		     `(call-with-err-handler
		       (lambda()
			 (eval ,content))
		       (lambda(mes)
			 (apply stx:error `("Error " ,nl ,mes ,nl 
					    "while evaluating code:" ,nl 
					    ,,content 
					    ,nl "from element" ,nl 
					    ,@(sxml:clean-feed 
						(sxml:sxml->xml
						  ',t-node)))))))))
	      ) c-root 
	    (lambda-tuple) ; compile-time environment
	    )))))) 
stx:call-function
Index
 A helper for stx:xsl->stx 
(define-macro stx:call-function 
  (lambda (name type tpl-node $-env)
  `(let ((fn (,$-env 
	      (string->symbol ,name))))
    (if 
      (eq? fn '*LT-NOT-FOUND*)
      (apply stx:error 
	     (append 
	      (list "Undefined " ,type  " with name " ,name " is called by:" nl)
	       (sxml:clean-feed (sxml:sxml->xml ',tpl-node))
	       (list nl "Valid names: ") (map car (,$-env))
				))
      (call-with-err-handler
	(lambda()
	  (sxml:clean-feed
 	      (fn current-node stx:templates current-root (,$-env '*LT-ADD* 
						      `(stx:param ,',tpl-node)))))
	(lambda (mes)
	  (apply stx:error 
		 (list ,type " evaluation ERROR" 
		   nl mes nl "for:" nl
		   (sxml:clean-feed 
		     (sxml:sxml->xml ',tpl-node))))))))))