
<<SMIntImpl.mesa>>
<<Copyright © 1985 by Xerox Corporation.  All rights reserved.>>
<<last edit by Satterthwaite, May 29, 1986 12:00:08 pm PDT>>

DIRECTORY
BasicTime: TYPE USING [GMT, nullGMT],
Buttons: TYPE USING [Button, ButtonProc],
Commander: TYPE USING [CommandProc, Register],
Containers: TYPE USING [ChildXBound, ChildYBound, Container, Create],
CS: TYPE USING [EndsIn, GMTFromRope, Init, RootName, RopeFromGMT, ShortName],
FS: TYPE USING [
OpenFile, nullOpenFile,
Create, Error, FileInfo, GetInfo, GetName, Open, StreamFromOpenFile],
IO: TYPE USING [card, Close, PutChar, PutF, PutFR, PutRope, RIS, rope, STREAM, time],
Labels: TYPE USING [Create, Label, Set, SetDisplayStyle],
List: TYPE USING [DRemove],
MBQueue: TYPE USING [Create, CreateMenuEntry, CreateButton, Flush, Queue],
Menus: TYPE USING [CreateEntry, CreateMenu, InsertMenuEntry, Menu, MenuProc],
Process: TYPE USING [Abort, CheckForAbort, GetCurrent],
ProcessProps: TYPE USING [GetProp],
Rope: TYPE USING [Concat, Equal, Find, Flatten, IsEmpty, Length, ROPE, Substr, Text],
Rules: TYPE USING [Create, Rule],
SMBcd: TYPE USING [WriteModelBcd],
SMComp: TYPE USING [CompileAll, LoadCompiler],
SMDF: TYPE USING [WriteDFFile],
SMEval: TYPE USING [Equiv, Eval],
SMFI: TYPE USING [SrcFileInfo],
SMFIOps: TYPE USING [
Ambiguous, EvaluateUnitId, Reset, NewestBcd, NewestSource, UnitToRope],
SMLDriver: TYPE USING [Bind, LoadAndBind, Loaded, StartAll, Started, Unload],
SMOps: TYPE USING [MS, NewModel, PatchList],
SMProj: TYPE USING [Proj, Reset],
SMUtil: TYPE USING [ParseStream, PrettyPrint, PrintTree],
SMTree: TYPE Tree USING [Ext, Handle, Link, null],
SMTreeOps: TYPE TreeOps USING [
GetExt, Initialize, Finalize, Map, NthSon, OpName, PutExt, PutNthSon,
Scan, ScanSons, UpdateLeaves],
TiogaMenuOps: TYPE USING [Open],
TypeScript: TYPE USING [TS, Create],
ViewerClasses: TYPE USING [Viewer],
ViewerEvents: TYPE USING [
EventProc, EventRegistration, RegisterEventProc, UnRegisterEventProc],
ViewerIO: TYPE USING [CreateViewerStreams],
ViewerOps: TYPE USING [
AddProp, EstablishViewerPosition, FetchProp, PaintViewer, SetMenu, SetOpenHeight],
ViewerTools: TYPE USING [
EnableUserEdits, GetContents, GetSelectionContents, InhibitUserEdits, MakeNewTextViewer,
SetContents, SetSelection];

