
<<TIPTableBuilder.mesa>>
<<McGregor, September 10, 1982 10:28 am>>
<<Paxton, July 30, 1982 9:08 am>>
<<Maxwell, January 3, 1983 11:59 am>>
<<Paul Rovner, July 21, 1983 11:09 am>>
<<Russ Atkinson, November 16, 1983 7:44 pm>>
<<(removed use of long names to access *.tip)>>

DIRECTORY
Ascii,
Atom USING [MakeAtom],
BasicTime USING [GMT, Period, earliestGMT],
FS USING [ComponentPositions, Error, ExpandName, FileInfo, StreamOpen],
Intime USING [EventTime],
IO USING [STREAM, Close, Error, GetIndex, int, Put, PutRope, SetLength],
GPM USING [Close, Error, GetChar, GetIndex, Handle, Open],
Interminal USING [KeyName],
Rope USING [Concat, ROPE, FromRefText, Substr],
TIPPrivate,
TIPUser,
TIPTables;

TIPTableBuilder: CEDAR MONITOR

IMPORTS BasicTime, TIPPrivate, FS, GPM, Rope, Atom, IO
EXPORTS TIPPrivate, TIPUser = {
OPEN TIPPrivate, TIPTables, TIPUser;

ROPE: TYPE = Rope.ROPE;
STREAM: TYPE = IO.STREAM;

ReservedWord: REF PACKED ARRAY Symbol OF BOOL _
NEW[PACKED ARRAY Symbol OF BOOL];
fh: GPM.Handle;
filename: ROPE;
errlogfh: STREAM;

fastOption: BOOL;
fastMouseOption: BOOL;
keyOption : KeyOption;

errorText : PUBLIC REF ARRAY [0..nrOfErrors] OF ROPE _
NEW[ARRAY [0..nrOfErrors] OF ROPE];

keyNames: PUBLIC REF ARRAY Interminal.KeyName OF ROPE _
NEW[ARRAY Interminal.KeyName OF ROPE];

<<global scanner variables:>>
thereAreErrors: BOOL;
ch: CHAR;
nextch: CHAR;
havenext: BOOL;
symbol: Symbol;
atom: ATOM;
keyName: Interminal.KeyName;
symPos: INT;
number: CARDINAL;
ident: REF TEXT _ NEW[TEXT[100]];
errcnt: CARDINAL;


printKeyTable,
defaultKeyTable: TIPTable _ NIL;

DefaultTable: PROC [printKeys: BOOL] RETURNS [TIPTable] = TRUSTED {
key: Interminal.KeyName;
enableTerm: keyEnable TIPTerm _ [keyEnable[[Ctrl, up]]];
charTerm: char TIPTerm _ [char[stdChar]];
<<charTerm: char TIPTerm _ [char[qZ.NEW[CHAR]]]; - for the general case ->>
resultTerm: result TIPTerm _ [result[LIST[charTerm.ch]]];

IF printKeys THEN {
IF printKeyTable = NIL THEN {
ctrlUpDefault: TIPChoice _ CONS[enableTerm, CONS[charTerm, LIST[resultTerm]]];
printKeyTable _ NEW[fast TIPTableRec];
printKeyTable.ignore.down _ FALSE;

FOR key IN Interminal.KeyName DO    -- includes CR, TAB and Space!
SELECT key FROM
IN [Five..BackSlash],
IN [Three..RightBracket],
IN [One..One],
IN [TAB..F],
IN [C..Z],
IN [Period..Arrow],
IN [R..M],
IN [Space..Equal]    => WITH printKeyTable SELECT FROM
fast => keyDown[key] _ ctrlUpDefault;
ENDCASE;
ENDCASE;
ENDLOOP;
};
RETURN [printKeyTable];
}
ELSE {
IF defaultKeyTable = NIL THEN {
normalDefault: TIPChoice _ CONS[charTerm, LIST[resultTerm]];
ctrlUpDefault: TIPChoice _ CONS[enableTerm, CONS[charTerm, LIST[resultTerm]]];
defaultKeyTable _ NEW[fast TIPTableRec];
defaultKeyTable.ignore.down _ FALSE;


FOR key IN Interminal.KeyName DO    -- includes CR and Space!
SELECT key FROM
E,
IN [D..V],
K, P,
IN [W..A],
IN [I..L],
F,
IN [C..Z],
IN [R..H],
IN [N..M]    => WITH defaultKeyTable SELECT FROM
fast => keyDown[key] _ normalDefault;
ENDCASE;
IN [Five..Six],
IN [Seven..Seven],
IN [Zero..Zero],
IN [Dash..Dash],
IN [Slash..BackSlash],
IN [Three..Two],
IN [Nine..Nine],
IN [Comma..RightBracket],
IN [One..One],
IN [Period..Arrow],
IN [Eight..Eight],
IN [Space..Equal],
IN [DEL..DEL],
IN [LF..BS],
IN [ESC..TAB]    => WITH printKeyTable SELECT FROM
fast => keyDown[key] _ normalDefault;
ENDCASE;
ENDCASE;
ENDLOOP;
};
RETURN [defaultKeyTable];
};
}; -- DefaultTable


<<*** the scanner: *** >>

EndOfFile: SIGNAL = CODE;

GetChar: PROC = {
GetGPMChar: PROC RETURNS [ch: CHAR] = INLINE {
ch _ GPM.GetChar[fh ! GPM.Error => { IF ec=EndOfStream THEN ch _ 0C; CONTINUE }] };
IF havenext THEN { havenext _ FALSE; ch _ nextch }
ELSE ch _ GetGPMChar[];
IF ch = '- THEN {
IF (nextch _ GetGPMChar[]) = '- THEN { -- scan over comment
DO -- go to CR or double dash
SELECT GetGPMChar[] FROM
Ascii.CR, 0C => EXIT;
'- => SELECT GetGPMChar[] FROM
'-, Ascii.CR => EXIT;
ENDCASE;
ENDCASE;
ENDLOOP; 
ch _ Ascii.SP }
ELSE havenext _ TRUE;
};
};


