-- 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 26, 1983 9:50 am


DIRECTORY
Ascii USING[ Letter ],
Atom USING [GetPName, MakeAtom],
Buttons USING [ButtonProc],
FS USING [Error],
Commander USING[ CommandObject, CommandProc, Register ],
CommandTool USING [Run],
Containers USING [ChildXBound],
DB,
-- FinchSmarts USING[PlaceCall],
Icons,
IO,
Menus USING [AppendMenuEntry, CreateMenu, Menu, MenuProc, CreateEntry],
MessageWindow USING [Append, Confirm, Clear],
Nut,
NutDump USING [DumpToFile, LoadFromFile],
NutOps,
NutViewer,
Process,
Rope,
PrincOpsUtils USING [IsBound],
SquirrelTool,
UserProfile USING[Number, Token],
ViewerEvents,
ViewerOps,
ViewerTools USING [GetContents, SetContents, SetSelection],
ViewerIO USING [CreateViewerStreams],
ViewerClasses,
Whiteboard USING [WBSegment];

SquirrelToolImpl: CEDAR MONITOR
IMPORTS Ascii, Atom, FS, Containers, CommandTool, DB, -- FinchSmarts,-- Icons, IO,
MessageWindow, Menus, Nut, NutDump, NutOps,
NutViewer, Process, Rope, PrincOpsUtils, UserProfile, Commander,
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;
squirrelSegment: PUBLIC ROPE; -- the name of any $Squirrel segment opened
segmentName: ROPE; -- the name of the last segment opened with the Tool

stopped: PUBLIC BOOLEAN;

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

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 =>
IF Ascii.Letter[ch] THEN segName ← Rope.Concat["[Local]", r];
SELECT TRUE FROM
segName.Length[] # 0 => segmentName ← segName;
ENDCASE => {
IF Whiteboard.WBSegment # NIL THEN segmentName ← Whiteboard.WBSegment
ELSE segmentName ← UserProfile.Token["Squirrel.Segment", "[Local]Squirrel.segment"];
};
BuildSquirrel[];
IF segName # NIL THEN MyOpenProc[ squirrel ] -- user specified it, open it up
END;


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

squirrel: PUBLIC Viewer;
squirrelOut: PUBLIC IO.STREAM ← IO.noWhereStream;

squirrelIcon: Icons.IconFlavor ← tool;
tsIn, tsOut: IO.STREAM ← 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 5.0 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 ! FS.Error => {CONTINUE}];
IF squirrelIcon = tool THEN squirrelIcon ←
Icons.NewIconFromFile["/Indigo/Squirrel/Icons/Nut.icons", 0 ! FS.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];
squirrelOut ← tsOut;
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 = {
-- Display specified entity, opening segment if necessary
segName: ROPE ← ViewerTools.GetContents[segmentText];
domName: ROPE ← ViewerTools.GetContents[domainText];
entName: ROPE ← ViewerTools.GetContents[nameText];
seg: DB.Segment← NutOps.AtomFromSegment[segName];
[]← NutOps.SetUpSegment[segName, seg];
DisplayEntity[domName, entName, seg]};

EditorProc: Buttons.ButtonProc = {
-- Edit specified entity, opening segment if necessary
segName: ROPE ← ViewerTools.GetContents[segmentText];
domName: ROPE ← ViewerTools.GetContents[domainText];
entName: ROPE ← ViewerTools.GetContents[nameText];
seg: DB.Segment← NutOps.AtomFromSegment[segName];
[]← NutOps.SetUpSegment[segName, seg];
EditEntity[domName, entName, seg];
};

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[Atom.GetPName[GetSegment[]], " transaction committed."] };

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

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

MyOpenProc: Menus.MenuProc =
{ success: BOOL;
s: DB.Segment = GetSegment[];
fileName: ROPE ← ViewerTools.GetContents[segmentText];
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;
-- See whether the segment is already open with a different file name
IF Rope.Fetch[fileName, 0] # '[ THEN fileName ← Rope.Concat["[Local]", 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 };
-- File is either different or previous one was closed; must and can open segment
[success, readOnly]← NutOps.SetUpSegment[fileName, s,, readOnly];
IF success THEN {
Nut.Notify[s, open];
Message[ fileName, " has been opened", IF readOnly THEN ", read-only" ELSE ""]}
ELSE
Message["Can't open transaction on ", fileName, "!"];
};

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