SMIntImpl: CEDAR PROGRAM
IMPORTS
Commander, Containers, CS, FS, MBQueue, IO, Labels, List, Menus,
Process, ProcessProps, Rope, Rules,
SMBcd, SMComp, SMDF, SMEval, SMFIOps, SMLDriver, SMOps, SMProj, SMUtil, SMTreeOps,
TiogaMenuOps, TypeScript, ViewerEvents, ViewerOps, ViewerIO, ViewerTools ~ {
OPEN Tree~~SMTree, TreeOps~~SMTreeOps;

<<modeller state>>

ModelState: TYPE~{        -- ordered
idle, unparsed, parsed, checked, compiled, loaded, run};

<<global data>>
Global: TYPE ~ REF GlobalRecord;
GlobalRecord: TYPE ~ RECORD[
<<viewers data>>
container: Containers.Container_NIL,
ttyin: IO.STREAM_NIL,
ttyout: IO.STREAM_NIL,
msgout: IO.STREAM_NIL,
<<viewers fields>>
modelFileNameButton: Buttons.Button_NIL,
modelFileNameViewer: ViewerClasses.Viewer_NIL,
wDirNameButton: Buttons.Button_NIL,
wDirNameViewer: ViewerClasses.Viewer_NIL,
attachEditorButton: Buttons.Button_NIL,
attachEditorLabel: Labels.Label_NIL,
<<modelling state>>
state: ModelState_$idle,
stateLabel: Labels.Label_NIL,
replaceable: BOOL_FALSE,
<<other objects>>
process: UNSAFE PROCESS_NIL,        -- current menu process (NIL if none)
q: MBQueue.Queue_MBQueue.Create[],
noticeList: LIST OF Rope.Text_NIL,    -- files that have been noticed
attachEditor: BOOL_TRUE,
attachEditorRef: REF ANY_NIL,
model: SMOps.MS_NIL,                    -- non-NIL iff state # $idle
modelFileName: Rope.ROPE_NIL,
modelFileVersion: BasicTime.GMT_BasicTime.nullGMT,
wDir: Rope.ROPE_NIL,
modelUpdated: BOOL_FALSE,
modelSuperseded: BOOL_FALSE,
debugLevel: NAT_NAT.LAST  --  <= 1: parse tree, <=2: value tree, <= 3: pp value
];

<<MDS usage>>
globalList: LIST OF Global _ NIL;    -- not properly monitored
destroyEventRegistration: ViewerEvents.EventRegistration;
<<end of MDS usage>>

<<these are commands for the viewers world>>

entryHeight: NAT ~ 15;
entryVSpace: NAT ~ 7;
entryHSpace: NAT ~ 10;

Create: PROC[wDir: Rope.ROPE] RETURNS[g: Global] ~ {
ttyTypeScript, msgTypeScript: TypeScript.TS;
vName: Rope.ROPE ~ IO.PutFR["Cedar Modeller 6.1a, started on %t", IO.time[]];
menu: Menus.Menu ~ Menus.CreateMenu[lines~3];

QMenuItem: PROC[name: Rope.ROPE, proc: Menus.MenuProc, line: NAT] ~ {
menu.InsertMenuEntry[(g.q).CreateMenuEntry[name, proc, g], line]};

MenuItem: PROC[name: Rope.ROPE, proc: Menus.MenuProc, line: NAT] ~ {
menu.InsertMenuEntry[Menus.CreateEntry[name, proc, g], line]};

g _ NEW[GlobalRecord _ [
container~Containers.Create[
info~[name~vName, iconic~FALSE, scrollable~FALSE, column~$right]]]
];
ViewerOps.AddProp[g.container, $SMGlobalRef, g];
<<first row of menu items>>
QMenuItem["Debug", Debug, 0];
QMenuItem["StopModel", StopModel, 0];
QMenuItem["Continue", Continue, 0];
QMenuItem["Begin", Begin, 0];
QMenuItem["NoticeAll", NoticeAll, 0];
QMenuItem["StartModel", StartModel, 0];
<<second row of menu items>>
MenuItem["NewModeller", NewModeller, 1];
QMenuItem["Bind", Bind, 1];
QMenuItem["MakeDFFile", MakeDFFile, 1];
QMenuItem["MakeModelBcd", MakeModelBcd, 1];
<<third row of menu items>>
MenuItem["Abort", Abort, 2];
QMenuItem["Unload", Unload, 2];
QMenuItem["Start", Start, 2];
QMenuItem["Load", Load, 2];
QMenuItem["Compile", Compile, 2];
QMenuItem["Check", Check, 2];
MenuItem["Open", Open, 2];
<<>>
ViewerOps.SetMenu[g.container, menu, FALSE];
[ttyTypeScript, msgTypeScript] _ BuildUserInput[g, wDir];
<<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];
[in~g.ttyin, out~g.ttyout] _ ViewerIO.CreateViewerStreams[viewer~ttyTypeScript, name~NIL];
g.msgout _ ViewerIO.CreateViewerStreams[viewer~msgTypeScript, name~NIL].out;
IF g.attachEditor THEN AttachSymbiote[g];
globalList _ CONS[g, globalList]};

