-- File: SquirrelToolImpl.mesa
-- Last edited by
-- Maxwell on: September 7, 1982 2:52 pm
-- Willie-Sue on: February 22, 1983 4:24 pm
-- Cattell on: June 7, 1983 2:54 pm
-- Donahue on: June 1, 1983 4:53 pm


DIRECTORY
Atom USING [GetPName, MakeAtom],
Buttons USING [ButtonProc],
CIFS USING [Error],
CommandTool USING [DoCommand],
Containers USING [ChildXBound],
DB,
Icons,
IO,
Menus USING [AppendMenuEntry, CreateMenu, Menu, MenuProc, CreateEntry],
MessageWindow USING [Append],
Nut,
NutDump USING [DumpToFile, LoadFromFile],
NutOps,
NutViewer,
Process,
Rope,
Runtime USING [IsBound],
SquirrelTool,
UserExec USING [CommandProc, RegisterCommand],
UserProfile USING[ Number, Token ],
ViewerEvents,
ViewerOps,
ViewerTools USING [GetContents, SetContents, SetSelection],
ViewerIO USING [CreateViewerStreams],
ViewerClasses,
Whiteboard USING[ OpenSegment ];

SquirrelToolImpl: CEDAR MONITOR
IMPORTS Atom, CIFS, Containers, CommandTool, DB, Icons, IO,
MessageWindow, Menus, Nut, NutDump, NutOps,
NutViewer, Process, Rope, Runtime, UserProfile, UserExec,
ViewerEvents, ViewerOps, ViewerTools, ViewerIO, Whiteboard
EXPORTS SquirrelTool
SHARES ViewerClasses

= BEGIN OPEN IO;

Viewer: TYPE = ViewerClasses.Viewer;
ROPE: TYPE = Rope.ROPE;


-- ***********************************************
-- Initialization
-- ***********************************************

createSquirrelWindow: BOOL ← FALSE;
openSquirrel: BOOL ← FALSE;
segmentName: ROPE ← UserProfile.Token["Squirrel.Segment", "[Local]Squirrel.segment"];

stopped: PUBLIC BOOLEAN;

