BSD 4_3 development

Work on file usr/contrib/B/src/bed/ins2.c
Work on file usr/contrib/B/src/bed/inse.c
Work on file usr/contrib/B/src/bed/lexi.c
Work on file usr/contrib/B/src/bed/line.c
Work on file usr/contrib/B/src/bed/main.c
Work on file usr/contrib/B/src/bed/move.c
Work on file usr/contrib/B/src/bed/node.c
Work on file usr/contrib/B/src/bed/outp.c
Work on file usr/contrib/B/src/bed/que1.c
Work on file usr/contrib/B/src/bed/que2.c
Work on file usr/contrib/B/src/bed/save.c
Work on file usr/contrib/B/src/bed/scrn.c
Work on file usr/contrib/B/src/bed/spos.c
Work on file usr/contrib/B/src/bed/sugg.c
Work on file usr/contrib/B/src/bed/supr.c
Work on file usr/contrib/B/src/bed/term.c
Work on file usr/contrib/B/src/bed/unix.c
Work on file usr/contrib/B/src/bed/wide.c
Work on file usr/contrib/B/src/bed/mkboot.c
Work on file usr/contrib/B/src/bed/tabl.c

Synthesized-from: CSRG/cd1/4.3

diff --git a/usr/contrib/B/src/bed/ins2.c b/usr/contrib/B/src/bed/ins2.c
new file mode 100644 (file)
index 0000000..ae9b822
--- /dev/null
+++ b/usr/contrib/B/src/bed/ins2.c
@@ -0,0 +1,344 @@
+/* Copyright (c) Stichting Mathematisch Centrum, Amsterdam, 1984. */
+static char rcsid[] = "$Header: ins2.c,v 2.4 84/10/26 12:08:24 guido Exp $";
+
+/*
+ * B editor -- Insert characters from keyboard.
+ */
+
+#include "b.h"
+#include "bobj.h"
+#include "node.h"
+#include "supr.h"
+#include "queu.h"
+#include "gram.h"
+#include "tabl.h"
+
+
+/*
+ * Insert a character.
+ */
+
+Visible bool
+ins_char(ep, c, alt_c)
+       register environ *ep;
+       int c;
+       int alt_c;
+{
+       auto queue q = Qnil;
+       auto queue qf = Qnil;
+       auto value copyout();
+       auto string str;
+       char buf[2];
+       int where;
+       bool spwhere;
+
+       higher(ep);
+       shrink(ep);
+       if (index("({[`'\"", c) && !ishole(ep)) {
+               /* Surround something.  Wonder what will happen! */
+               qf = (queue) copyout(ep);
+               if (!delbody(ep)) {
+                       qrelease(qf);
+                       return No;
+               }
+       }
+       fixit(ep);
+       ep->changed = Yes;
+       buf[0] = c;
+       buf[1] = 0;
+       if (!ins_string(ep, buf, &q, alt_c))
+               return No;
+       if (!emptyqueue(q) || !emptyqueue(qf)) {
+               /* Slight variation on app_queue */
+               if (!emptyqueue(qf) && emptyqueue(q))
+                       ritevhole(ep); /* Wizardry.  Why does this work? */
+               spwhere = ep->spflag;
+               ep->spflag = No;
+               where = focoffset(ep);
+               markpath(&ep->focus, 1);
+               ep->spflag = spwhere;
+               if (ep->mode == FHOLE && ep->s2 > 0) {
+                       /* If we just caused a suggestion, insert the remains
+                          after the suggested text, not after its first character. */
+                       str = "";
+                       if (!soften(ep, &str, 0)) {
+                               ep->mode = ATEND;
+                               leftvhole(ep);
+                               if (symbol(tree(ep->focus)) == Hole) {
+                                       ep->mode = ATBEGIN;
+                                       leftvhole(ep);
+                               }
+                       }
+               }
+               if (!emptyqueue(q)) { /* Re-insert stuff queued by ins_string */
+                       if (!ins_queue(ep, &q, &q))
+                               return No;
+                       where += spwhere;
+                       spwhere = No;
+               }
+               if (!emptyqueue(qf)) { /* Re-insert deleted old focus */
+                       firstmarked(&ep->focus, 1) || Abort();
+                       fixfocus(ep, where);
+                       if (!ins_queue(ep, &qf, &qf))
+                               return No;
+               }
+               firstmarked(&ep->focus, 1) || Abort();
+               unmkpath(&ep->focus, 1);
+               ep->spflag = No;
+               fixfocus(ep, where + spwhere);
+       }
+       return Yes;
+}
+
+
+/*
+ * Insert a newline.
+ */
+
+Visible bool
+ins_newline(ep)
+       register environ *ep;
+{
+       register node n;
+       register int sym;
+       auto bool mayindent;
+
+       ep->changed = Yes;
+       if (!fiddle(ep, &mayindent))
+               return No;
+       for (;;) {
+               switch (ep->mode) {
+
+               case VHOLE:
+                       ep->mode = ATEND;
+                       continue;
+
+               case FHOLE:
+                       ep->s2 = lenitem(ep);
+                       if (!fix_move(ep))
+                               return No;
+                       continue;
+
+               case ATEND:
+                       if (!joinstring(&ep->focus, "\n", No, 0, mayindent)) {
+                               if (!move_on(ep))
+                                       return No;
+                               continue;
+                       }
+                       s_downi(ep, 2);
+                       s_downi(ep, 1);
+                       ep->mode = WHOLE;
+                       Assert((sym = symbol(tree(ep->focus))) == Hole || sym == Optional);
+                       return Yes;
+
+               case ATBEGIN:
+                       n = tree(ep->focus);
+                       if (Type(n) == Tex) {
+                               ep->mode = ATEND;
+                               continue;
+                       }
+                       sym = symbol(n);
+                       if (sym == Hole || sym == Optional) {
+                               ep->mode = WHOLE;
+                               continue;
+                       }
+                       n = nodecopy(n);
+                       if (!fitstring(&ep->focus, "\n", 0)) {
+                               if (!down(&ep->focus))
+                                       ep->mode = ATEND;
+                               noderelease(n);
+                               continue;
+                       }
+                       s_downrite(ep);
+                       if (fitnode(&ep->focus, n)) {
+                               noderelease(n);
+                               s_up(ep);
+                               s_down(ep);
+                               ep->mode = WHOLE;
+                               return Yes;
+                       }
+                       s_up(ep);
+                       s_down(ep);
+                       if (!fitnode(&ep->focus, n)) {
+                               noderelease(n);
+#ifndef NDEBUG
+                               debug("[Sorry, I don't see how to insert a newline here]");
+#endif NDEBUG
+                               return No;
+                       }
+                       noderelease(n);
+                       ep->mode = ATBEGIN;
+                       return Yes;
+
+               case WHOLE:
+                       Assert((sym = symbol(tree(ep->focus))) == Hole || sym == Optional);
+                       if (!fitstring(&ep->focus, "\n", 0)) {
+                               ep->mode = ATEND;
+                               continue;
+                       }
+                       s_downi(ep, 1);
+                       Assert((sym = symbol(tree(ep->focus))) == Hole || sym == Optional);
+                       ep->mode = WHOLE;
+                       return Yes;
+
+               default:
+                       Abort();
+
+               }
+       }
+}
+
+
+/*
+ * Refinement for ins_newline() to do the initial processing.
+ */
+
+Hidden bool
+fiddle(ep, pmayindent)
+       register environ *ep;
+       bool *pmayindent;
+{
+       register int level;
+       auto string str = "";
+
+       higher(ep);
+       while (rnarrow(ep))
+               ;
+       fixit(ep);
+       soften(ep, &str, 0);
+       higher(ep);
+       *pmayindent = Yes;
+       if (atdedent(ep)) {
+               *pmayindent = No;
+               s_up(ep);
+               level = Level(ep->focus);
+               delfocus(&ep->focus);
+               if (symbol(tree(ep->focus)) == Hole) {
+                       if (hackhack(ep))
+                               return Yes;
+               }
+               while (Level(ep->focus) >= level) {
+                       if (!nexthole(ep)) {
+                               ep->mode = ATEND;
+                               break;
+                       }
+               }
+               if (ep->mode == ATEND) {
+                       leftvhole(ep);
+                       ep->mode = ATEND;
+                       while (Level(ep->focus) >= level) {
+                               if (!up(&ep->focus))
+                                       return No;
+                       }
+               }
+               return Yes;
+       }
+       return Yes;
+}
+
+
+/*
+ * "Hier komen de houthakkers."
+ *
+ * Incredibly ugly hack to delete a join whose second child begins with \n,
+ * such as a suite after an IF, FOR or WHILE or  unit heading.
+ * Inspects the parent node.
+ * If this has rp[0] ands rp[1] both empty, replace it by its first child.
+ * (caller assures this makes sense).
+ * Return Yes if this happened AND rp[1] contained a \t.
+ */
+
+Hidden Procedure
+hackhack(ep)
+       environ *ep;
+{
+       node n;
+       int ich = ichild(ep->focus);
+       string *rp;
+
+       if (!up(&ep->focus))
+               return No;
+       higher(ep);
+       rp = noderepr(tree(ep->focus));
+       if (!Fw_zero(rp[0]) || !Fw_zero(rp[1])) {
+               s_downi(ep, ich);
+               return No;
+       }
+       n = nodecopy(firstchild(tree(ep->focus)));
+       delfocus(&ep->focus);
+       replace(&ep->focus, n);
+       ep->mode = ATEND;
+       return rp[1] && rp[1][0] == '\t';
+}
+       
+
+/*
+ * Refinement for fiddle() to find out whether we are at a possible
+ * decrease-indentation position.
+ */
+
+Hidden bool
+atdedent(ep)
+       register environ *ep;
+{
+       register path pa;
+       register node npa;
+       register int i;
+       register int sym = symbol(tree(ep->focus));
+
+       if (sym != Hole && sym != Optional)
+               return No;
+       if (ichild(ep->focus) != 1)
+               return No;
+       switch (ep->mode) {
+       case FHOLE:
+               if (ep->s1 != 1 || ep->s2 != 0)
+                       return No;
+               break;
+       case ATBEGIN:
+       case WHOLE:
+       case SUBSET:
+               break;
+       default:
+               return No;
+       }
+       pa = parent(ep->focus);
+       if (!pa)
+               return No;
+       npa = tree(pa);
+       if (fwidth(noderepr(npa)[0]) >= 0)
+               return No;
+       for (i = nchildren(npa); i > 1; --i) {
+               sym = symbol(child(npa, i));
+               if (sym != Hole && sym != Optional)
+                       return No;
+       }
+       return Yes; /* Sigh! */
+}
+
+/*
+ * Refinement for ins_node() and fiddle() to find the next hole,
+ * skipping blank space only.
+ */
+
+Hidden bool
+nexthole(ep)
+       register environ *ep;
+{
+       register node n;
+       register int ich;
+       register string repr;
+
+       do {
+               ich = ichild(ep->focus);
+               if (!up(&ep->focus))
+                       return No;
+               higher(ep);
+               n = tree(ep->focus);
+               repr = noderepr(n)[ich];
+               if (!Fw_zero(repr) && !allspaces(repr))
+                       return No;
+       } while (ich >= nchildren(n));
+       s_downi(ep, ich+1);
+       return Yes;
+}

diff --git a/usr/contrib/B/src/bed/inse.c b/usr/contrib/B/src/bed/inse.c
new file mode 100644 (file)
index 0000000..ec404c7
--- /dev/null
+++ b/usr/contrib/B/src/bed/inse.c
@@ -0,0 +1,343 @@
+/* Copyright (c) Stichting Mathematisch Centrum, Amsterdam, 1984. */
+static char rcsid[] = "$Header: inse.c,v 2.4 85/02/14 13:27:09 timo Exp $";
+
+/*
+ * Subroutines (refinements) for ins_string() (see que2.c).
+ */
+
+#include "b.h"
+#include "feat.h"
+#include "bobj.h"
+#include "node.h"
+#include "gram.h"
+#include "supr.h"
+#include "tabl.h"
+
+#include <ctype.h>
+
+
+/*
+ * Try to insert the character c in the focus *pp.
+ */
+
+Visible bool
+insguess(pp, c, ep)
+       path *pp;
+       char c;
+       environ *ep;
+{
+       path pa = parent(*pp);
+       node n;
+       int sympa = pa ? symbol(tree(pa)) : Rootsymbol;
+       int ich = ichild(*pp);
+       struct classinfo *ci = table[sympa].r_class[ich-1];
+       classptr cp;
+       string *rp;
+       int code = Code(c);
+       int sym;
+       char buf[2];
+
+#ifdef USERSUGG
+       if (isinclass(Suggestion, ci)) {
+               if (setsugg(pp, c, ep))
+                       return Yes;
+       }
+#endif USERSUGG
+       for (cp = ci->c_insert; *cp; cp += 2) {
+               if (cp[0] == code)
+                       break;
+       }
+       if (!*cp)
+               return No;
+       sym = cp[1];
+       if (sym >= LEXICAL) {
+               buf[0] = c;
+               buf[1] = 0;
+               replace(pp, (node) mk_text(buf));
+               ep->mode = VHOLE;
+               ep->s1 = 2*ich;
+               ep->s2 = 1;
+               return Yes;
+       }
+       Assert(sym < TABLEN);
+       rp = table[sym].r_repr;
+       n = table[sym].r_node;
+       if (Fw_zero(rp[0])) {
+               buf[0] = c;
+               buf[1] = 0;
+               setchild(&n, 1, (node) mk_text(buf));
+               replace(pp, n);
+               ep->mode = VHOLE;
+               ep->s1 = 2;
+               ep->s2 = 1;
+               return Yes;
+       }
+       replace(pp, n);
+       if (c == '\n' || c == '\r') {
+               ep->mode = SUBSET;
+               ep->s1 = ep->s2 = 2;
+       }
+       else {
+               ep->mode = FHOLE;
+               ep->s1 = 1;
+               ep->s2 = 1;
+       }
+       return Yes;
+}
+
+
+/*
+ * Test whether character `c' may be inserted in position `s2' in
+ * child `ich' of node `n'; that child must be a Text.
+ */
+
+Visible bool
+mayinsert(n, ich, s2, c)
+       node n;
+       int ich;
+       int s2;
+       register char c;
+{
+       int sympa = symbol(n);
+       struct classinfo *ci;
+       register classptr cp;
+       register value v = (value) child(n, ich);
+       register char c1;
+       bool maycontinue();
+       bool maystart();
+       register bool (*fun1)() = s2 > 0 ? maystart : maycontinue;
+       register bool (*fun)() = s2 > 0 ? maycontinue : maystart;
+
+       Assert(v && v->type == Tex);
+       Assert(sympa > 0 && sympa < TABLEN);
+       ci = table[sympa].r_class[ich-1];
+       Assert(ci && ci->c_class);
+       c1 = Str(v)[0];
+       for (cp = ci->c_class; *cp; ++cp) {
+               if (*cp >= LEXICAL && (*fun1)(c1, *cp)) {
+                       if ((*fun)(c, *cp))
+                               return Yes;
+               }
+       }
+       return No;
+}
+
+
+/*
+ * Change a Fixed into a Variable node, given a string pointer variable
+ * which contains the next characters to be inserted.
+ * If the change is not appropriate, No is returned.
+ * Otherwise, as many (though maybe zero) characters from the string
+ * as possible will have been incorporated in the string node.
+ */
+
+Visible bool
+soften(ep, pstr, alt_c)
+       environ *ep;
+       string *pstr;
+       int alt_c;
+{
+       path pa = parent(ep->focus);
+       node n;
+       int sympa = pa ? symbol(tree(pa)) : Rootsymbol;
+       struct classinfo *ci;
+       register classptr cp;
+       register int code;
+       string repr;
+       register struct table *tp;
+       char buf[1024];
+
+       if (ep->mode == VHOLE && (ep->s1&1))
+               ep->mode = FHOLE;
+       if (ep->mode != FHOLE || ep->s1 != 1 || ep->s2 <= 0 || !issuggestion(ep))
+               return No;
+       n = tree(ep->focus);
+       repr = noderepr(n)[0];
+       if (!repr || !isupper(repr[0]))
+               return No;
+       code = Code(repr[0]);
+       ci = table[sympa].r_class[ichild(ep->focus) - 1];
+       n = Nnil;
+       for (cp = ci->c_insert; *cp; cp += 2) {
+               if (cp[0] != code)
+                       continue;
+               if (cp[1] >= TABLEN)
+                       continue;
+               tp = &table[cp[1]];
+               if (Fw_zero(tp->r_repr[0])) {
+                       Assert(tp->r_class[0]->c_class[0] >= LEXICAL);
+                       n = tp->r_node;
+                       break;
+               }
+       }
+       if (!n)
+               return No;
+       strncpy(buf, repr, ep->s2);
+       buf[ep->s2] = 0;
+       setchild(&n, 1, (node) mk_text(buf));
+       if (!mayinsert(n, 1, ep->s2, repr[ep->s2])) {
+               if (!**pstr || !mayinsert(n, 1, ep->s2, **pstr)
+                       && (!alt_c || !mayinsert(n, 1, ep->s2, alt_c))) {
+                       noderelease(n); /* Don't forget! */
+                       return No;
+               }
+       }
+       if (**pstr && mayinsert(n, 1, ep->s2, **pstr)) {
+               do {
+                       buf[ep->s2] = **pstr;
+                       ++*pstr;
+                       ++ep->s2;
+               } while (ep->s2 < sizeof buf - 1 && **pstr
+                               && mayinsert(n, 1, ep->s2, **pstr));
+               buf[ep->s2] = 0;
+               setchild(&n, 1, (node) mk_text(buf));
+       }
+       replace(&ep->focus, n);
+       ep->mode = VHOLE;
+       ep->s1 = 2;
+       return Yes;
+}
+
+
+/*
+ * Renew suggestion, or advance in old suggestion.
+ * Return Yes if *pstr has been advanced.
+ */
+
+Visible bool
+resuggest(ep, pstr, alt_c)
+       environ *ep;
+       string *pstr;
+       int alt_c;
+{
+       struct table *tp;
+       struct classinfo *ci;
+       classptr cp;
+       path pa;
+       node nn;
+       node n = tree(ep->focus);
+       register string *oldrp = noderepr(n);
+       register int ich = ep->s1/2;
+       register string str = oldrp[ich];
+       int oldsym = symbol(n);
+       int childsym[MAXCHILD];
+       string *newrp;
+       int sympa;
+       register int sym;
+       int symfound = -1;
+       register int i;
+       int code;
+       char buf[15]; /* Should be sufficient for all fixed texts */
+       bool ok;
+       bool anyok = No;
+
+       if (!str || !**pstr || !issuggestion(ep))
+               return No;
+       /***** Change this if commands can be prefixes of others! *****/
+       /***** Well, they can!
+       if (!c)
+               return No;
+               *****/
+       if (ich > 0 && ifmatch(ep, pstr, str, alt_c))
+               /* Shortcut: sec. keyword, exact match will do just fine */
+               return Yes;
+       if (ep->s2 <= 0 || Fw_zero(oldrp[0]))
+               return No;
+       if (**pstr != ' ' && !isupper(**pstr)
+               && !alt_c && **pstr != '"' && **pstr != '\'')
+               /* Shortcut: not a keyword, must match exactly */
+               return ifmatch(ep, pstr, str, alt_c);
+       for (i = 0; i < ich; ++i) { /* Preset some stuff for main loop */
+               if (!oldrp[i])
+                       oldrp[i] = "";
+               childsym[i] = symbol(child(n, i+1));
+       }
+       Assert(ep->s2 + 1 < sizeof buf);
+       strcpy(buf, oldrp[ich]);
+       buf[ep->s2] = alt_c ? alt_c : **pstr;
+       buf[ep->s2 + 1] = 0;
+       pa = parent(ep->focus);
+       sympa = pa ? symbol(tree(pa)) : Rootsymbol;
+       ci = table[sympa].r_class[ichild(ep->focus) - 1];
+       code = Code(oldrp[0][0]);
+
+       for (cp = ci->c_insert; *cp; cp += 2) {
+               if (cp[0] != code)
+                       continue;
+               sym = cp[1];
+               if (sym >= TABLEN)
+                       continue;
+               if (sym == oldsym) {
+                       anyok = Yes;
+                       continue;
+               }
+               tp = &table[sym];
+               newrp = tp->r_repr;
+               ok = Yes;
+               for (i = 0; i < ich; ++i) {
+                       str = newrp[i];
+                       if (!str)
+                               str = "";
+                       if (!Strequ(str, oldrp[i])
+                               || childsym[i] != Optional && childsym[i] != Hole
+                                       && !isinclass(childsym[i], tp->r_class[i])) {
+                               ok = No;
+                               break;
+                       }
+               }
+               if (!ok)
+                       continue;
+               str = newrp[i];
+               if (!str || !Strnequ(str, buf, ep->s2+1))
+                       continue;
+               if (anyok) {
+                       if (Strequ(str, oldrp[ich]))
+                               continue; /* Same as it was: no new suggestion */
+                       symfound = sym;
+                       break;
+               }
+               else if (symfound < 0 && !Strequ(str, oldrp[ich]))
+                       symfound = sym;
+       }
+
+       if (symfound < 0)
+               return ifmatch(ep, pstr, oldrp[ich], alt_c);
+       nn = table[symfound].r_node;
+       for (i = 1; i <= ich; ++i) { /* Copy children to the left of the focus */
+               sym = symbol(child(n, i));
+               if (sym == Optional || sym == Hole)
+                       continue;
+               setchild(&nn, i, nodecopy(child(n, i)));
+       }
+       replace(&ep->focus, nn);
+       str = newrp[ich];
+       do { /* Find easy continuation */
+               ++ep->s2;
+               ++*pstr;
+       } while (**pstr && **pstr == str[ep->s2]);
+       return Yes;
+}
+
+
+/*
+ * Refinement for resuggest(): see if there is a match, and if so, find
+ * longest match.
+ */
+
+Hidden bool
+ifmatch(ep, pstr, str, alt_c)
+       register environ *ep;
+       register string *pstr;
+       register string str;
+       register int alt_c;
+{
+       register int c = str[ep->s2];
+
+       if (c != **pstr && (!alt_c || c != alt_c))
+               return No;
+       do {
+               ++ep->s2;
+               ++*pstr;
+       } while (**pstr && **pstr == str[ep->s2]);
+       return Yes;
+}

diff --git a/usr/contrib/B/src/bed/lexi.c b/usr/contrib/B/src/bed/lexi.c
new file mode 100644 (file)
index 0000000..880ea6f
--- /dev/null
+++ b/usr/contrib/B/src/bed/lexi.c
@@ -0,0 +1,87 @@
+/* Copyright (c) Stichting Mathematisch Centrum, Amsterdam, 1984. */
+static char rcsid[] = "$Header: lexi.c,v 2.4 84/10/26 12:01:34 guido Exp $";
+
+/*
+ * B editor -- Lexical elements (identifiers, keywords, numbers etc.)
+ */
+
+#include <ctype.h>
+
+#include "b.h"
+#include "bobj.h"
+#include "node.h"
+#include "gram.h"
+
+
+/*
+ * Table defining lexical elements.
+ *
+ * ********** Indexed by (symbol-LEXICAL).
+ */
+
+Hidden char lowercase[] = "0123456789'\"abcdefghijklmnopqrstuvwxyz";
+Hidden char uppercase[] = "0123456789'\"ABCDEFGHIJKLMNOPQRSTUVWXYZ";
+Hidden char digits[] = "0123456789";
+
+Hidden struct {
+       string l_start;
+       string l_continue;
+} chclass[] = {
+       {lowercase+12, lowercase,}, /* IDENT */
+       {uppercase+12, uppercase,}, /* KEYWORD */
+       {digits, digits,}, /* NUMBER */
+       {"\\", "^",}, /* COMMENT */
+       {"^`'", "^`'",}, /* TEXT1 */
+       {"^`\"", "^`\"",}, /* TEXT2 */
+       {".+-*/#^~@|<=>", "",}, /* OPERATORS */
+       {"^", "^",}, /* RAW_INPUT */
+       {"", "",}, /* SUGGESTION (dummy) */
+};
+
+#define NCHCLASS (sizeof(chclass)/sizeof(chclass[0]))
+
+
+/*
+ * Test whether character `c' may start a lexical element with
+ * symbolic name `lex'.
+ */
+
+Visible bool
+maystart(c, lex)
+       char c;
+       int lex;
+{
+       string cp;
+
+       lex -= LEXICAL;
+       Assert(lex >= 0);
+       if (lex >= NCHCLASS || !isascii(c) || c != ' ' && !isprint(c))
+               return No;
+       cp = chclass[lex].l_start;
+       if (*cp == '^')
+               return !index(cp+1, c);
+       return index(cp, c) != 0;
+}
+
+
+/*
+ * Test whether character `c' may continue a lexical element with
+ * symbolic name `lex'.
+ */
+
+Visible bool
+maycontinue(c, lex)
+       char c;
+       int lex;
+{
+       string cp;
+
+       lex -= LEXICAL;
+       Assert(lex >= 0);
+       if (lex >= NCHCLASS || !isascii(c) || c != ' ' && !isprint(c))
+               return No;
+       cp = chclass[lex].l_continue;
+       if (*cp == '^')
+               return !index(cp+1, c);
+       return index(cp, c) != 0;
+}

diff --git a/usr/contrib/B/src/bed/line.c b/usr/contrib/B/src/bed/line.c
new file mode 100644 (file)
index 0000000..fece658
--- /dev/null
+++ b/usr/contrib/B/src/bed/line.c
@@ -0,0 +1,238 @@
+/* Copyright (c) Stichting Mathematisch Centrum, Amsterdam, 1984. */
+static char rcsid[] = "$Header: line.c,v 2.4 85/08/22 16:04:53 timo Exp $";
+
+/*
+ * B editor -- Routines for treating the parse tree as a sequence of lines.
+ *
+ * WARNING: The routines in this file (and many others!) assume that a
+ * `newline' can only occur in the zero'th representation string of a node
+ * (i.e., rp[0]).
+ */
+
+#include "b.h"
+#include "bobj.h"
+#include "node.h"
+#include "gram.h"
+#include "supr.h"
+
+
+/*
+ * Compute equality of subtrees, based on common descent.
+ * Strings are not checked for characterwise equality, but must
+ * be the same pointer; other nodes must have the same symbol and
+ * their children must be equal in this sense (equal pointers are
+ * always used as a shortcut).
+ *
+ * (Used by screen update algorithm only.)
+ */
+
+Visible bool
+eqlines(n1, n2)
+       node n1;
+       node n2;
+{
+       register node nn1;
+       register node nn2;
+       register int w1;
+       register int w2;
+       register int nch;
+       register int i;
+
+       if (n1 == n2)
+               return Yes;
+       if (Type(n1) != Nod || Type(n2) != Nod)
+               return No;
+       if (symbol(n1) != symbol(n2))
+               return No;
+       nch = nchildren(n1);
+       Assert(nch == nchildren(n2));
+       for (i = 1; i <= nch; ++i) {
+               nn1 = child(n1, i);
+               nn2 = child(n2, i);
+               w1 = width(nn1);
+               w2 = width(nn2);
+               if (w1 >= 0 && w2 >= 0) {
+                       if (!eqlines(nn1, nn2))
+                               return No;
+               }
+               else {
+                       if (nn1 == nn2)
+                               return Yes;
+                       if (fwidth(noderepr(nn1)[0]) < 0 || fwidth(noderepr(nn2)[0]) < 0)
+                               return linelen(n1) == linelen(n2);
+                       return eqlines(nn1, nn2);
+               }
+       }
+       return Yes;
+}
+
+
+/*
+ * Compute the length of the line beginning at the current node.
+ */
+ 
+Visible int
+linelen(n)
+       node n;
+{
+       register node nn;
+       register string *rp = noderepr(n);
+       register int w;
+       register int nch = nchildren(n);
+       register int i;
+       register int len = fwidth(rp[0]);
+
+       if (len < 0)
+               len = 0;
+       for (i = 1; i <= nch; ++i) {
+               nn = child(n, i);
+               w = width(nn);
+               if (w >= 0)
+                       len += w;
+               else {
+                       n = nn;
+                       i = 0;
+                       nch = nchildren(n);
+                       rp = noderepr(n);
+               }
+               w = Fwidth(rp[i]);
+               if (w < 0)
+                       break;
+               len += w;
+       }
+       return len;
+}
+
+
+/*
+ * Move the focus to the next line.
+ * NB: This is a building block for use in the 'show' module;
+ * it cannot set ep->mode or call higher() properly!
+ */
+
+Visible bool
+nextline(pp)
+       register path *pp;
+{
+       register node n;
+       register node nn;
+       register int w;
+       register int nch;
+       register int i = 0;
+
+       for (;;) {
+               n = tree(*pp);
+               if (width(n) < 0) {
+                       nch = nchildren(n);
+                       while (++i <= nch) {
+                               nn = child(n, i);
+                               w = width(nn);
+                               if (w < 0) {
+                                       downi(pp, i) || Abort();
+                                       n = tree(*pp);
+                                       if (fwidth(noderepr(n)[0]) < 0)
+                                               return Yes;
+                                       nch = nchildren(n);
+                                       i = 0;
+                               }
+                       }
+               }
+               /* Must go upward in the tree */
+               i = ichild(*pp);
+               if (!up(pp))
+                       return No;
+       }
+}
+
+
+/*
+ * Compute the current line number.  If the current node begins with
+ * a `newline', add one because the first character is actually
+ * on the next line.
+ */
+
+Visible int
+lineno(ep)
+       register environ *ep;
+{
+       register int y;
+
+       y = -focoffset(ep);
+       if (y < 0)
+               y = 0;
+       if (focchar(ep) == '\n')
+               ++y;
+       return y + Ycoord(ep->focus);
+}
+
+/*
+ * Similarly, compute the current column number.
+ * (Hope the abovementioned trick isn't necessary.)
+ */
+
+Visible int
+colno(ep)
+       environ *ep;
+{
+       int x= focoffset(ep);
+
+       if (x < 0)
+               x= 0; /* In fact, give up */
+       return x + Xcoord(ep->focus);
+}
+
+
+/*
+ * Make the focus exactly one line wide (if at all possible).
+ */
+
+Visible Procedure
+oneline(ep)
+       register environ *ep;
+{
+       register node n;
+       node nn;
+       register string *rp;
+       register int s1;
+       register int s2;
+       register int len;
+       int ich;
+       int nch;
+
+       ich = 1;
+       while (width(tree(ep->focus)) >= 0) {
+               ich = ichild(ep->focus);
+               if (!up(&ep->focus)) {
+                       ep->mode = WHOLE;
+                       higher(ep);
+                       return;
+               }
+       }
+       higher(ep);
+       n = tree(ep->focus);
+       nch = nchildren(n);
+       rp = noderepr(n);
+       for (s1 = 2*ich-1; s1 >= 1; --s1) {
+               if (s1&1)
+                       len = fwidth(rp[s1/2]);
+               else {
+                       nn = child(n, s1/2);
+                       len = width(nn);
+               }
+               if (len < 0)
+                       break;
+       }
+       for (s2 = 2*ich+1; s2 <= 2*nch+1; ++s2) {
+               if (s2&1)
+                       len = fwidth(rp[s2/2]);
+               else {
+                       nn = child(n, s2/2);
+                       len = width(nn);
+               }
+               if (len < 0)
+                       break;
+       }
+       ep->mode = SUBSET;
+       ep->s1 = s1+1;
+       ep->s2 = s2-1;
+}