BuildUserInput: PROC[g: Global, wDir: Rope.ROPE]
RETURNS[ttyTypeScript, msgTypeScript: TypeScript.TS] ~ {
heightSoFar: CARDINAL _ 0;
l: ViewerClasses.Viewer _ NIL;
rule: Rules.Rule;

CreateButton: PROC[bName, lName: Rope.ROPE, newLine: BOOL, drawRule: BOOL_FALSE]
RETURNS[button: Buttons.Button, label: Labels.Label] ~ {
x: CARDINAL;
IF newLine THEN {
heightSoFar _ heightSoFar + entryVSpace/2;
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 _ (g.q).CreateButton[
info~[name~bName, parent~g.container, border~FALSE, wx~x, wy~heightSoFar],
proc~PushButton,
clientData~g];
IF lName ~= NIL THEN
l _ label _ Labels.Create[info~[
name~lName, parent~g.container,
wx~button.wx+button.ww+entryHSpace, wy~heightSoFar, border~FALSE]];
};

<<first line>>
[g.modelFileNameButton, ] _ CreateButton["ModelName:", NIL, TRUE];
l _ g.modelFileNameViewer _ 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.modelFileNameViewer];
heightSoFar _ heightSoFar + l.wh + entryVSpace/2;
<<second line>>
[g.wDirNameButton, ] _ CreateButton["Working Directory:", NIL, TRUE];
l _ g.wDirNameViewer _ 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.wDirNameViewer];
ViewerTools.SetContents[g.wDirNameViewer, wDir];
heightSoFar _ heightSoFar + l.wh + entryVSpace/2;
<<third line>>
heightSoFar _ heightSoFar + entryVSpace/2;
l _ Labels.Create[info~[
name~"State: ", parent~g.container, wx~0, wy~heightSoFar, border~FALSE]];
l _ g.stateLabel _ Labels.Create[info~[
name~"wwwwww",
parent~g.container, wx~l.wx+l.ww+entryHSpace, wy~heightSoFar, border~FALSE]];
SetState[g, $idle];
[g.attachEditorButton, g.attachEditorLabel] _ CreateButton["AttachEditor:", "FALSE", FALSE];
IF g.attachEditor THEN Labels.Set[g.attachEditorLabel, "TRUE"];
heightSoFar _ heightSoFar + l.wh + entryVSpace/2;
<<>>
<<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>>
msgTypeScript _ TypeScript.Create[
info~[parent~g.container, wx~0, wy~heightSoFar, ww~0, wh~25, border~FALSE]];
Containers.ChildXBound[g.container, msgTypeScript];
heightSoFar _ heightSoFar + entryVSpace + 20;
<<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>>
ttyTypeScript _ TypeScript.Create[
info~[parent~g.container, wx~0, wy~heightSoFar, ww~0, wh~80, border~FALSE]];
heightSoFar _ heightSoFar + entryVSpace + 80;
Containers.ChildXBound[g.container, ttyTypeScript];
Containers.ChildYBound[g.container, ttyTypeScript];
ViewerOps.SetOpenHeight[g.container, heightSoFar + 200]};

SetState: PROC[g: Global, state: ModelState] ~ {
Labels.SetDisplayStyle[g.stateLabel, $BlackOnWhite];
Labels.Set[g.stateLabel, SELECT state FROM
$idle => "idle",
$unparsed => "unparsed",
$parsed => "parsed",
$checked => "checked",
$compiled => "compiled",
$loaded => "loaded",
$run => "started",
ENDCASE => "ERROR"];
g.state _ state};

PushButton: Buttons.ButtonProc ~ {
g: Global ~ NARROW[clientData];
SELECT NARROW[parent, Buttons.Button] FROM
g.modelFileNameButton =>
ViewerTools.SetSelection[g.modelFileNameViewer, NIL];
g.wDirNameButton =>
ViewerTools.SetSelection[g.wDirNameViewer, NIL];
g.attachEditorButton => {
g.attachEditor _ ~g.attachEditor;
Labels.Set[g.attachEditorLabel, IF g.attachEditor THEN "TRUE" ELSE "FALSE"];
IF g.attachEditor THEN AttachSymbiote[g] ELSE DetachSymbiote[g, TRUE]};
ENDCASE => ERROR;
};

<<MENU PROCS>>

