File: DBIconsImpl.mesa
-- Edited by Teitelman on July 18, 1984 9:12:44 am PDT
-- Edited by: Donahue, December 28, 1984 1:24:58 pm PST
(Changed treatment of startup to avoid opening database until necessary)
(Changed ticksToWait to be 60 -- close transaction quicker if no activity)
(Added TransOpened CONDITION variable to stop looping when transaction closed)compile
-- Last Edited by: Widom, August 8, 1984 9:14:17 pm PDT
DIRECTORY
FS USING [Error, StreamOpen],
Booting USING [CheckpointProc, RegisterProcs, RollbackProc],
Convert USING [RopeFromCard],
DB,
DBIcons,
IO,
Basics USING[LowHalf],
IOClasses USING [CreateCommentFilterStream ],
DBNames USING[ EntityToName, MakeName],
Icons USING [NewIconFromFile, IconFlavor],
List USING[ DotCons, DottedPair, AList ],
MessageWindow USING [Append, Blink],
Process USING[Ticks, SecondsToTicks, Pause, Detach],
UserCredentials,
VM USING [AddressFault],
Rope USING [Cat, Equal, ROPE],
UserProfile
;
DBIconsImpl: CEDAR MONITOR
IMPORTS Basics, Booting, DBNames, FS, Convert, IO, MessageWindow, VM, Process,
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 (the other attributes are treated as properties)
iconCache: List.AList ← NIL; -- the internal cache of mappings from icon names to flavors
IconDB: PUBLIC ROPE ← NIL;
pendingChange: BOOL ← FALSE; -- this is set by the rollback and credentials change procs to remember a potential change of state; it is checked by CarefullyApply, which will call ResetSchema if it is true
readOnly: PUBLIC BOOLEAN ← TRUE; -- true if the segment is readonly
iconTrans: DB.Transaction;
activity: BOOLEAN ← FALSE; -- true if a database operation has been performed recently
ticksToWait: Process.Ticks ← Process.SecondsToTicks[60];
transOpened: CONDITION;
Establishing the database
EstablishIconDB: PUBLIC ENTRY PROC [file: Rope.ROPE ← NIL] = {
ENABLE UNWIND => NULL;
IconDB ← IF file = NIL THEN
UserProfile.Token[key: "Icons.Segment", default: "[Luther.Alpine]<CedarDoc>Icons.Segment"] ELSE file;
pendingChange ← TRUE };
WatchDBActivity: PROC[] = {
WHILE TRUE DO
Process.Pause[ticksToWait];
CheckConnection[]
ENDLOOP
};
CheckConnection: ENTRY PROC[] = {
ENABLE UNWIND => NULL;
IF NOT activity THEN {
CloseTransaction[]; -- don't keep the connection open too long
WAIT transOpened };
activity ← FALSE;
};
Close: PUBLIC ENTRY PROC [] = { CloseTransaction[] };
CloseTransaction: INTERNAL PROC [] = {
caughtAborted: BOOL ← FALSE;
IF iconTrans # NIL THEN
DB.CloseTransaction[iconTrans ! DB.Aborted => { caughtAborted ← TRUE; CONTINUE }];
IF caughtAborted THEN DB.AbortTransaction[iconTrans];
iconTrans ← 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};
{ fileName: ROPE = V2S[ GetF[iconRelship, IconFileAttr] ];
index: CARDINAL = Basics.LowHalf[LOOPHOLE[V2I[GetF[iconRelship, IconIndexAttr]]]];
flavor ← Icons.NewIconFromFile[fileName, index !
    FS.Error =>
     IF default # unInit THEN flavor ← default
     ELSE ERROR Failed[fileNotFound, fileName];
   VM.AddressFault =>
     IF default # unInit THEN flavor ← default
     ELSE ERROR
     Failed[invalidIndex, Convert.RopeFromCard[index]]]; -- NewIconFromFile raises this if given badindex.
} };
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]
};
****************** setting/getting icons for entities ****************

-- works for Entities or Domains
SetIcon: PUBLIC PROCEDURE[e: Entity, iconFile: ROPE, fileIndex: CARDINAL] =
BEGIN
name: ROPE = IF DB.IsSystemEntity[e] THEN DB.NameOf[e]
     ELSE DBNames.EntityToName[e, DB.SegmentOf[e]];
  IF IsRegistered[name].file = NIL THEN
  RegisterIcon[ name, iconFile, fileIndex ]
