diff options
author | Andy Wingo <wingo@pobox.com> | 2016-06-01 23:48:08 +0200 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2016-06-09 10:59:02 +0200 |
commit | d8067213dc3728a37c3c60d15aa0f1113d2e8daa (patch) | |
tree | 7bbafa1767494c901eb482c91d41588b9cdbf35b /module | |
parent | c7c11f3af9774a07d885dad1eb0c653ab4b45ef7 (diff) | |
download | guile-d8067213dc3728a37c3c60d15aa0f1113d2e8daa.tar.gz |
put-char in Scheme
* libguile/ports.c (scm_port_encode_char): New function.
* module/ice-9/ports.scm (port-encode-char): Export port-encode-char to
the internals module.
* module/ice-9/sports.scm (put-char): New function.
(port-bindings): Add put-char and put-string.
Diffstat (limited to 'module')
-rw-r--r-- | module/ice-9/ports.scm | 2 | ||||
-rw-r--r-- | module/ice-9/suspendable-ports.scm | 17 |
2 files changed, 16 insertions, 3 deletions
diff --git a/module/ice-9/ports.scm b/module/ice-9/ports.scm index 43a029b49..8eee22988 100644 --- a/module/ice-9/ports.scm +++ b/module/ice-9/ports.scm @@ -187,6 +187,7 @@ interpret its input and output." specialize-port-encoding! port-random-access? port-decode-char + port-encode-char port-encode-chars port-read-buffering port-poll @@ -235,6 +236,7 @@ interpret its input and output." %port-encoding specialize-port-encoding! port-decode-char + port-encode-char port-encode-chars port-random-access? port-read-buffering diff --git a/module/ice-9/suspendable-ports.scm b/module/ice-9/suspendable-ports.scm index d4468be09..6d3d40510 100644 --- a/module/ice-9/suspendable-ports.scm +++ b/module/ice-9/suspendable-ports.scm @@ -660,15 +660,26 @@ (port-line-buffered? port)) (flush-output port)))) +(define* (put-char port char) + (let ((aux (port-auxiliary-write-buffer port))) + (set-port-buffer-cur! aux 0) + (port-clear-stream-start-for-bom-write port aux) + (port-encode-char port aux char) + (let ((end (port-buffer-end aux))) + (set-port-buffer-end! aux 0) + (put-bytevector port (port-buffer-bytevector aux) 0 end)) + (when (and (eqv? char #\newline) (port-line-buffered? port)) + (flush-output port)))) + (define saved-port-bindings #f) (define port-bindings - '(((guile) read-char peek-char force-output close-port) + '(((guile) + read-char peek-char force-output close-port) ((ice-9 binary-ports) get-u8 lookahead-u8 get-bytevector-n put-u8 put-bytevector) ((ice-9 textual-ports) - ;; FIXME: put-char - put-string) + put-char put-string) ((ice-9 rdelim) %read-line read-line read-delimited))) (define (install-suspendable-ports!) (unless saved-port-bindings |