scsh-conservatory
/
sunet
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Work correctly if port specification is #t (for (CURRENT-OUTPUT-PORT)).

This commit is contained in:
sperber 2002-02-21 14:03:18 +00:00
parent 5d19ffbb31
commit 0cbe13d177
1 changed files with 8 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
htmlout.scm
View File

@ -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)
(call-with-values thunk
(lambda results
(newline out)
(emit-close-tag out tag)
(apply values results))))
(let ((out (fmt->port out)))
(call-with-values thunk
(lambda results
(newline out)
(emit-close-tag out tag)
(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)))))