NCONC: PROC [list1, list2: TIPChoice] RETURNS[TIPChoice] = {
l: TIPChoice _ list1;
IF l = NIL THEN RETURN[list2];
UNTIL l.rest = NIL DO l _ l.rest; ENDLOOP;
l.rest _ list2;
RETURN[list1];
};


InstantiateNewTIPTable: PUBLIC PROC [file: ROPE _ NIL] RETURNS [table: TIPTable _ NIL] = {
comp: ROPE; -- name of the compiled file
tryC: BOOL _ TRUE;
stream: STREAM;
fileCD, compCD: BasicTime.GMT;
option, newKeyOption: KeyOption;
newTable: TIPTable;
file _ FS.ExpandName[file].fullFName;
{-- construct the tipC name from the tip name
cp: FS.ComponentPositions;
[cp: cp] _ FS.ExpandName[file];
IF cp.ver.length # 0
THEN comp _ Rope.Substr[file, cp.base.start, cp.ver.start - cp.base.start]
ELSE comp _ Rope.Substr[file, cp.base.start];
comp _ Rope.Concat[comp,"C"];
};
fileCD _ FS.FileInfo[file ! FS.Error => {tryC _ FALSE; CONTINUE}].created;
IF tryC
THEN compCD _ FS.FileInfo[comp ! FS.Error => {tryC _ FALSE; CONTINUE}].created;
IF tryC
THEN tryC _ BasicTime.Period[from: BasicTime.earliestGMT, to: fileCD] < BasicTime.Period[from: BasicTime.earliestGMT, to: compCD];
IF tryC THEN {
stream _ FS.StreamOpen[comp, $read];
[table, option] _ ReadTIPTable[stream ! BadTable => CONTINUE];
IO.Close[stream] };
IF table # NIL THEN {
IF option # none THEN {
table.link _ DefaultTable[option=printKeys];
table.opaque _ FALSE };
RETURN };
[table, option] _ BuildNewTIPTable[file];
stream _ FS.StreamOpen[comp, $create];
WriteTIPTable[table, option, stream];
IO.Close[stream];
stream _ FS.StreamOpen[comp, $read];
[newTable, newKeyOption] _ ReadTIPTable[stream];
IO.Close[stream];
IF newKeyOption # option THEN ERROR;
EqualTables[table, newTable];
};

BuildNewTIPTable: ENTRY PROC [file: ROPE]
RETURNS [table: TIPTable _ NIL, option: KeyOption] = {

<<Satterthwaite suggested all this crap about the GOTO.>>

ENABLE UNWIND => IF thereAreErrors THEN {
GPM.Close[fh]; TruncateErrorLog[]; IO.Close[errlogfh]};

GetFile: PROC [file: ROPE] RETURNS [fh: STREAM _ NIL] = CHECKED {
file _ FS.ExpandName[file].fullFName;
fh _ FS.StreamOpen[file, $read];
<<FS.Error will percolate up>>
};

errMsg: ROPE;

{    -- fake begin to get around bug where double catch phrase fails

ENABLE {
GPM.Error => {errMsg _ errorMsg; GOTO MacroCleanup};
TIPError => GOTO Cleanup;
};

statement: TIPChoiceSeries;


filename _ file;
fh _ GPM.Open[GetFile[file]];
fh.startCall _ '[;
fh.endCall _ '];
fh.singleQuote _ '; -- 004 octal
fh.startQuote _ '(;
fh.endQuote _ ');
fh.sepArg _ ',;
fh.numArg _ '~;
thereAreErrors _ FALSE;
errcnt _ 0;
havenext _ FALSE;
fastOption _ FALSE;
fastMouseOption _ FALSE;
keyOption _ none;

GetChar; GetSymbol;

IF symbol = OptionSym THEN Options;
option _ keyOption;

IF symbol = Select THEN {
GetSymbol;
IF symbol = Trigger THEN {
GetSymbol;
statement _ TriggerStmt[];
}
ELSE Error[5];
IF symbol # Dot THEN Error[3];
}
ELSE Error[1];

GPM.Close[fh];
IF ~thereAreErrors THEN table _ CreateTable[statement];
IF thereAreErrors THEN ErrorFinish; -- finish the error log and raise signal

EXITS
Cleanup => { ErrorFinish };
MacroCleanup => {
IF ~thereAreErrors THEN OpenErrorLog;
thereAreErrors _ TRUE;
errcnt _ errcnt+1;
IO.PutRope[errlogfh, "Error from macro package\n\n"];
IO.PutRope[errlogfh, errMsg];
ErrorFinish };

};    -- fake block (see above)

}; -- InstantiateNewTIPTable

TruncateErrorLog: PROC = {
ENABLE IO.Error => GOTO Exit;
IO.SetLength[errlogfh, IO.GetIndex[errlogfh]];
EXITS Exit => {};
};

ErrorFinish: PROC = {
TruncateErrorLog[];
IO.Close[errlogfh];
SIGNAL InvalidTable[Rope.Concat[filename," errors on TIP.ERRORS"]];
};

CreateTable: PROC[series: TIPChoiceSeries] RETURNS[table: TIPTable] = TRUSTED {
IF fastOption THEN {
table _ NEW[fast TIPTableRec];
WITH table SELECT FROM fast => 
FOR choiceSeries: TIPChoiceSeries _ series, choiceSeries.rest 
UNTIL choiceSeries = NIL DO
choice: TIPChoice _ choiceSeries.first;
WITH choice.first SELECT FROM
keyTrigger =>
IF keyState.state = up THEN {
ignore.up _ FALSE;
IF keyUp[keyState.key] # NIL THEN DoubleDef[keyState.key];
keyUp[keyState.key] _ choice.rest;
}
ELSE {
ignore.down _ FALSE;
IF keyDown[keyState.key] # NIL THEN DoubleDef[keyState.key];
keyDown[keyState.key] _ choice.rest;
};
mouseTrigger => {
ignore.move _ FALSE;
IF mouse # NIL THEN Error[25];
mouse _ choice.rest
};
timeTrigger => Error[]; -- to be detected earlier !!!
ENDCASE;
ENDLOOP;
ENDCASE;
}
ELSE {
table _ NEW[small TIPTableRec];
WITH table SELECT FROM small => {
FOR choiceSeries: TIPChoiceSeries _ series, choiceSeries.rest
UNTIL choiceSeries = NIL DO
choice: TIPChoice _ choiceSeries.first;
WITH choice.first SELECT FROM
keyTrigger => IF keyState.state = up THEN ignore.up _ FALSE
ELSE ignore.down _ FALSE;
mouseTrigger => ignore.move _ FALSE;
timeTrigger => Error[]; -- to be detected earlier !!!
ENDCASE => ERROR;
ENDLOOP;
all _ series;
};
ENDCASE;
};
IF keyOption # none THEN {
table.link _ DefaultTable[keyOption=printKeys];
table.opaque _ FALSE;
};
IF fastMouseOption THEN table.mouseTicks _ 0;
}; -- CreateTable

Options: PROC = {
GetSymbol;
DO -- until see Semicolon
SELECT symbol FROM
Fast => fastOption _ TRUE;
Small => fastOption _ FALSE;
DefaultKeys => keyOption _ defaultKeys;
PrintKeys => keyOption _ printKeys;
FastMouse => fastMouseOption _ TRUE;
SlowMouse => fastMouseOption _ FALSE;
ENDCASE => Error[18];
GetSymbol;
SELECT symbol FROM
Semicolon => EXIT;
Comma => NULL;
ENDCASE => Error[19];
GetSymbol;
ENDLOOP;
GetSymbol;
}; -- Options

CheckForUniqueSymbol: PROC[symbols: LIST OF ATOM] = {
<<maintain the list symbols used to label the branches of the current statement>>
FOR list: LIST OF ATOM _ symbols, list.rest UNTIL list = NIL DO
IF list.first = atom THEN GOTO notUnique;
REPEAT
notUnique => Error[17];
FINISHED => symbols _ CONS[atom, symbols]; -- !!!
ENDLOOP;
};


