DBIconsImpl.mesa;
Edited by Teitelman on April 12, 1983 4:53 pm
Last Edited by: Donahue, May 26, 1983 9:17 am
DIRECTORY
AMEvents USING [Debugging, Debugged],
CIFS USING [Error],
CedarSnapshot USING [CheckpointProc, Register, RollbackProc, After],
Convert USING [Value, ValueToRope],
DB,
DBNames,
Directory USING[Lookup, ignore, Error, GetProps],
File USING[ Capability ],
IO USING [GetCard, EndOfStream, Close, CR, CreateFilterCommentsStream, GetChar, GetIndex, int, PeekChar, PutF, rope, STREAM, time, TAB, SP, GetToken, SkipOver, TokenProc, BreakProc, WhiteSpace, GreenwichMeanTime, CharProc, GetSequence],
DBIcons USING [Failure],
Icons USING [NewIconFromFile, IconFlavor],
FileIO USING [Open, StreamFromCapability, OpenFailed],
MessageWindow USING [Append, Blink],
PageFault USING [AddressFault],
Process USING [Detach],
Rope USING [Cat, Equal, ROPE, ToRefText],
System USING[ GreenwichMeanTime, GetGreenwichMeanTime ],
ViewerClasses USING [Viewer],
ViewerEvents USING [EventProc, RegisterEventProc],
ViewerOps USING [FindViewer, RestoreViewer]
;
DBIconsImpl: CEDAR MONITOR
IMPORTS AMEvents, CedarSnapshot, CIFS, Convert, FileIO, IO, MessageWindow, PageFault, Process, Rope, Icons, ViewerEvents, ViewerOps, DB, DBNames, Directory, System
EXPORTS DBIcons
= BEGIN
OPEN DB, Rope;
Types
Failed: PUBLIC ERROR [why: DBIcons.Failure, reason: Rope.ROPE] = CODE;
Global variables for accessing the database
IconDomain: DB.Domain; -- the domain of icons
IconRelation: DB.Relation; -- the relation giving the properties of an icon
The tuples in the relation have the structure
IconRelation[ IconIsAttr: IconDomain, IconFileAttr: ROPE, IconIndexAttr: INT, IconFlavorAttr: Icons.IconFlavor ] (where the flavor is stored as an UNSPECIFIED)
IconFileAttr: DB.Attribute; -- the name of the file for an icon
IconIndexAttr: DB.Attribute; -- the index in the file
IconIsAttr: DB.Attribute; -- the icon itself (the other attributes are treated as properties)
IconFlavorAttr: DB.Attribute; -- the flavor of the icon (this is somewhat tricky)
IconDBInfo: DB.Relation; -- the information about the creation of the database
The tuple in the relation have the structure
IconDBInfo[ IconDBTime: Time ] (there is only one tuple in this relation)
IconDBTime: DB.Attribute; -- the last time of a parse (to make sure the DB is consistent with the catalogue; the DB may well be an extension of the parse)
Accessing Icon Catalogue
RegisterIcon: PUBLIC ENTRY PROC [iconName: Rope.ROPE, fileName: Rope.ROPE, index: CARDINAL, saveInCatalogue: BOOL ← FALSE] = {
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.
InternalRegisterIcon[ iconName, fileName, index ];
IF saveInCatalogue THEN WriteEntry[iconName, fileName, index];
DB.MarkTransaction[DB.TransactionOf[$Icons]]
};
GetIcon: PUBLIC 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.
icon: Entity = DeclareEntity[IconDomain, iconName, OldOnly];
IF icon # NIL THEN
{ flavor: Icons.IconFlavor ← V2U[ GetP[ icon, IconFlavorAttr, IconIsAttr ] ];
fileName: ROPE = V2S[ GetP[ icon, IconFileAttr, IconIsAttr ] ];
index: CARDINAL = V2U[ GetP[ icon, IconIndexAttr, IconIsAttr ] ];
IF flavor = unInit THEN 
{ flavor ← Icons.NewIconFromFile[fileName, index !
    CIFS.Error =>
     IF code # noSuchFile THEN REJECT
     ELSE IF default = unInit THEN GOTO Default
     ELSE ERROR Failed[fileNotFound, fileName];
   PageFault.AddressFault =>
     IF default # unInit THEN GOTO Default
     ELSE ERROR
     Failed[invalidIndex, Convert.ValueToRope[[signed[index]]]];
       ]; -- NewIconFromFile raises this if given badindex.
[] ← SetP[ icon, IconFlavorAttr, U2V[flavor], IconIsAttr ] };
RETURN[flavor];
};
IF default # unInit THEN GOTO Default;
ERROR Failed[noSuchIcon, iconName];
EXITS
Default => RETURN[default];
};
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).
IF iconName # NIL THEN
{ icon: Entity = DeclareEntity[IconDomain, iconName, OldOnly];
  IF icon = NIL THEN RETURN[NIL, NIL, 0];
 { file ← V2S[ GetP[ icon, IconFileAttr, IconIsAttr ] ];
  i ← V2U[ GetP[ icon, IconIndexAttr, IconIsAttr ] ] } }
