DIRECTORY
Atom USING [GetPName, MakeAtom],
Buttons USING [ButtonProc],
FS USING [Error],
Commander USING[ CommandObject, CommandProc, Register ],
CommandTool,
Containers USING [ChildXBound], 
DB,
Icons, 
IO, 
Menus USING [AppendMenuEntry, CreateMenu, Menu, MenuProc, CreateEntry], 
MessageWindow USING [Append, Confirm],
Nut USING [Display, Edit, Query, PushDefaults],
SquirrelTool,
SquirrelDump USING [DumpToFile, LoadFromFile],
NutOps USING [SetUpSegment],
NutViewer,
Process,
Rope,
UserCredentials USING[Get],
UserProfile USING[Token], 
ViewerEvents,
ViewerOps, 
ViewerTools USING [GetContents, SetContents, SetSelection], 
ViewerClasses;

SquirrelToolImpl: CEDAR MONITOR
IMPORTS Atom, FS, Containers, DB, Icons, IO, MessageWindow, Menus, Nut, SquirrelDump, NutOps, NutViewer,  Process, Rope, UserCredentials, UserProfile, Commander, ViewerEvents, ViewerOps, ViewerTools
EXPORTS SquirrelTool
SHARES ViewerClasses

= BEGIN OPEN IO;

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

createSquirrelWindow: BOOL _ FALSE;
openSquirrel: BOOL _ FALSE;
squirrelSegment: PUBLIC ROPE;  -- the name of any $Squirrel segment opened
segmentName: ROPE;  -- the name of the last segment opened with the Tool
fileName: ROPE; -- the name of the last file opened with the Tool
defaultPrefix: ROPE _ Rope.Cat["[Luther.Alpine]<", UserCredentials.Get[].name, ">"];

Initialize: PROCEDURE = TRUSTED {
DB.Initialize[ nCachePages: 512]; stopped _ FALSE;
IF squirrelIcon = tool THEN
squirrelIcon _ Icons.NewIconFromFile["Nut.icons", 0 ! FS.Error => {CONTINUE}]; };


SquirrelProc: Commander.CommandProc =
BEGIN
segName: ROPE;
r: ROPE; ch: CHAR; 
h: IO.STREAM _ IO.RIS[ cmd.commandLine ]; 
IF (r _ h.GetTokenRope[ ! IO.EndOfStream => {r _ NIL; CONTINUE}].token) # NIL THEN 
SELECT ch _ r.Fetch[0] FROM 
'[ => segName _ Rope.Concat[r, h.GetLineRope[]]
ENDCASE => segName _ Rope.Concat[defaultPrefix, r]; 
SELECT TRUE FROM
segName.Length[] # 0 => segmentName _ segName;
ENDCASE => {
segmentName _ UserProfile.Token["Squirrel.Segment", ""];
fileName _ UserProfile.Token["Squirrel.File", ""];
};
BuildSquirrel[];
IF segName # NIL THEN MyOpenProc[squirrel] -- user specified it, open it up
END;


squirrelIcon: Icons.IconFlavor _ tool;
tsIn, tsOut: IO.STREAM _ NIL;
segmentText: Viewer; -- the text argument for Segment
fileText: Viewer;  -- the text argument for File
domainText: Viewer; -- the text argument for Domain
nameText: Viewer; -- the text argument for Name
StartUpMessage: ROPE _ "Squirrel 5.2 Release";
stopped: PUBLIC BOOLEAN _ FALSE;
squirrel: PUBLIC Viewer;
squirrelOut: PUBLIC IO.STREAM;

BuildSquirrel: PROC = {
v: Viewer; 
typeScript: Viewer;
info: ViewerClasses.ViewerRec = [name: "Squirrel", iconic: TRUE,
column: right, scrollable: FALSE, menu: squirrelMenu, icon: squirrelIcon];
IF squirrelIcon = tool THEN squirrelIcon _ 
Icons.NewIconFromFile["Nut.icons", 0 ! FS.Error => {CONTINUE}];
IF squirrel = NIL OR squirrel.destroyed THEN {
squirrel _ ViewerOps.CreateViewer[flavor: $Container, info: info];
v _ BuildSquirrelArea[squirrel]; 
v _ NutViewer.MakeRuler[sib: v]; 
typeScript _ NutViewer.MakeTypescript[sib: v]; 
squirrelOut _ tsOut _ NutViewer.GetTypescript[squirrel]; 
ViewerOps.PaintViewer[squirrel, all];
squirrelEventReg_ ViewerEvents.RegisterEventProc[proc: QuitProc, event: destroy, filter: squirrel];
Message[StartUpMessage];
};
ViewerTools.SetContents[segmentText, segmentName];
ViewerTools.SetContents[fileText, fileName];
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: "File: ", proc: FileNameProc,
border: FALSE, sib: tLabel, newLine: TRUE]; 
fileText _ NutViewer.NextRightTextViewer[sib: tLabel, w: squirrel.cw - tLabel.ww]; 
Containers.ChildXBound[fileText.parent, fileText];

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]};