TriggerStmt: PROC RETURNS[choiceSeries: TIPChoiceSeries] = {
<<TriggerStmt ::= SELECT TRIGGER FROM TriggerChoiceSeries>>

usedSymbols: LIST OF ATOM _ NIL;

IF symbol = From THEN
GetSymbol
ELSE {
Error[6];
<<skip until choice-begin>>
};
choiceSeries _ TriggerChoiceSeries[];
}; -- TriggerStmt


EnableStmt: PROC RETURNS[choiceSeries: TIPChoiceSeries] = {
<<EnableStmt ::= SELECT ENABLE FROM EnableChoiceSeries>>

usedSymbols: LIST OF ATOM _ NIL;

IF symbol = From THEN
GetSymbol
ELSE {
Error[20];
<<skip until (enable)choice-begin>>
};
choiceSeries _ EnableChoiceSeries[];
}; -- EnableStmt


TriggerChoiceSeries: PROC RETURNS[choiceSeries: TIPChoiceSeries] = {
<<TriggerChoiceSeries ::= TriggerChoice ; TriggerChoiceSeries>>
<<| TriggerChoice ENDCASE FinalChoice>>
<<| ENDCASE FinalChoice>>

choice: TIPChoice;  
IF symbol = Endcase THEN {
GetSymbol;
choiceSeries _ FinalChoice[];
RETURN
};
choice _ TriggerChoice[];
IF symbol = Semicolon THEN {
GetSymbol;
choiceSeries _ CONS[choice, TriggerChoiceSeries[]];
}
ELSE IF symbol = Endcase THEN {
GetSymbol;
choiceSeries _ CONS[choice, FinalChoice[]]; -- may be NIL !?!?
}
ELSE {
Error[2];
<<skip until choice-begin or else>>
};
}; -- TriggerChoiceSeries

EnableChoiceSeries: PROC RETURNS[choiceSeries: TIPChoiceSeries] = {
<<EnableChoiceSeries ::= EnableChoice ; EnableChoiceSeries>>
<<| EnableChoice ENDCASE FinalChoice>>
<<| ENDCASE FinalChoice>>

choice: TIPChoice;
IF symbol = Endcase THEN {
GetSymbol;
choiceSeries _ FinalChoice[];
RETURN
};
choice _ EnableChoice[];
IF symbol = Semicolon THEN {
GetSymbol;
choiceSeries _ CONS[choice, EnableChoiceSeries[]];
}
ELSE IF symbol = Endcase THEN {
GetSymbol;
choiceSeries _ CONS[choice, FinalChoice[]]; -- may be NIL !?!?
}
ELSE {
Error[2];
<<skip until choice-begin or else>>
};
}; -- EnableChoiceSeries


TriggerChoice: PROC RETURNS[triggerChoice: TIPChoice] = {
<<TriggerChoice ::= TriggerTerm Expression>>

term: TIPChoice _ TriggerTerm[];
triggerChoice _ NCONC[term, Expression[]];
}; -- TriggerChoice

EnableChoice: PROC RETURNS[enableChoice: TIPChoice] = {
<<EnableChoice ::= EnableTerm Expression>>

term: TIPChoice _ EnableTerm[];
enableChoice _ NCONC[term, Expression[]];
}; -- EnableChoice


TriggerTerm: PROC RETURNS[triggerTerm: TIPChoice] = {
<<TriggerTerm ::= Key TimeOut | MOUSE TimeOut>>

SELECT symbol FROM
KeyIdent => {
keyTerm: keyTrigger TIPTerm;
keyTerm.keyState _ Key[];
triggerTerm _ LIST[keyTerm];
};
Mouse => {
mouseTerm: mouseTrigger TIPTerm;
triggerTerm _ LIST[mouseTerm];
GetSymbol;
};
ENDCASE => {
Error[8];
<<skip>>
};

IF symbol = Before OR symbol = After THEN
triggerTerm _ CONS[TimeOut[], triggerTerm];
}; -- TriggerTerm

EnableTerm: PROC RETURNS[enableTerm: TIPChoice] = {
<<EnableTerm ::= Keys | PredicateIdent>>

IF symbol = KeyIdent THEN enableTerm _ Keys[]
ELSE IF symbol = Ident THEN {
predTerm: predEnable TIPTerm;
predTerm.predicate _ atom;
enableTerm _ LIST[predTerm]; 
GetSymbol;
}
ELSE {
Error[21]
};
}; -- EnableTerm