Abort: Menus.MenuProc ~ TRUSTED {
<<not on the queue>>
g: Global ~ NARROW[clientData];
(g.q).Flush[];
IF g.process # NIL THEN Process.Abort[g.process]};    -- not properly monitored

Begin: Menus.MenuProc ~ {
g: Global ~ NARROW[clientData];
g.process _ Process.GetCurrent[];
{
ENABLE ABORTED => {GOTO out};
InternalUnload[g, TRUE];
IF g.state = $idle OR g.modelSuperseded THEN InternalStartModel[g];
InternalParse[g, TRUE];
IF g.state >= $parsed THEN ClearExtensions[g.model.tree];
InternalCheck[g];
InternalCompile[g, FALSE];
InternalLoad[g, FALSE];
InternalStart[g];
g.process _ NIL;
EXITS
out => {g.ttyout.PutRope["Begin aborted\n"]};
};
SetState[g, g.state]};

Bind: Menus.MenuProc ~ {
g: Global ~ NARROW[clientData];
g.process _ Process.GetCurrent[];
{
ENABLE ABORTED => {GOTO out};
IF g.state = $idle OR g.modelSuperseded THEN InternalStartModel[g];
InternalParse[g, TRUE];
InternalCheck[g];
InternalCompile[g, g.replaceable];
InternalBind[g];
g.process _ NIL;
EXITS
out => {g.ttyout.PutRope["Bind aborted\n"]};
};
SetState[g, g.state]};

Check: Menus.MenuProc ~ {
g: Global ~ NARROW[clientData];
g.process _ Process.GetCurrent[];
{
ENABLE ABORTED => {GOTO out};
IF g.state = $idle OR g.modelSuperseded THEN InternalStartModel[g];
InternalParse[g, TRUE];
InternalCheck[g];
g.process _ NIL;
EXITS
out => {g.ttyout.PutRope["Check aborted\n"]};
};
SetState[g, g.state]};

Compile: Menus.MenuProc ~ {
g: Global ~ NARROW[clientData];
g.process _ Process.GetCurrent[];
{
ENABLE ABORTED => {GOTO out};
IF g.state = $idle OR g.modelSuperseded THEN InternalStartModel[g];
InternalParse[g, TRUE];
InternalCheck[g];
InternalCompile[g, FALSE];
g.process _ NIL;
EXITS
out => {g.ttyout.PutRope["Compile aborted\n"]};
};
SetState[g, g.state]};

Continue: Menus.MenuProc ~ {
g: Global ~ NARROW[clientData];
g.process _ Process.GetCurrent[];
{
ENABLE ABORTED => {GOTO out};
IF g.state = $idle OR g.modelSuperseded THEN InternalStartModel[g];
InternalParse[g, TRUE];
InternalCheck[g];
InternalCompile[g, g.replaceable];
InternalLoad[g, g.replaceable];
InternalStart[g];
g.process _ NIL;
EXITS
out => {g.ttyout.PutRope["Continue aborted\n"]};
};
SetState[g, g.state]};

Debug: Menus.MenuProc ~ {
g: Global ~ NARROW[clientData];
g.ttyout.PutRope["---------------\n"];
IF g.state = $idle THEN {
ENABLE ABORTED => {GOTO out};
g.model _ SMOps.NewModel[g.ttyin, g.ttyout, g.ttyout];
(g.model.tm).Initialize;
g.model.tree _ SMUtil.ParseStream[g.model, IO.RIS[ViewerTools.GetSelectionContents[]]];
IF g.model.tree # Tree.null THEN {
IF g.debugLevel <= 1 THEN SMUtil.PrintTree[g.model, g.model.tree];
SMUtil.PrettyPrint[g.model.out, g.model.tree, g.model.comments]};
IF g.model.tree # Tree.null THEN {
g.model.val _ SMEval.Eval[g.model, g.model.tree, NIL];
g.model.out.PutRope["\n\n"];
SMUtil.PrintTree[g.model, g.model.val];
SMUtil.PrettyPrint[g.model.out, g.model.val, NIL];
g.model.val _ NIL};
g.model _ NIL;
EXITS
out => {g.ttyout.PutRope["Debug aborted\n"]};
};
g.ttyout.PutRope["---------------\n"]};

Load: Menus.MenuProc ~ {
g: Global ~ NARROW[clientData];
g.process _ Process.GetCurrent[];
{
ENABLE ABORTED => {GOTO out};
InternalLoad[g, FALSE];
g.process _ NIL;
EXITS
out => {g.ttyout.PutRope["Load aborted\n"]};
};
SetState[g, g.state]};

MakeDFFile: Menus.MenuProc ~ {
g: Global ~ NARROW[clientData];
g.process _ Process.GetCurrent[];
{
ENABLE ABORTED => {GOTO out};
IF g.state >= $checked THEN {
InternalTemporary[g];
SMDF.WriteDFFile[g.model, g.model.val, g.modelFileName]};
g.process _ NIL;
EXITS
out => {g.ttyout.PutRope["MakeDFFile aborted\n"]};
};
};

MakeModelBcd: Menus.MenuProc ~ {
g: Global ~ NARROW[clientData];
g.process _ Process.GetCurrent[];
{
ENABLE ABORTED => {GOTO out};
IF g.state >= $checked THEN {
InternalTemporary[g];
SMBcd.WriteModelBcd[g.model, g.model.val, g.modelFileName]};
g.process _ NIL;
EXITS
out => {g.ttyout.PutRope["MakeModelBcd aborted\n"]};
};
};

NewModeller: Menus.MenuProc ~ {
g: Global ~ NARROW[clientData];
[] _ Create[ViewerTools.GetContents[g.wDirNameViewer]]};

NoticeAll: Menus.MenuProc ~ {
g: Global ~ NARROW[clientData];
g.process _ Process.GetCurrent[];
{
ENABLE ABORTED => {GOTO out};
InternalNoticeAll[g];
g.process _ NIL;
EXITS
out => {g.ttyout.PutRope["NoticeAll aborted\n"]};
};
};

Open: Menus.MenuProc ~ {
g: Global ~ NARROW[clientData];
g.process _ Process.GetCurrent[];
{
ENABLE ABORTED => {GOTO out};
OpenViewer[g];
g.process _ NIL;
EXITS
out => {g.ttyout.PutRope["Open aborted\n"]};
};
};

StartModel: Menus.MenuProc ~ {
g: Global ~ NARROW[clientData];
g.process _ Process.GetCurrent[];
{
ENABLE ABORTED => {GOTO out};
InternalStartModel[g];
InternalParse[g];
g.process _ NIL;
EXITS
out => {g.ttyout.PutRope["StartModelling aborted\n"]};
};
SetState[g, g.state]};

