<> <> <> 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; <> Failed: PUBLIC ERROR [why: DBIcons.Failure, reason: Rope.ROPE] = CODE; RegisterArgs: TYPE = RECORD[ iconName: ROPE, fileName: ROPE, index: CARDINAL ]; <> IconDomain: DB.Domain; -- the domain of icons IconRelation: DB.Relation; -- the relation giving the properties of an icon <> 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 <> EstablishIconDB: PUBLIC PROC [file: Rope.ROPE _ NIL] = { IF file = NIL THEN file _ UserProfile.Token[key: "Icons.Segment", default: "[Luther.Alpine]Icons.Segment"]; ResetSchema[ $Icons, file, open ] }; <> RegisterIcon: PUBLIC ENTRY PROC [iconName: Rope.ROPE, fileName: Rope.ROPE, index: CARDINAL] = { <> 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] = { <> <> 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; <> 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] = { <> 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 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]] }; <> 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 = { <> <> 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 ] }; <> Report: INTERNAL PROCEDURE [msg: Rope.ROPE, errLog: IO.STREAM] = { OPEN IO; IF errLog # NIL THEN errLog.PutF["\n\n%g", rope[msg]]; }; <> 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]] }; <> TRUSTED { Booting.RegisterProcs[c: CloseTrans, r: OpenUp]; Nut.Register[ domain: "Icon", segment: $Icons, transaction: ResetSchema ]; EstablishIconDB[] }; END. <<>>