Keys: PROC RETURNS[enableTerm: TIPChoice] = TRUSTED {
<<Keys ::= Key | Key "|" Keys>>

first: TIPKeyState _ Key[];

SELECT symbol FROM
VertBar => {
rest: TIPChoice;
GetSymbol;
IF symbol # KeyIdent THEN Error[21];
rest _ Keys[];
WITH x:rest.first SELECT FROM
keyEnable => {
keyTerm: key2Enable TIPTerm;
keyTerm.keyState1 _ first;
keyTerm.keyState2 _ x.keyState;
enableTerm _ LIST[keyTerm];
};
key2Enable => {
keyTerm: keyEnableList TIPTerm;
keyTerm.lst _ LIST[first, x.keyState1, x.keyState2];
enableTerm _ LIST[keyTerm];
};
keyEnableList => {
keyTerm: keyEnableList TIPTerm;
keyTerm.lst _ CONS[first, x.lst];
enableTerm _ LIST[keyTerm];
};
ENDCASE => ERROR;
};
ENDCASE => {
keyTerm: keyEnable TIPTerm;
keyTerm.keyState _ first;
enableTerm _ LIST[keyTerm];
};
}; -- Keys

Key: PROC RETURNS[keySt: TIPKeyState] = {
<<KeyIdent UP | KeyIdent DOWN>>

name: Interminal.KeyName _ keyName;
GetSymbol;
IF symbol = Up OR symbol = Down THEN {
keySt _ [key: name,
state: IF symbol = Up THEN up
ELSE down];
GetSymbol;
}
ELSE Error[12];
}; -- Key

TimeOut: PROC RETURNS[timeoutExpr: timeTrigger TIPTerm] = {
<<TimeOut ::= empty | BEFORE Number | AFTER Number>>

fl: TimeoutFlavor _ IF symbol = Before THEN lt
ELSE gt;
GetSymbol;
IF symbol = Number THEN {
timeoutExpr.flavor _ fl;
timeoutExpr.mSecs _ number;
GetSymbol;
}
ELSE {
Error[10];
<<skip>>
};
}; -- TimeOut


Expression: PROC RETURNS[expression: TIPChoice] = {
<<Expression ::= AND TriggerChoice | WHILE EnableChoice | => Statement>>

SELECT symbol FROM
And => {
GetSymbol;
expression _ TriggerChoice[];
};
While => {
GetSymbol;
expression _ EnableChoice[];
};
RightArrow => {
GetSymbol;
expression _ Statement[];
};
ENDCASE => Error[22];
}; -- Expression

Results: PROC RETURNS[resultList: LIST OF REF ANY,
resultChoice: TIPChoice]   = {
<<Results ::= ResultItem | ResultItem , Results | { ResultItem* }>>

resultItem: REF ANY;
resultExpr: REF TIPTerm;

IF symbol = LeftCurly THEN {
GetSymbol;
[resultList, resultChoice] _ ResultItems[];
RETURN;
};

[resultItem, resultExpr] _ ResultItem[];
SELECT symbol FROM
Comma => {
resultItemList: LIST OF REF ANY;
resultExprList: TIPChoice;
GetSymbol;
[resultItemList, resultExprList] _ Results[];
resultList _ CONS[resultItem, resultItemList];
resultChoice _ IF resultExpr = NIL THEN resultExprList
ELSE CONS[resultExpr^, resultExprList];
};
ENDCASE => {
userResultList: result TIPTerm;
resultList _ LIST[resultItem];
resultChoice _ IF resultExpr = NIL THEN LIST[userResultList]
ELSE CONS[resultExpr^, LIST[userResultList]];
};
}; -- Results

Store: PROC[resultList: LIST OF REF ANY, tree: TIPChoice] = {
<<find all leaves l:[result TIPTermRec] of the tree,>>
<<append the list found there to a copy of resultList, and >>
<<store the resulting list as l.list>>

nestedChoice: TIPChoiceSeries;
FOR choice: TIPChoice _ tree, choice.rest UNTIL choice=NIL DO
TRUSTED {WITH term: choice.first SELECT FROM
nested => 
FOR nestedChoice _ term.statement, nestedChoice.rest UNTIL nestedChoice=NIL DO
Store[resultList, nestedChoice.first];
ENDLOOP;
result => {
IF term.list = NIL THEN
term.list _ resultList
ELSE {
Error[24];
term.list _ resultList; -- !!!
};
};
ENDCASE};
ENDLOOP;
}; -- Store

ResultItems: PROC RETURNS[resultList: LIST OF REF ANY,
resultChoice: TIPChoice]   = {
<<ResultItems ::= ResultItem } | ResultItem ResultItems>>

resultItem: REF ANY;
resultExpr: REF TIPTerm;
[resultItem, resultExpr] _ ResultItem[];
SELECT symbol FROM
RightCurly => {
userResultList: result TIPTerm;
GetSymbol;
resultList _ LIST[resultItem];
resultChoice _ IF resultExpr = NIL THEN LIST[userResultList]
ELSE CONS[resultExpr^, LIST[userResultList]];
};
ENDCASE => {
resultItemList: LIST OF REF ANY;
resultExprList: TIPChoice;
[resultItemList, resultExprList] _ ResultItems[];
resultList _ CONS[resultItem, resultItemList];
resultChoice _ IF resultExpr = NIL THEN resultExprList
ELSE CONS[resultExpr^, resultExprList];
};
};

