my title

; 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/07 16:02:31 sperber Exp $ ; 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 "")) "bad chars:" (em "<>&\"")))) (equal-strs?! '(#\newline "

" #\newline "
" #\newline "

item 1

") (gen '(p (@ (align "center") (atr "\"text\"")) (br) (ul (@ (compact)) (li "item " 1))))) (equal-strs?! '(#\newline "

" #\newline "
" #\newline "

item 1

") (gen '(p (@) (br) (ul (@ (compact)) (li "item " 1))))) (equal-strs?! '("Content-type: text/html" #\newline #\newline "my title" #\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 "

Slide number:0

" #\newline "

the text of the slide

") (with-output-to-string (lambda () (print-slide 0 1)))) (equal-strs?! '(#\newline "

Slide number:0

" #\newline "next" #\newline "

the text of the slide

") (with-output-to-string (lambda () (print-slide 0 3)))) (equal-strs?! '(#\newline "

Slide number:1

" #\newline "prev" #\newline "next" #\newline "

the text of the slide

") (with-output-to-string (lambda () (print-slide 1 3)))) (equal-strs?! '(#\newline "

Slide number:2

" #\newline "prev" #\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 "

")) ((small) (list "

")) (else (error "wrong flag:" flag)))))) ))))) (equal-strs?! '(#\newline "

text" #\newline "<body>text1

") (custom-sxml->html '(p "text" (link "url" "") "text1"))) (equal-strs?! '(#\newline "

text

text1

") (custom-sxml->html '(p "text" (vspace small) "text1"))) (equal-strs?! '(#\newline "

text

text1

") (custom-sxml->html '(p "text" (vspace large) "text1"))) ) (cout nl nl "All tests passed" nl)