DBIconsImpl.mesa;
Edited by Teitelman on April 12, 1983 4:53 pm
Last Edited by: Donahue, August 11, 1983 2:28 pm
DIRECTORY
FS USING [Error, StreamOpen],
Booting USING [CheckpointProc, RegisterProcs, RollbackProc],
Convert USING [RopeFromCard],
DB,
IO,
IOClasses USING [CreateCommentFilterStream ],
DBIcons USING [Failure],
DBNames USING[ Separator ],
Icons USING [NewIconFromFile, IconFlavor],
List USING[ DotCons, DottedPair, AList ],
MessageWindow USING [Append, Blink],
Nut,
NutOps USING [SetUpSegment, Do],
VM USING [AddressFault],
Rope USING [Cat, Equal, ROPE],
ViewerClasses USING [Viewer],
UserProfile USING [ Token ]
;
DBIconsImpl: CEDAR MONITOR
IMPORTS Booting, FS, Convert, IO, MessageWindow, VM, Rope, Icons, DB, List, Nut, NutOps, UserProfile, DBNames, IOClasses
EXPORTS DBIcons
= BEGIN
OPEN DB, Rope;
Types
Failed: PUBLIC ERROR [why: DBIcons.Failure, reason: Rope.ROPE] = CODE;
RegisterArgs: TYPE = RECORD[ iconName: ROPE, fileName: ROPE, index: CARDINAL ];
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)
iconCache: List.AList ← NIL; -- the internal cache of mappings from icon names to flavors
IconDB: PUBLIC ROPE ← NIL;
readOnly: PUBLIC BOOLEAN ← TRUE; -- true if the segment is readonly
Establishing the database
EstablishIconDB: PUBLIC PROC [file: Rope.ROPE ← NIL] = {
IF file = NIL THEN
file ← UserProfile.Token[key: "Icons.Segment", default: "[Luther.Alpine]<CedarDoc>Icons.Segment"];
ResetSchema[ $Icons, file, open ] };
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.
DoRegisterIcon: PROC[ arg: REF ANY ] = {
icon: DB.Entity = DeclareEntity[IconDomain, iconName];
iconRel: Relship = DeclareRelship[ IconRelation, LIST[AttributeValue[IconIsAttr, icon]] ];
SetF[iconRel, IconFileAttr, S2V[fileName]];
SetF[iconRel, IconIndexAttr, U2V[index]] };
IF readOnly OR IconDB = NIL THEN RETURN; -- can't register things in this segment
IF NutOps.Do[DoRegisterIcon, NIL] THEN
DB.MarkTransaction[DB.TransactionOf[$Icons]]
};
GetIcon: PUBLIC ENTRY 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.
ENABLE UNWIND => NULL;
cachedFlavor: REF ANY = CheckCache[iconName, iconCache];
flavor: Icons.IconFlavor ← unInit;
DoGetIcon: PROC[ arg: REF ANY ] = {
iconName: ROPE = NARROW[ arg ];
icon: Entity = DeclareEntity[IconDomain, iconName, OldOnly];
IF icon = NIL THEN {flavor ← default; RETURN};
{ fileName: ROPE = V2S[ GetP[ icon, IconFileAttr, IconIsAttr ] ];
index: CARDINAL = V2U[ GetP[ icon, IconIndexAttr, IconIsAttr ] ];
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 ];
IF NOT NutOps.Do[DoGetIcon, iconName, TRUE] 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]
};
Cache: 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: PROC[ name: Rope.ROPE, in: List.AList ] RETURNS[ val: REF ANY ] = {
UNTIL in = NIL DO
IF Rope.Equal[NARROW[in.first.key, Rope.ROPE], name] THEN RETURN[in.first.val];
in ← in.rest;
ENDLOOP;
RETURN[NIL];};
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).
DoRegisterCheck: PROC[ arg: REF ANY ] =
{IF iconName # NIL THEN
{ icon: Entity = DeclareEntity[IconDomain, iconName, OldOnly];
IF icon = NIL THEN
{ file ← NIL; name ← NIL; i ← 0 }
ELSE
{ file ← V2S[ GetP[ icon, IconFileAttr, IconIsAttr ] ];
i ← V2U[ GetP[ icon, IconIndexAttr, IconIsAttr ] ] } }
ELSE
{iconRels: RelshipSet = RelationSubset[IconRelation,
       LIST[AttributeValue[IconFileAttr, S2V[fileName]],
         AttributeValue[IconIndexAttr, U2V[index]]]];
iconRel: Relship = NextRelship[iconRels];
IF iconRel = NIL THEN
{ ReleaseRelshipSet[iconRels];
file ← NIL; name ← NIL; i ← 0 }
ELSE
{ name ← DB.NameOf[V2E[GetF[iconRel, IconIsAttr]]];
file ← fileName;
i ← index;
ReleaseRelshipSet[iconRels] } } };
IF NOT NutOps.Do[ DoRegisterCheck, NIL ] 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.
IF iconName = NIL THEN iconCache ← NIL
ELSE iconCache ← Cache[ List.DotCons[iconName, NIL], iconCache ]
};
InternalRegisterIcon: INTERNAL PROC[ argList: REF ANY ] = {
args: REF RegisterArgs = NARROW[ argList ];
iconName: Rope.ROPE = args.iconName;
fileName: Rope.ROPE = args.fileName;
index: CARDINAL = args.index;
icon: DB.Entity = DeclareEntity[IconDomain, iconName];
iconRel: Relship = DeclareRelship[ IconRelation, LIST[AttributeValue[IconIsAttr, icon]] ];
SetF[iconRel, IconFileAttr, S2V[fileName]];
SetF[iconRel, IconIndexAttr, U2V[index]]
};
Parsing Icon Catalogues
Parse: INTERNAL PROCEDURE[ stream: IO.STREAM, errlog: IO.STREAM ] = {
OPEN IO;
error: BOOLEAN ← FALSE;
{ ENABLE IO.EndOfStream => GOTO Out;
DO
sepCount: INT;
DBNameProc: IO.BreakProc = {
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[other] };
IF char = ': AND (sepCount = 2 OR sepCount = 0) THEN
RETURN[sepr];
RETURN[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;
position: INT;
[] ← IO.SkipWhitespace[stream];
position ← stream.GetIndex[];
sepCount ← 0;
iconName ← IO.GetTokenRope[stream, DBNameProc].token;
-- see if key is followed by a :
[] ← IO.GetTokenRope[stream, whiteSpace];
IF stream.PeekChar[] # ': THEN {
[] ← IO.GetTokenRope[stream, isACR];
error ← TRUE;
Report[msg: Rope.Cat["missing : at [", Convert.RopeFromCard[position], "]"], errLog: errlog];
LOOP;
};
[] ← stream.GetChar[]; -- the :
[] ← IO.GetTokenRope[stream, whiteSpace];
fileName ← IO.GetTokenRope[stream, tokenProc].token;
index ← IO.GetCard[stream];
IF NOT NutOps.Do[InternalRegisterIcon, NEW[RegisterArgs ← [iconName, fileName, index]]]THEN
{ error ← TRUE;
Report[msg: Rope.Cat["Transaction Aborted at: ",
Convert.RopeFromCard[position]], 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] = {
stream: IO.STREAM;
InternalWrite: PROC[ arg: REF ANY ] = {
OPEN IO;
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] ];
stream.PutF["\n%g: %g %d", rope[DB.NameOf[e]], rope[fileName], int[index]];
ENDLOOP;
stream.Close[] };
stream ← FS.StreamOpen[file, $append ! FS.Error => {stream ← NIL; CONTINUE}];
IF stream # NIL THEN [] ← NutOps.Do[ InternalWrite, NIL ]
};
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: Booting.RollbackProc = {
DB.Initialize[nCachePages: 256];
ResetSchema[ $Icons, IconDB, close];
InvalidateCache[] };
CloseTrans: Booting.CheckpointProc = {
DB.CloseTransaction[trans: DB.TransactionOf[segment: $Icons]] };
ResetSchema: ENTRY Nut.TransactionProc = {
success: BOOLEAN;
IF type = close THEN {IconDB ← NIL; RETURN};
IF DB.TransactionOf[$Icons] # NIL THEN DB.CloseTransaction[DB.TransactionOf[$Icons]];
[success, readOnly] ← NutOps.SetUpSegment[segmentFile: fileName, seg: segment, number: 140B];
IF NOT success THEN RETURN;
IconDomain ← DeclareDomain["Icon", $Icons];
IconRelation ← DeclareRelation[ "IconInfo", $Icons ];
IconFileAttr ← DeclareAttribute[IconRelation, "file", RopeType];
IconIndexAttr ← DeclareAttribute[IconRelation, "index", IntType];
IconIsAttr ← DeclareAttribute[IconRelation, "of", IconDomain, Key];
IconDB ← fileName;
IF type = open THEN iconCache ← NIL -- throw away any old definitions
};
ReadCatalogue: PUBLIC ENTRY PROC[file: Rope.ROPE, errlog: IO.STREAM ← NIL] = TRUSTED {
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]] };
Initialization
TRUSTED {
Booting.RegisterProcs[c: CloseTrans, r: OpenUp];
Nut.Register[ domain: "Icon", segment: $Icons, transaction: ResetSchema ];
EstablishIconDB[] };
END.