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. FFile: DBIconsImpl.mesa Edited by Teitelman on July 18, 1984 9:12:44 am PDT Copyright c 1985 by Xerox Corporation. All rights reserved. Edited by: Donahue, June 17, 1985 9:01:18 am PDT Last Edited by: Widom, August 8, 1984 9:14:17 pm PDT Types Global variables for accessing the database The tuples in the relation have the structure IconRelation[ IconNameAttr: ROPE, IconFileAttr: ROPE, IconIndexAttr: INT ] Establishing the database Accessing Icons 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. 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. key not found on x the test is here to make the operation idempotent 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. Throw the entire cache away. can't register things in this segment Parsing Icon Catalogues Reporting errors Opening, closing segment, making/reading catalogue this is a crock to see if the database really can be written to; you need to actually open a transaction to find this out attempt to open for writing failed; declare it for reading only Initialization Κ˜šΟi™Jšœ0Οk™3Icodešœ Οmœ1™Jšžœžœžœ˜šœ žœžœž˜JšœBžœ˜L—J•StartOfExpansionY[segmentFile: ROPE, seg: DB.Segment, number: NAT _ 0, makeReadOnly: BOOL _ FALSE]šœ ˜ J˜—š’œžœžœ˜%Jšžœžœžœžœ˜9Jšœžœ ˜4J˜—Jš’œžœžœžœ˜6J˜š’œžœžœ˜&Jšœ žœžœ˜šžœžœž˜Jšžœ$žœžœžœ˜R—Jšžœ žœžœ#˜5Jšœžœ˜——™š’ œžœžœžœžœžœ žœ˜_J™ΰJšžœžœžœ˜Jšœ4˜4J˜—J˜š ’œžœžœžœžœ&žœ˜sJšžœžœžœ˜Jšžœ%˜+—J˜J˜š ’œžœžœžœ&žœ˜vJš‘}™}J™ Jšœžœžœ˜-Jšœ"˜"Jšœ žœ˜š’ œžœ˜Jšœžœ?˜QJšœ žœ(žœ˜VJšžœžœžœžœ˜5šž˜Jšœ žœ*˜8Jšœžœžœ)˜Rš’ œžœ˜šœ0˜0šžœ˜Jšžœžœ˜)Jšžœžœ3˜=—Jšœžœ žœ#˜5——Jšœžœ˜2Jšžœ˜——Jš žœžœžœžœžœžœ˜OJšžœ žœžœžœ ˜%Jšœ$˜$Jšžœžœ žœžœ ˜$šžœžœ˜Jšœ)žœ)˜UJšžœ ˜—Jšžœžœžœ ˜)Jšžœ˜"Jšœ˜J˜—š’œžœžœžœžœ žœžœ˜YJšœžœ;˜MJšœ žœ(žœ˜VJšžœžœžœžœ ˜3šžœ˜Jšœ4˜4—Jšœžœ-˜K—J˜š’œžœžœ-žœ˜[Jšœžœ˜J˜ šžœžœž˜š žœ žœžœžœ žœž˜EJšž˜J˜Jšžœ˜Jšžœ˜—J˜J˜ —Jšžœ˜Jš‘™Jšœžœžœ˜šžœžœžœžœ˜Jš žœžœ žœžœ ‘ ˜4Jšžœžœ‘˜%—Jšžœ˜J˜J˜—š’ œžœžœ žœžœžœžœ˜Gšžœ2žœ žœž˜LJš žœ žœžœ žœžœ˜ZJšžœ˜—Jšžœžœ˜—J˜š’œžœžœ˜%Jšœžœ˜%Jšœžœ˜!Jšœ žœ ˜Jšœ1™1šžœžœžœ˜"Jšœ žœžœ?˜lJšœ žœžœ=˜hJšœ žœžœ:˜a—Jšœ˜—J˜š’œžœžœžœ žœžœžœ˜DJšžœžœžœ˜Jš’œžœžœ4žœ˜PJšœžœ!˜,—J˜š’ œžœžœžœžœžœ žœ žœ˜bJšžœžœžœ˜Jš’œžœžœ9˜WJš žœžœ!žœžœžœ˜=J˜—š ’ œžœžœžœžœžœ˜=J™ΝJšžœžœžœ˜Jšžœ žœžœ˜0Jšžœ+žœ˜@J˜—J˜š’œžœžœ˜-J™Jšœ žœ˜—J˜š’œžœžœžœžœ žœžœ žœ˜|š’œžœ˜Jšœžœ+˜=Jšœ0žœ˜FJšœ+˜+Jšœ+˜+—š žœ žœ žœžœžœžœ˜/Jšœ%™%—Jšœ*˜*Jšœ˜——™procš’œžœž œ žœžœ žœžœ˜FJšžœžœ˜Jšœžœžœ˜Jšœžœ˜Jšœžœ˜šœžœžœžœ˜$šž˜Jšœ žœ˜%Jšœ žœ'˜4Jšœžœ˜šžœžœ1ž˜;Jšœ žœ˜šœ2˜2Jšœ:˜:—Jšœžœ˜ —Jšžœ˜—šž˜Jšœžœ˜ —J˜—šžœžœ˜JšœC˜CJšœ˜Jšžœ žœžœ˜$J˜—Jšœ˜—J˜š ’œžœžœžœ žœ˜7Jšžœžœžœ˜Jšœžœžœ˜š’ œžœ˜Jšžœžœ˜Jšœ4˜4šžœ;žœžœž˜NJšœ žœ+˜9Jšœ žœ+˜9Jšœžœžœ˜HJšœ\˜\Jšžœ˜—J˜—Jš œ žœžœžœžœ˜MJšžœ žœžœ#˜7J˜——™J˜š ’œžœž œ žœ žœžœ˜BJšžœžœ˜Jšžœ žœžœ#˜7Jšœ˜—J˜—™2šœžœ#˜˜S—J˜š’ œžœžœ˜ J˜Jš žœžœžœžœžœ‘+˜UJ˜5J˜@J˜AJšœE˜EJšœ žœ˜4Jšœ˜Jšœ˜—J˜š’ œžœžœžœ žœ žœžœžœžœ˜VJšžœžœžœ˜Jšœžœžœ˜Jš œ žœžœžœžœ˜FJšžœ žœžœžœ˜Jšœ5˜5Jšœ˜Jšžœžœ!˜6J˜—š ’œžœžœžœžœ žœ˜JJš žœžœžœ žœžœžœ˜IJšœ žœžœ˜Jšœ žœ˜šž˜Jšžœžœžœžœ˜2J˜Jšœ˜Jšžœ˜—Jš žœžœ žœžœ‘˜2Jšžœ#˜%Jšœ˜JšœΟb‘)˜1Jšœ˜J˜—šΠbnœžœžœ˜Jš žœžœ žœ žœ žœ˜6Jšœžœ˜Jšœ žœ˜Jšžœ˜ Jšžœ/žœ˜8Jšœy™yšœžœ ˜Jš žœžœžœžœžœ˜IJšžœžœ˜—šžœ žœ˜Jšœ?™?Jšœ˜Jšžœ/žœžœ˜?—Jšžœ‘(˜Ašž˜Jšœ"žœžœ žœ˜C—J˜——šœ™šžœ˜ Jšœ˜Jšœ7˜7J˜/JšœžœR˜gKšœžœ˜&Jšœ˜—J˜J˜—Jšžœ˜J˜—…—,B]