diff --git a/usr/contrib/B/src/bed/main.c b/usr/contrib/B/src/bed/main.c
new file mode 100644 (file)
index 0000000..5d3b13a
--- /dev/null
+++ b/usr/contrib/B/src/bed/main.c
@@ -0,0 +1,239 @@
+/* Copyright (c) Stichting Mathematisch Centrum, Amsterdam, 1984. */
+static char rcsid[] = "$Header: main.c,v 2.5 85/08/22 16:05:00 timo Exp $";
+
+/*
+ * B editor -- Main program (init/exit processing), error handling.
+ */
+
+/*
+ * The B editor is a structured editor for a programming language
+ * for beginners and non-professional computer users.
+ * [L.G.L.T. Meertens: Draft Proposal for the B programming language,
+ * Mathematical Centre, Amsterdam, 1982, ISBN 90 6169 238 2.]
+ * Note that `B' is only a provisional name for the language.
+ * The editor uses a subset of the run-time system for the B
+ * interpreter, so that they may be linked together in a later stage.
+ * Also the sharing strategy of the B run-time routines makes a very
+ * elegant and powerful UNDO-mechanism possible.
+ */
+
+#include "b.h" /* Contains definitions like string, etc. */
+#include "feat.h"
+#include "bobj.h"
+
+
+#ifdef SAVEPOS
+#define SAVEPOSFILE ".Bed_pos" /* Last focus position database */
+#define MAXSAVE 50 /* Maximum number of entries kept in SAVEPOSFILE */
+#endif SAVEPOS
+
+
+/* Command line flags */
+
+bool dflag; /* -d: debugging output wanted */
+
+bool slowterminal;
+       /* -s: the terminal is so slow that long messages are annoying */
+
+bool hushbaby; /* -h: no bells are to be heard */
+
+#ifdef COMMENTED_OUT /* Lower levels don't respond to this */
+bool nostandout; /* -n: inhibit use of standout */
+#endif COMMENTED_OUT
+
+
+/*
+ * Main program -- call module initializations, do some work, 
+ * call module shut-off code, exit.
+ */
+
+Visible Procedure
+main(argc, argv)
+       int argc;
+       string *argv;
+{
+       bool initdone = No;
+       bool status = Yes;
+       int lineno = 0;
+       string arg0 = argv[0];
+       string cp;
+       string filename;
+       extern string malloc();
+
+       cp = rindex(arg0, '/');
+       if (cp)
+               arg0 = cp+1;
+
+       /* Process UNIX command line options */
+       for (; argc > 1 && argv[1][0] == '-'; --argc, ++argv) {
+               switch (argv[1][1]) {
+
+#ifndef NDEBUG
+               case 'd':
+                       dflag = Yes;
+                       break;
+#endif NDEBUG
+
+               case 'h':
+                       hushbaby = Yes;
+                       break;
+
+#ifdef COMMENTED_OUT /* Lower levels don't respond to this */
+               case 'n':
+                       nostandout = Yes;
+                       break;
+#endif COMMENTED_OUT
+
+               case 's':
+                       slowterminal = Yes;
+                       break;
+
+               default:
+                       fprintf(stderr,
+                               "*** Usage: %s [-h] [-s] %s\n",
+                               arg0,
+#ifdef FILEARGS
+                               "[ [+lineno] file ] ...");
+#else !FILEARGS
+                               "");
+#endif !FILEARGS
+                       exit(1);
+
+               }
+       }
+
+       /* Setbuf must be called before any output is produced! */
+       setbuf(stdout, malloc((unsigned)BUFSIZ));
+
+#ifdef FILEARGS
+       for (; status && argc > 1; --argc, ++argv) {
+               if (argv[1][0] == '+') { /* +lineno option */
+                       lineno = atoi(argv[1] + 1);
+               }
+               else {
+                       filename = argv[1];
+                       if (!initdone) {
+                               initall();
+                               initdone = Yes;
+                       }
+                       status = demo(filename, lineno);
+                       lineno = 0;
+               }
+       }
+#endif FILEARGS
+       if (!initdone) {
+#ifdef BTOP
+               initall();
+               mainloop();
+#else BTOP
+#ifndef FILEARGS
+               Deliberate error. You should define at least one of BTOP and FILEARGS;
+#endif !FILEARGS
+               fprintf(stderr, "*** No file edited\n");
+               exit(0);
+#endif BTOP
+       }
+       endall();
+       objstats();
+       if (status)
+               objcheck();
+       else
+               objdump();
+       return !status;
+}
+
+
+/*
+ * Module initializations -- for each module xxxx that needs dynamic
+ * initialization, call a routine named initxxxx.
+ * The order is determined by the inter-module dependencies.
+ * Also note that all terminal- and screen-related initializations are called
+ * indirectly by initterm().
+ */
+
+Hidden Procedure
+initall()
+{
+#ifndef NDEBUG
+       if (dflag)
+               fprintf(stderr, "*** initall();\n\r");
+#endif NDEBUG
+       initfile();
+       initkeys();
+       initgram();
+#ifdef USERSUGG
+       initsugg();
+#endif USERSUGG
+       initunix();
+       initterm();
+}
+
+
+/*
+ * Module shut-off code -- for each module xxxx that needs dynamic
+ * shut-off code (what is the inverse of `initialization'?),
+ * call a routine named endxxxx.
+ * Endall is also called (from module "unix") when a signal or interrupt
+ * causes termination.
+ */
+
+Visible Procedure
+endall()
+{
+       if (dflag)
+               fprintf(stderr, "*** endall();\n\r");
+       endterm();
+       enddemo();
+       endunix();
+       enderro();
+#ifdef USERSUGG
+       endsugg();
+#endif USERSUGG
+}
+
+
+
+/*
+ * System error -- abort the editor with a short error message.
+ * Should only be called for catastrophic, unrecoverable errors
+ * or those that `cannot happen'.
+ */
+
+/* VARARGS 1 */
+Visible Procedure
+syserr(fmt, a1, a2, a3, a4, a5, a6, a7, a8, a9, a10)
+       string fmt;
+{
+#ifdef BTOP
+       termchild();
+#endif BTOP
+       endall();
+       fprintf(stderr, "*** System error: ");
+       fprintf(stderr, fmt, a1, a2, a3, a4, a5, a6, a7, a8, a9, a10);
+       fprintf(stderr, "\n");
+#ifndef NDEBUG
+       fprintf(stderr, "*** Core dump for B guru: ");
+       fflush(stderr);
+       abort();
+#else
+       fflush(stderr);
+       _exit(1);
+#endif
+       /* NOTREACHED */
+}
+
+
+/*
+ * Assertion error.
+ * Call syserr with information about where something was wrong.
+ * (Sorry, WHAT was wrong must be dug out of the core dump.)
+ */
+
+Visible Procedure
+asserr(file, line)
+       string file;
+       int line;
+{
+       syserr("Assertion failed: file %s, line %d", file, line);
+       /* NOTREACHED */
+}

diff --git a/usr/contrib/B/src/bed/mkboot.c b/usr/contrib/B/src/bed/mkboot.c
new file mode 100644 (file)
index 0000000..d1bb8a5
--- /dev/null
+++ b/usr/contrib/B/src/bed/mkboot.c
@@ -0,0 +1,464 @@
+/* Copyright (c) Stichting Mathematisch Centrum, Amsterdam, 1985. */
+static char rcsid[]= "$Header: mkboot.c,v 1.1 85/08/22 15:44:31 timo Exp $";
+
+/*
+ * B editor -- Program to create the "boot.h" file (the grammar tables).
+ */
+
+#include "b.h"
+#include "node.h"
+#include "gram.h"
+#include "tabl.h"
+
+#include <ctype.h>
+
+
+/*
+ * Test whether sym is in the given class.
+ */
+
+Visible bool
+isinclass(sym, ci)
+       int sym;
+       struct classinfo *ci;
+{
+       classptr cp;
+
+       Assert(ci && ci->c_class);
+       if (sym == Hole)
+               return !isinclass(Optional, ci);
+       for (cp = ci->c_class; *cp; ++cp)
+               if (sym == *cp)
+                       return Yes;
+       return No;
+}
+
+
+main()
+{
+       int sym;
+       int nch;
+       struct classinfo **cp;
+       struct classinfo *sp;
+
+       printf("/* boot.h -- data file for grammar tables. */\n\n");
+
+       /* Check the representations.
+          The code assumes Optional and Hole are the last symbols
+          in the table, i.e. the first processed by the loop. */
+
+       for (sym = TABLEN-1; sym >= 0; --sym) {
+               if (table[sym].r_symbol != sym) {
+                       if (sym != Hole && sym != Optional
+                                       && table[sym].r_symbol == 0)
+                               continue; /* Disabled table entry */
+                       syserr("initgram: table order (%s=%d, should be %d)",
+                               table[sym].r_name, table[sym].r_symbol, sym);
+               }
+               cp = table[sym].r_class;
+               for (nch = 0; nch < MAXCHILD && (sp = cp[nch]); ++nch)
+                       ;
+               ckrepr(table[sym].r_repr, nch);
+       }
+
+       initcodes();
+       initclasses();
+       dumptable();
+       exit(0);
+}
+
+
+/*
+ * Check a representation array (subroutine for initgram).
+ */
+
+Hidden Procedure
+ckrepr(rp, nch)
+       string *rp;
+       int nch;
+{
+       string cp;
+       int i;
+       int ich;
+
+       for (ich = 0; ich <= nch; ++ich) {
+               cp = rp[ich];
+               if (!cp)
+                       continue;
+               for (i = 0; cp[i]; ++i) {
+                       switch (cp[i]) {
+                       case '\n':
+                       case '\r':
+                               if (i || ich)
+                                       syserr("initgram (ckrepr): badly placed \\n/\\r");
+                               break;
+                       case '\t':
+                       case '\b':
+                               if (cp[i+1])
+                                       syserr("initgram (ckrepr): badly placed \\t/\\b");
+                               break;
+                       default:
+                               if (cp[i] < ' ' || cp[i] >= 0177)
+                                       syserr("initgram (ckrepr): illegal control char");
+                       }
+               }
+       }
+}
+
+
+/*
+ * Compaction scheme for characters to save space in grammar tables
+ * by combining characters with similar properties (digits, l.c. letters).
+ */
+
+#define RANGE 128 /* ASCII characters are in {0 .. RANGE-1} */
+
+Visible char code_array[RANGE];
+Visible char invcode_array[RANGE];
+Visible int lastcode;
+
+Hidden Procedure
+initcodes()
+{
+       int c;
+
+       code_array['\n'] = ++lastcode;
+       invcode_array[lastcode] = '\n';
+       for (c = ' '; c <= '0'; ++c) {
+               code_array[c] = ++lastcode;
+               invcode_array[lastcode] = c;
+       }
+       for (; c <= '9'; ++c)
+               code_array[c] = lastcode;
+       for (; c <= 'a'; ++c) {
+               code_array[c] = ++lastcode;
+               invcode_array[lastcode] = c;
+       }
+       for (; c <= 'z'; ++c)
+               code_array[c] = lastcode;
+       for (; c < RANGE; ++c) {
+               code_array[c] = ++lastcode;
+               invcode_array[lastcode] = c;
+       }
+}
+
+
+/*
+ * Initialization routine for the 'struct classinfo' stuff.
+ *
+ * "Suggestion" is skipped:
+ * what can be inserted there is not computed from this table.
+ */
+
+Hidden Procedure
+initclasses()
+{
+       int i;
+       int j;
+       struct table *tp;
+
+       for (i = 0; i < TABLEN; ++i) {
+               tp = &table[i];
+               if (tp->r_symbol != i || i == Suggestion)
+                       continue; /* Dead entry */
+               for (j = 0; j < MAXCHILD && tp->r_class[j]; ++j) {
+                       if (!tp->r_class[j]->c_insert)
+                               defclass(tp->r_class[j]);
+               }
+       }
+}
+
+classptr makelist(); /* Forward */
+
+Hidden Procedure
+defclass(p)
+       struct classinfo *p;
+{
+       int c;
+       struct table *tp;
+       classptr cp;
+       classptr cp1;
+       classelem insert[1024];
+       classelem append[1024];
+       classelem join[1024];
+       int inslen = 0;
+       int applen = 0;
+       int joinlen = 0;
+       string *rp;
+       int fw1;
+
+       cp = p->c_class;
+       Assert(cp);
+
+       for (; *cp; ++cp) {
+               if (*cp == Optional)
+                       continue;
+               if (*cp >= TABLEN) { /* Insert direct lexical item */
+                       for (c = 1; c <= lastcode; ++c) {
+                               if (maystart(Invcode(c), *cp)) {
+                                       Assert(inslen+3 < sizeof insert / sizeof insert[0]);
+                                       insert[inslen] = c;
+                                       insert[inslen+1] = *cp;
+                                       inslen += 2;
+                               }
+                       }
+                       continue;
+               }
+               tp = &table[*cp];
+               rp = tp->r_repr;
+               if (!Fw_zero(rp[0])) { /* Insert fixed text */
+                       c = Code(rp[0][0]);
+                       Assert(inslen+3 < sizeof insert / sizeof insert[0]);
+                       insert[inslen] = c;
+                       insert[inslen+1] = *cp;
+                       inslen += 2;
+                       continue;
+               }
+               Assert(tp->r_class[0]);
+               cp1 = tp->r_class[0]->c_class;
+               Assert(cp1);
+               for (; *cp1; ++cp1) {
+                       if (*cp1 < TABLEN)
+                               continue;
+                       for (c = 1; c <= lastcode; ++c) { /* Insert indir. lex. items */
+                               if (maystart(Invcode(c), *cp1)) {
+                                       Assert(inslen+3 < sizeof insert / sizeof insert[0]);
+                                       insert[inslen] = c;
+                                       insert[inslen+1] = *cp;
+                                       inslen += 2;
+                               }
+                       }
+               }
+               fw1 = Fwidth(rp[1]);
+               if (fw1) { /* Append */
+                       c = rp[1][0];
+                       Assert(c > 0 && c < RANGE);
+                       if (c == ' ') {
+                               c = rp[1][1];
+                               if (!c || c == '\b' || c == '\t')
+                                       c = ' ';
+                               else
+                                       c |= 0200;
+                       }
+                       Assert(applen+3 < sizeof append / sizeof append[0]);
+                       append[applen] = c;
+                       append[applen+1] = *cp;
+                       applen += 2;
+               }
+               if ((!fw1 || fw1 == 1 && rp[1][0] == ' ')
+                       && tp->r_class[1]) { /* Join */
+                       Assert(joinlen+3 < sizeof join / sizeof join[0]);
+                       join[joinlen] = 1 + fw1;
+                       join[joinlen+1] = *cp;
+                       joinlen += 2;
+               }
+       }
+
+       Assert(inslen); /* Dead alley */
+       insert[inslen] = 0;
+       p->c_insert = makelist(insert, inslen + 1);
+       if (applen) {
+               append[applen] = 0;
+               p->c_append = makelist(append, applen + 1);
+       }
+       if (joinlen) {
+               join[joinlen] = 0;
+               p->c_join = makelist(join, joinlen + 1);
+       }
+}
+
+Hidden classptr
+makelist(list, len)
+       classptr list;
+       int len;
+{
+       classptr cp =
+               (classptr) malloc((unsigned) (len*sizeof(classelem)));
+       int i;
+
+       if (!cp)
+               syserr("makelist: malloc");
+       for (i = 0; i < len; ++i, ++list)
+               cp[i] = *list;
+#ifndef NDEBUG
+       if (index(cp, '\0') != cp+len-1)
+               printf("makelist: zero in string!\n");
+#endif
+       return cp;
+}
+
+#define MAXLOOKUP 1000
+
+Hidden struct classinfo **known;
+Hidden int nknown;
+
+Hidden Procedure
+dumptable()
+{
+       int sym;
+
+       getclassinfos();
+       printf("Hidden struct table b_grammar[%d] = {\n", TABLEN);
+       for (sym= 0; sym < TABLEN; ++sym)
+               dumpentry(table+sym);
+       printf("};\n");
+       free(known);
+}
+
+Hidden Procedure
+getclassinfos()
+{
+       int sym, k;
+
+       known= (struct classinfo **) malloc(MAXLOOKUP * sizeof(struct classinfo*));
+       if (known == NULL)
+               syserr("getclassinfos: can't malloc 'known' array");
+       nknown= 0;
+       printf("Hidden struct classinfo cl[] = {\n");
+       for (sym= 0; sym < TABLEN; ++sym) {
+               for (k= 0; k < MAXCHILD; ++k)
+                       lookup(table[sym].r_class[k]);
+       }
+       printf("};\n\n");
+}
+
+Hidden int
+lookup(ci)
+       struct classinfo *ci;
+{
+       int k;
+
+       if (ci == NULL)
+               return -1;
+       for (k= 0; k < nknown; ++k) {
+               if (known[k] == ci)
+                       return k;
+       }
+       if (k < MAXLOOKUP) {
+               ++nknown;
+               known[k]= ci;
+               printf("/*%d*/", k);
+               dumpclassinfo(ci);
+       }
+}
+
+Hidden Procedure
+dumpclassinfo(ci)
+       struct classinfo *ci;
+{
+       printf("\t{");
+       dumpstring(ci->c_class);
+       printf("\n\t");
+       dumpstring(ci->c_insert);
+       printf("\n\t");
+       dumpstring(ci->c_append);
+       printf("\n\t");
+       dumpstring(ci->c_join);
+       printf("},\n");
+}
+
+Hidden Procedure
+dumpentry(p)
+       struct table *p;
+{
+       int k;
+
+       printf("\t{%2d, ", p->r_symbol);
+       dumpstring(p->r_name);
+       printf(" {");
+       for (k= 0; k <= MAXCHILD; ++k)
+               dumpstring(p->r_repr[k]);
+       printf("}, {");
+       for (k= 0; k < MAXCHILD; ++k)
+               refclassinfo(p->r_class[k]);
+       printf("}, 0},\n");
+}
+
+Hidden Procedure
+dumpstring(s)
+       string s;
+{
+       char c;
+
+       if (s == NULL) {
+               printf("0, ");
+               return;
+       }
+       printf("\"");
+       for (; (c= *s) != '\0'; ++s) {
+               if (c >= ' ' && c < 0177) {
+                       if (c == '\\' || c == '"')
+                               printf("\\");
+                       printf("%c", c);
+               }
+               else if (c == '\t')
+                       printf("\\t");
+               else if (c == '\b')
+                       printf("\\b");
+               else
+                       printf("\\%03o", c&0377);
+       }
+       printf("\", ");
+}
+
+Hidden Procedure
+refclassinfo(ci)
+       struct classinfo ci;
+{
+       int k= lookup(ci);
+
+       if (k >= 0)
+               printf("&cl[%d], ", k);
+       else
+               printf("0, ");
+}
+
+
+/*
+ * Yield the width of a piece of fixed text as found in a node's repr,
+ * excluding \b or \t.  If \n or \r is found, -1 is returned.
+ * It assumes that \n or \r only occur as first
+ * character, and \b or \t only as last.
+ */
+
+Visible int
+fwidth(str)
+       register string str;
+{
+       register int c;
+       register int n = 0;
+
+       if (!str)
+               return 0;
+       c = str[0];
+       if (c == '\r' || c == '\n')
+               return -1;
+       for (; c; c = *++str)
+               ++n;
+       if (n > 0) {
+               c = str[-1];
+               if (c == '\t' || c == '\b')
+                       --n;
+       }
+       return n;
+}
+
+
+Visible Procedure
+syserr(fmt, a1, a2, a3, a4, a5)
+       string fmt;
+{
+       fprintf(stderr, "mkboot system error:\n");
+       fprintf(stderr, fmt, a1, a2, a3, a4, a5);
+       fprintf(stderr, "\n");
+       exit(1);
+}
+
+
+Visible Procedure
+asserr(file, line)
+       string file;
+       int line;
+{
+       syserr("assertion error: %s, line %d", file, line);
+}

diff --git a/usr/contrib/B/src/bed/move.c b/usr/contrib/B/src/bed/move.c
new file mode 100644 (file)
index 0000000..9a4bc64
--- /dev/null
+++ b/usr/contrib/B/src/bed/move.c
@@ -0,0 +1,477 @@
+/* Copyright (c) Stichting Mathematisch Centrum, Amsterdam, 1984. */
+static char rcsid[] = "$Header: move.c,v 2.4 85/08/22 16:05:16 timo Exp $";
+
+/*
+ * B editor -- Process arrow keys in four directions, plus TAB.
+ */
+
+#include "b.h"
+#include "bobj.h"
+#include "node.h"
+#include "supr.h"
+#include "gram.h"
+
+#define Left (-1)
+#define Rite 1
+
+
+/*
+ * Common code for PREVIOUS and NEXT commands.
+ */
+
+Hidden bool
+prevnext(ep, direction)
+       environ *ep;
+{
+       node n;
+       node n1;
+       int nch;
+       int i;
+       int len;
+       int sym;
+       string *rp;
+
+       higher(ep);
+       switch (ep->mode) {
+       case VHOLE:
+       case FHOLE:
+       case ATBEGIN:
+       case ATEND:
+               if (direction == Left)
+                       leftvhole(ep);
+               else
+                       ritevhole(ep);
+       }
+
+       for (;;) {
+               n = tree(ep->focus);
+               nch = nchildren(n);
+               rp = noderepr(n);
+
+               switch (ep->mode) {
+
+               case ATBEGIN:
+               case ATEND:
+                       ep->mode = WHOLE;
+                       continue;
+
+               case VHOLE:
+               case FHOLE:
+                       if (direction == Rite) {
+                               if (ep->s1&1)
+                                       len = Fwidth(rp[ep->s1/2]);
+                               else {
+                                       n1 = child(n, ep->s1/2);
+                                       len = width(n1);
+                               }
+                       }
+                       if (direction == Rite ? ep->s2 >= len : ep->s2 <= 0) {
+                               ep->mode = SUBSET;
+                               ep->s2 = ep->s1;
+                               return nextchar(ep, direction);
+                       }
+                       ep->s2 += direction;
+                       return Yes;
+
+               case SUBRANGE:
+                       if (direction == Rite) {
+                               if (ep->s1&1)
+                                       len = Fwidth(rp[ep->s1/2]);
+                               else {
+                                       n1 = child(n, ep->s1/2);
+                                       len = width(n1);
+                               }
+                       }
+                       if (direction == Left ? ep->s2 <= 0 : ep->s3 >= len-1) {
+                               ep->mode = SUBSET;
+                               ep->s2 = ep->s1;
+                               return nextchar(ep, direction);
+                       }
+                       if (direction == Rite)
+                               ep->s2 = ++ep->s3;
+                       else
+                               ep->s3 = --ep->s2;
+                       return Yes;
+
+               case SUBSET:
+                       if (direction == Rite ? ep->s2 > 2*nch : ep->s1 <= 1) {
+                               ep->mode = WHOLE;
+                               continue;
+                       }
+                       if (direction == Rite)
+                               ep->s1 = ++ep->s2;
+                       else
+                               ep->s2 = --ep->s1;
+                       if (ep->s1&1) {
+                               if (!Fw_positive(rp[ep->s1/2]) || allspaces(rp[ep->s1/2]))
+                                       continue;
+                       }
+                       else {
+                               sym = symbol(n);
+                               if (downi(&ep->focus, ep->s1/2)) {
+                                       n = tree(ep->focus);
+                                       if (((value)n)->type == Tex)
+                                               s_up(ep);
+                                       else {
+                                               if (ep->s1 == 2*nch && direction == Rite
+                                                       && issublist(sym) && samelevel(sym, symbol(n))) {
+                                                       ep->mode = SUBLIST;
+                                                       ep->s3 = 1;
+                                                       return Yes;
+                                               }
+                                               ep->mode = WHOLE;
+                                               if (width(n) == 0)
+                                                       continue;
+                                       }
+                               }
+                       }
+                       return Yes;
+
+               case SUBLIST:
+                       sym = symbol(n);
+                       if (direction == Left) {
+                               i = ichild(ep->focus);
+                               if (!up(&ep->focus))
+                                       return No;
+                               higher(ep);
+                               n = tree(ep->focus);
+                               if (i == nchildren(n) && samelevel(sym, symbol(n))) {
+                                       ep->s3 = 1;
+                                       return Yes;
+                               }
+                               ep->mode = SUBSET;
+                               ep->s1 = ep->s2 = 2*i;
+                               continue;
+                       }
+                       for (i = ep->s3; i > 0; --i)
+                               if (!downrite(&ep->focus))
+                                       return No; /* Sorry... */
+                       if (samelevel(sym, symbol(tree(ep->focus))))
+                               ep->s3 = 1;
+                       else
+                               ep->mode = WHOLE;
+                       return Yes;
+
+               case WHOLE:
+                       i = ichild(ep->focus);
+                       if (!up(&ep->focus))
+                               return No;
+                       higher(ep);
+                       ep->mode = SUBSET;
+                       ep->s1 = ep->s2 = 2*i;
+                       continue;
+
+               default:
+                       Abort();
+               }
+       }
+       /* Not reached */
+}
+
+Visible bool leftarrow(ep)
+       environ *ep;
+{
+       int w;
+       bool hole;
+
+       if (narrow(ep)) {
+               while (narrow(ep))
+                       ;
+               return Yes;
+       }
+       hole= ep->mode == WHOLE; /* Can't narrow and still WHOLE: */
+                                /* a real hole which needs some hacking. */
+       if (!previous(ep))
+               return No;
+       if (hole) {
+               for (;;) {
+                       w= focwidth(ep);
+                       if (w >= 0 && w <= 1)
+                               break;
+                       if (!rnarrow(ep))
+                               return No;
+               }
+               narrow(ep);
+       }
+       else {
+               while (rnarrow(ep))
+                       ;
+       }
+       return Yes;
+}
+
+Visible bool ritearrow(ep)
+       environ *ep;
+{
+       while (narrow(ep))
+               ;
+       if (!next(ep))
+               return No;
+       while (narrow(ep))
+               ;
+       return Yes;
+}
+
+
+Visible bool
+previous(ep)
+       environ *ep;
+{
+       if (!prevnext(ep, Left))
+               return No;
+       return Yes;
+}
+
+
+Visible bool
+next(ep)
+       environ *ep;
+{
+       if (!prevnext(ep, Rite))
+               return No;
+       return Yes;
+}
+
+
+/*
+ * Position focus at next or previous char relative to current position.
+ * Assume current position given as SUBSET.
+ */
+
+Hidden bool
+nextchar(ep, direction)
+       register environ *ep;
+       register int direction;
+{
+       register int ich;
+       register int nch;
+       register node n;
+       node n1;
+       register int len;
+       string *rp;
+
+       Assert(ep->mode == SUBSET);
+       for (;;) {
+               n = tree(ep->focus);
+               rp = noderepr(n);
+               nch = nchildren(n);
+               if (direction == Left)
+                       ep->s2 = --ep->s1;
+               else
+                       ep->s1 = ++ep->s2;
+               if (direction == Left ? ep->s1 < 1 : ep->s2 > 2*nch+1) {
+                       ich = ichild(ep->focus);
+                       if (!up(&ep->focus))
+                               return No; /* *ep is garbage now! */
+                       higher(ep);
+                       ep->s1 = ep->s2 = 2*ich;
+                       continue;
+               }
+               if (ep->s1&1) {
+                       len = Fwidth(rp[ep->s1/2]);
+                       if (len > 0) {
+                               ep->mode = SUBRANGE;
+                               ep->s2 = ep->s3 = direction == Left ? len-1 : 0;
+                               return Yes;
+                       }
+                       continue;
+               }
+               n1 = child(n, ep->s1/2);
+               len = width(n1);
+               if (len == 0)
+                       continue;
+               if (!downi(&ep->focus, ep->s1/2))
+                       return No; /* Sorry... */
+               n = tree(ep->focus);
+               if (((value)n)->type == Tex) {
+                       s_up(ep);
+                       ep->mode = SUBRANGE;
+                       ep->s2 = ep->s3 = direction == Left ? len-1 : 0;
+                       return Yes;
+               }
+               if (direction == Left) {
+                       nch = nchildren(n);
+                       ep->s1 = ep->s2 = 2*(nch+1);
+               }
+               else
+                       ep->s1 = ep->s2 = 0;
+       }
+       /* Not reached */
+}
+
+
+/*
+ * Up and down arrows.
+ */
+
+Hidden bool
+updownarrow(ep, yincr)
+       environ *ep;
+       int yincr;
+{
+       int y, x;
+
+       while (narrow(ep))
+               ;
+       y= lineno(ep) + yincr;
+       x= colno(ep);
+       if (!gotoyx(ep, y, x))
+               return No;
+       gotofix(ep, y, x);
+       while (narrow(ep))
+               ;
+       return Yes;
+}
+
+Visible bool
+uparrow(ep)
+       environ *ep;
+{
+       return updownarrow(ep, -1);
+}
+
+Visible bool
+downarrow(ep)
+       environ *ep;
+{
+       return updownarrow(ep, 1);
+}
+
+Visible bool
+upline(ep)
+       register environ *ep;
+{
+       register int y;
+
+       y = lineno(ep);
+       if (y <= 0)
+               return No;
+       if (!gotoyx(ep, y-1, 0))
+               return No;
+       oneline(ep);
+       return Yes;
+}
+
+Visible bool
+downline(ep)
+       register environ *ep;
+{
+       register int w;
+
+       if (!parent(ep->focus) && ep->mode == ATEND)
+               return No; /* Superfluous? */
+       w = -focwidth(ep);
+       if (w <= 0)
+               w = 1;
+       if (!gotoyx(ep, lineno(ep) + w, 0))
+               return No;
+       oneline(ep);
+       return Yes;
+}
+
+
+/*
+ * ACCEPT command
+ * move to next Hole hole or to end of suggestion or to end of line.
+ */
+
+
+Visible bool
+accept(ep)
+       environ *ep;
+{
+       int i;
+       string repr;
+
+       shrink(ep);
+       switch (ep->mode) {
+       case ATBEGIN:
+       case ATEND:
+       case FHOLE:
+       case VHOLE:
+               ritevhole(ep);
+       }
+       if (symbol(tree(ep->focus)) == Hole)
+               ep->mode = ATEND;
+       switch (ep->mode) {
+       case ATBEGIN:
+       case SUBLIST:
+       case WHOLE:
+               i = 1;
+               break;
+       case ATEND:
+               i = 2*nchildren(tree(ep->focus)) + 2;
+               break;
+       case SUBRANGE:
+       case VHOLE:
+       case FHOLE:
+               i = ep->s1;
+               if (ep->s2 > 0 && i > 2*nchildren(tree(ep->focus)))
+                       ++i; /* Kludge so after E?LSE: the focus moves to ELSE: ? */
+               break;
+       case SUBSET:
+               i = ep->s1 - 1;
+               break;
+       default:
+               Abort();
+       }
+       ep->mode = WHOLE;
+       for (;;) {
+               if (i/2 == nchildren(tree(ep->focus))) {
+                       repr = noderepr(tree(ep->focus))[i/2];
+                       if (Fw_positive(repr))
+                               break;
+               }
+               if (tabstop(ep, i + 1))
+                       return Yes;
+               i = 2*ichild(ep->focus) + 1;
+               if (!up(&ep->focus))
+                       break;
+               higher(ep);
+       }
+       ep->mode = ATEND;
+       return Yes;
+}
+
+
+/*
+ * Find suitable tab stops for accept.
+ */
+ 
+Hidden bool
+tabstop(ep, i)
+       environ *ep;
+       int i;
+{
+       node n = tree(ep->focus);
+       int nch;
+       string repr;
+
+       if (Type(n) == Tex)
+               return No;
+       nch = nchildren(n);
+       if (i/2 > nch)
+               return No;
+       if (symbol(n) == Hole) {
+               ep->mode = WHOLE;
+               return Yes;
+       }
+       if (i < 2) {
+               i = 2;
+               if (width(n) < 0) {
+                       repr = noderepr(n)[0];
+                       if (Fw_negative(repr)) {
+                               ep->mode = ATBEGIN;
+                               leftvhole(ep);
+                               return Yes;
+                       }
+               }
+       }
+       for (i /= 2; i <= nch; ++i) {
+               s_downi(ep, i);
+               if (tabstop(ep, 1))
+                       return Yes;
+               s_up(ep);
+       }
+       return No;
+}

