diff --git a/libguile/ports.c b/libguile/ports.c index a464aaf56..2694dcf5f 100644 --- a/libguile/ports.c +++ b/libguile/ports.c @@ -3238,6 +3238,25 @@ SCM_DEFINE (scm_port_encode_chars, "port-encode-chars", 5, 0, 0, } #undef FUNC_NAME +SCM scm_port_encode_char (SCM, SCM, SCM); +SCM_DEFINE (scm_port_encode_char, "port-encode-char", 3, 0, 0, + (SCM port, SCM buf, SCM ch), + "") +#define FUNC_NAME s_scm_port_encode_char +{ + scm_t_uint32 codepoint; + + SCM_VALIDATE_OPOUTPORT (1, port); + SCM_VALIDATE_VECTOR (2, buf); + SCM_VALIDATE_CHAR (3, ch); + + codepoint = SCM_CHAR (ch); + encode_utf32_chars (port, buf, &codepoint, 1); + + return SCM_UNSPECIFIED; +} +#undef FUNC_NAME + void scm_c_put_latin1_chars (SCM port, const scm_t_uint8 *chars, size_t len) { 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