Start: Menus.MenuProc ~ {
g: Global ~ NARROW[clientData];
g.process _ Process.GetCurrent[];
{
ENABLE ABORTED => {GOTO out};
InternalStart[g];
g.process _ NIL;
EXITS
out => {g.ttyout.PutRope["Start aborted\n"]};
};
SetState[g, g.state]};

StopModel: Menus.MenuProc ~ {
g: Global ~ NARROW[clientData];
g.process _ Process.GetCurrent[];
{
ENABLE ABORTED => {GOTO out};
InternalStopModel[g];
g.process _ NIL;
EXITS
out => {g.ttyout.PutRope["StopModelling aborted\n"]};
};
SetState[g, $idle]};

Unload: Menus.MenuProc ~ {
g: Global ~ NARROW[clientData];
g.process _ Process.GetCurrent[];
{
ENABLE ABORTED => {GOTO out};
InternalUnload[g, TRUE];
g.process _ NIL;
EXITS
out => {g.ttyout.PutRope["Unload aborted\n"]};
};
SetState[g, g.state]};

<<SUPPORT ROUTINES>>

AttachSymbiote: PROC[g: Global] ~ {
IF g.attachEditorRef = NIL THEN
g.attachEditorRef _ ViewerEvents.RegisterEventProc[SaveEvent, $save];
g.msgout.PutRope["Editor set to call this modeller.\n"]};

DetachSymbiote: PROC[g: Global, print: BOOL] ~ {
IF g.attachEditorRef ~= NIL THEN
ViewerEvents.UnRegisterEventProc[g.attachEditorRef, $save];
g.attachEditorRef _ NIL;
IF print THEN g.msgout.PutRope["Editor detached from this modeller.\n"]};

SaveEvent: ViewerEvents.EventProc ~ {
<<this is the procedure called by the editor>>
<<can't print anything in this procedure>>
ENABLE ANY => {GOTO out};
IF viewer.file # NIL THEN {
tag: Rope.ROPE ~ CS.ShortName[viewer.file];
IF CS.EndsIn[tag, ".mesa"] THEN    -- only source now
FOR l: LIST OF Global _ globalList, l.rest UNTIL l = NIL DO
l.first.noticeList _ CONS[tag.Flatten[], l.first.noticeList];
ENDLOOP
ELSE IF CS.EndsIn[tag, ".model"] THEN
FOR l: LIST OF Global _ globalList, l.rest UNTIL l = NIL DO
IF tag.Equal[l.first.modelFileName, FALSE] THEN l.first.modelSuperseded _ TRUE;
ENDLOOP
};
EXITS
out => NULL;
};

DestroyEvent: ViewerEvents.EventProc ~ {
IF event = $destroy AND globalList # NIL THEN {
g: Global ~ NARROW[ViewerOps.FetchProp[viewer, $SMGlobalRef]];
IF g ~= NIL THEN {
DetachSymbiote[g, FALSE];
FOR l: LIST OF Global _ globalList, l.rest UNTIL l = NIL DO
IF l.first.container = viewer THEN TRUSTED {
globalList _ LOOPHOLE[List.DRemove[ref~l.first, list~LOOPHOLE[globalList]]];
EXIT};
ENDLOOP;
IF globalList = NIL THEN {
SMFIOps.Reset[];  SMProj.Reset[];
ViewerEvents.UnRegisterEventProc[destroyEventRegistration, $destroy];
destroyEventRegistration _ NIL}
};
};
};


OpenViewer: PROC[g: Global] ~ {
selection: Rope.ROPE ~ ViewerTools.GetSelectionContents[];
index: INT ~ selection.Find[s2~"!"];
name, version: Rope.ROPE;
create: BasicTime.GMT;
{
fName: Rope.ROPE;
IF index = -1 THEN {name _ selection; version _ NIL}
ELSE {
name _ selection.Substr[0, index];
version _ selection.Substr[index+1, selection.Length-index-1]};
IF name.Find[s2~"."] = -1 THEN name _ name.Concat[".model"];
IF SMFIOps.Ambiguous[version] THEN create _ BasicTime.nullGMT
ELSE {
create _ CS.GMTFromRope[version
! UNWIND => NULL;
ANY => {GOTO badSyntax}];
};
fName _ FS.FileInfo[name~name, wantedCreatedTime~create,
wDir~(IF g.model # NIL
THEN g.model.wDir
ELSE ViewerTools.GetContents[g.wDirNameViewer])
! FS.Error => {
IF error.code = $illegalName THEN GOTO badSyntax
ELSE GOTO noFile}].fullFName;
IF SMFIOps.Ambiguous[version] THEN fName _ fName.Substr[0, fName.Find[s2~"!"]];
[] _ TiogaMenuOps.Open[fName];
EXITS
badSyntax => g.ttyout.PutRope["Error - selection is an ill-formed file name\n"];
noFile => g.ttyout.PutF["Error - file %g could not be opened\n", IO.rope[name]];
}
};


