#! /bin/sh 
string=? ; exec mzscheme -M errortrace -gr $0 $* 
; $Id: make-examples.scm,v 1.2 2004/01/27 04:31:55 kl Exp kl $
; A stylesheet for creating HTML index and a set of Scheme examples
; http://pair.com/lisovsky/query/examples/
; 
; May be considered as an example of STX stylesheet applyed for side effects 
;   _and_ XML->HTML transformation
;
; Usage: ./make-examples.scm >xpath-examples/index.html

(require (lib "sxml-tools.ss" "sxml")
	 (lib "sxpath.ss" "sxml")
	 (lib "stx-engine.ss" "sxml")
         (lib "fragments.ss" "sxml")
	 (lib "sxpathlib.ss" "sxml")
	 (lib "libmisc.ss" "sxml")
	 (lib "parse-error.ss" "ssax")
	 (lib "myenv.ss" "ssax"))

(define (read-eval-file file-name)
  (eval
    (read-syntax
      file-name
      (port-count-lines
	(open-input-file file-name)))))

; Source document
(define doc (read-eval-file "xpaths.sxml"))

(define (list-or-node x)
  (if (eq? 'list (car x))
    (cdr x)
    x))

; Transformation stylesheet
(define sst
(sxml:stylesheet
  (match  'case 
	 (lambda (current-node stx:templates current-root $)
	   (let ((filename (string-append (sxml:attr current-node 'id) 
					  ".txt"))
		 (abbr  (sxml:attr current-node 'abbreviated)))
	     ; Write a file of example code as a side effect
	   (with-output-to-file 
	     (string-append "xpath-examples/" filename)
	     (lambda()
	       (cout (comment-out ((car-sxpath '(descr *text*)) current-node) "; ") 
		     ";" nl
		     "; Abbreviated XPath: " (if abbr abbr "NONE") nl
		     "; Full XPath: " (sxml:attr current-node 'full) nl)
	       (cout nl "(define tree " nl "'") 
	       (pp (list-or-node ((car-sxpath '((* 1))) current-node)))
	       (cout " )" nl)
	       (for-each
		 (lambda(t)
		   (if (sxml:attr t 'sxpath)
		     (cout nl "; SXPath:" nl "((sxpath `" (sxml:text t) ")")
		     (cout nl "; Low-level:" nl "(" (sxml:text t)))
		   (cout nl " tree)" nl))
		 ((sxpath '(test)) current-node))
	       (cout nl "==>" nl)
	       (pp (list-or-node ((car-sxpath '((* 2))) current-node)))
	       ) 'replace)
	   ; Return a row for HTML table
           `(tr
	      (td
		(a (@ (href ,filename))
		(b ,(cond 
			(abbr)
			 (else (sxml:attr current-node 'full))))))
	      (td ,((car-sxpath '(descr *text*)) current-node))))
))
  (match 'samples
	 (lambda (current-node stx:templates current-root $)
	   ; HTML header
	   `(html (body (table (@ (border "1"))
			       (tr (@ (align "center")) 
				   (td (i "XPath")) (td (i "Description")))
                 ,@(xsl:apply-templates))))
))
  )
)

; Output HTML 
(sxml:display-fragments
(sxml:sxml->html
  (stx:apply-templates
  doc
  sst
  doc
  '())))

(exit)