<> << -- 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; <> Failed: PUBLIC ERROR [why: DBIcons.Failure, reason: Rope.ROPE] = CODE; ROPE: TYPE = Rope.ROPE; <> 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 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; <> EstablishIconDB: PUBLIC ENTRY PROC [file: Rope.ROPE _ NIL] = { ENABLE UNWIND => NULL; IconDB _ IF file = NIL THEN UserProfile.Token[key: "Icons.Segment", default: "[Luther.Alpine]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 }; <> RegisterIcon: PUBLIC ENTRY PROC [iconName: Rope.ROPE, fileName: Rope.ROPE, index: CARDINAL] = { <> 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] = { <> <> 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]; <> 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; <> 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"; <> 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] = { <> 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] = { <> ENABLE UNWIND => NULL; IF iconName = NIL THEN { InternalInvalidateCache[] } ELSE iconCache _ Cache[ List.DotCons[iconName, NIL], iconCache ] }; InternalInvalidateCache: INTERNAL PROC [] = { <> 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] }; <> Parse: INTERNAL PROCEDURE[ stream: IO.STREAM, errlog: IO.STREAM ] = { OPEN IO; error: BOOLEAN _ FALSE; { ENABLE IO.EndOfStream => GOTO Out; DO DBNameProc: IO.BreakProc = { <> 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] }; <> Report: INTERNAL PROCEDURE [msg: Rope.ROPE, errLog: IO.STREAM] = { OPEN IO; IF errLog # NIL THEN errLog.PutF["\n\n%g", rope[msg]]; }; <> 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]Icons.segment"]; IF NOT Rope.Equal[IconDB, newIconDB] THEN { <> 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}; <> 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 { <> 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 }; <> TRUSTED { Booting.RegisterProcs[c: CloseTrans, r: OpenUp]; EstablishIconDB[]; Process.Detach[ FORK WatchDBActivity[] ]; UserCredentials.RegisterForChange[NewUserReset]; UserProfile.CallWhenProfileChanges[ProfileChangeReset] }; END.