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:
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
|
#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)
|
||||||
{
|
{
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue