Subject: v23i098: ABC interactive programming environment, Part19/25 Newsgroups: comp.sources.unix Approved: rsalz@uunet.UU.NET X-Checksum-Snefru: ce9d71fe 133ee817 80fd7995 73963da8 Submitted-by: Steven Pemberton Posting-number: Volume 23, Issue 98 Archive-name: abc/part19 #! /bin/sh # This is a shell archive. Remove anything before this line, then feed it # into a shell via "sh file" or similar. To overwrite existing files, # type "sh file -c". # The tool that generated this appeared in the comp.sources.unix newsgroup; # send mail to comp-sources-unix@uunet.uu.net if you want that tool. # Contents: abc/bed/e1edit.c abc/bed/e1goto.c abc/bed/e1wide.c # abc/bint2/i2dis.c abc/bint3/i3typ.c abc/bio/i4rec.c # abc/btr/i1btr.h abc/tc/termcap.c # Wrapped by rsalz@litchi.bbn.com on Mon Dec 17 13:28:16 1990 PATH=/bin:/usr/bin:/usr/ucb ; export PATH echo If this archive is complete, you will see the following message: echo ' "shar: End of archive 19 (of 25)."' if test -f 'abc/bed/e1edit.c' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'abc/bed/e1edit.c'\" else echo shar: Extracting \"'abc/bed/e1edit.c'\" \(7312 characters\) sed "s/^X//" >'abc/bed/e1edit.c' <<'END_OF_FILE' X/* Copyright (c) Stichting Mathematisch Centrum, Amsterdam, 1986. */ X X/* X * B editor -- Read unit from file. X */ X X#include "b.h" X#include "bedi.h" X#include "etex.h" X#include "feat.h" X#include "bmem.h" X#include "erro.h" X#include "bobj.h" X#include "node.h" X#include "tabl.h" X#include "gram.h" X#include "supr.h" X#include "queu.h" X X#define TABSIZE 8 X#define MAXLEVEL 128 Xstatic short *indent; Xstatic int level; X X/* X * Read (edit) parse tree from file into the focus. X * Rather ad hoc, we use ins_string for each line X * and do some magic tricks to get the indentation right X * (most of the time). X * If line > 0, position the focus at that line, if possible; X * otherwise the focus is left at the end of the inserted text. X */ X XVisible bool Xreadfile(ep, filename, line, creating) X register environ *ep; X string filename; X int line; X bool creating; X{ X X int lines = 0; X register FILE *fp = fopen(filename, "r"); X register int c; X string buf; X auto string cp; X auto queue q = Qnil; X X if (!fp) { X ederrS(MESS(6200, "Sorry, I can't edit file \"%s\""), filename); X return No; X } X X buf= (string) getmem(BUFSIZ); X if (indent == NULL) { X indent= (short*) getmem((unsigned) (MAXLEVEL * sizeof(short))); X } X X level= 0; X indent[0]= 0; X X do { X do { X for (cp = buf; cp < buf + BUFSIZ - 1; ++cp) { X c = getc(fp); X if (c == EOF || c == '\n') X break; X if (c < ' ' || c >= 0177) X c = ' '; X *cp = c; X } X if (cp > buf) { X *cp = 0; X if (!ins_string(ep, buf, &q, 0) || !emptyqueue(q)) { X qrelease(q); X fclose(fp); X freemem((ptr) buf); X return No; X } X qrelease(q); X } X } while (c != EOF && c != '\n'); X ++lines; X if (c != EOF && !editindentation(ep, fp)) { X fclose(fp); X freemem((ptr) buf); X return No; X } X } while (c != EOF); X freemem((ptr) buf); X fclose(fp); X if (ep->mode == FHOLE || ep->mode == VHOLE && (ep->s1&1)) { X cp = ""; X VOID soften(ep, &cp, 0); X } X if (lines > 1 && line > 0) { X if (line >= lines) line= lines-1; X VOID gotoyx(ep, line-1, 0); X oneline(ep); X } X if (creating) X ins_newline(ep); X return Yes; X} X X X/* X * Do all the footwork required to get the indentation proper. X */ X XHidden Procedure Xeditindentation(ep, fp) X register environ *ep; X register FILE *fp; X{ X register int ind= 0; X register int c; X X for (;;) { X c= getc(fp); X X if (c == ' ') X ++ind; X else if (c == '\t') X ind= (ind/TABSIZE + 1) * TABSIZE; X else X break; X } X ungetc(c, fp); X if (c == EOF || c == '\n') X return Yes; X if (ind > indent[level]) { X if (level == MAXLEVEL-1) { X ederr(MESS(6201, "excessively nested indentation")); X return No; X } X indent[++level]= ind; X } X else if (ind < indent[level]) { X while (level > 0 && ind <= indent[level-1]) X --level; X if (ind != indent[level]) { X ederr(MESS(6202, "indentation messed up")); X return No; X } X } X if (!ins_newline(ep)) { X#ifndef NDEBUG X debug("[Burp! Can't insert a newline.]"); X#endif /* NDEBUG */ X return No; X } X if (level > Level(ep->focus)) { X ederr(MESS(6203, "unexpected indentation increase")); X return No; X } X while (level < Level(ep->focus)) { X if (!ins_newline(ep)) { X#ifndef NDEBUG X debug("[Burp, burp! Can't decrease indentation.]"); X#endif /* NDEBUG */ X return No; X } X } X fixit(ep); X return Yes; X} X X/* ------------------------------------------------------------ */ X X#ifdef SAVEBUF X X/* X * Read the next non-space character. X */ X XHidden int Xskipspace(fp) X register FILE *fp; X{ X register int c; X X do { X c = getc(fp); X } while (c == ' '); X return c; X} X X X/* X * Read a text in standard B format when the initial quote has already X * been read. X */ X XHidden value Xreadtext(fp, quote) X register FILE *fp; X register char quote; X{ X auto value v = Vnil; X char buf[BUFSIZ]; X register string cp = buf; X register int c; X auto int i; X value w; X X for (; ; ++cp) { X c = getc(fp); X if (!isascii(c) || c != ' ' && !isprint(c)) { X#ifndef NDEBUG X if (c == EOF) X debug("readtext: EOF"); X else X debug("readtext: bad char (0%02o)", c); X#endif /* NDEBUG */ X release(v); X return Vnil; /* Bad character or EOF */ X } X if (c == quote) { X c = getc(fp); X if (c != quote) { X ungetc(c, fp); X break; X } X } X else if (c == '`') { X c = skipspace(fp); X if (c == '$') { X i = 0; X if (fscanf(fp, "%d", &i) != 1 X || i == 0 || !isascii(i)) { X#ifndef NDEBUG X debug("readtext: error in conversion"); X#endif /* NDEBUG */ X release(v); X return Vnil; X } X c = skipspace(fp); X } X else X i = '`'; X if (c != '`') { X#ifndef NDEBUG X if (c == EOF) X debug("readtext: EOF in conversion"); X else X debug("readtext: bad char in conversion (0%o)", c); X#endif /* NDEBUG */ X release(v); X return Vnil; X } X c = i; X } X if (cp >= &buf[sizeof buf - 1]) { X *cp = 0; X w= mk_etext(buf); X if (v) { X e_concto(&v, w); X release(w); X } X else X v = w; X cp = buf; X } X *cp = c; X } X *cp = 0; X w= mk_etext(buf); X if (!v) X return w; X e_concto(&v, w); X release(w); X return v; X} X X XHidden int Xreadsym(fp) X register FILE *fp; X{ X register int c; X char buf[100]; X register string bufp; X X for (bufp = buf; ; ++bufp) { X c = getc(fp); X if (c == EOF) X return -1; X if (!isascii(c) || !isalnum(c) && c != '_') { X if (ungetc(c, fp) == EOF) X syserr(MESS(6204, "readsym: ungetc failed")); X break; X } X *bufp = c; X } X *bufp = 0; X if (isdigit(buf[0])) X return atoi(buf); X if (strcmp(buf, "Required") == 0) /***** Compatibility hack *****/ X return Hole; X return nametosym(buf); X} X X X/* X * Read a node in internal format (recursively). X * Return nil pointer if EOF or error. X */ X XHidden node Xreadnode(fp) X FILE *fp; X{ X int c; X int nch; X node ch[MAXCHILD]; X node n; X int sym; X X c = skipspace(fp); X switch (c) { X case EOF: X return Nnil; /* EOF hit */ X X case '(': X sym = readsym(fp); X if (sym < 0) { X#ifndef NDEBUG X debug("readnode: missing symbol"); X#endif /* NDEBUG */ X return Nnil; /* No number as first item */ X } X if (sym < 0 || sym > Hole) { X#ifndef NDEBUG X debug("readnode: bad symbol (%d)", sym); X#endif /* NDEBUG */ X return Nnil; X } X nch = 0; X while ((c = skipspace(fp)) == ',' && nch < MAXCHILD) { X n = readnode(fp); X if (!n) { X for (; nch > 0; --nch) X noderelease(ch[nch-1]); X return Nnil; /* Error encountered in child */ X } X ch[nch] = n; X ++nch; X } X if (c != ')') { X#ifndef NDEBUG X if (c == ',') X debug("readnode: node too long (sym=%d)", sym); X else X debug("readnode: no ')' where expected (sym=%d)", sym); X#endif /* NDEBUG */ X for (; nch > 0; --nch) X noderelease(ch[nch-1]); X return Nnil; /* Not terminated with ')' or too many children */ X } X if (nch == 0) X return gram(sym); /* Saves space for Optional/Hole nodes */ X return newnode(nch, sym, ch); X X case '\'': X case '"': X return (node) readtext(fp, c); X X default: X#ifndef NDEBUG X debug("readnode: bad initial character"); X#endif /* NDEBUG */ X return Nnil; /* Bad initial character */ X } X} X X X/* X * Read a node written in a more or less internal format. X */ X XVisible value Xeditqueue(filename) X string filename; X{ X register FILE *fp = fopen(filename, "r"); X auto queue q = Qnil; X register node n; X X if (!fp) X return Vnil; X do { X n = readnode(fp); X if (!n) X break; /* EOF or error */ X addtoqueue(&q, n); X noderelease(n); X } while (skipspace(fp) == '\n'); X fclose(fp); X return (value)q; X} X X#endif /* SAVEBUF */ END_OF_FILE if test 7312 -ne `wc -c <'abc/bed/e1edit.c'`; then echo shar: \"'abc/bed/e1edit.c'\" unpacked with wrong size! fi # end of 'abc/bed/e1edit.c' fi if test -f 'abc/bed/e1goto.c' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'abc/bed/e1goto.c'\" else echo shar: Extracting \"'abc/bed/e1goto.c'\" \(5725 characters\) sed "s/^X//" >'abc/bed/e1goto.c' <<'END_OF_FILE' X/* Copyright (c) Stichting Mathematisch Centrum, Amsterdam, 1986. */ X X/* X * B editor -- Random access focus positioning. X */ X X#include "b.h" X#include "bedi.h" X#include "etex.h" X#include "feat.h" X#include "bobj.h" X#include "erro.h" X#include "node.h" X#include "gram.h" X#include "supr.h" X Xextern int winheight; Xextern int winstart; X X X#define BEFORE (-1) X#define INSIDE 0 X#define BEYOND 1 X X X#ifdef GOTOCURSOR X X/* X * Random cursor positioning (e.g., with a mouse). X */ X Xextern bool nosense; X XVisible bool Xgotocursor(ep) X environ *ep; X{ X int y; X int x; X X if (nosense) { X while (narrow(ep)) X ; X if (ep->mode == ATEND) X leftvhole(ep); X y = lineno(ep); X x = colno(ep); X } X else if (sense(&y, &x)) { X#ifdef SCROLLBAR X if (y == winheight) X return gotoscrollbar(ep, x); X#endif /* SCROLLBAR */ X if (!backtranslate(&y, &x)) X return No; X } X else { /* sense() of cursor or mouse failed */ X return No; X } X if (!gotoyx(ep, y, x)) X return No; X gotofix(ep, y, x); X return Yes; X} X X#ifdef SCROLLBAR X X/* X * Special case for goto: user pointed at some point in the scroll bar. X * Go directly to the corresponding line. X * (The scroll bar is only present when winstart == 0; it extends from X * col 0 to winheight-1 inclusive.) X */ X XHidden bool Xgotoscrollbar(ep, x) X environ *ep; X int x; X{ X int w; X X if (winstart != 0 || x >= winheight) { /* Not within scroll bar */ X ederr(GOTO_OUT); X return No; X } X top(&ep->focus); X ep->mode = WHOLE; X higher(ep); X w = nodewidth(tree(ep->focus)); X if (w >= 0) X w = 1; X else X w = 1-w; X if (!gotoyx(ep, x * w / winheight, 0)) X return No; X oneline(ep); X return Yes; X} X X#endif /* SCROLLBAR */ X X#endif /* GOTOCURSOR */ X X/* X * Set the focus to the smallest node or subset surrounding X * the position (y, x). X */ X XVisible bool Xgotoyx(ep, y, x) X register environ *ep; X register int y; X register int x; X{ X register node n; X register string *rp; X register int i; X register int pc; X X ep->mode = WHOLE; X while ((pc = poscomp(ep->focus, y, x)) != INSIDE) { X if (!up(&ep->focus)) { X if (pc == BEFORE) X ep->mode = ATBEGIN; X else X ep->mode = ATEND; X higher(ep); X return No; X } X } X higher(ep); X for (;;) { X switch (poscomp(ep->focus, y, x)) { X X case BEFORE: X i = ichild(ep->focus); X n = tree(parent(ep->focus)); /* Parent's !!! */ X rp = noderepr(n); X if (Fw_positive(rp[i-1])) { X s_up(ep); X ep->s1 = ep->s2 = 2*i - 1; X ep->mode = SUBSET; X } X else if (left(&ep->focus)) X ep->mode = ATEND; X else X ep->mode = ATBEGIN; X return Yes; X X case INSIDE: X n = tree(ep->focus); X if (nchildren(n) >= 1 && !Is_etext(firstchild(n))) { X s_down(ep); X continue; X } X ep->mode = WHOLE; X return Yes; X X case BEYOND: X if (rite(&ep->focus)) X continue; X n = tree(parent(ep->focus)); /* Parent's !!! */ X rp = noderepr(n); X i = ichild(ep->focus); X if (Fw_positive(rp[i])) { X s_up(ep); X ep->s1 = ep->s2 = 2*i + 1; X ep->mode = SUBSET; X } X else X ep->mode = ATEND; X return Yes; X X default: X Abort(); X /* NOTREACHED */ X X } X } X} X X X/* X * Deliver relative position of (y, x) with respect to focus p: X * BEFORE: (y, x) precedes focus; X * INSIDE: (y, x) contained in focus; X * EAFTER: (y, x) follows focus. X X */ X XHidden int Xposcomp(p, y, x) X register path p; X register int y; X register int x; X{ X register int ly; X register int lx; X register int w; X register string *rp; X register node n; X X ly = Ycoord(p); X lx = Xcoord(p); X if (y < ly || y == ly && (lx < 0 || x < lx)) X return BEFORE; X n = tree(p); X w = nodewidth(n); X if (w < 0) { X if (y == ly) { /* Hack for position beyond end of previous line */ X rp = noderepr(n); X if (Fw_negative(rp[0])) X return BEFORE; X } X ly += -w; X lx = -1; X } X else { X if (lx >= 0) X lx += w; X } X if (y < ly || y == ly && (lx < 0 || x < lx)) X return INSIDE; X return BEYOND; X} X X X/* X * Position focus exactly at character indicated by (y, x) if possible. X * If this is the start of something larger, position focus at largest X * object starting here. X */ X XVisible Procedure Xgotofix(ep, y, x) X environ *ep; X int y; X int x; X{ X int fx; X int fy; X int len; X string repr; X X switch (ep->mode) { X X case ATBEGIN: X case ATEND: X return; /* No change; the mouse pointed in the margin. */ X X case SUBSET: X if (ep->s1 > 1) { X fx = Xcoord(ep->focus); X fy = Ycoord(ep->focus); X len = focoffset(ep); X if (len < 0 || fy != y) X return; X if ((ep->s1&1) && fx + len >= x-1) { X string *nr= noderepr(tree(ep->focus)); X repr = nr[ep->s1/2]; X if ((repr && repr[0] == ' ') != (fx + len == x)) X return; X } X else if (fx + len == x) X return; X } X ep->mode = WHOLE; X /* Fall through */ X case WHOLE: X fx = Xcoord(ep->focus); X fy = Ycoord(ep->focus); X if (y != fy) X return; X if (x <= fx ) { X for (;;) { X if (ichild(ep->focus) > 1) X break; X if (!up(&ep->focus)) X break; X repr = noderepr(tree(ep->focus))[0]; X if (!Fw_zero(repr)) { X s_down(ep); X break; X } X higher(ep); X } X if (issublist(symbol(tree(ep->focus)))) X fixsublist(ep); X return; X } X fixfocus(ep, x - fx); X ritevhole(ep); X switch(ep->mode) { X case VHOLE: X len = nodewidth(tree(ep->focus)); X break; X case FHOLE: X { X string *nr= noderepr(tree(ep->focus)); X len = fwidth(nr[ep->s1/2]); X } X break; X default: X return; X } X if (ep->s2 < len) { X ep->mode = SUBRANGE; X ep->s3 = ep->s2; X } X return; X X default: X Abort(); X } X} X X X/* X * Refinement for gotofix -- don't show right sublist of something. X */ X XHidden Procedure Xfixsublist(ep) X environ *ep; X{ X path pa = parent(ep->focus); X node n; X X if (!pa) X return; X n = tree(pa); X if (nchildren(n) > ichild(ep->focus)) X return; X if (samelevel(symbol(n), symbol(tree(ep->focus)))) { X ep->mode = SUBLIST; X ep->s3 = 1; X } X} END_OF_FILE if test 5725 -ne `wc -c <'abc/bed/e1goto.c'`; then echo shar: \"'abc/bed/e1goto.c'\" unpacked with wrong size! fi # end of 'abc/bed/e1goto.c' fi if test -f 'abc/bed/e1wide.c' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'abc/bed/e1wide.c'\" else echo shar: Extracting \"'abc/bed/e1wide.c'\" \(5769 characters\) sed "s/^X//" >'abc/bed/e1wide.c' <<'END_OF_FILE' X/* Copyright (c) Stichting Mathematisch Centrum, Amsterdam, 1986. */ X X/* X * B editor -- Commands to make the focus larger and smaller in various ways. X */ X X#include "b.h" X#include "bedi.h" X#include "etex.h" X#include "bobj.h" X#include "node.h" X#include "supr.h" X#include "gram.h" X#include "tabl.h" X X/* X * Widen -- make the focus larger. X */ X XVisible bool Xwiden(ep, deleting) X register environ *ep; X bool deleting; X{ X register node n; X register node nn; X register int sym; X register int ich; X X higher(ep); X grow(ep, deleting); X X n = tree(ep->focus); X sym = symbol(n); X if (ep->mode == VHOLE && (ep->s1&1)) X ep->mode = FHOLE; X X switch (ep->mode) { X X case ATBEGIN: X case ATEND: X /* Shouldn't occur after grow(ep) */ X ep->mode = WHOLE; X return Yes; X X case VHOLE: X if (ep->s2 >= lenitem(ep)) X --ep->s2; X ep->mode = SUBRANGE; X ep->s3 = ep->s2; X return Yes; X X case FHOLE: X if (ep->s2 >= lenitem(ep)) { X if (ep->s2 > 0) X --ep->s2; X else { X leftvhole(ep); X switch (ep->mode) { X case ATBEGIN: X case ATEND: X ep->mode = WHOLE; X return Yes; X case VHOLE: X case FHOLE: X if (ep->s2 >= lenitem(ep)) { X if (ep->s2 == 0) { X#ifndef NDEBUG X debug("[Desperate in widen]"); X#endif /* NDEBUG */ X ep->mode = SUBSET; X ep->s2 = ep->s1; X return widen(ep, deleting); X } X --ep->s2; X } X ep->mode = SUBRANGE; X ep->s3 = ep->s2; X return Yes; X } X Abort(); X } X } X ep->mode = SUBRANGE; X ep->s3 = ep->s2; X return Yes; X X case SUBRANGE: X ep->mode = SUBSET; X ep->s2 = ep->s1; X return Yes; X X case SUBSET: X if (!issublist(sym)) { X ep->mode = WHOLE; X return Yes; X } X nn= lastchild(n); X if (nodewidth(nn) == 0) { X ep->mode = WHOLE; X return Yes; X } X if (ep->s2 < 2*nchildren(n)) { X ep->mode = SUBLIST; X ep->s3 = 1; X return Yes; X } X /* Fall through */ X case SUBLIST: X for (;;) { X ich = ichild(ep->focus); X if (!up(&ep->focus)) { X ep->mode = WHOLE; X return Yes; X } X higher(ep); X n = tree(ep->focus); X if (ich != nchildren(n) || !samelevel(sym, symbol(n))) { X ep->mode = SUBSET; X ep->s1 = ep->s2 = 2*ich; X return Yes; X } X } X /* Not reached */ X X case WHOLE: X ich = ichild(ep->focus); X if (!up(&ep->focus)) X return No; X n = tree(ep->focus); X if (issublist(symbol(n)) && ich < nchildren(n)) { X ep->mode = SUBLIST; X ep->s3 = 1; X } X return Yes; X X default: X Abort(); X /* NOTREACHED */ X } X /* Not reached */ X} X X X/* X * Narrow -- make the focus smaller. X */ X XVisible bool Xnarrow(ep) X register environ *ep; X{ X register node n; X register int sym; X register int nch; X register string repr; X X higher(ep); X X shrink(ep); X n = tree(ep->focus); X sym = symbol(n); X X switch (ep->mode) { X X case ATBEGIN: X case ATEND: X case VHOLE: X case FHOLE: X return No; X X case SUBRANGE: X if (ep->s3 > ep->s2) X ep->s3 = ep->s2; X else X ep->mode = (ep->s1&1) ? FHOLE : VHOLE; X return Yes; X X case SUBSET: X if (ep->s1 <= 2) { X nch = nchildren(n); X if (ep->s2 >= 2*nch && issublist(symbol(n))) { X if (ep->s1 <= 1) { X ep->s2 = 2*nch - 1; X return Yes; X } X repr = noderepr(n)[0]; X if (!Fw_positive(repr)) { X ep->s2 = 2*nch - 1; X return Yes; X } X } X } X ep->s2 = ep->s1; X return Yes; X X case SUBLIST: X Assert(ep->s3 > 1); X ep->s3 = 1; X return Yes; X X case WHOLE: X Assert(sym == Hole || sym == Optional); X return No; X X default: X Abort(); X /* NOTREACHED */ X } X} X X XVisible bool Xextend(ep) X register environ *ep; X{ X register node n; X register int i; X register int len; X register int s1save; X int sym; X X grow(ep, No); X higher(ep); X switch (ep->mode) { X X case VHOLE: X case FHOLE: X case ATBEGIN: X case ATEND: X return widen(ep, No); X X case SUBRANGE: X len = lenitem(ep); X if (ep->s3 < len-1) X ++ep->s3; X else if (ep->s2 > 0) X --ep->s2; X else { X ep->mode = SUBSET; X ep->s2 = ep->s1; X return extend(ep); /* Recursion! */ X } X return Yes; X X case SUBSET: X s1save = ep->s1; X ep->s1 = ep->s2; X if (nextnnitem(ep)) { X ep->s2 = ep->s1; X ep->s1 = s1save; X } X else { X ep->s1 = s1save; X if (!prevnnitem(ep)) Abort(); X } X if (ep->s1 == 1 X && ((sym= symbol(n= tree(ep->focus))) == Test_suite X || sym == Refinement) X && ep->s2 == 3) X { X oneline(ep); X } X X return Yes; X X case WHOLE: X return up(&ep->focus); X X case SUBLIST: X n = tree(ep->focus); X for (i = ep->s3; i > 1; --i) X n = lastchild(n); X if (samelevel(symbol(n), symbol(lastchild(n)))) { X ++ep->s3; X return Yes; X } X ep->mode = WHOLE; X if (symbol(lastchild(n)) != Optional) X return Yes; X return extend(ep); /* Recursion! */ X X default: X Abort(); X /* NOTREACHED */ X } X} X X X/* X * Right-Narrow -- make the focus smaller, going to the last item of a list. X */ X XVisible bool Xrnarrow(ep) X register environ *ep; X{ X register node n; X register node nn; X register int i; X register int sym; X X higher(ep); X X shrink(ep); X n = tree(ep->focus); X sym = symbol(n); X if (sym == Optional || sym == Hole) X return No; X X switch (ep->mode) { X X case ATBEGIN: X case ATEND: X case VHOLE: X case FHOLE: X return No; X X case SUBRANGE: X if (ep->s3 > ep->s2) X ep->s2 = ep->s3; X else { X ++ep->s2; X ep->mode = (ep->s1&1) ? FHOLE : VHOLE; X } X return Yes; X X case SUBSET: X if (issublist(sym) && ep->s2 >= 2*nchildren(n)) { X do { X sym = symbol(n); X s_downrite(ep); X n = tree(ep->focus); X } while (samelevel(sym, symbol(n)) X && (nn = lastchild(n), nodewidth(nn) != 0)); X ep->mode = WHOLE; X return Yes; X } X ep->s1 = ep->s2; X return Yes; X X case SUBLIST: X Assert(ep->s3 > 1); X for (i = ep->s3; i > 1; --i) X s_downi(ep, nchildren(tree(ep->focus))); X ep->s3 = 1; X return Yes; X X case WHOLE: X Assert(sym == Hole || sym == Optional); X return No; X X default: X Abort(); X /* NOTREACHED */ X } X} END_OF_FILE if test 5769 -ne `wc -c <'abc/bed/e1wide.c'`; then echo shar: \"'abc/bed/e1wide.c'\" unpacked with wrong size! fi # end of 'abc/bed/e1wide.c' fi if test -f 'abc/bint2/i2dis.c' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'abc/bint2/i2dis.c'\" else echo shar: Extracting \"'abc/bint2/i2dis.c'\" \(7205 characters\) sed "s/^X//" >'abc/bint2/i2dis.c' <<'END_OF_FILE' X/* Copyright (c) Stichting Mathematisch Centrum, Amsterdam, 1986. */ X X#include "b.h" X#include "bint.h" X#include "bobj.h" X#include "b0lan.h" X#include "i2par.h" X#include "i2nod.h" X XFILE *d_file; X XHidden intlet ilevel= 0; X XHidden Procedure set_ilevel() { X intlet i; X for (i= 0; i 1", X /* AT_LEAST */ "0 >= 1", X /* EQUAL */ "0 = 1", X /* UNEQUAL */ "0 <> 1", X /* Nonode */ "", X X /* TAGformal */ "0", X /* TAGlocal */ "0", X /* TAGglobal */ "0", X /* TAGrefinement */ "0", X /* TAGzerfun */ "0", X /* TAGzerprd */ "0", X X /* ACTUAL */ "", X /* FORMAL */ "", X X#ifdef GFX X /* SPACE */ "SPACE FROM a TO b", X /* LINE */ "LINE FROM a TO b", X /* CLEAR */ "CLEAR SCREEN", X#endif X /* COLON_NODE */ "0" X X}; X X#define Is_digit(d) ((d) >= '0' && (d) <= '9') X#define Fld(v, t) *Branch(v, (*(t) - '0') + First_fieldnr) X XHidden Procedure displ(v) value v; { X string t; X X if (!Valid(v)) return; X else if (Is_text(v)) d_string(strval(v)); X else if (Is_parsetree(v)) { X t= text[nodetype(v)]; X while (*t) { X if (Is_digit(*t)) displ(Fld(v, t)); X else if (*t == '#') { X special(v, &t); X if (stop_displ) return; X } else d_char(*t); X t++; X } X } X} X XHidden Procedure special(v, t) parsetree v; string *t; { X (*t)++; X switch (**t) { X case 'a': d_collateral(Fld(v, ++*t)); break; X case 'b': indent(Fld(v, ++*t)); break; X case 'c': d_comment(Fld(v, ++*t)); break; X case 'd': /* test suite */ X (*t)++; X if (!new_line) /* there was a command */ X d_char(**t); X break; X case 'e': d_textdis(v); break; X case 'f': d_textlit(v); break; X case 'g': d_tabdis(Fld(v, ++*t)); break; X case 'h': d_actfor_compound(Fld(v, ++*t)); break; X case 'i': d_listdis(Fld(v, ++*t)); break; X case 'j': d_write(v); break; X case 'k': d_dyaf(v); break; X case 'l': d_monf(v); break; X } X} X XHidden Procedure indent(v) parsetree v; { X if (displ_one_line) { stop_displ= Yes; return; } X ilevel++; X displ(v); X ilevel--; X} X XHidden bool no_space_before_comment(v) value v; { X return ncharval(1, v) == '\\'; X} X X XHidden Procedure d_comment(v) value v; { X if ( v != Vnil) { X in_comment= Yes; X if (!new_line && no_space_before_comment(v)) d_space(); X displ(v); X in_comment= No; X } X if (!new_line) d_newline(); X} X XHidden value quote= Vnil; X XHidden Procedure d_textdis(v) parsetree v; { X value s_quote= quote; X quote= *Branch(v, XDIS_QUOTE); X displ(quote); X displ(*Branch(v, XDIS_NEXT)); X displ(quote); X quote= s_quote; X} X XHidden Procedure d_textlit(v) parsetree v; { X value w; X displ(w= *Branch(v, XLIT_TEXT)); X if (Valid(w) && character(w)) { X value c= mk_text("`"); X if (compare(quote, w) == 0 || compare(c, w) == 0) displ(w); X release(c); X } X displ(*Branch(v, XLIT_NEXT)); X} X XHidden Procedure d_tabdis(v) value v; { X intlet k, len= Nfields(v); X for (k= 0; k < len; k++) { X if (k>0) d_string("; "); X d_string("["); X displ(*Field(v, k)); X d_string("]: "); X displ(*Field(v, ++k)); X } X} X XHidden Procedure d_collateral(v) value v; { X intlet k, len= Nfields(v); X for (k= 0; k < len; k++) { X if (k>0) d_string(", "); X displ(*Field(v, k)); X } X} X XHidden Procedure d_listdis(v) value v; { X intlet k, len= Nfields(v); X for (k= 0; k < len; k++) { X if (k>0) d_string("; "); X displ(*Field(v, k)); X } X} X XHidden Procedure d_actfor_compound(v) value v; { X while (v != Vnil) { X displ(*Branch(v, ACT_KEYW)); X if (*Branch(v, ACT_EXPR) != Vnil) { X d_space(); X displ(*Branch(v, ACT_EXPR)); X } X v= *Branch(v, ACT_NEXT); X if (v != Vnil) d_space(); X } X} X XHidden Procedure d_write(v) parsetree v; { X value l_lines, w, r_lines; X l_lines= *Branch(v, WRT_L_LINES); X w= *Branch(v, WRT_EXPR); X r_lines= *Branch(v, WRT_R_LINES); X displ(l_lines); X if (w != NilTree) { X value n= size(l_lines); X if (intval(n) > 0) d_space(); X release(n); X displ(w); X n= size(r_lines); X if (intval(n) > 0) d_space(); X release(n); X } X displ(r_lines); X} X X#define is_b_tag(v) (Valid(v) && Letter(ncharval(1, v))) X XHidden Procedure d_dyaf(v) parsetree v; { X parsetree l, r; value name; X l= *Branch(v, DYA_LEFT); X r= *Branch(v, DYA_RIGHT); X name= *Branch(v, DYA_NAME); X displ(l); X if (is_b_tag(name) || nodetype(r) == MONF) { X d_space(); X displ(name); X d_space(); X } X else displ(name); X displ(r); X} X XHidden Procedure d_monf(v) parsetree v; { X parsetree r; value name; X name= *Branch(v, MON_NAME); X r= *Branch(v, MON_RIGHT); X displ(name); X if (is_b_tag(name)) { X switch (nodetype(r)) { X case MONF: X name= *Branch(r, MON_NAME); X if (!is_b_tag(name)) X break; X case SELECTION: X case BEHEAD: X case CURTAIL: X case TAG: X case TAGformal: X case TAGlocal: X case TAGglobal: X case TAGrefinement: X case TAGzerfun: X case TAGzerprd: X case NUMBER: X case TEXT_DIS: X d_space(); X break; X default: X break; X } X } X displ(r); X} END_OF_FILE if test 7205 -ne `wc -c <'abc/bint2/i2dis.c'`; then echo shar: \"'abc/bint2/i2dis.c'\" unpacked with wrong size! fi # end of 'abc/bint2/i2dis.c' fi if test -f 'abc/bint3/i3typ.c' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'abc/bint3/i3typ.c'\" else echo shar: Extracting \"'abc/bint3/i3typ.c'\" \(2726 characters\) sed "s/^X//" >'abc/bint3/i3typ.c' <<'END_OF_FILE' X/* Copyright (c) Stichting Mathematisch Centrum, Amsterdam, 1986. */ X X/* Type matching */ X#include "b.h" X#include "bint.h" X#include "bobj.h" X#include "i3env.h" X#include "i3typ.h" X X#define Tnil ((btype) Vnil) X X/* All the routines in this file are temporary */ X/* Thus length() has been put here too */ X XVisible int length(v) value v; { X value s= size(v); X int len= intval(s); X release(s); X return len; X} X XVisible btype loctype(l) loc l; { X value *ll; X if (Is_simploc(l)) { X simploc *sl= Simploc(l); X if (!in_env(sl->e->tab, sl->i, &ll)) return Tnil; X return valtype(*ll); X } else if (Is_tbseloc(l)) { X tbseloc *tl= Tbseloc(l); X btype tt= loctype(tl->R), ass; X if (tt == Tnil) return Tnil; X if (!empty(tt)) ass= item(tt, one); X else ass= Tnil; X release(tt); X return ass; X } else if (Is_trimloc(l)) { X return mk_text(""); X } else if (Is_compound(l)) { X btype ct= mk_compound(Nfields(l)); intlet k, len= Nfields(l); X k_Overfields { *Field(ct, k)= loctype(*Field(l, k)); } X return ct; X } else { X syserr(MESS(4200, "loctype asked of non-location")); X return Tnil; X } X} X XVisible btype valtype(v) value v; { X if (Is_number(v)) return mk_integer(0); X else if (Is_text(v)) return mk_text(""); X else if (Is_compound(v)) { X btype ct= mk_compound(Nfields(v)); intlet k, len= Nfields(v); X k_Overfields { *Field(ct, k)= valtype(*Field(v, k)); } X return ct; X } else if (Is_ELT(v)) { X return mk_elt(); X } else if (Is_list(v)) { X btype tt= mk_elt(), vt, ve; X if (!empty(v)) { X insert(vt= valtype(ve= min1(v)), &tt); X release(vt); release(ve); X } X return tt; X } else if (Is_table(v)) { X btype tt= mk_elt(), vk, va; X if (!empty(v)) { X vk= valtype(*key(v, 0)); X va= valtype(*assoc(v, 0)); X replace(va, &tt, vk); X release(vk); release(va); X } X return tt; X } else { X syserr(MESS(4201, "valtype called with unknown type")); X return Tnil; X } X} X XVisible Procedure must_agree(t, u, m) btype t, u; int m; { X intlet k, len; X value vt, vu; X if (t == Tnil || u == Tnil || t == u) return; X if (Is_number(t) && Is_number(u)) return; X if (Is_text(t) && Is_text(u)) return; X if (Is_ELT(u) && (Is_ELT(t) || Is_list(t) || Is_table(t))) return; X if (Is_ELT(t) && ( Is_list(u) || Is_table(u))) return; X if (Is_compound(t) && Is_compound(u)) { X if ((len= Nfields(t)) != Nfields(u)) interr(m); X else k_Overfields { must_agree(*Field(t,k), *Field(u,k), m); } X } else { X if (Is_list(t) && Is_list(u)) { X if (!empty(t) && !empty(u)) { X must_agree(vt= min1(t), vu= min1(u), m); X release(vt); release(vu); X } X } else if (Is_table(t) && Is_table(u)) { X if (!empty(t) && !empty(u)) { X must_agree(*key(t, 0), *key(u, 0), m); X must_agree(*assoc(t, 0), *assoc(u, 0), m); X } X } else interr(m); X } X} END_OF_FILE if test 2726 -ne `wc -c <'abc/bint3/i3typ.c'`; then echo shar: \"'abc/bint3/i3typ.c'\" unpacked with wrong size! fi # end of 'abc/bint3/i3typ.c' fi if test -f 'abc/bio/i4rec.c' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'abc/bio/i4rec.c'\" else echo shar: Extracting \"'abc/bio/i4rec.c'\" \(5720 characters\) sed "s/^X//" >'abc/bio/i4rec.c' <<'END_OF_FILE' X/* Copyright (c) Stichting Mathematisch Centrum, Amsterdam, 1988. */ X X#include "b.h" X#include "feat.h" X#include "bint.h" X#include "bfil.h" X#include "bmem.h" X#include "bobj.h" X#include "i2nod.h" X#include "i2par.h" X#include "i3scr.h" X#include "i3sou.h" X#include "i4bio.h" X X/* X * Code to recover the contents of an ABC workspace. X * X * It constructs two completely new files: X * perm.abc for the permanent environment, and X * suggest.abc for the user suggestions. X * Files with an extension of ".cts" or ".CTS" are taken to be targets; X * all others are assumed to contain units (if they contain garbage, X * they are ignored). X * For units, the name, type and adicity are extracted from the source; X * for targets, the target name is either taken from the old perm.abc or X * taken to be the file name with all illegal characters converted to double X * quote (") and uppercase to lowercase. X * X * BUGS: X * - target names can get truncated when the original target name was longer X * than what fits in a legal file name. X */ X XVisible bool ws_recovered= No; XHidden bool rec_ok= Yes; X XHidden value old_perm; XHidden value permtab; XHidden value sugglis; X XVisible Procedure rec_workspace() { X value lis, fname; X value k, len, m; X value old_ulast, old_tlast; X X ws_recovered= No; X rec_ok= Yes; X X old_perm= copy(b_perm); X old_ulast= copy(last_unit); X old_tlast= copy(last_target); X endworkspace(); X X permtab= mk_elt(); X sugglis= mk_elt(); X X lis= get_names(curdir(), abcfile); X k= one; len= size(lis); X while (numcomp(k, len) <= 0) { X fname= item(lis, k); X if (targetfile(fname)) X rec_target(fname); X else if (unitfile(fname)) X rec_unit(fname); X release(fname); X k= sum(m= k, one); X release(m); X } X release(k); release(len); X release(lis); X X rec_current(old_ulast); X rec_current(old_tlast); X X recperm(); X recsugg(); X recpos(); X#ifdef TYPE_CHECK X rectypes(); X#endif X X release(permtab); X release(sugglis); X release(old_perm); X X initworkspace(); X if (!still_ok) X return; X X ws_recovered= Yes; X} X XHidden Procedure rec_target(fname) value fname; { X value pname; X value name; X intlet k, len; X X /* try to find a name via the old perm table */ X name= Vnil; X len= Valid(old_perm) ? length(old_perm) : 0; X for (k= 0; k'abc/btr/i1btr.h' <<'END_OF_FILE' X/* Copyright (c) Stichting Mathematisch Centrum, Amsterdam, 1986. */ X X/* Private definitions for the b-tree module */ X X#define EQ == X#define NE != X Xextern bool comp_ok; X#define reqerr(s) interr(s) X X/*********************************************************************/ X/* items */ X/*********************************************************************/ X Xtypedef char texitem; Xtypedef value lisitem; Xtypedef struct pair {value k, a;} tabitem; Xtypedef struct onpair {value ka, u;} keysitem; Xtypedef union itm { X texitem c; X lisitem l; X tabitem t; X} btritem, *itemarray, *itemptr; X X#define Charval(pitm) ((pitm)->c) X#define Keyval(pitm) ((pitm)->l) X#define Ascval(pitm) ((pitm)->t.a) X X/* Xt = itemtype, do not change these, their order is used */ X#define Ct (0) X#define Lt (1) X#define Tt (2) X#define Kt (3) X X/* Itemwidth, used for offset in btreenodes */ Xtypedef char width; X#define Itemwidth(it) (itemwidth[it]) Xextern char itemwidth[]; /* uses: */ X#define Cw (sizeof(texitem)) X#define Lw (sizeof(lisitem)) X#define Tw (sizeof(tabitem)) X#define Kw (sizeof(keysitem)) X X/*********************************************************************/ X/* sizes of btrees */ X/*********************************************************************/ X X#define Bigsize (-1) X#define Stail(r,s) ((r) > Maxint - (s) ? Bigsize : (r)+(s)) X#define Ssum(r,s) ((r) EQ Bigsize || (s) EQ Bigsize ? Bigsize : Stail(r,s)) X#define Sincr(r) ((r) EQ Bigsize ? Bigsize : Stail(r,1)) X#define Sadd2(r) ((r) EQ Bigsize ? Bigsize : Stail(r,2)) X#define Sdiff(r,s) ((r) EQ Bigsize || (s) EQ Bigsize ? Bigsize : (r)-(s)) X#define Sdecr(r) ((r) EQ Bigsize ? Bigsize : (r)-(1)) Xvalue treesize(); /* btreeptr pnode */ X X/*********************************************************************/ X/* (A,B)-btrees */ X/*********************************************************************/ X X/* innernodes: using A=6 B=12 */ X#define Mininner 5 /* A - 1 */ X#define Maxinner 11 /* B - 1 */ X/* bottomnodes */ X#define Minbottom 11 X#define Maxbottom 22 X/* rangenodes */ X#define Biglim (Maxbottom+1) X Xtypedef struct btrnode { X HEADER; int size; X char **g; X} Xbtreenode, *btreeptr; X Xtypedef struct innernode { X HEADER; int size; X btreeptr pnptr[Maxinner+1]; itemarray iitm; X} Xinnernode, *innerptr; X Xtypedef struct itexnode { X HEADER; int size; X btreeptr pnptr[Maxinner+1]; texitem icitm[Maxinner]; X} Xitexnode, *itexptr; X Xtypedef struct ilisnode { X HEADER; int size; X btreeptr pnptr[Maxinner+1]; lisitem ilitm[Maxinner]; X} Xilisnode, *ilisptr; X Xtypedef struct itabnode { X HEADER; int size; X btreeptr pnptr[Maxinner+1]; tabitem ititm[Maxinner]; X} Xitabnode, *itabptr; X Xtypedef struct bottomnode { X HEADER; int size; X itemarray bitm; X} Xbottomnode, *bottomptr; X Xtypedef struct btexnode { X HEADER; int size; X texitem bcitm[Maxbottom]; X} Xbtexnode, *btexptr; X Xtypedef struct blisnode { X HEADER; int size; X lisitem blitm[Maxbottom]; X} Xblisnode, *blisptr; X Xtypedef struct btabnode { X HEADER; int size; X tabitem btitm[Maxbottom]; X} Xbtabnode, *btabptr; X Xtypedef struct rangenode { X HEADER; int size; X lisitem lwb, upb; X} Xrangenode, *rangeptr; X X#define Bnil ((btreeptr) 0) X X#define Flag(pnode) ((pnode)->type) X#define Inner 'i' X#define Bottom 'b' X#define Irange '.' X#define Crange '\'' X X#define Lim(pnode) ((pnode)->len) X#define Minlim(pnode) (Flag(pnode) EQ Inner ? Mininner : Minbottom) X#define Maxlim(pnode) (Flag(pnode) EQ Inner ? Maxinner : Maxbottom) X#define SetRangeLim(pnode) (Size(pnode) EQ Bigsize || Size(pnode) > Maxbottom\ X ? Biglim : Size(pnode)) X X#define Size(pnode) ((pnode)->size) X X#define Ptr(pnode,l) (((innerptr) (pnode))->pnptr[l]) X/* pointer to item in innernode: */ X#define Piitm(pnode,l,w) ((itemptr) (((char*)&(((innerptr) (pnode))->iitm)) + ((l)*(w)))) X/* pointer to item in bottomnode: */ X#define Pbitm(pnode,l,w) ((itemptr) (((char*)&(((bottomptr) (pnode))->bitm)) + ((l)*(w)))) X#define Ichar(pnode,l) (((itexptr) (pnode))->icitm[l]) X#define Bchar(pnode,l) (((btexptr) (pnode))->bcitm[l]) X X#define Lwbval(pnode) (((rangeptr) (pnode))->lwb) X#define Upbval(pnode) (((rangeptr) (pnode))->upb) X#define Lwbchar(pnode) (Bchar(Root(Lwbval(pnode)), 0)) X#define Upbchar(pnode) (Bchar(Root(Upbval(pnode)), 0)) X X#define Maxheight 20 /* should be some function of B */ X X/* Procedure merge(); */ X /* btreeptr pleft; itemptr pitm; btreeptr pright; literal it; */ Xbool rebalance(); X /* btreeptr *pptr1; itemptr pitm; btreeptr pptr2; X intlet minlim, maxlim; literal it; */ X/* Procedure restore_child(); */ X /* btreeptr pparent; intlet ichild, minl, maxl; literal it; */ Xbool inodeinsert(); X /* btreeptr pnode, *pptr; itemptr pitm; intlet at; literal it; */ Xbool bnodeinsert(); X /* btreeptr pnode, *pptr; itemptr pitm; intlet at; literal it; */ Xbool i_search(); X /* btreeptr pnode; value key; intlet *pl; width iw; */ Xbool b_search(); X /* btreeptr pnode; value key; intlet *pl; width iw; */ X X/*********************************************************************/ X/* texts only (mbte.c) */ X/*********************************************************************/ X Xbtreeptr trimbtextnode(); /* btreeptr pnode, intlet from,to */ Xbtreeptr trimitextnode(); /* btreeptr pnode, intlet from,to */ Xbool join_itm(); X /* btreeptr pnode, *pptr; itemptr pitm; bool after */ X X/*********************************************************************/ X/* lists only (mbli.c) */ X/*********************************************************************/ X Xbtreeptr spawncrangenode(); /* value lwb, upb */ X/* Procedure set_size_and_lim(); */ /* btreeptr pnode */ X/* PRrocedure ir_to_bottomnode(); */ /* btreeptr *pptr; */ Xbool ins_itm(); X /* btreeptr *pptr1; itemptr pitm; btreeptr *pptr2; literal it; */ X/* Procedure rem_greatest(); */ X /* btreeptr *pptr; itemptr prepl_itm; literal it; */ Xbool rem_itm(); X /* btreeptr *pptr1; itemptr pitm; X itemptr p_insitm; btreeptr *pptr2; bool *psplit; X literal it; */ X X/*********************************************************************/ X/* tables only (mbla.c) */ X/*********************************************************************/ X Xbool rpl_itm(); X /* btreeptr *pptr1, *pptr2; itemptr pitm; bool *p_added */ Xbool del_itm(); X /* btreeptr *pptr1; itemptr pitm */ Xvalue assocval(); /* btreeptr pnode; value key; */ Xbool assocloc(); X /* value **ploc; btreeptr pnode; value key; */ Xbool u_assoc(); /* btreeptr pnode; value key; */ X X/***************** Texts, lists and tables ********************/ X/* Procedure move_itm(); */ /* itemptr pdes, psrc; literal it; */ Xbool get_th_item(); /* itemptr pitm; value num, v; */ X X/* Private definitions for grabbing and ref count scheme */ X Xbtreeptr grabbtreenode(); /* literal flag, it */ Xbtreeptr copybtree(); /* btreeptr pnode */ X/* Procedure uniqlbtreenode(); */ /* btreeptr *pptr; literal it */ Xbtreeptr ccopybtreenode(); /* btreeptr pnode; literal it */ Xbtreeptr mknewroot(); X /* btreeptr ptr0, itemptr pitm0, btreeptr ptr1, literal it */ X/* Procedure relbtree(); */ /* btreeptr pnode; literal it */ X/* Procedure freebtreenode(); */ /* btreeptr pnode; */ END_OF_FILE if test 7434 -ne `wc -c <'abc/btr/i1btr.h'`; then echo shar: \"'abc/btr/i1btr.h'\" unpacked with wrong size! fi # end of 'abc/btr/i1btr.h' fi if test -f 'abc/tc/termcap.c' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'abc/tc/termcap.c'\" else echo shar: Extracting \"'abc/tc/termcap.c'\" \(6705 characters\) sed "s/^X//" >'abc/tc/termcap.c' <<'END_OF_FILE' X#define BUFSIZ 1024 X#define MAXHOP 32 /* max number of tc= indirections */ X#define E_TERMCAP "/etc/termcap" X X#include X/* X * termcap - routines for dealing with the terminal capability data base X * X * BUG: Should use a "last" pointer in tbuf, so that searching X * for capabilities alphabetically would not be a n**2/2 X * process when large numbers of capabilities are given. X * Note: If we add a last pointer now we will screw up the X * tc capability. We really should compile termcap. X * X * Essentially all the work here is scanning and decoding escapes X * in string capabilities. We don't use stdio because the editor X * doesn't, and because living w/o it is not hard. X */ X Xstatic char *tbuf; Xstatic int hopcount; /* detect infinite loops in termcap, init 0 */ Xchar *tskip(); Xchar *tgetstr(); Xchar *tdecode(); Xchar *getenv(); X X/* X * Get an entry for terminal name in buffer bp, X * from the termcap file. Parse is very rudimentary; X * we just notice escaped newlines. X */ Xtgetent(bp, name) X char *bp, *name; X{ X register char *cp; X register int c; X register int i = 0, cnt = 0; X char ibuf[BUFSIZ]; X char *cp2; X int tf; X X tbuf = bp; X tf = 0; X#ifndef V6 X cp = getenv("TERMCAP"); X /* X * TERMCAP can have one of two things in it. It can be the X * name of a file to use instead of /etc/termcap. In this X * case it better start with a "/". Or it can be an entry to X * use so we don't have to read the file. In this case it X * has to already have the newlines crunched out. X */ X if (cp && *cp) { X if (*cp!='/') { X cp2 = getenv("TERM"); X if (cp2==(char *) 0 || strcmp(name,cp2)==0) { X strcpy(bp,cp); X return(tnchktc()); X } else { X tf = open(E_TERMCAP, 0); X } X } else X tf = open(cp, 0); X } X if (tf==0) X tf = open(E_TERMCAP, 0); X#else X tf = open(E_TERMCAP, 0); X#endif X if (tf < 0) X return (-1); X for (;;) { X cp = bp; X for (;;) { X if (i == cnt) { X cnt = read(tf, ibuf, BUFSIZ); X if (cnt <= 0) { X close(tf); X return (0); X } X i = 0; X } X c = ibuf[i++]; X if (c == '\n') { X if (cp > bp && cp[-1] == '\\'){ X cp--; X continue; X } X break; X } X if (cp >= bp+BUFSIZ) { X write(2,"Termcap entry too long\n", 23); X break; X } else X *cp++ = c; X } X *cp = 0; X X /* X * The real work for the match. X */ X if (tnamatch(name)) { X close(tf); X return(tnchktc()); X } X } X} X X/* X * tnchktc: check the last entry, see if it's tc=xxx. If so, X * recursively find xxx and append that entry (minus the names) X * to take the place of the tc=xxx entry. This allows termcap X * entries to say "like an HP2621 but doesn't turn on the labels". X * Note that this works because of the left to right scan. X */ Xtnchktc() X{ X register char *p, *q; X char tcname[16]; /* name of similar terminal */ X char tcbuf[BUFSIZ]; X char *holdtbuf = tbuf; X int l; X X p = tbuf + strlen(tbuf) - 2; /* before the last colon */ X while (*--p != ':') X if (p MAXHOP) { X write(2, "Infinite tc= loop\n", 18); X return (0); X } X if (tgetent(tcbuf, tcname) != 1) X return(0); X for (q=tcbuf; *q != ':'; q++) X ; X l = p - holdtbuf + strlen(q); X if (l > BUFSIZ) { X write(2, "Termcap entry too long\n", 23); X q[BUFSIZ - (p-tbuf)] = 0; X } X strcpy(p, q+1); X tbuf = holdtbuf; X return(1); X} X X/* X * Tnamatch deals with name matching. The first field of the termcap X * entry is a sequence of names separated by |'s, so we compare X * against each such name. The normal : terminator after the last X * name (before the first field) stops us. X */ Xtnamatch(np) X char *np; X{ X register char *Np, *Bp; X X Bp = tbuf; X if (*Bp == '#') X return(0); X for (;;) { X for (Np = np; *Np && *Bp == *Np; Bp++, Np++) X continue; X if (*Np == 0 && (*Bp == '|' || *Bp == ':' || *Bp == 0)) X return (1); X while (*Bp && *Bp != ':' && *Bp != '|') X Bp++; X if (*Bp == 0 || *Bp == ':') X return (0); X Bp++; X } X} X X/* X * Skip to the next field. Notice that this is very dumb, not X * knowing about \: escapes or any such. If necessary, :'s can be put X * into the termcap file in octal. X */ Xstatic char * Xtskip(bp) X register char *bp; X{ X X while (*bp && *bp != ':') X bp++; X if (*bp == ':') X bp++; X return (bp); X} X X/* X * Return the (numeric) option id. X * Numeric options look like X * li#80 X * i.e. the option string is separated from the numeric value by X * a # character. If the option is not found we return -1. X * Note that we handle octal numbers beginning with 0. X */ Xtgetnum(id) X char *id; X{ X register int i, base; X register char *bp = tbuf; X X for (;;) { X bp = tskip(bp); X if (*bp == 0) X return (-1); X if (*bp++ != id[0] || *bp == 0 || *bp++ != id[1]) X continue; X if (*bp == '@') X return(-1); X if (*bp != '#') X continue; X bp++; X base = 10; X if (*bp == '0') X base = 8; X i = 0; X while (isdigit(*bp)) X i *= base, i += *bp++ - '0'; X return (i); X } X} X X/* X * Handle a flag option. X * Flag options are given "naked", i.e. followed by a : or the end X * of the buffer. Return 1 if we find the option, or 0 if it is X * not given. X */ Xtgetflag(id) X char *id; X{ X register char *bp = tbuf; X X for (;;) { X bp = tskip(bp); X if (!*bp) X return (0); X if (*bp++ == id[0] && *bp != 0 && *bp++ == id[1]) { X if (!*bp || *bp == ':') X return (1); X else if (*bp == '@') X return(0); X } X } X} X X/* X * Get a string valued option. X * These are given as X * cl=^Z X * Much decoding is done on the strings, and the strings are X * placed in area, which is a ref parameter which is updated. X * No checking on area overflow. X */ Xchar * Xtgetstr(id, area) X char *id, **area; X{ X register char *bp = tbuf; X X for (;;) { X bp = tskip(bp); X if (!*bp) X return (0); X if (*bp++ != id[0] || *bp == 0 || *bp++ != id[1]) X continue; X if (*bp == '@') X return(0); X if (*bp != '=') X continue; X bp++; X return (tdecode(bp, area)); X } X} X X/* X * Tdecode does the grung work to decode the X * string capability escapes. X */ Xstatic char * Xtdecode(str, area) X register char *str; X char **area; X{ X register char *cp; X register int c; X register char *dp; X int i; X X cp = *area; X while ((c = *str++) && c != ':') { X switch (c) { X X case '^': X c = *str++ & 037; X break; X X case '\\': X dp = "E\033^^\\\\::n\nr\rt\tb\bf\f"; X c = *str++; Xnextc: X if (*dp++ == c) { X c = *dp++; X break; X } X dp++; X if (*dp) X goto nextc; X if (isdigit(c)) { X c -= '0', i = 2; X do X c <<= 3, c |= *str++ - '0'; X while (--i && isdigit(*str)); X } X break; X } X *cp++ = c; X } X *cp++ = 0; X str = *area; X *area = cp; X return (str); X} END_OF_FILE if test 6705 -ne `wc -c <'abc/tc/termcap.c'`; then echo shar: \"'abc/tc/termcap.c'\" unpacked with wrong size! fi # end of 'abc/tc/termcap.c' fi echo shar: End of archive 19 \(of 25\). cp /dev/null ark19isdone MISSING="" for I in 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 ; do if test ! -f ark${I}isdone ; then MISSING="${MISSING} ${I}" fi done if test "${MISSING}" = "" ; then echo You have unpacked all 25 archives. rm -f ark[1-9]isdone ark[1-9][0-9]isdone else echo You still must unpack the following archives: echo " " ${MISSING} fi exit 0 # Just in case...