TIPTableBuilder.mesa
Copyright © 1984, 1985 by Xerox Corporation. All rights reserved.
Doug Wyatt, April 14, 1985 10:06:17 pm PST
Russ Atkinson (RRA) October 21, 1985 9:44:16 pm PDT
DIRECTORY
Ascii USING [BS, CR, FF, LF, SP, TAB],
Atom USING [MakeAtom],
BasicTime USING [GMT, nullGMT, Update],
DefaultRemoteNames USING [Get],
FS USING [ComponentPositions, Error, ExpandName, FileInfo, nullOpenFile, Open, OpenFile, OpenFileFromStream, SetByteCountAndCreatedTime, StreamFromOpenFile, StreamOpen],
GPM USING [Close, Error, GetChar, GetIndex, Handle, Open],
Intime USING [EventTime],
IO USING [STREAM, Close, Error, GetIndex, int, Put, PutRope, SetLength],
Rope USING [Cat, Concat, FromRefText, ROPE, Substr],
TerminalDefs USING [BW, FL3, FL4, KeyName],
TIPPrivate USING [BadTable, EqualTables, KeyOption, nrOfErrors, ReadTIPTable, Symbol, WriteTIPTable],
TIPTables USING [TimeoutFlavor, TIPChoice, TIPChoiceSeries, TIPKeyState, TIPTableImplRep, TIPTerm, TIPTime],
TIPUser USING [TIPScreenCoords, TIPScreenCoordsRec, TIPTable, TIPTableImplRep, TIPTableRep];
TIPTableBuilder: CEDAR MONITOR
IMPORTS Atom, BasicTime, DefaultRemoteNames, FS, GPM, IO, Rope, TIPPrivate
EXPORTS TIPPrivate, TIPUser
= BEGIN OPEN TIPUser, TIPPrivate, TIPTables;
TIPTableImplRep: PUBLIC TYPE ~ TIPTables.TIPTableImplRep;
KeyName: TYPE ~ TerminalDefs.KeyName;
ROPE: TYPE = Rope.ROPE;
STREAM: TYPE = IO.STREAM;
LORA: TYPE = LIST OF REF ANY;
errorText: PUBLIC REF ARRAY [0..nrOfErrors] OF ROPE ←
NEW[ARRAY [0..nrOfErrors] OF ROPE];
keyNames: PUBLIC REF ARRAY KeyName OF ROPE ←
NEW[ARRAY KeyName OF ROPE];
GData: TYPE = RECORD [
ReservedWord: REF PACKED ARRAY Symbol OF BOOL ← NIL,
fh: GPM.Handle ← NIL,
filename: ROPE ← NIL,
errlogfh: 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,
keyName: KeyName ← x0,
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]]
]];
DefaultTable: PROC [printKeys: BOOL] RETURNS [table: TIPTable] = TRUSTED {
SELECT TRUE FROM
printKeys AND gData.printKeyTable # NIL => RETURN [gData.printKeyTable];
NOT printKeys AND gData.defaultKeyTable # NIL => RETURN [gData.defaultKeyTable];
ENDCASE => {
key: KeyName;
enableTerm: keyEnable TIPTerm ← [keyEnable[[Ctrl, up]]];
charTerm: char TIPTerm ← [char[stdChar]];
resultTerm: result TIPTerm ← [result[LIST[charTerm.ch]]];
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;
FOR key IN KeyName DO -- includes CR and Space!
SELECT key FROM
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, Dash, Slash, BackSlash, Comma, Quote, RightBracket, Period, SemiColon, Return, Arrow, Space, LeftBracket, Equal, DEL, LF, BS, ESC, TAB =>
impl.keyDown[key] ← default;
ENDCASE;
ENDLOOP;
IF printKeys THEN impl.keyDown[TAB] ← ctrlUpDefault; -- Also include TAB
table ← NEW[TIPTableRep ← [impl: impl]];
};
IF printKeys THEN gData.printKeyTable ← table ELSE gData.defaultKeyTable ← table;
RETURN[table];
}; -- DefaultTable
*** the scanner: ***
GetChar: PROC = {
GetGPMChar: PROC RETURNS [ch: CHAR] = INLINE {
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.CR, 0C => EXIT;
'- => SELECT GetGPMChar[] FROM
'-, 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] = {
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];
};
TrySeveralDirectories: PROC [name: ROPE] RETURNS [fullName: ROPE, date: BasicTime.GMT] = {
date ← BasicTime.nullGMT;
fullName ← name;
[created: date, fullFName: fullName] ← FS.FileInfo[name: name, remoteCheck: FALSE
! FS.Error => CONTINUE];
IF date # BasicTime.nullGMT THEN RETURN;
name ← ForceDirectory[name, "///"];
[created: date, fullFName: fullName] ← FS.FileInfo[name: name, remoteCheck: FALSE
! FS.Error => CONTINUE];
IF date # BasicTime.nullGMT THEN RETURN;
name ← ForceDirectory[name, Rope.Concat[DefaultRemoteNames.Get[].current, "Tip>"]];
[created: date, fullFName: fullName] ← FS.FileInfo[name: name, remoteCheck: FALSE
! FS.Error => CONTINUE];
};
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 ← BasicTime.nullGMT;
option, newKeyOption: KeyOption;
newTable: TIPTable;
cp: FS.ComponentPositions;
file ← FS.ExpandName[file].fullFName;
construct the tipC name from the tip name
[cp: cp] ← FS.ExpandName[file];
comp ← Rope.Cat["///TipC/", Rope.Substr[file, cp.base.start, cp.base.length], ".tipC"];
{
Try to open and read the compiled (tipC) version of the tip file. The tipC file is always stored on the ///TipC/ directory to avoid multiple copies. The create date of the tipC file is one second later than the create date of the tip file so we can determine correspondence between the two.
fullComp: ROPE ← comp;
[file, fileCD] ← TrySeveralDirectories[file];
IF fileCD = BasicTime.nullGMT THEN GO TO noComp;
fileCD ← BasicTime.Update[fileCD, 1];
[created: compCD, fullFName: fullComp]
← FS.FileInfo[name: comp, wantedCreatedTime: fileCD, remoteCheck: FALSE
! FS.Error => GO TO noComp];
stream ← FS.StreamOpen[fullComp, $read ! FS.Error => GO TO noComp];
[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 };
EXITS noComp => {}};
At this point there is no tipC file, so we will have to make one. We start from the tip file, and any FS.Error will propagate from here.
[table, option] ← BuildNewTIPTable[file];
stream ← FS.StreamOpen[comp, $create];
FS.SetByteCountAndCreatedTime[file: FS.OpenFileFromStream[stream], created: fileCD];
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] = {
ENABLE UNWIND => IF gData.errcnt#0 THEN {
GPM.Close[gData.fh]; TruncateErrorLog[]; IO.Close[gData.errlogfh]};
GetFile: PROC [file: ROPE] RETURNS [fh: STREAM ← NIL] = CHECKED {
FS.Error will percolate up
openFile: FS.OpenFile ← FS.nullOpenFile;
file ← FS.ExpandName[file].fullFName;
openFile ← FS.Open[name: file, remoteCheck: FALSE];
fh ← FS.StreamFromOpenFile[openFile];
};
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;
gData.filename ← file;
gData.fh ← GPM.Open[GetFile[file]];
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; GetSymbol;
IF gData.symbol = OptionSym THEN Options;
option ← gData.keyOption;
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 and raise signal
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;
};
}; -- fake block (see above)
}; -- InstantiateNewTIPTable
TruncateErrorLog: PROC = {
ENABLE IO.Error => GOTO Exit;
IO.SetLength[gData.errlogfh, IO.GetIndex[gData.errlogfh]];
EXITS Exit => {};
};
ErrorFinish: PROC = {
TruncateErrorLog[];
IO.Close[gData.errlogfh];
SIGNAL InvalidTable[Rope.Concat[gData.filename," errors on TIP.ERRORS"]];
};
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];
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 impl.keyUp[keyState.key] # NIL THEN DoubleDef[keyState.key];
impl.keyUp[keyState.key] ← choice.rest;
}
ELSE {
impl.ignore.down ← FALSE;
IF impl.keyDown[keyState.key] # NIL THEN DoubleDef[keyState.key];
impl.keyDown[keyState.key] ← 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;
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;
};
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 ← ConsTerm[keyTerm];
};
keyEnableList => {
keyTerm: keyEnableList TIPTerm;
keyTerm.lst ← CONS[first, x.lst];
enableTerm ← ConsTerm[keyTerm];
};
ENDCASE => ERROR;
};
ENDCASE => {
keyTerm: keyEnable TIPTerm;
keyTerm.keyState ← first;
enableTerm ← ConsTerm[keyTerm];
};
}; -- Keys
Key: PROC RETURNS[keySt: TIPKeyState] = {
KeyIdent UP | KeyIdent DOWN
name: KeyName ← gData.keyName;
GetSymbol;
IF gData.symbol = Up OR gData.symbol = Down THEN {
keySt ← [key: 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;
GetSymbol;
resultList ← LIST[resultItem];
resultChoice ← IF resultExpr = NIL
THEN ConsTerm[userResultList]
ELSE 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;
};
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];
stdTime: PUBLIC TIPTables.TIPTime ← NEW[Intime.EventTime];
InvalidTable: PUBLIC SIGNAL [errorMsg: ROPE] = CODE;
OpenErrorLog: PROC = {
gData.errlogfh ← FS.StreamOpen["tip.errors", $create];
IO.PutRope[gData.errlogfh, gData.filename];
IO.PutRope[gData.errlogfh, " TIP TABLE error log.\n\n"];
};
DoubleDef: PROC[key: KeyName] = {
IF gData.errcnt=0 THEN OpenErrorLog[];
gData.errcnt ← gData.errcnt+1;
IO.PutRope[gData.errlogfh, keyNames[key]];
IO.PutRope[gData.errlogfh, " entry must not occur more than once in table.\n\n"];
};
TIPError: ERROR = CODE;
Error: PROC[nr: CARDINAL ← 0] = { OPEN IO;
IF gData.errcnt=0 THEN OpenErrorLog;
gData.errcnt ← gData.errcnt+1;
PutRope[gData.errlogfh, errorText[nr]];
PutRope[gData.errlogfh, " at "];
Put[gData.errlogfh, int[gData.symPos]];
PutRope[gData.errlogfh, "\n\n"];
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 = {
dummy: KeyName = KeyName.LAST;
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;
gData.atom ← Atom.MakeAtom[Rope.FromRefText[gData.ident]];
gData.symbol ← KeyIdent;
gData.keyName ← 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;
$Char => gData.symbol ← Char;
$Coords => gData.symbol ← Coords;
$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;
$x0 => gData.keyName ← x0;
$x1 => gData.keyName ← x1;
$x2 => gData.keyName ← x2;
$x3 => gData.keyName ← x3;
$x4 => gData.keyName ← x4;
$x5 => gData.keyName ← x5;
$x6 => gData.keyName ← x6;
$Pen => gData.keyName ← Pen;
$Keyset1 => gData.keyName ← Keyset1;
$Keyset2 => gData.keyName ← Keyset2;
$Keyset3 => gData.keyName ← Keyset3;
$Keyset4 => gData.keyName ← Keyset4;
$Keyset5 => gData.keyName ← Keyset5;
$Red => gData.keyName ← Red;
$Blue => gData.keyName ← Blue;
$Yellow => gData.keyName ← Yellow;
$Five => gData.keyName ← Five;
$Four => gData.keyName ← Four;
$Six => gData.keyName ← Six;
$E => gData.keyName ← E;
$Seven => gData.keyName ← Seven;
$D => gData.keyName ← D;
$U => gData.keyName ← U;
$V => gData.keyName ← V;
$Zero => gData.keyName ← Zero;
$K => gData.keyName ← K;
$Dash => gData.keyName ← Dash;
$P => gData.keyName ← P;
$Slash => gData.keyName ← Slash;
$BackSlash => gData.keyName ← BackSlash;
$Defaults => gData.keyName ← BackSlash; -- synonym
$LF => gData.keyName ← LF;
$Copy => gData.keyName ← LF; -- synonym
$BS => gData.keyName ← BS;
$Three => gData.keyName ← Three;
$Two => gData.keyName ← Two;
$W => gData.keyName ← W;
$Q => gData.keyName ← Q;
$S => gData.keyName ← S;
$A => gData.keyName ← A;
$Nine => gData.keyName ← Nine;
$I => gData.keyName ← I;
$X => gData.keyName ← X;
$O => gData.keyName ← O;
$L => gData.keyName ← L;
$Comma => gData.keyName ← Comma;
$Quote => gData.keyName ← Quote;
$RightBracket => gData.keyName ← RightBracket;
$Spare2 => gData.keyName ← Spare2;
$Keyboard => gData.keyName ← Spare2; -- synonym (DLion)
$Next => gData.keyName ← Spare2; -- synonym
$Spare1 => gData.keyName ← Spare1;
$BW => gData.keyName ← Spare1; -- synonym
$Undo => gData.keyName ← Spare1; -- synonym (DLion)
$Look => gData.keyName ← Spare1; -- synonym
$One => gData.keyName ← One;
$ESC => gData.keyName ← ESC;
$Center => gData.keyName ← ESC; -- synonym (DLion)
$TAB => gData.keyName ← TAB;
$F => gData.keyName ← F;
$Ctrl => gData.keyName ← Ctrl;
$Open => gData.keyName ← Ctrl; -- synonym (DLion)
$C => gData.keyName ← C;
$J => gData.keyName ← J;
$B => gData.keyName ← B;
$Z => gData.keyName ← Z;
$LeftShift => gData.keyName ← LeftShift;
$Period => gData.keyName ← Period;
$SemiColon => gData.keyName ← SemiColon;
$Return => gData.keyName ← Return;
$Arrow => gData.keyName ← Arrow;
$DEL => gData.keyName ← DEL;
$Move => gData.keyName ← Move;
$FL3 => gData.keyName ← Move; -- synonym
$R => gData.keyName ← R;
$T => gData.keyName ← T;
$G => gData.keyName ← G;
$Y => gData.keyName ← Y;
$H => gData.keyName ← H;
$Eight => gData.keyName ← Eight;
$N => gData.keyName ← N;
$M => gData.keyName ← M;
$Lock => gData.keyName ← Lock;
$Space => gData.keyName ← Space;
$LeftBracket => gData.keyName ← LeftBracket;
$Equal => gData.keyName ← Equal;
$RightShift => gData.keyName ← RightShift;
$Spare3 => gData.keyName ← Spare3;
$Swat => gData.keyName ← Spare3; -- synonym
$Stop => gData.keyName ← Spare3; -- synonym (DLion)
$Props => gData.keyName ← Props;
$FL4 => gData.keyName ← Props; -- synonym
$SkipNext => gData.keyName ← SkipNext; -- DLion only
$Margins => gData.keyName ← Margins; -- DLion only
$Same => gData.keyName ← Same; -- DLion only
$Find => gData.keyName ← Find; -- DLion only
$Again => gData.keyName ← Again; -- DLion only
$Help => gData.keyName ← Help; -- DLion only
$DefnExpand => gData.keyName ← DefnExpand; -- DLion only
$RightArrow => gData.keyName ← RightArrow; -- DLion only
$Bold => gData.keyName ← Bold; -- DLion only
$Italics => gData.keyName ← Italics; -- DLion only
$Underline => gData.keyName ← Underline; -- DLion only
$Superscript => gData.keyName ← Superscript; -- DLion only
$Subscript => gData.keyName ← Subscript; -- DLion only
$LargerSmaller => gData.keyName ← LargerSmaller; -- DLion only
$Font => gData.keyName ← Font; -- DLion only
ENDCASE => gData.symbol ← Ident;
};
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 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[];
};
main code:
InitBuilder: PUBLIC PROC = {
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] ← "";
keyNames[x0] ← "x0";
keyNames[x1] ← "x1";
keyNames[x2] ← "x2";
keyNames[x3] ← "x3";
keyNames[x4] ← "x4";
keyNames[x5] ← "x5";
keyNames[x6] ← "x6";
keyNames[Pen] ← "Pen";
keyNames[Keyset1] ← "Keyset1";
keyNames[Keyset2] ← "Keyset2";
keyNames[Keyset3] ← "Keyset3";
keyNames[Keyset4] ← "Keyset4";
keyNames[Keyset5] ← "Keyset5";
keyNames[Red] ← "Red";
keyNames[Blue] ← "Blue";
keyNames[Yellow] ← "Yellow";
keyNames[Five] ← "Five";
keyNames[Four] ← "Four";
keyNames[Six] ← "Six";
keyNames[E] ← "E";
keyNames[Seven] ← "Seven";
keyNames[D] ← "D";
keyNames[U] ← "U";
keyNames[V] ← "V";
keyNames[Zero] ← "Zero";
keyNames[K] ← "K";
keyNames[Dash] ← "Dash";
keyNames[P] ← "P";
keyNames[Slash] ← "Slash";
keyNames[BackSlash] ← "BackSlash";
keyNames[LF] ← "LF";
keyNames[BS] ← "BS";
keyNames[Three] ← "Three";
keyNames[Two] ← "Two";
keyNames[W] ← "W";
keyNames[Q] ← "Q";
keyNames[S] ← "S";
keyNames[A] ← "A";
keyNames[Nine] ← "Nine";
keyNames[I] ← "I";
keyNames[X] ← "X";
keyNames[O] ← "O";
keyNames[L] ← "L";
keyNames[Comma] ← "Comma";
keyNames[Quote] ← "Quote";
keyNames[RightBracket] ← "RightBracket";
keyNames[Spare2] ← "Spare2";
keyNames[TerminalDefs.BW] ← "BW";
keyNames[One] ← "One";
keyNames[ESC] ← "ESC";
keyNames[TAB] ← "TAB";
keyNames[F] ← "F";
keyNames[Ctrl] ← "Ctrl";
keyNames[C] ← "C";
keyNames[J] ← "J";
keyNames[B] ← "B";
keyNames[Z] ← "Z";
keyNames[LeftShift] ← "LeftShift";
keyNames[Period] ← "Period";
keyNames[SemiColon] ← "SemiColon";
keyNames[Return] ← "Return";
keyNames[Arrow] ← "Arrow";
keyNames[DEL] ← "DEL";
keyNames[TerminalDefs.FL3] ← "FL3";
keyNames[R] ← "R";
keyNames[T] ← "T";
keyNames[G] ← "G";
keyNames[Y] ← "Y";
keyNames[H] ← "H";
keyNames[Eight] ← "Eight";
keyNames[N] ← "N";
keyNames[M] ← "M";
keyNames[Lock] ← "Lock";
keyNames[Space] ← "Space";
keyNames[LeftBracket] ← "LeftBracket";
keyNames[Equal] ← "Equal";
keyNames[RightShift] ← "RightShift";
keyNames[Spare3] ← "Spare3";
keyNames[TerminalDefs.FL4] ← "FL4";
};
InitBuilder[];
Reserved word initialization
{
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;
};
END.