FileNameProc: Buttons.ButtonProc =
{ ViewerTools.SetSelection[fileText, NIL]};

DisplayerProc: Buttons.ButtonProc = {
physicalSegName: ROPE _ ViewerTools.GetContents[fileText];
domName: ROPE _ ViewerTools.GetContents[domainText]; 
entName: ROPE _ ViewerTools.GetContents[nameText];
seg: DB.Segment_ GetSegment[];
[]_ NutOps.SetUpSegment[physicalSegName, seg];
DisplayEntity[domName, entName, seg]};

EditorProc: Buttons.ButtonProc = {
physicalSegName: ROPE _ ViewerTools.GetContents[fileText];
domName: ROPE _ ViewerTools.GetContents[domainText]; 
entName: ROPE _ ViewerTools.GetContents[nameText];
seg: DB.Segment_ GetSegment[];
[]_ NutOps.SetUpSegment[physicalSegName, seg];
EditEntity[domName, entName, seg];
}; 

QueryerProc: Buttons.ButtonProc = {
domName: ROPE _ ViewerTools.GetContents[domainText]; 
entName: ROPE _ ViewerTools.GetContents[nameText];
IF domName.Equal["Domain"] THEN domName _ entName;
IF domName.Length[]=0 THEN {Message["No domain specified!"]; RETURN};
QueryDomain[entName, domName, GetSegment[]]
}; 

EraseDomains: PROC [dl: LIST OF DB.Domain] = {
al: LIST OF DB.Attribute;
FOR dlT: LIST OF DB.Domain _ dl, dlT.rest WHILE NOT (dlT = NIL) DO 
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: PROC [rl: LIST OF DB.Relation] = {
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] = {
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] =
BEGIN
segName: ROPE _ ViewerTools.GetContents[segmentText];
fileName: ROPE _ ViewerTools.GetContents[fileText];
IF Rope.Equal[segName, NIL] THEN
-- user has not specified a segment to use, so extract it from the file
RETURN[ AtomFromSegment[fileName] ]
ELSE -- user has specified a segment
RETURN[Atom.MakeAtom[segName]];
END;

AtomFromSegment: PROC[ segR: ROPE ] RETURNS[ ATOM ] = {
   end: INT;
	begin: INT_ Rope.Find[segR, ">"];
	IF begin < 0 THEN begin_ Rope.Find[segR, "]" ] -- local file
	ELSE UNTIL (end_ Rope.Find[segR, ">", begin+1])=-1 DO begin_ end ENDLOOP; -- last one!
	end_ Rope.Find[segR, ".", MAX[begin, 0] ];
	IF end < 0 THEN end_ segR.Length[];
	begin _ MAX[ begin+1, 0 ];
	RETURN[Atom.MakeAtom[Rope.Substr[ segR, begin, (end-1)-begin+1]]] };


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]; 
};


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

MyResetProc: Menus.MenuProc = {
s: DB.Segment = GetSegment[];
fileName: ROPE = ViewerTools.GetContents[fileText];
DB.AbortTransaction[DB.TransactionOf[s]];
Message[Atom.GetPName[s], " transaction aborted."];
DB.OpenTransaction[ s ];
Message[Atom.GetPName[s], " transaction opened."] }; 

MyCloseProc: Menus.MenuProc = {
s: DB.Segment = GetSegment[];
fileName: ROPE = ViewerTools.GetContents[fileText];
DB.CloseTransaction[DB.TransactionOf[s]];
Message[Atom.GetPName[s], " segment has been closed"] };

MyOpenProc: Menus.MenuProc = 
{ ENABLE DB.Error, DB.Aborted, DB.Failure =>
{Message["Can't open transaction on ", ViewerTools.GetContents[fileText], "!"]; CONTINUE};
s: DB.Segment = GetSegment[];
fileName: ROPE _ ViewerTools.GetContents[fileText];
oldName: ROPE = DB.GetSegmentInfo[s].filePath;
open: BOOL = DB.TransactionOf[s] # NIL;
switch: CHAR;
sameFile, readOnly: BOOL;
[fileName, switch] _ ExtractSwitch[fileName];
readOnly _ switch='r OR switch='R;
IF Rope.Fetch[fileName, 0] # '[ THEN fileName _ Rope.Concat[defaultPrefix, fileName];
IF Rope.Find[fileName, ".segment"] = -1 THEN fileName _ Rope.Concat[fileName, ".segment"];
sameFile _ Rope.Equal[fileName, oldName]; 
IF NOT sameFile AND open THEN { Message[oldName, " must be closed first!"]; RETURN };
IF sameFile AND open THEN { Message[oldName, " already open!"]; RETURN };
readOnly _ NutOps.SetUpSegment[segmentFile: fileName, seg: s, makeReadOnly: readOnly];
Message[ fileName, " has been opened", IF readOnly THEN ", read-only" ELSE ""]
};

DebugProc: Menus.MenuProc = 
BEGIN
Nut.PushDefaults[domain: ViewerTools.GetContents[domainText], segment: GetSegment[]];
END;


EraseAllProc: Menus.MenuProc = {
ENABLE DB.Error, DB.Aborted, DB.Failure =>
{Message["Can't open transaction on segment"]; CONTINUE};
s: DB.Segment = GetSegment[];
fileName: ROPE = ViewerTools.GetContents[fileText];
IF NutOps.SetUpSegment[fileName, s] THEN
{Message["Can't open file for updates"]; RETURN}; -- file was readonly
DB.EraseSegment[s];
DB.OpenTransaction[s];
Message[fileName, " has been erased and re-initialized"] };

ListSegsProc: Menus.MenuProc = {
segs: LIST OF DB.Segment = DB.GetSegments[];
trans: DB.Transaction; filePath: ROPE; readOnly: BOOL;
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["\n "];
MessageRope[Atom.GetPName[s1.first]];
[filePath,, trans, readOnly]_ DB.GetSegmentInfo[s1.first];
MessageRope[ Rope.Cat[": ", filePath] ];
IF trans#NIL THEN
IF readOnly THEN MessageRope[" (Open read-only)"]
ELSE 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[] ];
stopped _ FALSE; DumpData[segment]; };

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 = {
s: DB.Segment = GetSegment[];
fileName: ROPE = ViewerTools.GetContents[fileText];
trans: DB.Transaction = DB.TransactionOf[s];
ViewerEvents.UnRegisterEventProc[squirrelEventReg, destroy];
squirrelEventReg_ NIL;
IF trans # NIL THEN
{ IF MessageWindow.Confirm[prompt: Rope.Cat["Close ", fileName, " first?"]]
THEN { DB.CloseTransaction[trans] } };
ViewerOps.DestroyViewer[squirrel];
squirrel _ NIL; squirrelOut _ IO.noWhereStream };

MyLoadProc: Menus.MenuProc = {
  segment: DB.Segment = GetSegment[];
segmentName: ROPE = IF segment # NIL THEN Atom.GetPName[segment] ELSE NIL;
IF segment = NIL THEN RETURN;
stopped _ FALSE;
SetPriority[];	
SquirrelDump.LoadFromFile[dumpFile: Rope.Concat[ segmentName, ".dump" ], segment: segment, DBFile: ViewerTools.GetContents[fileText]];
};



WhiteSpace: IO.BreakProc =
{ RETURN[ IF char = IO.SP OR char = IO.CR THEN IO.CharClass[break]
ELSE IO.CharClass[other] ] };

DumpData: PROCEDURE[command: ROPE] =
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.GetTokenRope[].token;
seg: DB.Segment = Atom.MakeAtom[segName];
IF DB.TransactionOf[seg]=NIL THEN {Message["Segment not open!"]; RETURN};
SetPriority[];	
BEGIN
IF command.Find["_"] = -1 THEN
{ file _ FALSE; fileName _ Rope.Cat[segName, ".dump"] };
WHILE ~stream.EndOf[] DO
[] _ stream.SkipWhitespace[];
token _ stream.GetTokenRope[WhiteSpace !
IO.EndOfStream => {token _ NIL; CONTINUE}].token;
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;
SquirrelDump.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] = {
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] = {
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] = 
{NutViewer.Message[squirrel, msg1, msg2, msg3, msg4]}; 

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



ShowEntityProc: Commander.CommandProc =
BEGIN ENABLE IO.EndOfStream => {Message[
"Illegal command syntax: expect DBDisplay [Segment:] [Domain:] Entity"]; CONTINUE};
h: IO.STREAM = IO.RIS[cmd.commandLine];
segName, domName, entName: ROPE;
segName _ h.GetTokenRope[].token;
IF h.PeekChar[]#': THEN {
d: DB.Domain;
ds: DB.EntitySet_ DB.DomainSubset[d: DB.DomainDomain, searchSegment: $Squirrel];
entName_ Rope.Cat[segName, h.GetLineRope[]];
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
};
domName_ h.GetTokenRope[].token;
IF h.PeekChar[]#': THEN {
entName_ Rope.Cat[domName, h.GetLineRope[]];
domName_ segName;  segName_ "Squirrel" }
ELSE {
[] _ h.GetChar[]; []_ h.SkipWhitespace[]; -- Skip over the ":" and following blanks
entName _ h.GetLineRope[] };
DisplayEntity[domName, entName, Atom.MakeAtom[segName]]; 
END;

