139 |
} |
} |
140 |
|
|
141 |
|
|
142 |
|
static int |
143 |
|
sf_input_waiting (SCM port) |
144 |
|
{ |
145 |
|
SCM p = SCM_PACK (SCM_STREAM (port)); |
146 |
|
if (SCM_VECTOR_LENGTH (p) >= 6) |
147 |
|
{ |
148 |
|
SCM f = SCM_VELTS (p)[5]; |
149 |
|
if (SCM_NFALSEP (f)) |
150 |
|
return SCM_INUM (scm_call_0 (f)); |
151 |
|
} |
152 |
|
/* Default is such that char-ready? for soft ports returns #t, as it |
153 |
|
did before this extension was implemented. */ |
154 |
|
return 1; |
155 |
|
} |
156 |
|
|
157 |
|
|
158 |
|
|
159 |
SCM_DEFINE (scm_make_soft_port, "make-soft-port", 2, 0, 0, |
SCM_DEFINE (scm_make_soft_port, "make-soft-port", 2, 0, 0, |
160 |
(SCM pv, SCM modes), |
(SCM pv, SCM modes), |
161 |
"Return a port capable of receiving or delivering characters as\n" |
"Return a port capable of receiving or delivering characters as\n" |
162 |
"specified by the @var{modes} string (@pxref{File Ports,\n" |
"specified by the @var{modes} string (@pxref{File Ports,\n" |
163 |
"open-file}). @var{pv} must be a vector of length 5. Its\n" |
"open-file}). @var{pv} must be a vector of length 5 or 6. Its\n" |
164 |
"components are as follows:\n" |
"components are as follows:\n" |
165 |
"\n" |
"\n" |
166 |
"@enumerate 0\n" |
"@enumerate 0\n" |
174 |
"thunk for getting one character\n" |
"thunk for getting one character\n" |
175 |
"@item\n" |
"@item\n" |
176 |
"thunk for closing port (not by garbage collection)\n" |
"thunk for closing port (not by garbage collection)\n" |
177 |
|
"@item\n" |
178 |
|
"(if present and not @code{#f}) thunk for computing the number of\n" |
179 |
|
"characters that can be read from the port without blocking.\n" |
180 |
"@end enumerate\n" |
"@end enumerate\n" |
181 |
"\n" |
"\n" |
182 |
"For an output-only port only elements 0, 1, 2, and 4 need be\n" |
"For an output-only port only elements 0, 1, 2, and 4 need be\n" |
204 |
"@end lisp") |
"@end lisp") |
205 |
#define FUNC_NAME s_scm_make_soft_port |
#define FUNC_NAME s_scm_make_soft_port |
206 |
{ |
{ |
207 |
|
int vlen; |
208 |
scm_t_port *pt; |
scm_t_port *pt; |
209 |
SCM z; |
SCM z; |
210 |
SCM_VALIDATE_VECTOR_LEN (1, pv,5); |
|
211 |
|
SCM_VALIDATE_VECTOR (1, pv); |
212 |
|
vlen = SCM_VECTOR_LENGTH (pv); |
213 |
|
SCM_ASSERT ((vlen == 5) || (vlen == 6), pv, 1, FUNC_NAME); |
214 |
SCM_VALIDATE_STRING (2, modes); |
SCM_VALIDATE_STRING (2, modes); |
215 |
|
|
216 |
SCM_DEFER_INTS; |
SCM_DEFER_INTS; |
234 |
scm_set_port_mark (tc, scm_markstream); |
scm_set_port_mark (tc, scm_markstream); |
235 |
scm_set_port_flush (tc, sf_flush); |
scm_set_port_flush (tc, sf_flush); |
236 |
scm_set_port_close (tc, sf_close); |
scm_set_port_close (tc, sf_close); |
237 |
|
scm_set_port_input_waiting (tc, sf_input_waiting); |
238 |
|
|
239 |
return tc; |
return tc; |
240 |
} |
} |