diff --git a/usr/contrib/B/src/bed/node.c b/usr/contrib/B/src/bed/node.c
new file mode 100644 (file)
index 0000000..5ff28f5
--- /dev/null
+++ b/usr/contrib/B/src/bed/node.c
@@ -0,0 +1,653 @@
+/* Copyright (c) Stichting Mathematisch Centrum, Amsterdam, 1984. */
+static char rcsid[] = "$Header: node.c,v 2.4 85/08/22 16:05:27 timo Exp $";
+
+/*
+ * B editor -- Parse tree and Focus stack.
+ */
+
+#include "b.h"
+#include "bobj.h"
+
+#include "node.h"
+
+#define Register register
+       /* Used for registers 4-6.  Define as empty macro on PDP */
+
+
+/*
+ * Lowest level routines for 'node' data type.
+ */
+
+#define Isnode(n) ((n) && (n)->type == Nod)
+
+#define Nchildren(n) ((n)->len)
+#define Symbol(n) ((n)->n_symbol)
+#define Child(n, i) ((n)->n_child[(i)-1])
+#define Marks(n) ((n)->n_marks)
+#define Width(n) ((n)->n_width)
+
+
+/*
+ * Routines which are macros for the compiler but real functions for lint,
+ * so it will check the argument types more strictly.
+ */
+
+#ifdef lint
+node
+nodecopy(n)
+       node n;
+{
+       return (node) copy((value) n);
+}
+
+noderelease(n)
+       node n;
+{
+       release((value)n);
+}
+
+nodeuniql(pn)
+       node *pn;
+{
+       uniql((value*)pn);
+}
+#endif lint
+
+
+/*
+ * Allocate a new node.
+ */
+
+Visible node
+newnode(nch, sym, children)
+       register int nch;
+       Register int sym;
+       register node children[];
+{
+       register node n = (node) grab_node(nch); /* Must preset with zeros! */
+
+       Symbol(n) = sym;
+       for (; nch > 0; --nch)
+               Child(n, nch) = children[nch-1];
+       Width(n) = evalwidth(n);
+       return n;
+}
+
+
+/*
+ * Macros to change the fields of a node.
+ */
+
+#define Locchild(pn, i) \
+       (Refcnt(*(pn)) == 1 || nodeuniql(pn), &Child(*(pn), i))
+#define Setmarks(pn, x) \
+       (Refcnt(*(pn)) == 1 || nodeuniql(pn), Marks(*(pn))=(x))
+#define Setwidth(pn, w) (Refcnt(*(pn)) == 1 || nodeuniql(pn), Width(*(pn))=w)
+
+
+/*
+ * Change a child of a node.
+ * Like replace(), it does not increase the reference count of n.
+ */
+
+Visible Procedure
+setchild(pn, i, n)
+       register node *pn;
+       register int i;
+       Register node n;
+{
+       register node *pch;
+       register node oldchild;
+
+       Assert(Isnode(*pn));
+       pch = Locchild(pn, i);
+       oldchild = *pch;
+       *pch = n;
+       repwidth(pn, oldchild, n);
+       noderelease(oldchild);
+}
+
+
+/*
+ * Lowest level routines for 'path' data type.
+ */
+
+#define NPATHFIELDS 6
+
+#define Parent(p) ((p)->p_parent)
+#define Tree(p) ((p)->p_tree)
+#define Ichild(p) ((p)->p_ichild)
+#define Ycoord(p) ((p)->p_ycoord)
+#define Xcoord(p) ((p)->p_xcoord)
+#define Level(p) ((p)->p_level)
+
+
+/*
+ * Routines which are macros for the compiler but real functions for lint,
+ * so it will check the argument types more strictly.
+ */
+
+#ifdef lint
+Visible path
+pathcopy(p)
+       path p;
+{
+       return (path) copy((value) p);
+}
+
+Visible Procedure
+pathrelease(p)
+       path p;
+{
+       release((value)p);
+}
+
+Visible Procedure
+pathuniql(pp)
+       path *pp;
+{
+       uniql((value*)pp);
+}
+#endif lint
+
+
+/*
+ * Allocate a new path entry.
+ */
+
+Visible path
+newpath(pa, n, i)
+       register path pa;
+       register node n;
+       Register int i;
+{
+       register path p = (path) grab_path();
+
+       Parent(p) = pa;
+       Tree(p) = n;
+       Ichild(p) = i;
+       Ycoord(p) = Xcoord(p) = Level(p) = 0;
+       return p;
+}
+
+
+/*
+ * Macros to change the fields of a path entry.
+ */
+
+#define Uniqp(pp) (Refcnt(*(pp)) == 1 || pathuniql(pp))
+
+#define Setcoord(pp, y, x, level) (Uniqp(pp), \
+       (*(pp))->p_ycoord = y, (*(pp))->p_xcoord = x, (*(pp))->p_level = level)
+
+#define Locparent(pp) (Uniqp(pp), &Parent(*(pp)))
+
+#define Loctree(pp) (Uniqp(pp), &Tree(*(pp)))
+
+#define Addmarks(pp, x) (Uniqp(pp), \
+       (*(pp))->p_addmarks |= (x), (*(pp))->p_delmarks &= ~(x))
+
+#define Delmarks(pp, x) (Uniqp(pp), \
+       (*(pp))->p_delmarks |= (x), (*(pp))->p_addmarks &= ~(x))
+
+
+Hidden Procedure
+connect(pp)
+       path *pp;
+{
+       register path p = *pp;
+       register path pa = Parent(p);
+       register path *ppa;
+       register node n;
+       register node npa;
+       register node *pn;
+       node oldchild;
+       node *pnpa;
+       int i;
+       markbits add;
+       markbits del;
+
+       if (!pa)
+               return;
+       i = ichild(p);
+       n = Tree(p);
+       if (Child(Tree(pa), i) == n)
+               return; /* Still connected */
+
+       n = nodecopy(n);
+       ppa = Locparent(pp);
+       pnpa = Loctree(ppa);
+       pn = Locchild(pnpa, i);
+       oldchild = *pn;
+       *pn = n;
+       repwidth(pnpa, oldchild, n);
+       noderelease(oldchild);
+
+       add = p->p_addmarks;
+       del = p->p_delmarks;
+       if (add|del) {
+               p = *pp;
+               p->p_addmarks = 0;
+               p->p_delmarks = 0;
+               if (add)
+                       Addmarks(ppa, add);
+               npa = *pnpa;
+               if (del) {
+                       for (i = Nchildren(npa); i > 0; --i)
+                               if (i != ichild(p))
+                                       del &= ~marks(Child(npa, i));
+                       Delmarks(ppa, del);
+               }
+               Setmarks(pnpa, Marks(npa)&~del|add);
+       }
+}
+
+
+/*
+ * The following procedure sets the new width of node *pn when child
+ * oldchild is replaced by child newchild.
+ * This was added because the original call to evalwidth seemed to
+ * be the major caller of noderepr() and fwidth().
+ */
+
+Hidden Procedure
+repwidth(pn, old, new)
+       register node *pn;
+       Register node old;
+       Register node new;
+{
+       register int w = Width(*pn);
+       register int oldwidth = width(old);
+       register int newwidth = width(new);
+
+       if (w < 0) {
+               if (oldwidth > 0)
+                       oldwidth = 0;
+               if (newwidth > 0)
+                       newwidth = 0;
+       }
+       else {
+               Assert(oldwidth >= 0);
+               if (newwidth < 0) {
+                       Setwidth(pn, newwidth);
+                       return;
+               }
+       }
+       newwidth -= oldwidth;
+       if (newwidth)
+               Setwidth(pn, w + newwidth);
+}
+
+
+Visible Procedure
+markpath(pp, new)
+       register path *pp;
+       register markbits new;
+{
+       register node *pn;
+       register markbits old;
+
+       Assert(Type(Tree(*pp)) == Nod);
+       old = Marks(Tree(*pp));
+       if ((old|new) == old)
+               return; /* Bits already set */
+
+       pn = Loctree(pp);
+       Setmarks(pn, old|new);
+       Addmarks(pp, new&~old);
+}
+
+
+Visible Procedure
+unmkpath(pp, del)
+       register path *pp;
+       register int del;
+{
+       register node *pn;
+       register markbits old;
+
+       Assert(Type(Tree(*pp)) == Nod);
+       old = Marks(Tree(*pp));
+       if ((old&~del) == del)
+               return;
+
+       pn = Loctree(pp);
+       Setmarks(pn, old&~del);
+       Delmarks(pp, del&old);
+}
+
+
+Hidden Procedure
+clearmarks(pn)
+       register node *pn;
+{
+       register int i;
+
+       if (!Marks(*pn))
+               return;
+       if (Isnode(*pn)) {
+               Setmarks(pn, 0);
+               for (i = Nchildren(*pn); i > 0; --i)
+                       clearmarks(Locchild(pn, i));
+       }
+}
+
+
+/*
+ * Replace the focus' tree by a new node.
+ * WARNING: n's reference count is not increased!
+ * You can also think of this as: replace(pp, n) implies noderelease(n).
+ * Mark bits are copied from the node being replaced.
+ */
+
+Visible Procedure
+replace(pp, n)
+       register path *pp;
+       register node n;
+{
+       register node *pn;
+       register markbits old;
+
+       pn = Loctree(pp);
+       if (Type(*pn) == Nod)
+               old = Marks(*pn);
+       else
+               old = 0;
+       noderelease(*pn);
+       *pn = n;
+       if (Type(n) == Nod) {
+               clearmarks(pn);
+               if (old)
+                       Setmarks(pn, old);
+       }
+       else if (old)
+               Addmarks(pp, old);
+}
+
+
+Visible bool
+up(pp)
+       register path *pp;
+{
+       register path p = *pp;
+
+       if (!Parent(p))
+               return No;
+
+       connect(pp);
+       p = pathcopy(Parent(*pp));
+       pathrelease(*pp);
+       *pp = p;
+       return Yes;
+}
+
+
+Visible bool
+downi(pp, i)
+       register path *pp;
+       register int i;
+{
+       register node n;
+       auto int y;
+       auto int x;
+       auto int level;
+
+       n = Tree(*pp);
+       if (!Isnode(n) || i < 1 || i > Nchildren(n))
+               return No;
+
+       y = Ycoord(*pp);
+       x = Xcoord(*pp);
+       level = Level(*pp);
+       *pp = newpath(*pp, nodecopy(Child(n, i)), i);
+       evalcoord(n, i, &y, &x, &level);
+       Setcoord(pp, y, x, level);
+       return Yes;
+}
+
+
+Visible bool
+downrite(pp)
+       register path *pp;
+{
+       if (!Isnode(Tree(*pp)))
+               return No;
+       return downi(pp, Nchildren(Tree(*pp)));
+}
+
+
+Visible bool
+left(pp)
+       register path *pp;
+{
+       register int i;
+
+       i = ichild(*pp) - 1;
+       if (i <= 0)
+               return No;
+       if (!up(pp))
+               return No;
+       return downi(pp, i);
+}
+
+
+Visible bool
+rite(pp)
+       register path *pp;
+{
+       register int i;
+       register path pa = Parent(*pp);
+
+       i = ichild(*pp) + 1;
+       if (!pa || i > Nchildren(Tree(pa)))
+               return No;
+       if (!up(pp))
+               return No;
+       return downi(pp, i);
+}
+
+
+/*
+ * Highest level: small utilities.
+ *
+ * WARNING: Several of the following routines may change their argument
+ * even if they return No.
+ * HINT: Some of these routines are not used; they are included for
+ * completeness of the provided set of operators only.  If you have
+ * space problems (as, e.g., on a PDP-11), you can delete the superfluous
+ * ones (lint will tell you which they are).
+ */
+
+Visible Procedure
+top(pp)
+       register path *pp;
+{
+       while (up(pp))
+               ;
+}
+
+
+Visible bool
+nextnode(pp)
+       register path *pp;
+{
+       while (!rite(pp)) {
+               if (!up(pp))
+                       return No;
+       }
+       return Yes;
+}
+
+
+Visible Procedure
+firstleaf(pp)
+       register path *pp;
+{
+       while (down(pp))
+               ;
+}
+
+#if NOT_USED
+
+Visible bool
+nextleaf(pp)
+       register path *pp;
+{
+       if (!nextnode(pp))
+               return No;
+       firstleaf(pp);
+       return Yes;
+}
+
+#endif NOT_USED
+
+Visible bool
+prevnode(pp)
+       register path *pp;
+{
+       while (!left(pp)) {
+               if (!up(pp))
+                       return No;
+       }
+       return Yes;
+}
+
+Visible Procedure
+lastleaf(pp)
+       register path *pp;
+{
+       while (downrite(pp))
+                       ;
+}
+
+#ifdef NOT_USED
+
+Visible bool
+prevleaf(pp)
+       register path *pp;
+{
+       if (!prevnode(pp))
+               return No;
+       lastleaf(pp);
+       return Yes;
+}
+
+
+Visible bool
+nextmarked(pp, x)
+       register path *pp;
+       register markbits x;
+{
+       do {
+               if (!nextnode(pp))
+                       return No;
+       } while (!marked(*pp, x));
+       while (down(pp)) {
+               while (!marked(*pp, x)) {
+                       if (!rite(pp)) {
+                               up(pp) || Abort();
+                               return Yes;
+                       }
+               }
+       }
+       return Yes;
+}
+
+#endif NOT_UED
+
+Visible bool
+firstmarked(pp, x)
+       register path *pp;
+       register markbits x;
+{
+       while (!marked(*pp, x)) {
+               if (!up(pp))
+                       return No;
+       }
+       while (down(pp)) {
+               while (Type(tree(*pp)) == Tex || !marked(*pp, x)) {
+                       if (!rite(pp)) {
+                               up(pp) || Abort();
+                               return Yes;
+                       }
+               }
+       }
+       return Yes;
+}
+
+
+Visible bool
+prevmarked(pp, x)
+       register path *pp;
+       register markbits x;
+{
+       do {
+               if (!prevnode(pp))
+                       return No;
+       } while (!marked(*pp, x));
+       while (downrite(pp)) {
+               while (!marked(*pp, x)) {
+                       if (!left(pp)) {
+                               up(pp) || Abort();
+                               return Yes;
+                       }
+               }
+       }
+       return Yes;
+}
+
+
+/*
+ * Deliver the path length to the root.
+ */
+
+
+Visible Procedure
+pathlength(p)
+       register path p;
+{
+       register int n;
+
+       for (n = 0; p; ++n)
+               p = parent(p);
+       return n;
+}
+
+
+/*
+ * Put a C string in a trimmed location (this name should change,
+ * the 'official' routine of this name has quite different parameters).
+ */
+
+
+Visible Procedure
+putintrim(pn, head, tail, str)
+       register value *pn;
+       register int head;
+       Register int tail;
+       Register string str;
+{
+       register value v = *pn; 
+       value w = head == 0 ? mk_text("") :
+               head == Length(v) ? copy(v) : trim(v, 0, Length(v) - head);
+
+       Assert(head >= 0 && tail >= 0 && head + tail <= Length(v));
+       if (*str)
+               concato(&w, str);
+       if (tail > 0)
+               concato(&w, Str(v)+(Length(v) - tail));
+       release(v);
+       *pn = w;
+}
+
+
+/*
+ * Touch the node in focus.
+ */
+
+Visible Procedure
+touchpath(pp)
+       register path *pp;
+{
+       nodeuniql(Loctree(pp));
+}

diff --git a/usr/contrib/B/src/bed/outp.c b/usr/contrib/B/src/bed/outp.c
new file mode 100644 (file)
index 0000000..0c32c98
--- /dev/null
+++ b/usr/contrib/B/src/bed/outp.c
@@ -0,0 +1,419 @@
+/* Copyright (c) Stichting Mathematisch Centrum, Amsterdam, 1984. */
+static char rcsid[] = "$Header: outp.c,v 2.4 85/08/22 16:05:48 timo Exp $";
+
+/*
+ * B editor -- Screen management package, lower level output part.
+ */
+
+#include <ctype.h>
+
+#include "b.h"
+#include "bobj.h"
+#include "node.h"
+#include "supr.h"
+#include "gram.h"
+#include "cell.h"
+
+
+#define SOBIT 0200
+#define CHAR 0177
+
+
+/*
+ * Variables used for communication with outfocus.
+ */
+
+Hidden node thefocus;
+Hidden environ wherebuf;
+Hidden environ *where = &wherebuf;
+Hidden bool realvhole;
+Hidden int multiline; /* Height of focus */
+Hidden int yfocus;
+
+Visible int focy; /* Where the cursor must go */
+Visible int focx;
+
+
+/*
+ * Save position of the focus for use by outnode/outfocus.
+ */
+
+Visible Procedure
+savefocus(ep)
+       register environ *ep;
+{
+       register int sym;
+       register int w;
+
+       realvhole = No;
+       thefocus = Nnil;
+       multiline = 0;
+       yfocus = Ycoord(ep->focus);
+       w = focoffset(ep);
+       if (w < 0)
+               yfocus += -w;
+       w = focwidth(ep);
+       if (w < 0) {
+               multiline = -w;
+               if (focchar(ep) == '\n')
+                       ++yfocus;
+               else
+                       ++multiline;
+               return;
+       }
+       if (ep->mode == WHOLE) {
+               sym = symbol(tree(ep->focus));
+               if (sym == Optional)
+                       ep->mode = ATBEGIN;
+       }
+       switch(ep->mode) {
+       case VHOLE:
+               if (ep->s1&1)
+                       ep->mode = FHOLE;
+       case ATBEGIN:
+       case ATEND:
+       case FHOLE:
+               ritevhole(ep);
+               switch (ep->mode) {
+               case ATBEGIN:
+               case FHOLE:
+                       sym = symbol(tree(ep->focus));
+                       if (sym == Hole && (ep->mode == ATBEGIN || ep->s2 == 0)) {
+                               ep->mode = WHOLE;
+                               break;
+                       }
+                       /* Fall through */
+               case VHOLE:
+               case ATEND:
+                       leftvhole(ep);
+                       realvhole = 1 + ep->spflag;
+               }
+       }
+       touchpath(&ep->focus); /* Make sure it is a unique pointer */
+       thefocus = tree(ep->focus); /* No copy; used for comparison only! */
+       where->mode = ep->mode;
+       where->s1 = ep->s1;
+       where->s2 = ep->s2;
+       where->s3 = ep->s3;
+       where->spflag = ep->spflag;
+}
+
+
+/*
+ * Incorporate the information saved about the focus.
+ */
+
+Visible Procedure
+setfocus(tops)
+       register cell *tops;
+{
+       register cell *p;
+       register int i;
+
+       for (p = tops, i = 0; i < yfocus; ++i, p = p->c_link) {
+               if (!p) {
+#ifndef NDEBUG
+                       debug("[Focus lost (setfocus)]");
+#endif NDEBUG
+                       return;
+               }
+       }
+       p->c_newvhole = realvhole;
+       i = multiline;
+       do {
+               p->c_newfocus = Yes;
+               p = p->c_link;
+       } while (--i > 0);
+}
+
+
+/*
+ * Signal that actual updata is started.
+ */
+
+Visible Procedure
+startactupdate(nofocus)
+       bool nofocus;
+{
+       if (nofocus) {
+               multiline = 0;
+               thefocus = Nnil;
+       }
+}
+
+
+/*
+ * Signal the end of the actual update.
+ */
+
+Visible Procedure
+endactupdate()
+{
+}
+
+
+/*
+ * Output a line of text.
+ */
+
+Visible Procedure
+outline(p, lineno)
+       register cell *p;
+       register int lineno;
+{
+       register node n = p->c_data;
+       register int w = width(n);
+       register string buf =
+           malloc((unsigned) (p->c_newindent + 4 + (w < 0 ? linelen(n) : w)));
+                       /* some 4 extra for spflag and vhole */
+       auto string bp = buf;
+       register int i;
+       register int endarea = lineno+Space(p)-1;
+
+       if (endarea >= winheight)
+               endarea = winheight-1;
+       for (i = p->c_newindent; i-- > 0; )
+               *bp++ = ' ';
+       if (!p->c_newfocus) {
+               smash(&bp, n, 0);
+               *bp = 0;
+       }
+       else {
+               if (multiline)
+                       smash(&bp, n, SOBIT);
+               else if (n == thefocus)
+                       focsmash(&bp, n);
+               else
+                       smash(&bp, n, 0);
+               *bp = 0;
+               for (bp = buf; *bp && !(*bp&SOBIT); ++bp)
+                       ;
+               if (*bp&SOBIT) {
+                       if (focy == Nowhere) {
+                               focx = indent + bp-buf;
+                               focy = lineno + focx/llength;
+                               focx %= llength;
+                       }
+                       if (multiline <= 1 && !(bp[1]&SOBIT))
+                               *bp &= ~SOBIT; /* Clear mask if just one char in focus */
+               }
+       }
+       trmputdata(lineno, endarea, indent, buf);
+}
+
+
+/*
+ * Smash -- produce a linear version of a node in a buffer (which had
+ * better be long enough!).  The buffer pointer is moved to the end of
+ * the resulting string.
+ * Care is taken to represent the focus.
+ * Characters in the focus have their upper bit set.
+ */
+
+#define Outvhole() \
+       (where->spflag && strsmash(pbuf, " ", 0), strsmash(pbuf, "?", SOBIT))
+
+Hidden Procedure
+focsmash(pbuf, n)
+       string *pbuf;
+       node n;
+{
+       value v;
+       string str;
+       register string *rp;
+       register int maxs2;
+       register int i;
+       register bool ok;
+       register int j;
+       register int mask;
+
+       switch (where->mode) {
+
+       case WHOLE:
+               smash(pbuf, n, SOBIT);
+               break;
+
+       case ATBEGIN:
+               Outvhole();
+               smash(pbuf, n, 0);
+               break;
+
+       case ATEND:
+               smash(pbuf, n, 0);
+               Outvhole();
+               break;
+
+       case VHOLE:
+               if (!(where->s1&1)) {
+                       v = (value) child(n, where->s1/2);
+                       Assert(Type(v) == Tex);
+                       subsmash(pbuf, Str(v), where->s2, 0);
+                       Outvhole();
+                       strsmash(pbuf, Str(v) + where->s2, 0);
+                       break;
+               }
+               /* Else, fall through */
+       case FHOLE:
+               rp = noderepr(n);
+               maxs2 = 2*nchildren(n) + 1;
+               for (ok = Yes, i = 1; ok && i <= maxs2; ++i) {
+                       if (i&1) {
+                               if (i == where->s1) {
+                                       subsmash(pbuf, rp[i/2], where->s2, 0);
+                                       Outvhole();
+                                       if (rp[i/2])
+                                               strsmash(pbuf, rp[i/2] + where->s2, 0);
+                               }
+                               else
+                                       strsmash(pbuf, rp[i/2], 0);
+                       }
+                       else
+                               ok = chismash(pbuf, n, i/2, 0);
+               }
+               break;
+
+       case SUBRANGE:
+               rp = noderepr(n);
+               maxs2 = 2*nchildren(n) + 1;
+               for (ok = Yes, i = 1; ok && i <= maxs2; ++i) {
+                       if (i&1) {
+                               if (i == where->s1) {
+                                       subsmash(pbuf, rp[i/2], where->s2,0);
+                                       if (rp[i/2])
+                                               subsmash(pbuf, rp[i/2] + where->s2,
+                                                       where->s3 - where->s2 + 1, SOBIT);
+                                       if (rp[i/2])
+                                               strsmash(pbuf, rp[i/2] + where->s3 + 1, 0);
+                               }
+                               else
+                                       strsmash(pbuf, rp[i/2], 0);
+                       }
+                       else if (i == where->s1) {
+                               v = (value)child(n, i/2);
+                               Assert(Type(v) == Tex);
+                               str = Str(v);
+                               subsmash(pbuf, str, where->s2, 0);
+                               subsmash(pbuf, str + where->s2, where->s3 - where->s2 + 1,
+                                       SOBIT);
+                               strsmash(pbuf, str + where->s3 + 1, 0);
+                       }
+                       else
+                               ok = chismash(pbuf, n, i/2, 0);
+               }
+               break;
+
+       case SUBLIST:
+               for (ok = Yes, j = where->s3; j > 0; --j) {
+                       rp = noderepr(n);
+                       maxs2 = 2*nchildren(n) - 1;
+                       for (i = 1; ok && i <= maxs2; ++i) {
+                               if (i&1)
+                                       strsmash(pbuf, rp[i/2], SOBIT);
+                               else
+                                       ok = chismash(pbuf, n, i/2, SOBIT);
+                       }
+                       if (ok)
+                               n = lastchild(n);
+               }
+               if (ok)
+                       smash(pbuf, n, 0);
+               break;
+
+       case SUBSET:
+               rp = noderepr(n);
+               maxs2 = 2*nchildren(n) + 1;
+               mask = 0;
+               for (ok = Yes, i = 1; ok && i <= maxs2; ++i) {
+                       if (i == where->s1)
+                               mask = SOBIT;
+                       if (i&1)
+                               strsmash(pbuf, rp[i/2], mask);
+                       else
+                               ok = chismash(pbuf, n, i/2, mask);
+                       if (i == where->s2)
+                               mask = 0;
+               }
+               break;
+
+       default:
+               Abort();
+       }
+}
+
+Hidden Procedure
+smash(pbuf, n, mask)
+       register string *pbuf;
+       register node n;
+       register int mask;
+{
+       register string *rp;
+       register int i;
+       register int nch;
+
+       rp = noderepr(n);
+       strsmash(pbuf, rp[0], mask);
+       nch = nchildren(n);
+       for (i = 1; i <= nch; ++i) {
+               if (!chismash(pbuf, n, i, mask))
+                       break;
+               strsmash(pbuf, rp[i], mask);
+       }
+}
+
+Hidden Procedure
+strsmash(pbuf, str, mask)
+       register string *pbuf;
+       register string str;
+       register int mask;
+{
+       if (!str)
+               return;
+       for (; *str; ++str) {
+               if (isprint(*str) || *str == ' ')
+                       **pbuf = *str|mask, ++*pbuf;
+       }
+}
+
+Hidden Procedure
+subsmash(pbuf, str, len, mask)
+       register string *pbuf;
+       register string str;
+       register int len;
+       register int mask;
+{
+       if (!str)
+               return;
+       for (; len > 0 && *str; --len, ++str) {
+               if (isprint(*str) || *str == ' ')
+                       **pbuf = *str|mask, ++*pbuf;
+       }
+}
+
+
+/*
+ * Smash a node's child.
+ * Return No if it contained a newline (to stop the parent).
+ */
+
+Hidden bool
+chismash(pbuf, n, i, mask)
+       register string *pbuf;
+       register node n;
+       register int i;
+{
+       register node nn = child(n, i);
+       register int w;
+
+       if (Type(nn) == Tex) {
+               strsmash(pbuf, Str((value)nn), mask);
+               return Yes;
+       }
+       w = width(nn);
+       if (w < 0 && Fw_negative(noderepr(nn)[0]))
+               return No;
+       if (nn == thefocus)
+               focsmash(pbuf, nn);
+       else
+               smash(pbuf, nn, mask);
+       return w >= 0;
+}

