![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to b3scr.c CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [CSRG BSD Unix] / 43BSD / contrib / B / src / bint|
Return to b3scr.c CVS log | Up to [CSRG BSD Unix] / 43BSD / contrib / B / src / bint |
1.1 root 1: /* Copyright (c) Stichting Mathematisch Centrum, Amsterdam, 1985. */
2:
3: /*
4: $Header: b3scr.c,v 1.4 85/08/22 16:58:54 timo Exp $
5: */
6:
7: /* B input/output handling */
8:
9: #include "b.h"
10: #include "b0fea.h"
11: #include "b1mem.h"
12: #include "b1obj.h"
13: #include "b0con.h" /*for CLEAR_EOF*/
14: #include "b2nod.h"
15: #include "b2syn.h"
16: #include "b2par.h"
17: #include "b3scr.h"
18: #include "b3err.h"
19: #include "b3fil.h"
20: #include "b3typ.h"
21: #include "b3env.h"
22: #include "b3sem.h"
23: #include "b3int.h"
24: #ifdef SETJMP
25: #include <setjmp.h>
26: #endif
27:
28: Visible bool interactive;
29: Visible bool rd_interactive;
30: Visible value iname= Vnil; /* input name */
31: Visible bool filtered= No;
32: Visible bool outeractive;
33: #ifdef SETJMP
34: Visible bool awaiting_input= No;
35: Visible jmp_buf read_interrupt;
36: #endif
37: Visible bool at_nwl= Yes; /*Yes if currently at the start of an output line*/
38: Hidden bool woa, wnwl; /*was outeractive, was at_nwl */
39: Hidden bool last_was_text= No; /*Yes if last value written was a text*/
40:
41: Visible bool Eof;
42: FILE *ofile= stdout;
43: FILE *ifile; /* input file */
44: FILE *sv_ifile; /* copy of ifile for restoring after reading unit */
45:
46: /******************************* Output *******************************/
47:
48: #ifndef INTEGRATION
49:
50: Hidden Procedure putch(c) char c; {
51: if (still_ok) {
52: putc(c, ofile);
53: if (c == '\n') at_nwl= Yes;
54: else at_nwl= No;
55: }
56: }
57:
58: #else
59:
60: Hidden int ocol; /* Current output column */
61:
62: Hidden Procedure putch(c) char c; {
63: if (still_ok) {
64: putc(c, ofile);
65: if (c == '\n') { at_nwl= Yes; ocol= 0; }
66: else {
67: if (at_nwl) { ocol= 0; at_nwl= No;}
68: ++ocol;
69: }
70: }
71: }
72:
73: #endif
74:
75: Visible Procedure newline() {
76: putch('\n');
77: fflush(stdout);
78: }
79:
80: Hidden Procedure line() {
81: if (!at_nwl) newline();
82: }
83:
84: Visible Procedure wri_space() {
85: putch(' ');
86: }
87:
88: Visible Procedure writ(v) value v; {
89: wri(v, Yes, Yes, No);
90: fflush(stdout);
91: }
92:
93: #define Putch_sp() {if (!perm) putch(' ');}
94:
95: Hidden int intsize(v) value v; {
96: value s= size(v); int len=0;
97: if (large(s)) error(MESS(3800, "value too big to output"));
98: else len= intval(s);
99: release(s);
100: return len;
101: }
102:
103: Hidden bool lwt;
104:
105: Visible Procedure wri(v, coll, outer, perm) value v; bool coll, outer, perm; {
106: if (outer && !at_nwl && (!Is_text(v) || !last_was_text)
107: && (!Is_compound(v) || !coll)) putch(' ');
108: lwt= No;
109: if (Is_number(v)) {
110: if (perm) printnum(ofile, v);
111: else {
112: string cp= convnum(v);
113: while(*cp && still_ok) putch(*cp++);
114: }
115: } else if (Is_text(v)) {
116: #ifndef INTEGRATION
117: wrtext(putch, v, outer ? '\0' : '"');
118: #else
119: value ch; char c; int k, len= Length(v);
120: #define QUOTE '"'
121: if (!outer) putch(QUOTE);
122: for (k=0; k<len && still_ok; k++) {
123: ch= thof(k+1, v);
124: putch(c= charval(ch));
125: if (!outer && (c == QUOTE || c == '`'))
126: putch(c);
127: release(ch);
128: }
129: if (!outer) putch(QUOTE);
130: #endif
131: lwt= outer;
132: } else if (Is_compound(v)) {
133: intlet k, len= Nfields(v);
134: outer&= coll;
135: if (!coll) putch('(');
136: for (k=0; k<len && still_ok; k++) {
137: wri(*Field(v, k), No, outer, perm);
138: if (!Lastfield(k)) {
139: if (!outer){
140: putch(',');
141: Putch_sp();
142: }
143: }
144: }
145: if (!coll) putch(')');
146: } else if (Is_list(v) || Is_ELT(v)) {
147: value ve; int k, len= intsize(v);
148: putch('{');
149: for (k=0; k<len && still_ok; k++) {
150: wri(ve= thof(k+1, v), No, No, perm);
151: release(ve);
152: if (!Last(k)) {
153: putch(';');
154: Putch_sp();
155: }
156: }
157: putch('}');
158: } else if (Is_table(v)) {
159: int k, len= intsize(v);
160: putch('{');
161: for (k=0; k<len && still_ok; k++) {
162: putch('['); wri(*key(v, k), Yes, No, perm);
163: putch(']'); putch(':'); Putch_sp();
164: wri(*assoc(v, k), No, No, perm);
165: if (!Last(k)) {
166: putch(';');
167: Putch_sp();
168: }
169: }
170: putch('}');
171: } else {
172: if (bugs || testing) { putch('?'); putch(Type(v)); putch('?'); }
173: else syserr(MESS(3801, "writing value of unknown type"));
174: }
175: last_was_text= lwt;
176: #ifdef IBMPC
177: if (interrupted) clearerr(ofile);
178: #endif
179: }
180:
181: /***************************** Input ****************************************/
182:
183: Hidden char cmbuf[CMBUFSIZE]; /* for commands */
184: Hidden char rdbuf[RDBUFSIZE]; /* for READ EG/RAW */
185:
186: #ifndef INTEGRATION
187: Visible string cmd_prompt= ">>> "; /* commands */
188: Visible string eg_prompt= "?\b"; /* READ EG */
189: Visible string raw_prompt= "?\b"; /* READ RAW */
190: Visible string qn_prompt= "?\b"; /* questions */
191: #else
192: Hidden literal cmd_prompt= '>'; /* commands */
193: Hidden literal eg_prompt= 'E'; /* READ EG */
194: Hidden literal raw_prompt= 'R'; /* READ RAW */
195: Hidden literal qn_prompt= 'Y'; /* questions */
196: Visible literal unit_prompt= ':'; /* units */
197: Visible literal tar_prompt= '='; /* targets */
198: #endif
199:
200: /* Read a line; EOF only allowed if not interactive, in which case eof set */
201: /* Returns the line input */
202: /* This is the only place where a long jump is necessary */
203: /* In other places, interrupts are just like procedure calls, and checks */
204: /* of still_ok and interrupted suffice: eventually the stack unwinds to the*/
205: /* main loop in imm_command(). Here though, an interrupt must actually */
206: /* terminate the read. Hence the bool awaiting_input indicating if the */
207: /* long jump is necessary or not */
208:
209: #ifndef INTEGRATION
210:
211: Hidden txptr read_line(should_prompt, prompt, cmd, eof, eof_message)
212: bool should_prompt, cmd, *eof; string prompt, eof_message; {
213: txptr buf, rp, bufend; intlet k; bool got= No;
214: FILE *f;
215: *eof= No;
216: if (cmd) { buf= cmbuf; bufend= &cmbuf[CMBUFSIZE-2]; }
217: else { buf= rdbuf; bufend= &rdbuf[RDBUFSIZE-2]; }
218: #ifdef SETJMP
219: if (setjmp(read_interrupt) != 0) {
220: awaiting_input= No;
221: return buf;
222: }
223: #endif
224: while (!got) {
225: rp= buf;
226: #ifdef SETJMP
227: awaiting_input= Yes;
228: #endif
229: if (should_prompt) {
230: if (cmd) {
231: if (outeractive) {
232: line();
233: at_nwl= No;
234: }
235: }
236: fprintf(stderr, prompt); fflush(stderr);
237: f= stdin;
238: } else {
239: f= ifile;
240: }
241: while ((k= getc(f)) != EOF && k != '\n') {
242: *rp++= k;
243: if (rp >= bufend) syserr(MESS(3802, "buffer overflow"));
244: }
245: #ifdef SETJMP
246: awaiting_input= No;
247: #endif
248: got= Yes; *rp++= '\n'; *rp= '\0';
249: if (k == EOF) {
250: if (should_prompt) {
251: if (filtered) {
252: bye(0); /*Editor has died*/
253: } else {
254: fprintf(stderr, "\r*** %s\n", eof_message);
255: CLEAR_EOF;
256: if (outeractive) at_nwl= Yes;
257: got= No;
258: }
259: } else *eof= Yes;
260: }
261: }
262: if (should_prompt && outeractive && k == '\n') at_nwl= Yes;
263: return buf;
264: }
265:
266: #else INTEGRATION
267:
268: Hidden intlet
269: rd_fileline(nbuf, file, nbufend)
270: string nbuf, nbufend;
271: FILE *file;
272: {
273: intlet k;
274: while ((k= getc(file)) != EOF && k != '\n') {
275: *nbuf++= k;
276: if (nbuf >= nbufend)
277: syserr(MESS(3803, "buffer overflow rd_fileline()"));
278: }
279: *nbuf++= '\n'; *nbuf= '\0';
280: return k;
281: }
282:
283: Hidden intlet
284: rd_bufline(nbuf, obuf, nbufend)
285: string nbuf, *obuf, nbufend;
286: {
287: while (**obuf && **obuf != '\n') {
288: *nbuf++= **obuf; ++*obuf;
289: if (nbuf >= nbufend)
290: syserr(MESS(3804, "buffer overflow rd_bufline()"));
291: }
292: *nbuf++= '\n'; *nbuf= '\0';
293: if (**obuf) { ++*obuf; return '\n';}
294: else return EOF;
295: }
296:
297: Hidden string edcmdbuf;
298:
299: Hidden txptr
300: read_line(should_prompt, prompt, cmd, eof, eof_message)
301: bool should_prompt, cmd, *eof; literal prompt; string eof_message;
302: {
303: txptr buf, rp, bufend; intlet k, indent= 0; bool got= No;
304: static string pedcmdbuf;
305: if (prompt == eg_prompt || prompt == raw_prompt) indent= ocol;
306: *eof= No;
307: if (cmd) { buf= cmbuf; bufend= &cmbuf[CMBUFSIZE-2]; }
308: else { buf= rdbuf; bufend= &rdbuf[RDBUFSIZE-2]; }
309: #ifdef SETJMP
310: if (setjmp(read_interrupt) != 0) {
311: awaiting_input= No;
312: return buf;
313: }
314: #endif
315: while (!got) {
316: rp= buf; got= Yes;
317: #ifdef SETJMP
318: awaiting_input= Yes;
319: #endif
320: if (!should_prompt) {
321: k= rd_fileline(rp, ifile, bufend);
322: if (k == EOF) *eof= Yes;
323: } else {
324: if (!edcmdbuf) {
325: if (cmd && outeractive) { line(); at_nwl= No; }
326: btop(&edcmdbuf, 0, prompt, indent);
327: pedcmdbuf= edcmdbuf;
328: }
329: k= rd_bufline(rp, &pedcmdbuf, bufend);
330: if (k == EOF) {
331: freemem((ptr) edcmdbuf);
332: edcmdbuf= (string) NULL;
333: if (prompt != '>') got= No;
334: }
335: }
336: #ifdef SETJMP
337: awaiting_input= No;
338: #endif
339: }
340:
341: if (should_prompt && outeractive && k == '\n') at_nwl= Yes;
342: return buf;
343: }
344:
345: #endif INTEGRATION
346:
347: /* Rather over-fancy routine to ask the user a question */
348: /* Will anybody discover that you're only given 4 chances? */
349:
350: Hidden char USE_YES_OR_NO[]=
351: "Answer with yes or no (or use interrupt to duck the question)";
352:
353: Hidden char LAST_CHANCE[]=
354: "This is your last chance. Take it. I really don't know what you want.\n\
355: So answer the question";
356:
357: Hidden char NO_THEN[]=
358: "Well, I shall assume that your refusal to answer the question means no!";
359:
360: Visible bool is_intended(m) string m; {
361: char answer; intlet try; txptr tp; bool eof;
362: if (!interactive) return Yes;
363: if (outeractive) line();
364: for (try= 1; try<=4; try++){
365: if (try == 1 || try == 3) fprintf(stderr, "*** %s\n", m);
366: tp= read_line(Yes, qn_prompt, No, &eof, USE_YES_OR_NO);
367: skipsp(&tp);
368: answer= Char(tp);
369: if (answer == 'y' || answer == 'Y') return Yes;
370: if (answer == 'n' || answer == 'N') return No;
371: if (outeractive) line();
372: fprintf(stderr, "*** %s\n",
373: try == 1 ? "Please answer with yes or no" :
374: try == 2 ? "Just yes or no, please" :
375: try == 3 ? LAST_CHANCE :
376: NO_THEN);
377: } /* end for */
378: return No;
379: }
380:
381: /* Read_eg uses evaluation but it shouldn't.
382: Wait for a more general mechanism. */
383:
384: Visible Procedure read_eg(l, t) loc l; btype t; {
385: context c; parsetree code;
386: parsetree r= NilTree; value rv= Vnil; btype rt= Vnil;
387: envtab svprmnvtab= Vnil;
388: txptr fcol_save= first_col, tx_save= tx;
389: do {
390: still_ok= Yes;
391: sv_context(&c);
392: if (cntxt != In_read) {
393: release(read_context.uname);
394: sv_context(&read_context);
395: }
396: svprmnvtab= prmnvtab == Vnil ? Vnil : prmnv->tab;
397: /* save scratch-pad copy because of following setprmnv() */
398: setprmnv();
399: cntxt= In_read;
400: first_col= tx= read_line(rd_interactive, eg_prompt, No,
401: &Eof, "use interrupt to abort READ command");
402: if (still_ok && Eof)
403: error(MESS(3805, "End of file encountered during READ command"));
404: if (!rd_interactive) f_lino++;
405: if (still_ok) {
406: findceol();
407: r= expr(ceol);
408: if (still_ok) fix_nodes(&r, &code);
409: rv= evalthread(code); release(r);
410: rt= still_ok ? valtype(rv) : Vnil;
411: if (svprmnvtab != Vnil) {
412: prmnvtab= prmnv->tab;
413: prmnv->tab= svprmnvtab;
414: }
415: set_context(&c);
416: if (still_ok) must_agree(t, rt,
417: MESS(3806, "type of expression does not agree with that of EG sample"));
418: release(rt);
419: }
420: if (!still_ok && rd_interactive && !interrupted)
421: fprintf(stderr, "*** Please try again\n");
422: } while (!interrupted && !still_ok && rd_interactive);
423: if (still_ok) put(rv, l);
424: first_col= fcol_save;
425: tx= tx_save;
426: release(rv);
427: }
428:
429: Visible Procedure read_raw(l) loc l; {
430: value r; bool eof;
431: txptr line= read_line(rd_interactive, raw_prompt, No, &eof,
432: "use interrupt to abort READ t RAW");
433: if (still_ok && eof) error(MESS(3807, "End of file encountered during READ t RAW"));
434: if (!rd_interactive) f_lino++;
435: if (still_ok) {
436: txptr rp= line;
437: while (*rp != '\n') rp++;
438: *rp= '\0';
439: r= mk_text(line);
440: put(r, l);
441: release(r);
442: }
443: }
444:
445: Visible txptr getline() {
446: bool should_prompt=
447: interactive && sv_ifile == ifile;
448: return read_line(should_prompt, cmd_prompt, Yes, &Eof,
449: "use QUIT to end session");
450: }
451:
452: /******************************* Files ******************************/
453:
454: Visible Procedure redirect(of) FILE *of; {
455: ofile= of;
456: if (of == stdout) {
457: outeractive= woa;
458: at_nwl= wnwl;
459: } else {
460: woa= outeractive; outeractive= No;
461: wnwl= at_nwl; at_nwl= Yes;
462: }
463: }
464:
465: Visible Procedure vs_ifile() {
466: ifile= sv_ifile;
467: }
468:
469: Visible Procedure re_screen() {
470: sv_ifile= ifile;
471: interactive= f_interactive(ifile) || (ifile == stdin && filtered);
472: Eof= No;
473: }
474:
475: /* initscr is a reserved name of CURSES */
476: Visible Procedure init_scr() {
477: outeractive= f_interactive(stdout) || filtered;
478: rd_interactive= f_interactive(stdin) || filtered;
479: rdbuf[0]= '\n'; tx= rdbuf;
480: }
481:
482: Visible Procedure
483: endscr()
484: {
485: #ifdef INTEGRATION
486: if (edcmdbuf) {
487: freemem((ptr) edcmdbuf);
488: edcmdbuf= (string) NULL;
489: }
490: #endif
491: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.