TIPTableReaderWriterImpl.mesa
Copyright Ó 1985, 1986, 1989, 1990, 1991, 1992, 1993 by Xerox Corporation. All rights reserved.
Doug Wyatt, January 19, 1987 11:35:36 pm PST
Russ Atkinson (RRA) April 9, 1990 6:15 pm PDT
Tim Diebert: April 20, 1988 12:10:24 pm PDT
Michael Plass, November 26, 1991 1:37 pm PST
Bier, March 4, 1993 12:42 pm PST
Willie-s, June 23, 1993 3:24 pm PDT
Kenneth A. Pier, August 5, 1992 6:42 pm PDT
Christian Jacobi, March 3, 1992 9:10 am PST
Last tweaked by Mike Spreitzer April 15, 1992 7:13 am PDT
Contents: Manage TIP files. Reads .tip files. Creates .tipB (compiled Tip files). The actual building of TIP tables is performed in TIPTableBuilderImpl.
DIRECTORY
Atom, Basics, BasicTime, Convert, IO, KeySymsKB, KeyTypes, PFS, PFSNames, ProcessProps, RefText, Rope, SimpleFeedback, StandardStreams, SystemNames, TIPLinking, TIPPrivate, TIPPrivateTypes, TIPFastTables, TIPTables, TIPTypes, TIPUser;
TIPTableReaderWriterImpl: CEDAR PROGRAM
IMPORTS Atom, Basics, Convert, IO, PFS, PFSNames, ProcessProps, RefText, Rope, SimpleFeedback, StandardStreams, SystemNames, TIPPrivate, TIPFastTables
EXPORTS TIPLinking, TIPPrivate, TIPPrivateTypes, TIPTypes, TIPUser = BEGIN
TIPTableRep: PUBLIC <<TIPTypes>> TYPE ~ TIPPrivateTypes.TIPTableRep;
TIPTableImplRep: PUBLIC <<TIPPrivateTypes>> TYPE ~ TIPTables.TIPTableImplRep;
KeyOption: TYPE = TIPPrivate.KeyOption;
KeySym: TYPE = KeyTypes.KeySym;
ROPE: TYPE = Rope.ROPE;
PATH: TYPE = PFSNames.PATH;
STREAM: TYPE = IO.STREAM;
TIPTableImpl: TYPE ~ REF TIPTableImplRep;
TIPChoice: PUBLIC TYPE ~ TIPTables.TIPChoice;
TIPChoiceSeries: PUBLIC TYPE ~ TIPTables.TIPChoiceSeries;
TIPKeyState: PUBLIC TYPE ~ TIPTables.TIPKeyState;
TIPResults: PUBLIC TYPE ~ TIPTables.TIPResults;
TIPTable: PUBLIC TYPE ~ TIPTypes.TIPTable;
TIPTerm: PUBLIC TYPE ~ TIPTables.TIPTerm;
BadTable: ERROR = CODE;
debugTipErrors: BOOL ¬ TRUE;
FindErrorStream: PROC RETURNS [STREAM] = {
WITH ProcessProps.GetProp[$ErrOut] SELECT FROM
stream: STREAM => RETURN [stream];
ENDCASE => NULL;
WITH ProcessProps.GetProp[$StdOut] SELECT FROM
stream: STREAM => RETURN [stream];
ENDCASE => NULL;
RETURN [StandardStreams.CreateStandardOutputStream[]];
};
WriteGMT: PROC [f: STREAM, gmt: BasicTime.GMT] = {
f.PutFWord[Basics.FFromCard32[LOOPHOLE[gmt]]];
};
ReadGMT: PROC [f: STREAM] RETURNS [gmt: BasicTime.GMT] = {
gmt ¬ LOOPHOLE[Basics.Card32FromF[IO.GetFWord[f]]];
};
GetTIPFilePrefix: PUBLIC PROC[hadError: BOOL] RETURNS [ROPE] ~ {
IF hadError THEN SetTIPFilePrefix[hadError];
RETURN[tipFilePrefix];
};
InstantiateNewTIPTable: PUBLIC PROC [file: ROPE] RETURNS [table: TIPTable ¬ NIL] = {
ENABLE PFS.Error => IF debugTipErrors THEN {
reason: ROPE ¬ error.explanation;
out: STREAM = FindErrorStream[];
IO.PutF1[out, "PFS.Error (file %g) in TIPTableReaderWriterImpl.InstantiateNewTIPTable: ", [rope[file]] ];
IO.PutRope[out, reason];
IO.PutRope[out, "\n"];
REJECT;
};
short: ROPE = ShortName[file];
tipCName: ROPE ¬ Rope.Flatten[Rope.Cat[tipFilePrefix, short, "B"]];
option: KeyOption ¬ none;
uniqueID: PFS.UniqueID ¬ PFS.nullUniqueID;
tipCreated: BasicTime.GMT ¬ BasicTime.nullGMT;
name: ROPE ¬ file;
fullName: PATH ¬ NIL;
[fullFName: fullName, uniqueID: uniqueID] ¬ PFS.FileInfo[name: PFS.PathFromRope[name]];
tipCreated ¬ uniqueID.egmt.gmt;
{
Try to read the compiled (tipB) version of the tip file. The tipB filename contains the create date of the tip file (as a BasicTime.GMT) so we can determine correspondence between the two.
{
tipCreatedCardRope: Rope.ROPE ¬ NIL;
st: STREAM ¬ NIL;
tipCreatedCardRope ¬ Convert.RopeFromCard[
from: LOOPHOLE[tipCreated, CARD], base: 10, showRadix: FALSE];
tipCName ¬ Rope.Flatten[Rope.Cat[tipCName, "-", tipCreatedCardRope]];
st ¬ PFS.StreamOpen[PFS.PathFromRope[tipCName], read
! PFS.Error => GO TO noTIPC
];
[table, option] ¬ ReadTIPCFile[st ! BadTable => CONTINUE];
IO.Close[st];
};
IF table # NIL THEN {
IF option # none THEN {
The default table acts as a back stop, translating the printing keys.
table.link ¬ TIPPrivate.DefaultTable[option = printKeys];
table.opaque ¬ FALSE;
};
RETURN [table];
};
EXITS noTIPC => {};
};
We will have to make a tipB file, starting from the tip file. Any PFS.Error will propagate from here.
[table, option] ¬ TIPPrivate.BuildNewTIPTable[PFS.RopeFromPath[fullName]];
IF table = NIL THEN RETURN;
Produce the tipB file.
{
first: BOOL ¬ TRUE;
st: STREAM;
DO
st ¬ PFS.StreamOpen[PFS.PathFromRope[tipCName], $create
! PFS.Error => IF first THEN CONTINUE ELSE REJECT];
IF st # NIL THEN EXIT;
SetTIPFilePrefix[TRUE];
tipCName ¬ Rope.Flatten[Rope.Cat[tipFilePrefix, short, "B"]];
first ¬ FALSE;
ENDLOOP;
WriteTIPCFile[table, option, st];
IO.Close[st];
};
Make sure that building a table from the tipB, produces the same result.
{
newTable: TIPTable;
newKeyOption: KeyOption ¬ none;
st: STREAM = PFS.StreamOpen[PFS.PathFromRope[tipCName], $read];
[newTable, newKeyOption] ¬ ReadTIPCFile[st];
IO.Close[st];
IF newKeyOption # option THEN ERROR;
EnsureEqualTables[table, newTable]; -- raise an ERROR if tables not equal.
};
RETURN [table];
};
Append: PUBLIC PROC [early, late: TIPTable] RETURNS [err: TIPTable] ~ {
FOR x: TIPTable ¬ early, x.link UNTIL x=NIL DO
FOR y: TIPTable ¬ late, y.link UNTIL y=NIL DO
IF x = y THEN RETURN [x];
ENDLOOP;
ENDLOOP;
FOR x: TIPTable ¬ early, x.link UNTIL x.link=NIL DO
REPEAT FINISHED => {
early.mouseTicks ¬ MIN[late.mouseTicks, early.mouseTicks];
x.opaque ¬ FALSE;
x.link ¬ late;
};
ENDLOOP;
RETURN[NIL]};
ShortName: PROC [name: ROPE] RETURNS [ROPE] = {
Gets the file name stripped of directory and version information, but retaining the extension.
RETURN [PFSNames.ComponentRope[PFSNames.ShortName[PFS.PathFromRope[name]]]];
};
ReadTIPCFile: PROC [s: STREAM] RETURNS [table: TIPTable, keyOption: KeyOption ¬ none] = {
text: REF TEXT ¬ NEW[TEXT[32]]; -- scratch text for atoms and such
opaque, up, down, move: BOOL;
where: INT ¬ 0; -- for debugging
Text: PROC [len: CARDINAL] = TRUSTED {
IF len > 255 THEN ERROR BadTable;
IF len > text.maxLength THEN text ¬ NEW[TEXT[len]];
IF (text.length ¬ IO.GetBlock[s,text,0,len]) # len THEN ERROR BadTable;
where ¬ where+len;
};
Char: PROC RETURNS [CHAR] = INLINE {
where ¬ where+1;
RETURN [IO.GetChar[s]];
};
Key: PROC RETURNS [k: KeySym] = TRUSTED {
k ¬ [Basics.Card32FromF[IO.GetFWord[s]]];
};
GetAtom: PROC RETURNS [ATOM] = {
Text[LOOPHOLE[Char[],CARDINAL]];
RETURN [Atom.MakeAtom[Rope.FromRefText[text]]];
};
Bool: PROC RETURNS [BOOL] = {
RETURN [SELECT Char[] FROM 'F => FALSE, 'T => TRUE, ENDCASE => ERROR BadTable];
};
StoreFlags: PROC = {
impl: TIPTableImpl ~ table.impl;
table.opaque ¬ opaque;
impl.ignore.up ¬ up;
impl.ignore.down ¬ down;
impl.ignore.move ¬ move;
};
ChoiceItem: PROC RETURNS [key: KeySym, choice: TIPChoice] = {
SELECT Char[] FROM
') => RETURN [KeySymsKB.BS, NIL];
'( => NULL;
ENDCASE => ERROR BadTable;
key ¬ Key[];
choice ¬ Choice[];
IF Char[] # ') THEN ERROR BadTable;
};
Choice: PROC [skipPar: BOOL ¬ FALSE] RETURNS [choice: TIPChoice] = {
last: TIPChoice;
char: CHAR;
IF ~skipPar AND Char[] # '( THEN ERROR BadTable;
WHILE (char ¬ Char[]) # ') DO
term: TIPChoice ¬ Term[char];
IF last=NIL THEN choice ¬ last ¬ term ELSE last ¬ last.rest ¬ term;
ENDLOOP;
};
ChoiceSeries: PROC RETURNS [series: TIPChoiceSeries] = {
last: TIPChoiceSeries;
IF Char[] # '( THEN ERROR BadTable;
WHILE Char[] # ') DO
choices: TIPChoiceSeries ¬ LIST[Choice[TRUE]];
IF last=NIL THEN series ¬ last ¬ choices ELSE last ¬ last.rest ¬ choices;
ENDLOOP;
};
Term: PROC [char: CHAR] RETURNS [term: TIPChoice] = {
SELECT char FROM
'1 => {
keytrigger
keyTerm: keyTrigger TIPTerm;
keyTerm.keyState.keySym ¬ Key[];
keyTerm.keyState.state ¬ SELECT Char[] FROM
'U => up, 'D => down, ENDCASE => ERROR BadTable;
RETURN [LIST[keyTerm]] };
'2 => {
mousetrigger
mouseTerm: mouseTrigger TIPTerm;
RETURN [LIST[mouseTerm]] };
'T => {
trackballTrigger
term: trackballTrigger TIPTerm;
RETURN [LIST[term]];
};
'W => {
thumbwheelTrigger
term: thumbwheelTrigger TIPTerm;
RETURN [LIST[term]];
};
'3 => {
timetrigger
timeTerm: timeTrigger TIPTerm;
msecs: CARDINAL;
timeTerm.flavor ¬ SELECT Char[] FROM
'G => gt, 'L => lt, ENDCASE => ERROR BadTable;
msecs ¬ LOOPHOLE[Char[],CARDINAL]*256;
msecs ¬ msecs + LOOPHOLE[Char[],CARDINAL];
timeTerm.mSecs ¬ msecs;
RETURN [LIST[timeTerm]] };
'4 => {
keyenable
keyTerm: keyEnable TIPTerm;
keyTerm.keyState ¬ KeyState[];
RETURN [LIST[keyTerm]] };
'5 => {
predenable
predTerm: predEnable TIPTerm;
predTerm.predicate ¬ GetAtom[];
RETURN [LIST[predTerm]] };
'6 => {
char
charTerm: char TIPTerm;
charTerm.ch ¬ TIPPrivate.stdChar;
RETURN [LIST[charTerm]] };
'7 => {
mouse coords
coordsTerm: coords TIPTerm;
coordsTerm.xy ¬ TIPPrivate.stdCoords;
RETURN [LIST[coordsTerm]] };
't => {
Trackball coords
term: trackballChange TIPTerm;
term.vec ¬ TIPPrivate.stdTrackballChange;
RETURN [LIST[term]];
};
'w => {
Thumbwheel coords
term: thumbwheelChange TIPTerm;
term.v ← TIPPrivate.stdThumbwheelChange;
RETURN [LIST[term]];
};
'8 => {
choiceseries
term: nested TIPTerm;
term.statement ¬ ChoiceSeries[];
RETURN [LIST[term]] };
'9 => {
results
resultTerm: result TIPTerm;
resultTerm.list ¬ Results[];
RETURN [LIST[resultTerm]] };
'A => {
key2Enable
term: key2Enable TIPTerm;
term.keyState1 ¬ KeyState[];
term.keyState2 ¬ KeyState[];
RETURN [LIST[term]] };
'B => {
keyEnableList
term: keyEnableList TIPTerm;
last: LIST OF TIPKeyState;
IF Char[] # '( THEN ERROR BadTable;
WHILE IO.PeekChar[s] # ') DO
keyState: LIST OF TIPKeyState ¬ LIST[KeyState[]];
IF last=NIL THEN term.lst ¬ last ¬ keyState ELSE last ¬ last.rest ¬ keyState;
ENDLOOP;
IF Char[] # ') THEN ERROR;
RETURN [LIST[term]] };
'C => {
TIME
timeTerm: time TIPTerm;
timeTerm.time ¬ TIPPrivate.stdTime;
RETURN [LIST[timeTerm]];
};
ENDCASE => ERROR BadTable;
};
KeyState: PROC RETURNS [keyState: TIPKeyState] = {
keyState.keySym ¬ Key[];
keyState.state ¬ SELECT Char[] FROM
'U => up, 'D => down, ENDCASE => ERROR BadTable;
};
Results: PROC RETURNS [results: TIPResults] = {
last: TIPResults ¬ NIL;
char: CHAR;
IF Char[] # '( THEN ERROR BadTable;
WHILE (char ¬ Char[]) # ') DO
result: LIST OF REF ANY ¬ LIST[Result[char]];
IF last=NIL THEN results ¬ last ¬ result ELSE last ¬ last.rest ¬ result;
ENDLOOP;
};
Result: PROC [char: CHAR] RETURNS [REF ANY] = { -- used to parse results clauses
SELECT char FROM
'1 => RETURN [GetAtom[]]; -- an atom
'2 => RETURN [TIPPrivate.stdChar]; -- put a ref to stdChar in the table
'3 => { -- put an INT in the table
b: bytes Basics.LongNumber;
These calls to Char[] are on separate lines so we don't depend on left-to-right evaluation.
b.hh ¬ LOOPHOLE[Char[]];
b.hl ¬ LOOPHOLE[Char[]];
b.lh ¬ LOOPHOLE[Char[]];
b.ll ¬ LOOPHOLE[Char[]];
RETURN [NEW[INT ¬ LOOPHOLE[b]]];
};
'4 => { -- allocate a new text and put it in the table
len: NAT ¬ Char[]-0C;
txt: REF TEXT ¬ RefText.New[len];
Text[len];
txt ¬ RefText.Append[to: txt, from: text];
RETURN [txt];
};
'5 => RETURN [TIPPrivate.stdCoords];
'6 => RETURN [TIPPrivate.stdTime];
'7 => RETURN [TIPPrivate.stdTrackballChange];
'8 => RETURN [TIPPrivate.stdThumbwheelChange];
ENDCASE => ERROR BadTable;
};
Text[8];
IF ~Rope.Equal["TIPTABLE", RefText.TrustTextAsRope[text]] THEN ERROR BadTable;
IF Char[] # TIPPrivate.version THEN ERROR BadTable;
opaque ¬ Bool[];
keyOption ¬ SELECT Char[] FROM
'N => none, 'P => printKeys, 'D => defaultKeys, ENDCASE => ERROR BadTable;
up ¬ Bool[]; down ¬ Bool[]; move ¬ Bool[];
SELECT Char[] FROM
'S => {
small table
small: REF small TIPTableImplRep ¬ NEW[small TIPTableImplRep];
table ¬ NEW[TIPTableRep ¬ [impl: small]];
StoreFlags[];
small.all ¬ ChoiceSeries[];
};
'F => {
fast table
fast: REF fast TIPTableImplRep ¬ NEW[fast TIPTableImplRep];
key: KeySym;
choice: TIPChoice;
fast.keyUp ¬ TIPFastTables.CreateFastTable[];
fast.keyDown ¬ TIPFastTables.CreateFastTable[];
table ¬ NEW[TIPTableRep ¬ [impl: fast]];
StoreFlags[];
fast.mouse ¬ Choice[];
IF Char[] # 'U THEN ERROR BadTable;
IF Char[] # '( THEN ERROR BadTable;
DO [key, choice] ¬ ChoiceItem[];
IF choice=NIL THEN EXIT;
TIPFastTables.StoreInFastTable[fast.keyUp, key, choice];
ENDLOOP;
IF Char[] # 'D THEN ERROR BadTable;
IF Char[] # '( THEN ERROR BadTable;
DO [key,choice] ¬ ChoiceItem[];
IF choice=NIL THEN EXIT;
TIPFastTables.StoreInFastTable[fast.keyDown, key, choice];
ENDLOOP;
fast.time ¬ Choice[];
};
ENDCASE => ERROR BadTable;
};
EnsureEqualTables: PUBLIC PROC [t1, t2: TIPTable] = TRUSTED {
Make sure the two tables are equivalent. Return an error if not.
This routine is TRUSTED because with WITH ... SELECT FROM clauses are unsafe.
impl1: TIPTableImpl ~ t1.impl;
impl2: TIPTableImpl ~ t2.impl;
IF t1.opaque # t2.opaque THEN ERROR;
IF impl1.ignore # impl1.ignore THEN ERROR;
WITH x: impl1 SELECT FROM
small => WITH y: impl2 SELECT FROM
small => EqualChoiceSeries[x.all,y.all];
fast => ERROR;
ENDCASE => ERROR;
fast => WITH y: impl2 SELECT FROM
fast => {
DoCompareDownTerms: PROC [k: KeySym, c: TIPChoice] = TRUSTED {
yChoice: TIPChoice ¬ TIPFastTables.FetchFromFastTable[y.keyDown, k];
EqualChoices[c, yChoice];
};
DoCompareUpTerms: PROC [k: KeySym, c: TIPChoice] = TRUSTED {
yChoice: TIPChoice ¬ TIPFastTables.FetchFromFastTable[y.keyUp, k];
EqualChoices[c, yChoice];
};
EqualChoices[x.mouse,y.mouse];
IF TIPFastTables.GetSizeFastTable[x.keyDown] # TIPFastTables.GetSizeFastTable[y.keyDown] THEN ERROR;
TIPFastTables.WalkKeySymsInFastTable[x.keyDown, DoCompareDownTerms];
TIPFastTables.WalkKeySymsInFastTable[x.keyUp, DoCompareUpTerms];
EqualChoices[x.time, y.time];
};
small => ERROR;
ENDCASE => ERROR;
ENDCASE => ERROR;
};
EqualChoiceSeries: PROC [c1, c2: TIPChoiceSeries] = {
DO
check each choice on list
IF c1 = c2 THEN RETURN;
IF c1 = NIL OR c2 = NIL THEN ERROR;
EqualChoices[c1.first, c2.first];
c1 ¬ c1.rest;
c2 ¬ c2.rest;
ENDLOOP;
};
EqualChoices: PROC [c1, c2: TIPChoice] = TRUSTED {
This routine is TRUSTED because the WITH ... SELECT FROM statement is unsafe.
DO
check each term on list
IF c1 = c2 THEN RETURN;
IF c1 = NIL OR c2 = NIL THEN ERROR;
WITH x: c1.first SELECT FROM
keyTrigger => WITH y: c2.first SELECT FROM
keyTrigger => IF x.keyState # y.keyState THEN ERROR;
ENDCASE => ERROR;
mouseTrigger => WITH y: c2.first SELECT FROM
mouseTrigger => NULL;
ENDCASE => ERROR;
trackballTrigger => WITH y: c2.first SELECT FROM
trackballTrigger => NULL;
ENDCASE => ERROR;
thumbwheelTrigger => WITH y: c2.first SELECT FROM
thumbwheelTrigger => NULL;
ENDCASE => ERROR;
timeTrigger => WITH y: c2.first SELECT FROM
timeTrigger => IF x.flavor # y.flavor OR x.mSecs # y.mSecs THEN ERROR;
ENDCASE => ERROR;
keyEnable => WITH y: c2.first SELECT FROM
keyEnable => IF x.keyState # y.keyState THEN ERROR;
ENDCASE => ERROR;
key2Enable => WITH y: c2.first SELECT FROM
key2Enable =>
IF x.keyState1 # y.keyState1 OR x.keyState2 # y.keyState2 THEN ERROR;
ENDCASE => ERROR;
keyEnableList => WITH y: c2.first SELECT FROM
keyEnableList => {
lst1: LIST OF TIPKeyState ¬ x.lst;
lst2: LIST OF TIPKeyState ¬ y.lst;
DO
IF lst1 = NIL THEN IF lst2 = NIL THEN EXIT ELSE ERROR;
IF lst2 = NIL THEN ERROR;
IF lst1.first # lst2.first THEN ERROR;
lst1 ¬ lst1.rest;
lst2 ¬ lst2.rest;
ENDLOOP };
ENDCASE => ERROR;
predEnable => WITH y: c2.first SELECT FROM
predEnable => IF x.predicate # y.predicate THEN ERROR;
ENDCASE => ERROR;
char => WITH y: c2.first SELECT FROM
char => NULL;
ENDCASE => ERROR;
coords => WITH y: c2.first SELECT FROM
coords => NULL;
ENDCASE => ERROR;
trackballChange => WITH y: c2.first SELECT FROM
trackballChange => NULL;
ENDCASE => ERROR;
thumbwheelChange => WITH y: c2.first SELECT FROM
thumbwheelChange => NULL;
ENDCASE => ERROR;
nested => WITH y: c2.first SELECT FROM
nested => EqualChoiceSeries[x.statement, y.statement];
ENDCASE => ERROR;
result => WITH y: c2.first SELECT FROM
result => {
cList1: TIPResults ¬ x.list;
cList2: TIPResults ¬ y.list;
DO
check each term on list
SELECT TRUE FROM
cList1 = cList2 => RETURN;
cList1=NIL, cList2=NIL => ERROR;
cList1.first = cList2.first => {};
cList1.first = TIPPrivate.stdChar, cList2.first = TIPPrivate.stdChar => ERROR;
cList1.first = TIPPrivate.stdCoords, cList2.first = TIPPrivate.stdCoords => ERROR;
cList1.first = TIPPrivate.stdTrackballChange, cList2.first = TIPPrivate.stdTrackballChange => ERROR;
cList1.first = TIPPrivate.stdThumbwheelChange, cList2.first = TIPPrivate.stdThumbwheelChange => ERROR;
ENDCASE =>
WITH cList1.first SELECT FROM
x: ATOM => WITH cList2.first SELECT FROM
y: ATOM => IF x # y THEN ERROR;
ENDCASE => ERROR;
x: REF INT => WITH cList2.first SELECT FROM
y: REF INT => IF x­ # y­ THEN ERROR;
ENDCASE => ERROR;
x: REF TEXT => WITH cList2.first SELECT FROM
y: REF TEXT => {
IF x.length # y.length THEN ERROR;
FOR i:NAT IN [0..x.length) DO
IF x[i] # y[i] THEN ERROR;
ENDLOOP
};
ENDCASE => ERROR;
ENDCASE => ERROR;
cList1 ¬ cList1.rest;
cList2 ¬ cList2.rest;
ENDLOOP;
};
ENDCASE => ERROR;
ENDCASE => ERROR;
c1 ¬ c1.rest;
c2 ¬ c2.rest;
ENDLOOP;
};
debug: BOOL = FALSE;
debugStream: STREAM;
WriteTIPCFile: PROC [table: TIPTable, keyOption: KeyOption, s: STREAM] = {
impl: TIPTableImpl ~ table.impl;
Char: PROC [c: CHAR] = {
IO.PutChar[s, c];
IF debug THEN IO.PutChar[debugStream,c];
};
String: PROC [str: REF READONLY TEXT] = {
IO.PutBlock[s,str];
IF debug THEN IO.PutBlock[debugStream,str];
};
Text: PROC [txt: REF READONLY TEXT] = {
IF txt.length > 255 THEN ERROR;
Char[LOOPHOLE[txt.length]];
String[txt];
};
Bool: PROC [flag: BOOL] = { Char[IF flag THEN 'T ELSE 'F] };
Key: PROC [k: KeySym] = {
b: Basics.Word32 ~ [card[k]];
Char[LOOPHOLE[b.hh]];
Char[LOOPHOLE[b.hl]];
Char[LOOPHOLE[b.lh]];
Char[LOOPHOLE[b.ll]];
};
Int: PROC [x: INT] = {
b: Basics.LongNumber ¬ LOOPHOLE[x];
Char[LOOPHOLE[b.hh]];
Char[LOOPHOLE[b.hl]];
Char[LOOPHOLE[b.lh]];
Char[LOOPHOLE[b.ll]];
};
ChoiceItem: PROC [k: KeySym, c: TIPChoice] = {
IF c=NIL THEN RETURN;
Char['(]; Key[k]; Choice[c]; Char[')]
};
ChoiceSeries: PROC [cs: TIPChoiceSeries] = {
Char['(];
FOR x: TIPChoiceSeries ¬ cs, x.rest UNTIL x=NIL DO
Choice[x.first]; ENDLOOP;
Char[')];
};
Choice: PROC [c: TIPChoice] = {
Char['(];
FOR x: TIPChoice ¬ c, x.rest UNTIL x=NIL DO
Term[x.first]; ENDLOOP;
Char[')];
};
KeyState: PROC [keyState: TIPKeyState] = {
Key[keyState.keySym];
Char[SELECT keyState.state FROM
up => 'U, down => 'D, ENDCASE => ERROR] };
Term: PROC [t: TIPTerm] = TRUSTED {
WITH x: t SELECT FROM
keyTrigger => {
Char['1];
Key[x.keyState.keySym];
Char[SELECT x.keyState.state FROM
up => 'U, down => 'D, ENDCASE => ERROR] };
mouseTrigger => Char['2];
trackballTrigger => Char['T];
thumbwheelTrigger => Char['W];
timeTrigger => {
Char['3];
Char[SELECT x.flavor FROM gt => 'G, lt => 'L, ENDCASE => ERROR];
Char[LOOPHOLE[x.mSecs / 256]];
Char[LOOPHOLE[x.mSecs MOD 256]] };
keyEnable => { Char['4]; KeyState[x.keyState] };
predEnable => { Char['5]; Text[LOOPHOLE[Atom.GetPName[x.predicate]]] };
char => Char['6];
coords => Char['7];
trackballChange => Char['t];
thumbwheelChange => Char['w];
nested => { Char['8]; ChoiceSeries[x.statement] };
result => { Char['9]; Results[x.list] };
key2Enable => { Char['A]; KeyState[x.keyState1]; KeyState[x.keyState2] };
keyEnableList => {
Char['B]; Char['(];
FOR lst: LIST OF TIPKeyState ¬ x.lst, lst.rest UNTIL lst=NIL DO
KeyState[lst.first]; ENDLOOP;
Char[')] };
time => Char['C];
ENDCASE => ERROR;
};
Results: PROC [c: TIPResults] = {
Char['(];
FOR x: TIPResults ¬ c, x.rest UNTIL x=NIL DO
Result[x.first]; ENDLOOP;
Char[')] };
Result: PROC [r: REF ANY] = TRUSTED {
This routine must be TRUSTED because of the LOOPHOLE
IF r=TIPPrivate.stdCoords THEN Char['5]
ELSE IF r=TIPPrivate.stdChar THEN Char['2]
ELSE IF r=TIPPrivate.stdTime THEN Char['6]
ELSE IF r=TIPPrivate.stdTrackballChange THEN Char['7]
ELSE IF r=TIPPrivate.stdThumbwheelChange THEN Char['8]
ELSE WITH r SELECT FROM
x: ATOM => { Char['1]; Text[LOOPHOLE[Atom.GetPName[x]]] };
x: REF INT => { Char['3]; Int[x­] };
x: REF TEXT => { Char['4]; Text[x] };
ENDCASE => ERROR };
IF debug THEN debugStream ← ViewerIO.CreateViewerStreams["TIPTableWriterDebugLog"].out;
String["TIPTABLE"];
Char[TIPPrivate.version];
Bool[table.opaque];
Char[SELECT keyOption FROM
none => 'N, printKeys => 'P, defaultKeys => 'D, ENDCASE => ERROR];
Bool[impl.ignore.up];
Bool[impl.ignore.down];
Bool[impl.ignore.move];
WITH impl SELECT FROM
x: REF small TIPTableImplRep => { Char['S]; ChoiceSeries[x.all] };
x: REF fast TIPTableImplRep => {
Char['F];
Choice[x.mouse];
Char['U];
Char['(];
TIPFastTables.WalkKeySymsInFastTable[x.keyUp, ChoiceItem];
Char[')];
Char['D];
Char['(];
TIPFastTables.WalkKeySymsInFastTable[x.keyDown, ChoiceItem];
Char[')];
Choice[x.time];
};
ENDCASE => ERROR;
};
tipFilePrefix: ROPE;
SetTIPFilePrefix: PROC[hadError: BOOL] = {
pth: ROPE ¬ IF debug THEN NIL ELSE SystemNames.SimpleHomeDirectory[];
IF (pth.Length[] < 3 ) OR hadError THEN { -- in case "//" returned ????
pth ¬ "/tmp/";
SimpleFeedback.Append[$TIP, oneLiner, $Feedback, "TIP: Home directory not available - using -vux:/tmp/ ..."];
}
ELSE pth ¬ SystemNames.UserCedarDir["tipb"];
tipFilePrefix ¬ Rope.Concat["-vux:", pth];
};
SetTIPFilePrefix[FALSE];
liberalMode: UnixStat.Mode ← [fmt: dir, owner: [true, true, true], group: [true, true, true], others: [true, true, true]];
IF UnixSysCalls.MkDir[path: UXStrings.Create["/tmp/tip"], mode: liberalMode] = failure THEN {
SimpleFeedback.Append[$TIP, oneLiner, $Feedback, "TIP: Using existing /tmp/tip. I hope we have write permission ... "];
}
ELSE {
SimpleFeedback.Append[$TIP, begin, $Feedback, "TIP: Creating /tmp/tip with permissions 777 ... "];
IF UnixSysCalls.ChMod[path: UXStrings.Create["/tmp/tip"], mode: liberalMode] = failure
THEN SimpleFeedback.Append[$TIP, end, $Feedback, "failed."]
ELSE SimpleFeedback.Append[$TIP, end, $Feedback, "done."]
Use ChMod because UnixSysCalls.MkDir above appears to create with mode 755 no matter what arguments are given.
};
END.