diff --git a/usr/contrib/B/src/bed/que1.c b/usr/contrib/B/src/bed/que1.c
new file mode 100644 (file)
index 0000000..d8624f0
--- /dev/null
+++ b/usr/contrib/B/src/bed/que1.c
@@ -0,0 +1,588 @@
+/* Copyright (c) Stichting Mathematisch Centrum, Amsterdam, 1984. */
+static char rcsid[] = "$Header: que1.c,v 2.4 84/10/26 12:04:28 guido Exp $";
+
+/*
+ * B editor -- Manipulate queues of nodes, lower levels.
+ */
+
+#include "b.h"
+#include "feat.h"
+#include "bobj.h"
+#include "node.h"
+#include "supr.h"
+#include "queu.h"
+#include "gram.h"
+
+#include <ctype.h>
+
+
+value grab_com();
+
+
+/*
+ * Append queue 2 to the end of queue 1.
+ */
+
+Visible Procedure
+joinqueues(pq, q)
+       register queue *pq;
+       register queue q;
+{
+       if (emptyqueue(q))
+               return;
+       while (*pq) {
+               if (Refcnt(*pq) > 1)
+                       uniql((value*)pq);
+               pq = &(*pq)->q_link;
+       }
+       *pq = q;
+}
+
+
+/*
+ * Prepend a node to a queue ("push").
+ * Empty strings and Optional holes are silently discarded.
+ */
+
+Visible Procedure
+preptoqueue(n, pq)
+       node n;
+       register queue *pq;
+{
+       register queue q;
+
+       if (Type(n) == Tex) {
+               int len = Length((value)n);
+               if (len == 0)
+                       return;
+               n = nodecopy(n);
+       }
+       else { /* Avoid Optional holes */
+               if (symbol(n) == Optional)
+                       return;
+               n = nodecopy(n);
+       }
+       q = (queue) grab_com(2);
+       q->q_data = n;
+       q->q_link = *pq;
+       *pq = q;
+}
+
+
+/*
+ * Append a node to the end of a queue (same extras as preptoqueue).
+ */
+
+Visible Procedure
+addtoqueue(pq, n)
+       register queue *pq;
+       register node n;
+{
+       auto queue q = Qnil;
+
+       preptoqueue(n, &q);
+       joinqueues(pq, q);
+}
+
+
+/*
+ * Push a string onto a queue.
+ */
+
+Visible Procedure
+stringtoqueue(str, pq)
+       register string str;
+       register queue *pq;
+{
+       register value  v;
+
+       if (str == NULL)
+               return;
+       v = mk_text(str);
+       preptoqueue((node) v, pq);
+       release(v);
+}
+
+
+/*
+ * Append a string to a queue.
+ */
+
+Visible Procedure
+addstringtoqueue(pq, str)
+       register queue *pq;
+       register string str;
+{
+       register value v = mk_text(str);
+
+       addtoqueue(pq, (node) v);
+       release(v);
+}
+
+
+/*
+ * Get the first node of a queue and delink it ("pop").
+ */
+
+Visible node
+queuebehead(pq)
+       register queue *pq;
+{
+       register node n;
+       register queue q = *pq;
+
+       Assert(q);
+
+       n = nodecopy(q->q_data);
+       *pq = qcopy(q->q_link);
+       qrelease(q);
+       return n;
+}
+
+
+/*
+ * Split a node in successive queue elements which are pushed
+ * on the queue using preptoqueue.
+ * 'Atomic' nodes (texts and holes) are pushed unadorned.
+ */
+
+Visible Procedure
+splitnode(n, pq)
+       register node n;
+       register queue *pq;
+{
+       register node nn;
+       register string *rp;
+       register int i;
+       register int sym;
+
+       if (Type(n) == Tex) {
+               preptoqueue(n, pq);
+               return;
+       }
+       sym = symbol(n);
+       if (sym == Optional)
+               return;
+       if (sym == Hole) {
+               preptoqueue(n, pq);
+               return;
+       }
+
+       rp = noderepr(n);
+       for (i = nchildren(n); i >= 0; --i) {
+               if (rp[i] && rp[i][0])
+                       stringtoqueue(rp[i], pq);
+               if (i) {
+                       nn = child(n, i);
+                       if (Type(nn) == Tex || symbol(nn) != Optional)
+                               preptoqueue(nn, pq);
+               }
+       }
+}
+
+
+/*
+ * Substitute the focus for its parent, appending the remainder of
+ * the parent to the queue.
+ * The focus must be the first child and not preceded by fixed text.
+ * The focus must be allowed in the place of its parent.
+ * If any of these conditions is not met, No is returned and nothing
+ * is changed.
+ */
+
+Visible bool
+resttoqueue(pp, pq)
+       register path *pp;
+       register queue *pq;
+{
+       auto queue q = Qnil;
+       register path pa = parent(*pp);
+       register node n = tree(*pp);
+       register int sym = symbol(n);
+       /* register markbits x; */
+
+       if (!pa || ichild(*pp) != 1
+               || fwidth(noderepr(tree(pa))[0]) != 0 || !allowed(pa, sym))
+               return No;
+
+       n = nodecopy(n);
+       /* x = marks(n); */
+       up(pp) || Abort();
+       splitnode(tree(*pp), &q);
+       noderelease(queuebehead(&q));
+       replace(pp, n);
+       /* if (x) { */
+               /* markpath(pp, x); */ /* Actually, should restore all n's marks? */
+       /* } */
+       joinqueues(pq, q);
+       return Yes;
+}
+
+
+/*
+ * Like resttoqueue, but exactly from current position in fixed text.
+ * Also, it cannot fail.
+ */
+
+Visible Procedure
+nosuggtoqueue(ep, pq)
+       register environ *ep;
+       queue *pq;
+{
+       auto queue q = Qnil;
+       register int i;
+       register string *rp;
+       register node n;
+       register node nn;
+       register int sym;
+       string str;
+
+       if (issuggestion(ep))
+               return;
+       Assert((ep->mode == FHOLE || ep->mode == VHOLE) && (ep->s1&1));
+
+       n = tree(ep->focus);
+       rp = noderepr(n);
+       for (i = nchildren(n); i > ep->s1/2; --i) {
+               if (!Fw_zero(rp[i]))
+                       stringtoqueue(rp[i], &q);
+               nn = child(n, i);
+               sym = symbol(nn);
+               if (sym != Optional) {
+                       preptoqueue(nn, &q);
+                       if (sym != Hole) {
+                               s_downi(ep, i);
+                               delfocus(&ep->focus);
+                               s_up(ep);
+                       }
+               }
+       }
+       str = rp[i];
+       if (str && str[ep->s2]) /* Push partial first text */
+               stringtoqueue(str + ep->s2, &q);
+       joinqueues(pq, q);
+}
+
+
+/*
+ * Check whether the remainder of the current node is all suggestion.
+ */
+
+Visible bool
+issuggestion(ep)
+       register environ *ep;
+{
+       register node n;
+       register int nch;
+       register int sym;
+       register int i;
+
+       if (ep->mode != VHOLE && ep->mode != FHOLE || !(ep->s1&1))
+               return No; /* Actually wrong call? */
+
+       n = tree(ep->focus);
+       nch = nchildren(n);
+       for (i = ep->s1/2 + 1; i <= nch; ++i) {
+               sym = symbol(child(n, i));
+               if (sym != Hole && sym != Optional)
+                       return No;
+       }
+       return Yes;
+}
+
+
+/*
+ * See if a node fits in a hole.
+ */
+
+Visible bool
+fitnode(pp, n)
+       register path *pp;
+       register node n;
+{
+       if (!allowed(*pp, symbol(n)))
+               return No;
+       replace(pp, nodecopy(n));
+       return Yes;
+}
+
+
+/*
+ * Fit a string in a hole.
+ * Returns the number of characters consumed.
+ * (This does not have to be the maximum possible, but a reasonable attempt
+ * is made.  If the internal buffer is exhausted, it leaves the rest for
+ * another call.)
+ */
+
+Visible int
+fitstring(pp, str, alt_c)
+       register path *pp;
+       register string str;
+       int alt_c;
+{
+       environ dummyenv;
+       register node n;
+       register int ich;
+       register int len;
+       register string cp;
+       char buf[1024];
+
+       Assert(str);
+       if (!str[0])
+               return 0;
+       if (!insguess(pp, str[0], &dummyenv)) {
+               if (!alt_c)
+                       return 0;
+               if (!insguess(pp, alt_c, &dummyenv))
+                       return 0;
+       }
+       if (Type(tree(*pp)) == Tex)
+               up(pp) || Abort();
+       if (dummyenv.mode == FHOLE) {
+               cp = noderepr(tree(*pp))[0];
+               len = 1;
+               if (cp) {
+                       ++str;
+                       ++cp;
+                       while (*str >= ' ' && *str == *cp) {
+                               ++len;
+                               ++str;
+                               ++cp;
+                       }
+               }
+               return len;
+       }
+       if (dummyenv.mode == VHOLE) {
+               buf[0] = str[0];
+               ++str;
+               len = 1;
+               n = tree(*pp);
+               ich = dummyenv.s1/2;
+               while (*str && mayinsert(n, ich, len, *str) && len < sizeof buf - 1) {
+                       buf[len] = *str;
+                       ++str;
+                       ++len;
+               }
+               if (len > 1) {
+                       buf[len] = 0;
+                       downi(pp, ich) || Abort();
+                       replace(pp, (node) mk_text(buf));
+                       up(pp) || Abort();
+               }
+               return len;
+       }
+       return 1;
+}
+
+
+/*
+ * Set the focus position (some VHOLE/FHOLE setting, probably)
+ * at the 'len'th character from the beginning of the current node.
+ * This may involve going to a child or moving beyond the current subtree.
+ * Negative 'len' values may be given to indicate negative widths;
+ * this is implemented incomplete.
+ */
+
+Visible Procedure
+fixfocus(ep, len)
+       register environ *ep;
+       register int len;
+{
+       node nn;
+       register node n = tree(ep->focus);
+       register string *rp;
+       register int i = 0;
+       register int nch;
+       register int w;
+
+       if (Type(n) == Tex) {
+               w = Length((value)n);
+               Assert(w >= len && len >= 0);
+               if (w > len)
+                       ep->spflag = No;
+               ep->mode = VHOLE;
+               ep->s1 = ichild(ep->focus) * 2;
+               ep->s2 = len;
+               s_up(ep);
+               return;
+       }
+       nch = nchildren(n);
+       w = width(n);
+       if (len > w && w >= 0) {
+               i = ichild(ep->focus); /* Change initial condition for for-loop */
+               if (!up(&ep->focus)) {
+                       ep->mode = ATEND;
+                       return;
+               }
+               higher(ep);
+               n = tree(ep->focus);
+       }
+
+       rp = noderepr(n);
+       for (; i <= nch; ++i) {
+               if (i) {
+                       nn = child(n, i);
+                       w = width(nn);
+                       if (w < 0 || w >= len && len >= 0) {
+                               s_downi(ep, i);
+                               fixfocus(ep, len);
+                               return;
+                       }
+                       if (len >= 0)
+                               len -= w;
+               }
+               w = Fwidth(rp[i]);
+               if (w >= len && len >= 0) {
+                       if (w > len)
+                               ep->spflag = No;
+                       ep->mode = FHOLE;
+                       ep->s1 = 2*i + 1;
+                       ep->s2 = len;
+                       return;
+               }
+               else if (w < 0)
+                       len = 0;
+               else
+                       len -= w;
+       }
+       ep->mode = ATEND;
+}
+
+
+/*
+ * Apply, if possible, a special fix relating to spaces:
+ * when a space has been interpreted as joining character
+ * and we end up in the following hole, but we don't succeed
+ * in filling the hole; it is then tried to delete the hole
+ * and the space.
+ * Usually this doesn't occur, but it may occur when inserting
+ * after a space that was already fixed on the screen but now
+ * deserves re-interpretation.
+ */
+
+Visible bool
+spacefix(ep)
+       environ *ep;
+{
+       path pa;
+       node n;
+       string *rp;
+
+       if (ichild(ep->focus) != 2 || symbol(tree(ep->focus)) != Hole)
+               return No;
+       pa = parent(ep->focus);
+       n = tree(pa);
+       rp = noderepr(n);
+       if (!Fw_zero(rp[0]) || Fwidth(rp[1]) != 1 || rp[1][0] != ' ')
+               return No;
+       n = firstchild(n);
+       if (!allowed(pa, symbol(n)))
+               return No;
+       s_up(ep);
+       replace(&ep->focus, nodecopy(n));
+       ep->mode = ATEND;
+       ep->spflag = Yes;
+       return Yes;
+}
+
+
+/*
+ * Prepend a subset of a node to a queue.
+ */
+
+Visible Procedure
+subsettoqueue(n, s1, s2, pq)
+       register node n;
+       register int s1;
+       register int s2;
+       register queue *pq;
+{
+       register string *rp = noderepr(n);
+
+       for (; s2 >= s1; --s2) {
+               if (s2&1)
+                       stringtoqueue(rp[s2/2], pq);
+               else
+                       preptoqueue(child(n, s2/2), pq);
+       }
+}
+
+#ifdef SHOWBUF
+
+/*
+ * Produce flat text out of a queue's first line, to show it on screen.
+ */
+
+Visible string
+querepr(qv)
+       value qv;
+{
+       queue q = (queue)qv;
+       node n;
+       static char buf[1000]; /***** Cannot overflow? *****/
+       string cp;
+       string sp;
+       string *rp;
+       int nch;
+       int i;
+       int len;
+
+       cp = buf;
+       for (; q; q = q->q_link) {
+               n = q->q_data;
+               if (Type(n) == Tex) {
+                       for (sp = Str((value) n); cp < buf+80 && *sp; ++sp) {
+                               if (!isprint(*sp) && *sp != ' ')
+                                       break;
+                               *cp++ = *sp;
+                       }
+                       if (*sp == '\n') {
+                               if (!emptyqueue(q->q_link)) {
+                                       strcpy(cp, " ...");
+                                       cp += 4;
+                               }
+                               break;
+                       }
+               }
+               else {
+                       rp = noderepr(n);
+                       nch = nchildren(n);
+                       for (i = 0; i <= nch; ++i) {
+                               if (i > 0) {
+                                       if (Type(child(n, i)) == Tex) {
+                                               len = Length((value)child(n, i));
+                                               if (len > 80)
+                                                       len = 80;
+                                               strncpy(cp, Str((value)child(n, i)), len);
+                                               cp += len;
+                                       }
+                                       else {
+                                               strcpy(cp, "...");
+                                               cp += 3;
+                                       }
+                               }
+                               if (Fw_negative(rp[i])) {
+                                       strcpy(cp, " ...");
+                                       cp += 4;
+                                       break;
+                               }
+                               if (Fw_positive(rp[i])) {
+                                       strcpy(cp, rp[i]);
+                                       while (*cp)
+                                               ++cp;
+                                       if (cp[-1] == '\t' || cp[-1] == '\b')
+                                               --cp;
+                               }
+                       }
+               }
+               if (cp >= buf+80) {
+                       strcpy(buf+76, "...");
+                       break;
+               }
+       }
+       *cp = 0;
+       return buf;
+}
+
+#endif SHOWBUF

diff --git a/usr/contrib/B/src/bed/que2.c b/usr/contrib/B/src/bed/que2.c
new file mode 100644 (file)
index 0000000..34b283e
--- /dev/null
+++ b/usr/contrib/B/src/bed/que2.c
@@ -0,0 +1,852 @@
+/* Copyright (c) Stichting Mathematisch Centrum, Amsterdam, 1984. */
+static char rcsid[] = "$Header: que2.c,v 2.3 84/07/23 13:02:38 guido Exp $";
+
+/*
+ * B editor -- Manipulate queues of nodes, higher levels.
+ */
+
+#include <ctype.h>
+
+#include "b.h"
+#include "feat.h"
+#include "bobj.h"
+#include "node.h"
+#include "supr.h"
+#include "queu.h"
+#include "gram.h"
+#include "tabl.h"
+
+
+extern bool lefttorite;
+       /* Set by edit() to signal we parse purely left-to-right */
+extern bool dflag; /* Debug mode even if NDEBUG on */
+
+
+/*
+ * Insert a queue of nodes at the focus
+ * (which had better be some kind of a hole).
+ * The nodes may also be a text, in which case the individual characters
+ * are inserted.
+ * Extensive changes to the parse tree may occur, and the node may be
+ * broken up in its constituent parts (texts and other nodes) which
+ * are then inserted individually.
+ */
+
+Visible bool
+ins_queue(ep, pq, pq2)
+       register environ *ep;
+       register queue *pq;
+       register queue *pq2;
+{
+       register bool ok = Yes;
+       register node n;
+       register queue oldq2;
+       environ saveenv;
+       int oldindentation = focindent(ep);
+       int indentation = oldindentation;
+
+       leftvhole(ep);
+       while (ok && !emptyqueue(*pq)) {
+               n = queuebehead(pq);
+               if (Type(n) == Tex) {
+                       ok = ins_string(ep, Str((value) n), pq2, 0);
+                       switch (Str((value) n)[Length((value) n) - 1]) { /* Last char */
+                       case '\t':
+                               ++indentation;
+                               break;
+                       case '\b':
+                               --indentation;
+                               break;
+                       case '\n':
+                               while (focindent(ep) > indentation) {
+                                       if (!ins_newline(ep))
+                                               break;
+                               }
+                               break;
+                       }
+               }
+               else {
+                       Ecopy(*ep, saveenv);
+                       oldq2 = qcopy(*pq2);
+                       if (!ins_node(&saveenv, n, pq2)) {
+                               Erelease(saveenv);
+                               qrelease(*pq2);
+                               *pq2 = oldq2;
+                               if (symbol(n) == Hole)
+                                       ok = ins_string(ep, "?", pq2, 0);
+                               else
+                                       splitnode(n, pq);
+                       }
+                       else {
+                               Erelease(*ep);
+                               Emove(saveenv, *ep);
+                               qrelease(oldq2);
+                       }
+               }
+               noderelease(n);
+       }
+       if (!ok)
+               qshow(*pq, "ins_queue");
+       qrelease(*pq);
+       for (indentation = focindent(ep);
+               indentation > oldindentation; --indentation)
+               stringtoqueue("\b", pq2); /* Pass on indentation to outer level */
+       return ok;
+}
+
+
+/*
+ * Subroutine to insert a queue to the right of the focus
+ * without affecting the focus position.
+ */
+
+Visible bool
+app_queue(ep, pq)
+       environ *ep;
+       queue *pq;
+{
+       int where;
+       static int markbit = 1; /* To properly handle recursive calls */
+
+       if (emptyqueue(*pq))
+               return Yes;
+       where = focoffset(ep);
+       markbit <<= 1;
+       markpath(&ep->focus, markbit);
+       if (!ins_queue(ep, pq, pq)) {
+               markbit >>= 1;
+               return No;
+       }
+       firstmarked(&ep->focus, markbit) || Abort();
+       unmkpath(&ep->focus, markbit);
+       markbit >>= 1;
+       ep->spflag = No;
+       fixfocus(ep, where);
+       return Yes;
+}
+
+
+/*
+ * Advance to next thing after current position.
+ */
+
+Visible bool
+move_on(ep)
+       register environ *ep;
+{
+       register node n;
+       register string *rp;
+       register int sym;
+       register int ich = ichild(ep->focus);
+
+       if (!up(&ep->focus))
+               return No;
+       higher(ep);
+       n = tree(ep->focus);
+       rp = noderepr(n);
+       if (Fw_positive(rp[ich])) {
+               ep->mode = FHOLE;
+               ep->s1 = 2*ich + 1;
+               ep->s2 = 0;
+               if (ep->spflag) {
+                       ep->spflag = No;
+                       if (rp[ich][0] == ' ') {
+                               ++ep->s2;
+                               if (fwidth(rp[ich]) > 1)
+                                       return Yes;
+                       }
+                       else
+                               return Yes;
+               }
+               else
+                       return Yes;
+       }
+       if (ich < nchildren(n)) {
+               s_downi(ep, ich+1);
+               sym = symbol(tree(ep->focus));
+               if (sym == Hole || sym == Optional)
+                       ep->mode = WHOLE;
+               else
+                       ep->mode = ATBEGIN;
+               return Yes;
+       }
+       ep->mode = ATEND;
+       return Yes;
+}
+
+
+/*
+ * Like move_on but moves through fixed texts, skipping only spaces
+ * and empty strings.
+ * <<<<< This code is a dinosaur and should be revised. >>>>>
+ */
+
+Visible bool
+fix_move(ep)
+       register environ *ep;
+{
+       register int ich;
+       register int i;
+       register string *rp;
+       register string cp;
+
+       Assert(ep->mode == FHOLE);
+
+       ich = ep->s1/2;
+       rp = noderepr(tree(ep->focus));
+       cp = rp[ich];
+       if (cp) {
+               i = ep->s2;
+               Assert(i <= Fwidth(cp));
+               if (cp[i] == ' ') {
+                       do {
+                               ++i;
+                       } while (cp[i] == ' ');
+               }
+               if (cp[i] == '\b' || cp[i] == '\t') {
+                       ++i;
+                       Assert(!cp[i]);
+               }
+               else if (cp[i]) {
+                       if (i == ep->s2)
+                               return No;
+                       ep->s2 = i;
+                       return Yes;
+               }
+       }
+
+       if (ich >= nchildren(tree(ep->focus)))
+               ep->mode = ATEND;
+       else {
+               s_downi(ep, ich+1);
+               if (symbol(tree(ep->focus)) == Hole
+                       || symbol(tree(ep->focus)) == Optional)
+                       ep->mode = WHOLE;
+               else
+                       ep->mode = ATBEGIN;
+       }
+       return Yes;
+}
+
+
+/*
+ * Insert a node in the parse tree.
+ */
+
+Hidden bool
+ins_node(ep, n, pq)
+       register environ *ep;
+       register node n;
+       register queue *pq;
+{
+       register int sym;
+       register node nn;
+       register markbits x;
+       string *rp;
+
+       if (symbol(n) == Optional)
+               return Yes;
+
+       for (;;) {
+               switch (ep->mode) {
+
+               case FHOLE:
+                       if (ep->s2 < lenitem(ep) || !fix_move(ep))
+                               return No;
+                       continue;
+
+               case VHOLE:
+                       if (ep->s2 < lenitem(ep) || !move_on(ep))
+                               return No;
+                       continue;
+
+               case ATBEGIN:
+                       sym = symbol(tree(ep->focus));
+                       if (sym == Optional || sym == Hole) {
+                               ep->mode = WHOLE;
+                               continue;
+                       }
+                       x = marks(tree(ep->focus));
+                       if (joinnodes(&ep->focus, n, tree(ep->focus), No)) {
+                               if (x) {
+                                       s_downi(ep, 2);
+                                       markpath(&ep->focus, x);
+                                       s_up(ep);
+                               }
+                               s_down(ep);
+                               ep->mode = ATEND;
+                               leftvhole(ep);
+                               return Yes;
+                       }
+                       nn = tree(ep->focus);
+                       rp = noderepr(nn);
+                       if (nchildren(nn) >= 1 && Fw_zero(rp[0])) {
+                               sym = symbol(firstchild(nn));
+                               if (sym == Hole || sym == Optional) {
+                                       s_down(ep);
+                                       if (fitnode(&ep->focus, n)) {
+                                               ep->mode = ATEND;
+                                               leftvhole(ep);
+                                               return Yes;
+                                       }
+                                       s_up(ep);
+                               }
+                       }
+                       nn = nodecopy(nn);
+                       if (!fitnode(&ep->focus, n)) {
+                               addtoqueue(pq, nn);
+                               noderelease(nn);
+                               delfocus(&ep->focus);
+                               ep->mode = WHOLE;
+                               continue;
+                       }
+                       if (downrite(&ep->focus)) {
+                               if (Type(tree(ep->focus)) != Tex) {
+                                       sym = symbol(tree(ep->focus));
+                                       if (sym == Hole || sym == Optional) {
+                                               if (fitnode(&ep->focus, nn)) {
+                                                       noderelease(nn);
+                                                       nn = Nnil;
+                                               }
+                                       }
+                               }
+                               else
+                                       up(&ep->focus);
+                       }
+                       if (nn) {
+                               addtoqueue(pq, nn);
+                               noderelease(nn);
+                       }
+                       ep->mode = ATEND;
+                       leftvhole(ep);
+                       return Yes;
+
+               case WHOLE:
+                       sym = symbol(tree(ep->focus));
+                       Assert(sym == Optional || sym == Hole);
+                       do {
+                               higher(ep); /* Only for second time around */
+                               if (fitnode(&ep->focus, n)) {
+                                       ep->mode = ATEND;
+                                       leftvhole(ep);
+                                       return Yes;
+                               }
+                       } while (resttoqueue(&ep->focus, pq));
+                       ep->mode = ATEND;
+                       /* Fall through */
+               case ATEND:
+                       do {
+                               higher(ep); /* Only for second time around */
+                               if (joinnodes(&ep->focus, tree(ep->focus), n, ep->spflag)) {
+                                       ep->spflag = No;
+                                       leftvhole(ep);
+                                       return Yes;
+                               }
+                       } while (resttoqueue(&ep->focus, pq)
+                               || move_on(ep) && ep->mode == ATEND);
+                       return No;
+
+               default:
+                       return No;
+
+               }
+       }
+}
+
+
+/*
+ * Insert a string in the parse tree.
+ */
+
+#define NEXT (++str, alt_c = 0)
+
+Visible bool
+ins_string(ep, str, pq, alt_c)
+       register environ *ep;
+       /*auto*/ string str;
+       register queue *pq;
+       int alt_c;
+{
+       register node nn;
+       auto value v;
+       char buf[1024];
+       register string repr;
+       string oldstr;
+       register int sym;
+       register int len;
+       bool interactive = alt_c != 0;
+
+       if (alt_c < 0)
+               alt_c = 0;
+       while (*str) {
+               switch (*str) {
+
+               case '\n':
+                       if (!ins_newline(ep))
+                               return No;
+                       /* Fall through */
+               case '\t':
+               case '\b':
+                       NEXT;
+                       continue;
+
+               }
+               switch (ep->mode) {
+
+               case ATBEGIN:
+                       nn = tree(ep->focus);
+                       if (Type(nn) == Tex) {
+                               ep->s1 = 2*ichild(ep->focus);
+                               ep->s2 = 0;
+                               ep->mode = VHOLE;
+                               s_up(ep);
+                               continue;
+                       }
+                       sym = symbol(nn);
+                       if (sym != Optional && sym != Hole) {
+                               if (fwidth(noderepr(nn)[0]) == 0) {
+                                       if (down(&ep->focus))
+                                               break;
+                               }
+                               addtoqueue(pq, nn);
+                               delfocus(&ep->focus);
+                       }
+                       ep->mode = WHOLE;
+                       /* Fall through */
+               case WHOLE:
+                       nn = tree(ep->focus);
+                       sym = symbol(nn);
+                       Assert(sym == Hole || sym == Optional);
+                       while ((len = fitstring(&ep->focus, str, alt_c)) == 0) {
+                               if (sym == Optional) {
+                                       if (!move_on(ep)) {
+                                               if (*str == ' ')
+                                                       NEXT;
+                                               else
+                                                       return No;
+                                       }
+                                       break;
+                               }
+                               if (!interactive && *str == '?') {
+                                       NEXT;
+                                       ep->mode = ATEND;
+                                       break;
+                               }
+                               if (resttoqueue(&ep->focus, pq))
+                                       higher(ep);
+                               else if (spacefix(ep))
+                                       break;
+                               else if (*str == ' ') {
+                                       NEXT;
+                                       break;
+                               }
+                               else if (interactive)
+                                       return No;
+                               else {
+                                       ep->mode = ATEND;
+                                       break;
+                               }
+                       }
+                       if (len > 0) {
+                               str += len;
+                               alt_c = 0;
+                               fixfocus(ep, len);
+                       }
+                       break;
+
+               case ATEND:
+                       if (add_string(ep, &str, alt_c)) {
+                               alt_c = 0;
+                               break;
+                       }
+                       len = joinstring(&ep->focus, str, ep->spflag,
+                               alt_c ? alt_c : interactive ? -1 : 0, Yes);
+                       if (len > 0) {
+                               s_downi(ep, 2);
+                               ep->spflag = No;
+                               fixfocus(ep, len);
+                       }
+                       else {
+                               if (resttoqueue(&ep->focus, pq)) {
+                                       higher(ep);
+                                       break;
+                               }
+                               if (move_on(ep))
+                                       break;
+                               if (*str == ' ') {
+                                       NEXT;
+                                       break;
+                               }
+                               return No;
+                       }
+                       str += len;
+                       alt_c = 0;
+                       break;
+
+               case FHOLE:
+                       nn = tree(ep->focus);
+                       repr = noderepr(nn)[ep->s1/2];
+                       if (ep->s2 >= fwidth(repr)
+                               && (ep->s2 <= 0 || ep->spflag || !isalpha(repr[0])
+                                       || repr[ep->s2-1] == ' ')) { /* At end */
+                               if (ep->s1/2 < nchildren(nn)) {
+                                       s_downi(ep, ep->s1/2 + 1);
+                                       ep->mode = ATBEGIN; /* Of next child */
+                               }
+                               else
+                                       ep->mode = ATEND;
+                               break;
+                       }
+                       if ((*str == ':' || *str == ' ') && *str == repr[ep->s2]) {
+                               /*****
+                                * Quick hack for insertion of test-suites and refinements:
+                                *****/
+                               ++ep->s2;
+                               NEXT;
+                               continue;
+                       }
+                       if (!lefttorite)
+                               nosuggtoqueue(ep, pq);
+                       oldstr = str;
+                       if (resuggest(ep, &str, alt_c) || soften(ep, &str, alt_c)) {
+                               if (str > oldstr)
+                                       alt_c = 0;
+                               continue;
+                       }
+                       if (fix_move(ep))
+                               continue;
+                       return No;
+
+               case VHOLE:
+                       Assert(!(ep->s1&1));
+                       nn = tree(ep->focus);
+#ifdef USERSUGG
+                       if (symbol(nn) == Suggestion) {
+                               if (newsugg(ep, &str, alt_c))
+                                       alt_c = 0;
+                               else
+                                       killsugg(ep);
+                               continue;
+                       }
+#endif USERSUGG
+                       s_downi(ep, ep->s1/2);
+                       v = copy((value) tree(ep->focus));
+                       len = 0;
+                       if (!ep->spflag) {
+                               for (; len < sizeof buf - 1 && str[len]
+                                               && mayinsert(nn, ep->s1/2, !!(ep->s2 + len),
+                                                       str[len]);
+                                       ++len) {
+                                       buf[len] = str[len];
+                               }
+                               if (len <= 0 && alt_c
+                                       && mayinsert(nn, ep->s1/2, !!(ep->s2 + len), alt_c)) {
+                                       buf[0] = alt_c;
+                                       len = 1;
+                               }
+                       }
+                       if (len > 0) { /* Effectuate change */
+                               str += len;
+                               alt_c = 0;
+                               Assert(Type(v) == Tex);
+                               buf[len] = 0;
+                               putintrim(&v, ep->s2, Length(v) - ep->s2, buf);
+                               replace(&ep->focus, (node) v);
+                               s_up(ep);
+                               ep->spflag = No;
+                               ep->s2 += len;
+                       }
+                       else { /* Nothing inserted */
+                               if (ep->s2 == 0) { /* Whole string rejected */
+                                       addtoqueue(pq, (node)v);
+                                       release(v);
+                                       s_up(ep);
+                                       delfocus(&ep->focus);
+                                       ep->mode = WHOLE;
+                                       break;
+                               }
+                               if (ep->s2 < Length(v)) {
+                                       addstringtoqueue(pq, Str(v) + ep->s2);
+                                       putintrim(&v, ep->s2, 0, "");
+                                       replace(&ep->focus, (node) v);
+                               }
+                               else
+                                       release(v);
+                               move_on(ep) || Abort(); /* ==> up, cancelling s_downi! */
+                       }
+                       break;
+
+               default:
+                       Abort();
+
+               }
+       }
+
+       return Yes;
+}
+
+
+/*
+ * See if two nodes can be joined in a hole.
+ * 'Spflag' indicates whether a space must be present between the nodes
+ * (required or forbidden).
+ * Either of n1, n2 may actually be the current contents of the hole.
+ */
+
+Hidden bool
+joinnodes(pp, n1, n2, spflag)
+       path *pp;
+       node n1;
+       node n2;
+       bool spflag;
+{
+       path pa = parent(*pp);
+       int sympa = pa ? symbol(tree(pa)) : Rootsymbol;
+       struct table *tp = &table[sympa];
+       struct classinfo *ci = tp->r_class[ichild(*pp) - 1];
+       classptr cp = ci->c_join;
+       int sym1 = symbol(n1);
+       int sym2 = symbol(n2);
+       int symcp;
+       int symfound = -1;
+
+       if (!cp)
+               return No;
+       for (; *cp; cp += 2) {
+               if (cp[0] != spflag + 1)
+                       continue;
+               symcp = cp[1];
+               tp = &table[symcp];
+               if (isinclass(sym1, tp->r_class[0])
+                       && isinclass(sym2, tp->r_class[1])) {
+                       symfound = symcp;
+                       break;
+               }
+       }
+
+       if (symfound < 0)
+               return No;
+       n1 = nodecopy(n1);
+       n2 = nodecopy(n2); /* 'Cause one of them may overlap tree(*pp) */
+       replace(pp, table[symfound].r_node);
+       down(pp) || Abort();
+       replace(pp, n1);
+       rite(pp) || Abort();
+       replace(pp, n2);
+       up(pp) || Abort();
+       return Yes;
+}
+
+
+/*
+ * Try to join a node (implicit as tree(*pp)) with some text.
+ * That is, try to replace the node by one with it as first child,
+ * (some of) the text as second child, and nothing or a space in between.
+ *
+ * 'Spflag' indicates whether a space is desirable between the nodes
+ * (but if No it is only used as advice).
+ *
+ * Returns the number of characters consumed from str.
+ */
+
+Visible int
+joinstring(pp, str, spflag, alt_c, mayindent)
+       path *pp;
+       register string str;
+       register bool spflag;
+       int alt_c;
+       bool mayindent;
+{
+       register struct table *tp;
+       path pa = parent(*pp);
+       node n1;
+       struct classinfo *ci;
+       register classptr cp;
+       int sympa = pa ? symbol(tree(pa)) : Rootsymbol;
+       register int sym1;
+       register int symcp;
+       int symfound;
+       int len;
+       char buf[2];
+       bool interactive = alt_c != 0;
+
+       if (alt_c < 0)
+               alt_c = 0;
+       ci = table[sympa].r_class[ichild(*pp) - 1];
+       Assert(ci);
+       cp = ci->c_join;
+       if (!cp)
+               return 0;
+
+       n1 = tree(*pp);
+       sym1 = symbol(n1);
+       symfound = -1;
+       for (; *cp; cp += 2) {
+               if (cp[0] < spflag + 1)
+                       continue;
+               symcp = cp[1];
+               tp = &table[symcp];
+               if (!mayindent && tp->r_repr[1] && index(tp->r_repr[1], '\t'))
+                       continue;
+               if (isinclass(sym1, tp->r_class[0])
+                       && ((canfitchar(str[0], tp->r_class[1]))
+                               || str[0] == '?' && !interactive)) {
+                       if (cp[0] == spflag + 1) {
+                               symfound = symcp;
+                               break;
+                       }
+                       if (symfound < 0)
+                               symfound = symcp;
+               }
+       }
+
+       if (symfound < 0) { /* 1-level recursion */
+               if (!alt_c)
+                       return 0;
+               buf[0] = alt_c;
+               buf[1] = 0;
+               return joinstring(pp, buf, spflag, 0, mayindent);
+       }
+       n1 = nodecopy(n1); /* 'Cause it overlaps tree(*pp) */
+       replace(pp, table[symfound].r_node);
+       down(pp) || Abort();
+       replace(pp, n1);
+       rite(pp) || Abort();
+       len = fitstring(pp, str, 0);
+       if (len == 0 && str[0] == '?')
+               len = 1;
+       Assert(len > 0); /* Disagreement between canfitchar and fitstring */
+       up(pp) || Abort();
+       return len;
+}
+
+
+/*
+ * Similar to joinstring, but now the string must match the delimiter
+ * rather than being acceptable as second child.
+ * (Interface has changed to resemble resuggest/soften.)
+ */
+
+Hidden bool
+add_string(ep, pstr, alt_c)
+       environ *ep;
+       string *pstr;
+       int alt_c; /* Yet unused */
+{
+       register struct table *tp;
+       path pa = parent(ep->focus);
+       node n1;
+       struct classinfo *ci;
+       register classptr cp;
+       int sympa = pa ? symbol(tree(pa)) : Rootsymbol;
+       register int sym1;
+       register int symcp;
+       register int c;
+
+       ci = table[sympa].r_class[ichild(ep->focus) - 1];
+       Assert(ci);
+       cp = ci->c_append;
+       if (!cp)
+               return No;
+       n1 = tree(ep->focus);
+       sym1 = symbol(n1);
+       c = **pstr;
+       for (; *cp; cp += 2) {
+               if ((*cp&0177) != c)
+                       continue;
+               symcp = cp[1];
+               tp = &table[symcp];
+               if (isinclass(sym1, tp->r_class[0]))
+                       break;
+       }
+       if (!*cp)
+               return No;
+       ++*pstr;
+       if (c == ' ') {
+               ep->spflag = Yes;
+               return Yes;
+       }
+       n1 = nodecopy(n1); /* 'Cause it overlaps tree(ep->focus) */
+       replace(&ep->focus, table[symcp].r_node);
+       s_down(ep);
+       replace(&ep->focus, n1);
+       s_up(ep);
+       ep->mode = FHOLE;
+       ep->s1 = 3;
+       ep->s2 = (*cp&0200) ? 2 : 1;
+       ep->spflag = No;
+       return Yes;
+}
+
+
+/*
+ * See whether a character may start a new node in a hole with given class.
+ */
+
+Visible bool
+canfitchar(c, ci)
+       int c;
+       struct classinfo *ci;
+{
+       register classptr cp;
+       register int code = Code(c);
+
+       Assert(ci);
+       cp = ci->c_insert;
+       Assert(cp);
+       for (; *cp; cp += 2) {
+               if (cp[0] == code)
+                       return Yes;
+       }
+       return No;
+}
+
+
+/*
+ * Debug routine to print a queue.
+ */
+
+Visible Procedure
+qshow(q, where)
+       queue q;
+       string where;
+{
+#ifndef NDEBUG
+       node n;
+       char buf[256];
+       string cp;
+       string sp;
+
+       sprintf(buf, "%s:", where);
+       cp = buf + strlen(buf);
+       for (;q; q = q->q_link) {
+               n = q->q_data;
+               *cp++ = ' ';
+               if (Type(n) == Tex) {
+                       *cp++ = '"';
+                       for (sp = Str((value) n); *sp; ++sp) {
+                               if (isprint(*sp) || *sp == ' ') {
+                                       *cp++ = *sp;
+                                       if (*sp == '"')
+                                               *cp++ = *sp;
+                               }
+                               else {
+                                       sprintf(cp, "\\%03o", *sp&0377);
+                                       cp += 4;
+                               }
+                       }
+                       *cp++ = '"';
+               }
+               else {
+                       strncpy(cp, table[symbol(n)].r_name, 80);
+                       cp += strlen(cp);
+               }
+               if (cp >= buf+80) {
+                       strcpy(buf+76, "...");
+                       break;
+               }
+       }
+       *cp = 0;
+       debug(buf);
+#endif NDEBUG
+}

