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
This commit is contained in:
parent
e8dc69b745
commit
4c1e1a16a8
|
@ -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")
|
||||
|
|
|
@ -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
|
||||
|
||||
|
|
|
@ -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>
|
||||
|
||||
|
|
|
@ -15,6 +15,7 @@
|
|||
|
||||
(define-interface htmlout-interface
|
||||
(export emit-tag
|
||||
emit-empty-tag
|
||||
emit-close-tag
|
||||
|
||||
emit-p
|
||||
|
|
Loading…
Reference in New Issue