Initialize: PROCEDURE = TRUSTED {
IF ~Runtime.IsBound[DB.Initialize] THEN {
err: ROPE;
MessageRope["Loading and starting Cypress... "];
err← CommandTool.DoCommand["Run", "Cypress"].err;
IF err.Length[]#0 THEN Message[err] ELSE Message["Done."]};
DB.Initialize[ nCachePages: UserProfile.Number["Squirrel.nCachePages", 256]];
stopped ← FALSE };

SquirrelProc: UserExec.CommandProc =
BEGIN
segName: ROPE;
r: ROPE; ch: CHAR;
h: IO.STREAM ← IO.RIS[ event.commandLine ];
  IF (r ← h.GetToken[]) # NIL THEN
SELECT ch ← r.Fetch[0] FROM
'[, '< => segName ← Rope.Concat[r, h.GetSequence[]]
ENDCASE =>
IF Rope.Letter[ch] THEN segName ← Rope.Concat["[Local]", r];
IF segName.Length[] # 0 AND NOT Rope.Equal[segName, segmentName] THEN
{ TRUSTED{ Whiteboard.OpenSegment[ segName ] };
segmentName ← segName };
BuildSquirrel[];
END;


-- ***********************************************
-- Window and buttons
-- ***********************************************

squirrel: PUBLIC Viewer;
squirrelIcon: Icons.IconFlavor ← tool;
tsIn, tsOut: IO.Handle ← NIL;
segmentText: Viewer; -- the text argument for Segment
domainText: Viewer; -- the text argument for Domain
nameText: Viewer; -- the text argument for Name
StartUpMessage: ROPE ← "Squirrel 4.2 Release";

BuildSquirrel: PROC = {
-- Builds and puts up the Squirrel window
v: Viewer;
typeScript: Viewer;
info: ViewerClasses.ViewerRec← [name: "Squirrel", iconic: TRUE,
 column: right, scrollable: FALSE, menu: squirrelMenu];
IF squirrelIcon = tool THEN squirrelIcon ←
Icons.NewIconFromFile["Nut.icons", 0 ! CIFS.Error => {CONTINUE}];
IF squirrelIcon = tool THEN squirrelIcon ←
Icons.NewIconFromFile["/Indigo/Squirrel/Icons/Nut.icons", 0 ! CIFS.Error => {CONTINUE}];

IF squirrel = NIL OR squirrel.destroyed THEN {
info.icon← squirrelIcon;
squirrel ← ViewerOps.CreateViewer[flavor: $Container, info: info];
v ← BuildSquirrelArea[squirrel];
v ← NutViewer.MakeRuler[sib: v];
typeScript ← NutViewer.MakeTypescript[sib: v];
[tsIn, tsOut] ← ViewerIO.CreateViewerStreams[NIL, typeScript];
ViewerOps.PaintViewer[squirrel, all];
squirrelEventReg← ViewerEvents.RegisterEventProc[
proc: QuitProc, event: destroy, filter: squirrel];
ViewerOps.AddProp[squirrel, $Typescript, tsOut];
Message[StartUpMessage];
};

ViewerTools.SetContents[segmentText, segmentName];
ViewerTools.SetContents[domainText, "Domain"];
ViewerTools.SetContents[nameText, "Domain"] };

BuildSquirrelArea: PROC [squirrel: Viewer] RETURNS [Viewer] = {
tLabel: Viewer← NutViewer.Initialize[squirrel];

tLabel ← NutViewer.MakeButton[
q: NIL, name: "Segment: ", proc: SegmentNameProc,
border: FALSE, sib: tLabel];
segmentText ← NutViewer.NextRightTextViewer[sib: tLabel, w: squirrel.cw - tLabel.ww];
Containers.ChildXBound[segmentText.parent, segmentText];

tLabel ← NutViewer.MakeButton[
q: NIL, name: "Domain:", proc: DomainNameProc,
border: FALSE, sib: tLabel, newLine: TRUE];
domainText ← NutViewer.NextRightTextViewer[sib: tLabel, w: squirrel.cw - tLabel.ww];
Containers.ChildXBound[domainText.parent, domainText];

tLabel ← NutViewer.MakeButton[q: NIL, name: "Name:", proc: NameNameProc,
   border: FALSE, sib: tLabel, newLine: TRUE];
nameText ← NutViewer.NextRightTextViewer[sib: tLabel, w: squirrel.cw - tLabel.ww];
Containers.ChildXBound[nameText.parent, nameText];

RETURN [nameText]
};

DomainNameProc: Buttons.ButtonProc =
{ ViewerTools.SetSelection[domainText, NIL]};

NameNameProc: Buttons.ButtonProc =
{ ViewerTools.SetSelection[nameText, NIL]};

SegmentNameProc: Buttons.ButtonProc =
{ ViewerTools.SetSelection[segmentText, NIL]};

DisplayerProc: Buttons.ButtonProc = {
domName: ROPE ← ViewerTools.GetContents[domainText];
entName: ROPE ← ViewerTools.GetContents[nameText];
DisplayEntity[domName, entName, GetSegment[]]};

EditorProc: Buttons.ButtonProc = {
domName: ROPE ← ViewerTools.GetContents[domainText];
entName: ROPE ← ViewerTools.GetContents[nameText];
EditEntity[domName, entName, GetSegment[]]
};

QueryerProc: Buttons.ButtonProc = {
domName: ROPE ← ViewerTools.GetContents[domainText];
entName: ROPE ← ViewerTools.GetContents[nameText];
-- Allow user to say domain foo, or just put foo in the domain field.
IF domName.Equal["Domain"] THEN domName ← entName;
IF domName.Length[]=0 THEN {Message["No domain specified!"]; RETURN};
QueryDomain[domName, GetSegment[]]
};

EraseDomains: PUBLIC PROC [dl: LIST OF DB.Domain] = {
-- Erases all domains in dl, all their entities, and all relations that ref them. Careful. . .
al: LIST OF DB.Attribute;
FOR dlT: LIST OF DB.Domain ← dl, dlT.rest WHILE NOT (dlT = NIL) DO
-- First destroy the relations that ref dlT.first (CedarDB would, but we want to tell user)
IF (al ← DB.VL2EL[DB.GetPList[dlT.first, DB.aTypeOf]]) # NIL THEN
{Message["Erasing Relations referencing ", DB.GetName[dlT.first], ":"];
EraseAttributesRelations[al]};
Message["Erasing Domain ", DB.GetName[dlT.first], ". . ."];
DB.DestroyDomain[dlT.first]
ENDLOOP;
};

EraseRelations: PUBLIC PROC [rl: LIST OF DB.Relation] = {
-- Erases all relations in rl, and all their relships. Careful. . .
FOR rlT: LIST OF DB.Relation ← rl, rlT.rest WHILE NOT (rlT = NIL) DO
Message["Erasing Relation ", DB.GetName[rlT.first], ". . ."];
DB.DestroyRelation[rlT.first]
ENDLOOP;
};

EraseAttributesRelations: PROC [al: LIST OF DB.Attribute] = {
-- Erases relations that attributes belong to
OPEN DB;
FOR alT: LIST OF Attribute ← al, alT.rest WHILE NOT (alT = NIL) DO
IF NOT DB.Null[alT.first] THEN
{r: DB.Relation ← V2E[GetP[alT.first, aRelationIs]];
Message["Erasing Relation ", DB.GetName[r], ". . ."];
DB.DestroyRelation[r]}
ENDLOOP;
};

-- ***********************************************
GetSegment: PROC RETURNS [ATOM] =
{ RETURN[NutOps.AtomFromSegment[ViewerTools.GetContents[segmentText]]] };


-- ***********************************************
-- Building the menu
-- ***********************************************

squirrelMenu: Menus.Menu ← Menus.CreateMenu[2];

BuildSquirrelMenu: PROC = {
OPEN Menus;
AppendMenuEntry[
squirrelMenu, NutViewer.MakeMenuEntry[NutViewer.DBQueue[], "Save", MySaveProc]];
AppendMenuEntry[
squirrelMenu, NutViewer.MakeMenuEntry[q: NutViewer.DBQueue[], name: "Reset",
proc: MyResetProc, guarded: TRUE]];
AppendMenuEntry[
squirrelMenu, NutViewer.MakeMenuEntry[NutViewer.DBQueue[], "Open", MyOpenProc]];
AppendMenuEntry[
squirrelMenu, NutViewer.MakeMenuEntry[NutViewer.DBQueue[], "Close", MyCloseProc]];
AppendMenuEntry[ -- don't want under Squirrel DBQueue so can do asynchronously
squirrelMenu, Menus.CreateEntry["Load", MyLoadProc]];
AppendMenuEntry[ -- don't want under Squirrel DBQueue
squirrelMenu, Menus.CreateEntry["Dump", MyDumpProc]];
AppendMenuEntry[ -- don't want under Squirrel DBQueue
squirrelMenu, Menus.CreateEntry["List", ListSegsProc]];
AppendMenuEntry[squirrelMenu, NutViewer.MakeMenuEntry[
q: NutViewer.DBQueue[], name: "EraseSegment",
proc: EraseAllProc, guarded: TRUE],];

AppendMenuEntry[squirrelMenu, NutViewer.MakeMenuEntry[
NutViewer.DBQueue[], "Display", DisplayerProc], 1];
AppendMenuEntry[squirrelMenu, NutViewer.MakeMenuEntry[
NutViewer.DBQueue[], "Edit", EditorProc], 1];
AppendMenuEntry[squirrelMenu, NutViewer.MakeMenuEntry[
NutViewer.DBQueue[], "Query", QueryerProc], 1];
AppendMenuEntry[squirrelMenu, NutViewer.MakeMenuEntry[
q: NutViewer.DBQueue[], name: "Erase", proc: MyEraseProc, guarded: TRUE], 1];
AppendMenuEntry[
squirrelMenu, Menus.CreateEntry["Stop!", MyStopProc], 1];
AppendMenuEntry[
squirrelMenu, NutViewer.MakeMenuEntry[NIL, "Debug", DebugProc], 1];
};


-- ***********************************************
-- Menu items
-- ***********************************************

MySaveProc: Menus.MenuProc = {
MessageRope["Saving ... "]; -- sometimes takes a while, so tell him before
DB.MarkTransaction[DB.TransactionOf[GetSegment[]]];
Message["transaction for ", ViewerTools.GetContents[segmentText], " committed."] };

MyResetProc: Menus.MenuProc = {
 s: DB.Segment = GetSegment[];
 fileName: ROPE = ViewerTools.GetContents[segmentText];
 DB.AbortTransaction[DB.TransactionOf[s]];
 Message["Transaction for ", fileName, " aborted."];
 DB.OpenTransaction[ s ];
 IF s = $Squirrel THEN TRUSTED{ Whiteboard.OpenSegment[fileName] };
 Message["Transaction for ", fileName, " opened."] };

MyCloseProc: Menus.MenuProc = {
 DB.CloseTransaction[DB.TransactionOf[GetSegment[]]];
 Message[ViewerTools.GetContents[segmentText], " has been closed"] };

MyOpenProc: Menus.MenuProc =
{ s: DB.Segment = GetSegment[];
fileName: ROPE = ViewerTools.GetContents[segmentText];
IF s = $Squirrel THEN TRUSTED{ Whiteboard.OpenSegment[fileName] }
ELSE NutOps.SetUpSegment[fileName, s];
Message[ fileName, " has been opened"] };

DebugProc: Menus.MenuProc = {Nut.debug ← NOT Nut.debug};

EraseAllProc: Menus.MenuProc = {
s: DB.Segment = GetSegment[];
fileName: ROPE = ViewerTools.GetContents[segmentText];
NutOps.SetUpSegment[fileName, s];
IF DB.TransactionOf[s]#NIL THEN DB.CloseTransaction[DB.TransactionOf[s]];
DB.DeclareSegment[fileName, s, , , NewOnly];
DB.OpenTransaction[s];
IF s = $Squirrel THEN TRUSTED{ Whiteboard.OpenSegment[fileName, FALSE] };
Message[fileName, " has been erased and re-initialized"] };

ListSegsProc: Menus.MenuProc = {
 segs: LIST OF DB.Segment = DB.GetSegments[];
 IF segs=NIL THEN { Message["No declared segments"]; RETURN};
 MessageRope["\nDeclared segments:"];
 FOR s1: LIST OF DB.Segment← segs, s1.rest UNTIL s1=NIL DO
  MessageRope[" "];
  MessageRope[Atom.GetPName[s1.first]];
  IF DB.TransactionOf[s1.first]#NIL THEN MessageRope["(Open)"];
ENDLOOP;
Message[""];
};

MyEraseProc: Menus.MenuProc = {
domain: ROPE = ViewerTools.GetContents[domainText];
IF domain.Equal["Domain", FALSE] THEN MyDomainEraseProc[]
ELSE IF domain.Equal["Relation", FALSE] THEN MyRelationEraseProc[]
ELSE {
ENABLE DB.Error => {Message["Can't find entity!"]; CONTINUE};
entityToDelete: ROPE = ViewerTools.GetContents[nameText];
DB.DestroyEntity[DB.FetchEntity[
DB.DeclareDomain[domain, GetSegment[], OldOnly], entityToDelete]];
Message[entityToDelete, " erased."]};
};

MyDomainEraseProc: PROC = {
domainsToDelete: ROPE = ViewerTools.GetContents[nameText];
stopped← FALSE;
EraseDomains[NameListToEntityList
[RopeToNameList[domainsToDelete], DB.DomainDomain, GetSegment[]]];
Message["Do Save to commit deletions."]
};

MyRelationEraseProc: PROC = {
relationsToDelete: ROPE = ViewerTools.GetContents[nameText];
stopped← FALSE;
EraseRelations[NameListToEntityList
[RopeToNameList[relationsToDelete], DB.RelationDomain, GetSegment[]]];
Message["Do Save to commit deletions."]
};

MyDumpProc: Menus.MenuProc = {
segment: ROPE = Atom.GetPName[ GetSegment[] ];
command: ROPE = Rope.Cat[ segment, " ", ViewerTools.GetContents[nameText] ];
stopped ← FALSE; DumpData[command]; };

MyStopProc: Menus.MenuProc = { stopped ← TRUE };

squirrelEventReg: ViewerEvents.EventRegistration← NIL;

QuitProc: ViewerEvents.EventProc = {
 IF squirrelEventReg = NIL THEN RETURN[FALSE];
TRUSTED {Process.Detach[ FORK DoQuit[] ]};
RETURN[TRUE] };
DoQuit: PROC = {
 ViewerEvents.UnRegisterEventProc[squirrelEventReg, destroy];
 squirrelEventReg← NIL;
ViewerOps.DestroyViewer[squirrel] };

MyLoadProc: Menus.MenuProc = {
segment: ROPE = Atom.GetPName[ GetSegment[] ];
stopped ← FALSE;
SetPriority[]; 
NutDump.LoadFromFile[Rope.Cat[ segment, ".dump" ], ViewerTools.GetContents[segmentText]];
};


-- ***********************************************
-- Support procedures
-- ***********************************************

DumpData: PROCEDURE[command: ROPE] =
-- Command = segment [fileName ← ] [~] [!] [[Domains:] aaa bbb ccc] [Relations: rrr sss ttt]
BEGIN
token: ROPE;
fileName: ROPE;
dl: LIST OF DB.Domain;
rl: LIST OF DB.Relation;
file: BOOLEAN ← TRUE;
domains: BOOLEAN ← TRUE;
complement: BOOLEAN ← FALSE;
entityCentric: BOOLEAN ← FALSE;
stream: IO.STREAM ← IO.RIS[command];
segName: ROPE← stream.GetToken[IO.WhiteSpace];
seg: DB.Segment← Atom.MakeAtom[segName];
SetPriority[]; 
BEGIN
IF command.Find["←"] = -1 THEN
{ file ← FALSE; fileName ← Rope.Cat[segName, ".dump"] };
WHILE ~stream.EndOf[] DO
token ← stream.GetToken[IO.WhiteSpace];
IF file THEN {fileName ← token; file ← FALSE; LOOP};
IF token = NIL THEN EXIT;
SELECT TRUE FROM
token.Equal["Domain", FALSE] => NULL;
token.Equal["Relation", FALSE] => NULL;
token.Equal["Domains:", FALSE] => domains ← TRUE;
token.Equal["Relations:", FALSE] => domains ← FALSE;
token.Equal["~"] => complement ← TRUE;
token.Equal["←"] => NULL;
token.Equal["!"] => entityCentric← TRUE;
ENDCASE =>
IF domains THEN
{ domain: DB.Domain = DB.DeclareDomain[token, seg, OldOnly];
IF domain=NIL THEN GO TO NotFound ELSE dl ← CONS[domain, dl] }
ELSE
{ relation: DB.Relation = DB.DeclareRelation[token, seg, OldOnly];
IF relation=NIL THEN GO TO NotFound ELSE rl ← CONS[relation, rl] };
ENDLOOP;
IF dl = NIL AND rl = NIL THEN complement ← TRUE;
NutDump.DumpToFile[segName, fileName, dl, rl, complement, entityCentric];
EXITS NotFound =>
IF domains THEN Message[token, " not a domain. Dump aborted."]
ELSE Message[token, " not a relation. Dump aborted."];
END END;

NameListToEntityList: PROC
[nl: LIST OF ROPE, d: DB.Domain, seg: DB.Segment] RETURNS [el: LIST OF DB.Entity] = {
-- Turns a list of names into a list of entities. seg only used if system domain.
OPEN DB;
e: Entity;
IF nl = NIL THEN RETURN [NIL];
e ← FetchEntity[d, nl.first, seg];
IF e = NIL
THEN
{Message[nl.first, " is not a ", GetName[d]];
RETURN [NameListToEntityList[nl.rest, d, seg]]}
ELSE
RETURN [CONS[e, NameListToEntityList[nl.rest, d, seg]]]
};

RopeToNameList: PROC [s: ROPE] RETURNS [nl: LIST OF ROPE] = {
-- takes rope with ","s or " "s in it and breaks up into components
name: ROPE; begin, end: INT;
IF s.Length[] = 0 THEN RETURN [NIL];
begin ← s.SkipOver[0, ", "]; -- skip any leading blanks or commas
IF begin = s.Length[] THEN RETURN [NIL]; -- whole string was blank
end ← s.SkipTo[begin, ", "]; -- find next blank or comma after that
name ← s.Substr[begin, end - begin]; -- collect string between them
RETURN [CONS[name, RopeToNameList[s.Substr[end]]]]
};



Message: PUBLIC SAFE PROC [msg1, msg2, msg3, msg4: ROPE ← NIL] =
-- Put CR at beginning if MessageWindow, at end if going to SquirrelTool
{NutViewer.Message[squirrel, msg1, msg2, msg3, msg4]};

MessageRope: PUBLIC SAFE PROC [msg: ROPE] = {
IF squirrel=NIL THEN MessageWindow.Append[msg] ELSE tsOut.PutRope[msg];
};


-- ***********************************************
-- User executive commands
-- ***********************************************

ShowEntityProc: UserExec.CommandProc =
-- Read line of the form "DBDisplay Segment: DomainName: EntityName".
-- Entity name is everything after second ": " and up to CR.
BEGIN
h: IO.STREAM = IO.RIS[event.commandLine];
segName, domName, entName: ROPE;
segName← h.GetToken[IO.IDProc];
IF h.PeekChar[]#': THEN {
-- Both segment and domain were defaulted: search ALL domains in Squirrel segment!
d: DB.Domain;
ds: DB.EntitySet← DB.DomainSubset[d: DB.DomainDomain, searchSegment: $Squirrel];
entName← Rope.Cat[segName, h.GetSequence[IO.LineAtATime]];
UNTIL DB.Null[d← DB.NextEntity[ds]] DO
IF DB.FetchEntity[d, entName]#NIL THEN
{DisplayEntity[DB.NameOf[d], entName, $Squirrel]; RETURN};
ENDLOOP;
Message[entName, " not found in any domain!"];
RETURN
};
h.SkipOver[IO.IDProc]; -- skip over the ":" and following blanks
domName← h.GetToken[IO.IDProc];
IF h.PeekChar[]#': THEN {
-- Segment was defaulted, since no domain was given: search the Squirrel segment
entName← Rope.Cat[domName, h.GetSequence[IO.LineAtATime]];
domName← segName; segName← "Squirrel" }
ELSE {
h.SkipOver[IO.IDProc]; -- Skip over the ":" and following blanks
entName ← h.GetSequence[IO.LineAtATime]};
DisplayEntity[domName, entName, Atom.MakeAtom[segName]];
END;