OpenProc: Commander.CommandProc = {
ENABLE BEGIN
DB.Error, DB.Aborted, DB.Failure =>
{cmd.err.Put[IO.rope["Can't Open Database!"]]; CONTINUE};
IO.EndOfStream =>
{cmd.err.Put[IO.rope["Illegal command syntax: expect DBOpen Filename SegmentAtom"]]; CONTINUE};
END;
h: IO.STREAM _ IO.RIS[cmd.commandLine];
fileName: ROPE = h.GetTokenRope[IO.IDProc].token;
segmentName: ROPE = h.GetTokenRope[IO.IDProc].token;
s: DB.Segment = Atom.MakeAtom[segmentName];
[]_ NutOps.SetUpSegment[fileName, s] };

EraseProc: Commander.CommandProc = {
ENABLE BEGIN
DB.Error, DB.Aborted, DB.Failure =>
{cmd.err.Put[IO.rope["Can't Open Database!"]]; CONTINUE};
IO.EndOfStream =>
{cmd.err.Put[IO.rope["Illegal command syntax: expect DBErase Filename SegmentAtom"]]; CONTINUE};
END;
h: IO.STREAM _ IO.RIS[cmd.commandLine];
fileName: ROPE = h.GetTokenRope[IO.IDProc].token;
segmentName: ROPE = h.GetTokenRope[IO.IDProc].token;
s: DB.Segment = Atom.MakeAtom[segmentName];
IF NutOps.SetUpSegment[fileName, s]
THEN { cmd.err.Put[IO.rope["Can't Write Database!"]]; RETURN }; 
IF DB.TransactionOf[s]#NIL THEN DB.CloseTransaction[DB.TransactionOf[s]];
DB.EraseSegment[s];
DB.OpenTransaction[s] };

DumpProc: Commander.CommandProc = {
stopped _ FALSE;
DumpData[cmd.commandLine] };

LoadProc: Commander.CommandProc = {
ENABLE BEGIN
DB.Error, DB.Aborted, DB.Failure =>
{cmd.err.Put[IO.rope["Can't Open Database!"]]; CONTINUE};
IO.EndOfStream =>
{cmd.err.Put[IO.rope["Illegal command syntax: expect DBLoad Filename DBName SegmentAtom"]]; CONTINUE};
END;
h: IO.STREAM = IO.RIS[cmd.commandLine];
fileName: ROPE = h.GetTokenRope[].token;
DBName: ROPE = h.GetTokenRope[].token;
segmentName: ROPE = h.GetTokenRope[IO.IDProc].token;
s: DB.Segment = Atom.MakeAtom[segmentName];
SetPriority[];	
SquirrelDump.LoadFromFile[  
IF fileName = NIL THEN "DB.dump" ELSE fileName,
s,
IF DBName = NIL THEN segmentName ELSE DBName ]
}; 



DisplayEntity: PROC[domain, name: ROPE, segment: DB.Segment] = {
dom: DB.Domain;
ent: DB.Entity;
enl: INT;
IF NOT IsOpen[segment] THEN RETURN;
dom _ DB.DeclareDomain[domain, segment, OldOnly];
IF DB.Null[dom] THEN {Message[domain, " is not a domain."]; RETURN};
enl_ name.Length[];
IF enl#0 AND name.Fetch[enl-1]='* THEN
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[eName: DB.NameOf[ent], domain: domain, segment: segment, parent: NIL];
ENDLOOP;
IF count=0 THEN Message["No such entity"];
END
ELSE
BEGIN
ent _  DB.FetchEntity[dom, name, segment];
IF DB.Null[ent] THEN {Message[name, " does not exist in domain ", domain]; RETURN}; 
[] _ Nut.Display[eName: name, domain: domain, segment: segment, parent: NIL];
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], " segment not open" ] };

EditEntity: PROC[domain, name: ROPE, segment: DB.Segment] = {
IF NOT IsOpen[segment] THEN RETURN
ELSE
{ dom: DB.Domain_ DB.DeclareDomain[domain, segment, OldOnly]; 
IF dom=NIL THEN Message["No such domain."]
ELSE 
[] _ Nut.Edit[eName: name, domain: domain, segment: segment, parent: NIL] } }; 

QueryDomain: PROC[entity, domain: ROPE, segment: DB.Segment] = {
IF NOT IsOpen[segment] THEN RETURN
ELSE
{ dom: DB.Domain = DB.DeclareDomain[domain, segment];
IF DB.Null[dom] THEN Message["No such domain."] 
ELSE [] _ Nut.Query[eName: entity, domain: domain, segment: segment] } };

ExtractSwitch: PROC[old: ROPE] RETURNS [new: ROPE, switch: CHAR] =
BEGIN
switchesPos: INT_ Rope.Find[old, "/"];
switch_ ' ;
new_ old;
IF switchesPos#-1 THEN {
switch_ new.Fetch[switchesPos+1]; 
new_ Rope.Concat[new.Substr[0, switchesPos], new.Substr[switchesPos+2]];
};
END;

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