diff --git a/usr/contrib/B/src/bed/save.c b/usr/contrib/B/src/bed/save.c
new file mode 100644 (file)
index 0000000..d03f9e4
--- /dev/null
+++ b/usr/contrib/B/src/bed/save.c
@@ -0,0 +1,244 @@
+/* Copyright (c) Stichting Mathematisch Centrum, Amsterdam, 1984. */
+static char rcsid[] = "$Header: save.c,v 2.5 85/08/22 16:07:04 timo Exp $";
+
+/*
+ * B editor -- Save Parse tree on file.
+ */
+
+#include <ctype.h>
+
+#include "b.h"
+#include "feat.h"
+#include "bobj.h"
+#include "node.h"
+#include "gram.h"
+#include "queu.h"
+
+#define Indent "    " /* Output for each indentation level */
+
+Hidden int spaces = 0; /* Saved-up spaces; emitted when non-blank found */
+
+#ifdef BTOP
+#include <setjmp.h>
+
+Hidden bool piping; /* Set if output goes to B interpreter */
+Hidden jmp_buf alas; /* Where to go when no command prompt gotten */
+#endif
+
+/*
+ * Write the representation of a node.  If it has children,
+ * they are written by recursive calls.
+ */
+
+Hidden Procedure
+savewalk(n, level, file)
+       node n;
+       int level;
+       FILE *file;
+{
+       string *rp;
+       string cp;
+       int nch;
+       int i;
+       char c;
+
+       if (Type(n) == Tex) {
+               for (; spaces > 0; --spaces)
+                       putc(' ', file);
+               fputs(Str((value)n), file);
+               return;
+       }
+       nch = nchildren(n);
+       rp = noderepr(n);
+       for (i = 0; i <= nch; ++i) {
+               if (i)
+                       savewalk(child(n, i), level, file);
+               cp = rp[i];
+               if (cp) {
+                       for (; c = *cp; ++cp) {
+                               switch (c) {
+
+                               case '\n':
+                               case '\r':
+                                       putc('\n', file);
+#ifdef BTOP
+                                       if (piping) {
+                                               if (!expect(">>> "))
+                                                       longjmp(alas, 1);
+                                       }
+#endif BTOP
+                                       if (c == '\n')
+                                               for (i = level; i > 0; --i)
+                                                       fputs(Indent, file);
+                                       spaces = 0;
+                                       break;
+
+                               case '\b':
+                                       --level;
+                                       break;
+
+                               case '\t':
+                                       ++level;
+                                       break;
+
+                               case ' ':
+                                       ++spaces;
+                                       break;
+
+                               default:
+                                       for (; spaces > 0; --spaces)
+                                               putc(' ', file);
+                                       putc(c, file);
+                                       break;
+
+                               }
+                       }
+               }
+       }
+}
+
+
+/*
+ * Save the entire Parse tree.
+ */
+
+Visible bool
+save(p, filename)
+       path p;
+       string filename;
+{
+       FILE *file = fopen(filename, "w");
+
+       if (!file)
+               return No;
+#ifdef BTOP
+       piping = No;
+#endif BTOP
+       sendsave(p, file);
+       return fclose(file) != EOF;
+}
+
+
+Hidden Procedure
+sendsave(p, file)
+       path p;
+       FILE *file;
+{
+       p = pathcopy(p);
+       top(&p);
+       spaces = 0;
+       savewalk(tree(p), 0, file);
+       putc('\n', file);
+       pathrelease(p);
+}
+
+#ifdef BTOP
+
+/*
+ * Interface to top level.
+ */
+
+Visible bool
+send(p, pdown)
+       path p;
+       FILE *pdown;
+{
+       piping = Yes;
+       if (setjmp(alas)) {
+               pathrelease(p);
+               return No;
+       }
+       sendsave(p, pdown);
+       if (expect(">>> "))
+               putc('\n', pdown);
+       return Yes;
+}
+#endif BTOP
+
+/* ------------------------------------------------------------------ */
+
+#ifdef SAVEBUF
+
+/*
+ * Write a node.
+ */
+
+Hidden Procedure
+writenode(n, fp)
+       node n;
+       FILE *fp;
+{
+       int nch;
+       int i;
+
+       if (!n) {
+               fputs("(0)", fp);
+               return;
+       }
+       if (((value)n)->type == Tex) {
+               writetext((value)n, fp);
+               return;
+       }
+       nch = nchildren(n);
+       fprintf(fp, "(%s", symname(symbol(n)));
+       for (i = 1; i <= nch; ++i) {
+               putc(',', fp);
+               writenode(child(n, i), fp);
+       }
+       fputc(')', fp);
+}
+
+
+Hidden Procedure
+writetext(v, fp)
+       value v;
+       FILE *fp;
+{
+       string str;
+       int c;
+
+       Assert(v && Type(v) == Tex);
+       putc('\'', fp);
+       str = Str(v);
+       for (str = Str(v); *str; ++str) {
+               c = *str;
+               if (c == ' ' || isprint(c)) {
+                       putc(c, fp);
+                       if (c == '\'' || c == '`')
+                               putc(c, fp);
+               }
+               else if (isascii(c))
+                       fprintf(fp, "`$%d`", c);
+       }
+       putc('\'', fp);
+}
+
+
+Visible bool
+savequeue(v, filename)
+       value v;
+       string filename;
+{
+       register FILE *fp;
+       auto queue q = (queue)v;
+       register node n;
+       register bool ok;
+       register int lines = 0;
+
+       fp = fopen(filename, "w");
+       if (!fp)
+               return No;
+       q = qcopy(q);
+       while (!emptyqueue(q)) {
+               n = queuebehead(&q);
+               writenode(n, fp);
+               putc('\n', fp);
+               ++lines;
+               noderelease(n);
+       }
+       ok = fclose(fp) != EOF;
+       if (!lines)
+               /* Try to */ unlink(filename); /***** UNIX! *****/
+       return ok;
+}
+#endif SAVEBUF

diff --git a/usr/contrib/B/src/bed/scrn.c b/usr/contrib/B/src/bed/scrn.c
new file mode 100644 (file)
index 0000000..5b4877e
--- /dev/null
+++ b/usr/contrib/B/src/bed/scrn.c
@@ -0,0 +1,480 @@
+/* Copyright (c) Stichting Mathematisch Centrum, Amsterdam, 1984. */
+static char rcsid[] = "$Header: scrn.c,v 2.5 85/08/22 16:07:10 timo Exp $";
+
+/*
+ * B editor -- Screen management package, higher level routines.
+ */
+
+#include "b.h"
+#include "erro.h"
+#include "bobj.h"
+#include "node.h"
+#include "supr.h"
+#include "gram.h"
+#include "cell.h"
+
+
+extern bool dflag;
+
+cell *gettop();
+extern int focy;
+extern int focx;
+
+Visible int winstart;
+
+Visible int winheight;
+Visible int indent;
+Visible int llength;
+
+Visible bool noscroll;
+Visible bool nosense;
+
+Hidden cell *tops;
+
+
+/*
+ * Actual screen update.
+ */
+
+Visible Procedure
+actupdate(copybuffer, recording, lasttime)
+       value copybuffer;
+       bool recording;
+       bool lasttime; /* Yes if called from final screen update */
+{
+       register cell *p;
+       cell *top = tops;
+       register int diff;
+       register int curlno;
+       register int delcnt = 0; /* Lines deleted during the process. */
+               /* Used as offset for lines that are on the screen. */
+       int totlines = 0;
+       int topline = 0;
+       int scrlines = 0;
+
+       if (winstart > 0)
+               growwin();
+       if (winstart <= 0) {
+               top = gettop(tops);
+               for (p = tops; p && p != top; p = p->c_link)
+                       ++topline;
+               totlines = topline;
+       }
+       startactupdate(lasttime);
+       focy = Nowhere;
+       for (p = top, curlno = winstart; p && curlno < winheight;
+               curlno += Space(p), p = p->c_link) {
+               ++scrlines;
+               if (lasttime) {
+                       p->c_newfocus = No;
+                       p->c_newvhole = 0;
+               }
+               if (p->c_onscreen != Nowhere && Space(p) == Oldspace(p)) {
+                       /* Old comrade */
+                       diff = p->c_onscreen - (curlno+delcnt);
+                       /* diff can't be negative due to 'makeroom' below! */
+                       if (diff > 0) { /* Get him here */
+                               trmscrollup(curlno, winheight, diff);
+                               delcnt += diff;
+                       }
+                       if (p->c_oldfocus || p->c_newfocus
+                               || p->c_oldindent != p->c_newindent
+                               || p->c_onscreen + Space(p) >= winheight) {
+                               delcnt = make2room(p, curlno, delcnt);
+                               outline(p, curlno);
+                       }
+               }
+               else { /* New guy, make him toe the line */
+                       delcnt = makeroom(p, curlno, delcnt);
+                       delcnt = make2room(p, curlno, delcnt);
+                       outline(p, curlno);
+               }
+               p->c_onscreen = curlno;
+               p->c_oldindent = p->c_newindent;
+               p->c_oldvhole = p->c_newvhole;
+               p->c_oldfocus = p->c_newfocus;
+       }
+       totlines += scrlines;
+       for (; p; p = p->c_link) { /* Count rest and remove old memories */
+               ++totlines;
+               /* This code should never find any garbage?! */
+#ifndef NDEBUG
+               if (p->c_onscreen != Nowhere)
+                       debug("[Garbage removed from screen list]");
+#endif NDEBUG
+               p->c_onscreen = Nowhere;
+       }
+       trmscrollup(curlno, winheight, -delcnt);
+       curlno += delcnt;
+       if (curlno < winheight) { /* Clear lines beyond end of unit */
+               trmputdata(curlno, winheight-1, 0, "");
+               scrlines += winheight-curlno;
+       }
+       if (!lasttime) {
+               stsline(totlines, topline, scrlines, copybuffer, recording);
+               if (focy != Nowhere)
+                       trmsync(focy, focx);
+               else
+                       trmsync(winheight, 0);
+       }
+       endactupdate();
+}
+
+
+/*
+ * Grow the window if not maximum size.
+ */
+
+Hidden Procedure
+growwin()
+{
+       register int winsize;
+       register int growth;
+       register cell *p;
+
+       winsize = 0;
+       for (p = tops; p; p = p->c_link)
+               winsize += Space(p);
+       if (winsize <= winheight - winstart)
+               return; /* No need to grow */
+       if (winsize > winheight)
+               winsize = winheight; /* Limit size to maximum available */
+
+       growth = winsize - (winheight - winstart);
+       trmscrollup(0, winheight - (winstart!=winheight), growth);
+       winstart -= growth;
+       for (p = tops; p; p = p->c_link) {
+               if (p->c_onscreen != Nowhere)
+                       p->c_onscreen -= growth;
+       }
+}
+
+
+/*
+ * Make room for possible insertions.
+ * (If a line is inserted, it may be necessary to delete lines
+ * further on the screen.)
+ */
+
+Hidden Procedure
+makeroom(p, curlno, delcnt)
+       register cell *p;
+       register int curlno;
+       register int delcnt;
+{
+       register int here = 0;
+       register int need = Space(p);
+       register int amiss;
+       int avail;
+       int diff;
+
+       Assert(p);
+       do {
+               p = p->c_link;
+               if (!p)
+                       return delcnt;
+       } while (p->c_onscreen == Nowhere);
+       here = p->c_onscreen - delcnt;
+       avail = here - curlno;
+       amiss = need - avail;
+#ifndef NDEBUG
+       if (dflag)
+               debug("[makeroom: curlno=%d, delcnt=%d, here=%d, avail=%d, amiss=%d]",
+                       curlno, delcnt, here, avail, amiss);
+#endif NDEBUG
+       if (amiss <= 0)
+               return delcnt;
+       if (amiss > delcnt) {
+               for (; p; p = p->c_link) {
+                       if (p->c_onscreen != Nowhere) {
+                               diff = amiss-delcnt;
+                               if (p->c_onscreen - delcnt - here < diff)
+                                       diff = p->c_onscreen - delcnt - here;
+                               if (diff > 0) {
+                                       trmscrollup(here, winheight, diff);
+                                       delcnt += diff;
+                               }
+                               p->c_onscreen += -delcnt + amiss;
+                               here = p->c_onscreen - amiss;
+                               if (p->c_onscreen >= winheight)
+                                       p->c_onscreen = Nowhere;
+                       }
+                       here += Space(p);
+               }
+               /* Now for all p encountered whose p->c_onscreen != Nowhere,
+               /* p->c_onscreen - amiss is its actual position. */
+               if (amiss > delcnt) {
+                       trmscrollup(winheight - amiss, winheight, amiss-delcnt);
+                       delcnt = amiss;
+               }
+       }
+       /* Now amiss <= delcnt */
+       trmscrollup(curlno + avail, winheight, -amiss);
+       return delcnt - amiss;
+}
+
+
+/*
+ * Addition to makeroom - make sure the status line is not overwritten.
+ * Returns new delcnt, like makeroom does.
+ */
+
+Hidden int
+make2room(p, curlno, delcnt)
+       cell *p;
+       int curlno;
+       int delcnt;
+{
+       int nextline = curlno + Space(p);
+       int sline = winheight - delcnt;
+       int diff;
+
+       if (sline < curlno) {
+#ifndef NDEBUG
+               debug("[Status line overwritten]");
+#endif NDEBUG
+               return delcnt;
+       }
+       if (nextline > winheight)
+               nextline = winheight;
+       diff = nextline - sline;
+       if (diff > 0) {
+               trmscrollup(sline, winheight, -diff);
+               delcnt -= diff;
+       }
+       return delcnt;
+               
+}
+
+
+/*
+ * Routine called for every change in the screen.
+ */
+
+Visible Procedure
+virtupdate(oldep, newep, highest)
+       environ *oldep;
+       environ *newep;
+       int highest;
+{
+       environ old;
+       environ new;
+       register int oldlno;
+       register int newlno;
+       register int oldlcnt;
+       register int newlcnt;
+       register int i;
+
+       if (!oldep) {
+               highest = 1;
+               trmputdata(winstart, winheight, indent, "");
+               discard(tops);
+               tops = Cnil;
+               Ecopy(*newep, old);
+       }
+       else {
+               Ecopy(*oldep, old);
+       }
+       Ecopy(*newep, new);
+
+       savefocus(&new);
+
+       oldlcnt = fixlevels(&old, &new, highest);
+       newlcnt = -width(tree(new.focus));
+       if (newlcnt < 0)
+               newlcnt = 0;
+       i = -width(tree(old.focus));
+       if (i < 0)
+               i = 0;
+       newlcnt -= i - oldlcnt;
+               /* Offset newlcnt as much as oldcnt is offset */
+       
+       oldlno = Ycoord(old.focus);
+       newlno = Ycoord(new.focus);
+       if (!atlinestart(&old))
+               ++oldlcnt;
+       else
+               ++oldlno;
+       if (!atlinestart(&new))
+               ++newlcnt;
+       else
+               ++newlno;
+       Assert(oldlno == newlno);
+
+       tops = replist(tops, build(new.focus, newlcnt), oldlno, oldlcnt);
+
+       setfocus(tops); /* Incorporate the information saved by savefocus */
+
+       Erelease(old);
+       Erelease(new);
+}
+
+
+Hidden bool
+atlinestart(ep)
+       environ *ep;
+{
+       register string repr = noderepr(tree(ep->focus))[0];
+
+       return Fw_negative(repr);
+}
+
+
+/*
+ * Make the two levels the same, and make sure they both are line starters
+ * if at all possible.  Return the OLD number of lines to be replaced.
+ * (0 if the whole unit has no linefeeds.)
+ */
+
+Hidden int
+fixlevels(oldep, newep, highest)
+       register environ *oldep;
+       register environ *newep;
+       register int highest;
+{
+       register int oldpl = pathlength(oldep->focus);
+       register int newpl = pathlength(newep->focus);
+       register bool intraline = No;
+       register int w;
+
+       if (oldpl < highest)
+               highest = oldpl;
+       if (newpl < highest)
+               highest = newpl;
+       while (oldpl > highest) {
+               up(&oldep->focus) || Abort();
+               --oldpl;
+       }
+       while (newpl > highest) {
+               up(&newep->focus) || Abort();
+               --newpl;
+       }
+       if (Ycoord(newep->focus) != Ycoord(oldep->focus) ||
+               Level(newep->focus) != Level(newep->focus)) {
+               /* Inconsistency found.  */
+               Assert(highest > 1); /* Inconsistency at top level. Stop. */
+               return fixlevels(oldep, newep, 1); /* Try to recover. */
+       }
+       intraline = width(tree(oldep->focus)) >= 0
+               && width(tree(newep->focus)) >= 0;
+       while (!atlinestart(oldep) || !atlinestart(newep)) {
+               /* Find beginning of lines for both */
+               if (!up(&newep->focus)) {
+                       Assert(!up(&newep->focus));
+                       break;
+               }
+               --oldpl;
+               up(&oldep->focus) || Abort();
+               --newpl;
+       }
+       if (intraline)
+               return atlinestart(oldep);
+       w = width(tree(oldep->focus));
+       return w < 0 ? -w : 0;
+}
+
+
+/*
+ * Initialization code.
+ */
+
+Visible Procedure
+initshow()
+{
+       int flags = 0;
+#ifndef NDEBUG
+       if (dflag)
+               fprintf(stderr, "*** initshow();\n\r");
+#endif NDEBUG
+       if (!trmstart(&winheight, &llength, &flags)) {
+               endunix();
+               exit(2);
+       }
+       noscroll = (flags&2) == 0;
+       nosense = (flags&8) == 0;
+       winstart = --winheight;
+}
+
+
+/*
+ * Routine to move the cursor to the first line after the just edited
+ * document.  (Called after each editing action.)
+ */
+
+Visible Procedure
+endshow()
+{
+       register cell *p;
+       register int last = winheight;
+
+       for (p = tops; p; p = p->c_link) {
+               if (p->c_onscreen != Nowhere)
+                       last = p->c_onscreen + Oldspace(p);
+       }
+       if (last > winheight)
+               last = winheight;
+       discard(tops);
+       tops = Cnil;
+       trmputdata(last, winheight, 0, "");
+       trmsync(last, 0);
+       trmend();
+}
+
+
+/*
+ * Translate a cursor position in tree coordinates.
+ *
+ * ***** DOESN'T WORK IF SCREEN INDENT DIFFERS FROM TREE INDENT! *****
+ * (I.e. for lines with >= 80 spaces indentation)
+ */
+
+Visible bool
+backtranslate(py, px)
+       int *py;
+       int *px;
+{
+       cell *p;
+       int y = *py;
+       int x = *px;
+       int i;
+
+       for (i = 0, p = tops; p; ++i, p = p->c_link) {
+               if (p->c_onscreen != Nowhere
+                       && y >= p->c_onscreen && y < p->c_onscreen + Space(p)) {
+                       *px += (y - p->c_onscreen) * llength - indent;
+                       if (*px < 0)
+                               *px = 0;
+                       *py = i;
+                       if (p->c_oldvhole && (y > focy || y == focy && x > focx))
+                               --*px; /* Correction if beyond Vhole on same logical line */
+                       return Yes;
+               }
+       }
+       error(GOTO_OUT);
+       return No;
+}
+
+
+/*
+ * Set the indent level and window start line.
+ */
+
+Visible Procedure
+setindent(x)
+       int x;
+{
+       winstart= winheight;
+       indent= x;
+}
+
+
+/*
+ * Show the command prompt.
+ */
+
+Visible Procedure cmdprompt(prompt)
+       string prompt;
+{
+       setindent(strlen(prompt));
+       trmputdata(winstart, winstart, 0, prompt);
+}

diff --git a/usr/contrib/B/src/bed/spos.c b/usr/contrib/B/src/bed/spos.c
new file mode 100644 (file)
index 0000000..89250be
--- /dev/null
+++ b/usr/contrib/B/src/bed/spos.c
@@ -0,0 +1,99 @@
+/* Copyright (c) Stichting Mathematisch Centrum, Amsterdam, 1985. */
+
+/*
+  $Header: spos.c,v 1.1 85/08/22 15:50:07 timo Exp $
+*/
+
+/*
+ * B editor -- Save and restore focus position.
+ */
+
+#include "b.h"
+#include "bobj.h"
+#include "feat.h"
+#include "file.h"
+
+#ifdef SAVEPOS
+#define MAXPATHLEN 1024 /* See getwd(3) */
+#define MAXSAVE 50 /* Maximum number of entries kept in SAVEPOSFILE */
+
+#define strval(v) Str(v)
+
+/*
+ * Keep a simple database of file name vs. line number, so that
+ * when an edit session is stopped and later continued, the focus
+ * is restored exactly.
+ * The database is kept in most-recently-used-first order.
+ * When it is rewritten, only its first MAXSAVE lines are saved,
+ * thus limiting the amount of disk space wasted by files
+ * that were once edited but then removed, renamed or forgotten.
+ */
+
+
+Visible int
+getpos(file)
+       register string file;
+{
+       register FILE *fp = fopen(posfile, "r");
+       char buf[BUFSIZ];
+       auto int l1;
+       int nread;
+       register int len = strlen(file);
+
+       if (!fp)
+               return 0;
+       while (fgets(buf, sizeof buf, fp) != NULL) {
+               if (strncmp(buf, file, len) == 0
+                       && (buf[len] == '\t' || buf[len] == ' ')) {
+                       nread= sscanf(buf+len+1, "%d", &l1);
+                       if (nread >= 1) {
+                               fclose(fp);
+                               return l1;
+                       }
+               }
+       }
+       fclose(fp);
+       return 0;
+}
+
+
+/*
+ * Save focus position for file 'file'.
+ * Return Yes if save succeeded.
+ */
+
+Visible bool
+savepos(file, line)
+       register string file;
+       int line;
+{
+       register int nsave = 0;
+       register int i;
+       register FILE *fp = fopen(posfile, "r");
+       char buf[BUFSIZ];
+       register int len = strlen(file);
+       value saved[MAXSAVE];
+
+       if (fp) {
+               while (fgets(buf, sizeof buf, fp) != NULL && nsave < MAXSAVE) {
+                       if (strncmp(file, buf, len) == 0
+                               && (buf[len] == ' ' || buf[len] == '\t'))
+                               continue;
+                       saved[nsave] = mk_text(buf);
+                       ++nsave;
+               }
+               fclose(fp);
+       }
+       fp = fopen(posfile, "w");
+       if (fp == NULL)
+               return No;
+       fprintf(fp, "%s\t%d\n", file, line);
+       for (i = 0; i < nsave; ++i) {
+               fputs(strval(saved[i]), fp);
+               release(saved[i]);
+       }
+       if (fclose(fp) == EOF) return No;
+       return Yes;
+}
+
+#endif SAVEPOS

