mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-04-30 11:50:28 +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:
parent
c7c11f3af9
commit
d8067213dc
3 changed files with 35 additions and 3 deletions
|
@ -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)
|
||||
{
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue