<> <> <> <> <> <<>> DIRECTORY Atom, Booting, FS USING [Error, StreamOpen], Commander, Convert USING [RopeFromCard, RopeFromRope], DB, DBCommon, DBDefs, 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]; DBIconsImpl: CEDAR MONITOR IMPORTS Basics, Booting, FS, FileNames, Commander, Convert, IO, MessageWindow, Process, ProcessProps, VM, Rope, Icons, DB, List, UserCredentials, IOClasses EXPORTS DBIcons = BEGIN OPEN DB, DBDefs, Rope; <> Failed: PUBLIC ERROR [why: DBIcons.Failure, reason: Rope.ROPE] = CODE; ROPE: TYPE = Rope.ROPE; <> IconRelation: DBDefs.Relation; -- the relation giving the properties of an icon <> IconFileField: DB.Field = [name: "file", type: DB.String, lengthHint: 30]; -- the name of the file for an icon IconIndexField: DB.Field = [name: "index", type: DB.Integer]; -- the index in the file IconNameField: DB.Field = [name: "name", type: DB.String, lengthHint: 30]; -- the icon itself IconFields: DB.FieldSpec = DB.L2FS[LIST[IconNameField, IconIndexField, IconFileField]]; IconNameAttribute: CARDINAL = 0; IconIndexAttribute: CARDINAL = 1; IconFileAttribute: CARDINAL = 2; nameIndex: Index; nameField: FieldSequence = DB.L2F[LIST[IconNameAttribute]]; iconCache: List.AList _ NIL; -- the internal cache of mappings from icon names to flavors searchRuleList: LIST OF Rope.ROPE; IconDB: PUBLIC ROPE _ NIL; stopped: BOOL _ TRUE; iconTransaction: DBCommon.TransactionHandle; activity: BOOL _ TRUE; ticksToWait: Process.Ticks _ Process.SecondsToTicks[5*60]; transOpened: CONDITION; readOnly: PUBLIC BOOLEAN _ TRUE; -- true if the segment is readonly 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[]; WAIT transOpened }; activity _ FALSE }; EstablishIconDB: PUBLIC ENTRY PROC [file: Rope.ROPE] = { ENABLE UNWIND => NULL; IF Rope.Equal[IconDB, file] THEN RETURN; IconDB _ file; stopped _ TRUE; -- protection against errors that might arise in the opening CloseTransaction[]; OpenDB[]; stopped _ FALSE }; OpenTransaction: INTERNAL PROC [] = { schemaInvalid: BOOL; IF iconTransaction = NIL THEN { [iconTransaction, schemaInvalid] _ DB.OpenTransaction[$Icons]; IF schemaInvalid THEN ResetSchema[] }; NOTIFY transOpened }; Close: PUBLIC ENTRY PROC [] = { ENABLE UNWIND => iconTransaction _ NIL; CloseTransaction[]; stopped _ TRUE }; CloseTransaction: INTERNAL PROC [] = { aborted: BOOL _ FALSE; IF iconTransaction = NIL THEN RETURN; DB.CloseTransaction[iconTransaction ! DB.Aborted => { aborted _ TRUE; CONTINUE }; DB.Error, DB.Failure => CONTINUE ]; IF aborted THEN DB.AbortTransaction[iconTransaction]; iconTransaction _ NIL }; AbortTransaction: INTERNAL PROC [] = { IF iconTransaction = NIL THEN RETURN; DB.AbortTransaction[iconTransaction ! DB.Error, DB.Failure, DB.Aborted => CONTINUE ]; 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[] = { iconRelship: DBDefs.Relship = LookupWithSimpleKey[IconRelation, nameIndex, S2V[iconName]]; IF iconRelship = NIL THEN {flavor _ default; RETURN}; BEGIN fileName: ROPE = V2S[ GetF[iconRelship, IconFileAttribute] ]; index: CARDINAL = Basics.LowHalf[LOOPHOLE[V2I[GetF[iconRelship, IconIndexAttribute]]]]; FetchIcon: PROC[] = { flavor _ Icons.NewIconFromFile[fileName, index ! VM.AddressFault => IF default # unInit THEN {flavor _ default; CONTINUE} ELSE ERROR Failed[invalidIndex, Convert.RopeFromCard[index]]; FS.Error => IF default # unInit THEN {flavor _ default; CONTINUE} ELSE 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] = { iconRelship: DBDefs.Relship = LookupWithSimpleKey[IconRelation, nameIndex, S2V[name]]; IF iconRelship = NIL THEN { fileName _ NIL; i _ 0 } ELSE { fileName _ V2S[ GetF[ iconRelship, IconFileAttribute ] ]; i _ Basics.LowHalf[LOOPHOLE[V2I[GetF[iconRelship, IconIndexAttribute]]]] } }; 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 }; valueSequence: ValueSequence _ NEW[ValueSequenceObject[3]]; InternalRegisterIcon: INTERNAL PROC[iconName: Rope.ROPE, fileName: Rope.ROPE, index: CARDINAL] RETURNS[success: BOOLEAN] = { DoRegisterIcon: PROC[] = TRUSTED { relship: Relship = LookupWithSimpleKey[IconRelation, nameIndex, S2V[iconName]]; IF relship # NIL THEN { } ELSE { [] _ CreateRelship[IconRelation, L2VS[LIST[DB.S2V[iconName], DB.U2V[index], DB.S2V[fileName]]]]; DB.MarkTransaction[iconTransaction] } }; 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[r: IconRelation, index: nameIndex, constraint: NIL, start: First]; FOR r: Relship _ NextRelship[iconRels], NextRelship[iconRels] UNTIL r = NIL DO fileName: ROPE = V2S[ GetF[r, IconFileAttribute] ]; iconName: ROPE = V2S[ GetF[r, IconNameAttribute] ]; index: CARDINAL = Basics.LowHalf[LOOPHOLE[V2I[GetF[r, IconIndexAttribute]]]]; 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]]; }; <> UserChanged: ENTRY UserCredentials.CredentialsChangeProc = { ENABLE UNWIND => NULL; user: Rope.ROPE = UserCredentials.Get[].name; searchRuleList _ LIST["///Commands/", Rope.Cat["///Users/", user, "/Commands/"]]; CloseTransaction[]; stopped _ TRUE }; ResetSchema: INTERNAL PROC[] = { IconRelation _ DeclareRelation["IconInfo", $Icons, IconFields]; nameIndex _ DeclareKeyIndex[IconRelation, nameField]; 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[iconTransaction] }; CarefullyApply: INTERNAL PROC [proc: PROC[]] RETURNS [succeeded: BOOL] ~ { ENABLE DB.Error, DB.Failure, DB.Aborted => {succeeded _ FALSE; CONTINUE}; aborted: BOOL _ FALSE; succeeded _ TRUE; IF stopped THEN RETURN; BEGIN ENABLE DB.Aborted => { aborted _ TRUE; CONTINUE }; IF iconTransaction = NIL THEN OpenTransaction[]; proc[] END; IF NOT aborted THEN RETURN; -- no aborted occurred AbortTransaction[]; OpenTransaction[]; 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]; <> OpenTransaction[! DB.Error => IF code = ProtectionViolation THEN { readOnly _ TRUE; CONTINUE } ELSE REJECT ]; IF readOnly THEN { <> CloseTransaction[]; DB.DeclareSegment[filePath: IconDB, segment: $Icons, number: segmentNumber, readonly: TRUE]; OpenTransaction[] } }; OpenIt: Commander.CommandProc = { h: IO.STREAM = IO.RIS[cmd.commandLine]; name: ROPE; [] _ h.SkipWhitespace[]; IF h.EndOf THEN name _ NIL ELSE name _ h.GetLineRope[]; IF Rope.Equal[name, ""] THEN IF IconDB # NIL THEN name _ IconDB ELSE msg _ "Must supply a database name"; EstablishIconDB[name] }; CloseIt: Commander.CommandProc = { Close[] }; OpenUp: Booting.RollbackProc = { DB.Initialize[nCachePages: 256] }; CloseTrans: ENTRY Booting.CheckpointProc = { ENABLE UNWIND => NULL; CloseTransaction[]; stopped _ TRUE }; <> TRUSTED { searchRuleList _ LIST["///Commands/", Rope.Cat["///Users/", UserCredentials.Get[].name, "/Commands/"]]; UserCredentials.RegisterForChange[UserChanged]; Booting.RegisterProcs[c: CloseTrans, r: OpenUp]; Commander.Register[key: "OpenIconDB", proc: OpenIt, doc: "\nOpenIconDB opens a new icon database (closing a previously open one, if necessary)"]; Commander.Register[key: "CloseIconDB", proc: CloseIt, doc: "\nCloseIconDB closes the icon database"]; Process.Detach[FORK WatchDBActivity[]] }; END.