-- WhiteboardToolImpl.mesa
-- last edit by
-- Maxwell, September 30, 1982 10:35 am
-- Willie-Sue, February 22, 1983 4:30 pm
-- Cattell, June 8, 1983 7:08 pm
-- Donahue, May 30, 1983 8:53 am
DIRECTORY
BcdDefs USING [CTIndex, MTIndex, NameRecord],
BcdOps USING [BcdBase, CTHandle, MTHandle, NameString, ProcessConfigs, ProcessModules],
DB USING [ Attribute, DeclareEntity, Domain, Entity, Error,
GetName, GetP, Relship, SetP, S2V, V2E, V2S],
Icons USING [IconFlavor],
IO USING [UnsafeGetBlock, GetLength, Close,
GetChar, UnsafeBlock, STREAM, SetIndex],
FileIO,
PilotLoadStateOps USING [
AcquireBcd, ConfigIndex, EnumerateBcds,
InputLoadState, ReleaseBcd, ReleaseLoadState],
Nut USING [ CreateProc, DisplayProc, EditProc, QueryProc, Register, DefaultDisplay],
NutViewer,
PressFormat,
Rope,
Runtime USING[ IsBound],
-- ShowPress USING[ CreateShowViewer ],
String USING [EquivalentString, AppendChar],
Strings USING [AppendSubString, SubStringDescriptor],
UserExec USING [ExecHandle, DoIt],
ViewerClasses USING [Viewer],
ViewerOps USING [CreateViewer, FindViewer, OpenIcon, PaintViewer],
ViewerTools USING [MakeNewTextViewer],
Whiteboard;
WhiteboardToolImpl: CEDAR PROGRAM
IMPORTS
BcdOps, DB, IO, Nut, NutViewer, PilotLoadStateOps, FileIO,
Rope, Runtime, String, Strings, UserExec, ViewerOps, ViewerTools, Whiteboard
EXPORTS Whiteboard =
BEGIN
OPEN DB, IO, Whiteboard;
ROPE: TYPE = Rope.ROPE;
Viewer: TYPE = ViewerClasses.Viewer;
-- ************************ initializing domains *************************
InitTextViewer: PROC =
BEGIN
Nut.Register[domain: NutViewer.TextViewer, segment: $Squirrel, create: CreateTextViewer,
display: NullDisplay, edit: NullEdit, query: NullQuery];
END;
InitToolViewer: PROCEDURE =
BEGIN
Nut.Register[ domain: NutViewer.ToolViewer, segment: $Squirrel,
create: CreateToolViewer, display: NullDisplay,
edit: NullEdit, query: NullQuery];
InsertTools[];
END;
InsertTools: PROCEDURE =
BEGIN
RegisterTool["Cedar Spy", "Spy", "Run Spy"];
RegisterTool["Squirrel", "Squirrel", "Squirrel"];
RegisterTool["File Tool", "FileTool", "Run FileTool"];
RegisterTool["EditTool", "EditTool", "Run EditTool"];
RegisterTool["Talker", "Talker", "Talker"];
RegisterTool["Clover", "Tsetter", "Tsetter"];
RegisterTool["Walnut", "Walnut", "Walnut"];
RegisterTool["Watch", "Watch", "Run Watch"]
END;
RegisterTool: PUBLIC PROCEDURE[name, impl, instructions: ROPE ← NIL] =
BEGIN ENABLE DB.Error => TRUSTED { CONTINUE };
tool, bcd: Entity;
tool ← DeclareEntity[Whiteboard.ToolViewer, name];
bcd ← DeclareEntity[Whiteboard.BCD, impl];
[]← SetP[tool, Whiteboard.implementor, bcd];
IF instructions # NIL THEN []← SetP[tool, Whiteboard.comment, instructions];
END;
NullDisplay: Nut.DisplayProc = {};
NullQuery: Nut.QueryProc = {};
NullEdit: Nut.EditProc = {};
-- *********************** creating entities **************************
CreateTextViewer: PUBLIC Nut.CreateProc =
BEGIN
IF IsAPressFile[eName] THEN
TRUSTED{ --IF Runtime.IsBound[link: ShowPress.CreateShowViewer] THEN
--[] ← ShowPress.CreateShowViewer[eName];
RETURN[NIL] };
v ← ViewerOps.FindViewer[eName];
IF v = NIL OR v.destroyed
THEN v ← ViewerTools.MakeNewTextViewer[info: [name: eName, file: eName]];
Open[v];
RETURN[NIL];
END;
IsAPressFile: PUBLIC PROCEDURE [fileName: ROPE] RETURNS [BOOLEAN ← FALSE] = TRUSTED {
Byte: TYPE = [0..256);
bytesPerPressRecord: CARDINAL = 512;
wordsPerPressRecord: CARDINAL = 256;
Block:
TYPE =
PACKED
ARRAY [0..bytesPerPressRecord]
OF Byte;
-- oversize for overrun check
buffer: REF Block ← NEW[Block];
unsafeBlock: IO.UnsafeBlock;
ReadABlock:
UNSAFE
PROCEDURE = {
nBytesRead: INT;
buffer[bytesPerPressRecord] ← 123;
nBytesRead ← stream.UnsafeGetBlock[unsafeBlock];
IF buffer[bytesPerPressRecord] # 123 THEN ERROR; -- it went too far!
IF nBytesRead # bytesPerPressRecord THEN ERROR; -- should always be reading full blocks
};
lengthInBytes: INT;
stream: IO.STREAM;
documentDirectory: LONG POINTER TO PressFormat.DDV;
documentDirectory ← unsafeBlock.base ← LOOPHOLE[buffer];
unsafeBlock.startIndex ← 0;
unsafeBlock.stopIndexPlusOne ← bytesPerPressRecord;
stream ← FileIO.Open[fileName, read !
FileIO.OpenFailed => TRUSTED {GOTO Quit}
];
lengthInBytes ← stream.GetLength[];
IF lengthInBytes > 22 AND stream.GetChar = LOOPHOLE[0AAH, CHAR] AND stream.GetChar = LOOPHOLE[0AAH, CHAR] THEN RETURN[TRUE]; -- it looks like a PD file
IF lengthInBytes = 0 OR (lengthInBytes MOD bytesPerPressRecord # 0)
THEN { stream.Close[]; RETURN};
stream.SetIndex[lengthInBytes-bytesPerPressRecord];
ReadABlock[];
IF documentDirectory.Passwd # PressFormat.PressPasswd
THEN { stream.Close[]; RETURN };
IF documentDirectory.nRecs # lengthInBytes/bytesPerPressRecord THEN
{ stream.Close[]; RETURN };
stream.Close[]; RETURN[TRUE];
EXITS Quit => {}
};
CreateToolViewer: PUBLIC Nut.CreateProc =
BEGIN
error: ROPE ← "";
tool, module: Entity;
v ← ViewerOps.FindViewer[eName];
IF v # NIL THEN {Open[v]; RETURN[NIL]};
-- load the module (cross your fingers!!)
tool ← DeclareEntity[d: Whiteboard.ToolViewer, name: eName, version: OldOnly];
IF tool = NIL THEN RETURN[NIL];
module ← V2E[GetP[tool, Whiteboard.implementor]];
IF module # NIL AND ~Loaded[GetName[module]] THEN {
UserExec.DoIt[Rope.Cat["Run ", GetName[module]] !
ANY => {error ← "UNCAUGHT SIGNAL"; CONTINUE}] };
-- was the load successful?
IF Rope.Equal[error,""] THEN v ← ViewerOps.FindViewer[eName];
IF v # NIL THEN {Open[v]; RETURN[NIL]};
-- try to invoke the command given in the instructions
IF Rope.Equal[error,""] AND module = NIL
THEN error ← "No implementor defined."
ELSE { instructions: ROPE = V2S[ GetP[ tool, Whiteboard.comment ] ];
IF Rope.Equal[instructions,""] THEN error ← "Loaded tool, but no viewer created"
ELSE
{ UserExec.DoIt[instructions ! ANY => {error ← "Bad instructions"; CONTINUE}];
IF Rope.Equal[error,""] THEN v ← ViewerOps.FindViewer[eName];
IF v = NIL THEN error ← "Loaded tool, but no viewer created"
ELSE { Open[v]; RETURN[NIL] } } };
-- if you get to here, then something went wrong, eg., couldn't load, no viewer created
[] ← SetP[tool, Whiteboard.loadError, S2V[error]];
v ← ViewerOps.CreateViewer[flavor: $Container, info: [name: eName]];
Nut.DefaultDisplay[tool, v, seg];
RETURN[NIL];
END;
Loaded: PUBLIC PROCEDURE[module: ROPE] RETURNS[loaded: BOOLEAN] = TRUSTED
BEGIN
OPEN PilotLoadStateOps;
temp: STRING ← [30];
modName: STRING ← [30];
EachConfig: PROC[ci: ConfigIndex] RETURNS [BOOLEAN] = TRUSTED
BEGIN
FindModule: PROC [mth: BcdOps.MTHandle, mti: BcdDefs.MTIndex]
RETURNS [BOOLEAN] = TRUSTED
{ GetNameString[bcdns, mth.name, temp];
loaded ← String.EquivalentString[modName, temp];
RETURN[loaded]};
FindConfig: PROC [cth: BcdOps.CTHandle, cti: BcdDefs.CTIndex]
RETURNS [BOOLEAN] = TRUSTED
{ GetNameString[bcdns, cth.name, temp];
loaded ← String.EquivalentString[modName, temp];
RETURN[loaded]};
bcd: BcdOps.BcdBase ← AcquireBcd[ci];
bcdns: BcdOps.NameString ← LOOPHOLE[bcd + bcd.ssOffset];
[] ← BcdOps.ProcessModules[bcd, FindModule];
IF ~loaded THEN [] ← BcdOps.ProcessConfigs[bcd, FindConfig];
ReleaseBcd[bcd];
RETURN[loaded];
END;
-- main code
loaded ← FALSE;
FOR i: INT IN [0..MIN[30, Rope.Length[module]]) DO
String.AppendChar[modName, Rope.Fetch[base: module, index: i]] ENDLOOP;
[] ← InputLoadState[];
[] ← EnumerateBcds[recentfirst, EachConfig]; -- sets 'loaded'
ReleaseLoadState[];
END;
GetNameString: PROC[ssb: BcdOps.NameString, n: BcdDefs.NameRecord, name: STRING] = TRUSTED
BEGIN
ssd: Strings.SubStringDescriptor;
ssd ← [base: @ssb.string, offset: n, length: MIN[ssb.size[n], 100]];
name.length ← 0;
Strings.AppendSubString[name, @ssd];
END;
ExtractName: PUBLIC PROCEDURE[name: ROPE] RETURNS[ROPE] =
BEGIN
pos: INTEGER;
pos ← Rope.Find[name, ": "];
IF pos < 0 THEN pos ← 0 ELSE pos ← pos + 2;
RETURN[Rope.Substr[name, pos, Rope.Length[name]-pos-11]]; -- remove the " (Squirrel)" too
END;
Open: PROCEDURE[viewer: Viewer] =
INLINE BEGIN
IF viewer.iconic
THEN ViewerOps.OpenIcon[viewer]
ELSE ViewerOps.PaintViewer[viewer, all];
END;
InitTextViewer[]; InitToolViewer[]; InsertTools[]
END.
Change Log
Cattell August 11, 1982 12:23 pm: Removed StartTrap call, want to selectively start up whiteboards. Also make GetIconInfo recover gracefully if icon relation has been deleted or not initialized.
Cattell October 11, 1982 9:29 pm: GetIcon must catch MultipleMatch on GetEntityByName, because there may be more than one sub-type of the domain; in this case just use nut icon.