diff --git a/usr/contrib/B/src/bed/sugg.c b/usr/contrib/B/src/bed/sugg.c
new file mode 100644 (file)
index 0000000..63267ff
--- /dev/null
+++ b/usr/contrib/B/src/bed/sugg.c
@@ -0,0 +1,474 @@
+/* Copyright (c) Stichting Mathematisch Centrum, Amsterdam, 1984. */
+static char rcsid[] = "$Header: sugg.c,v 2.4 84/10/26 12:10:51 guido Exp $";
+
+/*
+ * B editor -- New suggestion handling module.
+ */
+
+#include "feat.h"
+
+#ifdef USERSUGG
+
+#include "b.h"
+#include "bobj.h"
+#include "node.h"
+#include "supr.h"
+#include "gram.h"
+#include "queu.h"
+
+#include <ctype.h>
+
+extern bool dflag;
+extern bool edontop;
+
+extern bool lefttorite;
+
+#ifndef SUGGFILE
+#define SUGGFILE ".Bed_sugg"
+#endif
+
+#define MAXNSUGG 1000
+
+Hidden value sugg[MAXNSUGG];
+Hidden int nsugg;
+Hidden int nbuiltin;
+Hidden bool suggchanges;
+Hidden bool ignorefirstcall; /* Communication between killsugg and setsugg */
+
+/*
+ * Read the suggestion table from file.
+ */
+
+Visible Procedure
+initsugg()
+{
+       char buffer[1000];
+       register FILE *fp;
+       register c;
+
+       fp = fopen(SUGGFILE, "r");
+       if (!fp) {
+               if (dflag) {
+                       fprintf(stderr, "*** No suggestion file: ");
+                       perror(SUGGFILE);
+               }
+               return;
+       }
+       while (fgets(buffer, sizeof buffer, fp)) {
+               if (!index(buffer, '\n')) { /* Skip long line */
+                       fprintf(stderr,
+                           "*** Excessively long suggestion ignored\n");
+                       while ((c = getc(fp)) != '\n' && c != EOF)
+                               ;
+               }
+               else
+                       addsugg(buffer, -1);
+       }
+       fclose(fp);
+}
+
+
+/*
+ * Make sure a line looks like a suggestion, return No if not.
+ * Replace the trailing newline or comment-sign by a zero byte.
+ * ***** Should check more thoroughly. *****
+ */
+
+Hidden bool
+checksugg(bp)
+       string bp;
+{
+       if (!isascii(*bp) || !isupper(*bp))
+               return No;
+       while (*bp && *bp != '\n' && *bp != '\\')
+               ++bp;
+       *bp = 0;
+       return Yes;
+}
+
+
+/*
+ * Procedure to add a suggestion to the suggestion table.
+ */
+
+Visible Procedure
+addsugg(str, builtin)
+       string str;
+       int builtin;
+{
+       int i;
+       int j;
+       int len;
+       int cmp;
+       string suggi;
+       int where = (builtin == -1) ? nsugg : nbuiltin;
+
+       if (!checksugg(str))
+               return;
+       for (len = 0; str[len] && str[len] != ' '; ++len)
+               ;
+       for (i = nsugg-1; i >= 0; --i) {
+               suggi = Str(sugg[i]);
+               cmp = strncmp(str, suggi, len);
+               if (cmp < 0)
+                       continue;
+               if (cmp > 0) {
+                       if (i >= where)
+                               where = i+1;
+                       continue;
+               }
+               if (suggi[len] && suggi[len] != ' ')
+                       continue; /* No match, just prefix */
+               if (Strequ(str+len, suggi+len))
+                       return; /* Ignore exact duplicates */
+               if (i < nbuiltin)
+                       return; /* Cannot replace built-in */
+               /* Replacement */
+               sugg[i] = mk_text(str); /* No use to release the old one... */
+                                       /* ...its refcount is infinite */
+               fix(sugg[i]);
+               suggchanges = Yes;
+               return;
+       }
+       /* Insertion */
+       if (nsugg >= MAXNSUGG)
+               return; /* Table overflow */
+       if (builtin == Yes)
+               ++nbuiltin;
+       for (j = nsugg; j > where; --j)
+               sugg[j] = sugg[j-1];
+       ++nsugg;
+       sugg[where] = mk_text(str);
+       fix(sugg[where]);
+       suggchanges = Yes;
+}
+
+
+/*
+ * Procedure to delete a suggestion from the suggestion table.
+ * Must supply the whole string as argument.
+ */
+
+Hidden Procedure
+delsugg(str)
+       string str;
+{
+       int i;
+
+       for (i = 0; i < nsugg; ++i) {
+               if (Strequ(str, Str(sugg[i]))) {
+                       --nsugg;
+                       for (; i < nsugg; ++i)
+                               sugg[i] = sugg[i+1];
+                       suggchanges = Yes;
+                       return;
+               }
+       }
+}
+
+
+/*
+ * Return a suitable suggestion which matches str for len characters.
+ * If len > 1, and all of str (even beyond len) equals some table
+ * entry, the first matching entry after that is preferred; otherwise,
+ * the first matching entry at all is returned.
+ * Vnil is returned if no entry matches.
+ */
+
+Hidden node
+nextsugg(str, len)
+       string str;
+       int len;
+{
+       bool found = !str[len];
+       int first = -1;
+       int i;
+
+       for (i = 0; i < nsugg; ++i) {
+               if (!Strnequ(str, Str(sugg[i]), len))
+                       continue;
+               if (found)
+                       return (node) sugg[i];
+               if (Strequ(str+len, Str(sugg[i])+len))
+                       found = Yes;
+               if (first < 0)
+                       first = i;
+       }
+       if (first >= 0)
+               return (node) sugg[first];
+       return Nnil;
+}
+
+
+/*
+ * Procedure to save the suggestion file if it has been changed.
+ */
+
+Visible Procedure
+endsugg()
+{
+       FILE *fp;
+       int i;
+
+       if (!suggchanges)
+               return;
+       suggchanges = No;
+       fp = fopen(SUGGFILE, "w");
+       if (!fp) {
+               if (dflag) {
+                       fprintf(stderr, "*** Can't rewrite ");
+                       perror(SUGGFILE);
+               }
+               return;
+       }
+       if (dflag)
+               fprintf(stderr, "*** [Rewriting suggestion file]\n");
+       for (i = nbuiltin; i < nsugg; ++i)
+               fprintf(fp, "%s\n", Str(sugg[i]));
+       if (fclose(fp) == EOF) {
+               fprintf(stderr, "*** Can't finish writing ");
+               perror(SUGGFILE);
+               return;
+       }
+}
+
+
+/*
+ * Find a new suggestion or advance in the current one.
+ * Interface styled like resuggest: string pointer is advanced here.
+ */
+
+Visible bool
+newsugg(ep, pstr, alt_c)
+       environ *ep;
+       string *pstr;
+       int alt_c;
+{
+       char buffer[1000];
+       node n = tree(ep->focus);
+       node nn;
+       int sym = symbol(n);
+       string str;
+       string bp;
+       bool end;
+
+       Assert(pstr && *pstr);
+       if (sym != Suggestion || ep->mode != VHOLE || ep->s1 != 2)
+               return No;
+       strncpy(buffer, Str((value)firstchild(n)), sizeof buffer);
+       for (str = *pstr, bp = buffer+ep->s2, end = No;
+                       *str && bp < buffer + sizeof buffer; ++str, ++bp) {
+               if (!*bp)
+                       end = Yes;
+               *bp = *str;
+       }
+       if (end)
+               *bp = 0;
+       nn = (node)nextsugg(buffer, ep->s2 + 1);
+       if (!nn) {
+               if (!alt_c)
+                       return No;
+               buffer[ep->s2] = alt_c;
+               nn = (node)nextsugg(buffer, ep->s2 + 1);
+               if (!nn)
+                       return No;
+       }
+       if (nn != firstchild(n)) {
+               s_down(ep);
+               replace(&ep->focus, nn);
+               s_up(ep);
+       }
+       /* No need to release because its refcount is infinite anyway */
+       ++ep->s2;
+       if (**pstr == ' ')
+               accsugg(ep);
+       ++*pstr;
+       return Yes;
+}
+
+
+/*
+ * Kill suggestion -- only the part to the left of the focus is kept.
+ */
+
+Visible Procedure
+killsugg(ep)
+       environ *ep;
+{
+       queue q = Qnil;
+       char buffer[1000];
+       node n = tree(ep->focus);
+
+       Assert(ep->mode == VHOLE && ep->s1 == 2 && symbol(n) == Suggestion);
+       strncpy(buffer, Str((value)firstchild(n)), ep->s2);
+       buffer[ep->s2] = 0;
+       delfocus(&ep->focus);
+       ep->mode = WHOLE;
+       ignorefirstcall = Yes;
+       ins_string(ep, buffer, &q, 0);
+       qrelease(q);
+       ignorefirstcall = No;
+}
+
+
+/*
+ * Place an initial suggestion in a node.
+ */
+
+Visible bool
+setsugg(pp, c, ep)
+       path *pp;
+       char c;
+       environ *ep;
+{
+       char buf[2];
+       node n;
+
+       if (lefttorite)
+               return No;
+       if (ignorefirstcall) {
+               ignorefirstcall = No;
+               return No;
+       }
+       buf[0] = c;
+       buf[1] = 0;
+       n = (node)nextsugg(buf, 1);
+       if (!n)
+               return No;
+       replace(pp, newnode(1, Suggestion, &n));
+       ep->mode = VHOLE;
+       ep->s1 = 2;
+       ep->s2 = 1;
+       return Yes;
+}
+
+
+/*
+ * Accept a suggestion -- turn it into real nodes.
+ */
+
+Visible Procedure
+accsugg(ep)
+       environ *ep;
+{
+       node n = tree(ep->focus);
+       int s2 = ep->s2;
+       queue q = Qnil;
+       environ env;
+
+       Assert(symbol(n) == Suggestion && ep->mode == VHOLE && ep->s1 == 2);
+       stringtoqueue(Str((value)firstchild(n)) + s2, &q);
+       killsugg(ep);
+       Ecopy(*ep, env);
+       if (app_queue(ep, &q))
+               Erelease(env);
+       else {
+               Erelease(*ep);
+               Emove(env, *ep);
+               qrelease(q);
+       }
+}
+
+
+/*
+ * Procedure called when a unit is read in.
+ * It tries to update the suggestion database.
+ * It also remembers the suggestion so that it can be removed by writesugg
+ * if that finds the unit was deleted.
+ */
+
+Hidden char lastsugg[1000];
+
+Visible Procedure
+readsugg(p)
+       path p;
+{
+       p = pathcopy(p);
+       top(&p);
+       getpattern(lastsugg, tree(p));
+       pathrelease(p);
+       addsugg(lastsugg, No);
+}
+
+
+/*
+ * Procedure called when a unit is saved.
+ * It tries to update the suggestion database.
+ * If the unit appears empty, the last suggestion passed to readsugg
+ * will be deleted.
+ */
+
+Visible Procedure
+writesugg(p)
+       path p;
+{
+       p = pathcopy(p);
+       top(&p);
+       if (width(tree(p)) == 0)
+               delsugg(lastsugg);
+       else {
+               getpattern(lastsugg, tree(p));
+               if (lastsugg[0])
+                       addsugg(lastsugg, No);
+       }
+       pathrelease(p);
+}
+
+
+/*
+ * Procedure to find out the suggestion that fits the current unit.
+ * Makes the buffer empty if not a HOW'TO unit.
+ * ***** Won't work if B-grammar is severely changed! *****
+ */
+
+Hidden Procedure
+getpattern(buffer, n)
+       string buffer;
+       node n;
+{
+       string *rp = noderepr(n);
+
+       buffer[0] = 0;
+       while (Fw_zero(rp[0])) {
+               if (nchildren(n) == 0)
+                       return;
+               n = firstchild(n);
+               rp = noderepr(n);
+       }
+       if (!Strequ(rp[0], "HOW'TO ") || nchildren(n) < 1)
+               return;
+       subgetpattern(&buffer, firstchild(n));
+       *buffer = 0;
+}
+
+
+/*
+ * Refinement for getpattern to do the work.
+ */
+
+Hidden Procedure
+subgetpattern(pbuf, n)
+       string *pbuf;
+       node n;
+{
+       string *rp;
+       int i;
+       int nch;
+
+       rp = noderepr(n);
+       nch = (Type(n) == Tex) ? 0 : nchildren(n);
+       for (i = 0; i <= nch; ++i) {
+               if (i > 0)
+                       subgetpattern(pbuf, child(n, i));
+               if (Fw_positive(rp[i])) {
+                       if (islower(rp[i][0]))
+                               *(*pbuf)++ = '?';
+                       else {
+                               strcpy(*pbuf, rp[i]);
+                               *pbuf += strlen(*pbuf);
+                       }
+               }
+       }
+}
+
+#endif USERSUGG

diff --git a/usr/contrib/B/src/bed/supr.c b/usr/contrib/B/src/bed/supr.c
new file mode 100644 (file)
index 0000000..290370d
--- /dev/null
+++ b/usr/contrib/B/src/bed/supr.c
@@ -0,0 +1,1117 @@
+/* Copyright (c) Stichting Mathematisch Centrum, Amsterdam, 1984. */
+static char rcsid[] = "$Header: supr.c,v 2.3 84/07/23 13:03:15 guido Exp $";
+
+/*
+ * B editor -- Superroutines.
+ */
+
+#include "b.h"
+#include "feat.h"
+#include "bobj.h"
+#include "node.h"
+#include "supr.h"
+#include "gram.h"
+
+/*
+ * Compute the length of the ep->s1'th item of node tree(ep->focus).
+ */
+
+Visible int
+lenitem(ep)
+       register environ *ep;
+{
+       register node n = tree(ep->focus);
+       register node nn;
+
+       if (ep->s1&1) /* Fixed text */
+               return fwidth(noderepr(n)[ep->s1/2]);
+       /* Else, variable text or a whole node */
+       nn = child(n, ep->s1/2);
+       return width(nn);
+}
+
+
+/*
+ * Find the largest possible representation of the focus.
+ * E.g., a WHOLE can also be represented as a SUBSET of its parent,
+ * provided it has a parent.
+ * Also, a SUBSET may be extended with some empty left and right
+ * items and then look like a WHOLE, etc.
+ * This process is repeated until no more improvements can be made.
+ */
+
+Visible Procedure
+grow(ep)
+       environ *ep;
+{
+       subgrow(ep, Yes);
+}
+
+Visible Procedure
+subgrow(ep, ignorespaces)
+       register environ *ep;
+       bool ignorespaces;
+{
+       register node n;
+       register int sym;
+       register int i;
+       register int len;
+       register string repr;
+
+       switch (ep->mode) {
+       case ATBEGIN:
+       case ATEND:
+       case VHOLE:
+       case FHOLE:
+               ritevhole(ep);
+               if (ep->mode != FHOLE && ep->mode != VHOLE || lenitem(ep) == 0)
+                       leftvhole(ep);
+
+       }
+
+       for (;;) {
+               n = tree(ep->focus);
+               sym = symbol(n);
+
+               switch (ep->mode) {
+
+               case VHOLE:
+               case FHOLE:
+                       if ((sym == Optional || sym == Hole) && ep->s2 == 0) {
+                               ep->mode = WHOLE;
+                               continue;
+                       }
+                       if (lenitem(ep) <= 0) {
+                               ep->mode = SUBSET;
+                               ep->s2 = ep->s1;
+                               continue;
+                       }
+                       return;
+
+               case ATBEGIN:
+               case ATEND:
+                       if (sym == Optional || sym == Hole) {
+                               ep->mode = WHOLE;
+                               continue;
+                       }
+                       return;
+
+               case SUBRANGE:
+                       if (ep->s1&1) {
+                               repr = noderepr(n)[ep->s1/2];
+                               len = fwidth(repr);
+                               if (!ignorespaces) {
+                                 while (ep->s2 > 0 && repr[ep->s2-1] == ' ')
+                                       --ep->s2;
+                                 while (ep->s3 < len && repr[ep->s3+1] == ' ')
+                                       ++ep->s3;
+                               }
+                       }
+                       else
+                               len = Length((value) firstchild(n));
+                       if (ep->s2 == 0 && ep->s3 >= len - 1) {
+                               ep->mode = SUBSET;
+                               ep->s2 = ep->s1;
+                               continue;
+                       }
+                       return;
+
+               case SUBSET:
+                       subgrsubset(ep, ignorespaces);
+                       if (ep->s1 == 1) {
+                               if (ep->s2 == 2*nchildren(n) + 1) {
+                                       ep->mode = WHOLE;
+                                       continue;
+                               }
+                               if (ep->s2 == 2*nchildren(n) - 1 && issublist(sym)) {
+                                       ep->mode = SUBLIST;
+                                       ep->s3 = 1;
+                                       return;
+                               }
+                       }
+                       return;
+
+               case SUBLIST:
+                       for (i = ep->s3; i > 0; --i)
+                               n = lastchild(n);
+                       sym = symbol(n);
+                       if (sym == Optional) {
+                               ep->mode = WHOLE;
+                               continue;
+                       }
+                       return;
+
+               case WHOLE:
+                       ep->s1 = 2*ichild(ep->focus);
+                       if (up(&ep->focus)) {
+                               ep->mode = SUBSET;
+                               ep->s2 = ep->s1;
+                               higher(ep);
+                               continue;
+                       }
+                       return; /* Leave as WHOLE if there is no parent */
+
+               default:
+                       Abort();
+                       /* NOTREACHED */
+
+               }
+               
+       }
+       /* Not reached */
+}
+
+
+/*
+ * Ditto to find smallest possible representation.
+ */
+
+Visible Procedure
+shrink(ep)
+       register environ *ep;
+{
+       register node n;
+       register int sym;
+
+       for (;;) {
+               n = tree(ep->focus);
+               sym = symbol(n);
+
+               switch (ep->mode) {
+
+               case WHOLE:
+                       if (sym == Hole || sym == Optional)
+                               return;
+                       ep->mode = SUBSET;
+                       ep->s1 = 1;
+                       ep->s2 = 2*nchildren(n) + 1;
+                       continue;
+
+               case SUBLIST:
+                       if (sym == Hole || sym == Optional) {
+                               ep->mode = WHOLE;
+                               return;
+                       }
+                       if (ep->s3 == 1) {
+                               ep->mode = SUBSET;
+                               ep->s1 = 1;
+                               ep->s2 = 2*nchildren(n) - 1;
+                               continue;
+                       }
+                       return;
+
+               case SUBSET:
+                       if (sym == Hole || sym == Optional) {
+                               ep->mode = WHOLE;
+                               return;
+                       }
+                       shrsubset(ep);
+                       if (ep->s1 == ep->s2) {
+                               if (isunititem(ep)) {
+                                       ep->mode = SUBRANGE;
+                                       ep->s2 = 0;
+                                       ep->s3 = lenitem(ep) - 1;
+                                       return;
+                               }
+                               else {
+                                       s_downi(ep, ep->s1/2);
+                                       ep->mode = WHOLE;
+                                       continue;
+                               }
+                       }
+                       return;
+
+               case SUBRANGE:
+                       if (sym == Optional || sym == Hole)
+                               ep->mode = WHOLE;
+                       return;
+
+               case ATBEGIN:
+                       ritevhole(ep);
+                       if (ep->mode == ATBEGIN) {
+                               if (sym == Optional || sym == Hole)
+                                       ep->mode = WHOLE;
+                               return;
+                       }
+                       continue;
+
+               case FHOLE:
+               case VHOLE:
+                       ritevhole(ep);
+                       if (ep->mode != VHOLE && ep->mode != FHOLE)
+                               continue;
+                       sym = symbol(tree(ep->focus));
+                       if (sym == Optional || sym == Hole && ep->s2 == 0)
+                               ep->mode = WHOLE;
+                       return;
+
+               case ATEND:
+                       return;
+
+               default:
+                       Abort();
+                       /* NOTREACHED */
+
+               }
+       }
+       /* Not reached */
+
+}
+
+
+/*
+ * Subroutine to find the largest way to describe a SUBSET focus
+ * (modulo surrounding blanks and newlines).
+ */
+
+Visible Procedure
+growsubset(ep)
+       environ *ep;
+{
+       subgrsubset(ep, Yes);
+}
+
+Visible Procedure
+subgrsubset(ep, ignorespaces)
+       register environ *ep;
+       bool ignorespaces;
+{
+       register node n = tree(ep->focus);
+       register string *rp = noderepr(n);
+       register nch21 = nchildren(n)*2 + 1;
+       register int i;
+
+       Assert(ep->mode == SUBSET);
+       for (i = ep->s1; i > 1 && subisnull(n, rp, i-1, ignorespaces); --i)
+               ;
+       ep->s1 = i;
+       for (i = ep->s2; i < nch21 && subisnull(n, rp, i+1, ignorespaces); ++i)
+               ;
+       ep->s2 = i;
+}
+
+
+/*
+ * Ditto for the smallest way.
+ */
+
+Visible Procedure /* Ought to be Hidden */
+shrsubset(ep)
+       register environ *ep;
+{
+       register node n = tree(ep->focus);
+       register string *rp = noderepr(n);
+       register int s1 = ep->s1;
+       register int s2 = ep->s2;
+
+       for (; s1 < s2 && isnull(n, rp, s1); ++s1)
+               ;
+       ep->s1 = s1;
+       for (; s2 > s1 && isnull(n, rp, s2); --s2)
+               ;
+       ep->s2 = s2;
+}
+
+
+/*
+ * Subroutine for grow/shrink to see whether item i is (almost) invisible.
+ */
+
+Visible bool
+isnull(n, rp, i)
+       node n;
+       string *rp;
+       int i;
+{
+       return subisnull(n, rp, i, Yes);
+}
+
+Hidden Procedure
+subisnull(n, rp, i, ignorespaces)
+       register node n;
+       register string *rp;
+       register int i;
+       bool ignorespaces;
+{
+       register string repr;
+       register node nn;
+
+       if (i&1) { /* Fixed text */
+               repr = rp[i/2];
+               return !Fw_positive(repr) || ignorespaces && allspaces(repr);
+       }
+       nn = child(n, i/2);
+       return width(nn) == 0;
+}
+
+
+/*
+ * Find the rightmost VHOLE which would look the same as the current one.
+ */
+
+Visible Procedure
+ritevhole(ep)
+       register environ *ep;
+{
+       register node n;
+       register int ich;
+       register int len;
+       register int s1save;
+
+       for (;;) {
+               n = tree(ep->focus);
+
+               switch (ep->mode) {
+
+               case WHOLE:
+                       ep->mode = ATEND;
+                       break;
+
+               case VHOLE:
+               case FHOLE:
+                       len = lenitem(ep);
+                       Assert(len >= 0);
+                       if (ep->s2 < len)
+                               return; /* Hole in middle of string */
+                       s1save = ep->s1;
+                       if (nextitem(ep)) {
+                               if (isunititem(ep)) {
+                                       ep->mode = (ep->s1&1) ? FHOLE : VHOLE;
+                                       ep->s2 = 0;
+                               }
+                               else if (fwidth(noderepr(child(n, ep->s1/2))[0]) < 0) {
+                                       /* Next item begins with newline -- avoid */
+                                       ep->s1 = s1save;
+                                       return;
+                               }
+                               else {
+                                       s_downi(ep, ep->s1/2);
+                                       ep->mode = ATBEGIN;
+                               }
+                               break;
+                       }
+                       ep->mode = ATEND;
+                       /* Fall through */
+               case ATEND:
+                       if (!parent(ep->focus) || width(n) < 0)
+                               return;
+                       ich = ichild(ep->focus);
+                       ep->s1 = 2*ich;
+                       s_up(ep);
+                       if (nextitem(ep)) {
+                               /* Note -- negative width cannot occur (see test above) */
+                               if (isunititem(ep)) {
+                                       ep->mode = (ep->s1&1) ? FHOLE : VHOLE;
+                                       ep->s2 = 0;
+                               }
+                               else {
+                                       ep->mode = ATBEGIN;
+                                       s_downi(ep, ep->s1/2);
+                               }
+                               break;
+                       }
+                       continue;
+
+               case ATBEGIN:
+                       if (fwidth(noderepr(n)[0]) < 0)
+                               return; /* Already at dangerous position */
+                       ep->mode = FHOLE;
+                       ep->s1 = 1;
+                       ep->s2 = 0;
+                       continue;
+
+               default:
+                       Abort();
+                       /* NOTREACHED */
+
+               }
+       }
+}
+
+
+/*
+ * Ditto to the left.
+ */
+
+Visible Procedure
+leftvhole(ep)
+       register environ *ep;
+{
+       register int ich;
+
+       for (;;) {
+               switch (ep->mode) {
+
+               case WHOLE:
+                       ep->mode = ATBEGIN;
+                       break;
+
+               case VHOLE:
+               case FHOLE:
+                       if (ep->s2 > 0)
+                               return;
+                       if (previtem(ep)) {
+                               if (isunititem(ep)) {
+                                       ep->mode = (ep->s1&1) ? FHOLE : VHOLE;
+                                       ep->s2 = lenitem(ep);
+                               }
+                               else {
+                                       s_downi(ep, ep->s1/2);
+                                       ep->mode = ATEND;
+                               }
+                       }
+                       else if (fwidth(noderepr(tree(ep->focus))[0]) < 0)
+                               return;
+                       else
+                               ep->mode = ATBEGIN;
+                       continue;
+
+               case ATBEGIN:
+                       ich = ichild(ep->focus);
+                       if (!up(&ep->focus))
+                               return;
+                       higher(ep);
+                       ep->s1 = 2*ich;
+                       if (prevnnitem(ep)) {
+                               if (isunititem(ep)) {
+                                       ep->mode = (ep->s1&1) ? FHOLE : VHOLE;
+                                       ep->s2 = lenitem(ep);
+                               }
+                               else {
+                                       s_downi(ep, ep->s1/2);
+                                       ep->mode = ATEND;
+                               }
+                       }
+                       else if (fwidth(noderepr(tree(ep->focus))[0]) < 0) {
+                               s_downi(ep, ich); /* Undo up */
+                               return;
+                       }
+                       else
+                               ep->mode = ATBEGIN;
+                       continue;
+
+               case ATEND:
+                       lastnnitem(ep);
+                       if (isunititem(ep)) {
+                               ep->s2 = lenitem(ep);
+                               ep->mode = (ep->s1&1) ? FHOLE : VHOLE;
+                       }
+                       else
+                               s_downi(ep, ep->s1/2);
+                       continue;
+
+               default:
+                       Abort();
+
+               }
+       }
+}
+
+
+/*
+ * Safe up, downi, left and rite routines:
+ * 1) Rather die than fail;
+ * 2) Update ep->highest properly.
+ */
+
+Visible Procedure
+s_up(ep)
+       register environ *ep;
+{
+       if (!up(&ep->focus))
+               syserr("s_up failed");
+       higher(ep);
+}
+
+Visible Procedure
+s_downi(ep, i)
+       register environ *ep;
+       register int i;
+{
+       if (!downi(&ep->focus, i))
+               syserr("s_downi failed");
+}
+
+Visible Procedure
+s_down(ep)
+       register environ *ep;
+{
+       if (!down(&ep->focus))
+               syserr("s_down failed");
+}
+
+Visible Procedure
+s_downrite(ep)
+       register environ *ep;
+{
+       if (!downrite(&ep->focus))
+               syserr("s_downrite failed");
+}
+
+Visible Procedure
+s_left(ep)
+       register environ *ep;
+{
+       register int ich = ichild(ep->focus);
+
+       s_up(ep);
+       s_downi(ep, ich-1);
+}
+
+Visible Procedure
+s_rite(ep)
+       register environ *ep;
+{
+       register int ich = ichild(ep->focus);
+
+       s_up(ep);
+       s_downi(ep, ich+1);
+}
+
+
+/*
+ * Find next item in a subset, using ep->s1 as index.
+ * (This used to be less trivial, so it's still a subroutine rather than
+ * coded in-line or as a macro.)
+ */
+
+Visible bool
+nextitem(ep)
+       register environ *ep;
+{
+       if (ep->s1 >= 2*nchildren(tree(ep->focus)) + 1)
+               return No; /* Already at last item */
+       ++ep->s1;
+       return Yes;
+}
+
+
+/*
+ * Ditto for previous.
+ */
+
+Visible bool
+previtem(ep)
+       register environ *ep;
+{
+       if (ep->s1 <= 1
+               || ep->s1 == 2 && fwidth(noderepr(tree(ep->focus))[0]) < 0)
+               return No; /* Already at first item */
+       --ep->s1;
+       return Yes;
+}
+
+
+/*
+ * Test whether item ep->s1 is "small", i.e., fixed or varying text
+ * but not a whole subtree.
+ */
+
+Visible bool
+isunititem(ep)
+       register environ *ep;
+{
+       return (ep->s1&1) || Type(child(tree(ep->focus), ep->s1/2)) == Tex;
+}
+
+
+/*
+ * Check for consistent mode information.
+ */
+
+Visible bool
+checkep(ep)
+       register environ *ep;
+{
+       switch (ep->mode) {
+
+       case FHOLE:
+               if (!(ep->s1&1))
+                       break;
+               if (ep->s2 < 0 || ep->s2 > lenitem(ep))
+                       break;
+               return Yes;
+
+       case VHOLE:
+               if (!(ep->s1&1)) {
+                       if (Type(child(tree(ep->focus), ep->s1/2)) != Tex)
+                               break;
+               }
+               if (ep->s2 < 0 || ep->s2 > lenitem(ep))
+                       break;
+               return Yes;
+
+       case SUBSET:
+               if (ep->s2 == ep->s1 && isunititem(ep) && lenitem(ep) <= 0)
+                       break;
+               return Yes;
+
+       default:
+               return Yes;
+
+       }
+       dbmess(ep);
+       return No;
+}
+
+
+/*
+ * Like {next,prev,first,last}item, but with empty items skipped
+ * (i.e., those with length <= 0).
+ */
+
+Visible bool
+nextnnitem(ep)
+       register environ *ep;
+{
+       register int s1save = ep->s1;
+
+       while (nextitem(ep)) {
+               if (lenitem(ep) != 0)
+                       return Yes;
+       }
+       ep->s1 = s1save;
+       return No;
+}
+
+Visible bool
+prevnnitem(ep)
+       register environ *ep;
+{
+       register int s1save = ep->s1;
+       register int len;
+
+       while (previtem(ep)) {
+               len = lenitem(ep);
+               if (len > 0 || len < 0 && ep->s1 > 1)
+                       return Yes;
+       }
+       ep->s1 = s1save;
+       return No;
+}
+
+
+Visible Procedure
+firstnnitem(ep)
+       register environ *ep;
+{
+       ep->s1 = fwidth(noderepr(tree(ep->focus))[0]) < 0 ? 2 : 1;
+       while (lenitem(ep) == 0) {
+               if (!nextitem(ep))
+                       break;
+       }
+       return;
+}
+
+Visible Procedure
+lastnnitem(ep)
+       register environ *ep;
+{
+       ep->s1 = 2*nchildren(tree(ep->focus)) + 1;
+       while (lenitem(ep) == 0) {
+               if (!previtem(ep))
+                       break;
+       }
+       return;
+}
+
+
+/*
+ * Prepare the focus for insertion.
+ * If the focus isn't a hole, make a hole just before it which becomes the
+ * new focus.
+ * Also repair strange statuses left by moves, so we may have more chance
+ * to insert a character.
+ */
+
+Visible Procedure
+fixit(ep)
+       register environ *ep;
+{
+       /* First, make a hole if it's not already a hole. */
+
+       switch (ep->mode) {
+
+       case FHOLE:
+               break;
+
+       case VHOLE:
+               if (ep->s1&1)
+                       ep->mode = FHOLE;
+               break;
+
+       case SUBRANGE:
+               if (ep->s1&1)
+                       ep->mode = FHOLE;
+               else
+                       ep->mode = VHOLE;
+               break;
+
+       case SUBSET:
+               if (ep->s1&1) {
+                       if (ep->s1 == 1)
+                               ep->mode = ATBEGIN;
+                       else {
+                               ep->mode = FHOLE;
+                               ep->s2 = 0;
+                       }
+               }
+               else if (Type(child(tree(ep->focus), ep->s1/2)) == Tex) {
+                       ep->mode = VHOLE;
+                       ep->s2 = 0;
+               }
+               else {
+                       s_downi(ep, ep->s1/2);
+                       ep->mode = ATBEGIN;
+               }
+               break;
+
+       case ATBEGIN:
+       case SUBLIST:
+       case WHOLE:
+               ep->mode = ATBEGIN;
+               break;
+
+       case ATEND:
+               break;
+
+       default:
+               Abort();
+       }
+
+       leftvhole(ep);
+       if (ep->mode == ATEND && symbol(tree(ep->focus)) == Hole)
+               ep->mode = WHOLE; /***** Experiment! *****/
+}
+
+
+/*
+ * Small utility to see if a string contains only spaces
+ * (this is true for the empty string "").
+ * The string pointer must not be null!
+ */
+
+Visible bool
+allspaces(str)
+       register string str;
+{
+       Assert(str);
+       for (; *str; ++str) {
+               if (*str != ' ')
+                       return No;
+       }
+       return Yes;
+}
+
+
+/*
+ * Function to compute the actual width of the focus.
+ */
+
+Visible int
+focwidth(ep)
+       register environ *ep;
+{
+       node nn;
+       register node n = tree(ep->focus);
+       register string *rp = noderepr(n);
+       register int i;
+       register int w;
+       int len = 0;
+
+       switch (ep->mode) {
+
+       case VHOLE:
+       case FHOLE:
+       case ATEND:
+       case ATBEGIN:
+               return 0;
+
+       case WHOLE:
+               return width(n);
+
+       case SUBRANGE:
+               return ep->s3 - ep->s2 + 1;
+
+       case SUBSET:
+               for (i = ep->s1; i <= ep->s2; ++i) {
+                       if (i&1)
+                               w = fwidth(rp[i/2]);
+                       else {
+                               nn = child(n, i/2);
+                               w = width(nn);
+                       }
+                       if (w < 0 && len >= 0)
+                               len = w;
+                       else if (w >= 0 && len < 0)
+                               ;
+                       else
+                               len += w;
+               }
+               return len;
+
+       case SUBLIST:
+               len = width(n);
+               for (i = ep->s3; i > 0; --i)
+                       n = lastchild(n);
+               w = width(n);
+               if (w < 0 && len >= 0)
+                       return w;
+               if (w >= 0 && len < 0)
+                       return len;
+               return len - w;
+
+       default:
+               Abort();
+               /* NOTREACHED */
+       }
+}
+
+
+/*
+ * Compute the offset of the focus from the beginning of the current node.
+ * This may be input again to fixfocus to allow restoration of this position.
+ */
+
+Visible int
+focoffset(ep)
+       register environ *ep;
+{
+       node nn;
+       register node n;
+       register string *rp;
+       register int w;
+       register int len;
+       register int i;
+
+       switch (ep->mode) {
+
+       case WHOLE:
+       case SUBLIST:
+               return 0;
+
+       case ATBEGIN:
+               return ep->spflag;
+
+       case ATEND:
+               w = width(tree(ep->focus));
+               if (w < 0)
+                       return w;
+               return w + ep->spflag;
+
+       case SUBSET:
+       case FHOLE:
+       case VHOLE:
+       case SUBRANGE:
+               n = tree(ep->focus);
+               rp = noderepr(n);
+               len = 0;
+               for (i = 1; i < ep->s1; ++i) {
+                       if (i&1)
+                               w = Fwidth(rp[i/2]);
+                       else {
+                               nn = child(n, i/2);
+                               w = width(nn);
+                       }
+                       if (w < 0) {
+                               if (len >= 0)
+                                       len = w;
+                               else
+                                       len += w;
+                       }
+                       else if (len >= 0)
+                               len += w;
+               }
+               if (ep->mode == SUBSET || len < 0)
+                       return len;
+               return len + ep->s2 + ep->spflag;
+
+       default:
+               Abort();
+               /* NOTREACHED */
+       }
+}
+
+
+/*
+ * Return the first character of the focus (maybe '\n'; 0 if zero-width).
+ */
+
+Visible int
+focchar(ep)
+       environ *ep;
+{
+       node n = tree(ep->focus);
+       string str;
+       string *rp;
+       int i;
+       int c;
+
+       switch (ep->mode) {
+
+       case VHOLE:
+       case FHOLE:
+       case ATBEGIN:
+       case ATEND:
+               return 0;
+
+       case WHOLE:
+       case SUBLIST:
+               return nodechar(n);
+
+       case SUBSET:
+               rp = noderepr(n);
+               for (i = ep->s1; i <= ep->s2; ++i) {
+                       if (i&1) {
+                               if (!Fw_zero(rp[i/2]))
+                               return rp[i/2][0];
+                       }
+                       else {
+                               c = nodechar(child(n, i/2));
+                               if (c)
+                                       return c;
+                       }
+               }
+               return 0;
+
+       case SUBRANGE:
+               if (ep->s1&1)
+                       str = noderepr(n)[ep->s1/2];
+               else {
+                       Assert(Type(child(n, ep->s1/2)) == Tex);
+                       str = Str((value)child(n, ep->s1/2));
+               }
+               return str[ep->s2];
+
+       default:
+               Abort();
+               /* NOTREACHED */
+
+       }
+}
+
+
+/*
+ * Subroutine to return first character of node.
+ */
+
+Visible int
+nodechar(n)
+       node n;
+{
+       string *rp;
+       int nch;
+       int i;
+       int c;
+
+       if (Type(n) == Tex)
+               return Str((value)n)[0];
+       rp = noderepr(n);
+       if (!Fw_zero(rp[0]))
+               return rp[0][0];
+       nch = nchildren(n);
+       for (i = 1; i <= nch; ++i) {
+               c = nodechar(child(n, i));
+               if (c)
+                       return c;
+               if (!Fw_zero(rp[i]))
+                       return rp[i][0];
+       }
+       return 0;
+}
+
+
+/*
+ * Function to compute the actual indentation level at the focus.
+ */
+
+Visible int
+focindent(ep)
+       environ *ep;
+{
+       int y = Ycoord(ep->focus);
+       int x = Xcoord(ep->focus);
+       int level = Level(ep->focus);
+       node n = tree(ep->focus);
+
+       switch (ep->mode) {
+
+       case WHOLE:
+       case ATBEGIN:
+       case SUBLIST:
+               break;
+
+       case ATEND:
+               evalcoord(n, 1 + nchildren(n), &y, &x, &level);
+               break;
+
+       case SUBSET:
+       case FHOLE:
+       case VHOLE:
+               evalcoord(n, ep->s1/2, &y, &x, &level);
+               break;
+
+       default:
+               Abort();
+       }
+       return level;
+}
+
+
+/*
+ * Routines to move 'environ' structures.
+ */
+
+emove(s, d)
+       environ *s;
+       environ *d;
+{
+#ifdef STRUCTASS
+       *d = *s;
+#else !STRUCTASS
+       d->focus = s->focus;
+
+       d->mode = s->mode;
+       d->copyflag = s->copyflag;
+       d->spflag = s->spflag;
+       d->changed = s->changed;
+
+       d->s1 = s->s1;
+       d->s2 = s->s2;
+       d->s3 = s->s3;
+
+       d->highest = s->highest;
+
+       d->copybuffer = s->copybuffer;
+#ifdef RECORDING
+       d->oldmacro = s->oldmacro;
+       d->newmacro = s->newmacro;
+#endif RECORDING
+
+       d->generation = s->generation;
+#endif !STRUCTASS
+}
+
+ecopy(s, d)
+       environ *s;
+       environ *d;
+{
+       emove(s, d);
+       pathcopy(d->focus);
+       copy(d->copybuffer);
+#ifdef RECORDING
+       copy(d->oldmacro);
+       copy(d->newmacro);
+#endif RECORDING
+}
+
+erelease(e)
+       environ *e;
+{
+       pathrelease(e->focus);
+       release(e->copybuffer);
+#ifdef RECORDING
+       release(e->oldmacro);
+       release(e->newmacro);
+#endif RECORDING
+}