EraseProc: UserExec.CommandProc = {
h: IO.STREAM ← IO.RIS[event.commandLine];
segName: ROPE = h.GetToken[IO.IDProc];
s: DB.Segment = NutOps.AtomFromSegment[ segName ];
NutOps.SetUpSegment[segName, s];
IF DB.TransactionOf[s]#NIL THEN DB.CloseTransaction[DB.TransactionOf[s]];
DB.DeclareSegment[segName, s, , , NewOnly];
DB.OpenTransaction[s] };

DumpProc: UserExec.CommandProc = {
stopped← FALSE;
DumpData[event.commandLine]};

LoadProc: UserExec.CommandProc = {
h: IO.STREAM = IO.RIS[event.commandLine];
fileName: ROPE = h.GetToken[];
DBName: ROPE = h.GetToken[IDProc];
SetPriority[]; 
NutDump.LoadFromFile[IF fileName = NIL THEN "DB.dump" ELSE fileName,
        IF DBName = NIL THEN segmentName ELSE DBName ]
};


-- ***********************************************
-- Entity manipulation
-- ***********************************************

DisplayEntity: PROC[domain, name: ROPE, segment: DB.Segment] = {
-- Tries to display an entity with name entName in domain domName in segment segment
dom: DB.Domain;
ent: DB.Entity;
enl: INT;
IF NOT IsOpen[segment] THEN RETURN;
-- Make special case for DomainDomain and RelationDomain
IF domain.Equal["Domain", FALSE] THEN
IF name.Equal["Domain", FALSE] THEN
{[] ← Nut.Display[e: DB.DomainDomain, seg: segment]; RETURN}
ELSE IF name.Equal["Relation", FALSE] THEN
{[] ← Nut.Display[e: DB.RelationDomain, seg: segment]; RETURN};
dom← DB.FetchEntity[DB.DomainDomain, domain, segment];
IF dom = NIL THEN {Message[domain, " is not a domain."]; RETURN};
enl← name.Length[];
IF enl#0 AND name.Fetch[enl-1]='* AND NOT Nut.debug THEN
-- Interpret "*" as a wild card if at the end and not in debug mode
BEGIN
es: DB.EntitySet← DB.DomainSubset[dom, name.Substr[0, enl-1],
  name.Substr[0, enl-1].Cat["\177"], First, TRUE, segment];
count: INT← 0;
UNTIL (ent← DB.NextEntity[es])=NIL DO
count← count+1;
IF count>5 THEN {Message["... more than 5; others not displayed"]; EXIT};
[]← Nut.Display[ent, segment];
ENDLOOP;
IF count=0 THEN Message["No such entity"];
END
ELSE
BEGIN
ent ← DB.FetchEntity[dom, name, segment];
IF ent=NIL THEN
{Message[name, " does not exist in domain ", domain]; RETURN};
IF DB.Null[ent]
THEN Message["No such entity"]
ELSE [] ← Nut.Display[ent, segment]
END;
};