InternalStartModel: PROC[g: Global] ~ {
modelFileName: Rope.ROPE;
wDir: Rope.ROPE;
IF g.state ~= $idle THEN InternalStopModel[g];
<<now set the contents>>
wDir _ ViewerTools.GetContents[g.wDirNameViewer];
modelFileName _ ViewerTools.GetContents[g.modelFileNameViewer];
IF modelFileName.IsEmpty THEN {
g.ttyout.PutRope["Error - no model source input file\n"];
GOTO failed};
IF ~CS.EndsIn[modelFileName, ".model"] THEN
modelFileName _ modelFileName.Concat[".model"];
g.model _ SMOps.NewModel[g.ttyin, g.ttyout, g.msgout];
(g.model.tm).Initialize;
g.modelFileName _ modelFileName;
g.model.wDir _ wDir;
g.modelUpdated _ g.modelSuperseded _ FALSE;
SetState[g, $unparsed];
ViewerTools.InhibitUserEdits[g.modelFileNameViewer];
ViewerTools.InhibitUserEdits[g.wDirNameViewer];
EXITS
failed => NULL;
};        -- file remains open

InternalParse: PROC[g: Global, autoNotice: BOOL_FALSE] ~ {
IF g.state = $unparsed THEN {    -- must (re)parse
file: FS.OpenFile _ FS.nullOpenFile;
input: IO.STREAM _ NIL;
file _ FS.Open[name~g.modelFileName, wDir~g.model.wDir
! FS.Error => {
g.ttyout.PutF["Error - file %g could not be opened\n", IO.rope[g.modelFileName]];
GOTO failed}];
input _ file.StreamFromOpenFile[];
g.modelFileVersion _ file.GetInfo[].created;
Labels.SetDisplayStyle[g.stateLabel, $BlackOnGrey];
g.model.tree _ SMUtil.ParseStream[m~g.model, source~input];
input.Close[];
Labels.SetDisplayStyle[g.stateLabel, $BlackOnWhite];
IF g.model.tree # Tree.null THEN {
SetState[g, $parsed];
IF autoNotice THEN InternalNoticeAll[g];
IF g.debugLevel <= 1 THEN {
SMUtil.PrintTree[g.model, g.model.tree];
SMUtil.PrettyPrint[g.model.out, g.model.tree, g.model.comments]};
};
EXITS
failed => NULL;
};
Process.CheckForAbort[]};