BuildSquirrelMenu[];
Commander.Register[
"Squirrel", SquirrelProc, "Database application tool"];
Commander.Register[
"DBDisplay", ShowEntityProc, "Displays a database entity"];
Commander.Register[
"DBDump", DumpProc, "segment [file _ ] [~] [!] [[Domains: ] aaa bbb] [Relations: rrr sss]"];
Commander.Register[
"DBLoad", LoadProc, "Loads given dump file (Squirrel.dump default) into given segment"];
Commander.Register[
"DBEraseSegment", EraseProc, "Erases a database segment"];
Commander.Register[
"DBOpen", OpenProc, "Open a database segment file"];


Initialize[];

END. 

CHANGE LOG:

Butler, June 26, 1984:
Made many changes to comply with new organization of Squirrel

Butler, July 3, 1984:
Added "File:" Button to squirrelTool.  This distinguishes between the
physical segment (File) and the logical segment (Segment).

º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: September 16, 1983 4:08 pm
Donahue on: July 24, 1984 10:24:32 am PDT
Widom on: June 18, 1984 9:38:11 am PDT
Butler on: August 13, 1984 9:34:50 pm PDT
***********************************************
Initialization 
***********************************************
***********************************************
Window and buttons 
***********************************************
Builds and puts up the Squirrel window
Display specified entity, opening segment if necessary
Edit specified entity, opening segment if necessary
Allow user to say domain foo, or just put foo in the domain field.
Erases all domains in dl, all their entities, and all relations that ref them.  Careful. . .
First destroy the relations that ref dlT.first (CedarDB would, but we want to tell user)
Erases all relations in rl, and all their relships.  Careful. . .
Erases relations that attributes belong to
***********************************************
Building the menu 
***********************************************
***********************************************
Menu items 
***********************************************
See whether the segment is already open with a different file name
File is either different or previous one was closed; must and can open segment
***********************************************
Support procedures 
***********************************************
Command = segment [fileName _ ] [~] [!] [[Domains:] aaa bbb ccc] [Relations: rrr sss ttt] 
Turns a list of names into a list of entities.  seg only used if system domain.
Takes rope with ","s or " "s in it and breaks up into components
Put CR at beginning if MessageWindow, at end if going to SquirrelTool
***********************************************
User executive commands 
***********************************************
Read line of the form "DBDisplay Segment: DomainName: EntityName".
Entity name is everything after second ": " and up to CR.
Both segment and domain were defaulted: search ALL domains in Squirrel segment!
Segment was defaulted, since no domain was given: search the Squirrel segment
***********************************************
Entity manipulation 
***********************************************
Tries to display an entity with name entName in domain domName in segment segment 
Interpret "*" as a wild card if at the end and not in debug mode
Again, first check to see that the segment is open
Again, first check to see that the segment is open
Extracts one-character switch, returns blank if none.
***********************************************
Start code
***********************************************
�ʘJš
œ™š
œ™Jš
œ%™%Jš
œ(™(Jš
œ&™&Jš
œ)™)Jš
œ&™&Jš
œ)™)J˜—š
Ïk	˜	Jšœ�œ˜ Jšœ�œ˜Jš�œ
�œ	˜Jšœ
�œ)˜8J˜Jšœ�œ˜ Jš�œ
˜J˜Jš�œ˜Jšœ�œ=˜HJšœ�œ˜&Jšœ�œ&˜/J˜
Jšœ
�œ˜.Jšœ�œ˜J˜
J˜J˜Jšœ�œ˜Jšœ�œ	˜J˜
J˜Jšœ�œ+˜<J˜J˜—šœ�œ
�˜Jš�œ�œ�œ	�œ›
˜Æ
Jš�œ
˜Jš�œ˜J˜—Jšœ�œ
�œ
�œ
˜˜Jšœ�œ˜%Jš�œ�œ�œ˜J˜—Jš
œ/™/Jš
œ™Jš
œ/™/Jšœ�œ�œ
˜#Jšœ�œ�œ
˜Jšœ�œ
�œÏc+˜JJšœ
�œž4˜HJšœ
�œž1˜AJšœ�œA˜T˜šÏn
œ�	œ�œ˜!Jš�œ*�œ
˜2š�œ�˜Jšœ6�œ�œ˜QJ˜J˜—˜%Jš
�˜Jšœ	�œ
˜Jšœ�œ�œ˜š	œ�œ
�œ�œ
�œ˜*Jš�œ�œ�œ�œ�œ
�œ
˜Sš�œ�œ
˜J˜/Jš�œ-˜4——š�œ
�œ
�˜J˜.š�œ˜J˜8J˜2J˜——J˜Jš�œ�œ
�œž ˜KJš�œ
˜J˜———Jš
œ/™/Jš
œ™Jš
œ/™/˜J˜&Jšœ
�œ
�œ�œ
˜šœž ˜5Jšœž˜0Jšœž˜3—Jšœž˜/Jšœ�œ˜.Jšœ	�œ
�œ�œ
˜ Jšœ
�œ˜Jšœ
�œ
�œ
�œ
˜J˜šŸ
œ�œ˜Jš
œ&™&J˜J˜šœ;�œ
˜@Jšœ�œ*˜J—š�œ�œ˜+Jšœ'�œ�œ˜?—š�œ�œ
�œ�œ˜.J˜BJ˜!J˜!J˜/J˜9J˜%J˜c˜J˜——J˜2J˜,J˜.J˜/J˜—šŸœ�œ�œ
˜?J˜/J˜˜Jšœ�œ+˜1Jšœ�œ˜—J˜VJ˜8J˜˜Jšœ�œ%˜+Jšœ�œ�œ˜,—J˜SJ˜2J˜˜Jšœ�œ(˜.Jšœ�œ�œ˜,—J˜TJ˜6J˜šœ!�œ$˜HJšœ�œ�œ˜,—J˜RJ˜2J˜Jš�œ˜J˜J˜—˜$Jšœ'�œ˜-J˜—˜"Jšœ%�œ˜+J˜—˜%Jšœ(�œ˜.J˜—˜"Jšœ%�œ˜+J˜—˜%Jš
œ6™6Jšœ�œ%˜:Jšœ	�œ(˜5Jšœ	�œ%˜2Jšœ�œ˜J˜.J˜&J˜—˜"Jš
œ3™3Jšœ�œ%˜:Jšœ	�œ(˜5Jšœ	�œ%˜2Jšœ�œ˜J˜.J˜"J˜J˜—˜#Jšœ	�œ(˜5Jšœ	�œ%˜2Jš
œB™BJš�œ�œ˜2Jš�œ�œ#�œ˜EJ˜+J˜J˜—š
Ÿœ�œ�œ
�œ
�œ˜.Jš
œ\™\Jšœ�œ
�œ
�œ˜š�œ�œ
�œ
�œ�œ
�œ�œ�œ
˜CJš
œX™Xš�œ�œ�œ�œ�œ
�œ
˜Bšœ+�œ˜HJ˜——Jšœ�œ˜<Jš�œ˜Jš�œ˜	—J˜J˜—š
Ÿœ�œ�œ
�œ
�œ˜2Jš
œA™Aš�œ�œ
�œ
�œ�œ
�œ�œ�œ
˜EJšœ�œ˜>Jš�œ˜Jš�œ˜	—J˜J˜—š
Ÿœ�œ�œ
�œ
�œ˜=Jš
œ*™*Jš�œ
�œ
˜š�œ�œ
�œ�œ
�œ�œ�œ
˜Cš�œ
�œ
�œ�œ
˜šœ�œ/˜5Jšœ�œ˜6Jš�œ˜——Jš�œ˜	J˜J˜J˜———šŸ
œ�œ
�œ�œ˜!š
œ˜Jš
œ5˜5Jš
œ3˜3š
œ ˜ Jš
œG˜GJš�œ˜#—š
œ$˜$Jš
œ˜—J˜J˜——Jš(Ÿœ�œ�œ�œ�œ�œ
�œ�œ�œžœ
�œ
�œ)�œ�œž
œ�œ�œ	�œ�œ�œ>˜°J˜Jš
œ/™/Jš
œ™Jš
œ/™/J˜J˜0J˜šŸœ�œ˜Jš�œ˜˜J˜Q—˜˜LJšœ�œ˜$——˜J˜Q—˜J˜S—šœž=˜NJ˜6—šœž$˜5J˜5—šœž$˜5J˜8—˜6J˜-Jšœ�œ˜&—˜6J˜4—˜6J˜.—˜6J˜0—˜6JšœC�œ˜N—˜J˜9—˜Jšœ&�œ˜D—J˜J˜—Jš
œ/™/Jš
œ™Jš
œ/™/J˜˜Jšœž.˜JJš�œ�œ˜3J˜BJ˜—˜Jšœ�œ˜Jšœ
�œ%˜3Jš�œ�œ˜)J˜3Jš�œ˜J˜5J˜—˜šœ�œ˜Jšœ
�œ%˜3Jš�œ�œ˜)J˜8J˜——˜š	œ�œ
�œ�œ
�œ˜,JšœP�œ˜ZJšœ�œ˜Jšœ
�œ%˜3Jšœ	�œ�œ˜.Jšœ�œ�œ�œ
˜'Jšœ�œ
˜
Jšœ�œ
˜J˜-Jšœ�œ˜"š
œB™BJš�œ�œ1˜UJš�œ&�œ.˜ZJ˜*Jš
�œ
�œ
�œ�œ/�œ˜UJš�œ
�œ�œ'�œ˜IJš
œN™NJ˜VJšœ'�œ
�œ�œ˜NJ˜J˜———˜š
�˜J˜UJš�œ
˜J˜J˜——˜ š�œ
�œ�œ
�œ˜*Jšœ/�œ˜9—Jšœ�œ˜Jšœ
�œ%˜3Jš�œ"�˜(Jšœ)�œž˜FJš�œ˜Jš�œ˜J˜;J˜—˜ Jš	œ�œ
�œ
�œ�œ˜,Jšœ�œ�œ�œ
˜6Jš�œ�œ
�œ$�œ˜<J˜$š
�œ�œ
�œ
�œ�œ�œ
�˜9J˜J˜%Jšœ�œ˜:J˜(š�œ�œ
�˜Jš�œ
�œ!˜1Jš�œ˜——Jš�œ
˜J˜J˜J˜—˜Jšœ�œ'˜3Jš�œ�œ�œ˜9Jš�œ
�œ�œ�œ˜Bš�œ˜Jš�œ
�œ*�œ˜=Jšœ�œ%˜9š�œ�œ
˜ Jš�œ@˜B—J˜%—J˜J˜—šŸœ�œ˜Jšœ�œ%˜:Jšœ	�œ
˜˜!Jšœ"�œ˜C—J˜'J˜J˜—šŸœ�œ˜Jšœ�œ&˜=Jšœ	�œ
˜˜#Jšœ$�œ!˜G—J˜'J˜J˜—˜Jšœ	�œ!˜.Jšœ
�œ˜&J˜—Jšœ)�œ˜0J˜Jšœ2�œ
˜6J˜˜%Jš
�œ�œ
�œ
�œ
�œ˜-Jš�œ�œ
˜*Jš�œ
�œ˜J˜—šŸœ�œ˜šœ�œ˜Jšœ
�œ%˜3Jšœ�œ�œ˜,J˜<Jšœ�œ
˜š�œ	�œ
�˜šœ�œG˜KJš�œ�œ˜&———J˜"Jšœ�œ�œ˜1J˜—š
œD˜DJš
œ
�œ�œ�œ
�œ�œ
�œ
˜JJš�œ�œ
�œ
�œ
˜Jšœ
�œ
˜J˜Jš
Ϡ
˜†
J˜J˜J˜—Jš
œ/™/Jš
œ™Jš
œ/™/J˜šœ�œ˜šœ�œ�œ�œ
�œ
�œ�œ
�œ
�œ
�œ˜BJš�œ
�œ˜J˜——šŸœ�	œ
�œ˜$Jš
œZ™ZJš
�˜Jšœ�œ
˜Jšœ
�œ
˜Jšœ�œ
�œ
�œ˜Jšœ�œ
�œ
�œ
˜Jšœ�œ�œ
˜Jšœ	�œ�œ
˜Jšœ�œ�œ
˜Jšœ�œ�œ
˜Jš	œ�œ
�œ�œ
�œ
˜$Jšœ	�œ˜,Jšœ�œ"˜)Jš
�œ
�œ�œ
�œ �œ˜IJ˜š
�˜š�œ�˜Jšœ	�œ*˜8——š�œ�˜J˜˜(Jš�œ�œ�œ	˜1—Jš�œ�œ�œ�œ˜4Jš�œ	�œ
�œ
�œ
˜š�œ
�œ
�˜Jšœ�œ�œ
˜%Jšœ�œ�œ
˜'Jšœ�œ�œ
˜1Jšœ�œ�œ
˜4Jšœ!�œ
˜&Jšœ�œ
˜Jšœ#�œ
˜(š�œ˜
š�œ	�œ
˜šœ
�œ
�œ$˜<Jš�œ�œ
�œ
�œ
�œ
�œ�œ˜>—š�œ
˜šœ�œ�œ&˜BJš�œ
�œ
�œ
�œ
�œ
�œ�œ˜C—————Jš�œ
˜—Jš�œ�œ
�œ�œ
�œ�œ
˜0J˜Nš�œ
˜Jš�œ	�œ0˜?Jš�œ3˜7—Jš�œ
�œ˜
J˜—šŸœ�˜Jšœ�œ
�œ
�œ�œ�œ
�œ�œ
�œ
�œ˜UJš
œO™OJš�œ
�œ
˜J˜
Jš
�œ�œ
�œ
�œ�œ˜J˜#š�œ�œ
˜š�œ
˜˜.Jš�œ*˜0——š�œ
˜Jš�œ�œ+˜7——J˜J˜—šŸœ�œ�œ�œ�œ
�œ
�œ˜=Jš
œ@™@Jšœ�œ�œ
˜Jš�œ�œ
�œ�œ˜%Jšœž$˜AJš	�œ�œ
�œ�œž˜BJšœž&˜CJšœ%ž˜CJš�œ�œ&˜2J˜J˜—šŸœ�œ
�œ
�œ�œ�œ˜AJš
œE™EJ˜7J˜—š
Ÿœ�œ
�œ
�œ�œ˜-Jš�œ
�œ
�œ�œ˜GJ˜J˜J˜—Jš
œ/™/Jš
œ™Jš
œ/™/J˜˜'Jš
œB™BJš
œ9™9š�œ
�œ
�œ˜(JšœI�œ˜S—Jš	œ�œ
�œ�œ
�œ˜'Jšœ�œ
˜ J˜!š�œ�œ˜Jš
œO™OJšœ�œ˜
Jšœ�œ�œ�œ)˜PJ˜,š�œ
�œ	�œ�˜&š�œ
�œ�œ
�˜&Jšœ�œ!�œ˜:—Jš�œ
˜—J˜.Jš
�˜J˜—J˜ š�œ�œ˜Jš
œM™MJ˜,J˜(—š�œ˜Jšœ*ž)˜SJ˜—J˜9Jš�œ
˜J˜—˜#š�œ
�˜Jš�œ�œ
�œ˜#Jšœ
�œ �œ˜9š�œ˜Jšœ
�œF�œ˜_—Jš�œ
˜—Jš	œ�œ
�œ�œ
�œ˜'Jšœ
�œ�œ˜1Jšœ
�œ�œ˜4Jšœ�œ&˜+Jš
œ'˜'J˜—˜$š�œ
�˜Jš�œ�œ
�œ˜#Jšœ
�œ �œ˜9š�œ˜Jšœ
�œG�œ˜`—Jš�œ
˜—Jš	œ�œ
�œ�œ
�œ˜'Jšœ
�œ�œ˜1Jšœ
�œ�œ˜4Jšœ�œ&˜+š�œ!˜#Jš�œ
�œ.�	œ˜@—Jš�œ
�œ�œ
�œ
�œ�œ˜IJš�œ˜Jš�œ˜J˜—˜#Jšœ
�œ
˜J˜J˜—˜#š�œ
�˜Jš�œ�œ
�œ˜#Jšœ
�œ �œ˜9š�œ˜Jšœ
�œM�œ˜f—Jš�œ
˜—Jš	œ�œ
�œ�œ
�œ˜'Jšœ
�œ˜(Jšœ�œ˜&Jšœ
�œ�œ˜4Jšœ�œ&˜+J˜˜Jš�œ�œ
�œ�œ
˜/J˜Jš�œ
�œ
�œ
�œ	˜.—J˜J˜J˜—Jš
œ/™/Jš
œ™Jš
œ/™/J˜šŸ
œ�œ�œ�œ
˜@Jš
œR™RJšœ�œ˜Jšœ�œ˜Jšœ�œ
˜	Jš�œ
�œ�œ
�œ
˜#Jšœ�œ)˜1Jš�œ
�œ�œ(�œ˜DJ˜š�œ�œ�˜&Jš
œ@™@Jš
�˜šœ�œ�œ)˜=Jšœ*�œ˜9—Jšœ�œ˜š�œ�œ�œ
�˜%˜Jš�œ	�œ4�œ˜IJšœ�œ8�œ˜WJš�œ
˜——Jš�œ	�œ˜*Jš
�˜—š
�˜Jš
�˜Jšœ�œ!˜*Jš�œ
�œ�œ7�œ˜TšœH�œ˜MJš�œ
˜——J˜J˜—š
Ÿœ�œ�œ�œ�œ˜<Jšœ�œ
˜
š�œ�œ
�œ
�œ�œ�œ�œ
�˜HJš
�œ�œ
�œ�œ�œ
˜7—J˜5J˜—šŸ
œ�œ�œ�œ
˜=Jš
œ2™2Jš�œ
�œ�œ
�˜"š
�˜šœ�œ	�œ*˜>Jš�œ�œ
�œ˜*Jš�œ
˜JšœE�œ˜OJ˜———šŸœ�œ�œ�œ
˜@Jš
œ2™2Jš�œ
�œ�œ
�˜"š
�˜šœ�œ
�œ ˜5Jš�œ
�œ�œ˜0Jš�œE˜IJ˜———šŸ
œ�œ�œ�œ�œ
�œ˜BJš
œ5™5Jš
�˜Jšœ
�œ˜&J˜J˜	š�œ�œ˜J˜"J˜HJ˜—Jš�œ
˜J˜—šŸœ�œ�œ˜J˜2J˜—Jš
œ/™/Jš
œ
™
Jš
œ/™/J˜J˜˜J˜7—˜J˜;—˜J˜\—˜J˜X—˜J˜:—˜J˜4J˜J˜—J˜
J˜Jš�œ˜J˜Jš�œ
�œ
˜J˜J˜J˜=J˜J˜J˜EJ˜:—…—Z*~ö