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;
}.