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" ...> ;;; <tag name1="val1" name2="val2" ...>
(define (emit-tag out tag . attrs) (define (emit-tag out tag . attrs)
(let ((out (if (eq? out #t) (current-output-port) out))) (let ((out (fmt->port out)))
(display "<" out) (display "<" out)
(display tag out) (display tag out)
(for-each (lambda (attr) (for-each (lambda (attr)
@ -118,11 +118,12 @@
(define (with-tag* out tag thunk . attrs) (define (with-tag* out tag thunk . attrs)
(apply emit-tag out tag attrs) (apply emit-tag out tag attrs)
(call-with-values thunk (let ((out (fmt->port out)))
(lambda results (call-with-values thunk
(newline out) (lambda results
(emit-close-tag out tag) (newline out)
(apply values results)))) (emit-close-tag out tag)
(apply values results)))))
(define (fmt->port x) (define (fmt->port x)
@ -132,9 +133,6 @@
;;; double-quote to their HTML escape sequences. ;;; 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 ;; Note iso8859-1 above 127 is perfectly OK
(define *html-entity-alist* (define *html-entity-alist*
@ -194,4 +192,4 @@
(define (emit-text s . maybe-port) (define (emit-text s . maybe-port)
(if (null? maybe-port) (if (null? maybe-port)
(write-string (escape-html s)) (write-string (escape-html s))
(write-string (escape-html s) (car maybe-port)))) (write-string (escape-html s) (fmt->port (car maybe-port)))))