TIPTableBuilder.mesa; Last Edited by McGregor, September 10, 1982 10:28 am
Last Edited by Paxton, July 30, 1982 9:08 am
Last Edited by: Maxwell, January 3, 1983 11:59 am
DIRECTORY
Ascii,
Atom USING [MakeAtom],
CIFS USING [ConnectionErrors, Error, Open, OpenFile, Close, GetFC, read],
Directory USING [GetProperty],
File USING [Capability],
Intime USING [EventTime],
FileIO USING [Open, StreamFromCapability],
IO USING [Handle, Close, Error, GetIndex, int, Put, PutRope, SetLength],
GPM USING [Close, Error, GetChar, GetIndex, Handle, Open],
Interminal USING [KeyName],
PropertyTypes USING [tCreateDate],
Rope USING [Concat, Find, ROPE, FromRefText, Substr],
SafeStorage USING [NewZone],
System USING [GreenwichMeanTime, SecondsSinceEpoch],
TIPPrivate,
TIPUser,
TIPTables;
TIPTableBuilder: CEDAR MONITOR
IMPORTS TIPPrivate, CIFS, Directory, GPM, SafeStorage, System, Rope, Atom, FileIO, IO
EXPORTS TIPPrivate, TIPUser =
BEGIN
OPEN TIPPrivate, TIPTables, TIPUser;
ReservedWord: REF PACKED ARRAY Symbol OF BOOLEAN
NEW[PACKED ARRAY Symbol OF BOOLEAN];
fh: GPM.Handle;
filename: Rope.ROPE;
errlogfh: IO.Handle;
fastOption: BOOLEAN;
fastMouseOption: BOOLEAN;
keyOption : KeyOption;
errorText : PUBLIC REF ARRAY [0..nrOfErrors] OF Rope.ROPE
NEW[ARRAY [0..nrOfErrors] OF Rope.ROPE];
keyNames: PUBLIC REF ARRAY Interminal.KeyName OF Rope.ROPE
NEW[ARRAY Interminal.KeyName OF Rope.ROPE];
qZ: PUBLIC ZONE ← SafeStorage.NewZone[quantized]; -- quantized zone for allocations
global scanner variables:
thereAreErrors: BOOLEAN;
ch : CHARACTER;
nextch : CHARACTER;
havenext : BOOLEAN;
symbol : Symbol;
atom : ATOM;
keyName : Interminal.KeyName;
symPos : INT;
number : CARDINAL;
ident : REF TEXTNEW[TEXT[100]];
errcnt : CARDINAL;
printKeyTable,
defaultKeyTable: TIPTable ← NIL;
DefaultTable: PROC [printKeys: BOOLEAN] RETURNS [TIPTable] = TRUSTED BEGIN
key: Interminal.KeyName;
enableTerm: keyEnable TIPTerm ← [keyEnable[[Ctrl, up]]];
charTerm: char TIPTerm ← [char[stdChar]];
charTerm: char TIPTerm ← [char[qZ.NEW[CHARACTER]]]; - for the general case -
resultTerm: result TIPTerm ← [result[qZ.LIST[charTerm.ch]]];
IF printKeys THEN BEGIN
IF printKeyTable = NIL THEN BEGIN
ctrlUpDefault: TIPChoice ← qZ.CONS[enableTerm, qZ.CONS[charTerm, qZ.LIST[resultTerm]]];
printKeyTable ← qZ.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;
END;
RETURN [printKeyTable];
END
ELSE BEGIN
IF defaultKeyTable = NIL THEN BEGIN
normalDefault: TIPChoice ← qZ.CONS[charTerm, qZ.LIST[resultTerm]];
ctrlUpDefault: TIPChoice ← qZ.CONS[enableTerm, qZ.CONS[charTerm, qZ.LIST[resultTerm]]];
defaultKeyTable ← qZ.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;
END;
RETURN [defaultKeyTable];
END;
END; -- DefaultTable
*** the scanner: ***
EndOfFile: SIGNAL = CODE;
GetChar: PROC = BEGIN
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 BEGIN
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;
END;
END;
NCONC: PROC [list1, list2: TIPChoice] RETURNS[TIPChoice] = BEGIN
l: TIPChoice ← list1;
IF l = NIL THEN RETURN[list2];
UNTIL l.rest = NIL DO l ← l.rest; ENDLOOP;
l.rest ← list2;
RETURN[list1];
END;
InstantiateNewTIPTable: PUBLIC PROC [file: Rope.ROPENIL]
RETURNS [table: TIPTable ← NIL] = {
comp: Rope.ROPE; -- name of the compiled file
compC, fileC: File.Capability;
tryC: BOOLEANTRUE;
stream: IO.Handle;
Lookup: PROC [name: Rope.ROPE] RETURNS [fc: File.Capability] = {
fh: CIFS.OpenFile;
fc ← CIFS.GetFC[fh ← CIFS.Open[name, CIFS.read]];
CIFS.Close[fh] };
GetCreateDate: PROC [fc: File.Capability] RETURNS [date: System.GreenwichMeanTime] =
TRUSTED {
Directory.GetProperty[file: fc, property: PropertyTypes.tCreateDate,
propertyValue: DESCRIPTOR[@date, SIZE[System.GreenwichMeanTime]]] };
fileCD, compCD: System.GreenwichMeanTime;
option, newKeyOption: KeyOption;
newTable: TIPTable;
slash: INT;
comp ← Rope.Concat[file,"C"];
WHILE (slash ← Rope.Find[comp, "/"]) >= 0 DO -- strip off the remote info from front
comp ← Rope.Substr[comp, slash+1]; ENDLOOP;
compC ← Lookup[comp ! CIFS.Error => CHECKED { tryC ← FALSE; CONTINUE } ];
IF tryC THEN fileC ← Lookup[file ! CIFS.Error => CHECKED { tryC ← FALSE; CONTINUE } ];
IF tryC THEN {
fileCD ← GetCreateDate[fileC];
compCD ← GetCreateDate[compC];
tryC ← System.SecondsSinceEpoch[fileCD] < System.SecondsSinceEpoch[compCD] };
IF tryC THEN {
stream ← FileIO.Open[comp,read,oldOnly];
[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 ← FileIO.Open[comp,overwrite];
WriteTIPTable[table, option, stream];
IO.Close[stream];
stream ← FileIO.Open[comp,read,oldOnly];
[newTable, newKeyOption] ← ReadTIPTable[stream];
IO.Close[stream];
IF newKeyOption # option THEN ERROR;
EqualTables[table, newTable] };
BuildNewTIPTable: ENTRY PROC [file: Rope.ROPE]
RETURNS [table: TIPTable ← NIL, option: KeyOption] =
BEGIN
Satterthwaite suggested all this crap about the GOTO.
ENABLE UNWIND => IF thereAreErrors THEN {
GPM.Close[fh]; TruncateErrorLog[]; IO.Close[errlogfh]};
GetFile: PROC [file: Rope.ROPE] RETURNS [fh: CIFS.OpenFile] = CHECKED BEGIN
err: BOOLFALSE;
fh ← CIFS.Open[file, CIFS.read
! CIFS.Error => IF code IN CIFS.ConnectionErrors THEN {err ← TRUE; CONTINUE}];
IF err THEN BEGIN-- maybe the file is also on IVY
tryFile: Rope.ROPE;
strip off the /<Server>/
tryFile ← Rope.Substr[file, 1];
tryFile ← Rope.Substr[tryFile, Rope.Find[tryFile, "/"]];
tryFile ← Rope.Concat["/Ivy", tryFile];
fh ← CIFS.Open[tryFile, CIFS.read]; -- if this fails then give up
END;
END;
errMsg: Rope.ROPE;
BEGIN-- fake begin to get around bug where double catch phrase fails
ENABLE BEGIN
GPM.Error => {errMsg ← errorMsg; GOTO MacroCleanup};
TIPError => GOTO Cleanup;
END;
statement: TIPChoiceSeries;
cifsFH: CIFS.OpenFile;
filename ← file;
cifsFH ← GetFile[file];
fh ← GPM.Open[FileIO.StreamFromCapability[CIFS.GetFC[cifsFH],read]];
CIFS.Close[cifsFH];
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 BEGIN
GetSymbol;
IF symbol = Trigger THEN BEGIN
GetSymbol;
statement ← TriggerStmt[];
END
ELSE Error[5];
IF symbol # Dot THEN Error[3];
END
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 };
END; -- fake block (see above)
END; -- InstantiateNewTIPTable
TruncateErrorLog: PROC = {
{ ENABLE IO.Error => GOTO Exit; IO.SetLength[errlogfh, IO.GetIndex[errlogfh]] }
EXITS Exit => NULL };
ErrorFinish: PROC = { OPEN IO;
TruncateErrorLog[];
Close[errlogfh];
SIGNAL InvalidTable[Rope.Concat[filename," errors on TIP.ERRORS"]] };
CreateTable: PROC[series: TIPChoiceSeries] RETURNS[table: TIPTable] = TRUSTED BEGIN
IF fastOption THEN BEGIN
table ← qZ.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 BEGIN
ignore.up ← FALSE;
IF keyUp[keyState.key] # NIL THEN DoubleDef[keyState.key];
keyUp[keyState.key] ← choice.rest;
END
ELSE BEGIN
ignore.down ← FALSE;
IF keyDown[keyState.key] # NIL THEN DoubleDef[keyState.key];
keyDown[keyState.key] ← choice.rest;
END;
mouseTrigger => BEGIN
ignore.move ← FALSE;
IF mouse # NIL THEN Error[25];
mouse ← choice.rest
END;
timeTrigger => Error[]; -- to be detected earlier !!!
ENDCASE;
ENDLOOP;
ENDCASE;
END
ELSE BEGIN
table ← qZ.NEW[small TIPTableRec];
WITH table SELECT FROM small => BEGIN
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;
END;
ENDCASE;
END;
IF keyOption # none THEN BEGIN
table.link ← DefaultTable[keyOption=printKeys];
table.opaque ← FALSE;
END;
IF fastMouseOption THEN table.mouseTicks ← 0;
END; -- CreateTable
Options: PROC = BEGIN
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;
END; -- Options
CheckForUniqueSymbol: PROC[symbols: LIST OF ATOM] = BEGIN
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 ← qZ.CONS[atom, symbols]; -- !!!
ENDLOOP;
END;
TriggerStmt: PROC RETURNS[choiceSeries: TIPChoiceSeries] = BEGIN
TriggerStmt ::= SELECT TRIGGER FROM TriggerChoiceSeries
usedSymbols: LIST OF ATOMNIL;
IF symbol = From THEN
GetSymbol
ELSE BEGIN
Error[6];
skip until choice-begin
END;
choiceSeries ← TriggerChoiceSeries[];
END; -- TriggerStmt
EnableStmt: PROC RETURNS[choiceSeries: TIPChoiceSeries] = BEGIN
EnableStmt ::= SELECT ENABLE FROM EnableChoiceSeries
usedSymbols: LIST OF ATOMNIL;
IF symbol = From THEN
GetSymbol
ELSE BEGIN
Error[20];
skip until (enable)choice-begin
END;
choiceSeries ← EnableChoiceSeries[];
END; -- EnableStmt
TriggerChoiceSeries: PROC RETURNS[choiceSeries: TIPChoiceSeries] = BEGIN
TriggerChoiceSeries ::= TriggerChoice ; TriggerChoiceSeries
| TriggerChoice ENDCASE FinalChoice
| ENDCASE FinalChoice
choice: TIPChoice;
IF symbol = Endcase THEN BEGIN
GetSymbol;
choiceSeries ← FinalChoice[];
RETURN
END;
choice ← TriggerChoice[];
IF symbol = Semicolon THEN BEGIN
GetSymbol;
choiceSeries ← qZ.CONS[choice, TriggerChoiceSeries[]];
END
ELSE IF symbol = Endcase THEN BEGIN
GetSymbol;
choiceSeries ← qZ.CONS[choice, FinalChoice[]]; -- may be NIL !?!?
END
ELSE BEGIN
Error[2];
skip until choice-begin or else
END;
END; -- TriggerChoiceSeries
EnableChoiceSeries: PROC RETURNS[choiceSeries: TIPChoiceSeries] = BEGIN
EnableChoiceSeries ::= EnableChoice ; EnableChoiceSeries
| EnableChoice ENDCASE FinalChoice
| ENDCASE FinalChoice
choice: TIPChoice;
IF symbol = Endcase THEN BEGIN
GetSymbol;
choiceSeries ← FinalChoice[];
RETURN
END;
choice ← EnableChoice[];
IF symbol = Semicolon THEN BEGIN
GetSymbol;
choiceSeries ← qZ.CONS[choice, EnableChoiceSeries[]];
END
ELSE IF symbol = Endcase THEN BEGIN
GetSymbol;
choiceSeries ← qZ.CONS[choice, FinalChoice[]]; -- may be NIL !?!?
END
ELSE BEGIN
Error[2];
skip until choice-begin or else
END;
END; -- EnableChoiceSeries
TriggerChoice: PROC RETURNS[triggerChoice: TIPChoice] = BEGIN
TriggerChoice ::= TriggerTerm Expression
term: TIPChoice ← TriggerTerm[];
triggerChoice ← NCONC[term, Expression[]];
END; -- TriggerChoice
EnableChoice: PROC RETURNS[enableChoice: TIPChoice] = BEGIN
EnableChoice ::= EnableTerm Expression
term: TIPChoice ← EnableTerm[];
enableChoice ← NCONC[term, Expression[]];
END; -- EnableChoice
TriggerTerm: PROC RETURNS[triggerTerm: TIPChoice] = BEGIN
TriggerTerm ::= Key TimeOut | MOUSE TimeOut
SELECT symbol FROM
KeyIdent => BEGIN
keyTerm: keyTrigger TIPTerm;
keyTerm.keyState ← Key[];
triggerTerm ← qZ.LIST[keyTerm];
END;
Mouse => BEGIN
mouseTerm: mouseTrigger TIPTerm;
triggerTerm ← qZ.LIST[mouseTerm];
GetSymbol;
END;
ENDCASE => BEGIN
Error[8];
skip
END;
IF symbol = Before OR symbol = After THEN
triggerTerm ← qZ.CONS[TimeOut[], triggerTerm];
END; -- TriggerTerm
EnableTerm: PROC RETURNS[enableTerm: TIPChoice] = BEGIN
EnableTerm ::= Keys | PredicateIdent
IF symbol = KeyIdent THEN enableTerm ← Keys[]
ELSE IF symbol = Ident THEN BEGIN
predTerm: predEnable TIPTerm;
predTerm.predicate ← atom;
enableTerm ← qZ.LIST[predTerm];
GetSymbol;
END
ELSE BEGIN
Error[21]
END;
END; -- EnableTerm
Keys: PROC RETURNS[enableTerm: TIPChoice] = TRUSTED BEGIN
Keys ::= Key | Key "|" Keys
first: TIPKeyState ← Key[];
SELECT symbol FROM
VertBar => BEGIN
rest: TIPChoice;
GetSymbol;
IF symbol # KeyIdent THEN Error[21];
rest ← Keys[];
WITH x:rest.first SELECT FROM
keyEnable => BEGIN
keyTerm: key2Enable TIPTerm;
keyTerm.keyState1 ← first;
keyTerm.keyState2 ← x.keyState;
enableTerm ← qZ.LIST[keyTerm];
END;
key2Enable => BEGIN
keyTerm: keyEnableList TIPTerm;
keyTerm.lst ← qZ.LIST[first, x.keyState1, x.keyState2];
enableTerm ← qZ.LIST[keyTerm];
END;
keyEnableList => BEGIN
keyTerm: keyEnableList TIPTerm;
keyTerm.lst ← qZ.CONS[first, x.lst];
enableTerm ← qZ.LIST[keyTerm];
END;
ENDCASE => ERROR;
END;
ENDCASE => BEGIN
keyTerm: keyEnable TIPTerm;
keyTerm.keyState ← first;
enableTerm ← qZ.LIST[keyTerm];
END;
END; -- Keys
Key: PROC RETURNS[keySt: TIPKeyState] = BEGIN
KeyIdent UP | KeyIdent DOWN
name: Interminal.KeyName ← keyName;
GetSymbol;
IF symbol = Up OR symbol = Down THEN BEGIN
keySt ← [key: name,
state: IF symbol = Up THEN up
ELSE down];
GetSymbol;
END
ELSE Error[12];
END; -- Key
TimeOut: PROC RETURNS[timeoutExpr: timeTrigger TIPTerm] = BEGIN
TimeOut ::= empty | BEFORE Number | AFTER Number
fl: TimeoutFlavor ← IF symbol = Before THEN lt
ELSE gt;
GetSymbol;
IF symbol = Number THEN BEGIN
timeoutExpr.flavor ← fl;
timeoutExpr.mSecs ← number;
GetSymbol;
END
ELSE BEGIN
Error[10];
skip
END;
END; -- TimeOut
Expression: PROC RETURNS[expression: TIPChoice] = BEGIN
Expression ::= AND TriggerChoice | WHILE EnableChoice | => Statement
SELECT symbol FROM
And => BEGIN
GetSymbol;
expression ← TriggerChoice[];
END;
While => BEGIN
GetSymbol;
expression ← EnableChoice[];
END;
RightArrow => BEGIN
GetSymbol;
expression ← Statement[];
END;
ENDCASE => Error[22];
END; -- Expression
Results: PROC RETURNS[resultList: LIST OF REF ANY,
resultChoice: TIPChoice] = BEGIN
Results ::= ResultItem | ResultItem , Results | { ResultItem* }
resultItem: REF ANY;
resultExpr: REF TIPTerm;
IF symbol = LeftCurly THEN BEGIN
GetSymbol;
[resultList, resultChoice] ← ResultItems[];
RETURN;
END;
[resultItem, resultExpr] ← ResultItem[];
SELECT symbol FROM
Comma => BEGIN
resultItemList: LIST OF REF ANY;
resultExprList: TIPChoice;
GetSymbol;
[resultItemList, resultExprList] ← Results[];
resultList ← qZ.CONS[resultItem, resultItemList];
resultChoice ← IF resultExpr = NIL THEN resultExprList
ELSE qZ.CONS[resultExpr^, resultExprList];
END;
ENDCASE => BEGIN
userResultList: result TIPTerm;
resultList ← qZ.LIST[resultItem];
resultChoice ← IF resultExpr = NIL THEN qZ.LIST[userResultList]
ELSE qZ.CONS[resultExpr^, qZ.LIST[userResultList]];
END;
END; -- Results
Store: PROC[resultList: LIST OF REF ANY,
tree: TIPChoice] = BEGIN
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 => BEGIN
IF term.list = NIL THEN
term.list ← resultList
ELSE BEGIN
Error[24];
term.list ← resultList; -- !!!
END;
END;
ENDCASE};
ENDLOOP;
END; -- Store
ResultItems: PROC RETURNS[resultList: LIST OF REF ANY,
resultChoice: TIPChoice] = BEGIN
ResultItems ::= ResultItem } | ResultItem ResultItems
resultItem: REF ANY;
resultExpr: REF TIPTerm;
[resultItem, resultExpr] ← ResultItem[];
SELECT symbol FROM
RightCurly => BEGIN
userResultList: result TIPTerm;
GetSymbol;
resultList ← qZ.LIST[resultItem];
resultChoice ← IF resultExpr = NIL THEN qZ.LIST[userResultList]
ELSE qZ.CONS[resultExpr^, qZ.LIST[userResultList]];
END;
ENDCASE => BEGIN
resultItemList: LIST OF REF ANY;
resultExprList: TIPChoice;
[resultItemList, resultExprList] ← ResultItems[];
resultList ← qZ.CONS[resultItem, resultItemList];
resultChoice ← IF resultExpr = NIL THEN resultExprList
ELSE qZ.CONS[resultExpr^, resultExprList];
END;
END;
ResultItem: PROC RETURNS[resultItem: REF ANY,
resultExpr: REF TIPTerm ← NIL] = BEGIN
ResultItem ::= COORDS | CHAR | TIME | String | Number | ResultIdent
SELECT symbol FROM
Char => BEGIN
resultExpr ← qZ.NEW[char TIPTerm ← [char[resultItem ← stdChar]]];
GetSymbol;
END;
Coords => BEGIN
resultExpr ← qZ.NEW[coords TIPTerm ← [coords[resultItem ← stdCoords]]];
GetSymbol;
END;
Time => BEGIN
resultExpr ← qZ.NEW[time TIPTerm ← [time[resultItem ← stdTime]]];
GetSymbol;
END;
KeyIdent,  -- result names might be key names
Ident => BEGIN
resultItem ← atom;
GetSymbol;
END;
Number => BEGIN
resultItem ← qZ.NEW[LONG INTEGER];
WITH resultItem SELECT FROM
z: REF LONG INTEGER => z^ ← number;
ENDCASE;
GetSymbol;
END;
String => BEGIN
resultItem ← NEW[TEXT[ident.length]];
WITH resultItem SELECT FROM
z: REF TEXT => BEGIN
FOR i: CARDINAL IN [0..ident.length) DO
z[i] ← ident[i];
ENDLOOP;
z.length ← ident.length;
END;
ENDCASE;
GetSymbol;
END;
ENDCASE =>
IF ReservedWord[symbol] THEN BEGIN
resultItem ← atom;
GetSymbol;
END
ELSE Error[9];
END; -- ResultItem
FinalChoice: PROC RETURNS[finalChoice: TIPChoiceSeries] = BEGIN
FinalChoice ::= empty | => Statement
IF symbol = RightArrow THEN BEGIN
GetSymbol;
finalChoice ← qZ.LIST[Statement[]];
END;
END; -- FinalChoice
Statement: PROC RETURNS[stmt: TIPChoice] = BEGIN
Statement ::= TriggerStmt | EnableStmt | Results
IF symbol = Select THEN BEGIN
term: nested TIPTerm;
GetSymbol;
IF symbol = Trigger OR symbol = Enable THEN BEGIN
sy: Symbol ← symbol;
GetSymbol;
term.statement ← IF sy = Trigger THEN TriggerStmt[] ELSE EnableStmt[];
stmt ← qZ.LIST[term];
END
ELSE BEGIN
Error[13];
END;
END
ELSE BEGIN
userResults: LIST OF REF ANY;
[userResults, stmt] ← Results[];
Store[userResults, stmt];
END;
END; -- 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 CHARACTER ← qZ.NEW[CHARACTER];
stdCoords: PUBLIC TIPScreenCoords ← qZ.NEW[TIPScreenCoordsRec];
stdTime: PUBLIC TIPTables.TIPTime ← qZ.NEW[Intime.EventTime];
InvalidTable: PUBLIC SIGNAL [errorMsg: Rope.ROPE] = CODE;
OpenErrorLog: PROC = {
errlogfh ← FileIO.Open["tip.errors",overwrite];
IO.PutRope[errlogfh, filename];
IO.PutRope[errlogfh, " TIP TABLE error log.\n\n"] };
DoubleDef: PROC[key: Interminal.KeyName] = BEGIN
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"];
END;
TIPError: ERROR = CODE;
debug: BOOLFALSE;
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 = BEGIN
GetNumber: PROC = BEGIN
symbol ← Number;
number ← 0;
WHILE ch IN ['0..'9] DO
number ← 10*number + ch-'0;
GetChar;
ENDLOOP;
END;
TranslateAtom: PROC[name: Interminal.KeyName, sym: Symbol] = INLINE BEGIN
symbol ← sym;
keyName ← name
END;
GetWord: PROC = BEGIN
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];
END;
GetString: PROC = BEGIN
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;
END;
GetPunctuation: PROC = BEGIN
SELECT ch FROM
'; => symbol ← Semicolon;
', => symbol ← Comma;
'> => symbol ← Greater;
'. => symbol ← Dot;
'| => symbol ← VertBar;
'= => BEGIN
GetChar;
IF ch = '> THEN symbol ← RightArrow
ELSE symbol ← Illegal;
END;
'{ => symbol ← LeftCurly;
'} => symbol ← RightCurly;
ENDCASE => symbol ← Illegal;
GetChar;
END;
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;
END;
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;
END.