diff --git a/scheme/lib/htmlout.scm b/scheme/lib/htmlout.scm
index c6472f5..90e4576 100644
--- a/scheme/lib/htmlout.scm
+++ b/scheme/lib/htmlout.scm
@@ -11,6 +11,34 @@
;;; HTML text representation -- surrounding it with single or double quotes,
;;; as appropriate, etc.
+
+;;XHTML 1.0 Strict
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;; a well-formed XML document begins with a prolog;
+;; this is the prolog for an XHTML 1.0 strict document:
+
+(define XMLdecl
+ "")
+
+(define doctypedecl
+ "")
+
+(define (emit-prolog out)
+ (display XMLdecl out)
+ (newline out)
+ (display doctypedecl out)
+ (newline out))
+
+;; the root element html must contain an xmlns declaration for the
+;; XHTML namespace, which ist defined to be
+;; http://www.w3.org/1999/xhtml
+
+(define xmlnsval "http://www.w3.org/1999/xhtml")
+
+;; for use with emit-tag and with-tag:
+(define xmlnsdecl-attr (cons 'xmlns xmlnsval))
+
;;; Printing HTML tags.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; All the emit-foo procedures have the same basic calling conventions:
@@ -49,7 +77,7 @@
(format out "" tag))
-;;;
+;;;
(define (emit-p . args) ; (emit-p [out attr1 ...])
(receive (out attrs) (if (pair? args)
@@ -61,13 +89,13 @@
(apply emit-tag out 'p attrs)))
-;;;
Make Money Fast!!!
+;;; Make Money Fast!!!
(define (emit-title out title) ; Takes no attributes.
- (format out "~a~%~%" title))
+ (format out "~a~%" title))
(define (emit-header out level text . attribs)
- (apply with-tag* out (string-append "H" (number->string level))
+ (apply with-tag* out (string-append "h" (number->string level))
(lambda () (display text (fmt->port out)))
attribs))
@@ -90,11 +118,11 @@
;;; instead of (NAME VALUE).
;;;
;;; For example,
-;;; (let ((hp "http://clark.lcs.mit.edu/~shivers")) ; My home page.
-;;; (with-tag port A ((href hp-url) (name "hp"))
+;;; (let ((hp-url "http://clark.lcs.mit.edu/~shivers")) ; My home page.
+;;; (with-tag port a ((href hp-url) (name "hp"))
;;; (display "home page" port)))
;;; outputs
-;;; home page
+;;; home page
(define-syntax with-tag
(syntax-rules ()
@@ -107,9 +135,11 @@
;;; Why can't this be a LET-SYNTAX inside of WITH-TAG?
(define-syntax %hack-attr-elt
- (syntax-rules () ; Build attribute-list element:
+ (syntax-rules (xmlnsdecl-attr) ; Build attribute-list element:
((%hack-attr-elt (name val)) ; (name elt) => (cons 'name elt)
(cons 'name val))
+ ((%hack-attr-elt xmlnsdecl-attr)
+ xmlnsdecl-attr)
((%hack-attr-elt name) 'name))) ; name => 'name
@@ -118,8 +148,10 @@
(define (with-tag* out tag thunk . attrs)
(apply emit-tag out tag attrs)
(let ((out (fmt->port out)))
+ (newline out)
(call-with-values thunk
(lambda results
+ (newline out)
(emit-close-tag out tag)
(apply values results)))))
@@ -191,3 +223,4 @@
(if (null? maybe-port)
(write-string (escape-html s))
(write-string (escape-html s) (fmt->port (car maybe-port)))))
+