(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 "<p>par1par2par3par4</p>") (gen #t))
(equal-strs?! '(#\newline "<p>par1par2</p>") (gen #f))
)
(letrec ((gen (lambda (exp)
(with-output-to-string
(lambda ()
(SXML->HTML exp))))))
(equal-strs?! '(#\newline "<p>&</p>") (gen '(p "&")))
(equal-strs?! '(#\newline
"<p align=\"center\">bad chars:<>&"</p>")
(gen '(p (@ (align "center")) "bad chars:" "<>&\"")))
(equal-strs?! '(#\newline
"<p align=\"center\" atr=\"<value>\">bad chars:"
#\newline "<em><>&"</em></p>")
(gen '(p (@ (align "center") (atr "<value>"))
"bad chars:" (em "<>&\""))))
(equal-strs?! '(#\newline
"<p align=\"center\" atr=\""text"\">"
#\newline "<br>"
#\newline "<ul compact>"
#\newline "<li>item 1</li></ul></p>")
(gen '(p (@ (align "center") (atr "\"text\"")) (br)
(ul (@ (compact)) (li "item " 1)))))
(equal-strs?! '(#\newline "<p>"
#\newline "<br>"
#\newline "<ul compact>"
#\newline "<li>item 1</li></ul></p>")
(gen '(p (@) (br) (ul (@ (compact)) (li "item " 1)))))
(equal-strs?! '("Content-type: text/html" #\newline #\newline
"<HTML><HEAD><TITLE>my title</TITLE></HEAD>"
#\newline "<body bgcolor=\"#ffffff\">"
#\newline "<p>par1</p></body></HTML>")
(gen
'(html:begin "my title"
(body (@ (bgcolor "#ffffff")) (p "par1")))))
)
(let ()
(define (print-slide n max-count)
(SXML->HTML
`((h2 "Slide number:" ,n) ,(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 "<h2>Slide number:0</h2>"
#\newline "<p>the text of the slide</p>")
(with-output-to-string (lambda () (print-slide 0 1))))
(equal-strs?! '(#\newline "<h2>Slide number:0</h2>"
#\newline "<a href=\"base-url&slide=1\">next</a>"
#\newline "<p>the text of the slide</p>")
(with-output-to-string (lambda () (print-slide 0 3))))
(equal-strs?! '(#\newline "<h2>Slide number:1</h2>"
#\newline "<a href=\"base-url&slide=0\">prev</a>"
#\newline "<a href=\"base-url&slide=2\">next</a>"
#\newline "<p>the text of the slide</p>")
(with-output-to-string (lambda () (print-slide 1 3))))
(equal-strs?! '(#\newline "<h2>Slide number:2</h2>"
#\newline "<a href=\"base-url&slide=1\">prev</a>"
#\newline "<p>the text of the slide</p>")
(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")))
)
)
(let ()
(define (custom-sxml->html tree)
(with-output-to-string (lambda ()
(SRV:send-reply
(pre-post-order tree
`((@
((*default* . ,(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 *preorder* . ,(lambda (tag flag)
(case flag
((large) (list "<p><br> </p>"))
((small) (list "<br> <br>"))
(else (error "wrong flag:" flag))))))
)))))
(equal-strs?! '(#\newline "<p>text"
#\newline "<a href=\"url\"><body></a>text1</p>")
(custom-sxml->html '(p "text" (link "url" "<body>") "text1")))
(equal-strs?! '(#\newline "<p>text<br> <br>text1</p>")
(custom-sxml->html '(p "text" (vspace small) "text1")))
(equal-strs?! '(#\newline "<p>text<p><br> </p>text1</p>")
(custom-sxml->html '(p "text" (vspace large) "text1")))
)
(cout nl nl "All tests passed" nl)