4.3BSD - /usr/src/new/B/src/bint/b3scr.c

   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: }

Defined functions

Defined variables

Defined macros