File: DBIconsImpl.mesa
Edited by Teitelman on July 18, 1984 9:12:44 am PDT
Copyright © 1985 by Xerox Corporation. All rights reserved.
Edited by: Donahue, April 10, 1986 2:34:56 pm PST
Last Edited by: Widom, August 8, 1984 9:14:17 pm PDT
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;
Types
Failed: PUBLIC ERROR [why: DBIcons.Failure, reason: Rope.ROPE] = CODE;
ROPE: TYPE = Rope.ROPE;
Global variables for accessing the database
IconRelation: DBDefs.Relation; -- the relation giving the properties of an icon
The tuples in the relation have the structure
IconRelation[ IconNameAttr: ROPE, IconFileAttr: ROPE, IconIndexAttr: INT ]
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]];
Establishing the database
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 };
Accessing Icons
RegisterIcon:
PUBLIC
ENTRY
PROC[iconName: Rope.
ROPE, fileName: Rope.
ROPE, index:
CARDINAL] = {
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.
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] = {
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.
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;
key not found on x
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";
the test is here to make the operation idempotent
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] = {
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.
ENABLE UNWIND => NULL;
IF iconName = NIL THEN InternalInvalidateCache[]
ELSE iconCache ← Cache[ List.DotCons[iconName, NIL], iconCache ]
};
InternalInvalidateCache:
INTERNAL
PROC [] = {
Throw the entire cache away.
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];
can't register things in this segment
success ← CarefullyApply[DoRegisterIcon] };
Parsing Icon Catalogues
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;
};
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]
};
Reporting errors
Report:
INTERNAL
PROCEDURE [msg: Rope.
ROPE, errLog:
IO.
STREAM] = {
OPEN IO;
IF errLog # NIL THEN errLog.PutF["\n\n%g", rope[msg]];
};
Opening, closing segment, making/reading catalogue
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];
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
OpenTransaction[!
DB.Error =>
IF code = ProtectionViolation THEN { readOnly ← TRUE; CONTINUE } ELSE REJECT ];
IF readOnly
THEN {
attempt to open for writing failed; declare it for reading only
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 };
Initialization
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 <file> opens a new icon database (closing a previously open one, if necessary)"];
Commander.Register[key: "CloseIconDB", proc: CloseIt, doc: "\nCloseIconDB <file> closes the icon database"];
Process.Detach[FORK WatchDBActivity[]]
};
END.