Work correctly if port specification is #t (for (CURRENT-OUTPUT-PORT)).
This commit is contained in:
parent
5d19ffbb31
commit
0cbe13d177
10
htmlout.scm
10
htmlout.scm
|
@ -26,7 +26,7 @@
|
|||
;;; <tag name1="val1" name2="val2" ...>
|
||||
|
||||
(define (emit-tag out tag . attrs)
|
||||
(let ((out (if (eq? out #t) (current-output-port) out)))
|
||||
(let ((out (fmt->port out)))
|
||||
(display "<" out)
|
||||
(display tag out)
|
||||
(for-each (lambda (attr)
|
||||
|
@ -118,11 +118,12 @@
|
|||
|
||||
(define (with-tag* out tag thunk . attrs)
|
||||
(apply emit-tag out tag attrs)
|
||||
(let ((out (fmt->port out)))
|
||||
(call-with-values thunk
|
||||
(lambda results
|
||||
(newline out)
|
||||
(emit-close-tag out tag)
|
||||
(apply values results))))
|
||||
(apply values results)))))
|
||||
|
||||
|
||||
(define (fmt->port x)
|
||||
|
@ -132,9 +133,6 @@
|
|||
;;; double-quote to their HTML escape sequences.
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
;; Mike Sperber <sperber@informatik.uni-tuebingen.de>
|
||||
;; This is fairly simple-minded
|
||||
|
||||
;; Note iso8859-1 above 127 is perfectly OK
|
||||
|
||||
(define *html-entity-alist*
|
||||
|
@ -194,4 +192,4 @@
|
|||
(define (emit-text s . maybe-port)
|
||||
(if (null? maybe-port)
|
||||
(write-string (escape-html s))
|
||||
(write-string (escape-html s) (car maybe-port))))
|
||||
(write-string (escape-html s) (fmt->port (car maybe-port)))))
|
||||
|
|
Loading…
Reference in New Issue