trivia: towards a more modern HTML: closing slash within empty HTML

elements
*new: EMIT-EMPTY-TAG
*use EMIT-EMPTY-TAG instead of EMIT-TAG where appropriate

scheme/httpd/file-dir-handler.scm

@@ -368,7 +368,7 @@
 	      ((directory) "[DIR ]")
 	      (else "[????]"))))
       (if icon-name
-	  (emit-tag port 'img
+	  (emit-empty-tag port 'img
 		    (cons 'src icon-name)
 		    (cons 'alt tag-name))
 	  (display tag-name port))
@@ -433,16 +433,16 @@
 		      (with-tag port pre ()
 			(if blank-icon
 			    (display "[    ]" port)
-			    (emit-tag port 'img
+			    (emit-empty-tag port 'img
 				      (cons 'src blank-icon)
 				      (cons 'alt "      ")))
 			(write-string "Name                 " port)
 			(write-string "Last modified          " port)
 			(write-string "Size   " port)
 			(write-string "Description" port)
-			(emit-tag port 'hr)
+			(emit-empty-tag port 'hr)
 			(if back-icon
-			    (emit-tag port 'img
+			    (emit-empty-tag port 'img
 				      (cons 'src back-icon)
 				      (cons 'alt "[UP  ]"))
 			    (display "[UP  ]" port))
@@ -452,7 +452,7 @@
 				(write-string "Parent directory" port))
 			      (write-crlf port)))
 			(let ((n-files (directory-index req fname port options)))
-			  (emit-tag port 'hr)
+			  (emit-empty-tag port 'hr)
 			  (format port "~d files" n-files))))))))))))
 	 
 	 ((string=? request-method "POST")

scheme/httpd/info-gateway.scm

@@ -234,7 +234,7 @@
       (string-append "(" file ")" node))))
 
 (define (display-icon file alt out)
-  (emit-tag out 'img
+  (emit-empty-tag out 'img
     (cons 'src file)
     (cons 'alt alt)
     (cons 'align "bottom")))
@@ -282,18 +282,18 @@
   (emit-title out (string-append "Info Node: "
 				(unparse-node-name file node)))
   (with-tag out h1 ()
-	    (emit-tag out 'img
+	    (emit-empty-tag out 'img
 		      (cons 'src (icon-name 'info))
 		      (cons 'alt "Info Node")
 		      (cons 'align 'bottom))
 	    (write-string (unparse-node-name file node) out))
-  (emit-tag out 'hr)
+  (emit-empty-tag out 'hr)
   (maybe-display-header next (icon-name 'next) "[Next]")
   (maybe-display-header previous (icon-name 'previous) "[Previous]")
   (maybe-display-header up (icon-name 'up) "[Up]")
 	 
   (if (or next previous up)
-      (emit-tag out 'hr)))
+      (emit-empty-tag out 'hr)))
 
 ;; Text
 

scheme/lib/htmlout.scm

@@ -70,6 +70,26 @@
 	      attrs)
     (display #\> out)))
 
+;;; Empty elements, e.g. <hr />
+
+(define (emit-empty-tag out tag . attrs)
+  (let ((out (fmt->port out)))
+    (display "<" out)
+    (display tag out)
+    (for-each (lambda (attr)
+		(display #\space out)
+		(cond ((pair? attr)			; name="val"
+		       (display (car attr) out)
+		       (display "=\"" out)		; Should check for
+		       (display (cdr attr) out)		; internal double-quote
+		       (display #\" out))		; etc.
+		      (else
+		       (display attr out))))		; name
+	      attrs)
+    (display " /" out)
+    (display #\> out)))
+
+
 
 ;;; </tag>
 

scheme/packages.scm

@@ -15,6 +15,7 @@
 
 (define-interface htmlout-interface
   (export emit-tag
+	  emit-empty-tag
 	  emit-close-tag
 
 	  emit-p