EraseAllProc: Menus.MenuProc = {
s: DB.Segment = GetSegment[];
fileName: ROPE = ViewerTools.GetContents[segmentText];
IF NOT NutOps.SetUpSegment[fileName, s].success THEN RETURN;
IF DB.TransactionOf[s]#NIL THEN Nut.Notify[s, close];
DB.EraseSegment[s];
DB.OpenTransaction[s];
Nut.Notify[s, open];
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[segmentText];
 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]; Nut.Notify[s, close] } };
ViewerOps.DestroyViewer[squirrel];
squirrel ← NIL; squirrelOut ← IO.noWhereStream };

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


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

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

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.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;
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: Commander.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[cmd.commandLine];
segName, domName, entName: ROPE;
segName ← h.GetTokenRope[].token;
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.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
};
[] ← h.GetTokenRope[]; -- skip over the ":" and following blanks
domName← h.GetTokenRope[].token;
IF h.PeekChar[]#': THEN {
-- Segment was defaulted, since no domain was given: search the Squirrel segment
entName← Rope.Cat[domName, h.GetLineRope[]];
domName← segName; segName← "Squirrel" }
ELSE {
[] ← h.GetTokenRope[]; -- Skip over the ":" and following blanks
entName ← h.GetLineRope[] };
DisplayEntity[domName, entName, Atom.MakeAtom[segName]];
END;

OpenProc: Commander.CommandProc = {
h: IO.STREAM ← IO.RIS[cmd.commandLine];
segName: ROPE = h.GetTokenRope[IO.IDProc].token;
s: DB.Segment = NutOps.AtomFromSegment[segName];
[]← NutOps.SetUpSegment[segName, s];
Nut.Notify[s, open] };

EraseProc: Commander.CommandProc = {
h: IO.STREAM ← IO.RIS[cmd.commandLine];
segName: ROPE = h.GetTokenRope[ ].token;
s: DB.Segment = NutOps.AtomFromSegment[ segName ];
IF NOT NutOps.SetUpSegment[segName, s].success THEN RETURN;
IF DB.TransactionOf[s]#NIL THEN DB.CloseTransaction[DB.TransactionOf[s]];
Nut.Notify[s, close];
DB.EraseSegment[s];
DB.OpenTransaction[s];
Nut.Notify[s, open] };

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

LoadProc: Commander.CommandProc = {
h: IO.STREAM = IO.RIS[cmd.commandLine];
fileName: ROPE = h.GetTokenRope[].token;
DBName: ROPE = h.GetTokenRope[].token;
SetPriority[]; 
NutDump.LoadFromFile[
IF fileName = NIL THEN "DB.dump" ELSE fileName,
IF DBName = NIL THEN segmentName ELSE DBName ]
};

PhoneProc: Commander.CommandProc = TRUSTED {
number: ROPE; t: DB.Relship; phone: DB.Relation; phoneOf, phoneIs, phoneAt: DB.Attribute;
h: IO.STREAM = IO.RIS[cmd.commandLine];
skip: CHAR = h.GetChar[]; -- skip leading space
name: ROPE = h.GetLineRope[];
person: DB.Entity = StringToPerson[name];
IF person=NIL THEN RETURN[NIL, Rope.Cat["Found no Person or RegisteredName ", name]];
phone← DB.DeclareRelation["phone", DB.SegmentOf[person], OldOnly];
phoneOf← DB.DeclareAttribute[phone, "of"];
phoneIs← DB.DeclareAttribute[phone, "is"];
phoneAt← DB.DeclareAttribute[phone, "at"];
t← DB.DeclareRelship[phone, LIST[[phoneOf, person], [phoneAt, DB.S2V["work"]]], OldOnly];
IF t=NIL THEN RETURN[NIL, Rope.Cat["Found no phone number for ", name]];
number ← DB.V2S[DB.GetF[t, phoneIs]];
-- IF NOT PrincOpsUtils.IsBound[FinchSmarts.PlaceCall] THEN {
-- err: ROPE;
-- MessageRope["Loading and starting Finch... "];
-- err← CommandTool.Run["Finch"].errMsg;
-- IF err.Length[]#0 THEN Message[err]
-- ELSE { [] ← CommandTool.DoCommandRope[commandLine: "Finch",
--             parent: NEW[Commander.CommandObject ← []]];
--   Message["Done."] } };
-- FinchSmarts.PlaceCall[number: number, rName: DB.NameOf[person]];
};

PersonProc: Commander.CommandProc = {
h: IO.STREAM = IO.RIS[cmd.commandLine];
skip: CHAR = h.GetChar[]; -- skip leading space
name: ROPE = h.GetLineRope[];
person: DB.Entity = StringToPerson[name];
IF person#NIL THEN []← Nut.Display[person]
ELSE RETURN[NIL, Rope.Cat["Found no Person or RegisteredName ", name]];
};

StringToPerson: PROC[name: ROPE] RETURNS [person: DB.Entity] = {
-- Try to find the named person. Look in Squirrel, GrapenutLocal, and GrapenutRemote
-- segments. Try name as an RName, then as a prefix of a real name.
IF name=NIL THEN RETURN[NIL];
IF NutOps.SetUpSegment[
"[Local]Squirrel.segment", $Squirrel].success THEN {
person← TryAsRName[name, $Squirrel]; IF person#NIL THEN RETURN;
person← TryAsName[name, $Squirrel]; IF person#NIL THEN RETURN};
IF NutOps.SetUpSegment[
"[Local]GrapenutLocal.segment", $GrapenutLocal].success THEN {
person← TryAsRName[name, $GrapenutLocal]; IF person#NIL THEN RETURN;
person← TryAsName[name, $GrapenutLocal]; IF person#NIL THEN RETURN};
IF NutOps.SetUpSegment[
"[Luther.Alpine]<Grapenut>GrapenutRemote.segment", $GrapenutRemote].success THEN {
person← TryAsRName[name, $GrapenutRemote]; IF person#NIL THEN RETURN;
person← TryAsName[name, $GrapenutRemote]; IF person#NIL THEN RETURN};
};

TryAsRName: PROC[name: ROPE, seg: DB.Segment] RETURNS [person: DB.Entity] = {
RName: DB.Domain = DB.DeclareDomain["RegisteredName", seg, OldOnly];
mailbox: DB.Relation = DB.DeclareRelation["mailbox-name", seg, OldOnly];
mailboxOf: DB.Attribute = DB.DeclareAttribute[mailbox, "of"];
IF RName=NIL THEN RETURN[NIL];
person← DB.FetchEntity[RName, name];
IF person=NIL THEN RETURN[NIL];
person← DB.V2E[DB.GetP[person, mailboxOf]];
};

TryAsName: PROC[name: ROPE, seg: DB.Segment] RETURNS [person: DB.Entity] = {
es: DB.EntitySet; other: DB.Entity;
count: INT← 0;
People: DB.Domain = DB.DeclareDomain["Person", seg, OldOnly];
IF People=NIL THEN RETURN[NIL];
es← DB.DomainSubset[People, name, name.Concat["\177"]];
person← DB.NextEntity[es];
IF (other← DB.NextEntity[es])#NIL THEN BEGIN
MessageRope["Name is not unique! Matches: "];
MessageRope[DB.NameOf[person]]; MessageRope["; "];
MessageRope[DB.NameOf[other]]; MessageRope["; "];
WHILE (other← DB.NextEntity[es])#NIL DO
IF (count← count+1)> 5 THEN {MessageRope[" ... "]; EXIT};
MessageRope[DB.NameOf[other]]; MessageRope["; "];
ENDLOOP;
person← NIL;
END;
};


-- ***********************************************
-- 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, method: oneOnly]; RETURN}
ELSE IF name.Equal["Relation", FALSE] THEN
{[] ← Nut.Display[e: DB.RelationDomain, seg: segment, method: oneOnly]; 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,, oneOnly];
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,, oneOnly]
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" ] };

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

ExtractSwitch: PROC[old: ROPE] RETURNS [new: ROPE, switch: CHAR] =
-- Extracts one-character switch, returns blank if none.
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] };


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

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"];
Commander.Register[
"Person", PersonProc, "Display person with given RName or name (any prefix, lastname first)"];
Commander.Register[
"Ring", PhoneProc, "Phones person with given RName or real name (prefix, lastname first)"];


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 GetTokenRope 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.

Cattell June 22, 1983 5:04 pm: Make dump command always dump entire segment; confused users.