ResultItem: PROC RETURNS[resultItem: REF ANY,
resultExpr: REF TIPTerm _ NIL] = {
<<ResultItem ::= COORDS | CHAR | TIME | String | Number | ResultIdent>>

SELECT symbol FROM
Char => {
resultExpr _ NEW[char TIPTerm _ [char[resultItem _ stdChar]]];
GetSymbol;
};
Coords => {
resultExpr _ NEW[coords TIPTerm _ [coords[resultItem _ stdCoords]]];
GetSymbol;
};
Time => {
resultExpr _ NEW[time TIPTerm _ [time[resultItem _ stdTime]]];
GetSymbol;
};
KeyIdent,        -- result names might be key names
Ident => {
resultItem _ atom;
GetSymbol;
};
Number => {
resultItem _ NEW[LONG INTEGER];
WITH resultItem SELECT FROM
z: REF LONG INTEGER => z^ _ number;
ENDCASE;
GetSymbol;
};
String => {
resultItem _ NEW[TEXT[ident.length]];
WITH resultItem SELECT FROM
z: REF TEXT => {
FOR i: CARDINAL IN [0..ident.length) DO
z[i] _ ident[i];
ENDLOOP;
z.length _ ident.length;
};
ENDCASE;
GetSymbol;
};
ENDCASE =>
IF ReservedWord[symbol] THEN {
resultItem _ atom;
GetSymbol;
}
ELSE Error[9];
}; -- ResultItem


FinalChoice: PROC RETURNS[finalChoice: TIPChoiceSeries] = {
<<FinalChoice ::= empty | => Statement>>

IF symbol = RightArrow THEN {
GetSymbol;
finalChoice _ LIST[Statement[]];
};
}; -- FinalChoice

Statement: PROC RETURNS[stmt: TIPChoice] = {
<<Statement ::= TriggerStmt | EnableStmt | Results>>

IF symbol = Select THEN {
term: nested TIPTerm;
GetSymbol;
IF symbol = Trigger OR symbol = Enable THEN {
sy: Symbol _ symbol;
GetSymbol;
term.statement _ IF sy = Trigger THEN TriggerStmt[] ELSE EnableStmt[];
stmt _ LIST[term];
}
ELSE {
Error[13];
};
}
ELSE {
userResults: LIST OF REF ANY;
[userResults, stmt] _ Results[];
Store[userResults, stmt];
};
}; -- Statement


<<note that all parameters share the same variable for notification>>
<<users must copy parameter if they want to save value after returning from notify>>

stdChar: PUBLIC REF CHAR _ NEW[CHAR];
stdCoords: PUBLIC TIPScreenCoords _ NEW[TIPScreenCoordsRec];
stdTime: PUBLIC TIPTables.TIPTime _ NEW[Intime.EventTime];

InvalidTable: PUBLIC SIGNAL [errorMsg: ROPE] = CODE;

OpenErrorLog: PROC = {
errlogfh _ FS.StreamOpen["tip.errors", $create];
IO.PutRope[errlogfh, filename];
IO.PutRope[errlogfh, " TIP TABLE error log.\n\n"] };

DoubleDef: PROC[key: Interminal.KeyName] = {
IF ~thereAreErrors THEN OpenErrorLog[];
thereAreErrors _ TRUE;
errcnt _ errcnt+1;
IO.PutRope[errlogfh, keyNames[key]];
IO.PutRope[errlogfh, " entry must not occur more than once in table.\n\n"];
};    

TIPError: ERROR = CODE;
debug: BOOL _ FALSE;

Error: PROC[nr: CARDINAL _ 0] = { OPEN IO;
IF ~thereAreErrors THEN OpenErrorLog;
thereAreErrors _ TRUE;
errcnt _ errcnt+1;
PutRope[errlogfh, errorText[nr]];
PutRope[errlogfh, " at "];
Put[errlogfh, int[symPos]];
PutRope[errlogfh, "\n\n"];
IF debug THEN ERROR ELSE ERROR TIPError };