InternalNoticeAll: PROC[g: Global] ~ {
nChanged: NAT _ 0;

LookForSource: TreeOps.Scan ~ {
WITH t SELECT FROM
node: Tree.Handle =>
IF TreeOps.OpName[node] = $unitId THEN {
tag: Rope.Text ~ ShortName[node];
SELECT TRUE FROM
CS.EndsIn[tag, ".mesa"] =>
IF NoticeSource[g, node, FALSE] THEN nChanged _ nChanged + 1;
CS.EndsIn[tag, ".model"] =>
IF NoticeSource[g, node, FALSE] THEN {
nChanged _ nChanged + 1;
TreeOps.PutExt[node, Tree.null]};    -- force reparsing of embedded model
CS.EndsIn[tag, ".bcd"] =>
IF  NoticeBcd[g, node] THEN nChanged _ nChanged + 1;
CS.EndsIn[tag, ".modelBcd"] =>
IF  NoticeBcd[g, node] THEN {
nChanged _ nChanged + 1;
TreeOps.PutExt[node, Tree.null]};    -- force reparsing of embedded model
ENDCASE => NULL;
}
ELSE TreeOps.ScanSons[node, LookForSource];
ENDCASE => NULL;
Process.CheckForAbort[]};

g.ttyout.PutChar['\n];
IF g.state >= $parsed THEN {
LookForSource[g.model.tree];  g.noticeList _ NIL};
g.ttyout.PutF["%d files noticed.\n\n", IO.card[nChanged]];
IF nChanged > 0 THEN {
g.modelUpdated _ TRUE;
SetState[g, MIN[g.state, $parsed]];  g.model.val _ NIL};    -- force reevaluation
};

InternalCheck: PROC[g: Global] ~ {
[] _ RecordNoticedFiles[g];
IF g.state = $parsed THEN {    -- must (re)evaluate
g.model.errors _ FALSE;    -- set by evaluation errors
Labels.SetDisplayStyle[g.stateLabel, $BlackOnGrey];
g.model.val _ SMEval.Eval[g.model, g.model.tree, NIL];
Labels.SetDisplayStyle[g.stateLabel, $BlackOnWhite];
IF g.debugLevel <= 2 THEN {
SMUtil.PrintTree[g.model, g.model.val]; (g.model.out).PutRope["\n"]};
IF g.debugLevel <= 3 THEN SMUtil.PrettyPrint[g.model.out, g.model.val, NIL];
IF ~g.model.errors THEN SetState[g, $checked]};
Process.CheckForAbort[]};

InternalCompile: PROC[g: Global, replacement: BOOL] ~ {
IF g.state = $checked THEN {
InternalTemporary[g];
Labels.SetDisplayStyle[g.stateLabel, $BlackOnGrey];
IF ~replacement THEN g.replaceable _ FALSE;
IF SMComp.CompileAll[g.model, g.model.val, replacement].completed THEN
SetState[g, $compiled];
Labels.SetDisplayStyle[g.stateLabel, $BlackOnWhite]};
Process.CheckForAbort[]};

InternalBind: PROC[g: Global] ~ {
IF g.state >= $compiled THEN {
ms: SMOps.MS ~ g.model;
Labels.SetDisplayStyle[g.stateLabel, $BlackOnGrey];
[] _ SMLDriver.Bind[
CS.RootName[g.modelFileName], g.modelFileVersion, ms.val, ms.z, ms.tm, ms.out, ms.wDir];
Labels.SetDisplayStyle[g.stateLabel, $BlackOnWhite]};
Process.CheckForAbort[]};

InternalLoad: PROC[g: Global, replacement: BOOL] ~ {
IF g.state = $compiled THEN {
Labels.SetDisplayStyle[g.stateLabel, $BlackOnGrey];
IF ~(g.model.ls).LoadAndBind[g.model.val, g.model.wDir, replacement].errors THEN {
SetState[g, $loaded];  g.replaceable _ TRUE};
Labels.SetDisplayStyle[g.stateLabel, $BlackOnWhite]};
Process.CheckForAbort[]};

InternalStart: PROC[g: Global] ~ {
IF g.state = $loaded THEN {
Labels.SetDisplayStyle[g.stateLabel, $BlackOnGrey];
IF ~(g.model.ls).Started THEN (g.model.ls).StartAll[g.model.val];
Labels.SetDisplayStyle[g.stateLabel, $BlackOnWhite];
SetState[g, $run]};
Process.CheckForAbort[]};

InternalTemporary: PROC[g: Global] ~ {
FoldPatches[g.model];
IF g.modelUpdated THEN {
IF ~g.modelSuperseded THEN {
file: FS.OpenFile ~ FS.Create[name~g.modelFileName, keep~2, wDir~g.model.wDir];
s: IO.STREAM _ file.StreamFromOpenFile[accessRights~$write];
g.modelFileVersion _ file.GetInfo[].created;
SMUtil.PrettyPrint[s, g.model.tree, g.model.comments];
g.ttyout.PutF["new model on %g\n\n", IO.rope[file.GetName[].fullFName]];
s.Close;
g.modelUpdated _ FALSE}
ELSE g.ttyout.PutF["Warning: model was manually edited, new model not written\n\n"]}
};

InternalStopModel: PROC[g: Global] ~ {
IF g.state # $idle THEN {
InternalTemporary[g];
InternalUnload[g, FALSE];
(g.model.tm).Finalize;
g.replaceable _ g.modelSuperseded _ FALSE;
g.model.val _ NIL;  g.model _ NIL};
<<SMFIOps.Reset[];  SMProj.Reset[];-->>
ViewerTools.EnableUserEdits[g.modelFileNameViewer];
ViewerTools.EnableUserEdits[g.wDirNameViewer];
SetState[g, $idle]};

InternalUnload: PROC[g: Global, unloadBcd: BOOL] ~ {
IF g.model # NIL AND (g.model.ls).Loaded THEN {
Labels.SetDisplayStyle[g.stateLabel, $BlackOnGrey];
(g.model.ls).Unload[g.model.val, unloadBcd];
Labels.SetDisplayStyle[g.stateLabel, $BlackOnWhite];
g.replaceable _ FALSE;
SetState[g, MIN[g.state, $compiled]]};
Process.CheckForAbort[]};


ClearExtensions: PROC[parseTree: Tree.Link] ~ {
<<only does this for the parse tree>>

ANode: TreeOps.Scan ~ {
WITH t SELECT FROM
node: Tree.Handle => {
SELECT TreeOps.OpName[node] FROM
$none, $unitId => NULL;
ENDCASE => TreeOps.PutExt[node, Tree.null];
TreeOps.ScanSons[node, ANode]};
ENDCASE => NULL
};

ANode[parseTree]};


ShortName: PROC[unitId: Tree.Link] RETURNS[Rope.Text] ~ {
RETURN [NARROW[TreeOps.NthSon[unitId, 3]]]};


