diff --git a/scheme/httpd/file-dir-handler.scm b/scheme/httpd/file-dir-handler.scm index 3fd11ea..796e25b 100644 --- a/scheme/httpd/file-dir-handler.scm +++ b/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") diff --git a/scheme/httpd/info-gateway.scm b/scheme/httpd/info-gateway.scm index 278dd00..aa629d7 100644 --- a/scheme/httpd/info-gateway.scm +++ b/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 diff --git a/scheme/lib/htmlout.scm b/scheme/lib/htmlout.scm index 18e6d64..e6b8f1b 100644 --- a/scheme/lib/htmlout.scm +++ b/scheme/lib/htmlout.scm @@ -70,6 +70,26 @@ attrs) (display #\> out))) +;;; Empty elements, e.g.
+ +(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))) + + ;;; diff --git a/scheme/packages.scm b/scheme/packages.scm index 3d53e80..92ba8ba 100644 --- a/scheme/packages.scm +++ b/scheme/packages.scm @@ -15,6 +15,7 @@ (define-interface htmlout-interface (export emit-tag + emit-empty-tag emit-close-tag emit-p