GetSymbol: PROC = {

GetNumber: PROC = {
symbol _ Number;
number _ 0;
WHILE ch IN ['0..'9] DO
number _ 10*number + ch-'0;
GetChar;
ENDLOOP;
};

TranslateAtom: PROC[name: Interminal.KeyName, sym: Symbol] = INLINE {
symbol _ sym;
keyName _ name
};

GetWord: PROC = {
dummy: Interminal.KeyName = allUp;
i: CARDINAL _ 0;
WHILE ch IN ['0..'9] OR ch IN ['a..'z] OR ch IN ['A..'Z] DO
ident[i] _ ch;
i _ i + 1;
GetChar;
ENDLOOP;
ident.length _ i;

atom _ Atom.MakeAtom[Rope.FromRefText[ident]];
SELECT atom FROM
$OPTIONS    => TranslateAtom[dummy, OptionSym];
$SELECT        => TranslateAtom[dummy, Select];
$TRIGGER    => TranslateAtom[dummy, Trigger];
$ENABLE        => TranslateAtom[dummy, Enable];
$FROM        => TranslateAtom[dummy, From];
$ENDCASE    => TranslateAtom[dummy, Endcase];
$END        => TranslateAtom[dummy, End];
$AND        => TranslateAtom[dummy, And];
$WHILE        => TranslateAtom[dummy, While];
$AFTER        => TranslateAtom[dummy, After];
$BEFORE        => TranslateAtom[dummy, Before];
$Up        => TranslateAtom[dummy, Up];
$Down        => TranslateAtom[dummy, Down];
$Mouse        => TranslateAtom[dummy, Mouse];
$Char        => TranslateAtom[dummy, Char];
$Coords        => TranslateAtom[dummy, Coords];
$TIME        => TranslateAtom[dummy, Time];

$Small        => TranslateAtom[dummy, Small];
$Fast        => TranslateAtom[dummy, Fast];
$FastMouse        => TranslateAtom[dummy, FastMouse];
$SlowMouse        => TranslateAtom[dummy, SlowMouse];
$PrintKeys    => TranslateAtom[dummy, PrintKeys];
$DefaultKeys    => TranslateAtom[dummy, DefaultKeys];
<<$Opaque        => TranslateAtom[dummy, Opaque];>>
$x0        => TranslateAtom[x0, KeyIdent];
$x1        => TranslateAtom[x1, KeyIdent];
$x2        => TranslateAtom[x2, KeyIdent];
$x3        => TranslateAtom[x3, KeyIdent];
$x4        => TranslateAtom[x4, KeyIdent];
$x5        => TranslateAtom[x5, KeyIdent];
$x6        => TranslateAtom[x6, KeyIdent];
$Pen        => TranslateAtom[pen, KeyIdent];
$Keyset1    => TranslateAtom[Keyset1, KeyIdent];
$Keyset2    => TranslateAtom[Keyset2, KeyIdent];
$Keyset3    => TranslateAtom[Keyset3, KeyIdent];
$Keyset4    => TranslateAtom[Keyset4, KeyIdent];
$Keyset5    => TranslateAtom[Keyset5, KeyIdent];
$Red        => TranslateAtom[Red, KeyIdent];
$Blue        => TranslateAtom[Blue, KeyIdent];
$Yellow        => TranslateAtom[Yellow, KeyIdent];
$Five        => TranslateAtom[Five, KeyIdent];
$Four        => TranslateAtom[Four, KeyIdent];
$Six        => TranslateAtom[Six, KeyIdent];
$E        => TranslateAtom[E, KeyIdent];
$Seven        => TranslateAtom[Seven, KeyIdent];
$D        => TranslateAtom[D, KeyIdent];
$U        => TranslateAtom[U, KeyIdent];
$V        => TranslateAtom[V, KeyIdent];
$Zero        => TranslateAtom[Zero, KeyIdent];
$K        => TranslateAtom[K, KeyIdent];
$Dash        => TranslateAtom[Dash, KeyIdent];
$P        => TranslateAtom[P, KeyIdent];
$Slash        => TranslateAtom[Slash, KeyIdent];
$BackSlash    => TranslateAtom[BackSlash, KeyIdent];
$LF        => TranslateAtom[LF, KeyIdent];
$BS        => TranslateAtom[BS, KeyIdent];
$Three        => TranslateAtom[Three, KeyIdent];
$Two        => TranslateAtom[Two, KeyIdent];
$W        => TranslateAtom[W, KeyIdent];
$Q        => TranslateAtom[Q, KeyIdent];
$S        => TranslateAtom[S, KeyIdent];
$A        => TranslateAtom[A, KeyIdent];
$Nine        => TranslateAtom[Nine, KeyIdent];
$I        => TranslateAtom[I, KeyIdent];
$X        => TranslateAtom[X, KeyIdent];
$O        => TranslateAtom[O, KeyIdent];
$L        => TranslateAtom[L, KeyIdent];
$Comma        => TranslateAtom[Comma, KeyIdent];
$Quote        => TranslateAtom[Quote, KeyIdent];
$RightBracket    => TranslateAtom[RightBracket, KeyIdent];
$Spare2        => TranslateAtom[Spare2, KeyIdent];
$BW        => TranslateAtom[BW, KeyIdent];
$One        => TranslateAtom[One, KeyIdent];
$ESC        => TranslateAtom[ESC, KeyIdent];
$TAB        => TranslateAtom[TAB, KeyIdent];
$F        => TranslateAtom[F, KeyIdent];
$Ctrl        => TranslateAtom[Ctrl, KeyIdent];
$C        => TranslateAtom[C, KeyIdent];
$J        => TranslateAtom[J, KeyIdent];
$B        => TranslateAtom[B, KeyIdent];
$Z        => TranslateAtom[Z, KeyIdent];
$LeftShift    => TranslateAtom[LeftShift, KeyIdent];
$Period        => TranslateAtom[Period, KeyIdent];
$SemiColon    => TranslateAtom[SemiColon, KeyIdent];
$Return        => TranslateAtom[Return, KeyIdent];
$Arrow        => TranslateAtom[Arrow, KeyIdent];
$DEL        => TranslateAtom[DEL, KeyIdent];
$FL3        => TranslateAtom[FL3, KeyIdent];
$R        => TranslateAtom[R, KeyIdent];
$T        => TranslateAtom[T, KeyIdent];
$G        => TranslateAtom[G, KeyIdent];
$Y        => TranslateAtom[Y, KeyIdent];
$H        => TranslateAtom[H, KeyIdent];
$Eight        => TranslateAtom[Eight, KeyIdent];
$N        => TranslateAtom[N, KeyIdent];
$M        => TranslateAtom[M, KeyIdent];
$Lock        => TranslateAtom[Lock, KeyIdent];
$Space        => TranslateAtom[Space, KeyIdent];
$LeftBracket    => TranslateAtom[LeftBracket, KeyIdent];
$Equal        => TranslateAtom[Equal, KeyIdent];
$RightShift    => TranslateAtom[RightShift, KeyIdent];
$Spare3        => TranslateAtom[Spare3, KeyIdent];
$FL4        => TranslateAtom[FL4, KeyIdent];
<<$FR5        => TranslateAtom[FR5, KeyIdent];>>
ENDCASE        => TranslateAtom[dummy, Ident];
};

GetString: PROC = {
i: CARDINAL _ 0;
DO  -- process the characters of the string
SELECT ch _ GPM.GetChar[fh] FROM
'" => EXIT;
'\\ => SELECT ch _ GPM.GetChar[fh] FROM
'n, 'N, 'r, 'R => ch _ Ascii.CR;
't, 'T => ch _ Ascii.TAB;
'b, 'B => ch _ Ascii.BS;
'f, 'F => ch _ Ascii.FF;
'l, 'L => ch _ Ascii.LF;
'\\, '', '" => NULL;
IN ['0..'3] => {
d: CARDINAL _ ch-'0;
IF (ch _ GPM.GetChar[fh]) NOT IN ['0..'7] THEN Error[26];
d _ d*8 + ch-'0;
IF (ch _ GPM.GetChar[fh]) NOT IN ['0..'7] THEN Error[26];
d _ d*8 + ch-'0;
ch _ LOOPHOLE[d] };
ENDCASE => Error[26];
ENDCASE;
ident[i] _ ch;
i _ i + 1;
ENDLOOP;
ident.length _ i;
GetChar;
symbol _ String;
};

GetPunctuation: PROC = {
SELECT ch FROM
'; => symbol _ Semicolon;
', => symbol _ Comma;
'> => symbol _ Greater;
'. => symbol _ Dot;
'| => symbol _ VertBar;
'= => {
GetChar; 
IF ch = '> THEN symbol _ RightArrow 
ELSE symbol _ Illegal; 
};
'{ => symbol _ LeftCurly;
'} => symbol _ RightCurly;
ENDCASE => symbol _ Illegal;
GetChar[];
};

<<find next symbol:>>
WHILE ch = Ascii.SP OR ch = Ascii.TAB OR ch = Ascii.CR DO
GetChar[];
ENDLOOP;
symPos _ GPM.GetIndex[fh]-1;

<<classify symbol:>>
SELECT ch FROM
IN ['0..'9] => GetNumber[];
IN ['a..'z], IN ['A..'Z] => GetWord[];
= '"        => GetString[];
ENDCASE     => GetPunctuation[];
};

<<main code:>>

InitBuilder[];

FOR s: Symbol IN Symbol DO ReservedWord[s] _ TRUE; ENDLOOP;
ReservedWord[String] _ FALSE;
ReservedWord[Semicolon] _ FALSE;
ReservedWord[Comma] _ FALSE;
ReservedWord[Greater] _ FALSE;
ReservedWord[Dot] _ FALSE;
ReservedWord[RightArrow] _ FALSE;
ReservedWord[Illegal] _ FALSE;
ReservedWord[LeftCurly] _ FALSE;
ReservedWord[RightCurly] _ FALSE;
ReservedWord[VertBar] _ FALSE;
ReservedWord[Number] _ FALSE;
ReservedWord[KeyIdent] _ FALSE;

}.