IsOpen: PROC[ seg: DB.Segment ] RETURNS[ open: BOOLEAN ] = {
open ← FALSE;
FOR sl: LIST OF DB.Segment ← DB.GetSegments[], sl.rest UNTIL sl = NIL DO
  IF sl.first = seg THEN { open ← TRUE; RETURN } ENDLOOP;
Message[ Atom.GetPName[seg], " not open" ] };

LookupDomain: PROC [segment: DB.Segment, dName: ROPE] RETURNS [DB.Entity] = {
SELECT TRUE FROM
dName.Equal["Domain", FALSE] => RETURN[DB.DomainDomain];
dName.Equal["Relation", FALSE] => RETURN[DB.RelationDomain];
ENDCASE => RETURN[DB.FetchEntity[DB.DomainDomain, dName, segment]] };

EditEntity: PROC[domain, name: ROPE, segment: DB.Segment] = {
-- again first check to see that the segment is open
IF NOT IsOpen[segment] THEN RETURN
ELSE
{ dom: DB.Domain← DB.FetchEntity[DB.DomainDomain, domain, segment];
IF dom=NIL THEN Message["No such domain."]
ELSE []← Nut.Edit[d: dom, eName: name, seg: segment] } };

QueryDomain: PROC[domain: ROPE, segment: DB.Segment] = {
-- again first check to see that the segment is open
IF NOT IsOpen[segment] THEN RETURN
ELSE
{ dom: DB.Domain← DB.FetchEntity[DB.DomainDomain, domain, segment];
IF dom=NIL THEN Message["No such domain."] ELSE []← Nut.Query[dom, segment] } };

