<> <> <> <> <> <<>> DIRECTORY Atom, FS USING [Error, StreamOpen], Convert USING [RopeFromCard, RopeFromRope], DB, DBIcons, IO, Basics USING[LowHalf], FileNames USING[CurrentWorkingDirectory], IOClasses USING [CreateCommentFilterStream ], Icons USING [NewIconFromFile, IconFlavor], List USING[ DotCons, DottedPair, AList ], MessageWindow USING [Append, Blink], Process, ProcessProps USING[ AddPropList ], VM USING [AddressFault], Rope USING [Cat, Equal, ROPE], UserCredentials USING[Get, CredentialsChangeProc, RegisterForChange], UserProfile ; DBIconsImpl: CEDAR MONITOR IMPORTS Basics, FS, FileNames, Convert, IO, MessageWindow, Process, ProcessProps, VM, 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 iconCache: List.AList _ NIL; -- the internal cache of mappings from icon names to flavors searchRuleList: LIST OF Rope.ROPE; IconDB: PUBLIC ROPE _ NIL; iconTransaction: DB.Transaction; activity: BOOL _ TRUE; ticksToWait: Process.Ticks _ Process.SecondsToTicks[5*60]; readOnly: PUBLIC BOOLEAN _ TRUE; -- true if the segment is readonly defaultDatabase: PUBLIC ROPE _ "[Luther.Alpine]Icons.Segment"; workingDirectory: Rope.ROPE _ FileNames.CurrentWorkingDirectory[]; myProps: Atom.DottedPair _ NEW[Atom.DottedPairNode _ [key: $WorkingDirectory, val: workingDirectory]]; <> WatchDBActivity: PROC[] = { WHILE TRUE DO Process.Pause[ticksToWait]; CheckConnection[] ENDLOOP }; CheckConnection: ENTRY PROC[] = { ENABLE UNWIND => NULL; IF NOT activity THEN CloseTransaction[]; activity _ FALSE }; EstablishIconDB: PUBLIC ENTRY PROC [file: Rope.ROPE _ NIL] = { ENABLE UNWIND => NULL; IconDB _ IF file = NIL THEN UserProfile.Token[key: "Icons.Segment", default: defaultDatabase] ELSE file; OpenDB[] }; OpenTransaction: INTERNAL PROC [] = { IF iconTransaction = NIL THEN DB.OpenTransaction[$Icons]; iconTransaction _ DB.GetSegmentInfo[$Icons].trans }; Close: PUBLIC ENTRY PROC [] = { CloseTransaction[] }; CloseTransaction: INTERNAL PROC [] = { aborted: BOOL _ FALSE; IF iconTransaction # NIL THEN DB.CloseTransaction[iconTransaction ! DB.Aborted => { aborted _ TRUE; CONTINUE }]; IF aborted THEN DB.AbortTransaction[iconTransaction]; iconTransaction _ 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}; BEGIN fileName: ROPE = V2S[ GetF[iconRelship, IconFileAttr] ]; index: CARDINAL = Basics.LowHalf[LOOPHOLE[V2I[GetF[iconRelship, IconIndexAttr]]]]; FetchIcon: PROC[] = { flavor _ Icons.NewIconFromFile[fileName, index ! VM.AddressFault => IF default # unInit THEN flavor _ default ELSE ERROR Failed[invalidIndex, Convert.RopeFromCard[index]]; FS.Error => ERROR Failed[fileNotFound, fileName]] }; ProcessProps.AddPropList[LIST[myProps], FetchIcon] END }; 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] }; 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]]]] } }; 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[] = { Typescript: Rope.ROPE = "Typescript"; Document: Rope.ROPE = "Document"; Tool: Rope.ROPE = "Tool"; <> IF CheckCache["Tool"] = NIL THEN { 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] } }; Exists: PUBLIC ENTRY PROC[name: Rope.ROPE] RETURNS[yes: BOOLEAN] = { ENABLE UNWIND => NULL; DoCheck: INTERNAL PROC[] = { yes _ InternalCheckRegistry[name].fileName # NIL }; yes _ FALSE; [] _ CarefullyApply[DoCheck] }; Registration: PUBLIC ENTRY PROC[iconName: Rope.ROPE] RETURNS[file: Rope.ROPE, index: CARDINAL] = { ENABLE UNWIND => NULL; DoRegisterCheck: INTERNAL PROC[] = { [file, index] _ InternalCheckRegistry[iconName] }; IF NOT CarefullyApply[DoRegisterCheck] THEN RETURN[NIL, 0] }; FlushCache: 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[FALSE]; <> success _ CarefullyApply[DoRegisterIcon] }; <> Parse: INTERNAL PROCEDURE[ stream: IO.STREAM, errlog: IO.STREAM ] = { OPEN IO; error: BOOLEAN _ FALSE; iconName, fileName: Rope.ROPE; index: CARDINAL; { ENABLE IO.EndOfStream => GOTO Out; DO iconName _ IO.GetRopeLiteral[stream]; fileName _ IO.GetTokenRope[stream, IO.IDProc].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[Convert.RopeFromRope[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]]; }; <> ProfileChangeReset: ENTRY UserProfile.ProfileChangedProc = { newIconDB: ROPE = UserProfile.Token[key: "Icons.Segment", default: defaultDatabase]; IF NOT Rope.Equal[IconDB, newIconDB] THEN { IconDB _ newIconDB; CloseTransaction[] } }; UserChanged: ENTRY UserCredentials.CredentialsChangeProc = { user: Rope.ROPE = UserCredentials.Get[].name; searchRuleList _ LIST["///Commands/", Rope.Cat["///Users/", user, "/Commands/"]] }; ResetSchema: INTERNAL PROC[] = { OpenTransaction[]; 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]]; InternalInvalidateCache[]; SetDefaultIcons[] }; 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.GetSegmentInfo[$Icons].trans] }; CarefullyApply: INTERNAL PROC [proc: PROC[]] RETURNS [succeeded: BOOL] ~ { ENABLE DB.Error, DB.Failure, DB.Aborted => {succeeded _ FALSE; CONTINUE}; aborted: BOOL _ FALSE; succeeded _ TRUE; BEGIN ENABLE DB.Aborted => { aborted _ TRUE; CONTINUE }; ResetSchema[]; proc[] END; IF NOT aborted THEN RETURN; -- no aborted occurred DB.AbortTransaction[iconTransaction]; ResetSchema[]; proc[]; -- don't bother trying to restart here -- }; OpenDB: INTERNAL PROC [] ~ { ENABLE DB.Aborted, DB.Failure, DB.Error => {CONTINUE}; segmentNumber: NAT = 140B; readOnly _ FALSE; DB.Initialize[nCachePages: 256]; DB.DeclareSegment[IconDB, $Icons, segmentNumber, FALSE]; <> OpenTransaction[! DB.Error => TRUSTED {IF code = ProtectionViolation THEN { readOnly _ TRUE; CONTINUE } ELSE GOTO AlreadyDone } ]; IF readOnly THEN { <> CloseTransaction[]; DB.DeclareSegment[IconDB, $Icons, segmentNumber, TRUE, FALSE] } ELSE CloseTransaction[] -- throw away this worthless transaction EXITS AlreadyDone => CloseTransaction[! DB.Error, DB.Failure => CONTINUE] }; <> TRUSTED { EstablishIconDB[]; UserProfile.CallWhenProfileChanges[ProfileChangeReset]; UserCredentials.RegisterForChange[UserChanged]; searchRuleList _ LIST["///Commands/", Rope.Cat["///Users/", UserCredentials.Get[].name, "/Commands/"]]; Process.Detach[FORK WatchDBActivity[]] }; END.