diff --git a/usr/contrib/B/src/bed/tabl.c b/usr/contrib/B/src/bed/tabl.c
new file mode 100644 (file)
index 0000000..a5d1216
--- /dev/null
+++ b/usr/contrib/B/src/bed/tabl.c
@@ -0,0 +1,519 @@
+/* Copyright (c) Stichting Mathematisch Centrum, Amsterdam, 1985. */
+
+/* 
+ * $Header: tabl.c,v 2.4 85/08/22 16:08:42 timo Exp $
+ */
+
+/*
+ * B editor -- Grammar table.
+ */
+
+#include "b.h"
+#include "node.h"
+#include "gram.h"
+#include "tabl.h"
+
+
+/*
+ * ***** DISCLAIMER *****
+ *
+ * This file is a mess.  There should really be a separate program (like Yacc)
+ * to compile a grammar into tables.  But for the time being . . .
+ */
+
+
+/*
+ * Values returned by function symbol(n).
+ * They are used directly as index in the grammar table.
+ * The NAMES of the #defined constants are of no importance outside this file.
+ */
+
+#define Put    1
+#define Insert 2
+#define Remove 3
+#define Choose 4
+#define Draw   5
+#define Set_random     6
+#define Delete 7
+#define Check  8
+#define Share  9
+
+#define Write  10
+#define Read   11
+#define Read_raw       12
+
+#define If     13
+#define While  14
+#define For    15
+
+#define Select 16
+
+#define Quit   18
+#define Return 19
+#define Report 20
+#define Succeed        21
+#define Fail   22
+
+#define How_to 23
+#define Yield  24
+#define Test   25
+#define Suite  26
+#define Refinement     27
+
+#define Compound       28
+#define Collateral     29
+#define Tag    30
+#define Number 31
+#define Selection      32
+#define Behead 33
+#define Curtail        34
+
+#define And    35
+#define Or     36
+#define Not    37
+#define Some_in        38
+#define Each_in        39
+#define No_in  40
+#define Some_parsing   41
+#define Each_parsing   42
+#define No_parsing     43
+
+#define Comment        44
+#define Keyword        45
+
+#define L_t_dis        46
+#define List_body      47
+#define Tab_body       48
+#define Tab_entry      49
+
+#define E_number       50
+#define Com_target     51
+#define Col_target     52
+#define Sel_expr       53
+#define Text1  54
+#define Text2  55
+#define Grouped        56
+#define Blocked        57
+#define Operators      58
+
+#define Else_kw        59
+#define Kw_plus        60
+#define E_plus 61
+#define Conversion     62
+#define T1     63
+#define T1_plus        64
+#define T2     65
+#define T2_plus        66
+#define Cmt_cmd        67
+
+#define F_kw_plus      69
+#define F_e_plus       70
+#define Plus_sign      71
+#define Minus_sign     72
+
+#define Long_comp      73
+#define Short_comp     74
+#define Cmt_comp       75
+
+#define Long_unit      76
+#define Short_unit     77
+#define Cmt_head       78
+
+#define Ref_join       79
+
+#define And_kw 80
+#define Or_kw  81
+
+#define E_part 82
+
+#define Unit_edit      83
+#define Target_edit    84
+#define Imm_cmd        85
+#define Raw    86
+#define Raw_input      87
+#define Edit_unit      88
+#define Edit_target    89
+#define Colon  90
+#define Equals 91
+#define Test_suite     92
+#define Expression     93
+
+/*
+ * The last three, `Suggestion', `Optional' and `Hole',
+ * with values 97, 98 and 99, are defined in "gram.h".
+ */
+
+
+/*
+ * Symbol values used for lexical elements.
+ * Cross-reference: "lexi.c", table `chclass'.
+ */
+
+#define LEXICAL 100
+
+#define IDENT (LEXICAL+0)
+#define KEYWORD (LEXICAL+1)
+#define NUMBER (LEXICAL+2)
+#define COMMENT (LEXICAL+3)
+#define TEXT1 (LEXICAL+4)
+#define TEXT2 (LEXICAL+5)
+#define OPERATORS (LEXICAL+6)
+#define RAWINPUT (LEXICAL+7)
+#define SUGGESTION (LEXICAL+8)
+
+
+/*
+ * Classes used in table initialization.
+ */
+
+Hidden classelem Asugg_body[] = {SUGGESTION, 0};
+       Hidden struct classinfo sugg_body[] = {Asugg_body};
+
+#define TARGET Tag, Com_target, Selection, Behead, Curtail
+#define PRIMARY \
+       Sel_expr, Tag, E_number, Number, Compound, L_t_dis, Text1, Text2
+#define EXPR Blocked, Grouped, Operators, PRIMARY
+
+Hidden classelem Atag_body[] = {IDENT, 0};
+       Hidden struct classinfo tag_body[] = {Atag_body};
+Hidden classelem Anum_body[] = {NUMBER, 0};
+       Hidden struct classinfo num_body[] = {Anum_body};
+Hidden classelem Acom_body[] = {COMMENT, 0};
+       Hidden struct classinfo com_body[] = {Acom_body};
+Hidden classelem Akw_body[] = {KEYWORD, 0};
+       Hidden struct classinfo kw_body[] = {Akw_body};
+Hidden classelem At1_body[] = {TEXT1, 0};
+       Hidden struct classinfo t1_body[] = {At1_body};
+Hidden classelem At2_body[] = {TEXT2, 0};
+       Hidden struct classinfo t2_body[] = {At2_body};
+Hidden classelem Aops_body[] = {OPERATORS, 0};
+       Hidden struct classinfo ops_body[] = {Aops_body};
+Hidden classelem Araw_body[] = {RAWINPUT, 0};
+       Hidden struct classinfo raw_body[] = {Araw_body};
+Hidden classelem Araw_input[] = {Optional, Raw, 0};
+       Hidden struct classinfo raw_input[] = {Araw_input};
+
+Hidden classelem Aid_or_kw[] = {Tag, Keyword, 0};
+       Hidden struct classinfo id_or_kw[] = {Aid_or_kw};
+Hidden classelem Anumber[] = {Number, 0};
+       Hidden struct classinfo number[] = {Anumber};
+Hidden classelem Asign[] = {Optional, Plus_sign, Minus_sign, 0};
+       Hidden struct classinfo sign[] = {Asign};
+
+Hidden classelem Ao_c_expr[] = {Optional, Collateral, EXPR, 0};
+       Hidden struct classinfo o_c_expr[] = {Ao_c_expr};
+
+#define Ac_expr (Ao_c_expr+1)
+       Hidden struct classinfo c_expr[] = {Ac_expr};
+#define Aexpr (Ao_c_expr+2)
+       Hidden struct classinfo expr[] = {Aexpr};
+#define Aprimary (Ao_c_expr+5)
+       Hidden struct classinfo primary[] = {Aprimary};
+
+Hidden classelem Ablock[] = {Operators, PRIMARY, 0};
+       Hidden struct classinfo block[] = {Ablock};
+Hidden classelem Agroup[] = {Blocked, Operators, PRIMARY, 0};
+       Hidden struct classinfo group[] = {Agroup};
+
+#define Ar_expr Agroup
+       Hidden struct classinfo r_expr[] = {Ar_expr};
+
+Hidden classelem Al_t_body[] = {Optional, List_body, PRIMARY, Blocked, 
+       Grouped, Operators, Tab_body, Tab_entry, 0};
+       Hidden struct classinfo l_t_body[] = {Al_t_body};
+Hidden classelem Alist_body[] = {List_body, EXPR, 0};
+       Hidden struct classinfo list_body[] = {Alist_body};
+Hidden classelem Atab_body[] = {Tab_body, Tab_entry, 0};
+       Hidden struct classinfo tab_body[] = {Atab_body};
+Hidden classelem Atab_entry[] = {Tab_entry, 0};
+       Hidden struct classinfo tab_entry[] = {Atab_entry};
+
+Hidden classelem Ac_target[] = {Col_target, TARGET, 0};
+       Hidden struct classinfo c_target[] = {Ac_target};
+
+#define Atarget (Ac_target+1)
+       Hidden struct classinfo target[] = {Atarget};
+
+#define SOME_ETC \
+       Not, Some_in, Each_in, No_in, Some_parsing, Each_parsing, No_parsing
+
+Hidden classelem Ae_test[] = {Else_kw, SOME_ETC, And, Or, EXPR, 0};
+       Hidden struct classinfo e_test[] = {Ae_test};
+
+#define Atest (Ae_test+1)
+       Hidden struct classinfo test[] = {Atest};
+#define At_test Aexpr
+       Hidden struct classinfo t_test[] = {At_test};
+Hidden classelem Ar_test[] = {SOME_ETC, EXPR, 0};
+       Hidden struct classinfo r_test[] = {Ar_test};
+Hidden classelem Aand_test[] = {SOME_ETC, And, EXPR, 0};
+       Hidden struct classinfo and_test[] = {Aand_test};
+Hidden classelem Aor_test[] = {SOME_ETC, Or, EXPR, 0};
+       Hidden struct classinfo or_test[] = {Aor_test};
+Hidden classelem Ac_test[] = {Collateral, SOME_ETC, And, Or, EXPR, 0};
+       Hidden struct classinfo c_test[] = {Ac_test};
+       /*
+        * This means that a compound expression may in fact
+        * contain a `collateral test', e.g. (a AND b, c AND d).
+        * Of course, this is illegal in B, but I couldn't
+        * solve the ambiguity of `(' where a test is expected
+        * otherwise (this may start a parenthesized test, or
+        * a compound expression; the latter may be followed
+        * by more expression fragments, the first may not).
+        */
+
+Hidden classelem Acomment[] = {Comment, 0};
+       Hidden struct classinfo comment[] = {Acomment};
+Hidden classelem Ao_comment[] = {Optional, Comment, 0};
+       Hidden struct classinfo o_comment[] = {Ao_comment};
+       
+#define HEAD How_to, Yield, Test
+#define BODY HEAD, Cmt_head, Long_unit, Short_unit
+
+/* The order here determines which are suggested first and is subject
+   to constant change! */
+#define SIMPLE_CMD SC1, SC2, SC3
+#define SC1 Share, Quit, Return, Write, Read, Read_raw, Put, Delete
+#define SC2 Report, Fail, Succeed, Insert, Remove, Check
+#define SC3 Choose, Draw, Set_random, Suggestion, Keyword, Kw_plus
+
+#define CONTROL_CMD If, While, For
+#define COMP_CMD Short_comp, Long_comp, Cmt_comp, Select
+#define CMD If, For, COMP_CMD, SIMPLE_CMD, While
+/* #define SHORTCMD SIMPLE_CMD, Cmt_cmd */
+#define SHORTCMD If, For, SIMPLE_CMD, While, Short_comp, Cmt_comp, Cmt_cmd
+
+Hidden classelem Ac_head[] = {Cmt_head, HEAD, 0};
+       Hidden struct classinfo c_head[] = {Ac_head};
+#define Ahead (Ac_head+1)
+       Hidden struct classinfo head[] = {Ahead};
+
+Hidden classelem Aunit[] = {Optional, EXPR, BODY, Ref_join, 0};
+       Hidden struct classinfo unit[] = {Aunit};
+Hidden classelem Ao_refinements[] = {Optional, Refinement, 0};
+       Hidden struct classinfo o_refinements[] = {Ao_refinements};
+#define Arefinements (Ao_refinements+1)
+       Hidden struct classinfo refinements[] = {Arefinements};
+Hidden classelem Arefpred[] = {BODY, 0};
+       Hidden struct classinfo refpred[] = {Arefpred};
+
+Hidden classelem Af_cmd[] = {Keyword, F_kw_plus, 0};
+       Hidden struct classinfo f_cmd[] = {Af_cmd};
+#define Af_formula Aexpr /*****/
+       Hidden struct classinfo f_formula[] = {Af_formula};
+
+Hidden classelem Ao_suite[] = {Optional, Suite, 0};
+       Hidden struct classinfo o_suite[] = {Ao_suite};
+Hidden classelem At_suite[] = {Test_suite, 0};
+       Hidden struct classinfo t_suite[] = {At_suite};
+Hidden classelem Ao_t_suite[] = {Optional, Test_suite, 0};
+       Hidden struct classinfo o_t_suite[] = {Ao_t_suite};
+
+Hidden classelem Acmd[] = {Comment, CMD, Cmt_cmd, 0};
+       Hidden struct classinfo cmd[] = {Acmd};
+Hidden classelem Ashortcmd[] = {SHORTCMD, 0};
+       Hidden struct classinfo shortcmd[] = {Ashortcmd};
+Hidden classelem Ao_cmdsuite[] = {Optional, SHORTCMD, Suite, 0};
+       Hidden struct classinfo o_cmdsuite[] = {Ao_cmdsuite};
+Hidden classelem Asuite[] = {Suite, 0};
+       Hidden struct classinfo suite[] = {Asuite};
+Hidden classelem Asimple_cmd[] = {SIMPLE_CMD, 0};
+       Hidden struct classinfo simple_cmd[] = {Asimple_cmd};
+
+Hidden classelem Ac_ifforwhile[] = {CONTROL_CMD, Cmt_comp, 0};
+       Hidden struct classinfo c_ifforwhile[] = {Ac_ifforwhile};
+Hidden classelem Aifforwhile[] = {CONTROL_CMD, 0};
+       Hidden struct classinfo ifforwhile[] = {Aifforwhile};
+
+Hidden classelem Akeyword[] = {Keyword, 0};
+       Hidden struct classinfo keyword[] = {Akeyword};
+Hidden classelem Akw_next[] = {Collateral, EXPR, Keyword, E_plus, Kw_plus, 0};
+       Hidden struct classinfo kw_next[] = {Akw_next};
+Hidden classelem Ae_next[] = {Keyword, Kw_plus, 0};
+       Hidden struct classinfo e_next[] = {Ae_next};
+
+Hidden classelem Af_kw_next[] = {Tag, Keyword, F_kw_plus, F_e_plus, 0};
+       Hidden struct classinfo f_kw_next[] = {Af_kw_next};
+Hidden classelem Af_e_next[] = {Keyword, F_kw_plus, 0};
+       Hidden struct classinfo f_e_next[] = {Af_e_next};
+Hidden classelem Atag[] = {Tag, 0};
+       Hidden struct classinfo tag[] = {Atag};
+
+Hidden classelem Atext1[] = {Optional, T1, Conversion, T1_plus, 0};
+       Hidden struct classinfo text1[] = {Atext1};
+Hidden classelem At1_conv[] = {T1, Conversion, 0};
+       Hidden struct classinfo t1_conv[] = {At1_conv};
+Hidden classelem At1_next[] = {T1, Conversion, T1_plus, 0};
+       Hidden struct classinfo t1_next[] = {At1_next};
+
+Hidden classelem Atext2[] = {Optional, T2, Conversion, T2_plus, 0};
+       Hidden struct classinfo text2[] = {Atext2};
+Hidden classelem At2_conv[] = {T2, Conversion, 0};
+       Hidden struct classinfo t2_conv[] = {At2_conv};
+Hidden classelem At2_next[] = {T2, Conversion, T2_plus, 0};
+       Hidden struct classinfo t2_next[] = {At2_next};
+
+Hidden classelem Aand[] = {And_kw, 0};
+       Hidden struct classinfo and[] = {Aand};
+Hidden classelem Aor[] = {Or_kw, 0};
+       Hidden struct classinfo or[] = {Aor};
+
+Hidden classelem Ae_part[] = {E_part, 0};
+       Hidden struct classinfo e_part[] = {Ae_part};
+
+Hidden classelem Aunit_edit[] = {Optional, BODY, Ref_join, 0};
+       Hidden struct classinfo unit_edit[] = {Aunit_edit};
+Hidden classelem Atarget_edit[] = {Optional, EXPR, 0};
+       Hidden struct classinfo target_edit[] = {Atarget_edit};
+Hidden classelem Aimm_cmd[] = {Optional, Comment, HEAD, CMD, Cmt_cmd, Cmt_head,
+       Edit_unit, Edit_target, 0};
+       Hidden struct classinfo imm_cmd[] = {Aimm_cmd};
+
+Hidden classelem Aed_unit[] = {Optional, Tag, Keyword, Colon, 0};
+       Hidden struct classinfo ed_unit[] = {Aed_unit};
+Hidden classelem Aed_target[] = {Optional, Tag, Equals, 0};
+       Hidden struct classinfo ed_target[] = {Aed_target};
+
+
+/*
+ * WARNING: The entries in this table must correspond one by one
+ * to the symbols defined earlier.  This is checked dynamically
+ * by the initialization procedure (syserr "table order").
+ */
+
+#define XX(name) name, "name"
+
+Hidden struct table b_grammar[] = {
+       {XX(Rootsymbol), {0}, {unit}}, /* Start symbol of the grammar,
+                       may be overridden by setroot("Blabla") call. */
+       {XX(Put), {"PUT ", " IN "}, {c_expr, c_target}},
+       {XX(Insert), {"INSERT ", " IN "}, {c_expr, target}},
+       {XX(Remove), {"REMOVE ", " FROM "}, {c_expr, target}},
+       {XX(Choose), {"CHOOSE ", " FROM "}, {c_expr, expr}},
+       {XX(Draw), {"DRAW "}, {target}},
+       {XX(Set_random), {"SET'RANDOM "}, {c_expr}},
+       {XX(Delete), {"DELETE "}, {c_target}},
+       {XX(Check), {"CHECK "}, {test}},
+       {XX(Share), {"SHARE "}, {c_target}},
+
+       {XX(Write), {"WRITE "}, {c_expr}},
+       {XX(Read), {"READ ", " EG "}, {c_target, c_expr}},
+       {XX(Read_raw), {"READ ", " RAW"}, {target}},
+
+       {XX(If), {"IF ", ": "}, {test}},
+       {XX(While), {"WHILE ", ": "}, {test}},
+       {XX(For), {"FOR ", " IN ", ": "}, {c_target, expr}},
+
+       {XX(Select), {"SELECT: ", "\t", "\b"}, {o_comment, t_suite}},
+       {0}, /* Test_suite moved to 92 */
+
+       {XX(Quit), {"QUIT"}, {0}},
+       {XX(Return), {"RETURN "}, {c_expr}},
+       {XX(Report), {"REPORT "}, {test}},
+       {XX(Succeed), {"SUCCEED"}, {0}},
+       {XX(Fail), {"FAIL"}, {0}},
+
+       {XX(How_to), {"HOW'TO ", ": "}, {f_cmd}},
+       {XX(Yield), {"YIELD ", ": "}, {f_formula}},
+       {XX(Test), {"TEST ", ": "}, {f_formula}},
+
+       {XX(Suite), {"\n"}, {cmd, o_suite}},
+       {XX(Refinement), {"\n", ": ", "\t", "\b"},
+               {id_or_kw, o_comment, o_cmdsuite, o_refinements}},
+
+       {XX(Compound), {"(", ")"}, {c_test}},
+       {XX(Collateral), {0, ", "}, {expr, c_expr}},
+       {XX(Tag), {0}, {tag_body}},
+       {XX(Number), {0}, {num_body}},
+       {XX(Selection), {0, "[", "]"}, {target, c_expr}},
+       {XX(Behead), {0, "@"}, {target, r_expr}},
+       {XX(Curtail), {0, "|"}, {target, r_expr}},
+
+       {XX(And), {0, " "}, {t_test, and}},
+       {XX(Or), {0, " "}, {t_test, or}},
+       {XX(Not), {"NOT "}, {r_test}},
+       {XX(Some_in), {"SOME ", " IN ", " HAS "}, {c_target, expr, r_test}},
+       {XX(Each_in), {"EACH ", " IN ", " HAS "}, {c_target, expr, r_test}},
+       {XX(No_in), {"NO ", " IN ", " HAS "}, {c_target, expr, r_test}},
+       {XX(Some_parsing), {"SOME ", " PARSING ", " HAS "},
+               {c_target, expr, r_test}},
+       {XX(Each_parsing), {"EACH ", " PARSING ", " HAS "},
+               {c_target, expr, r_test}},
+       {XX(No_parsing), {"NO ", " PARSING ", " HAS "}, {c_target, expr, r_test}},
+
+       {XX(Comment), {0}, {com_body}},
+       {XX(Keyword), {0}, {kw_body}},
+
+       {XX(L_t_dis), {"{", "}"}, {l_t_body}},
+       {XX(List_body), {0, "; "}, {expr, list_body}},
+       {XX(Tab_body), {0, "; "}, {tab_entry, tab_body}},
+       {XX(Tab_entry), {"[", "]: "}, {c_expr, expr}},
+       {XX(E_number), {0}, {number, e_part}},
+
+       {XX(Com_target), {"(", ")"}, {c_target}},
+       {XX(Col_target), {0, ", "}, {target, c_target}},
+       {XX(Sel_expr), {0, "[", "]"}, {primary, c_expr}},
+
+       {XX(Text1), {"'", "'"}, {text1}},
+       {XX(Text2), {"\"", "\""}, {text2}},
+       {XX(Grouped), {0, " "}, {group, expr}},
+       {XX(Blocked), {0}, {block, group}},
+       {XX(Operators), {0}, {ops_body}},
+       {XX(Else_kw), {"ELSE"}, {0}},
+       {XX(Kw_plus), {0, " "}, {keyword, kw_next}},
+       {XX(E_plus), {0, " "}, {c_expr, e_next}},
+       {XX(Conversion), {"`", "`"}, {o_c_expr}},
+       {XX(T1), {0}, {t1_body}},
+       {XX(T1_plus), {0}, {t1_conv, t1_next}},
+       {XX(T2), {0}, {t2_body}},
+       {XX(T2_plus), {0}, {t2_conv, t2_next}},
+       {XX(Cmt_cmd), {0, " "}, {simple_cmd, comment}},
+       {0},
+       {XX(F_kw_plus), {0, " "}, {keyword, f_kw_next}},
+       {XX(F_e_plus), {0, " "}, {tag, f_e_next}},
+       {XX(Plus_sign), {"+"}, {0}},
+       {XX(Minus_sign), {"-"}, {0}},
+
+       {XX(Long_comp), {0, "\t", "\b"}, {c_ifforwhile, suite}},
+       {XX(Short_comp), {0, "\t", "\b"}, {ifforwhile, shortcmd}},
+       {XX(Cmt_comp), {0}, {ifforwhile, comment}},
+
+       {XX(Long_unit), {0, "\t", "\b"}, {c_head, suite}},
+       {XX(Short_unit), {0, "\t", "\b"}, {head, shortcmd}},
+       {XX(Cmt_head), {0}, {head, comment}},
+
+       {XX(Ref_join), {0}, {refpred, refinements}},
+
+       {XX(And_kw), {"AND "}, {and_test}},
+       {XX(Or_kw), {"OR "}, {or_test}},
+
+       {XX(E_part), {"E"}, {sign, number}},
+
+       /* Alternate root symbols */
+
+       {XX(Unit_edit), {0}, {unit_edit}},
+       {XX(Target_edit), {0}, {target_edit}},
+       {XX(Imm_cmd), {0}, {imm_cmd}},
+       {XX(Raw), {0}, {raw_body}},
+       {XX(Raw_input), {0}, {raw_input}},
+       {XX(Edit_unit), {":"}, {ed_unit}},
+       {XX(Edit_target), {"="}, {ed_target}},
+       {XX(Colon), {":"}, {0}},
+       {XX(Equals), {"="}, {0}},
+       {XX(Test_suite), {"\n", ": ", "\t", "\b"},
+               {e_test, o_comment, o_cmdsuite, o_t_suite}},
+       {XX(Expression), {0}, {c_expr}},
+
+       /* Spare(s); change Optional and Hole in "gram.h" if you run out. */
+
+       {0}, {0}, {0},
+
+       /* Next three entries must be the last entries of the table. */
+       /* (See comments in "gram.c", initgram().) */
+
+       {XX(Suggestion), {0}, {sugg_body}},
+       {XX(Optional), {0}, {0}},
+       {XX(Hole), {"?"}, {0}},
+};
+
+Visible struct table *table= b_grammar;

