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: July 3, 1984 11:34:45 am PDT
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;
***********************************************
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
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;
***********************************************
Window and buttons
***********************************************
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 = {
Builds and puts up the Squirrel window
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 = {
Display specified entity, opening segment if necessary
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 = {
Edit specified entity, opening segment if necessary
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];
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[entName, domName, GetSegment[]]
};
EraseDomains:
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:
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] =
BEGIN
segName: ROPE = ViewerTools.GetContents[segmentText];
RETURN[IF NOT Rope.Equal[segName, NIL] THEN Atom.MakeAtom[segName] ELSE NIL];
END;
***********************************************
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[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;
See whether the segment is already open with a different file name
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 };
File is either different or previous one was closed; must and can open segment
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]];
};
***********************************************
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;
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] = {
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
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 {
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
};
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.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 ]
};
***********************************************
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;
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
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[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] = {
Again, first check to see that the segment is open
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] = {
Again, first check to see that the segment is open
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] =
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"];
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).