SetPriority: PROC = TRUSTED {
Process.SetPriority[Process.priorityBackground] };


-- ***********************************************
-- Start code
-- ***********************************************

BuildSquirrelMenu[];
UserExec.RegisterCommand["Squirrel", SquirrelProc, "Database application tool"];
UserExec.RegisterCommand["DBDisplay", ShowEntityProc, "Displays a database entity"];
UserExec.RegisterCommand["DBDump", DumpProc, "[file ← ] [~] [!] [[Domains: ] aaa bbb] [Relations: rrr sss]"];
UserExec.RegisterCommand["DBLoad", LoadProc, "Loads given file (DB.dump default) from given segment"];
UserExec.RegisterCommand["DBEraseSegment", EraseProc, "Erases a database segment"];

Initialize[];

END.

Changes since October 82:

Cattell October 13, 1982 9:28 am: Save and Reset buttons should Fork.

Cattell December 1, 1982 4:29 pm: Should call GetRope instead of GetToken for 2nd DBShow argument.

Cattell April 5, 1983 9:21 am: Fixed DBLoad comment, segment arg to Nut.Display under *.

Cattell April 6, 1983 10:03 am: NameListToEntityList and folks that call it don't use seg. Removed tiptoe switch, no longer needed.

Cattell May 30, 1983 2:25 pm: Removed logOut and most of executive command registrations, because they cost too much VM! Will remove DBDump and DBShow commands, too, when can come up with convenient procedures to call.

Cattell June 2, 1983 11:40 am: Put back in registered commands, it wasn't them that were using up VM after all.