summaryrefslogtreecommitdiff
path: root/module
diff options
context:
space:
mode:
authorAndy Wingo <wingo@pobox.com>2016-06-01 23:48:08 +0200
committerAndy Wingo <wingo@pobox.com>2016-06-09 10:59:02 +0200
commitd8067213dc3728a37c3c60d15aa0f1113d2e8daa (patch)
tree7bbafa1767494c901eb482c91d41588b9cdbf35b /module
parentc7c11f3af9774a07d885dad1eb0c653ab4b45ef7 (diff)
downloadguile-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.scm2
-rw-r--r--module/ice-9/suspendable-ports.scm17
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