Commit | Line | Data |
---|---|---|
0f2d19dd JB |
1 | /* Copyright (C) 1995,1996 Free Software Foundation, Inc. |
2 | * | |
3 | * This program is free software; you can redistribute it and/or modify | |
4 | * it under the terms of the GNU General Public License as published by | |
5 | * the Free Software Foundation; either version 2, or (at your option) | |
6 | * any later version. | |
7 | * | |
8 | * This program is distributed in the hope that it will be useful, | |
9 | * but WITHOUT ANY WARRANTY; without even the implied warranty of | |
10 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
11 | * GNU General Public License for more details. | |
12 | * | |
13 | * You should have received a copy of the GNU General Public License | |
14 | * along with this software; see the file COPYING. If not, write to | |
82892bed JB |
15 | * the Free Software Foundation, Inc., 59 Temple Place, Suite 330, |
16 | * Boston, MA 02111-1307 USA | |
0f2d19dd JB |
17 | * |
18 | * As a special exception, the Free Software Foundation gives permission | |
19 | * for additional uses of the text contained in its release of GUILE. | |
20 | * | |
21 | * The exception is that, if you link the GUILE library with other files | |
22 | * to produce an executable, this does not by itself cause the | |
23 | * resulting executable to be covered by the GNU General Public License. | |
24 | * Your use of that executable is in no way restricted on account of | |
25 | * linking the GUILE library code into it. | |
26 | * | |
27 | * This exception does not however invalidate any other reasons why | |
28 | * the executable file might be covered by the GNU General Public License. | |
29 | * | |
30 | * This exception applies only to the code released by the | |
31 | * Free Software Foundation under the name GUILE. If you copy | |
32 | * code from other Free Software Foundation releases into a copy of | |
33 | * GUILE, as the General Public License permits, the exception does | |
34 | * not apply to the code that you add in this way. To avoid misleading | |
35 | * anyone as to the status of such modified files, you must delete | |
36 | * this exception notice from them. | |
37 | * | |
38 | * If you write modifications of your own for GUILE, it is your choice | |
39 | * whether to permit this exception to apply to your modifications. | |
82892bed | 40 | * If you do not wish that, delete this exception notice. */ |
0f2d19dd JB |
41 | \f |
42 | #include "extchrs.h" | |
43 | #include <stdio.h> | |
44 | #include "_scm.h" | |
20e6290e JB |
45 | #include "chars.h" |
46 | ||
47 | #include "genio.h" | |
0f2d19dd | 48 | |
95b88819 GH |
49 | #ifdef HAVE_STRING_H |
50 | #include <string.h> | |
51 | #endif | |
0f2d19dd JB |
52 | \f |
53 | ||
54 | ||
1717856b JB |
55 | |
56 | static void scm_putc SCM_P ((int c, SCM port)); | |
57 | ||
0f2d19dd JB |
58 | static void |
59 | scm_putc (c, port) | |
60 | int c; | |
61 | SCM port; | |
0f2d19dd JB |
62 | { |
63 | scm_sizet i = SCM_PTOBNUM (port); | |
64 | SCM_SYSCALL ((scm_ptobs[i].fputc) (c, SCM_STREAM (port))); | |
65 | } | |
66 | ||
67 | ||
1717856b JB |
68 | |
69 | static void scm_puts SCM_P ((char *s, SCM port)); | |
70 | ||
0f2d19dd JB |
71 | static void |
72 | scm_puts (s, port) | |
73 | char *s; | |
74 | SCM port; | |
0f2d19dd JB |
75 | { |
76 | scm_sizet i = SCM_PTOBNUM (port); | |
77 | SCM_SYSCALL ((scm_ptobs[i].fputs) (s, SCM_STREAM (port))); | |
78 | #ifdef TRANSCRIPT_SUPPORT | |
79 | if (scm_trans && (port == def_outp || port == cur_errp)) | |
80 | SCM_SYSCALL (fputs (s, scm_trans)); | |
81 | #endif | |
82 | } | |
83 | ||
84 | ||
1717856b JB |
85 | |
86 | static int scm_lfwrite SCM_P ((char *ptr, scm_sizet size, scm_sizet nitems, SCM port)); | |
87 | ||
0f2d19dd JB |
88 | static int |
89 | scm_lfwrite (ptr, size, nitems, port) | |
90 | char *ptr; | |
91 | scm_sizet size; | |
92 | scm_sizet nitems; | |
93 | SCM port; | |
0f2d19dd JB |
94 | { |
95 | int ret; | |
96 | scm_sizet i = SCM_PTOBNUM (port); | |
97 | SCM_SYSCALL (ret = (scm_ptobs[i].fwrite(ptr, size, nitems, SCM_STREAM (port)))); | |
98 | #ifdef TRANSCRIPT_SUPPORT | |
99 | if (scm_trans && (port == def_outp || port == cur_errp)) | |
100 | SCM_SYSCALL (fwrite (ptr, size, nitems, scm_trans)); | |
101 | #endif | |
102 | return ret; | |
103 | } | |
104 | ||
105 | ||
106 | \f | |
107 | ||
1717856b | 108 | |
0f2d19dd JB |
109 | void |
110 | scm_gen_putc (c, port) | |
111 | int c; | |
112 | SCM port; | |
0f2d19dd JB |
113 | { |
114 | switch (SCM_PORT_REPRESENTATION (port)) | |
115 | { | |
116 | case scm_regular_port: | |
117 | { | |
118 | /* Nothing good to do with extended chars here... | |
119 | * just truncate them. | |
120 | */ | |
121 | scm_putc ((unsigned char)c, port); | |
122 | break; | |
123 | } | |
124 | ||
125 | case scm_mb_port: | |
126 | { | |
127 | char buf[256]; | |
128 | int len; | |
129 | ||
130 | SCM_ASSERT (XMB_CUR_MAX < sizeof (buf), SCM_MAKICHR (c), | |
131 | "huge translation", "scm_gen_putc"); | |
132 | ||
133 | len = xwctomb (buf, c); | |
134 | ||
135 | SCM_ASSERT ((len >= 0), SCM_MAKICHR (c), "bogus character", "scm_gen_putc"); | |
136 | ||
137 | if (len == 0) | |
138 | scm_putc (0, port); | |
139 | else | |
140 | { | |
141 | int x; | |
142 | for (x = 0; x < len; ++x) | |
143 | scm_putc (buf[x], port); | |
144 | } | |
145 | break; | |
146 | } | |
147 | ||
148 | case scm_wchar_port: | |
149 | { | |
150 | scm_putc (((unsigned char)(c >> 8) & 0xff), port); | |
151 | scm_putc ((unsigned char)(c & 0xff), port); | |
152 | break; | |
153 | } | |
154 | } | |
155 | } | |
156 | ||
157 | ||
158 | \f | |
159 | ||
160 | ||
1717856b | 161 | |
0f2d19dd JB |
162 | void |
163 | scm_gen_puts (rep, str_data, port) | |
164 | enum scm_string_representation_type rep; | |
1717856b | 165 | char *str_data; |
0f2d19dd | 166 | SCM port; |
0f2d19dd JB |
167 | { |
168 | switch (rep) | |
169 | { | |
170 | ||
171 | case scm_regular_string: | |
172 | switch (SCM_PORT_REPRESENTATION (port)) | |
173 | { | |
174 | case scm_regular_port: | |
175 | case scm_mb_port: | |
176 | scm_puts (str_data, port); | |
177 | return; | |
178 | case scm_wchar_port: | |
179 | { | |
180 | while (*str_data) | |
181 | { | |
182 | scm_putc (0, port); | |
183 | scm_putc (*str_data, port); | |
184 | ++str_data; | |
185 | } | |
186 | return; | |
187 | } | |
188 | } | |
189 | ||
190 | case scm_mb_string: | |
191 | switch (SCM_PORT_REPRESENTATION (port)) | |
192 | { | |
193 | case scm_regular_port: | |
194 | case scm_mb_port: | |
195 | scm_puts (str_data, port); | |
196 | return; | |
197 | case scm_wchar_port: | |
198 | { | |
199 | xwchar_t output; | |
200 | int len; | |
201 | int size; | |
202 | ||
203 | size = strlen (str_data); | |
204 | while (size) | |
205 | { | |
206 | len = xmbtowc (&output, str_data, size); | |
cdbadcac JB |
207 | SCM_ASSERT ((len > 0), SCM_MAKINUM (*str_data), |
208 | "bogus character", "scm_gen_puts"); | |
0f2d19dd JB |
209 | scm_putc ((output >> 8) & 0xff, port); |
210 | scm_putc (output & 0xff, port); | |
211 | size -= len; | |
212 | str_data += len; | |
213 | } | |
214 | return; | |
215 | } | |
216 | } | |
217 | ||
218 | case scm_wchar_string: | |
219 | { | |
220 | xwchar_t * wstr_data; | |
221 | ||
47ce0f92 | 222 | wstr_data = (xwchar_t *) str_data; |
0f2d19dd JB |
223 | switch (SCM_PORT_REPRESENTATION (port)) |
224 | { | |
225 | case scm_regular_port: | |
226 | while (*wstr_data) | |
227 | { | |
228 | scm_putc ((unsigned char) *wstr_data, port); | |
229 | ++wstr_data; | |
230 | } | |
231 | return; | |
232 | ||
233 | case scm_mb_port: | |
234 | { | |
235 | char buf[256]; | |
236 | SCM_ASSERT (XMB_CUR_MAX < sizeof (buf), SCM_BOOL_F, | |
237 | "huge translation", "scm_gen_puts"); | |
238 | ||
239 | while (*wstr_data) | |
240 | { | |
241 | int len; | |
242 | ||
243 | len = xwctomb (buf, *wstr_data); | |
244 | ||
245 | SCM_ASSERT ((len > 0), SCM_MAKINUM (*wstr_data), "bogus character", "scm_gen_puts"); | |
246 | ||
247 | { | |
248 | int x; | |
249 | for (x = 0; x < len; ++x) | |
250 | scm_putc (buf[x], port); | |
251 | } | |
252 | ++wstr_data; | |
253 | } | |
254 | return; | |
255 | } | |
256 | ||
257 | case scm_wchar_port: | |
258 | { | |
259 | int len; | |
260 | for (len = 0; wstr_data[len]; ++len) | |
261 | ; | |
262 | scm_lfwrite (str_data, sizeof (xwchar_t), len, port); | |
263 | return; | |
264 | } | |
265 | } | |
266 | } | |
267 | } | |
268 | } | |
269 | ||
270 | ||
271 | \f | |
272 | ||
1717856b | 273 | |
0f2d19dd JB |
274 | void |
275 | scm_gen_write (rep, str_data, nitems, port) | |
276 | enum scm_string_representation_type rep; | |
277 | char *str_data; | |
278 | scm_sizet nitems; | |
279 | SCM port; | |
0f2d19dd JB |
280 | { |
281 | /* is nitems bytes or characters in the mb_string case? */ | |
282 | ||
283 | switch (rep) | |
284 | { | |
285 | case scm_regular_string: | |
286 | switch (SCM_PORT_REPRESENTATION (port)) | |
287 | { | |
288 | case scm_regular_port: | |
289 | case scm_mb_port: | |
290 | scm_lfwrite (str_data, 1, nitems, port); | |
291 | return; | |
292 | case scm_wchar_port: | |
293 | { | |
294 | while (nitems) | |
295 | { | |
296 | scm_putc (0, port); | |
297 | scm_putc (*str_data, port); | |
298 | ++str_data; | |
299 | --nitems; | |
300 | } | |
301 | return; | |
302 | } | |
303 | } | |
304 | ||
305 | case scm_mb_string: | |
306 | switch (SCM_PORT_REPRESENTATION (port)) | |
307 | { | |
308 | case scm_regular_port: | |
309 | case scm_mb_port: | |
310 | scm_lfwrite (str_data, 1, nitems, port); | |
311 | return; | |
312 | ||
313 | case scm_wchar_port: | |
314 | { | |
315 | xwchar_t output; | |
316 | int len; | |
317 | ||
318 | while (nitems) | |
319 | { | |
320 | len = xmbtowc (&output, str_data, nitems); | |
321 | SCM_ASSERT ((len > 0), SCM_MAKINUM (*str_data), "bogus character", "scm_gen_puts"); | |
322 | scm_putc ((output >> 8) & 0xff, port); | |
323 | scm_putc (output & 0xff, port); | |
324 | nitems -= len; | |
325 | str_data += len; | |
326 | } | |
327 | return; | |
328 | } | |
329 | } | |
330 | ||
331 | case scm_wchar_string: | |
332 | { | |
333 | xwchar_t * wstr_data; | |
334 | ||
47ce0f92 | 335 | wstr_data = (xwchar_t *) str_data; |
0f2d19dd JB |
336 | switch (SCM_PORT_REPRESENTATION (port)) |
337 | { | |
338 | case scm_regular_port: | |
339 | while (nitems) | |
340 | { | |
341 | scm_putc ((unsigned char) *wstr_data, port); | |
342 | ++wstr_data; | |
343 | --nitems; | |
344 | } | |
345 | return; | |
346 | ||
347 | case scm_mb_port: | |
348 | { | |
349 | char buf[256]; | |
350 | SCM_ASSERT (XMB_CUR_MAX < sizeof (buf), SCM_BOOL_F, | |
351 | "huge translation", "scm_gen_puts"); | |
352 | ||
353 | while (nitems) | |
354 | { | |
355 | int len; | |
356 | ||
357 | len = xwctomb (buf, *wstr_data); | |
358 | ||
359 | SCM_ASSERT ((len > 0), SCM_MAKINUM (*wstr_data), "bogus character", "scm_gen_puts"); | |
360 | ||
361 | { | |
362 | int x; | |
363 | for (x = 0; x < len; ++x) | |
364 | scm_putc (buf[x], port); | |
365 | } | |
366 | ++wstr_data; | |
367 | --nitems; | |
368 | } | |
369 | return; | |
370 | } | |
371 | ||
372 | case scm_wchar_port: | |
373 | { | |
374 | scm_lfwrite (str_data, sizeof (xwchar_t), nitems, port); | |
375 | return; | |
376 | } | |
377 | } | |
378 | } | |
379 | } | |
380 | } | |
381 | ||
382 | \f | |
383 | ||
384 | ||
1717856b JB |
385 | |
386 | static int scm_getc SCM_P ((SCM port)); | |
387 | ||
0f2d19dd JB |
388 | static int |
389 | scm_getc (port) | |
390 | SCM port; | |
0f2d19dd | 391 | { |
1717856b | 392 | SCM f; |
0f2d19dd JB |
393 | int c; |
394 | scm_sizet i; | |
395 | ||
1717856b | 396 | f = SCM_STREAM (port); |
0f2d19dd JB |
397 | i = SCM_PTOBNUM (port); |
398 | SCM_SYSCALL (c = (scm_ptobs[i].fgetc) (f)); | |
399 | return c; | |
400 | } | |
401 | ||
1717856b | 402 | |
0f2d19dd JB |
403 | int |
404 | scm_gen_getc (port) | |
405 | SCM port; | |
0f2d19dd JB |
406 | { |
407 | int c; | |
408 | ||
409 | /* One char may be stored in the high bits of (car port) orre@nada.kth.se. */ | |
410 | if (SCM_CRDYP (port)) | |
411 | { | |
412 | c = SCM_CGETUN (port); | |
413 | SCM_CLRDY (port); /* Clear ungetted char */ | |
414 | ||
415 | return_c: | |
416 | if (c == '\n') | |
417 | { | |
418 | SCM_INCLINE (port); | |
419 | } | |
420 | else if (c == '\t') | |
421 | { | |
422 | SCM_TABCOL (port); | |
423 | } | |
424 | else | |
425 | { | |
426 | SCM_INCCOL (port); | |
427 | } | |
428 | return c; | |
429 | } | |
430 | ||
431 | ||
432 | switch (SCM_PORT_REPRESENTATION (port)) | |
433 | { | |
434 | case scm_regular_port: | |
435 | c = scm_getc (port); | |
436 | goto return_c; | |
437 | ||
438 | case scm_mb_port: | |
439 | { | |
440 | int x; | |
cdbadcac | 441 | char buf[256]; |
0f2d19dd JB |
442 | |
443 | SCM_ASSERT (XMB_CUR_MAX < sizeof (buf), SCM_BOOL_F, | |
444 | "huge translation", "scm_gen_puts"); | |
445 | ||
446 | x = 0; | |
447 | while (1) | |
448 | { | |
449 | xwchar_t out; | |
450 | c = scm_getc (port); | |
451 | ||
452 | if (c == EOF) | |
453 | return EOF; | |
454 | ||
455 | buf[x] = c; | |
456 | ||
457 | if (xmbtowc (&out, buf, x + 1) > 0) | |
458 | { | |
459 | c = out; | |
460 | goto return_c; | |
461 | } | |
462 | ||
463 | SCM_ASSERT (x < sizeof (buf), SCM_BOOL_F, | |
464 | "huge translation", "scm_gen_getc"); | |
465 | ++x; | |
466 | } | |
467 | } | |
468 | ||
469 | ||
470 | case scm_wchar_port: | |
471 | { | |
472 | int hi; | |
473 | int lo; | |
474 | hi = scm_getc (port); | |
475 | lo = (hi == EOF | |
476 | ? EOF | |
477 | : scm_getc (port)); | |
478 | c = ((hi == EOF) | |
479 | ? EOF | |
480 | : ((hi << 8) | lo)); | |
481 | goto return_c; | |
482 | } | |
483 | ||
484 | ||
485 | default: | |
486 | return EOF; | |
487 | } | |
488 | } | |
489 | ||
1717856b | 490 | |
0f2d19dd JB |
491 | void |
492 | scm_gen_ungetc (c, port) | |
493 | int c; | |
494 | SCM port; | |
0f2d19dd JB |
495 | { |
496 | /* SCM_ASSERT(!SCM_CRDYP(port), port, SCM_ARG2, "too many scm_gen_ungetc");*/ | |
497 | SCM_CUNGET (c, port); | |
498 | if (c == '\n') | |
499 | { | |
500 | /* What should col be in this case? | |
501 | * We'll leave it at -1. | |
502 | */ | |
503 | SCM_LINUM (port) -= 1; | |
504 | } | |
505 | else | |
506 | SCM_COL(port) -= 1; | |
507 | } | |
508 | ||
509 | ||
3cb988bd TP |
510 | char * |
511 | scm_gen_read_line (port) | |
512 | SCM port; | |
513 | { | |
514 | char *s; | |
515 | scm_sizet i; | |
516 | ||
517 | i = SCM_PTOBNUM (port); | |
518 | SCM_SYSCALL (s = (scm_ptobs[i].fgets) (port)); | |
519 | return s; | |
520 | } | |
521 |