aboutsummaryrefslogtreecommitdiffstats
path: root/z05.c
diff options
context:
space:
mode:
Diffstat (limited to 'z05.c')
-rw-r--r--z05.c877
1 files changed, 877 insertions, 0 deletions
diff --git a/z05.c b/z05.c
new file mode 100644
index 0000000..0e346b2
--- /dev/null
+++ b/z05.c
@@ -0,0 +1,877 @@
+/*@z05.c:Read Definitions:ReadFontDef()@**************************************/
+/* */
+/* THE LOUT DOCUMENT FORMATTING SYSTEM (VERSION 3.17) */
+/* COPYRIGHT (C) 1991, 1999 Jeffrey H. Kingston */
+/* */
+/* Jeffrey H. Kingston (jeff@cs.usyd.edu.au) */
+/* Basser Department of Computer Science */
+/* The University of Sydney 2006 */
+/* AUSTRALIA */
+/* */
+/* This program is free software; you can redistribute it and/or modify */
+/* it under the terms of the GNU General Public License as published by */
+/* the Free Software Foundation; either Version 2, or (at your option) */
+/* any later version. */
+/* */
+/* This program is distributed in the hope that it will be useful, */
+/* but WITHOUT ANY WARRANTY; without even the implied warranty of */
+/* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the */
+/* GNU General Public License for more details. */
+/* */
+/* You should have received a copy of the GNU General Public License */
+/* along with this program; if not, write to the Free Software */
+/* Foundation, Inc., 59 Temple Place, Suite 330, Boston MA 02111-1307 USA */
+/* */
+/* FILE: z05.c */
+/* MODULE: Read Definitions */
+/* EXTERNS: ReadPrependDef(), ReadDatabaseDef(), ReadDefinitions() */
+/* */
+/*****************************************************************************/
+#include "externs.h"
+
+
+/*****************************************************************************/
+/* */
+/* is_string(t, str) */
+/* */
+/* If t is a token denoting unquoted word str, return TRUE. */
+/* */
+/*****************************************************************************/
+
+#define is_string(t, str) (type(t) == WORD && StringEqual(string(t), str) )
+
+
+/*****************************************************************************/
+/* */
+/* static ReadFontDef(encl) */
+/* */
+/* Read one font definition and pass it on to the font module. The */
+/* syntax is fontdef <family> <face> { <object> }. */
+/* */
+/*****************************************************************************/
+
+static void ReadFontDef(OBJECT encl)
+{ OBJECT t, family, face, inside;
+
+ SuppressScope();
+
+ /* get family name, allow for multiple tokens */
+ family = LexGetToken();
+ if( !is_word(type(family)) )
+ Error(5, 1, "expected font family name here", WARN, &fpos(family));
+ face = LexGetToken();
+ while( is_word(type(face)) && hspace(face) + vspace(face) == 0 )
+ {
+ family = MakeWordTwo(WORD, string(family), string(face), &fpos(family));
+ face = LexGetToken();
+ }
+
+ /* get face name, allow for multiple tokens */
+ if( !is_word(type(face)) )
+ Error(5, 2, "expected font face name here", WARN, &fpos(face));
+ UnSuppressScope();
+ t = LexGetToken();
+ while( is_word(type(t)) && hspace(t) + vspace(t) == 0 )
+ {
+ face = MakeWordTwo(WORD, string(face), string(t), &fpos(face));
+ t = LexGetToken();
+ }
+
+ if( type(t) != LBR )
+ { Error(5, 3, "expected opening %s of fontdef here", WARN, &fpos(t), KW_LBR);
+ Dispose(t);
+ return;
+ }
+ inside = Parse(&t, encl, FALSE, FALSE);
+ inside = ReplaceWithTidy(inside, FALSE);
+ FontDefine(family, face, inside);
+ return;
+} /* end ReadFontDef */
+
+
+/*****************************************************************************/
+/* */
+/* static ReadLangDef(encl) */
+/* */
+/* Read one language definition and pass it on to the language module. The */
+/* syntax is langdef <name> ... <name> { <object> } */
+/* */
+/*****************************************************************************/
+
+static void ReadLangDef(OBJECT encl)
+{ OBJECT t, names, inside;
+
+ New(names, ACAT);
+ t = LexGetToken();
+ while( is_word(type(t)) )
+ { Link(names, t);
+ t = LexGetToken();
+ }
+ if( type(t) != LBR )
+ { Error(5, 4, "expected opening %s of langdef here", WARN, &fpos(t), KW_LBR);
+ Dispose(t);
+ return;
+ }
+ inside = Parse(&t, encl, FALSE, FALSE);
+ inside = ReplaceWithTidy(inside, FALSE);
+ LanguageDefine(names, inside);
+ return;
+} /* end ReadLangDef */
+
+
+/*@::ReadPrependDef(), ReadDatabaseDef()@*************************************/
+/* */
+/* ReadPrependDef(typ, encl) */
+/* */
+/* Read @Prepend { <filename> } and record its presence. */
+/* */
+/*****************************************************************************/
+
+void ReadPrependDef(unsigned typ, OBJECT encl)
+{ OBJECT t, fname;
+ t = LexGetToken();
+ if( type(t) != LBR )
+ { Error(5, 5, "left brace expected here in %s declaration",
+ WARN, &fpos(t), KW_PREPEND);
+ Dispose(t);
+ return;
+ }
+ fname = Parse(&t, encl, FALSE, FALSE);
+ fname = ReplaceWithTidy(fname, FALSE);
+ if( !is_word(type(fname)) )
+ { Error(5, 6, "name of %s file expected here", WARN, &fpos(fname),KW_PREPEND);
+ DisposeObject(fname);
+ return;
+ }
+ debug0(DFS, D, " calling DefineFile from ReadPrependDef");
+ DefineFile(string(fname), STR_EMPTY, &fpos(fname), PREPEND_FILE,
+ typ == PREPEND ? INCLUDE_PATH : SYSINCLUDE_PATH);
+
+} /* end ReadPrependDef */
+
+
+/*****************************************************************************/
+/* */
+/* ReadDatabaseDef(typ, encl) */
+/* */
+/* Read @Database <symname> ... <symname> { <filename> } and record it. */
+/* */
+/*****************************************************************************/
+
+void ReadDatabaseDef(unsigned typ, OBJECT encl)
+{ OBJECT symbs, t, fname;
+ New(symbs, ACAT);
+ t = LexGetToken();
+ while( type(t)==CLOSURE || (type(t)==WORD && string(t)[0]==CH_SYMSTART) )
+ { if( type(t) == CLOSURE )
+ { Link(symbs, t);
+ }
+ else
+ { Error(5, 7, "unknown or misspelt symbol %s", WARN, &fpos(t), string(t));
+ Dispose(t);
+ }
+ t = LexGetToken();
+ }
+ if( type(t) != LBR )
+ { Error(5, 8, "symbol name or %s expected here (%s declaration)",
+ WARN, &fpos(t), KW_LBR, KW_DATABASE);
+ Dispose(t);
+ return;
+ }
+ if( Down(symbs) == symbs )
+ { Error(5, 9, "symbol names missing in %s declaration",
+ WARN, &fpos(t), KW_DATABASE);
+ }
+ fname = Parse(&t, encl, FALSE, FALSE);
+ fname = ReplaceWithTidy(fname, FALSE);
+ if( !is_word(type(fname)) )
+ { Error(5, 10, "name of %s file expected here", WARN, &fpos(fname),
+ KW_DATABASE);
+ DisposeObject(fname);
+ return;
+ }
+ if( StringEndsWith(string(fname), DATA_SUFFIX) )
+ { Error(5, 47, "%s suffix should be omitted in %s clause", WARN,
+ &fpos(fname), DATA_SUFFIX, KW_DATABASE);
+ DisposeObject(fname);
+ return;
+ }
+ if( Down(symbs) != symbs )
+ (void) DbLoad(fname, typ == DATABASE ? DATABASE_PATH : SYSDATABASE_PATH,
+ TRUE, symbs, InMemoryDbIndexes);
+} /* end ReadDatabaseDef */
+
+
+/*@::ReadTokenList()@*********************************************************/
+/* */
+/* static ReadTokenList(token, res) */
+/* */
+/* Read a list of tokens from input and append them to sym_body(res). */
+/* The list is assumed to begin immediately after token, which is either */
+/* an LBR or a @Begin, and input is to be read up to and including the */
+/* matching RBR or @End @Sym. */
+/* */
+/*****************************************************************************/
+#define NextToken(t, res) \
+ t = LexGetToken(); sym_body(res) = Append(sym_body(res), t, PARENT);
+
+static void ReadTokenList(OBJECT token, OBJECT res)
+{ OBJECT t, xsym, new_par, imps, link, y; int scope_count, i;
+ NextToken(t, res);
+ for(;;) switch(type(t))
+ {
+ case WORD:
+
+ if( string(t)[0] == CH_SYMSTART )
+ Error(5, 11, "symbol %s unknown or misspelt", WARN, &fpos(t),
+ string(t));
+ NextToken(t, res);
+ break;
+
+
+ case QWORD:
+
+ NextToken(t, res);
+ break;
+
+
+ case VCAT:
+ case HCAT:
+ case ACAT:
+ case CROSS:
+ case FORCE_CROSS:
+ case NULL_CLOS:
+ case PAGE_LABEL:
+ case ONE_COL:
+ case ONE_ROW:
+ case WIDE:
+ case HIGH:
+ case HSHIFT:
+ case VSHIFT:
+ case HSCALE:
+ case VSCALE:
+ case HCOVER:
+ case VCOVER:
+ case SCALE:
+ case KERN_SHRINK:
+ case HCONTRACT:
+ case VCONTRACT:
+ case HLIMITED:
+ case VLIMITED:
+ case HEXPAND:
+ case VEXPAND:
+ case START_HVSPAN:
+ case START_HSPAN:
+ case START_VSPAN:
+ case HSPAN:
+ case VSPAN:
+ case PADJUST:
+ case HADJUST:
+ case VADJUST:
+ case ROTATE:
+ case BACKGROUND:
+ case RAW_VERBATIM:
+ case VERBATIM:
+ case CASE:
+ case YIELD:
+ case BACKEND:
+ case XCHAR:
+ case FONT:
+ case SPACE:
+ case YUNIT:
+ case ZUNIT:
+ case BREAK:
+ case UNDERLINE:
+ case COLOUR:
+ case LANGUAGE:
+ case CURR_LANG:
+ case CURR_FAMILY:
+ case CURR_FACE:
+ case COMMON:
+ case RUMP:
+ case MELD:
+ case INSERT:
+ case ONE_OF:
+ case NEXT:
+ case PLUS:
+ case MINUS:
+ case TAGGED:
+ case INCGRAPHIC:
+ case SINCGRAPHIC:
+ case PLAIN_GRAPHIC:
+ case GRAPHIC:
+ case NOT_REVEALED:
+
+ NextToken(t, res);
+ break;
+
+
+ case LUSE:
+ case LVIS:
+ case ENV:
+ case USE:
+ case DATABASE:
+ case SYS_DATABASE:
+ case PREPEND:
+ case SYS_PREPEND:
+ case OPEN:
+
+ Error(5, 12, "symbol %s not allowed in macro", WARN, &fpos(t),
+ SymName(actual(t)));
+ NextToken(t, res);
+ break;
+
+
+ case LBR:
+
+ ReadTokenList(t, res);
+ NextToken(t, res);
+ break;
+
+
+ case UNEXPECTED_EOF:
+
+ Error(5, 13, "unexpected end of input", FATAL, &fpos(t));
+ break;
+
+
+ case BEGIN:
+
+ Error(5, 14, "%s not expected here", WARN, &fpos(t), SymName(actual(t)));
+ NextToken(t, res);
+ break;
+
+
+ case RBR:
+
+ if( type(token) != LBR )
+ Error(5, 15, "unmatched %s in macro", WARN, &fpos(t), KW_RBR);
+ return;
+
+
+ case END:
+
+ if( type(token) != BEGIN )
+ Error(5, 16, "unmatched %s in macro", WARN, &fpos(t), KW_END);
+ else
+ { NextToken(t, res);
+ if( type(t) != CLOSURE )
+ {
+ if( type(t) == WORD && string(t)[0] == CH_SYMSTART )
+ Error(5, 17, "symbol %s unknown or misspelt",
+ WARN, &fpos(t), string(t));
+ else
+ Error(5, 18, "symbol name expected after %s", WARN,&fpos(t),KW_END);
+ }
+ else if( actual(token) != actual(t) )
+ Error(5, 19, "%s %s does not match %s %s", WARN, &fpos(t),
+ SymName(actual(token)), KW_BEGIN, SymName(actual(t)), KW_END);
+ }
+ return;
+
+
+ case CLOSURE:
+
+ xsym = actual(t);
+ PushScope(xsym, TRUE, FALSE);
+ NextToken(t, res);
+ PopScope();
+ if( type(t) == CROSS || type(t) == FORCE_CROSS )
+ { NextToken(t, res);
+ break;
+ }
+
+ /* read named parameters */
+ while( type(t) == CLOSURE && enclosing(actual(t)) == xsym &&
+ type(actual(t)) == NPAR )
+ { new_par = t;
+ NextToken(t, res);
+ if( type(t) != LBR )
+ { if( type(t) == RBR )
+ { if( type(token) != LBR )
+ Error(5, 20, "unmatched %s in macro", WARN, &fpos(t), KW_RBR);
+ return;
+ }
+ Error(5, 21, "%s must follow named parameter %s",
+ WARN, &fpos(new_par), KW_LBR, SymName(actual(new_par)));
+ break;
+ }
+
+ /* add import list of the named parameter to current scope */
+ scope_count = 0;
+ imps = imports(actual(new_par));
+ if( imps != nilobj )
+ { for( link = Down(imps); link != imps; link = NextDown(link) )
+ { Child(y, link);
+ PushScope(actual(y), FALSE, TRUE);
+ scope_count++;
+ }
+ }
+
+ /* read the body of the named parameter */
+ PushScope(actual(new_par), FALSE, FALSE);
+ ReadTokenList(t, res);
+ PopScope();
+
+ /* pop the scopes pushed for the import list */
+ for( i = 0; i < scope_count; i++ )
+ PopScope();
+
+ /* get next token, possibly another named parameter */
+ PushScope(xsym, TRUE, FALSE);
+ NextToken(t, res);
+ PopScope();
+ }
+
+ /* read body parameter, if any */
+ if( has_body(xsym) )
+ {
+ if( type(t) == LBR || type(t) == BEGIN )
+ { PushScope(xsym, FALSE, TRUE);
+ PushScope(ChildSym(xsym, RPAR), FALSE, FALSE);
+ if( type(t) == BEGIN ) actual(t) = xsym;
+ ReadTokenList(t, res);
+ PopScope();
+ PopScope();
+ NextToken(t, res);
+ }
+ else if( type(t) != RBR && type(t) != END )
+ Error(5, 22, "right parameter of %s must begin with %s",
+ WARN, &fpos(t), SymName(xsym), KW_LBR);
+ }
+ break;
+
+
+ default:
+
+ Error(5, 23, "ReadTokenList: %s", INTERN, &fpos(t), Image(type(t)));
+ break;
+
+ }
+} /* end ReadTokenList */
+
+
+/*@::ReadMacro()@*************************************************************/
+/* */
+/* static OBJECT ReadMacro(token, encl) */
+/* */
+/* Read a macro from input and insert into symbol table. */
+/* Token *token contains the "macro" keyword. Input is read up to and */
+/* including the closing right brace, and nilobj returned in *token if OK. */
+/* The proper scope for reading the macro body is open at entry and exit. */
+/* ReadMacro returns the new symbol table entry if successful, else nilobj. */
+/* */
+/*****************************************************************************/
+
+static OBJECT ReadMacro(OBJECT *token, OBJECT curr_encl, OBJECT encl)
+{ OBJECT t, res;
+
+ /* find macro name and insert into symbol table */
+ SuppressScope();
+ Dispose(*token); t = LexGetToken();
+ if( !is_word(type(t)) )
+ { Error(5, 24, "%s ignored (name is missing)", WARN, &fpos(t), KW_MACRO);
+ debug1(ANY, D, "offending type is %s", Image(type(t)));
+ UnSuppressScope();
+ *token = t;
+ return nilobj;
+ }
+ res = InsertSym(string(t), MACRO, &fpos(t), 0, FALSE,TRUE,0,curr_encl,nilobj);
+ if( curr_encl != encl ) visible(res) = TRUE;
+ UnSuppressScope();
+
+ /* find alternative names for this symbol */
+ Dispose(t); t = LexGetToken();
+ while( is_word(type(t)) )
+ {
+ InsertAlternativeName(string(t), res, &fpos(t));
+ Dispose(t); t = LexGetToken();
+ }
+
+ /* find opening left brace */
+ if( type(t) != LBR )
+ { Error(5, 25, "%s ignored (opening %s is missing)",
+ WARN, &fpos(t), KW_MACRO, KW_LBR);
+ *token = t;
+ return nilobj;
+ }
+
+ /* read macro body */
+ ReadTokenList(t, res);
+ Dispose(t);
+
+ /* clean up (kill final RBR, dispose macro name) and exit */
+ t = pred(sym_body(res), PARENT);
+ sym_body(res) = Delete(t, PARENT);
+ Dispose(t);
+ recursive(res) = FALSE;
+ *token = nilobj;
+ return res;
+} /* end ReadMacro */
+
+
+/*@::ReadDefinitions()@*******************************************************/
+/* */
+/* ReadDefinitions(token, encl, res_type) */
+/* */
+/* Read a sequence of definitions and insert them into the symbol table. */
+/* Either a sequence of local definitions (res_type == LOCAL) or named */
+/* parameters (res_type == NPAR) is expected; *token is the first def etc. */
+/* A scope appropriate for reading the bodies of the definitions is open. */
+/* The parent definition is encl. */
+/* */
+/*****************************************************************************/
+
+void ReadDefinitions(OBJECT *token, OBJECT encl, unsigned char res_type)
+{ OBJECT t, res, res_target, export_list, import_list, link, y, z;
+ OBJECT curr_encl; BOOLEAN compulsory_par, has_import_encl;
+ t = *token;
+
+ while( res_type==LOCAL || is_string(t, KW_NAMED) || is_string(t, KW_IMPORT) )
+ {
+ curr_encl = encl;
+ if( is_string(t, KW_FONTDEF) )
+ { ReadFontDef(encl);
+ t = LexGetToken();
+ continue; /* next definition */
+ }
+ else if( is_string(t, KW_LANGDEF) )
+ { ReadLangDef(encl);
+ t = LexGetToken();
+ continue; /* next definition */
+ }
+ else if( type(t) == PREPEND || type(t) == SYS_PREPEND )
+ { ReadPrependDef(type(t), encl);
+ Dispose(t);
+ t = LexGetToken();
+ continue; /* next definition */
+ }
+ else if( type(t) == DATABASE || type(t) == SYS_DATABASE )
+ { ReadDatabaseDef(type(t), encl);
+ Dispose(t);
+ t = LexGetToken();
+ continue; /* next definition */
+ }
+
+ if( !is_string(t, KW_DEF) && !is_string(t, KW_MACRO) &&
+ !is_string(t, KW_NAMED) && !is_string(t, KW_IMPORT) &&
+ !is_string(t, KW_EXTEND) && !is_string(t, KW_EXPORT) )
+ break;
+
+ /* get import or extend list and change scope appropriately */
+ BodyParNotAllowed();
+ New(import_list, ACAT);
+ has_import_encl = FALSE;
+ if( is_string(t, KW_IMPORT) )
+ { Dispose(t);
+ t = LexGetToken();
+ while( type(t) == CLOSURE ||
+ (type(t)==WORD && !is_string(t,KW_EXPORT) && !is_string(t,KW_DEF)
+ && !is_string(t, KW_MACRO) && !is_string(t, KW_NAMED)) )
+ { if( type(t) == CLOSURE )
+ { if( type(actual(t)) == LOCAL )
+ {
+ /* *** letting this through now
+ if( res_type == NPAR && has_par(actual(t)) )
+ {
+ Error(5, 46, "named parameter import %s has parameters",
+ WARN, &fpos(t), SymName(actual(t)));
+ }
+ else
+ {
+ *** */
+ PushScope(actual(t), FALSE, TRUE);
+ if( actual(t) == encl ) has_import_encl = TRUE;
+ Link(import_list, t);
+ /* ***
+ }
+ *** */
+ }
+ else
+ { Error(5, 26, "import name expected here", WARN, &fpos(t));
+ Dispose(t);
+ }
+ }
+ else
+ { Error(5, 27, "import %s not in scope", WARN, &fpos(t), string(t));
+ Dispose(t);
+ }
+ t = LexGetToken();
+ }
+ }
+ else if( is_string(t, KW_EXTEND) )
+ { Dispose(t);
+ t = LexGetToken();
+ while( type(t) == CLOSURE ||
+ (type(t)==WORD && !is_string(t,KW_EXPORT) && !is_string(t,KW_DEF)
+ && !is_string(t, KW_MACRO)) )
+ { if( type(t) == CLOSURE )
+ { if( imports(actual(t)) != nilobj )
+ { Error(5, 48, "%s has %s clause, so cannot be extended",
+ WARN, &fpos(t), SymName(actual(t)), KW_IMPORT);
+ }
+ else if( type(actual(t)) == LOCAL )
+ { PushScope(actual(t), FALSE, FALSE);
+ curr_encl = actual(t);
+ debug1(DRD, D, " curr_encl = %s", SymName(curr_encl));
+ Link(import_list, t);
+ }
+ else
+ { Error(5, 28, "%s symbol name expected here",
+ WARN, &fpos(t), KW_EXTEND);
+ Dispose(t);
+ }
+ }
+ else
+ { Error(5, 29, "extend symbol %s not in scope", WARN,&fpos(t),string(t));
+ Dispose(t);
+ }
+ t = LexGetToken();
+ }
+ }
+
+ /* get export list and store for setting visible flags below */
+ New(export_list, ACAT);
+ if( is_string(t, KW_EXPORT) )
+ { Dispose(t);
+ SuppressScope();
+ t = LexGetToken();
+ while( is_word(type(t)) && !is_string(t, KW_DEF) && !is_string(t, KW_IMPORT)
+ && !is_string(t, KW_MACRO) && !is_string(t, KW_EXTEND) )
+ { Link(export_list, t);
+ t = LexGetToken();
+ }
+ UnSuppressScope();
+ }
+
+
+ if( res_type == LOCAL && !is_string(t, KW_DEF) && !is_string(t, KW_MACRO) )
+ { Error(5, 30, "keyword %s or %s expected here", WARN, &fpos(t),
+ KW_DEF, KW_MACRO);
+ break;
+ }
+ if( res_type == NPAR && !is_string(t, KW_NAMED) )
+ { Error(5, 31, "keyword %s expected here", WARN, &fpos(t), KW_NAMED);
+ break;
+ }
+
+ if( is_string(t, KW_MACRO) )
+ { if( Down(export_list) != export_list )
+ Error(5, 32, "ignoring export list of macro", WARN, &fpos(t));
+ res = ReadMacro(&t, curr_encl, encl);
+ }
+ else
+ {
+ SuppressScope(); Dispose(t); t = LexGetToken();
+
+ /* check for compulsory keyword */
+ if( res_type == NPAR && is_string(t, KW_COMPULSORY) )
+ { compulsory_par = TRUE;
+ Dispose(t); t = LexGetToken();
+ }
+ else compulsory_par = FALSE;
+
+ /* find name of symbol and insert it */
+ if( !is_word(type(t)) )
+ { Error(5, 33, "symbol name expected here", WARN, &fpos(t));
+ debug1(ANY, D, "offending type is %s", Image(type(t)));
+ UnSuppressScope();
+ *token = t;
+ return;
+ }
+ res = InsertSym(string(t), res_type, &fpos(t), DEFAULT_PREC,
+ FALSE, FALSE, 0, curr_encl, nilobj);
+ if( curr_encl != encl ) visible(res) = TRUE;
+ if( has_import_encl )
+ {
+ imports_encl(res) = TRUE;
+ debug1(DCE, D, " setting import_encl(%s) to TRUE", SymName(res));
+ }
+ if( compulsory_par )
+ { has_compulsory(encl)++;
+ is_compulsory(res) = TRUE;
+ }
+ Dispose(t); t = LexGetToken();
+
+ /* find alternative names for this symbol */
+ while( is_word(type(t)) && !is_string(t, KW_NAMED) &&
+ !is_string(t, KW_IMPORT) &&
+ !is_string(t, KW_FORCE) && !is_string(t, KW_INTO) &&
+ !is_string(t, KW_HORIZ) && !is_string(t, KW_PRECEDENCE) &&
+ !is_string(t, KW_ASSOC) && !is_string(t, KW_LEFT) &&
+ !is_string(t, KW_RIGHT) && !is_string(t, KW_BODY) &&
+ !is_string(t, KW_LBR) && !is_string(t, KW_BEGIN) )
+ {
+ InsertAlternativeName(string(t), res, &fpos(t));
+ Dispose(t); t = LexGetToken();
+ }
+
+ /* find force, if any */
+ if( is_string(t, KW_FORCE) )
+ { force_target(res) = TRUE;
+ Dispose(t); t = LexGetToken();
+ if( !is_string(t, KW_INTO) && !is_string(t, KW_HORIZ) )
+ Error(5, 34, "%s expected here", WARN, &fpos(t), KW_INTO);
+ }
+
+ /* find horizontally, if any */
+ if( is_string(t, KW_HORIZ) )
+ { horiz_galley(res) = COLM;
+ Dispose(t); t = LexGetToken();
+ /* *** want to allow KW_HORIZ with @Target form now
+ if( !is_string(t, KW_INTO) )
+ Error(5, 35, "%s expected here", WARN, &fpos(t), KW_INTO);
+ *** */
+ }
+
+ /* find into clause, if any */
+ res_target = nilobj;
+ if( is_string(t, KW_INTO) )
+ { UnSuppressScope();
+ Dispose(t); t = LexGetToken();
+ if( type(t) != LBR )
+ { Error(5, 36, "%s expected here", WARN, &fpos(t), KW_LBR);
+ debug1(ANY, D, "offending type is %s", Image(type(t)));
+ UnSuppressScope();
+ *token = t;
+ return;
+ }
+ res_target = Parse(&t, curr_encl, FALSE, FALSE);
+ SuppressScope();
+ if( t == nilobj ) t = LexGetToken();
+ }
+
+ /* find precedence clause, if any */
+ if( is_string(t, KW_PRECEDENCE) )
+ { int prec = 0;
+ Dispose(t);
+ t = LexGetToken();
+ while( type(t) == WORD && decimaldigit(string(t)[0]) )
+ {
+ prec = prec * 10 + digitchartonum(string(t)[0]);
+ Dispose(t); t = LexGetToken();
+ }
+
+ if( prec < MIN_PREC )
+ { Error(5, 37, "precedence is too low (%d substituted)",
+ WARN, &fpos(t), MIN_PREC);
+ prec = MIN_PREC;
+ }
+ else if( prec > MAX_PREC )
+ { Error(5, 38, "precedence is too high (%d substituted)",
+ WARN, &fpos(t), MAX_PREC);
+ prec = MAX_PREC;
+ }
+ precedence(res) = prec;
+ }
+
+ /* find associativity clause, if any */
+ if( is_string(t, KW_ASSOC) )
+ { Dispose(t); t = LexGetToken();
+ if( is_string(t, KW_LEFT) ) right_assoc(res) = FALSE;
+ else if( !is_string(t, KW_RIGHT) )
+ Error(5, 39, "associativity altered to %s", WARN, &fpos(t), KW_RIGHT);
+ Dispose(t); t = LexGetToken();
+ }
+
+ /* find left parameter, if any */
+ if( is_string(t, KW_LEFT) )
+ { Dispose(t); t = LexGetToken();
+ if( type(t) != WORD )
+ { Error(5, 40, "cannot find %s parameter name", WARN, &fpos(t), KW_LEFT);
+ debug1(ANY, D, "offending type is %s", Image(type(t)));
+ UnSuppressScope();
+ *token = t;
+ return;
+ }
+ InsertSym(string(t), LPAR, &fpos(t), DEFAULT_PREC,
+ FALSE, FALSE, 0, res, nilobj);
+ Dispose(t); t = LexGetToken();
+ }
+
+ /* find named parameters, if any */
+ UnSuppressScope();
+ ReadDefinitions(&t, res, NPAR);
+
+ /* find right or body parameter, if any */
+ if( is_string(t, KW_RIGHT) || is_string(t, KW_BODY) )
+ { has_body(res) = is_string(t, KW_BODY);
+ SuppressScope();
+ Dispose(t); t = LexGetToken();
+ if( type(t) != WORD )
+ { Error(5, 41, "cannot find %s parameter name", WARN,&fpos(t),KW_RIGHT);
+ debug1(ANY, D, "offending type is %s", Image(type(t)));
+ UnSuppressScope();
+ *token = t;
+ return;
+ }
+ InsertSym(string(t), RPAR, &fpos(t), DEFAULT_PREC,
+ FALSE, FALSE, 0, res, nilobj);
+ UnSuppressScope();
+ Dispose(t); t = LexGetToken();
+ }
+
+ /* read local definitions and body */
+ if( res_target != nilobj )
+ InsertSym(KW_TARGET, LOCAL, &fpos(res_target), DEFAULT_PREC,
+ FALSE, FALSE, 0, res, res_target);
+ if( type(t) == WORD && StringEqual(string(t), KW_LBR) )
+ { z = NewToken(LBR, &fpos(t), 0, 0, LBR_PREC, StartSym);
+ Dispose(t);
+ t = z;
+ }
+ else if( type(t) == WORD && StringEqual(string(t), KW_BEGIN) )
+ { z = NewToken(BEGIN, &fpos(t), 0, 0, BEGIN_PREC, StartSym);
+ Dispose(t);
+ t = z;
+ }
+ else if( type(t) != LBR && type(t) != BEGIN )
+ Error(5, 42, "opening left brace or @Begin of %s expected",
+ FATAL, &fpos(t), SymName(res));
+ if( type(t) == BEGIN ) actual(t) = res;
+ PushScope(res, FALSE, FALSE);
+ BodyParAllowed();
+ sym_body(res) = Parse(&t, res, TRUE, FALSE);
+
+ /* set visible flag of the exported symbols */
+ for( link=Down(export_list); link != export_list; link=NextDown(link) )
+ { Child(y, link);
+ z = SearchSym(string(y), StringLength(string(y)));
+ if( z == nilobj || enclosing(z) != res )
+ Error(5, 43, "exported symbol %s is not defined in %s",
+ WARN, &fpos(y), string(y), SymName(res));
+ else if( has_body(res) && type(z) == RPAR )
+ Error(5, 44, "body parameter %s may not be exported",
+ WARN, &fpos(y), string(y));
+ else if( visible(z) )
+ Error(5, 45, "symbol %s exported twice", WARN, &fpos(y), string(y));
+ else visible(z) = TRUE;
+ }
+ DisposeObject(export_list);
+
+ /* pop scope of res */
+ PopScope();
+ }
+
+ /* pop import scopes and store imports in sym tab */
+ for( link=Down(import_list); link != import_list; link=NextDown(link) )
+ {
+ PopScope();
+ }
+ if( Down(import_list) == import_list || curr_encl != encl )
+ { DisposeObject(import_list);
+ import_list = nilobj;
+ }
+ else
+ {
+ imports(res) = import_list;
+ }
+
+ BodyParAllowed();
+ if( t == nilobj ) t = LexGetToken();
+
+ } /* end while */
+
+ *token = t;
+ return;
+} /* end ReadDefinitions */