END;
acorn: Icons.IconFlavor = Icons.NewIconFromFile["DB.Icons", 0];
GetIconNameForEntity: PUBLIC ENTRY PROC[eName, domain: ROPE, segment: DB.Segment] RETURNS [name: Rope.ROPE] = {
ENABLE UNWIND => NULL;
IF eName = NIL OR domain = NIL OR segment = NIL THEN RETURN["Acorn"];
IF Rope.Equal[domain, "Domain"] THEN RETURN["Acorn"];
BEGIN
fullName: ROPE = DBNames.MakeName[segment, domain, eName];
DoCheck: INTERNAL PROC[] = {
name ← InternalCheckRegistry[fullName].fileName;
IF InternalCheckRegistry[fullName].fileName # NIL THEN name ← fullName
ELSE IF InternalCheckRegistry[domain].fileName # NIL THEN name ← domain
ELSE name ← "Acorn" };
IF NOT CarefullyApply[DoCheck] THEN name ← NIL
END
};
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]]]] } };
GetIconForEntity: PUBLIC ENTRY PROC[eName, domain: ROPE, segment: DB.Segment] RETURNS [Icons.IconFlavor] = {
ENABLE UNWIND => NULL;
IF eName = NIL OR domain = NIL OR segment = NIL THEN RETURN[acorn];
IF Rope.Equal[domain, "Domain"] THEN RETURN[InternalGetIcon[eName, acorn]];
BEGIN
icon: Icons.IconFlavor ← unInit;
fullName: ROPE = DBNames.MakeName[segment, domain, eName];
icon ← InternalGetIcon[fullName ! Failed => CONTINUE];
IF icon # unInit THEN RETURN[icon];
now try the name of the domain of the entity
RETURN[InternalGetIcon[domain, acorn]]
END
};
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[] = {
Acorn: Rope.ROPE = "Acorn";
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[Acorn, NEW[Icons.IconFlavor ← acorn]], iconCache];
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] }
};
IsRegistered: PUBLIC ENTRY PROC[iconName: Rope.ROPE ← NIL, fileName: Rope.ROPE ← NIL, index: CARDINAL ← LAST[CARDINAL]] RETURNS[name: Rope.ROPE, file: Rope.ROPE, i: CARDINAL] = {
Can be called with either iconName, or (fileName and index); does not force creation of icon flavor (only GetIcon does that).
ENABLE UNWIND => NULL;
DoRegisterCheck: INTERNAL PROC[] = {
IF iconName # NIL THEN {
[file, i] ← InternalCheckRegistry[iconName];
IF file = NIL THEN name ← NIL ELSE name ← iconName}
ELSE {
iconRels: RelshipSet = RelationSubset[IconRelation,
       LIST[AttributeValue[IconFileAttr, S2V[fileName]],
         AttributeValue[IconIndexAttr, U2V[index]]]];
iconRel: Relship = NextRelship[iconRels];
ReleaseRelshipSet[iconRels];
IF iconRel = NIL THEN{ file ← NIL; name ← NIL; i ← 0 }
ELSE
{ name ← V2S[GetF[iconRel, IconNameAttr]]; file ← fileName; i ← index } } };
IF NOT CarefullyApply[DoRegisterCheck] THEN RETURN[NIL, NIL, 0]
};
InvalidateCache: 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; -- 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;
{ ENABLE IO.EndOfStream => GOTO Out;
DO
DBNameProc: IO.BreakProc = {
just scan to a right paren (or be prepared to quit at a CR if you don't find one)
IF char = ') THEN RETURN[break];
RETURN[IF char = CR THEN break ELSE other] };
whiteSpace: IO.BreakProc = {
RETURN[
SELECT char FROM
CR => break,
IO.SP, IO.ESC, IO.LF, IO.TAB, ',, ':, '; => sepr,
ENDCASE => other ]
};
isACR: IO.BreakProc = {
RETURN[IF char = CR THEN break ELSE other]
};
tokenProc: IO.BreakProc = {
RETURN[SELECT char FROM
IO.SP, IO.TAB, ', => sepr,
IO.CR => break,
ENDCASE => other
];
};
iconName, fileName: Rope.ROPE;
index: CARDINAL;
[] ← IO.SkipWhitespace[stream];
IF stream.GetChar[] # '( THEN
{ error ← TRUE;
Report[msg: Rope.Cat["Transaction Aborted at: ",
Convert.RopeFromCard[stream.GetIndex[]]], errLog: errlog];
GOTO Out };
iconName ← IO.GetTokenRope[stream, DBNameProc].token;
IF stream.GetChar[] # ') THEN
{ error ← TRUE;
Report[msg: Rope.Cat["Transaction Aborted at: ",
Convert.RopeFromCard[stream.GetIndex[]]], errLog: errlog];
GOTO Out };
[] ← IO.SkipWhitespace[stream]; -- skip any intervening whitespace
fileName ← IO.GetTokenRope[stream, whiteSpace].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[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
OpenUp: ENTRY Booting.RollbackProc = {
DB.Initialize[nCachePages: 256] };
CloseTrans: ENTRY Booting.CheckpointProc = { CloseTransaction[] };
NewUserReset: ENTRY UserCredentials.CredentialsChangeProc = { CloseTransaction[] };
ProfileChangeReset: ENTRY UserProfile.ProfileChangedProc = {
newIconDB: ROPE = UserProfile.Token[key: "Icons.Segment", default: "[Luther.Alpine]<CedarDoc>Icons.segment"];
IF NOT Rope.Equal[IconDB, newIconDB] THEN {
don't open up the new database yet; simply remember that it must be done
IconDB ← newIconDB;
pendingChange ← TRUE } };
ResetSchema: INTERNAL PROC[changingDBs: BOOL] = {
IF pendingChange THEN {
CloseTransaction[];
InternalInvalidateCache[];
SetDefaultIcons[] };
IF iconTrans # NIL THEN RETURN;
IF NOT SetUpSegment[] THEN RETURN;
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]] };
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.TransactionOf[$Icons]] };
CarefullyApply: INTERNAL PROC [proc: PROC[]] RETURNS [succeeded: BOOL] ~ {
ENABLE DB.Error, DB.Failure, DB.Aborted => {succeeded ← FALSE; GOTO Quit};
if there is a pending change of databases, then reset things before trying the operation
ResetSchema[changingDBs: pendingChange];
pendingChange ← FALSE;
activity ← TRUE;
succeeded ← TRUE;
proc[ ! DB.Aborted => { succeeded ← FALSE; CONTINUE } ];
IF succeeded THEN RETURN; -- no aborted occurred
DB.AbortTransaction[iconTrans];
ResetSchema[changingDBs: FALSE];
proc[]; -- don't bother trying to restart here --
succeeded ← TRUE;
EXITS
Quit => NULL;
};
SetUpSegment: INTERNAL PROC[] RETURNS [success: BOOL] ~ {
ENABLE DB.Aborted, DB.Failure, DB.Error => {success ← FALSE; CONTINUE};
segment: ATOM = $Icons;
segmentNumber: NAT = 140B;
readOnly ← FALSE;
success ← TRUE;
DB.Initialize[nCachePages: 256];
DB.DeclareSegment[IconDB, segment, segmentNumber, FALSE];
DB.OpenTransaction[segment !
DB.Error => TRUSTED {
success ← FALSE;
IF code = ProtectionViolation THEN CONTINUE ELSE GOTO AlreadyDone } ];
IF NOT success THEN {
attempt to open for writing failed; open it for reading only
DB.CloseTransaction[DB.TransactionOf[segment]];
DB.DeclareSegment[IconDB, segment, segmentNumber, TRUE, FALSE];
DB.OpenTransaction[segment];
success ← TRUE };
readOnly ← DB.GetSegmentInfo[segment].readOnly;
iconTrans ← DB.GetSegmentInfo[segment].trans;
NOTIFY transOpened -- start up the watch dog process again to try to shut it down
EXITS
AlreadyDone => NULL
};
Initialization
TRUSTED {
Booting.RegisterProcs[c: CloseTrans, r: OpenUp];
EstablishIconDB[];
Process.Detach[ FORK WatchDBActivity[] ];
UserCredentials.RegisterForChange[NewUserReset];
UserProfile.CallWhenProfileChanges[ProfileChangeReset]
};
END.