1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-30 03:40:34 +02:00

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.
This commit is contained in:
Andy Wingo 2016-06-01 23:48:08 +02:00
parent c7c11f3af9
commit d8067213dc
3 changed files with 35 additions and 3 deletions

View file

@ -3238,6 +3238,25 @@ SCM_DEFINE (scm_port_encode_chars, "port-encode-chars", 5, 0, 0,
} }
#undef FUNC_NAME #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 void
scm_c_put_latin1_chars (SCM port, const scm_t_uint8 *chars, size_t len) scm_c_put_latin1_chars (SCM port, const scm_t_uint8 *chars, size_t len)
{ {

View file

@ -187,6 +187,7 @@ interpret its input and output."
specialize-port-encoding! specialize-port-encoding!
port-random-access? port-random-access?
port-decode-char port-decode-char
port-encode-char
port-encode-chars port-encode-chars
port-read-buffering port-read-buffering
port-poll port-poll
@ -235,6 +236,7 @@ interpret its input and output."
%port-encoding %port-encoding
specialize-port-encoding! specialize-port-encoding!
port-decode-char port-decode-char
port-encode-char
port-encode-chars port-encode-chars
port-random-access? port-random-access?
port-read-buffering port-read-buffering

View file

@ -660,15 +660,26 @@
(port-line-buffered? port)) (port-line-buffered? port))
(flush-output 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 saved-port-bindings #f)
(define port-bindings (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) ((ice-9 binary-ports)
get-u8 lookahead-u8 get-bytevector-n get-u8 lookahead-u8 get-bytevector-n
put-u8 put-bytevector) put-u8 put-bytevector)
((ice-9 textual-ports) ((ice-9 textual-ports)
;; FIXME: put-char put-char put-string)
put-string)
((ice-9 rdelim) %read-line read-line read-delimited))) ((ice-9 rdelim) %read-line read-line read-delimited)))
(define (install-suspendable-ports!) (define (install-suspendable-ports!)
(unless saved-port-bindings (unless saved-port-bindings