ELSE
{iconRels: RelshipSet = RelationSubset[IconRelation,
       LIST[AttributeValue[IconFileAttr, S2V[file]],
         AttributeValue[IconIndexAttr, U2V[index]]]];
iconRel: Relship = NextRelship[iconRels];
IF iconRel = NIL THEN
{ ReleaseRelshipSet[iconRels]; RETURN[NIL, NIL, 0] };
name ← DB.NameOf[V2E[GetF[iconRel, IconIsAttr]]];
file ← fileName;
i ← index;
ReleaseRelshipSet[iconRels] }
};
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.
icons: EntitySet = DomainSubset[ IconDomain, iconName ];
FOR e: Entity ← NextEntity[icons], NextEntity[icons] UNTIL e = NIL DO
[] ← SetP[ e, IconFlavorAttr, U2V[Icons.IconFlavor[unInit]], IconIsAttr ]
ENDLOOP;
ReleaseEntitySet[ icons ];
DB.MarkTransaction[DB.TransactionOf[$Icons]]
};
InternalRegisterIcon: INTERNAL PROC[ iconName: Rope.ROPE, fileName: Rope.ROPE, index: CARDINAL ] = {
icon: DB.Entity = DeclareEntity[IconDomain, iconName];
avList: AttributeValueList =
LIST[AttributeValue[IconIsAttr, icon],
AttributeValue[IconFileAttr, S2V[fileName]],
AttributeValue[IconIndexAttr, U2V[index]]];
[] ← DeclareRelship[ IconRelation, avList ];
[] ← SetP[ icon, IconFlavorAttr, U2V[Icons.IconFlavor[unInit]], IconIsAttr ]
};
Parsing Icon Catalogue
catalogueName: Rope.ROPE ← "DBIcons.Catalogue";
catalogueCap: File.Capability;
Parse: INTERNAL PROCEDURE = {
OPEN IO;
stream: IO.STREAM;
{
ENABLE {
Failed => REJECT;
IO.EndOfStream => GOTO Out;
ANY => GOTO Out;
};
stream ← CreateFilterCommentsStream[FileIO.StreamFromCapability[ 
    fileName: catalogueName, capability: catalogueCap,
    accessOptions: read ! FileIO.OpenFailed =>
    ERROR Failed[noCatalogue, catalogueName]]];
DO
sepCount: INT;
DBNameProc: IO.CharProc = {
find a colon after seeing zero or two separators (one for the domain,
one for the segment
IF char = DBNames.Separator THEN
{ sepCount ← sepCount+1; RETURN[FALSE, TRUE] };
IF char = ': AND (sepCount = 2 OR sepCount = 0) THEN
RETURN[TRUE, FALSE];
RETURN[FALSE, TRUE] };
whiteSpace: IO.BreakProc = {
RETURN[IF char = CR THEN break ELSE IO.WhiteSpace[char]]
};
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;
position: INT;
IO.SkipOver[stream, IO.WhiteSpace];
position ← stream.GetIndex[];
sepCount ← 0;
iconName ← IO.GetSequence[stream, DBNameProc];
-- see if key is followed by a :
IO.SkipOver[stream, whiteSpace]; -- skips over spaces, tabs, but stops at CR
IF stream.PeekChar[] # ': THEN {
IO.SkipOver[stream, isACR];
Report1[msg: Rope.Cat["missing : at [", Convert.ValueToRope[[signed[position]]], "]"]];
LOOP;
};
[] ← stream.GetChar[]; -- the :
IO.SkipOver[stream, whiteSpace];
fileName ← IO.GetToken[stream, tokenProc];
index ← IO.GetCard[stream];
InternalRegisterIcon[ iconName, fileName, index ]
ENDLOOP;
EXITS
Out => NULL;
};
IF stream # NIL THEN stream.Close[];
IF errorLog # NIL THEN {
MessageWindow.Append["problems encountered, see IconRegistry.log."];
MessageWindow.Blink[];
errorLog.Close[];
errorLog ← NIL;
};
};
WriteEntry: INTERNAL PROC [iconName: Rope.ROPE, fileName: Rope.ROPE, index: CARDINAL] = {
OPEN IO;
viewer: ViewerClasses.Viewer;
stream: IO.STREAM ← FileIO.Open[fileName: catalogueName,
accessOptions: append, createOptions: oldOnly];
Write: PROC [iconName: Rope.ROPE, fileName: Rope.ROPE, index: CARDINAL] = {
stream.PutF["\n%g: %g %d", rope[iconName], rope[fileName], int[index]];
};
IF iconName # NIL THEN Write[iconName, fileName, index];
stream.Close[];
IF (viewer ← ViewerOps.FindViewer[catalogueName]) # NIL THEN ViewerOps.RestoreViewer[viewer];
};
WriteCatalogue: PUBLIC ENTRY PROC [] = {
icons: EntitySet = DomainSubset[ IconDomain];
FOR e: Entity ← NextEntity[icons], NextEntity[icons] UNTIL e = NIL DO
{ fileName: ROPE = V2S[ GetP[ e, IconFileAttr, IconIsAttr ] ];
index: CARDINAL = V2U[ GetP[ e, IconIndexAttr, IconIsAttr ] ];
WriteEntry[ DBNames.EntityToName[e], fileName, index ] }
ENDLOOP;
ReleaseEntitySet[icons]
};
Reporting errors
Report1: INTERNAL PROCEDURE [msg: Rope.ROPE] = {
OPEN IO;
ENABLE {
UNWIND, AMEvents.Debugging, AMEvents.Debugged => NULL;
ANY => CONTINUE;
};
IF errorLog = NIL THEN {
errorLog ← FileIO.Open[fileName: "IconRegistry.log", accessOptions: overwrite];
errorLog.PutF["Processing %g at %t", rope[catalogueName], time[]];
};
errorLog.PutF["\n\n%g", rope[msg]];
};
errorLog: IO.STREAM ← NIL;
When the Icon Catalogue changes
NoticeChanges: CedarSnapshot.RollbackProc = {
DB.Initialize[nCachePages: 256];
SetUpSegment[segmentFile: "[Local]Icons.segment", seg: $Icons, number: 140B];
IconDomain ← DeclareDomain["Icon", $Icons];
IconRelation ← DeclareRelation[ "IconInfo", $Icons ];
IconFileAttr ← DeclareAttribute[IconRelation, "file", StringType];
IconIndexAttr ← DeclareAttribute[IconRelation, "index", IntType];
IconIsAttr ← DeclareAttribute[IconRelation, "of", IconDomain, Key];
IconFlavorAttr ← DeclareAttribute[IconRelation, "flavor", IntType];
IconDBInfo ← DeclareRelation[ "IconDBInfo", $Icons ];
IconDBTime ← DeclareAttribute[IconDBInfo, "time", TimeType];
InvalidateCache[];
ParseCatalogue[]};
SetUpSegment: PROC[segmentFile: ROPE, seg: DB.Segment, number: NAT← 0] =
A foolproof way to open a segment & transaction, regardless of whether the segment is already declared, doesn't exist on the disk, or already has a transaction open.
{ success: BOOL← TRUE;
DB.DeclareSegment[segmentFile, seg, number ! DB.Error =>
{ IF code=TransactionAlreadyOpen THEN GOTO AlreadyDone }];
DB.OpenTransaction[seg ! DB.Error =>
{IF code=FileNotFound THEN success← FALSE; CONTINUE}];
IF NOT success THEN {
DB.CloseTransaction[DB.TransactionOf[seg]]; -- DB has left the transaction open
 DB.DeclareSegment[segmentFile, seg, number,, NewOnly];
DB.OpenTransaction[seg];
DB.MarkTransaction[DB.TransactionOf[seg]] };
EXITS
AlreadyDone => NULL };
CloseTrans: CedarSnapshot.CheckpointProc = {
DB.CloseTransaction[trans: DB.TransactionOf[segment: $Icons]] };
ParseCatalogue: ENTRY PROC = TRUSTED {
txt: REF TEXT = Rope.ToRefText[catalogueName];
name: LONG STRING = LOOPHOLE[txt];
failed: BOOLEAN ← FALSE;
iconDBInfo: RelshipSet = RelationSubset[ IconDBInfo ];
infoRel: Relation = NextRelship[iconDBInfo];
timeInDB: IO.GreenwichMeanTime = IF infoRel # NIL THEN 
            V2T[GetF[infoRel, IconDBTime]]
          ELSE System.GetGreenwichMeanTime[];
catalogueCap ← Directory.Lookup[fileName: name, permissions: Directory.ignore
! Directory.Error => {failed ← TRUE; CONTINUE}];
IF failed THEN { ReleaseRelshipSet[iconDBInfo];
     ERROR Failed[noCatalogue, catalogueName] };
{ createDate: IO.GreenwichMeanTime;
[, , createDate, , ] ← Directory.GetProps[file: catalogueCap, name: name];
IF createDate # timeInDB THEN Parse[];
IF infoRel = NIL THEN
SetF[ DeclareRelship[ IconDBInfo ], IconDBTime, T2V[createDate] ]
ELSE SetF[ infoRel, IconDBTime, T2V[createDate] ];
DB.MarkTransaction[ DB.TransactionOf[ $Icons ] ] };
ReleaseRelshipSet[iconDBInfo] };
WasCatalogueEdited: ViewerEvents.EventProc -- [viewer: ViewerClasses.Viewer, event: ViewerEvent] -- = {
IF Rope.Equal[viewer.name, catalogueName, FALSE] THEN
TRUSTED {Process.Detach[FORK ParseCatalogue[]]};
};
Initialization
[] ← ViewerEvents.RegisterEventProc[proc: WasCatalogueEdited, event: save, before: FALSE];
TRUSTED
{CedarSnapshot.Register[c: CloseTrans, r: NoticeChanges];
NoticeChanges[checkpoint]
};
END.