Updated
[bpt/guile.git] / libguile / genio.c
1 /* Copyright (C) 1995,1996, 1997 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
15 * the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
16 * Boston, MA 02111-1307 USA
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.
40 * If you do not wish that, delete this exception notice. */
41 \f
42 #include <stdio.h>
43 #include "_scm.h"
44 #include "chars.h"
45 #ifdef GUILE_ISELECT
46 #include "filesys.h"
47 #endif
48
49 #include "genio.h"
50
51 #ifdef HAVE_STRING_H
52 #include <string.h>
53 #endif
54 \f
55
56 void
57 scm_putc (c, port)
58 int c;
59 SCM port;
60 {
61 scm_sizet i = SCM_PTOBNUM (port);
62 SCM_SYSCALL ((scm_ptobs[i].fputc) (c, SCM_STREAM (port)));
63 }
64
65 void
66 scm_puts (s, port)
67 char *s;
68 SCM port;
69 {
70 scm_sizet i = SCM_PTOBNUM (port);
71 SCM_SYSCALL ((scm_ptobs[i].fputs) (s, SCM_STREAM (port)));
72 #ifdef TRANSCRIPT_SUPPORT
73 if (scm_trans && (port == def_outp || port == cur_errp))
74 SCM_SYSCALL (fputs (s, scm_trans));
75 #endif
76 }
77
78 void
79 scm_lfwrite (ptr, size, port)
80 char *ptr;
81 scm_sizet size;
82 SCM port;
83 {
84 scm_sizet i = SCM_PTOBNUM (port);
85 SCM_SYSCALL (scm_ptobs[i].fwrite(ptr, size, 1, SCM_STREAM (port)));
86 #ifdef TRANSCRIPT_SUPPORT
87 if (scm_trans && (port == def_outp || port == cur_errp))
88 SCM_SYSCALL (fwrite (ptr, size, 1, scm_trans));
89 #endif
90 }
91
92
93 \f
94
95 int
96 scm_getc (port)
97 SCM port;
98 {
99 SCM f;
100 int c;
101 scm_sizet i;
102
103 /* One char may be stored in the high bits of (car port) orre@nada.kth.se. */
104 if (SCM_CRDYP (port))
105 {
106 c = SCM_CGETUN (port);
107 SCM_CLRDY (port); /* Clear ungetted char */
108 }
109 else
110 {
111 f = SCM_STREAM (port);
112 i = SCM_PTOBNUM (port);
113 #ifdef GUILE_ISELECT
114 if (SCM_FPORTP (port) && !scm_input_waiting_p ((FILE *) f, "scm_getc"))
115 {
116 int n;
117 SELECT_TYPE readfds;
118 int fd = fileno ((FILE *) f);
119 do
120 {
121 FD_ZERO (&readfds);
122 FD_SET (fd, &readfds);
123 n = scm_internal_select (fd + 1, &readfds, NULL, NULL, NULL);
124 }
125 while (n == -1 && errno == EINTR);
126 }
127 #endif
128 SCM_SYSCALL (c = (scm_ptobs[i].fgetc) (f));
129 }
130
131 if (c == '\n')
132 {
133 SCM_INCLINE (port);
134 }
135 else if (c == '\t')
136 {
137 SCM_TABCOL (port);
138 }
139 else
140 {
141 SCM_INCCOL (port);
142 }
143
144 return c;
145 }
146
147
148 void
149 scm_ungetc (c, port)
150 int c;
151 SCM port;
152 {
153 /* SCM_ASSERT(!SCM_CRDYP(port), port, SCM_ARG2, "too many scm_ungetc");*/
154 SCM_CUNGET (c, port);
155 if (c == '\n')
156 {
157 /* What should col be in this case?
158 * We'll leave it at -1.
159 */
160 SCM_LINUM (port) -= 1;
161 }
162 else
163 SCM_COL(port) -= 1;
164 }
165
166
167 char *
168 scm_do_read_line (port, len)
169 SCM port;
170 int *len;
171 {
172 char *s;
173 scm_sizet i;
174
175 i = SCM_PTOBNUM (port);
176 SCM_SYSCALL (s = (scm_ptobs[i].fgets) (port, len));
177 return s;
178 }
179