; Validation code for SXML-to-HTML.scm ; ; IMPORT ; SXML-to-HTML.scm and all of its imports ; ,open sxml-to-html sxml-tree-trans coutputs assertions with-output-to-string srfi-23 ; ; $Id: vSXML-to-HTML.scm,v 1.3 2004/07/08 19:51:57 oleg Exp oleg $ ; equal-strs? LIST-OF-PRINTABLES STRING ; Check to make sure that the result of writing out LIST-OF-PRINTABLES ; is the same as STRING ; LIST-OF-PRINTABLES can include strings, characters and numbers (define (equal-strs?! strs expected-str) (let ((output-str (with-output-to-string (lambda () (for-each display strs))))) (assert (equal? output-str expected-str)))) (cout nl nl "Testing SXML-to-HTML.scm" nl nl) (letrec ((gen (lambda (test-val) (with-output-to-string (lambda () (SXML->HTML `(p "par1" "par2" ,(and test-val (list "par3" "par4"))))))) )) (write (gen #t)) (newline) (equal-strs?! '(#\newline "
par1par2par3par4
") (gen #t)) (equal-strs?! '(#\newline "par1par2
") (gen #f)) ) (letrec ((gen (lambda (exp) (with-output-to-string (lambda () (SXML->HTML exp)))))) (equal-strs?! '(#\newline "&
") (gen '(p "&"))) ;(write (gen '(p (@ (ALIGN "center")) "bad chars:" "<>&\""))) (equal-strs?! '(#\newline "bad chars:<>&"
") (gen '(p (@ (align "center")) "bad chars:" "<>&\""))) (equal-strs?! '(#\newline "bad chars:" #\newline "<>&"
") (gen '(p (@ (align "center") (atr ""
#\newline "
"
#\newline "
"
#\newline "
"
#\newline "
par1
") (gen '(html:begin "my title" (body (@ (bgcolor "#ffffff")) (p "par1"))))) ) (let () (define (print-slide n max-count) (SXML->HTML `((h2 "Slide number:" ,n) ; Note n is used in its native form ,(and (positive? n) `(a (@ (href "base-url&slide=" ,(- n 1))) "prev")) ,(and (< (+ n 1) max-count) `(a (@ (href "base-url&slide=" ,(+ n 1))) "next")) (p "the text of the slide")))) (equal-strs?! '(#\newline "the text of the slide
") (with-output-to-string (lambda () (print-slide 0 1)))) (equal-strs?! '(#\newline "the text of the slide
") (with-output-to-string (lambda () (print-slide 0 3)))) (equal-strs?! '(#\newline "the text of the slide
") (with-output-to-string (lambda () (print-slide 1 3)))) (equal-strs?! '(#\newline "the text of the slide
") (with-output-to-string (lambda () (print-slide 2 3)))) ) (SXML->HTML `(ul ,@(map (lambda (filename-title) `(li (a (@ (href ,(car filename-title)))) ,(cdr filename-title))) '(("slides/slide0001.gif" . "Introduction") ("slides/slide0010.gif" . "Summary"))) ) ) ; Testing *preorder* and *macro* rules (let () (define (custom-sxml->html tree) (with-output-to-string (lambda () (SRV:send-reply (pre-post-order tree ; Universal transformation rules. Work for every HTML, ; present and future `((@ ((*default* ; local override for attributes . ,(lambda (attr-key . value) (enattr attr-key value)))) . ,(lambda (trigger . value) (cons '@ value))) (*default* . ,(lambda (tag . elems) (entag tag elems))) (*text* . ,(lambda (trigger str) (if (string? str) (string->goodHTML str) str))) (link *macro* . ,(lambda (tag url body) `(a (@ (href ,url)) ,body))) (vspace ; (vspace flag) *preorder* ; where flag is a symbol: small, large . ,(lambda (tag flag) (case flag ((large) (list "
text" #\newline "<body>text1
") (custom-sxml->html '(p "text" (link "url" "") "text1"))) (equal-strs?! '(#\newline "text
text1
text