diff --git a/usr/contrib/B/src/bed/term.c b/usr/contrib/B/src/bed/term.c
new file mode 100644 (file)
index 0000000..406092b
--- /dev/null
+++ b/usr/contrib/B/src/bed/term.c
@@ -0,0 +1,72 @@
+/* Copyright (c) Stichting Mathematisch Centrum, Amsterdam, 1984. */
+/* $Header: term.c,v 2.5 85/08/22 16:09:34 timo Exp $ */
+
+/*
+ * B editor -- Init/end terminal-related modules.
+ *
+ * This file should be wiped out completely.
+ */
+
+
+#include "b.h"
+#include "erro.h"
+
+extern bool dflag;
+
+extern bool nosense;
+
+
+/*
+ * Call initialization code of other terminal-dependent modules.
+ * N.B. the order of initializations is determined by black magic.
+ *     Don't change!
+ */
+
+Visible Procedure
+initterm()
+{
+#ifndef NDEBUG
+       if (dflag)
+               fprintf(stderr, "*** initterm();\n\r");
+#endif NDEBUG
+       /* initshow(); */
+       initgetc();
+}
+
+
+/*
+ * Extermination code, reverse of initterm().
+ * N.B. the order of exterminations is determined by black magic.
+ *      Don't change!
+ */
+
+Visible Procedure
+endterm()
+{
+#ifndef NDEBUG
+       if (dflag)
+               fprintf(stderr, "*** endterm();\n\r");
+#endif NDEBUG
+       /* endshow(); */
+       endgetc();
+}
+
+
+/*
+ * Compatible interface with trmsense; return No if not sensed.
+ */
+
+Visible bool
+sense(py, px)
+       int *py;
+       int *px;
+{
+       trmsense(py, px);
+       if (*py >= 0 && *px >= 0)
+               return Yes;
+       if (nosense)
+               error(GOTO_NO);
+       else
+               error(GOTO_BAD);
+       return No;
+}

diff --git a/usr/contrib/B/src/bed/unix.c b/usr/contrib/B/src/bed/unix.c
new file mode 100644 (file)
index 0000000..2c3a7be
--- /dev/null
+++ b/usr/contrib/B/src/bed/unix.c
@@ -0,0 +1,501 @@
+/* Copyright (c) Stichting Mathematisch Centrum, Amsterdam, 1984. */
+static char rcsid[] = "$Header: unix.c,v 2.6 85/08/22 16:09:38 timo Exp $";
+
+/*
+ * B editor -- UNIX interface, i.e. signal and tty fiddling.
+ */
+
+/* #define BADTABSTOPS /* Obsolete -- "b" doesn't set the tabs any more */
+       /* Defined if (soft) tabs may have been placed at strange positions. */
+       /* Actually this has only effect if curses(3) is used.
+          However this source file doesn't #include "curses.h" so we can't
+          check for that, and will assume curses(3) is always used.
+          For very slow baudrates when curses(3) is used, it may prove useful
+          to undefine BADTABSTOPS.  The "b" shell script must then be modified
+          to keep the tabs at the UNIX 8 space apart default. */
+
+#include "b.h" /* Only for definitions like bool, string, Hidden etc. */
+#include "unix.h" /* What kind of UNIX is this? */
+
+#ifdef SIGNAL
+#include <signal.h>
+#endif SIGNAL
+
+#ifdef SGTTY_H
+#include <sgtty.h>
+#endif SGTTY_H
+
+extern bool slowterminal; /* Set for speeds <= 600 baud */
+extern bool hushbaby; /* Set if no bells are to be heard */
+extern bool dflag; /* Debugging mode */
+
+
+#define COPYSAVEFILE ".Bed_buf"
+
+Visible char copysavefile[200] = COPYSAVEFILE;
+
+
+#define Ctl(x) ('x'&037)
+
+#ifndef QUITCHAR
+#define QUITCHAR Ctl(\\)
+#endif QUITCHAR
+
+#ifndef INTRCHAR
+#define INTRCHAR Ctl(])
+#endif INTRCHAR
+
+#define REDRAW Ctl(L) /* From "keys.h" */
+
+
+#ifdef SIGNAL
+/*
+ * Call exit code when signal arrives, then resend the signal.
+ */
+
+catch(sig)
+       int sig;
+{
+       signal(sig, SIG_DFL);
+#ifndef NDEBUG
+       fprintf(stderr, "*** Caught signal %d \n\r", sig);
+       if (sig == SIGQUIT) { /* QUIT only resets terminal modes */
+               endterm();
+               endunix();
+       }
+       else
+#endif NDEBUG
+               endall();
+#ifdef BTOP
+       termchild(); /* Kill possible child, but don't wait for it */
+#endif BTOP
+       kill(getpid(), sig);
+}
+#endif SIGNAL
+
+
+#ifdef SIGTSTP /* I.e., only on BSD systems with job control. */
+/*
+ * Reset tty modes etc. when STOP signal arrives (control-Z).
+ * This is like interrupt but the program may continue later
+ * so we must not do all exit code).
+ *
+ * In order that the code works for 4.1 and 4.2 BSD Unix (V7 and sys III/V
+ * don't have the SIGTSTP signal at all, so there wo don't bother), we use
+ * neither the awkward "-ljobs" mechanism nor the nicer but (yet!) even
+ * less portable sigmask/sigblock system calls.  Rather, to kill ourselves
+ * again after the screen and tty modes have been restored, we use another
+ * signal, i.e., SIGSTOP (which is uncatchable).
+ *
+ * Note! Since curses' initscr() also executes signal(SIGTSTP, tstp),
+ * and initscr() is called after initunix(), the name of this routine
+ * must be tstp, overriding a routine of the same name in the curses
+ * library which does not do what we want.
+ */
+
+tstp(sig)
+       int sig;
+{
+       int (*prevttousig)() = signal(SIGTTOU, SIG_IGN);
+               /* Ignore SIGTTOU so stty calls won't stop us again! */
+       char cread = REDRAW;
+
+#ifndef NDEBUG
+       if (dflag)
+               fprintf(stderr, "*** Caught stop signal %d \n\r", sig);
+#endif NDEBUG
+       signal(sig, SIG_DFL);
+       endterm();
+       unfixttymodes();
+       signal(SIGTTOU, prevttousig);
+       kill(getpid(), SIGSTOP); /* Hard stop */
+
+       /*
+        * A stop signal made us go to sleep in Tumbolia.
+        * When we awake, we continue at this point.
+        * The world may well have changed a little bit,
+        * so do the tty initializations anew.
+        */
+
+       fixttymodes();
+       initterm();
+
+#ifdef TIOCSTI
+       /* Simulate receipt of REDRAW initially so we come up
+          with a nice display. */
+       ioctl(0, TIOCSTI, &cread);
+#endif TIOCSTI
+       signal(SIGTSTP, tstp);
+}
+#endif SIGTSTP
+
+
+/*
+ * Prepare for interrupts (UNIX `signals') to be caught so
+ * we can reset the tty modes and perform miscellaneous other
+ * exit routines.
+ * Note -- if a signal arrives before the call to fixttymodes,
+ * the unfixttymodes may render the terminal useless.  The fix is
+ * easy, but I'm too lazy now (just read the statuses BEFORE,
+ * but change them only AFTER signal setting).
+ */
+
+initunix()
+{
+#ifdef SIGNAL
+       register int i;
+#endif SIGNAL
+
+#ifndef NDEBUG
+       if (dflag)
+               fprintf(stderr, "*** initunix();\n\r");
+#endif NDEBUG
+
+#ifdef SIGNAL
+       for (i = 1; i <= NSIG; ++i) {
+#ifndef NDEBUG
+               if (i == SIGQUIT)
+                       continue;
+#endif NDEBUG
+#ifdef SIGCONT
+               if (i == SIGCONT)
+                       continue;
+#endif SIGCONT
+#ifdef SIGCHLD
+               if (i == SIGCHLD)
+                       continue;
+#endif SIGCHLD
+               if (signal(i, SIG_IGN) != SIG_IGN) {
+                       signal(i, catch);
+#ifndef NDEBUG
+                       if (dflag)
+                               fprintf(stderr, "Catching signal %d\n", i);
+#endif NDEBUG
+               }
+       }
+       /* Stop/continue must be handled differently, see stop() above. */
+#ifdef SIGTSTP
+       if (signal(SIGTSTP, SIG_IGN) != SIG_IGN)
+               signal(SIGTSTP, tstp);
+#endif SIGTSTP
+
+#endif SIGNAL
+
+#ifdef SGTTY_H
+       fixttymodes();
+#endif SGTTY_H
+       setcopybuffer();
+}
+
+
+/*
+ * The last termination routine to be called.
+ * It also resets all signals to their default status.
+ */
+
+endunix()
+{
+#ifdef SIGNAL
+       int i;
+#endif SIGNAL
+
+       fflush(stdout);
+#ifndef NDEBUG
+       if (dflag)
+               fprintf(stderr, "*** endunix();\n\r");
+#endif NDEBUG
+#ifdef SGTTY_H
+       unfixttymodes();
+#endif SGTTY_H
+
+#ifdef SIGNAL
+       for (i = 1; i <= NSIG; ++i)
+               signal(i, SIG_DFL);
+#endif SIGNAL
+}
+
+
+/*
+ * Determine the name of the file where the copy buffer is saved.
+ */
+
+Hidden Procedure
+setcopybuffer()
+{
+       string home = getenv("HOME");
+
+       if (home)
+               sprintf(copysavefile, "%.150s/%.40s", home, COPYSAVEFILE);
+       /* Else, retain default initialization! */
+}
+
+
+/*
+ * Return a string like the one that perror(arg) would print
+ * (see UNIX manual page perror(3) for details).
+ * Like all C library routines returning strings, the string points
+ * to static storage that is overwritten on each call.
+ * If arg is fairly long, it may get truncated.
+ */
+
+string
+unixerror(arg)
+       string arg;
+{
+       static char msg[200];
+#ifdef PERROR
+       extern int sys_nerr, errno;
+       extern string sys_errlist[];
+
+       if (errno > 0 && errno < sys_nerr)
+               sprintf(msg, "%.80s: %.80s", arg, sys_errlist[errno]);
+       else
+               sprintf(msg, "%.80s: UNIX error %d", arg, errno);
+#else !PERROR
+       sprintf(msg, "%.68s: I/O error", arg);
+#endif !PERROR
+       msg[80] = '\0';
+       return msg;
+}
+
+
+#ifdef SGTTY_H
+/*
+ * Hacks to fix certain peculiarities due to the hostile environment
+ * in which the editor lives.
+ */
+
+Hidden struct sgttyb oldtty;
+
+#ifdef TIOCSETC
+Hidden struct tchars oldtchars;
+#endif
+
+#ifdef TIOCSLTC
+Hidden struct ltchars oldltchars;
+#endif
+
+Hidden Procedure
+fixttymodes()
+{
+       gtty(2, &oldtty);
+       if (oldtty.sg_ospeed <= B600)
+               slowterminal = Yes;
+#ifdef BADTABSTOPS
+       /*
+        * Turn on XTABS mode, to be able to live when terminal tabs are
+        * set at 4 rather than 8 columns (the B interpreter used to set
+        * this).
+        */
+       if (!(oldtty.sg_flags & XTABS)) {
+               struct sgttyb newtty;
+               gtty(2, &newtty);
+               newtty.sg_flags |= XTABS;
+               ioctl(0, TIOCSETN, &newtty);
+       }
+#endif BADTABSTOPS
+
+#ifdef TIOCSETC /* I.e., not at pre-version 7 UNIX systems */
+       /*
+        * Set the quit character to ^\ and the interrupt at DEL.
+        * The start/stop characters are kept only if they are ^S/^Q.
+        */
+       {
+               struct tchars newtchars;
+               ioctl(0, TIOCGETC, &oldtchars);
+               ioctl(0, TIOCGETC, &newtchars);
+               if ((newtchars.t_intrc & 0377) != 0377
+                       && newtchars.t_intrc != 0177/*DEL*/)
+                       newtchars.t_intrc = INTRCHAR;
+               if ((newtchars.t_quitc & 0377) != 0377)
+                       newtchars.t_quitc = QUITCHAR;
+               if (newtchars.t_startc != Ctl(Q))
+                       newtchars.t_startc = -1;
+               if (newtchars.t_stopc != Ctl(S))
+                       newtchars.t_stopc = -1;
+               ioctl(0, TIOCSETC, &newtchars);
+       }
+#endif TIOCSETC
+
+#ifdef TIOCSLTC /* I.e., at 4.xBSD systems */
+       /*
+        * Turn off all local control characters except keep stop (^Z) and delayed
+        * stop (^Y) when these are the originals.
+        */
+       {
+               static struct ltchars newltchars = {-1, -1, -1, -1, -1, -1};
+
+               ioctl(0, TIOCGLTC, &oldltchars);
+               if (oldltchars.t_suspc == Ctl(Z))
+                       newltchars.t_dsuspc = Ctl(Z);
+               ioctl(0, TIOCSLTC, &newltchars);
+       }
+#endif
+}
+
+
+/*
+ * Undo the effects of fixttymodes(), see comments there.
+ */
+
+Hidden Procedure
+unfixttymodes()
+{
+       if (!oldtty.sg_ospeed)
+               return; /* Not yet initialized! */
+#ifdef BADTABSTOPS
+       ioctl(0, TIOCSETN, &oldtty);
+#endif
+#ifdef TIOCSETC
+       ioctl(0, TIOCSETC, &oldtchars);
+#endif
+#ifdef TIOCSLTC
+       ioctl(0, TIOCSLTC, &oldltchars);
+#endif
+}
+#endif SGTTY_H
+
+
+/*
+ * Return Yes if more input immediately available
+ */
+
+#ifdef IBMPC
+
+Visible bool
+moreinput()
+{
+       return kbhit();
+}
+
+#else !IBMPC
+
+/*
+ * ***** UNIX DEPENDENCE *****
+ * Assumes the standard UNIX definition of FILE: assumes there is
+ * buffered input if stdin->_cnt > 0, so uses the `_cnt' field.
+ *
+ * ***** 4.2 BSD DEPENDENCE *****
+ * If the symbol SIGNAL is defined, uses the select() system call to determine
+ * whether more input is available; see select(2) in 4.2 BSD manual.
+ *
+ * ***** 4.1 BSD DEPENDENCE *****
+ * If the symbol FIONREAD is defined, uses the correponding ioctl call to
+ * determine whether more input is available; see tty(4) in 4.1 BSD manual.
+ */
+
+#ifdef SELECT
+#include <sys/time.h>
+#endif SELECT
+
+Visible bool
+moreinput()
+{
+       if (stdin->_cnt > 0)
+               return Yes;
+#ifdef SELECT
+       {
+               int readfds;
+               int nfds;
+               static struct timeval timeout = {0, 0};
+
+               readfds = 1<<fileno(stdin);
+               nfds = 1+fileno(stdin);
+               nfds = select(nfds, &readfds, (int*)0, (int*)0, &timeout);
+               if (nfds > 0) {
+                       if (dflag)
+                               fputc('\07', stderr);
+                       return Yes;
+               }
+       }
+#else SELECT
+#ifdef FIONREAD
+       {
+               long n = 0;
+
+               if (ioctl(0, FIONREAD, &n) != -1 && n > 0)
+                       return Yes;
+       }
+#endif FIONREAD
+#endif SELECT
+       return No;
+}
+#endif !IBMPC
+
+
+#ifdef SETENV
+/*
+ * Routine to add or change an environment variable.
+ * (No longer used.)
+ */
+
+extern string *environ;
+
+setenv(entry)
+       string entry;
+{
+       string equals = index(entry, '=');
+       int len;
+       string *ep;
+       static string *myenviron;
+
+       if (!equals)
+               syserr("setenv: no = sign");
+       len = equals - entry;
+       for (ep = environ; *ep && !Strnequ(*ep, entry, len+1); ++ep)
+               ;
+       if (*ep) {
+               *ep = entry;
+               return;
+       }
+       len = ep - environ + 2;
+       if (myenviron) {
+               myenviron = (string*)
+                       realloc((string)myenviron, (unsigned)(len * sizeof(string)));
+               if (!myenviron)
+                       syserr("setenv: realloc");
+       }
+       else {
+               myenviron = (string*) malloc((unsigned)(len * sizeof(string)));
+               if (!myenviron)
+                       syserr("setenv: malloc");
+               for (ep = environ; *ep; ++ep)
+                       myenviron[ep-environ] = *ep;
+       }
+       myenviron[len-1] = (string)NULL;
+       myenviron[len-2] = entry;
+       environ = myenviron;
+}
+#endif SETENV
+
+
+#ifdef PWB
+/*
+ * Substitute getenv routine - there is no environment on PWB systems,
+ * but as a substitute (not te be encouraged!) we allow a file with the
+ * name of the environment variable to contain the desired value;
+ * e.g. the file "TERM" may contain a line saying hp2621 or hp etc.
+ */
+
+Visible string
+getenv(name)
+       string name;
+{
+       static char buffer[100];
+       FILE *fp;
+       string cp;
+
+       fp = fopen(name, "r");
+       if (!fp)
+               return NULL;
+       if (!fgets(buffer, sizeof buffer, fp))
+               buffer[0] = '\0';
+       else {
+               cp = index(buffer, '\n');
+               if (cp)
+                       *cp = '\0';
+       }
+       fclose(fp);
+       return buffer;
+ }
+#endif PWB

diff --git a/usr/contrib/B/src/bed/wide.c b/usr/contrib/B/src/bed/wide.c
new file mode 100644 (file)
index 0000000..5b098bb
--- /dev/null
+++ b/usr/contrib/B/src/bed/wide.c
@@ -0,0 +1,339 @@
+/* Copyright (c) Stichting Mathematisch Centrum, Amsterdam, 1984. */
+static char rcsid[] = "$Header: wide.c,v 2.3 84/07/19 12:01:37 guido Exp $";
+
+/*
+ * B editor -- Commands to make the focus larger and smaller in various ways.
+ */
+
+#include "b.h"
+#include "bobj.h"
+#include "node.h"
+#include "supr.h"
+#include "gram.h"
+
+
+/*
+ * Widen -- make the focus larger.
+ */
+
+Visible bool
+widen(ep)
+       register environ *ep;
+{
+       register node n;
+       register int sym;
+       register int ich;
+
+       higher(ep);
+       grow(ep);
+
+       n = tree(ep->focus);
+       sym = symbol(n);
+       if (ep->mode == VHOLE && (ep->s1&1))
+               ep->mode = FHOLE;
+               
+       switch (ep->mode) {
+
+       case ATBEGIN:
+       case ATEND:
+               /* Shouldn't occur after grow(ep) */
+               ep->mode = WHOLE;
+               return Yes;
+
+       case VHOLE:
+               if (ep->s2 >= lenitem(ep))
+                       --ep->s2;
+               ep->mode = SUBRANGE;
+               ep->s3 = ep->s2;
+               return Yes;
+
+       case FHOLE:
+               if (ep->s2 >= lenitem(ep)) {
+                       if (ep->s2 > 0)
+                               --ep->s2;
+                       else {
+                               leftvhole(ep);
+                               switch (ep->mode) {
+                               case ATBEGIN:
+                               case ATEND:
+                                       ep->mode = WHOLE;
+                                       return Yes;
+                               case VHOLE:
+                               case FHOLE:
+                                       if (ep->s2 >= lenitem(ep)) {
+                                               if (ep->s2 == 0) {
+#ifndef NDEBUG
+                                                       debug("[Desperate in widen]");
+#endif NDEBUG
+                                                       ep->mode = SUBSET;
+                                                       ep->s2 = ep->s1;
+                                                       return widen(ep);
+                                               }
+                                               --ep->s2;
+                                       }
+                                       ep->mode = SUBRANGE;
+                                       ep->s3 = ep->s2;
+                                       return Yes;
+                               }
+                               Abort();
+                       }
+               }
+               ep->mode = SUBRANGE;
+               ep->s3 = ep->s2;
+               return Yes;
+
+       case SUBRANGE:
+               ep->mode = SUBSET;
+               ep->s2 = ep->s1;
+               return Yes;
+                       
+       case SUBSET:
+               if (!issublist(sym) || width(lastchild(n)) == 0) {
+                       ep->mode = WHOLE;
+                       return Yes;
+               }
+               if (ep->s2 < 2*nchildren(n)) {
+                       ep->mode = SUBLIST;
+                       ep->s3 = 1;
+                       return Yes;
+               }
+               /* Fall through */
+       case SUBLIST:
+               for (;;) {
+                       ich = ichild(ep->focus);
+                       if (!up(&ep->focus)) {
+                               ep->mode = WHOLE;
+                               return Yes;
+                       }
+                       higher(ep);
+                       n = tree(ep->focus);
+                       if (ich != nchildren(n) || !samelevel(sym, symbol(n))) {
+                               ep->mode = SUBSET;
+                               ep->s1 = ep->s2 = 2*ich;
+                               return Yes;
+                       }
+               }
+               /* Not reached */
+                       
+       case WHOLE:
+               ich = ichild(ep->focus);
+               if (!up(&ep->focus))
+                       return No;
+               n = tree(ep->focus);
+               if (issublist(symbol(n)) && ich < nchildren(n)) {
+                       ep->mode = SUBLIST;
+                       ep->s3 = 1;
+               }
+               return Yes;
+
+       default:
+               Abort();
+               /* NOTREACHED */
+       }
+       /* Not reached */
+}
+
+
+/*
+ * Narrow -- make the focus smaller.
+ */
+
+Visible bool
+narrow(ep)
+       register environ *ep;
+{
+       register node n;
+       register int sym;
+       register int nch;
+       register string repr;
+       
+       higher(ep);
+
+       shrink(ep);
+       n = tree(ep->focus);
+       sym = symbol(n);
+
+       switch (ep->mode) {
+               
+       case ATBEGIN:
+       case ATEND:
+       case VHOLE:
+       case FHOLE:
+               return No;
+       
+       case SUBRANGE:
+               if (ep->s3 > ep->s2)
+                       ep->s3 = ep->s2;
+               else
+                       ep->mode = (ep->s1&1) ? FHOLE : VHOLE;
+               return Yes;
+               
+       case SUBSET:
+               if (ep->s1 <= 2) {
+                       nch = nchildren(n);     
+                       if (ep->s2 >= 2*nch && issublist(symbol(n))) {
+                               if (ep->s1 <= 1) {
+                                       ep->s2 = 2*nch - 1;
+                                       return Yes;
+                               }
+                               repr = noderepr(n)[0];
+                               if (!Fw_positive(repr)) {
+                                       ep->s2 = 2*nch - 1;
+                                       return Yes;
+                               }
+                       }
+               }
+               ep->s2 = ep->s1;
+               return Yes;
+               
+       case SUBLIST:
+               Assert(ep->s3 > 1);
+               ep->s3 = 1;
+               return Yes;
+               
+       case WHOLE:
+               Assert(sym == Hole || sym == Optional);
+               return No;
+               
+       default:
+               Abort();
+               /* NOTREACHED */
+       }
+}
+
+
+Visible bool
+extend(ep)
+       register environ *ep;
+{
+       register node n;
+       register int i;
+       register int len;
+       register int s1save;
+
+       grow(ep);
+       higher(ep);
+       switch (ep->mode) {
+
+       case VHOLE:
+       case FHOLE:
+       case ATBEGIN:
+       case ATEND:
+               return widen(ep);
+
+       case SUBRANGE:
+               len = lenitem(ep);
+               if (ep->s3 < len-1)
+                       ++ep->s3;
+               else if (ep->s2 > 0)
+                       --ep->s2;
+               else {
+                       ep->mode = SUBSET;
+                       ep->s2 = ep->s1;
+                       return extend(ep); /* Recursion! */
+               }
+               return Yes;
+
+       case SUBSET:
+               s1save = ep->s1;
+               ep->s1 = ep->s2;
+               if (nextnnitem(ep)) {
+                       ep->s2 = ep->s1;
+                       ep->s1 = s1save;
+               }
+               else {
+                       ep->s1 = s1save;
+                       prevnnitem(ep) || Abort();
+               }
+               return Yes;
+
+       case WHOLE:
+               return up(&ep->focus);
+
+       case SUBLIST:
+               n = tree(ep->focus);
+               for (i = ep->s3; i > 1; --i)
+                       n = lastchild(n);
+               if (samelevel(symbol(n), symbol(lastchild(n)))) {
+                       ++ep->s3;
+                       return Yes;
+               }
+               ep->mode = WHOLE;
+               if (symbol(lastchild(n)) != Optional)
+                       return Yes;
+               return extend(ep); /* Recursion! */
+
+       default:
+               Abort();
+               /* NOTREACHED */
+       }
+}
+
+
+/*
+ * Right-Narrow -- make the focus smaller, going to the last item of a list.
+ */
+
+Visible bool
+rnarrow(ep)
+       register environ *ep;
+{
+       register node n;
+       register int i;
+       register int sym;
+       
+       higher(ep);
+
+       shrink(ep);
+       n = tree(ep->focus);
+       sym = symbol(n);
+       if (sym == Optional || sym == Hole)
+               return No;
+
+       switch (ep->mode) {
+               
+       case ATBEGIN:
+       case ATEND:
+       case VHOLE:
+       case FHOLE:
+               return No;
+       
+       case SUBRANGE:
+               if (ep->s3 > ep->s2)
+                       ep->s2 = ep->s3;
+               else {
+                       ++ep->s2;
+                       ep->mode = (ep->s1&1) ? FHOLE : VHOLE;
+               }
+               return Yes;
+               
+       case SUBSET:
+               if (issublist(sym) && ep->s2 >= 2*nchildren(n)) {
+                       do {
+                               sym = symbol(n);
+                               s_downrite(ep);
+                               n = tree(ep->focus);
+                       } while (samelevel(sym, symbol(n))
+                               && width(lastchild(n)) != 0);
+                       ep->mode = WHOLE;
+                       return Yes;
+               }
+               ep->s1 = ep->s2;
+               return Yes;
+               
+       case SUBLIST:
+               Assert(ep->s3 > 1);
+               for (i = ep->s3; i > 1; --i)
+                       s_downi(ep, nchildren(tree(ep->focus)));
+               ep->s3 = 1;
+               return Yes;
+               
+       case WHOLE:
+               Assert(sym == Hole || sym == Optional);
+               return No;
+               
+       default:
+               Abort();
+               /* NOTREACHED */
+       }
+}