File: DBIconsImpl.mesa
Edited by Teitelman on July 18, 1984 9:12:44 am PDT
Copyright © 1985 by Xerox Corporation. All rights reserved.
Edited by: Donahue, June 17, 1985 9:01:18 am PDT
Last Edited by: Widom, August 8, 1984 9:14:17 pm PDT
DIRECTORY
Atom,
FS USING [Error, StreamOpen],
Convert USING [RopeFromCard, RopeFromRope],
DB,
DBIcons,
IO,
Basics USING[LowHalf],
FileNames USING[CurrentWorkingDirectory],
IOClasses USING [CreateCommentFilterStream ],
Icons USING [NewIconFromFile, IconFlavor],
List USING[ DotCons, DottedPair, AList ],
MessageWindow USING [Append, Blink],
Process,
ProcessProps USING[ AddPropList ],
VM USING [AddressFault],
Rope USING [Cat, Equal, ROPE],
UserCredentials USING[Get, CredentialsChangeProc, RegisterForChange],
UserProfile
;
DBIconsImpl: CEDAR MONITOR
IMPORTS Basics, FS, FileNames, Convert, IO, MessageWindow, Process, ProcessProps, VM, Rope, Icons, DB, List, UserCredentials, UserProfile, IOClasses
EXPORTS DBIcons
= BEGIN
OPEN DB, Rope;
Types
Failed: PUBLIC ERROR [why: DBIcons.Failure, reason: Rope.ROPE] = CODE;
ROPE: TYPE = Rope.ROPE;
Global variables for accessing the database
IconRelation: DB.Relation; -- the relation giving the properties of an icon
The tuples in the relation have the structure
IconRelation[ IconNameAttr: ROPE, IconFileAttr: ROPE, IconIndexAttr: INT ]
IconFileAttr: DB.Attribute; -- the name of the file for an icon
IconIndexAttr: DB.Attribute; -- the index in the file
IconNameAttr: DB.Attribute; -- the icon itself
iconCache: List.AList ← NIL; -- the internal cache of mappings from icon names to flavors
searchRuleList: LIST OF Rope.ROPE;
IconDB: PUBLIC ROPE ← NIL;
iconTransaction: DB.Transaction;
activity: BOOL ← TRUE;
ticksToWait: Process.Ticks ← Process.SecondsToTicks[5*60];
readOnly: PUBLIC BOOLEAN ← TRUE; -- true if the segment is readonly
defaultDatabase: PUBLIC ROPE ← "[Luther.Alpine]<CedarDoc>Icons.Segment";
workingDirectory: Rope.ROPE ← FileNames.CurrentWorkingDirectory[];
myProps: Atom.DottedPair ← NEW[Atom.DottedPairNode ← [key: $WorkingDirectory, val: workingDirectory]];
Establishing the database
WatchDBActivity: PROC[] = {
WHILE TRUE DO
Process.Pause[ticksToWait];
CheckConnection[]
ENDLOOP
};
CheckConnection: ENTRY PROC[] = {
ENABLE UNWIND => NULL;
IF NOT activity THEN CloseTransaction[];
activity ← FALSE };
EstablishIconDB: PUBLIC ENTRY PROC [file: Rope.ROPE ← NIL] = {
ENABLE UNWIND => NULL;
IconDB ← IF file = NIL THEN
UserProfile.Token[key: "Icons.Segment", default: defaultDatabase] ELSE file;
OpenDB[] };
OpenTransaction: INTERNAL PROC [] = {
IF iconTransaction = NIL THEN DB.OpenTransaction[$Icons];
iconTransaction ← DB.GetSegmentInfo[$Icons].trans };
Close: PUBLIC ENTRY PROC [] = { CloseTransaction[] };
CloseTransaction: INTERNAL PROC [] = {
aborted: BOOL ← FALSE;
IF iconTransaction # NIL THEN
DB.CloseTransaction[iconTransaction ! DB.Aborted => { aborted ← TRUE; CONTINUE }];
IF aborted THEN DB.AbortTransaction[iconTransaction];
iconTransaction ← NIL };
Accessing Icons
RegisterIcon: PUBLIC ENTRY PROC[iconName: Rope.ROPE, fileName: Rope.ROPE, index: CARDINAL] = {
Changes RegisteredIcons.Catalogue to reflect the indicated association. This definition will replace any previous definition. comments are for inclusion in the catalogue to help the user figure out what the icon looks like.
ENABLE UNWIND => NULL;
[] ← InternalRegisterIcon[iconName, fileName, index]
};
GetIcon: PUBLIC ENTRY PROC [iconName: Rope.ROPE, default: Icons.IconFlavor ← unInit] RETURNS [Icons.IconFlavor] = {
ENABLE UNWIND => NULL;
RETURN[InternalGetIcon[iconName, default]];
};
InternalGetIcon: INTERNAL PROC[iconName: Rope.ROPE, default: Icons.IconFlavor ← unInit] RETURNS [Icons.IconFlavor] = {
Obtain an icon flavor for the icon associated with iconName. Create a new icon flavor if one has not previously been created.
If for some reason it could not obtain the icon, and default # unInit, returns the default. Otherwise, raises Error (defined below) with appropriate parameters.
cachedFlavor: REF ANY = CheckCache[iconName];
flavor: Icons.IconFlavor ← unInit;
success: BOOL;
DoGetIcon: PROC[] = {
attributeValue: DB.AttributeValue = [attribute: IconNameAttr, lo: S2V[iconName]];
iconRelship: DB.Relship = DeclareRelship[IconRelation, LIST[attributeValue], OldOnly];
IF iconRelship = NIL THEN {flavor ← default; RETURN};
BEGIN
fileName: ROPE = V2S[ GetF[iconRelship, IconFileAttr] ];
index: CARDINAL = Basics.LowHalf[LOOPHOLE[V2I[GetF[iconRelship, IconIndexAttr]]]];
FetchIcon: PROC[] = {
flavor ← Icons.NewIconFromFile[fileName, index !
VM.AddressFault =>
IF default # unInit THEN flavor ← default
ELSE ERROR Failed[invalidIndex, Convert.RopeFromCard[index]];
FS.Error => ERROR Failed[fileNotFound, fileName]] };
ProcessProps.AddPropList[LIST[myProps], FetchIcon]
END };
IF cachedFlavor # NIL THEN RETURN[NARROW[cachedFlavor, REF Icons.IconFlavor]^];
IF IconDB = NIL THEN RETURN[default];
success ← CarefullyApply[DoGetIcon];
IF NOT success THEN RETURN[default];
IF flavor # unInit THEN {
iconCache ← Cache[List.DotCons[iconName, NEW[Icons.IconFlavor ← flavor]], iconCache];
RETURN[flavor] };
IF default # unInit THEN RETURN[default];
ERROR Failed[noSuchIcon, iconName]
};
InternalCheckRegistry: INTERNAL PROC[name: ROPE] RETURNS[fileName: ROPE, i: CARDINAL] = {
attributeValue: DB.AttributeValue = [attribute: IconNameAttr, lo: S2V[name]];
iconRelship: DB.Relship = DeclareRelship[IconRelation, LIST[attributeValue], OldOnly];
IF iconRelship = NIL THEN { fileName ← NIL; i ← 0 }
ELSE {
fileName ← V2S[ GetF[ iconRelship, IconFileAttr ] ];
i ← Basics.LowHalf[LOOPHOLE[V2I[GetF[iconRelship, IconIndexAttr]]]] } };
Cache: INTERNAL PROC[ pair: List.DottedPair, aList: List.AList ] RETURNS[ List.AList ] = {
x, x1: List.AList ← NIL;
x ← aList;
UNTIL x = NIL DO
IF Rope.Equal[NARROW[x.first.key, ROPE], NARROW[pair.key, ROPE]] THEN
BEGIN
x.first.val ← pair.val;
RETURN[aList];
END;
x1←x;
x ← x.rest;
ENDLOOP;
key not found on x
x ← CONS[pair, NIL];
IF x1 = NIL THEN RETURN[x]
ELSE IF x1.rest = NIL THEN x1.rest ← x -- add at end
ELSE ERROR ; -- defensive programming
RETURN[aList];
};
CheckCache: INTERNAL PROC[name: Rope.ROPE] RETURNS[ val: REF ANY ] = {
FOR iconList: List.AList ← iconCache, iconList.rest UNTIL iconList = NIL DO
IF Rope.Equal[NARROW[iconList.first.key, Rope.ROPE], name] THEN RETURN[iconList.first.val]
ENDLOOP;
RETURN[NIL] };
SetDefaultIcons: INTERNAL PROC[] = {
Typescript: Rope.ROPE = "Typescript";
Document: Rope.ROPE = "Document";
Tool: Rope.ROPE = "Tool";
the test is here to make the operation idempotent
IF CheckCache["Tool"] = NIL THEN {
iconCache ← CONS[List.DotCons[Typescript, NEW[Icons.IconFlavor ← Icons.IconFlavor[typescript]]], iconCache];
iconCache ← CONS[List.DotCons[Document, NEW[Icons.IconFlavor ← Icons.IconFlavor[document]]], iconCache];
iconCache ← CONS[List.DotCons[Tool, NEW[Icons.IconFlavor ← Icons.IconFlavor[tool]]], iconCache] }
};
Exists: PUBLIC ENTRY PROC[name: Rope.ROPE] RETURNS[yes: BOOLEAN] = {
ENABLE UNWIND => NULL;
DoCheck: INTERNAL PROC[] = { yes ← InternalCheckRegistry[name].fileName # NIL };
yes ← FALSE; [] ← CarefullyApply[DoCheck] };
Registration: PUBLIC ENTRY PROC[iconName: Rope.ROPE] RETURNS[file: Rope.ROPE, index: CARDINAL] = {
ENABLE UNWIND => NULL;
DoRegisterCheck: INTERNAL PROC[] = { [file, index] ← InternalCheckRegistry[iconName] };
IF NOT CarefullyApply[DoRegisterCheck] THEN RETURN[NIL, 0] };
FlushCache: PUBLIC ENTRY PROC [iconName: Rope.ROPE ← NIL] = {
If an iconFlavor was previous created for this icon, discard the flavor, i.e. the next call to GetIcon will create a new flavor. If iconName = NIL, do this for all registered icons. For use by iconeditor.
ENABLE UNWIND => NULL;
IF iconName = NIL THEN InternalInvalidateCache[]
ELSE iconCache ← Cache[ List.DotCons[iconName, NIL], iconCache ]
};
InternalInvalidateCache: INTERNAL PROC [] = {
Throw the entire cache away.
iconCache ← NIL };
InternalRegisterIcon: INTERNAL PROC[iconName: Rope.ROPE, fileName: Rope.ROPE, index: CARDINAL] RETURNS[success: BOOLEAN] = {
DoRegisterIcon: PROC[] = {
attributeValue: DB.AttributeValue = [IconNameAttr, iconName];
iconRel: Relship = DeclareRelship[IconRelation, LIST[attributeValue]];
SetF[iconRel, IconFileAttr, S2V[fileName]];
SetF[iconRel, IconIndexAttr, U2V[index]] };
IF readOnly OR IconDB = NIL THEN RETURN[FALSE];
can't register things in this segment
success ← CarefullyApply[DoRegisterIcon]
};
Parsing Icon Catalogues
Parse: INTERNAL PROCEDURE[ stream: IO.STREAM, errlog: IO.STREAM ] = {
OPEN IO;
error: BOOLEAN ← FALSE;
iconName, fileName: Rope.ROPE;
index: CARDINAL;
{ ENABLE IO.EndOfStream => GOTO Out;
DO
iconName ← IO.GetRopeLiteral[stream];
fileName ← IO.GetTokenRope[stream, IO.IDProc].token;
index ← IO.GetCard[stream];
IF NOT InternalRegisterIcon[iconName, fileName, index] THEN
{ error ← TRUE;
Report[msg: Rope.Cat["Transaction Aborted at: ",
Convert.RopeFromCard[stream.GetIndex[]]], errLog: errlog];
GOTO Out }
ENDLOOP;
EXITS
Out => NULL;
};
IF error THEN {
MessageWindow.Append["problems encountered in reading icon file."];
MessageWindow.Blink[];
IF errlog # NIL THEN errlog.Close[];
};
};
WriteCatalogue: PUBLIC ENTRY PROC [file: Rope.ROPE] = {
ENABLE UNWIND => NULL;
stream: IO.STREAM;
InternalWrite: PROC[] = {
OPEN IO;
iconRels: RelshipSet = RelationSubset[IconRelation];
FOR r: Relship ← NextRelship[iconRels], NextRelship[iconRels] UNTIL r = NIL DO
fileName: ROPE = V2S[ GetF[IconFileAttr, IconFileAttr] ];
iconName: ROPE = V2S[ GetF[IconFileAttr, IconNameAttr] ];
index: CARDINAL = Basics.LowHalf[LOOPHOLE[V2I[GetF[r, IconIndexAttr]]]];
stream.PutF["\n%g %g %d", rope[Convert.RopeFromRope[iconName]], rope[fileName], int[index]];
ENDLOOP;
stream.Close[] };
stream ← FS.StreamOpen[file, $append ! FS.Error => {stream ← NIL; CONTINUE}];
IF stream # NIL THEN [] ← CarefullyApply[InternalWrite]
};
Reporting errors
Report: INTERNAL PROCEDURE [msg: Rope.ROPE, errLog: IO.STREAM] = {
OPEN IO;
IF errLog # NIL THEN errLog.PutF["\n\n%g", rope[msg]];
};
Opening, closing segment, making/reading catalogue
ProfileChangeReset: ENTRY UserProfile.ProfileChangedProc = {
newIconDB: ROPE = UserProfile.Token[key: "Icons.Segment", default: defaultDatabase];
IF NOT Rope.Equal[IconDB, newIconDB] THEN {
IconDB ← newIconDB; CloseTransaction[] } };
UserChanged: ENTRY UserCredentials.CredentialsChangeProc = {
user: Rope.ROPE = UserCredentials.Get[].name;
searchRuleList ← LIST["///Commands/", Rope.Cat["///Users/", user, "/Commands/"]] };
ResetSchema: INTERNAL PROC[] = {
OpenTransaction[];
IF NOT DB.Null[IconRelation] THEN RETURN; -- all is well, don't bother flushing cache
IconRelation ← DeclareRelation[ "IconInfo", $Icons ];
IconFileAttr ← DeclareAttribute[IconRelation, "file", RopeType];
IconIndexAttr ← DeclareAttribute[IconRelation, "index", IntType];
IconNameAttr ← DeclareAttribute[IconRelation, "name", RopeType, Key];
[] ← DeclareIndex[IconRelation, LIST[IconNameAttr]];
InternalInvalidateCache[];
SetDefaultIcons[] };
ReadCatalogue: PUBLIC ENTRY PROC[file: Rope.ROPE, errlog: IO.STREAM ← NIL] = TRUSTED {
ENABLE UNWIND => NULL;
stream: IO.STREAM;
stream ← FS.StreamOpen[file ! FS.Error => { stream ← NIL; CONTINUE }];
IF stream = NIL THEN RETURN;
stream ← IOClasses.CreateCommentFilterStream[stream];
Parse[ stream, errlog ];
DB.MarkTransaction[DB.GetSegmentInfo[$Icons].trans] };
CarefullyApply: INTERNAL PROC [proc: PROC[]] RETURNS [succeeded: BOOL] ~ {
ENABLE DB.Error, DB.Failure, DB.Aborted => {succeeded ← FALSE; CONTINUE};
aborted: BOOL ← FALSE;
succeeded ← TRUE;
BEGIN
ENABLE DB.Aborted => { aborted ← TRUE; CONTINUE };
ResetSchema[];
proc[]
END;
IF NOT aborted THEN RETURN; -- no aborted occurred
DB.AbortTransaction[iconTransaction];
ResetSchema[];
proc[]; -- don't bother trying to restart here --
};
OpenDB: INTERNAL PROC [] ~ {
ENABLE DB.Aborted, DB.Failure, DB.Error => {CONTINUE};
segmentNumber: NAT = 140B;
readOnly ← FALSE;
DB.Initialize[nCachePages: 256];
DB.DeclareSegment[IconDB, $Icons, segmentNumber, FALSE];
this is a crock to see if the database really can be written to; you need to actually open a transaction to find this out
OpenTransaction[! DB.Error =>
TRUSTED {IF code = ProtectionViolation THEN { readOnly ← TRUE; CONTINUE }
ELSE GOTO AlreadyDone } ];
IF readOnly THEN {
attempt to open for writing failed; declare it for reading only
CloseTransaction[];
DB.DeclareSegment[IconDB, $Icons, segmentNumber, TRUE, FALSE] }
ELSE CloseTransaction[] -- throw away this worthless transaction
EXITS
AlreadyDone => CloseTransaction[! DB.Error, DB.Failure => CONTINUE]
};
Initialization
TRUSTED {
EstablishIconDB[];
UserProfile.CallWhenProfileChanges[ProfileChangeReset];
UserCredentials.RegisterForChange[UserChanged];
searchRuleList ← LIST["///Commands/", Rope.Cat["///Users/", UserCredentials.Get[].name, "/Commands/"]];
Process.Detach[FORK WatchDBActivity[]]
};
END.