UserProfileEntriesImpl.mesa
Copyright Ó 1993 by Xerox Corporation. All rights reserved.
Willie-s, April 15, 1993 4:24 pm PDT
DIRECTORY
Basics USING [Comparison],
BasicTime,
Commander USING [CommandProc, Handle, Register],
CommanderOps USING [Failed, NextArgument],
Convert,
FileNames,
IO,
PFS,
PFSNames,
Process USING [CheckForAbort],
Prop,
RedBlackTree USING [Compare, Create, EachNode, EnumerateIncreasing, GetKey, Insert, Table],
Rope,
Tioga,
TiogaAccess,
VersionMap;
UserProfileEntriesImpl: CEDAR MONITOR
IMPORTS BasicTime, Commander, CommanderOps, Convert, FileNames, IO, PFS, PFSNames, Process, Prop, RedBlackTree, Rope, TiogaAccess, VersionMap
= BEGIN
Types
ROPE: TYPE = Rope.ROPE;
STREAM: TYPE = IO.STREAM;
PATH: TYPE = PFS.PATH;
FileEntry: TYPE = REF FileEntryRep;
FileEntryRep: TYPE = RECORD [
fullName: ROPE,
shortName: ROPE,
package: ROPE,
upeL: LIST OF UPE
];
Switches: TYPE = PACKED ARRAY CHAR['a..'z] OF BOOL;
UPE: TYPE ~ RECORD[type: UPEType, value: ROPE];
UPEType: TYPE ~ {unknown, bool, num, token, listOfTokens, line};
Command Procedures
DoIt: PROC [fileNamesFile: ROPE, table: RedBlackTree.Table, msgs: STREAM, outFile: ROPE] = {
CheckCount: PROC ~ {
IF (count ¬ count + 1) MOD 10 # 0 THEN RETURN;
IF count MOD 100 = 0 THEN
msgs.PutF1["(%g) ", [integer[count]] ] ELSE msgs.PutChar['.]
};
The mainline of DoIt
count: INT ¬ 0;
mapList: VersionMap.MapList;
prevPackage: ROPE ¬ NIL;
in: STREAM;
msgs.PutF["\n-- ***** Building table from file %g at %g\n", [rope[fileNamesFile]], [time[BasicTime.Now[]]] ];
in ¬ PFS.StreamOpen[PFS.PathFromRope[fileNamesFile] ! PFS.Error => CONTINUE];
IF in = NIL THEN RETURN;
UNTIL IO.EndOf[in] DO
next: ROPE;
mnList: VersionMap.MapAndNameList;
next ¬ IO.GetTokenRope[in, IO.IDProc ! IO.Error, IO.EndOfStream => CONTINUE].token;
IF next = NIL THEN EXIT;
CheckCount[];
next ¬ FileNames.GetShortName[next];
IF mapList = NIL THEN mapList ¬ VersionMap.MapListForName[next];
mnList ¬ VersionMap.ShortNameToNames[mapList, VersionMap.ShortName[next]];
IF mnList = NIL THEN {
msgs.PutF1["\n%g - not in version map\n", [rope[next]] ];
LOOP;
};
FOR mnL: VersionMap.MapAndNameList ¬ mnList, mnL.rest UNTIL mnL = NIL DO
this: ROPE ¬ FileNames.StripVersionNumber[mnL.first.name];
path: PFS.PATH ~ PFS.PathFromRope[this];
len: INT ~ PFSNames.ComponentCount[path];
new: FileEntry ¬ NEW[FileEntryRep ¬ [
fullName: this,
shortName: FileNames.GetShortName[this],
package: PFSNames.ComponentRope[PFSNames.Fetch[path, len-2]]
] ];
RedBlackTree.Insert[table, new, this];
ParseFile[new];
ENDLOOP;
ENDLOOP;
msgs.PutF1["\n-- ***** Formatting entries at %g\n", [time[BasicTime.Now[]]] ];
DumpTree[msgs, outFile, table];
msgs.PutF1["\n-- {Done at %g}\n", [time[BasicTime.Now[]]] ];
};
boolBrk: ROPE ~ "Boolean";
numBrk: ROPE ~ "Number";
tokenBrk: ROPE ~ "Token";
listOfTokensBrk: ROPE ~ "ListOfTokens";
lineBrk: ROPE ~ "Line";
upDot: ROPE ~ "UserProfile.";
ParseFile: PROC[entry: FileEntry] = {
rp: ROPE ¬ PFS.RopeOpen[PFS.PathFromRope[entry.fullName]].rope;
start: INT ¬ 0;
value: ROPE;
brk: INT ¬ 0;
DO
pos: INT ¬ Rope.Find[rp, upDot, start];
posx: INT;
which: UPEType ¬ unknown;
inQuote: BOOL ¬ FALSE;
lookingForBracket: BOOL ¬ TRUE;
IF pos < 0 THEN EXIT;
pos ¬ pos + Rope.Length[upDot];
SELECT TRUE FROM
Rope.Find[rp, boolBrk, pos] = pos => {
which ¬ bool;
posx ¬ pos ¬ pos + Rope.Length[boolBrk];
};
Rope.Find[rp, numBrk, pos] = pos => {
which ¬ num;
posx ¬ pos ¬ pos + Rope.Length[numBrk];
};
Rope.Find[rp, tokenBrk, pos] = pos => {
which ¬ token;
posx ¬ pos ¬ pos + Rope.Length[tokenBrk];
};
Rope.Find[rp, listOfTokensBrk, pos] = pos => {
which ¬ listOfTokens;
posx ¬ pos ¬ pos + Rope.Length[listOfTokensBrk];
};
Rope.Find[rp, lineBrk, pos] = pos => {
which ¬ line;
posx ¬ pos ¬ pos + Rope.Length[lineBrk];
};
ENDCASE => {pos ¬ pos + Rope.Length[listOfTokensBrk]; start ¬ pos; LOOP};
DO
ch: CHAR ¬ Rope.Fetch[rp, posx];
IF lookingForBracket THEN {
SELECT ch FROM
' , '\t, '\n => { posx ¬ posx + 1; LOOP };
'[ => { lookingForBracket ¬ FALSE; ch ¬ Rope.Fetch[rp, posx ¬ posx + 1]; };
ENDCASE;
skip white space following bracket
DO
SELECT ch ¬ Rope.Fetch[rp, posx] FROM
' , '\t, '\n => { posx ¬ posx + 1; LOOP };
ENDCASE => EXIT;
ENDLOOP;
pos ¬ posx;
};
SELECT ch FROM
'\\ => { posx ¬ posx + 2; LOOP}; --escaped char
'" => { inQuote ¬ NOT inQuote; posx ¬ posx + 1; LOOP };
'[ => { IF NOT inQuote THEN brk ¬ brk + 1; posx ¬ posx + 1; LOOP };
'] => {
IF inQuote THEN { posx ¬ posx + 1; LOOP };
IF brk # 0 THEN { brk ¬ brk - 1; posx ¬ posx + 1; LOOP };
value ¬ Rope.Substr[rp, pos, (posx - pos)];
entry.upeL ¬ CONS[[which, value], entry.upeL];
EXIT;
};
ENDCASE => {posx ¬ posx + 1; LOOP};
ENDLOOP;
start ¬ pos;
ENDLOOP;
};
DumpTree: PROC[msgs: STREAM, outName: ROPE, rbTable: RedBlackTree.Table] = {
First Char:
[charSet: 0, char: '\n, looks: LOOKS[], format: NIL, comment: FALSE, endOfNode: TRUE, deltaLevel: 1, propList: LIST[^[key: $FromTiogaFile, val: $Yes]]]
Comment Char:
[charSet: 0, char: 'F, looks: LOOKS[], format: $code, comment: TRUE, endOfNode: FALSE, deltaLevel: 0, propList: NIL]
Normal Char:
[charSet: 0, char: 'F, looks: LOOKS[], format: $code, comment: FALSE, endOfNode: FALSE, deltaLevel: 0, propList: NIL]
Comment end of node (next node nested):
[charSet: 0, char: '\n, looks: LOOKS[], format: $code, comment: TRUE, endOfNode: TRUE, deltaLevel: 1, propList: NIL]
tc: TiogaAccess.TiogaChar ¬
[charSet: 0, char: '\n, looks: ALL[FALSE], format: NIL, comment: TRUE,
endOfNode: TRUE, deltaLevel: 1,
propList: Prop.Put[propList: NIL, key: $NewlineDelimiter, val: Rope.Flatten["\n"]] ];
PutCharB: Rope.ActionType = { tc.char ¬ c; TiogaAccess.Put[writer, tc] };
PutRope: PROC [ rope: ROPE ] = { [] ¬ rope.Map[action: PutCharB] };
PutRopeBold: PROC [ rope: ROPE ] = {
tc.looks['b] ¬ TRUE;
[] ¬ rope.Map[action: PutCharB];
tc.looks['b] ¬ FALSE;
};
PutRopeItalic: PROC [ rope: ROPE ] = {
tc.looks['i] ¬ TRUE;
[] ¬ rope.Map[action: PutCharB];
tc.looks['i] ¬ FALSE;
};
EndNode: PROC [ delta: INTEGER ¬ 0, format: ATOM ¬ NIL ] = {
tc.char ¬ '\n;
tc.format ¬ format;
tc.deltaLevel ¬ delta;
tc.endOfNode ¬ TRUE;
TiogaAccess.Put[writer, tc];
tc.endOfNode ¬ FALSE;
};
DumpInfo: RedBlackTree.EachNode = {
[data: RedBlackTree.UserData] RETURNS [stop: BOOL ← FALSE]
called for each item in the table to write name on fileListStream.
WITH data SELECT FROM
entry: FileEntry => {
first: BOOL ¬ TRUE;
IF entry.upeL = NIL THEN RETURN;
IF prevPackage = NIL THEN {
EndNode[];
EndNode[];
tc.format ¬ $block;
PutRopeBold[prevPackage ¬ entry.package];
EndNode[1, $block];
}
ELSE IF NOT Rope.Equal[prevPackage, entry.package] THEN {
EndNode[-2, $block];
EndNode[];
tc.format ¬ $block;
PutRopeBold[prevPackage ¬ entry.package];
EndNode[1, $block];
}
ELSE EndNode[-1, $block];
PutRopeItalic[entry.shortName];
FOR uL: LIST OF UPE ¬ entry.upeL, uL.rest UNTIL uL = NIL DO
IF first THEN EndNode[1, $block] ELSE EndNode[0, $block];
first ¬ FALSE;
SELECT uL.first.type FROM
bool => PutRope["Boolean["];
num => PutRope["Number["];
token => PutRope["Token["];
listOfTokens => PutRope[ "ListOfTokens["];
line => PutRope["Line["];
ENDCASE;
PutRope[uL.first.value];
PutRope["]"];
ENDLOOP;
};
ENDCASE => msgs.PutRope["\n**Non-FileEntry in RedBlackTree table\n"];
};
writer: TiogaAccess.Writer ¬ TiogaAccess.Create[];
tyme: BasicTime.GMT = BasicTime.Now[];
prevPackage: ROPE ¬ NIL;
TiogaAccess.Put[writer, tc];
tc.propList ¬ NIL;
tc.comment ¬ TRUE;
tc.endOfNode ¬ FALSE;
PutRope[outName];
EndNode[1];
PutRope[ IO.PutFR1["Copyright Ó %g by Xerox Corporation. All rights reserved.",
[rope[Convert.RopeFromInt[BasicTime.Unpack[tyme].year]]] ] ];
EndNode[];
PutRope[IO.PutFR1["Written %g", [time[tyme]] ]];
EndNode[-1];
tc.comment ¬ FALSE;
RedBlackTree.EnumerateIncreasing[rbTable, DumpInfo];
EndNode[-1, $block]; -- seems like it should be -2, but ...
TiogaAccess.WriteFile[writer, outName];
msgs.PutF1["\nFinished %g\n", [rope[outName]] ];
};
ShowTable: PROC [out: STREAM, table: RedBlackTree.Table] = {
prevPackage: ROPE;
EachEntry: RedBlackTree.EachNode = {
[data: RedBlackTree.UserData] RETURNS [stop: BOOL ← FALSE]
WITH data SELECT FROM
entry: FileEntry => {
prevPackage ¬ ShowEntry[out, entry, prevPackage];
};
ENDCASE => ERROR;
};
RedBlackTree.EnumerateIncreasing[table, EachEntry];
};
ShowEntry: PROC [out: STREAM, entry: FileEntry, prevPackage: ROPE]
RETURNS[package: ROPE] = {
IF NOT Rope.Equal[package ¬ entry.package, prevPackage] THEN {
IO.PutChar[out, '\n];
IO.PutRope[out, package];
IO.PutRope[out, ":\n"];
};
IO.PutF1[out, "\t%g\n", [rope[entry.shortName]] ];
FOR uL: LIST OF UPE ¬ entry.upeL, uL.rest UNTIL uL = NIL DO
SELECT uL.first.type FROM
bool => IO.PutRope[out, "\t\tBoolean["];
num => IO.PutRope[out, "\t\tNumber["];
token => IO.PutRope[out, "\t\tToken["];
listOfTokens => IO.PutRope[out, "\t\tListOfTokens["];
line => IO.PutRope[out, "\t\tLine["];
ENDCASE;
IO.PutRope[out, uL.first.value];
IO.PutRope[out, "]\n"];
ENDLOOP;
};
GetKey: RedBlackTree.GetKey = {
[data: RedBlackTree.UserData] RETURNS [RedBlackTree.Key]
RETURN [data];
};
Compare: RedBlackTree.Compare = {
[k: RedBlackTree.Key, data: RedBlackTree.UserData] RETURNS [Basics.Comparison]
key: ROPE ¬ NIL;
WITH k SELECT FROM
ent: FileEntry => key ¬ ent.fullName;
rope: ROPE => key ¬ rope;
ENDCASE => ERROR;
WITH data SELECT FROM
ent: FileEntry => RETURN [Rope.Compare[key, ent.fullName, FALSE]];
ENDCASE;
ERROR;
};
DefaultUserProfileEntries: Commander.CommandProc ~ {
ProcessSwitches: PROC [arg: ROPE] ~ {
sense: BOOL ¬ TRUE;
FOR index: INT IN [0..Rope.Length[arg]) DO
char: CHAR ¬ Rope.Fetch[arg, index];
SELECT char FROM
'- => LOOP;
'~ => {sense ¬ NOT sense; LOOP};
'a, 'A => { outFileName ¬ CommanderOps.NextArgument[cmd]; switches[char] ¬ sense };
'o, 'O => { outFileName ¬ CommanderOps.NextArgument[cmd]; switches[char] ¬ sense };
IN ['a..'z] => switches[char] ¬ sense;
IN ['A..'Z] => switches[char + ('a-'A)] ¬ sense;
ENDCASE;
sense ¬ TRUE;
ENDLOOP;
};
fileNamesFile: ROPE;
outFileName: ROPE;
table: RedBlackTree.Table ¬ RedBlackTree.Create[getKey: GetKey, compare: Compare];
switches: Switches ¬ ALL[FALSE];
DO
arg: ROPE ¬ CommanderOps.NextArgument[cmd ! CommanderOps.Failed => { msg ¬ errorMsg; GO TO failed } ];
When parsing the command line, be prepared for failure. The error is reported to the user
ch: CHAR;
Process.CheckForAbort[];
IF arg = NIL THEN EXIT;
ch ¬ Rope.Fetch[arg, 0];
SELECT TRUE FROM
( ch = '- ) AND ( arg.Length[] = 2 ) => ProcessSwitches[arg]; -- switch
( ch = '{ ) => LOOP; -- ignore
( ch = '} ) => LOOP; -- ignore
( ch = '$ ) => LOOP; -- ignore
ENDCASE => fileNamesFile ¬ arg -- translations or other things
ENDLOOP;
IF outFileName = NIL THEN outFileName ¬ "UserProfileEntryDefaults.tioga";
DoIt[fileNamesFile, table, cmd.out, outFileName
! PFS.Error => {
cmd.out.PutF["-- PFS.Error[%g] - quitting.\n\t\t(at %g)\n\n", [rope[error.explanation]], [time[BasicTime.Now[]]] ];
CONTINUE;
};
];
EXITS
failed => {result ¬ $Failure};
};
Initialization
docRope: ROPE ~ "DefaultUserProfileEntries {-o|-a fileName} shortFileNamesFile";
Commander.Register[ key: "DefaultUserProfileEntries", proc: DefaultUserProfileEntries, doc: docRope];
END.