TIPTableBuilder.mesa
Copyright © 1984 by Xerox Corporation. All rights reserved.
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 6, 1984 5:32:52 pm PST
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],
Interminal USING [KeyName],
Intime USING [EventTime],
IO USING [STREAM, Close, Error, GetIndex, int, Put, PutRope, SetLength],
Rope USING [Cat, Concat, FromRefText, ROPE, Substr],
TIPPrivate USING [BadTable, EqualTables, InitBuilder, KeyOption, nrOfErrors, ReadTIPTable, Symbol, WriteTIPTable],
TIPTables USING [TimeoutFlavor, TIPChoice, TIPChoiceSeries, TIPKeyState, TIPScreenCoords, TIPScreenCoordsRec, TIPTable, TIPTableRec, TIPTerm, TIPTime],
TIPUser USING [];
TIPTableBuilder: CEDAR MONITOR
IMPORTS Atom, BasicTime, DefaultRemoteNames, FS, GPM, IO, Rope, TIPPrivate
EXPORTS TIPPrivate, TIPUser = {
OPEN TIPPrivate, TIPTables;
ROPE: TYPE = Rope.ROPE;
STREAM: TYPE = IO.STREAM;
LORA: TYPE = LIST OF REF ANY;
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:
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: TIPTable ← NIL;
defaultKeyTable: TIPTable ← NIL;
DefaultTable:
PROC [printKeys:
BOOL]
RETURNS [TIPTable] =
TRUSTED {
SELECT
TRUE
FROM
printKeys AND printKeyTable # NIL => RETURN [printKeyTable];
NOT printKeys AND defaultKeyTable # NIL => RETURN [defaultKeyTable];
ENDCASE => {
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]]];
normalDefault: TIPChoice ← ConsTerm[charTerm, ConsTerm[resultTerm]];
ctrlUpDefault: TIPChoice ← ConsTerm[enableTerm, normalDefault];
default: TIPChoice ← IF printKeys THEN ctrlUpDefault ELSE normalDefault;
tab: REF fast TIPTableRec ← NEW[fast TIPTableRec];
tab.ignore.down ← FALSE;
FOR key
IN Interminal.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 =>
tab.keyDown[key] ← default;
ENDCASE;
ENDLOOP;
IF printKeys
THEN {
Also include TAB
printKeyTable ← tab;
tab.keyDown[TAB] ← ctrlUpDefault;
}
ELSE defaultKeyTable ← tab;
RETURN [tab]
};
}; -- DefaultTable
*** the scanner: ***
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];
};
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 errcnt#0
THEN {
GPM.Close[fh]; TruncateErrorLog[]; IO.Close[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];
};
{
-- 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 ← '~;
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 errcnt=0
THEN table ← CreateTable[statement]
ELSE ErrorFinish; -- finish the error log and raise signal
EXITS
Cleanup => { ErrorFinish };
MacroCleanup => {
IF errcnt=0 THEN OpenErrorLog;
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"]];
};
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 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
TriggerStmt:
PROC
RETURNS[choiceSeries: TIPChoiceSeries] = {
TriggerStmt ::= SELECT TRIGGER FROM TriggerChoiceSeries
usedSymbols: LIST OF ATOM ← NIL;
IF symbol = From
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 ←
NIL] = {
TriggerChoiceSeries ::= TriggerChoice ; TriggerChoiceSeries
| TriggerChoice ENDCASE FinalChoice
| ENDCASE FinalChoice
tail: TIPChoiceSeries ← NIL;
IF 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 symbol = Semicolon
THEN {
GetSymbol;
IF symbol # Endcase THEN LOOP;
};
IF 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 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 symbol = Semicolon
THEN {
GetSymbol;
IF symbol # Endcase THEN LOOP;
};
IF 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 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 ← ConsTerm[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;
}
}; -- 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 ← 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: 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:
LORA, resultChoice: TIPChoice] = {
Results ::= ResultItem | ResultItem , Results | { ResultItem* }
resultItem: REF;
resultExpr: REF TIPTerm;
IF symbol = LeftCurly
THEN {
GetSymbol;
[resultList, resultChoice] ← ResultItems[];
RETURN;
};
[resultItem, resultExpr] ← ResultItem[];
SELECT 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 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 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[
INT];
WITH resultItem
SELECT
FROM
z: REF INT => 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 =>
IF ReservedWord[symbol]
THEN {
resultItem ← atom;
GetSymbol;
}; -- ResultItem
FinalChoice:
PROC
RETURNS [finalChoice: TIPChoiceSeries] = {
FinalChoice ::= empty | => Statement
GetSymbol; -- we always get here with a pending ENDCASE
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 {
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 = {
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 errcnt=0 THEN OpenErrorLog[];
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;
Error:
PROC[nr:
CARDINAL ← 0] = {
OPEN
IO;
IF errcnt=0 THEN OpenErrorLog;
errcnt ← errcnt+1;
PutRope[errlogfh, errorText[nr]];
PutRope[errlogfh, " at "];
Put[errlogfh, int[symPos]];
PutRope[errlogfh, "\n\n"];
ERROR TIPError;
};
GetSymbol:
PROC = {
GetNumber:
PROC = {
symbol ← Number;
number ← 0;
WHILE ch
IN ['0..'9]
DO
number ← 10*number + ch-'0;
GetChar;
ENDLOOP;
};
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]];
symbol ← KeyIdent;
keyName ← dummy;
SELECT atom
FROM
$OPTIONS => symbol ← OptionSym;
$SELECT => symbol ← Select;
$TRIGGER => symbol ← Trigger;
$ENABLE => symbol ← Enable;
$FROM => symbol ← From;
$ENDCASE => symbol ← Endcase;
$END => symbol ← End;
$AND => symbol ← And;
$WHILE => symbol ← While;
$AFTER => symbol ← After;
$BEFORE => symbol ← Before;
$Up => symbol ← Up;
$Down => symbol ← Down;
$Mouse => symbol ← Mouse;
$Char => symbol ← Char;
$Coords => symbol ← Coords;
$TIME => symbol ← Time;
$Small => symbol ← Small;
$Fast => symbol ← Fast;
$FastMouse => symbol ← FastMouse;
$SlowMouse => symbol ← SlowMouse;
$PrintKeys => symbol ← PrintKeys;
$DefaultKeys => symbol ← DefaultKeys;
$x0 => keyName ← x0;
$x1 => keyName ← x1;
$x2 => keyName ← x2;
$x3 => keyName ← x3;
$x4 => keyName ← x4;
$x5 => keyName ← x5;
$x6 => keyName ← x6;
$Pen => keyName ← pen;
$Keyset1 => keyName ← Keyset1;
$Keyset2 => keyName ← Keyset2;
$Keyset3 => keyName ← Keyset3;
$Keyset4 => keyName ← Keyset4;
$Keyset5 => keyName ← Keyset5;
$Red => keyName ← Red;
$Blue => keyName ← Blue;
$Yellow => keyName ← Yellow;
$Five => keyName ← Five;
$Four => keyName ← Four;
$Six => keyName ← Six;
$E => keyName ← E;
$Seven => keyName ← Seven;
$D => keyName ← D;
$U => keyName ← U;
$V => keyName ← V;
$Zero => keyName ← Zero;
$K => keyName ← K;
$Dash => keyName ← Dash;
$P => keyName ← P;
$Slash => keyName ← Slash;
$BackSlash => keyName ← BackSlash;
$LF => keyName ← LF;
$BS => keyName ← BS;
$Three => keyName ← Three;
$Two => keyName ← Two;
$W => keyName ← W;
$Q => keyName ← Q;
$S => keyName ← S;
$A => keyName ← A;
$Nine => keyName ← Nine;
$I => keyName ← I;
$X => keyName ← X;
$O => keyName ← O;
$L => keyName ← L;
$Comma => keyName ← Comma;
$Quote => keyName ← Quote;
$RightBracket => keyName ← RightBracket;
$Spare2 => keyName ← Spare2;
$BW => keyName ← BW;
$One => keyName ← One;
$ESC => keyName ← ESC;
$TAB => keyName ← TAB;
$F => keyName ← F;
$Ctrl => keyName ← Ctrl;
$C => keyName ← C;
$J => keyName ← J;
$B => keyName ← B;
$Z => keyName ← Z;
$LeftShift => keyName ← LeftShift;
$Period => keyName ← Period;
$SemiColon => keyName ← SemiColon;
$Return => keyName ← Return;
$Arrow => keyName ← Arrow;
$DEL => keyName ← DEL;
$FL3 => keyName ← FL3;
$R => keyName ← R;
$T => keyName ← T;
$G => keyName ← G;
$Y => keyName ← Y;
$H => keyName ← H;
$Eight => keyName ← Eight;
$N => keyName ← N;
$M => keyName ← M;
$Lock => keyName ← Lock;
$Space => keyName ← Space;
$LeftBracket => keyName ← LeftBracket;
$Equal => keyName ← Equal;
$RightShift => keyName ← RightShift;
$Spare3 => keyName ← Spare3;
$FL4 => keyName ← FL4;
ENDCASE => symbol ← 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[];
Reserved word initialization
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;
}.