-- ModelImpl.mesa
-- last edit by Schmidt, January 6, 1983 2:23 pm
-- last edit by Satterthwaite, March 8, 1983 10:56 am
-- main program for the system modeller
-- this is the top-level command module for the modeller
-- it provides an interface to the modeller using
-- a conventional viewers window with buttons to push
DIRECTORY
Buttons: TYPE USING [Button, ButtonProc, Create],
Containers: TYPE USING [ChildXBound, ChildYBound, Container, Create],
CWF: TYPE USING [SetWriteProcedure, WF0, WF1, WF2],
DBStash: TYPE USING [ForceOut, Insert],
Directory: TYPE USING [Error, Handle, ignore, Lookup],
File: TYPE USING [Capability],
FileIO: TYPE USING [Open],
FileStream: TYPE USING [SetLeaderPropertiesForCapability],
IO: TYPE USING [
bool, Close, CreateDribbleStream, Flush, GetChar, Handle,
Put, PutChar, PutF, PutFR, PutRope, Signal, string, time],
Labels: TYPE USING [Create, Label, Set],
LowLoader: TYPE USING [LoadBcdAndCount],
MDMain: TYPE USING [
AttachSymbiote, Begin, Compile, Continue, DetachSymbiote,
Loader, MDMainImpl, modellerIsIdle, Notice, NoticeAll, Permanent,
PrintSeparatorLine, ReStartModelling, SetWorkingModel, Start, StartModelling,
StopModelling, Temporary, Transaction, Type, UnLoader],
MDUtil: TYPE USING [AcquireMsgLock, AnyR, ReleaseMsgLock],
Menus: TYPE USING [CreateEntry, CreateMenu, InsertMenuEntry, Menu, MenuProc],
Process: TYPE USING [Detach],
Rope: TYPE USING [Cat, Length, Lower, ROPE, Text],
RopeInline: TYPE USING [InlineFlatten],
Rules: TYPE USING [Create, Rule],
Runtime: TYPE USING [IsBound, RunConfig],
Subr: TYPE USING [debugflg, LongZone, MakeTTYProcs, PackedTime, SubrStop, TTYProcs],
Time: TYPE USING [Current],
TypeScript: TYPE USING [TS, Create, SetUserAbort],
UserProfile: TYPE USING [Boolean, Token],
ViewerClasses: TYPE USING [Viewer],
ViewerEvents: TYPE USING [
EventProc, EventRegistration, RegisterEventProc, UnRegisterEventProc],
ViewerIO: TYPE USING [CreateViewerStreams],
ViewerOps: TYPE USING [
BlinkIcon, EstablishViewerPosition, PaintViewer, SetMenu, SetOpenHeight],
ViewerTools: TYPE USING [MakeNewTextViewer, GetContents, SetContents, SetSelection];
ModelImpl: PROGRAM
IMPORTS
Buttons, Containers, CWF, DBStash, Directory, FileIO, FileStream, IO,
Labels, LowLoader, MDMain, MDUtil, Menus, Process, Rope, RopeInline,
Rules, Runtime, Subr, Time, TypeScript, UserProfile,
ViewerEvents, ViewerOps, ViewerIO, ViewerTools = {
-- the code is organized as follows:
-- Procedures used for the Viewers windows only
-- Viewers procedures to implement the exterior of the windows
-- utility routines
-- Initialization code
-- global data
Global: TYPE = RECORD[
-- viewers data
container: Containers.Container ← NIL,
msgTypeScript: TypeScript.TS ← NIL, -- for compiler progress messages
msgout: IO.Handle ← NIL,
msgFile: IO.Handle ← NIL,
debugTypeScript: TypeScript.TS ← NIL, -- for debugging messages
debugout: IO.Handle ← NIL,
debugFile: IO.Handle ← NIL,
ttyTypeScript: TypeScript.TS ← NIL, -- modeller log
tty: Subr.TTYProcs ← NIL,
ttyin: IO.Handle ← NIL,
ttyout: IO.Handle ← NIL,
ttyFile: IO.Handle ← NIL,
-- fields
startModellingFileNameButton: Buttons.Button ← NIL,
startModellingFileNameViewer: ViewerClasses.Viewer ← NIL,
noticeFileNameButton: Buttons.Button ← NIL,
noticeFileNameViewer: ViewerClasses.Viewer ← NIL,
setWorkingFileNameButton: Buttons.Button ← NIL,
setWorkingModelViewer: ViewerClasses.Viewer ← NIL,
attachEditorButton: Buttons.Button ← NIL,
attachEditorLabel: Labels.Label ← NIL,
confirmButton: Buttons.Button ← NIL,
confirmLabel: Labels.Label ← NIL,
debuggingButton: Buttons.Button ← NIL,
debuggingLabel: Labels.Label ← NIL,
touchFileNameButton: Buttons.Button ← NIL,
touchFileNameViewer: ViewerClasses.Viewer ← NIL,
--
-- program data
attachsymbiote: BOOL ← FALSE, -- if true then please attach symbiote
confirm: REF BOOL ← NIL,
makewizard: BOOL ← FALSE
];
-- MDS usage!
g: REF Global ← NIL;
destroyEventRegistration: ViewerEvents.EventRegistration;
-- endof MDS usage !!!
-- these are commands for the viewers world
entryHeight: NAT = 15;
entryVSpace: NAT = 7;
entryHSpace: NAT = 10;
BuildOuter: PROC = {
vName: Rope.ROPE = IO.PutFR["Modeller, started on %t", IO.time[Time.Current[]]];
startModellingRef: Rope.Text;
menu: Menus.Menu = Menus.CreateMenu[lines: 3];
g ← NEW[Global←[]];
g.confirm ← NEW[BOOL←TRUE];
g.container ← Containers.Create[
info: [name: vName, iconic: FALSE, scrollable: FALSE, column: $right]];
-- first row of menu items
menu.InsertMenuEntry[Menus.CreateEntry["StopModel", StopModellingProc], 0];
menu.InsertMenuEntry[Menus.CreateEntry["Unload", UnloadProc], 0];
menu.InsertMenuEntry[Menus.CreateEntry["Continue", ContinueProc], 0];
menu.InsertMenuEntry[Menus.CreateEntry["Begin", BeginProc], 0];
menu.InsertMenuEntry[Menus.CreateEntry["NoticeAll", NoticeAllProc], 0];
menu.InsertMenuEntry[Menus.CreateEntry["StartModel", StartModellingProc], 0];
menu.InsertMenuEntry[Menus.CreateEntry["Abort", MyAbort], 0];
-- second row of menu items
-- menu.InsertMenuEntry[Menus.CreateEntry["Permanent", PermanentProc], 1]; ** disabled **
menu.InsertMenuEntry[Menus.CreateEntry["Temporary", TemporaryProc], 1];
menu.InsertMenuEntry[Menus.CreateEntry["Start", StartProc], 1];
menu.InsertMenuEntry[Menus.CreateEntry["LoadAll", LoadAllProc], 1];
menu.InsertMenuEntry[Menus.CreateEntry["LoadWithRepl", LoadWithReplProc], 1];
menu.InsertMenuEntry[Menus.CreateEntry["Compile", CompileProc], 1];
-- third row of menu items
menu.InsertMenuEntry[Menus.CreateEntry["Notice", NoticeProc], 2];
menu.InsertMenuEntry[Menus.CreateEntry["ReStartModelling", ReStartModellingProc], 2];
menu.InsertMenuEntry[Menus.CreateEntry["TypeWDefaults", TypeWDefaultsProc], 2];
menu.InsertMenuEntry[Menus.CreateEntry["TypeWODefaults", TypeWODefaultsProc], 2];
menu.InsertMenuEntry[Menus.CreateEntry["SetWorkingModel", SetWorkingModelProc], 2];
menu.InsertMenuEntry[Menus.CreateEntry["Touch", TouchProc], 2];
--
ViewerOps.SetMenu[g.container, menu, FALSE];
[g.attachsymbiote, g.confirm↑, g.makewizard, startModellingRef]
← GetDefaultsFromUserProfile[];
BuildUserInput[startModellingRef];
-- kludge required for multiple rows in menus
ViewerOps.EstablishViewerPosition[g.container, g.container.wx, g.container.wy,
g.container.ww, g.container.wh];
ViewerOps.PaintViewer[g.container, all];
[g.ttyout, g.ttyFile, g.ttyin, g.tty] ← SetUpLogStreams[g.ttyTypeScript, "Model.Log",
TRUE];
[g.msgout, g.msgFile, ] ← SetUpLogStreams[g.msgTypeScript, "Msg.Log", FALSE];
IF g.makewizard THEN
[g.debugout, g.debugFile, ] ← SetUpLogStreams[g.debugTypeScript, "Debug.Log", FALSE];
[] ← CWF.SetWriteProcedure[ToolTTYProc];
IF g.attachsymbiote THEN MDMain.AttachSymbiote[g.msgout];
destroyEventRegistration ← ViewerEvents.RegisterEventProc[MyDestroy, $destroy]};
BuildUserInput: PROC[startModellingRef: Rope.Text] = {
heightSoFar: CARDINAL;
l: ViewerClasses.Viewer;
rule: Rules.Rule;
CreateButton: PROC[bname, lname: Rope.Text, newLine: BOOL, drawRule: BOOL←FALSE]
RETURNS[button: Buttons.Button, label: Labels.Label] = {
x: CARDINAL;
IF newLine THEN {
heightSoFar ← (IF l = NIL THEN entryVSpace/2 ELSE heightSoFar + entryVSpace + l.wh);
IF drawRule THEN {
rule ← Rules.Create[info: [parent: g.container, wx: 0, wy: heightSoFar, ww: 0, wh: 1]];
Containers.ChildXBound[g.container, rule];
heightSoFar ← heightSoFar + entryVSpace};
x ← 0}
ELSE x ← l.wx + l.ww + entryHSpace;
l ← button ← Buttons.Create[info: [name: bname, parent: g.container,
border: FALSE, wx: x, wy: heightSoFar], proc: PushButton];
IF lname ~= NIL THEN
l ← label ← Labels.Create[info: [name: lname, parent: g.container,
wx: button.wx + button.ww + entryHSpace, wy: heightSoFar, border: TRUE]]};
-- first line
[g.startModellingFileNameButton, ] ← CreateButton["ModelName:", NIL, TRUE];
l ← g.startModellingFileNameViewer ← ViewerTools.MakeNewTextViewer[info: [parent: g.container,
wx: l.wx+l.ww+entryHSpace, wy: heightSoFar, ww: 100, wh: entryHeight,
data: NIL, scrollable: FALSE, border: FALSE], paint: FALSE];
IF startModellingRef ~= NIL THEN
ViewerTools.SetContents[g.startModellingFileNameViewer, startModellingRef];
[g.noticeFileNameButton, ] ← CreateButton["NoticeName:", NIL, FALSE];
l ← g.noticeFileNameViewer ← ViewerTools.MakeNewTextViewer[info: [parent: g.container,
wx: l.wx+l.ww+entryHSpace, wy: heightSoFar, ww: 100, wh: entryHeight,
data: NIL, scrollable: FALSE, border: FALSE], paint: FALSE];
[g.setWorkingFileNameButton, ] ← CreateButton["ProcName:", NIL, FALSE];
l ← g.setWorkingModelViewer ← ViewerTools.MakeNewTextViewer[info: [parent: g.container,
wx: l.wx+l.ww+entryHSpace, wy: heightSoFar, ww: 100, wh: entryHeight,
data: NIL, scrollable: FALSE, border: FALSE], paint: FALSE];
Containers.ChildXBound[g.container, g.setWorkingModelViewer];
--second line
[g.attachEditorButton, g.attachEditorLabel] ← CreateButton["AttachEditor:",
"FALSE", TRUE];
IF g.attachsymbiote THEN Labels.Set[g.attachEditorLabel, "TRUE"];
[g.confirmButton, g.confirmLabel] ← CreateButton["Confirm:", "FALSE", FALSE];
IF g.confirm↑ THEN Labels.Set[g.confirmLabel, "TRUE"];
[g.debuggingButton, g.debuggingLabel] ← CreateButton["Debugging:", "FALSE", FALSE];
IF Subr.debugflg THEN Labels.Set[g.debuggingLabel, "TRUE"];
[g.touchFileNameButton,] ← CreateButton["TouchName:", NIL, FALSE];
l ← g.touchFileNameViewer ← ViewerTools.MakeNewTextViewer[info: [parent: g.container,
wx: l.wx+l.ww+entryHSpace, wy: heightSoFar, ww: 0, wh: entryHeight,
data: NIL, scrollable: FALSE, border: FALSE], paint: FALSE];
Containers.ChildXBound[g.container, g.touchFileNameViewer];
heightSoFar ← heightSoFar+entryVSpace/2+l.wh;
--
-- first the msg window
-- now the line above the typescript
rule ← Rules.Create[info: [parent: g.container, wx: 0, wy: heightSoFar, ww: 0, wh: 1]];
Containers.ChildXBound[g.container, rule];
heightSoFar ← heightSoFar+entryVSpace/2;
-- now the typescript
g.msgTypeScript ← TypeScript.Create[info: [parent: g.container,
wx: 0, wy: heightSoFar, ww: 0, wh: 25, border: FALSE]];
Containers.ChildXBound[g.container, g.msgTypeScript];
heightSoFar ← heightSoFar + entryVSpace + 20;
-- then the debugging window
IF g.makewizard THEN {
rule ← Rules.Create[info: [parent: g.container, wx: 0, wy: heightSoFar, ww: 0, wh: 1]];
Containers.ChildXBound[g.container, rule];
heightSoFar ← heightSoFar+entryVSpace/2;
-- now the typescript
g.debugTypeScript ← TypeScript.Create[info: [parent: g.container,
wx: 0, wy: heightSoFar, ww: 0, wh: 40, border: FALSE]];
Containers.ChildXBound[g.container, g.debugTypeScript];
heightSoFar ← heightSoFar + entryVSpace/2 + 40};
-- now the line above the typescript
rule ← Rules.Create[info: [parent: g.container, wx: 0, wy: heightSoFar, ww: 0, wh: 1]];
Containers.ChildXBound[g.container, rule];
heightSoFar ← heightSoFar+entryVSpace/2;
-- now the typescript
g.ttyTypeScript ← TypeScript.Create[info: [parent: g.container,
wx: 0, wy: heightSoFar, ww: 0, wh: 800, border: FALSE]]; -- 800 due to viewers bug
Containers.ChildXBound[g.container, g.ttyTypeScript];
Containers.ChildYBound[g.container, g.ttyTypeScript];
ViewerOps.SetOpenHeight[g.container, heightSoFar + 200]};
BoolLabels: ARRAY BOOL OF Rope.Text ← --=-- [FALSE: "FALSE", TRUE: "TRUE"];
PushButton: Buttons.ButtonProc = TRUSTED {
SELECT NARROW[parent, ViewerClasses.Viewer] FROM
g.attachEditorButton => {
g.attachsymbiote ← ~g.attachsymbiote;
Labels.Set[g.attachEditorLabel, BoolLabels[g.attachsymbiote]];
-- this prints on the msgwindow after acquiring the lock
IF g.attachsymbiote THEN MDMain.AttachSymbiote[g.msgout]
ELSE MDMain.DetachSymbiote[g.msgout]};
g.confirmButton => {
g.confirm↑ ← ~g.confirm↑;
Labels.Set[g.confirmLabel, BoolLabels[g.confirm↑]]};
g.debuggingButton => {
Subr.debugflg ← ~Subr.debugflg;
Labels.Set[g.debuggingLabel, BoolLabels[Subr.debugflg]];
-- this prints on the msgwindow after acquiring the lock
MDUtil.AcquireMsgLock[];
g.msgout.PutF["Debugging is now %g.\n", IO.bool[Subr.debugflg]
! UNWIND => {MDUtil.ReleaseMsgLock[]}];
MDUtil.ReleaseMsgLock[]};
g.noticeFileNameButton =>
ViewerTools.SetSelection[g.noticeFileNameViewer, NIL];
g.setWorkingFileNameButton =>
ViewerTools.SetSelection[g.setWorkingModelViewer, NIL];
g.startModellingFileNameButton =>
ViewerTools.SetSelection[g.startModellingFileNameViewer, NIL];
g.touchFileNameButton =>
ViewerTools.SetSelection[g.touchFileNameViewer, NIL];
ENDCASE => ERROR};
GetVString: PROC[viewer: ViewerClasses.Viewer] RETURNS[contentsRef: Rope.Text] = {
vString: Rope.ROPE = ViewerTools.GetContents[viewer];
RETURN[IF vString.Length = 0 THEN NIL ELSE RopeInline.InlineFlatten[vString]]};
SetUpLogStreams: PROC[ts: TypeScript.TS, fileName: Rope.Text, createTTY: BOOL]
RETURNS[out, file, in: IO.Handle, tty: Subr.TTYProcs] = {
file ← FileIO.Open[fileName, overwrite];
[in, out] ← ViewerIO.CreateViewerStreams[viewer: ts, name: NIL, editedStream: FALSE];
out ← IO.CreateDribbleStream[out, file];
tty ← IF createTTY THEN Subr.MakeTTYProcs[in, out, ts, MyConfirm] ELSE NIL};
MyConfirm: PROC[in, out: IO.Handle, data: REF ANY, msg: Rope.ROPE, dch: CHAR]
RETURNS[CHAR] = {
out.PutRope[msg];
DO
ENABLE IO.Signal => TRUSTED {IF ec = Rubout THEN LOOP};
bs: IO.Handle = (IF in.backingStream = NIL THEN in ELSE in.backingStream);
ch: CHAR;
out.PutF["? "];
ch ← bs.GetChar[];
RETURN[Rope.Lower[IF ch = '\n THEN dch ELSE ch]];
ENDLOOP};
-- print to viewers screen
ToolTTYProc: PROC[ch: CHAR] = {
(g.ttyout).PutChar[ch]};
-- file acquisition
GetFile: PROC[viewer: ViewerClasses.Viewer, ext: Rope.Text] RETURNS [ref: Rope.Text] = {
ref ← GetVString[viewer];
IF ref = NIL THEN {
MDMain.PrintSeparatorLine[];
CWF.WF0["Error - Must specify a filename.\n"L];
MDMain.PrintSeparatorLine[];
RETURN};
IF ref.Length[] > 0 AND ~MDUtil.AnyR[ref, '.] THEN
ref ← RopeInline.InlineFlatten[Rope.Cat[ref, ext]];
RETURN};
BeginProc: Menus.MenuProc = TRUSTED {
IF ChkIdle[g.msgout] THEN {
modelRef: Rope.Text = GetFile[g.startModellingFileNameViewer, ".model"];
IF modelRef = NIL THEN RETURN;
[] ← Subr.LongZone[]; -- this forces Subr.SubrInit to be called
Process.Detach[FORK MDMain.Begin[
action: NEW[MDMain.Transaction←[
modelRef, FALSE,
g.tty, g.ttyTypeScript, g.ttyin, g.ttyout, g.msgout, g.debugout]],
confirm: g.confirm]]}};
CompileProc: Menus.MenuProc = TRUSTED {
IF ChkIdle[g.msgout] THEN {
modelRef: Rope.Text = GetFile[g.startModellingFileNameViewer, ".model"];
IF modelRef = NIL THEN RETURN;
[] ← Subr.LongZone[]; -- this forces Subr.SubrInit to be called
Process.Detach[FORK MDMain.Compile[
action: NEW[MDMain.Transaction←[
modelRef, FALSE,
g.tty, g.ttyTypeScript, g.ttyin, g.ttyout, g.msgout, g.debugout]],
uniquename: FALSE, -- ignored-- tryreplacement: FALSE,
confirm: g.confirm]]}};
ContinueProc: Menus.MenuProc = TRUSTED {
IF ChkIdle[g.msgout] THEN
Process.Detach[FORK MDMain.Continue[g.confirm]]};
LoadAllProc: Menus.MenuProc = TRUSTED {
IF ChkIdle[g.msgout] THEN
Process.Detach[FORK MDMain.Loader[FALSE]]};
LoadWithReplProc: Menus.MenuProc = TRUSTED {
IF ChkIdle[g.msgout] THEN
Process.Detach[FORK MDMain.Loader[TRUE]]};
NoticeProc: Menus.MenuProc = TRUSTED {
IF ChkIdle[g.msgout] THEN {
noticeRef: Rope.Text = GetFile[g.noticeFileNameViewer, ".mesa"];
IF noticeRef = NIL THEN RETURN;
Process.Detach[FORK MDMain.Notice[noticeRef]]}};
NoticeAllProc: Menus.MenuProc = TRUSTED {
IF ChkIdle[g.msgout] THEN
Process.Detach[FORK MDMain.NoticeAll[]]};
-- Permanent is disabled
PermanentProc: Menus.MenuProc = TRUSTED {
IF ChkIdle[g.msgout] THEN
Process.Detach[FORK MDMain.Permanent[]]};
ReStartModellingProc: Menus.MenuProc = TRUSTED {
IF ChkIdle[g.msgout] THEN {
modelRef: Rope.Text = GetFile[g.startModellingFileNameViewer, ".model"];
IF modelRef = NIL THEN RETURN;
[] ← Subr.LongZone[]; -- this forces Subr.SubrInit to be called
Process.Detach[FORK MDMain.ReStartModelling[
NEW[MDMain.Transaction←[
modelRef, FALSE,
g.tty, g.ttyTypeScript, g.ttyin, g.ttyout, g.msgout, g.debugout]]]]}};
SetWorkingModelProc: Menus.MenuProc = TRUSTED {
IF ChkIdle[g.msgout] THEN {
modelRef: Rope.Text = GetFile[g.setWorkingModelViewer, ".model"];
IF modelRef = NIL THEN RETURN;
Process.Detach[FORK MDMain.SetWorkingModel[modelRef]]}};
StartProc: Menus.MenuProc = TRUSTED {
IF ChkIdle[g.msgout] THEN
Process.Detach[FORK MDMain.Start[]]};
StartModellingProc: Menus.MenuProc = TRUSTED {
IF ChkIdle[g.msgout] THEN {
modelRef: Rope.Text = GetFile[g.startModellingFileNameViewer, ".model"];
IF modelRef = NIL THEN RETURN;
[] ← Subr.LongZone[]; -- this forces Subr.SubrInit to be called
Process.Detach[FORK MDMain.StartModelling[
NEW[MDMain.Transaction←[
modelRef, FALSE,
g.tty, g.ttyTypeScript, g.ttyin, g.ttyout, g.msgout, g.debugout]]]]}};
StopModellingProc: Menus.MenuProc = TRUSTED {
IF ChkIdle[g.msgout] THEN
Process.Detach[FORK MDMain.StopModelling[]]};
TemporaryProc: Menus.MenuProc = TRUSTED {
IF ChkIdle[g.msgout] THEN
Process.Detach[FORK MDMain.Temporary[]]};
TouchProc: Menus.MenuProc = TRUSTED {
IF ChkIdle[g.msgout] THEN {
date: Subr.PackedTime ← Time.Current[];
cap: File.Capability;
fileRef: Rope.Text = GetFile[g.touchFileNameViewer, ".mesa"];
MDMain.PrintSeparatorLine[];
IF fileRef = NIL THEN RETURN;
CWF.WF2["Touch %s: time set to %lt\n"L, LOOPHOLE[fileRef], @date];
cap ← Directory.Lookup[fileName: LOOPHOLE[fileRef], permissions: Directory.ignore
! Directory.Error => {
CWF.WF1["Error - Can't find file '%s'.\n"L, LOOPHOLE[fileRef]];
GOTO out}];
FileStream.SetLeaderPropertiesForCapability[cap: cap, create: [date]];
CWF.WF0["Now calling Notice.\n"L];
Process.Detach[FORK MDMain.Notice[fileRef]];
EXITS
out => NULL}
};
TypeWDefaultsProc: Menus.MenuProc = TRUSTED {
IF ChkIdle[g.msgout] THEN {
fileRef: Rope.Text = GetFile[g.setWorkingModelViewer, ".model"];
Process.Detach[FORK MDMain.Type[fileRef, TRUE]]}};
TypeWODefaultsProc: Menus.MenuProc = TRUSTED {
IF ChkIdle[g.msgout] THEN {
fileRef: Rope.Text = GetFile[g.setWorkingModelViewer, ".model"];
Process.Detach[FORK MDMain.Type[fileRef, FALSE]]}};
UnloadProc: Menus.MenuProc = TRUSTED {
IF ChkIdle[g.msgout] THEN
Process.Detach[FORK MDMain.UnLoader[]]};
NullTTYProc: PROC[ch: CHAR] = {}; -- prints nothing
MyDestroy: ViewerEvents.EventProc = TRUSTED {
IF g = NIL OR event ~= destroy OR viewer ~= g.container THEN RETURN;
[] ← CWF.SetWriteProcedure[NullTTYProc]; -- turn off printing
MDMain.DetachSymbiote[g.msgout];
[] ← DBStash.ForceOut[];
Subr.SubrStop[];
g.ttyFile.Close[];
g.msgFile.Close[];
IF g.makewizard THEN g.debugFile.Close[];
g ← NIL;
ViewerEvents.UnRegisterEventProc[$destroyEventRegistration, $destroy]};
MyAbort: Menus.MenuProc = TRUSTED {
TypeScript.SetUserAbort[g.ttyTypeScript]};
-- common utility procedures
GetDefaultsFromUserProfile: PROC
RETURNS[attacheditor, confirmCompilation, makewizard: BOOL, defaultFile: Rope.Text] = {
defaultFile ← RopeInline.InlineFlatten[UserProfile.Token["Modeller.DefaultModel", NIL]];
attacheditor ← UserProfile.Boolean["Modeller.AttachEditor", TRUE]; -- default is true
confirmCompilation ← UserProfile.Boolean["Modeller.Confirm", FALSE]; -- default is false
makewizard ← UserProfile.Boolean["Modeller.Wizard", FALSE]}; -- default is false
ChkIdle: PROC[out: IO.Handle] RETURNS[chkok: BOOL] = {
IF ~MDMain.modellerIsIdle THEN {
MDUtil.AcquireMsgLock[];
out.Put[IO.string["Modeller is not ready yet.\nTry again in a few seconds.\n"L]
! UNWIND => MDUtil.ReleaseMsgLock[]];
out.Flush[];
ViewerOps.BlinkIcon[g.container];
MDUtil.ReleaseMsgLock[];
RETURN[FALSE]};
RETURN[TRUE]};
SetTTY: PROC = {
[] ← CWF.SetWriteProcedure[ToolTTYProc]};
-- initialization code
LoadPackage: PROC[file: LONG STRING] = {
CWF.WF1["Loading %s ... "L, file];
{
ENABLE ANY => { CWF.WF0["failed.\n"L]; GOTO out};
cap: File.Capability = Directory.Lookup[file];
Runtime.RunConfig[file: cap, offset: 1, codeLinks: TRUE];
CWF.WF0["done.\n"L];
EXITS
out => NULL;
}};
Init: PROC = {
-- This makes sure the global variables in MDMainImpl are initialized
START MDMain.MDMainImpl;
BuildOuter[]; -- fire up the tool
-- the main program exits at this point
-- SimpleExec will call these procedures when the user invokes them
-- TemporarySpecialExecOps is only available to the modeller if
-- Compiler.Bcd has been loaded BEFORE loaderpack accumulates
-- all the system interface records
IF ~Runtime.IsBound[LowLoader.LoadBcdAndCount] THEN
LoadPackage["LoaderPack.bcd"L];
IF ~Runtime.IsBound[DBStash.Insert] THEN
LoadPackage["DBStashPack.bcd"L];
MDMain.modellerIsIdle ← TRUE};
Init[];
}.