NoticeFile: PROC[g: Global, unitId: Tree.Link, create: BasicTime.GMT]
RETURNS[changed: BOOL] ~ {
version: Rope.Text ~ NARROW[TreeOps.NthSon[unitId, 4]];
oldCreate: BasicTime.GMT ~ (IF SMFIOps.Ambiguous[version]
THEN BasicTime.nullGMT ELSE CS.GMTFromRope[version]);
changed _ (create # BasicTime.nullGMT AND create # oldCreate);
IF changed THEN {
g.ttyout.PutF["Notice %g\n", IO.rope[ShortName[unitId]]];
TreeOps.PutNthSon[unitId, 4, CS.RopeFromGMT[create].Flatten[]]};
RETURN};

NoticeSource: PROC[g: Global, unitId: Tree.Link, new: BOOL] RETURNS[changed: BOOL] ~ {
fName: Rope.ROPE ~ SMFIOps.UnitToRope[unitId];
fiSrc: SMFI.SrcFileInfo ~ SMFIOps.NewestSource[fName, g.model.wDir];
changed _ NoticeFile[g, unitId, fiSrc.create];
IF changed THEN {
TreeOps.PutExt[unitId, fiSrc];
IF new THEN fiSrc.new _ TRUE};
RETURN};

NoticeBcd: PROC[g: Global, unitId: Tree.Link] RETURNS[changed: BOOL] ~ {
fName: Rope.ROPE ~ SMFIOps.UnitToRope[unitId];
RETURN[NoticeFile[g, unitId, SMFIOps.NewestBcd[fName, g.model.wDir].create]]};


SameTag: PROC[unitId: Tree.Link, tag: Rope.Text] RETURNS[BOOL] ~ {
RETURN[
tag.Equal[ShortName[unitId], FALSE] AND
TreeOps.NthSon[unitId, 1] = Tree.null AND TreeOps.NthSon[unitId, 2] = Tree.null]
}; 

RecordNoticedFiles: PROC[g: Global] RETURNS[noticedFile: BOOL_FALSE] ~ {
maxState: ModelState _ MIN[g.state, $checked];
ms: SMOps.MS ~ g.model;

SameTyped: PROC[oldFile: Tree.Ext, newUnitId: Tree.Link] RETURNS[BOOL] ~ {
IF oldFile = NIL OR maxState < $checked THEN RETURN[FALSE]
ELSE {
oldFi: SMFI.SrcFileInfo ~ NARROW[oldFile];
newFi: SMFI.SrcFileInfo;
[] _ SMFIOps.EvaluateUnitId[ms, newUnitId];
newFi _ NARROW[TreeOps.GetExt[newUnitId]];
RETURN[SMEval.Equiv[ms, oldFi.type, newFi.type]]}
};

LookForSource: TreeOps.Scan ~ {
WITH t SELECT FROM
node: Tree.Handle =>
IF TreeOps.OpName[node] = $unitId THEN
FOR l: LIST OF Rope.Text _ g.noticeList, l.rest UNTIL l = NIL DO
IF SameTag[node, l.first] THEN {
oldExt: Tree.Ext ~ TreeOps.GetExt[node];
IF NoticeSource[g, node, TRUE] THEN {
IF SameTyped[oldExt, node] THEN
ms.patches _ (ms.z).CONS[[old: oldExt, new: TreeOps.GetExt[node]], ms.patches]
ELSE maxState _ $parsed;
noticedFile _ TRUE};
EXIT}    -- can ignore multiple entries
ENDLOOP
ELSE TreeOps.ScanSons[node, LookForSource];
ENDCASE => NULL;
};

IF g.noticeList # NIL AND g.state >= $parsed THEN {
LookForSource[g.model.tree];  g.noticeList _ NIL};
IF noticedFile THEN {
g.modelUpdated _ TRUE;
SetState[g, MIN[g.state, maxState]];
IF g.state < $checked THEN {    -- force reevaluation
g.model.val _ Tree.null; g.model.patches _ NIL};
}
};


FoldPatches: PROC[ms: SMOps.MS] ~ {
IF ms.patches # NIL THEN {

PatchNode: TreeOps.Map ~ {
WITH t SELECT FROM
node: Tree.Handle => {
v _ TreeOps.UpdateLeaves[ms.tm, node, PatchNode];
WITH TreeOps.GetExt[v] SELECT FROM
proj: SMProj.Proj => TreeOps.PutExt[v, Tree.null];
ENDCASE;
};
srcFi: SMFI.SrcFileInfo => {
FOR p: SMOps.PatchList _ ms.patches, p.rest UNTIL p = NIL DO
IF p.first.old = t THEN {v _ p.first.new; EXIT};
REPEAT
FINISHED => v _ t
ENDLOOP
};
ENDCASE => v _ t;
RETURN};

ms.val _ PatchNode[ms.tm, ms.val];  ms.patches _ NIL}
};


SML: Commander.CommandProc ~ {
g: Global;
g _ Create[NARROW[ProcessProps.GetProp[$WorkingDirectory]]];
[] _ SMComp.LoadCompiler[g.msgout]};


<<module initialization>>

CS.Init[];
destroyEventRegistration _ ViewerEvents.RegisterEventProc[DestroyEvent, $destroy];
Commander.Register["SML", SML, "Cedar System Modeller"];                  

}.