-- WhiteboardToolImpl.mesa -- last edit by -- Maxwell, June 23, 1983 10:25 am -- Willie-Sue, February 22, 1983 4:30 pm -- Cattell, June 8, 1983 7:08 pm -- Donahue, August 2, 1983 4:35 pm DIRECTORY BcdDefs USING [CTIndex, MTIndex, NameRecord], BcdOps USING [BcdBase, CTHandle, MTHandle, NameString, ProcessConfigs, ProcessModules], CommandTool USING[ DoCommand ], DB USING [ Attribute, DeclareEntity, Domain, Entity, Error, GetName, GetP, Relship, SetP, V2E, V2S], Icons USING [IconFlavor], IO USING [UnsafeGetBlock, GetLength, Close, GetChar, UnsafeBlock, STREAM, SetIndex], FileIO, MessageWindow USING[ Append, Clear ], PilotLoadStateOps USING [ AcquireBcd, ConfigIndex, EnumerateBcds, InputLoadState, ReleaseBcd, ReleaseLoadState], Nut USING [CreateProc], PressFormat, Rope, Runtime USING[ IsBound], ShowPress USING[ CreateShowViewer ], String USING [EquivalentString, AppendChar], Strings USING [AppendSubString, SubStringDescriptor], TiogaMenuOps USING[ Open ], UserExec USING [ExecHandle, DoIt], ViewerClasses USING [Viewer], ViewerOps USING [FindViewer, OpenIcon, PaintViewer], Whiteboard; WhiteboardToolImpl: CEDAR PROGRAM IMPORTS BcdOps, CommandTool, DB, IO, MessageWindow, PilotLoadStateOps, FileIO, TiogaMenuOps, Rope, Runtime, ShowPress, String, Strings, UserExec, ViewerOps, Whiteboard EXPORTS Whiteboard = BEGIN OPEN DB, IO, Whiteboard; ROPE: TYPE = Rope.ROPE; Viewer: TYPE = ViewerClasses.Viewer; -- ************************ initializing domains ************************* 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; -- *********************** creating entities ************************** CreateTextViewer: PUBLIC Nut.CreateProc = BEGIN IF IsAPressFile[eName] THEN TRUSTED{ IF NOT Runtime.IsBound[link: ShowPress.CreateShowViewer] THEN { MessageWindow.Append["Running ShowPressPackage", TRUE]; IF CommandTool.DoCommand["Run", "ShowPressPackage"].err.Length[] # 0 THEN { MessageWindow.Append["Can't load ShowPressPackage", TRUE]; RETURN [NIL] } ELSE MessageWindow.Append["Done.", TRUE] }; MessageWindow.Append[message: Rope.Cat["Reading ", eName], clearFirst: TRUE]; v _ ShowPress.CreateShowViewer[eName].parent; v.icon _ document; MessageWindow.Append[message: "Done.", clearFirst: TRUE]; RETURN[v] }; v _ ViewerOps.FindViewer[eName]; IF v = NIL OR v.destroyed THEN { MessageWindow.Append[message: Rope.Cat["Reading ", eName], clearFirst: TRUE]; v _ TiogaMenuOps.Open[fileName: eName]; MessageWindow.Clear[] }; Open[v]; RETURN[v]; 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: Entity; { module: Entity; instructions: ROPE; 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]; MessageWindow.Append[Rope.Cat["Trying to start ", eName, ". . ."], TRUE]; module _ V2E[GetP[tool, Whiteboard.implementor]]; IF module # NIL AND ~Loaded[GetName[module]] THEN { MessageWindow.Append[Rope.Cat["Running ", GetName[module], ". . ."], TRUE]; UserExec.DoIt[Rope.Cat["Run ", GetName[module]] ! ANY => {error _ "UNCAUGHT SIGNAL"; GOTO Bad}]; v _ ViewerOps.FindViewer[eName]; IF v # NIL THEN { Open[v]; RETURN[NIL] } }; -- now try to invoke the command given in the instructions -- Note: module can be NIL if implementation in the boot file instructions _ V2S[ GetP[ tool, Whiteboard.comment ] ]; IF NOT Rope.Equal[instructions,""] THEN UserExec.DoIt[instructions ! ANY => {error _ "Bad instructions"; GOTO Bad}] ELSE IF module = NIL THEN { error _ "No implementor defined"; GOTO Bad }; -- try to find a viewer that might have been created v _ ViewerOps.FindViewer[eName]; IF v # NIL THEN Open[v]; RETURN[v] EXITS Bad => { -- if you get to here, then something went wrong, eg., couldn't load, bad instructions MessageWindow.Append[Rope.Cat[eName, " failed: ", error], TRUE]; 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; 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.