TIPTableBuilderImpl.mesa
Copyright Ó 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992 by Xerox Corporation. All rights reserved.
Russ Atkinson (RRA) October 16, 1989 4:01:48 pm PDT
Doug Wyatt, January 24, 1987 11:41:25 pm PST
Bill Jackson (bj) February 5, 1988 3:41:52 pm PST
Last tweaked by Mike Spreitzer on February 5, 1988 1:59:43 pm PST
Bier, March 4, 1993 12:41 pm PST
Michael Plass, September 27, 1991 1:57 pm PDT
Willie-s, May 27, 1992 3:10 pm PDT
Christian Jacobi, February 26, 1992 6:22 pm PST
Build internal data structures representing a TIP table. This module is a MONITOR, (with BuildNewTIPTable as the only ENTRY proc) because the scanner state is currently a global variable.
Kenneth A. Pier, August 5, 1992 6:36 pm PDT
DIRECTORY
Ascii, Atom, SimpleFeedback, GPM, IO, PFS, KeyNames, KeyTypes, KeySyms1, KeySymsKB, KeySymsPublish, KeySymsSun, Rope, TIPPrivate, TIPPrivateTypes, TIPFastTables, TIPTables, TIPTypes, TIPUser, Vector2;
TIPTableBuilderImpl: CEDAR MONITOR
IMPORTS Atom, SimpleFeedback, GPM, IO, KeyNames, PFS, Rope, TIPPrivate, TIPFastTables
EXPORTS TIPTypes, TIPUser, TIPPrivate, TIPPrivateTypes = BEGIN
KeyOption: TYPE ~ TIPPrivate.KeyOption;
KeySym: TYPE ~ KeyTypes.KeySym;
LORA: TYPE = LIST OF REF ANY;
ROPE: TYPE = Rope.ROPE;
Symbol: TYPE ~ TIPPrivate.Symbol;
TimeoutFlavor: TYPE ~ TIPTables.TimeoutFlavor;
TIPChoice: TYPE ~ TIPTables.TIPChoice;
TIPChoiceSeries: TYPE ~ TIPTables.TIPChoiceSeries;
TIPKeyState: TYPE ~ TIPTables.TIPKeyState;
TIPScreenCoords: TYPE ~ TIPUser.TIPScreenCoords;
TIPScreenCoordsRec: TYPE ~ TIPUser.TIPScreenCoordsRec;
TIPTable: TYPE ~ TIPTypes.TIPTable;
TIPTableRep: PUBLIC <<TYPTypes>> TYPE ~ TIPPrivateTypes.TIPTableRep;
TIPTerm: TYPE ~ TIPTables.TIPTerm;
TIPTableImplRep: PUBLIC <<TIPPrivateTypes>> TYPE ~ TIPTables.TIPTableImplRep;
CONTROL: KeySym ¬ KeySymsKB.LeftControl;
DELETE: KeySym ¬ KeySymsKB.Delete;
BS: KeySym ¬ KeySymsKB.BS;
COMPLETE: KeySym ¬ KeySymsKB.Complete;
TAB: KeySym ¬ KeySymsKB.TAB;
errorText: PUBLIC REF ARRAY [0..TIPPrivate.nrOfErrors] OF ROPE
¬ NEW[ARRAY [0..TIPPrivate.nrOfErrors] OF ROPE];
GData: TYPE = RECORD [
reservedWord: REF PACKED ARRAY Symbol OF BOOL ¬ NIL,
fh: GPM.Handle ¬ NIL,
filename: ROPE ¬ NIL,
errlogfh: IO.STREAM ¬ NIL,
fastOption: BOOL ¬ FALSE,
fastMouseOption: BOOL ¬ FALSE,
keyOption: KeyOption ¬ none,
global scanner variables:
ch: CHAR ¬ 0C,
nextch: CHAR ¬ 0C,
havenext: BOOL ¬ FALSE,
symbol: Symbol ¬ Illegal,
atom: ATOM ¬ NIL,
keySym: KeySym ¬ [0],
symPos: INT ¬ 0,
number: CARDINAL ¬ 0,
ident: REF TEXT ¬ NIL,
errcnt: CARDINAL ¬ 0,
printKeyTable: TIPTable ¬ NIL,
defaultKeyTable: TIPTable ¬ NIL
];
gData: REF GData ¬ NEW[GData ¬ [
reservedWord: NEW[PACKED ARRAY Symbol OF BOOL], ident: NEW[TEXT[100]]
]];
defaultKeyCount: CARDINAL = 62;
defaultKeys: ARRAY[0..defaultKeyCount) OF KeySym; -- keys used in the default TIP table
InitDefaultKeys: PROC [] = {
OPEN KeySyms1, KeySymsKB;
defaultKeys ¬ [A, B, C, D, E, F, G, H, I, J, K, L, M, N, O, P, Q, R, S, T, U, V, W, X, Y, Z,
Zero, One, Two, Three, Four, Five, Six, Seven, Eight, Nine,
KeySymsPublish.EmDash, Slash, BackSlash, Comma, Quote, Apostrophe, GraveAccent, Tilde, Hyphen, LowLine, RightBracket, Period, SemiColon, Return, LeftArrow, UpArrow, RightArrow, DownArrow, Space, LeftBracket, Equal, DELETE, KeySymsSun.Paste, BS, COMPLETE, TAB];
};
DefaultTable: PUBLIC PROC [printKeys: BOOL] RETURNS [table: TIPTable] = {
SELECT TRUE FROM
printKeys AND gData.printKeyTable # NIL => RETURN [gData.printKeyTable];
NOT printKeys AND gData.defaultKeyTable # NIL => RETURN [gData.defaultKeyTable];
ENDCASE => {
enableTerm: keyEnable TIPTerm ¬ [keyEnable[[CONTROL, up]]];
charTerm: char TIPTerm ¬ [char[stdChar]];
resultTerm: result TIPTerm ¬ [result[LIST[stdChar]]];
normalDefault: TIPChoice ¬ ConsTerm[charTerm, ConsTerm[resultTerm]];
ctrlUpDefault: TIPChoice ¬ ConsTerm[enableTerm, normalDefault];
default: TIPChoice ¬ IF printKeys THEN ctrlUpDefault ELSE normalDefault;
impl: REF fast TIPTableImplRep ¬ NEW[fast TIPTableImplRep];
impl.ignore.down ¬ FALSE;
impl.keyDown ¬ TIPFastTables.CreateFastTable[];
FOR i: NAT IN [0..defaultKeyCount) DO
keySym: KeySym ¬ defaultKeys[i];
TIPFastTables.StoreInFastTable[impl.keyDown, keySym, default];
ENDLOOP;
table ¬ NEW[TIPTableRep ¬ [impl: impl]];
};
Cache the results
IF printKeys THEN gData.printKeyTable ¬ table ELSE gData.defaultKeyTable ¬ table;
}; -- DefaultTable
BuildNewTIPTable: PUBLIC ENTRY PROC [file: ROPE]
RETURNS [table: TIPTable ¬ NIL, option: KeyOption] = {
file is assumed to be a .tip file.
ENABLE
UNWIND => {
IF gData.errcnt # 0 THEN {
GPM.Close[gData.fh];
TruncateErrorLog[];
IO.Close[gData.errlogfh];
};
};
errMsg: ROPE;
BEGIN -- fake begin to get around bug where double catch phrase fails
ENABLE {
GPM.Error => { errMsg ¬ errorMsg; GOTO MacroCleanup };
TIPError => GOTO Cleanup;
};
statement: TIPChoiceSeries;
fileStream: IO.STREAM ¬ NIL;
fileStream ¬ PFS.StreamOpen[PFS.PathFromRope[file], read];
gData.filename ¬ PFS.RopeFromPath[PFS.GetName[PFS.OpenFileFromStream[fileStream]].fullFName];
Set up the general-purpose macro parser.
gData.fh ¬ GPM.Open[fileStream];
gData.fh.startCall ¬ '[;
gData.fh.endCall ¬ '];
gData.fh.singleQuote ¬ '; -- 004 octal
gData.fh.startQuote ¬ '(;
gData.fh.endQuote ¬ ');
gData.fh.sepArg ¬ ',;
gData.fh.numArg ¬ '~;
gData.errcnt ¬ 0;
gData.havenext ¬ FALSE;
gData.fastOption ¬ FALSE;
gData.fastMouseOption ¬ FALSE;
gData.keyOption ¬ none;
GetChar[]; -- prime the pump? (Bier)
GetSymbol[];
IF gData.symbol = OptionSym THEN Options[];
option ¬ gData.keyOption;
Make sure "SELECT TRIGGER" is on the stream
IF gData.symbol = Select
THEN {
GetSymbol[];
IF gData.symbol = Trigger
THEN {
GetSymbol[];
statement ¬ TriggerStmt[];
}
ELSE Error[5];
IF gData.symbol # Dot THEN Error[3];
}
ELSE Error[1];
GPM.Close[gData.fh];
IF gData.errcnt=0
THEN table ¬ CreateTable[statement]
ELSE ErrorFinish[]; -- finish the error log
EXITS
Cleanup => ErrorFinish[];
MacroCleanup => {
IF gData.errcnt=0 THEN OpenErrorLog;
gData.errcnt ¬ gData.errcnt+1;
IO.PutRope[gData.errlogfh, "Error from macro package\n\n"];
IO.PutRope[gData.errlogfh, errMsg];
ErrorFinish[];
};
END; -- fake block (see above)
};
*** The Scanner ***
GetChar: PROC = {
Get a character, ignoring comments. This is implemented so that it is possible to back up over one character. The character is placed in gData.ch.
GetGPMChar: PROC RETURNS [ch: CHAR] = {
ch ¬ GPM.GetChar[gData.fh
! GPM.Error => { IF ec=EndOfStream THEN ch ¬ 0C; CONTINUE }];
};
IF gData.havenext
THEN { gData.havenext ¬ FALSE; gData.ch ¬ gData.nextch }
ELSE gData.ch ¬ GetGPMChar[];
IF gData.ch = '- THEN {
IF (gData.nextch ¬ GetGPMChar[]) = '-
THEN {
scan over comment
DO
go to CR or double dash
SELECT GetGPMChar[] FROM
Ascii.LF, Ascii.CR, 0C => EXIT;
'- => SELECT GetGPMChar[] FROM
'-, Ascii.LF, Ascii.CR => EXIT;
ENDCASE;
ENDCASE;
ENDLOOP;
gData.ch ¬ Ascii.SP
}
ELSE gData.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];
};
ForceDirectory: PROC [name: ROPE, dir: ROPE] RETURNS [ROPE] = {
FileInTermsOfDirectory: PROC [name: ROPE, dir: ROPE] RETURNS [ROPE];
cp: FS.ComponentPositions ← FS.ExpandName[name].cp;
short: ROPE ← Rope.Substr[name, cp.base.start, cp.base.length + 1 + cp.ext.length];
RETURN [FS.ExpandName[short, dir].fullFName];
cp: UFS.ComponentRopes ← UFS.ExpandName[name].cr;
short: ROPE ← Rope.Cat[cp.base, ".", cp.ext];
RETURN [UFS.ExpandName[short, dir].fullUName];
};
TruncateErrorLog: PROC = {
ENABLE { IO.Error => GOTO Exit };
IO.SetLength[gData.errlogfh, IO.GetIndex[gData.errlogfh]];
EXITS
Exit => {};
};
ErrorFinish: PROC = {
fName: ROPE ¬ "???";
msg: ROPE ¬ NIL;
BEGIN ENABLE PFS.Error => CONTINUE;
IF gData.errlogfh # NIL THEN fName ¬ PFS.RopeFromPath[PFS.GetName[PFS.OpenFileFromStream[gData.errlogfh]].fullFName];
END;
msg ¬ Rope.Cat[gData.filename, " errors on ", fName];
TruncateErrorLog[];
IO.Close[gData.errlogfh];
SimpleFeedback.Append[$TIP, oneLiner, $Complaint, msg ];
SIGNAL InvalidTable[msg];
};
ConsTerm: PROC [term: TIPTerm, list: TIPChoice ¬ NIL] RETURNS [TIPChoice] = {
RETURN [CONS[term, list]];
};
ConsAny: PROC [x: REF, list: LORA ¬ NIL] RETURNS [LORA] = {
RETURN [CONS[x, list]];
};
CreateTable: PROC[series: TIPChoiceSeries] RETURNS [table: TIPTable] = TRUSTED {
IF gData.fastOption
THEN {
impl: REF fast TIPTableImplRep ~ NEW[fast TIPTableImplRep];
impl.keyUp ¬ TIPFastTables.CreateFastTable[];
impl.keyDown ¬ TIPFastTables.CreateFastTable[];
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 {
impl.ignore.up ¬ FALSE;
IF TIPFastTables.FetchFromFastTable[impl.keyUp, keyState.keySym] # NIL THEN DoubleDef[keyState.keySym];
TIPFastTables.StoreInFastTable[impl.keyUp, keyState.keySym, choice.rest];
}
ELSE {
impl.ignore.down ¬ FALSE;
IF TIPFastTables.FetchFromFastTable[impl.keyDown, keyState.keySym] # NIL THEN DoubleDef[keyState.keySym];
TIPFastTables.StoreInFastTable[impl.keyDown, keyState.keySym, choice.rest];
};
mouseTrigger => {
impl.ignore.move ¬ FALSE;
IF impl.mouse # NIL THEN Error[25];
impl.mouse ¬ choice.rest
};
timeTrigger => Error[]; -- to be detected earlier !!!
ENDCASE;
ENDLOOP;
table ¬ NEW[TIPTableRep ¬ [impl: impl]];
}
ELSE {
impl: REF small TIPTableImplRep ~ NEW[small TIPTableImplRep];
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 impl.ignore.up ¬ FALSE
ELSE impl.ignore.down ¬ FALSE;
mouseTrigger => impl.ignore.move ¬ FALSE;
trackballTrigger => impl.ignore.move ¬ FALSE;
thumbwheelTrigger => impl.ignore.move ¬ FALSE;
timeTrigger => Error[]; -- to be detected earlier !!!
ENDCASE => ERROR;
ENDLOOP;
impl.all ¬ series;
table ¬ NEW[TIPTableRep ¬ [impl: impl]];
};
IF gData.keyOption # none THEN {
table.link ¬ DefaultTable[gData.keyOption=printKeys];
table.opaque ¬ FALSE;
};
IF gData.fastMouseOption THEN table.mouseTicks ¬ 0;
}; -- CreateTable
Options: PROC = {
GetSymbol;
DO -- until see Semicolon
SELECT gData.symbol FROM
Fast => gData.fastOption ¬ TRUE;
Small => gData.fastOption ¬ FALSE;
DefaultKeys => gData.keyOption ¬ defaultKeys;
PrintKeys => gData.keyOption ¬ printKeys;
FastMouse => gData.fastMouseOption ¬ TRUE;
SlowMouse => gData.fastMouseOption ¬ FALSE;
ENDCASE => Error[18];
GetSymbol;
SELECT gData.symbol FROM
Semicolon => EXIT;
Comma => NULL;
ENDCASE => Error[19];
GetSymbol;
ENDLOOP;
GetSymbol;
}; -- Options
TriggerStmt: PROC RETURNS[choiceSeries: TIPChoiceSeries] = {
TriggerStmt ::= SELECT TRIGGER FROM TriggerChoiceSeries
usedSymbols: LIST OF ATOM ¬ NIL;
IF gData.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 gData.symbol = From
THEN GetSymbol
ELSE {
Error[20];
skip until (enable)choice-begin
};
choiceSeries ¬ EnableChoiceSeries[];
}; -- EnableStmt
TriggerChoiceSeries: PROC RETURNS [choiceSeries: TIPChoiceSeries ¬ NIL] = {
TriggerChoiceSeries ::= TriggerChoice; TriggerChoiceSeries
| TriggerChoice ENDCASE FinalChoice
| ENDCASE FinalChoice
tail: TIPChoiceSeries ¬ NIL;
IF gData.symbol = Endcase THEN RETURN[FinalChoice[]];
DO
choice: TIPChoice = TriggerChoice[];
temp: TIPChoiceSeries = LIST[choice];
IF choiceSeries = NIL THEN choiceSeries ¬ temp ELSE tail.rest ¬ temp;
tail ¬ temp;
IF gData.symbol = Semicolon THEN {
GetSymbol[];
IF gData.symbol # Endcase THEN LOOP;
};
IF gData.symbol = Endcase THEN {
tail.rest ¬ FinalChoice[];
RETURN;
};
skip until choice-begin or else
Error[2];
ENDLOOP;
}; -- TriggerChoiceSeries
EnableChoiceSeries: PROC RETURNS[choiceSeries: TIPChoiceSeries ¬ NIL] = {
EnableChoiceSeries ::= EnableChoice; EnableChoiceSeries
| EnableChoice ENDCASE FinalChoice
| ENDCASE FinalChoice
tail: TIPChoiceSeries ¬ NIL;
IF gData.symbol = Endcase THEN RETURN[FinalChoice[]];
DO
choice: TIPChoice = EnableChoice[];
temp: TIPChoiceSeries ¬ LIST[choice];
IF choiceSeries = NIL THEN choiceSeries ¬ temp ELSE tail.rest ¬ temp;
tail ¬ temp;
IF gData.symbol = Semicolon THEN {
GetSymbol;
IF gData.symbol # Endcase THEN LOOP;
};
IF gData.symbol = Endcase THEN {
tail.rest ¬ FinalChoice[];
RETURN;
};
skip until choice-begin or else
Error[2];
ENDLOOP;
}; -- 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 gData.symbol FROM
KeyIdent => {
keyTerm: keyTrigger TIPTerm;
keyTerm.keyState ¬ Key[];
triggerTerm ¬ LIST[keyTerm];
};
Mouse => {
mouseTerm: mouseTrigger TIPTerm;
triggerTerm ¬ LIST[mouseTerm];
GetSymbol[];
};
Trackball => {
trackballTerm: trackballTrigger TIPTerm;
triggerTerm ¬ LIST[trackballTerm];
GetSymbol[];
};
Thumbwheel => {
thumbwheelTerm: thumbwheelTrigger TIPTerm;
triggerTerm ¬ LIST[thumbwheelTerm];
GetSymbol[];
};
ENDCASE => Error[8]; -- skip
IF gData.symbol = Before OR gData.symbol = After
THEN triggerTerm ¬ ConsTerm[TimeOut[], triggerTerm];
}; -- TriggerTerm
EnableTerm: PROC RETURNS[enableTerm: TIPChoice] = {
EnableTerm ::= Keys | PredicateIdent
IF gData.symbol = KeyIdent
THEN enableTerm ¬ Keys[]
ELSE IF gData.symbol = Ident
THEN {
predTerm: predEnable TIPTerm;
predTerm.predicate ¬ gData.atom;
enableTerm ¬ LIST[predTerm];
GetSymbol;
}
ELSE Error[21];
}; -- EnableTerm
Keys: PROC RETURNS[enableTerm: TIPChoice] = TRUSTED {
Keys ::= Key | Key "|" Keys
first: TIPKeyState ¬ Key[];
SELECT gData.symbol FROM
VertBar => {
rest: TIPChoice;
GetSymbol[];
IF gData.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: KeySym ¬ gData.keySym;
GetSymbol[];
IF gData.symbol = Up OR gData.symbol = Down
THEN {
keySt ¬ [
keySym: name,
state: IF gData.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 gData.symbol = Before THEN lt ELSE gt;
GetSymbol;
IF gData.symbol = Number
THEN {
timeoutExpr.flavor ¬ fl;
timeoutExpr.mSecs ¬ gData.number;
GetSymbol[];
}
ELSE Error[10]; -- skip
}; -- TimeOut
Expression: PROC RETURNS [expression: TIPChoice] = {
Expression ::= AND TriggerChoice | WHILE EnableChoice | => Statement
SELECT gData.symbol FROM
And => { GetSymbol[]; expression ¬ TriggerChoice[]; };
While => { GetSymbol[]; expression ¬ EnableChoice[]; };
RightArrow => { GetSymbol[]; expression ¬ Statement[]; };
ENDCASE => Error[22];
}; -- Expression
Results: PROC RETURNS [resultList: LORA, resultChoice: TIPChoice] = {
Results ::= ResultItem | ResultItem , Results | { ResultItem* }
resultItem: REF;
resultExpr: REF TIPTerm;
IF gData.symbol = LeftCurly THEN {
GetSymbol[];
[resultList, resultChoice] ¬ ResultItems[];
RETURN;
};
[resultItem, resultExpr] ¬ ResultItem[];
SELECT gData.symbol FROM
Comma => {
resultItemList: LORA;
resultExprList: TIPChoice;
GetSymbol[];
[resultItemList, resultExprList] ¬ Results[];
resultList ¬ ConsAny[resultItem, resultItemList];
resultChoice ¬ IF resultExpr = NIL
THEN resultExprList
ELSE ConsTerm[resultExpr­, resultExprList];
};
ENDCASE => {
userResultList: result TIPTerm;
resultList ¬ ConsAny[resultItem];
resultChoice ¬ ConsTerm[userResultList];
IF resultExpr # NIL THEN resultChoice ¬ ConsTerm[resultExpr­, resultChoice];
};
}; -- Results
Store: PROC [resultList: LORA, 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: LORA, resultChoice: TIPChoice] = {
ResultItems ::= ResultItem } | ResultItem ResultItems
resultItem: REF;
resultExpr: REF TIPTerm;
[resultItem, resultExpr] ¬ ResultItem[];
SELECT gData.symbol FROM
RightCurly => {
userResultList: result TIPTerm ¬ [result[list: NIL]];
GetSymbol[];
resultList ¬ LIST[resultItem];
IF resultExpr = NIL
THEN resultChoice ¬ ConsTerm[userResultList]
ELSE {
resultChoice ¬ ConsTerm[resultExpr­, ConsTerm[userResultList]];
};
};
ENDCASE => {
resultItemList: LORA;
resultExprList: TIPChoice;
[resultItemList, resultExprList] ¬ ResultItems[];
resultList ¬ ConsAny[resultItem, resultItemList];
resultChoice ¬ IF resultExpr = NIL
THEN resultExprList
ELSE ConsTerm[resultExpr­, resultExprList];
};
};
ResultItem: PROC RETURNS[resultItem: REF, resultExpr: REF TIPTerm ¬ NIL] = {
ResultItem ::= COORDS | CHAR | TIME | String | Number | ResultIdent
SELECT gData.symbol FROM
Char => {
resultExpr ¬ NEW[char TIPTerm ¬ [char[resultItem ¬ stdChar]]];
GetSymbol[];
};
Coords => {
resultExpr ¬ NEW[coords TIPTerm ¬ [coords[resultItem ¬ stdCoords]]];
GetSymbol[];
};
TrackballChange => {
resultExpr ¬ NEW[trackballChange TIPTerm ¬ [trackballChange[resultItem ¬ stdTrackballChange]]];
GetSymbol[];
};
ThumbwheelChange => {
resultExpr ¬ NEW[thumbwheelChange TIPTerm ¬ [thumbwheelChange[resultItem ¬ stdThumbwheelChange]]];
GetSymbol[];
};
Time => {
resultExpr ¬ NEW[time TIPTerm ¬ [time[resultItem ¬ stdTime]]];
GetSymbol[];
};
KeyIdent, -- result names might be key names
Ident => {
resultItem ¬ gData.atom;
GetSymbol[];
};
Number => {
resultItem ¬ NEW[INT];
WITH resultItem SELECT FROM
z: REF INT => z­ ¬ gData.number;
ENDCASE;
GetSymbol[];
};
String => {
resultItem ¬ NEW[TEXT[gData.ident.length]];
WITH resultItem SELECT FROM
z: REF TEXT => {
FOR i: CARDINAL IN [0..gData.ident.length) DO
z[i] ¬ gData.ident[i];
ENDLOOP;
z.length ¬ gData.ident.length;
};
ENDCASE;
GetSymbol[];
};
ENDCASE =>
IF gData.reservedWord[gData.symbol]
THEN {
resultItem ¬ gData.atom;
GetSymbol[];
}
ELSE Error[9];
}; -- ResultItem
FinalChoice: PROC RETURNS [finalChoice: TIPChoiceSeries] = {
FinalChoice ::= empty | => Statement
GetSymbol[]; -- we always get here with a pending ENDCASE
IF gData.symbol = RightArrow THEN {
GetSymbol[];
finalChoice ¬ LIST[Statement[]];
};
}; -- FinalChoice
Statement: PROC RETURNS[stmt: TIPChoice] = {
Statement ::= TriggerStmt | EnableStmt | Results
IF gData.symbol = Select
THEN {
term: nested TIPTerm;
GetSymbol[];
IF gData.symbol = Trigger OR gData.symbol = Enable
THEN {
sy: Symbol ¬ gData.symbol;
GetSymbol[];
term.statement ¬ IF sy = Trigger THEN TriggerStmt[] ELSE EnableStmt[];
stmt ¬ LIST[term];
}
ELSE Error[13];
}
ELSE {
userResults: LORA;
[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];
stdTrackballChange: PUBLIC REF Vector2.VEC ¬ NEW[Vector2.VEC];
stdThumbwheelChange: PUBLIC REF INTEGER ¬ NEW[INTEGER];
stdTime: PUBLIC TIPTables.TIPTime ¬ NEW[TIPUser.TIPTimeObj];
InvalidTable: PUBLIC SIGNAL [errorMsg: ROPE] = CODE;
OpenErrorLog: PROC = {
errorfile: PFS.PATH ¬ PFS.PathFromRope[Rope.Concat[TIPPrivate.GetTIPFilePrefix[FALSE], "tip.errors"]];
gData.errlogfh ¬ PFS.StreamOpen[errorfile, $create ! PFS.Error => CONTINUE];
IF gData.errlogfh = NIL THEN {
errorfile ¬ PFS.PathFromRope[Rope.Concat[TIPPrivate.GetTIPFilePrefix[TRUE], "tip.errors"]];
gData.errlogfh ¬ PFS.StreamOpen[errorfile, $create]; -- let error escape the second time
};
IO.PutRope[gData.errlogfh, gData.filename];
IO.PutRope[gData.errlogfh, " TIP TABLE error log.\n\n"];
};
DoubleDef: PROC[keySym: KeySym] = {
IF gData.errcnt=0 THEN OpenErrorLog[];
gData.errcnt ¬ gData.errcnt+1;
IO.PutRope[gData.errlogfh, KeyNames.NameFromKeySym[keySym]];
IO.PutRope[gData.errlogfh, " entry must not occur more than once in table.\n\n"];
};
TIPError: ERROR = CODE; -- should never be caught outside of this module
DebugTIP: SIGNAL [msg: Rope.Text] ~ CODE;
Error: PROC[nr: CARDINAL ¬ 0] = {
msg: Rope.Text ¬ Rope.Flatten[Rope.Cat[
errorText[nr],
" at ",
IO.PutFR1["%g", [integer[gData.symPos]]],
"\n\n"
]];
IF gData.errcnt=0 THEN OpenErrorLog;
gData.errcnt ¬ gData.errcnt+1;
IO.PutRope[gData.errlogfh, msg];
ERROR TIPError[];
};
GetSymbol: PROC = {
GetNumber: PROC = {
gData.symbol ¬ Number;
gData.number ¬ 0;
WHILE gData.ch IN ['0..'9] DO
gData.number ¬ 10*gData.number + gData.ch-'0;
GetChar[];
ENDLOOP;
};
GetWord: PROC = {
OPEN KeySyms1, KeySymsKB;
dummy: KeySym = [CARD32.LAST];
keyName: Rope.ROPE;
i: CARDINAL ¬ 0;
WHILE gData.ch IN ['0..'9] OR gData.ch IN ['a..'z] OR gData.ch IN ['A..'Z] DO
gData.ident[i] ¬ gData.ch;
i ¬ i + 1;
GetChar[];
ENDLOOP;
gData.ident.length ¬ i;
keyName ¬ Rope.FromRefText[gData.ident];
gData.atom ¬ Atom.MakeAtom[keyName];
gData.symbol ¬ KeyIdent;
gData.keySym ¬ dummy;
SELECT gData.atom FROM
$OPTIONS => gData.symbol ¬ OptionSym;
$SELECT => gData.symbol ¬ Select;
$TRIGGER => gData.symbol ¬ Trigger;
$ENABLE => gData.symbol ¬ Enable;
$FROM => gData.symbol ¬ From;
$ENDCASE => gData.symbol ¬ Endcase;
$END => gData.symbol ¬ End;
$AND => gData.symbol ¬ And;
$WHILE => gData.symbol ¬ While;
$AFTER => gData.symbol ¬ After;
$BEFORE => gData.symbol ¬ Before;
$Up => gData.symbol ¬ Up;
$Down => gData.symbol ¬ Down;
$Mouse => gData.symbol ¬ Mouse;
$Trackball => gData.symbol ¬ Trackball;
$Thumbwheel => gData.symbol ¬ Thumbwheel;
$Char => gData.symbol ¬ Char;
$Coords => gData.symbol ¬ Coords;
$TrackballChange => gData.symbol ¬ TrackballChange;
$ThumbwheelChange => gData.symbol ¬ ThumbwheelChange;
$TIME => gData.symbol ¬ Time;
$Small => gData.symbol ¬ Small;
$Fast => gData.symbol ¬ Fast;
$FastMouse => gData.symbol ¬ FastMouse;
$SlowMouse => gData.symbol ¬ SlowMouse;
$PrintKeys => gData.symbol ¬ PrintKeys;
$DefaultKeys => gData.symbol ¬ DefaultKeys;
ENDCASE => {
keySym: KeySym ¬ KeyNames.KeySymFromName[keyName];
IF keySym = KeyNames.NoSym THEN gData.symbol ¬ Ident
ELSE gData.keySym ¬ keySym;
};
};
GetString: PROC = {
i: CARDINAL ¬ 0;
DO -- process the characters of the string
SELECT gData.ch ¬ GPM.GetChar[gData.fh] FROM
'" => EXIT;
'\\ => SELECT gData.ch ¬ GPM.GetChar[gData.fh] FROM
'n, 'N, 'r, 'R => gData.ch ¬ Ascii.CR;
't, 'T => gData.ch ¬ Ascii.TAB;
'b, 'B => gData.ch ¬ Ascii.BS;
'f, 'F => gData.ch ¬ Ascii.FF;
'l, 'L => gData.ch ¬ Ascii.LF;
'\\, '', '" => NULL;
IN ['0..'3] => {
d: CARDINAL ¬ gData.ch-'0;
IF (gData.ch ¬ GPM.GetChar[gData.fh]) NOT IN ['0..'7] THEN Error[26];
d ¬ d*8 + gData.ch-'0;
IF (gData.ch ¬ GPM.GetChar[gData.fh]) NOT IN ['0..'7] THEN Error[26];
d ¬ d*8 + gData.ch-'0;
gData.ch ¬ LOOPHOLE[d] };
ENDCASE => Error[26];
ENDCASE;
gData.ident[i] ¬ gData.ch;
i ¬ i + 1;
ENDLOOP;
gData.ident.length ¬ i;
GetChar;
gData.symbol ¬ String;
};
GetPunctuation: PROC = {
SELECT gData.ch FROM
'; => gData.symbol ¬ Semicolon;
', => gData.symbol ¬ Comma;
'> => gData.symbol ¬ Greater;
'. => gData.symbol ¬ Dot;
'| => gData.symbol ¬ VertBar;
'= => {
GetChar;
IF gData.ch = '> THEN gData.symbol ¬ RightArrow
ELSE gData.symbol ¬ Illegal;
};
'{ => gData.symbol ¬ LeftCurly;
'} => gData.symbol ¬ RightCurly;
ENDCASE => gData.symbol ¬ Illegal;
GetChar[];
};
Find next symbol
WHILE gData.ch = Ascii.SP OR gData.ch = Ascii.TAB OR gData.ch = Ascii.CR OR gData.ch = Ascii.LF DO
GetChar[];
ENDLOOP;
gData.symPos ¬ GPM.GetIndex[gData.fh]-1;
classify symbol
SELECT gData.ch FROM
IN ['0..'9] => GetNumber[];
IN ['a..'z], IN ['A..'Z] => GetWord[];
= '" => GetString[];
ENDCASE => GetPunctuation[];
};
InitBuilder: PUBLIC PROC = { -- exported to TIPPrivate
errorText[0] ¬ "Error";
errorText[1] ¬ "OPTIONS or CASE expected";
errorText[2] ¬ "ENDCASE or; expected";
errorText[3] ¬ "'.' expected";
errorText[4] ¬ "Ident expected";
errorText[5] ¬ "TRIGGER expected";
errorText[6] ¬ "OF expected";
errorText[7] ¬ "': expected";
errorText[8] ¬ "KeyIdent or Mouse expected";
errorText[9] ¬ "error in Action";
errorText[10] ¬ "Number expected";
errorText[11] ¬ "'> expected";
errorText[12] ¬ "Up or Down expected";
errorText[13] ¬ "TRIGGER or ENABLED expected";
errorText[14] ¬ "illegal option";
errorText[15] ¬ "enable procedures as CONDITION only";
errorText[16] ¬ "mouse motion as TRIGGER only";
errorText[17] ¬ "label used twice";
errorText[18] ¬ "; expected";
errorText[19] ¬ ", expected";
errorText[20] ¬ "BY expected";
errorText[21] ¬ "Key or Ident expected";
errorText[22] ¬ "AND, WHILE, =>, or : expected";
errorText[23] ¬ "CASE expected";
errorText[24] ¬ "sorry, results only at leaves implemented";
errorText[25] ¬ "Mouse movement entry must not occur more than once in table.";
errorText[26] ¬ "Illegal character following \\ in string";
errorText[27] ¬ "";
errorText[28] ¬ "";
errorText[29] ¬ "";
errorText[30] ¬ "";
};
InitReservedWords: PROC = {
FOR s: Symbol IN Symbol DO gData.reservedWord[s] ¬ TRUE; ENDLOOP;
gData.reservedWord[String] ¬ FALSE;
gData.reservedWord[Semicolon] ¬ FALSE;
gData.reservedWord[Comma] ¬ FALSE;
gData.reservedWord[Greater] ¬ FALSE;
gData.reservedWord[Dot] ¬ FALSE;
gData.reservedWord[RightArrow] ¬ FALSE;
gData.reservedWord[Illegal] ¬ FALSE;
gData.reservedWord[LeftCurly] ¬ FALSE;
gData.reservedWord[RightCurly] ¬ FALSE;
gData.reservedWord[VertBar] ¬ FALSE;
gData.reservedWord[Number] ¬ FALSE;
gData.reservedWord[KeyIdent] ¬ FALSE;
};
InitBuilder[];
InitReservedWords[];
InitDefaultKeys[];
END.