-- File: SquirrelImpl.mesa
-- Created December, 1981 by Willie-Sue Haugeland & Rick Cattell
-- Last edit by:
-- Rick on: August 11, 1982 12:10 pm
-- Willie-Sue on: August 12, 1982 3:19 pm
-- Maxwell on: July 16, 1982 12:03 pm
DIRECTORY
Buttons USING [ButtonProc],
CedarSnapshot USING [Deregister, Register, CheckpointProc, RollbackProc],
CIFS USING [Error],
Containers USING [ChildXBound],
DBView,
FileIO,
Icons,
IO,
Menus USING [CreateMenu, InsertMenuEntry, Menu, MenuProc],
MessageWindow USING [Append, Blink, Confirm, ReadFrom],
Nut,
NutPrivate,
Rope,
TypeScript USING [TS],
UserExec USING [CommandProc, ExecHandle, RegisterCommand],
UserProfile USING[Boolean, CallWhenProfileChanges, ProfileChangedProc, String],
ViewerMenus USING [Close, Destroy, Grow, Move],
ViewerOps USING [BlinkIcon, CreateViewer, PaintViewer, EstablishViewerPosition],
ViewerTools USING [GetContents, SetContents, SetSelection],
ViewerIO USING [CreateViewerStreams],
ViewerClasses;
SquirrelImpl: MONITOR
IMPORTS DBView, Nut, Icons, IO, --Process,-- Rope, Menus, MessageWindow,
CIFS, CedarSnapshot, Containers, UserProfile, UserExec,
ViewerMenus, ViewerOps, ViewerTools, ViewerIO
EXPORTS Nut, NutPrivate
SHARES Nut, ViewerClasses
= BEGIN OPEN IO, FileIO;
Viewer: TYPE = ViewerClasses.Viewer;
ROPE: TYPE = Rope.ROPE;
StartUpMessage: ROPE ← "... Squirrel 1.4 Release";
databasePathName: PUBLIC ROPE;
remoreDBName: ROPE;
dbTransactionID: PUBLIC REF FileIO.Trans;
dbOpen: BOOL;
tsIn, tsOut, logOut: IO.Handle ← NIL;
--localDatabaseName: ROPE← NIL;
--remoteDatabaseName: ROPE← NIL;
createSquirrelWindow: BOOL ← TRUE; -- might be FALSE for Walnut only, for typical user
squirrel: Viewer;
squirrelIcon: Icons.IconFlavor← tool;
squirrelConfirm: CONDITION;
userHasResponded, userConfirmed: BOOL← FALSE;
tiptoe: PUBLIC BOOL← FALSE; -- TRUE when want as few db accesses as possible
BuildSquirrel: PROC = {
v: Viewer; typeScript: TypeScript.TS;
info: ViewerClasses.ViewerRec← [name: "Squirrel", iconic: TRUE,
column: right, scrollable: FALSE, menu: squirrelMenu];
IF squirrelIcon = tool THEN
BEGIN ENABLE CIFS.Error => GOTO notFound;
squirrelIcon ← Icons.NewIconFromFile["Nut.icons", 0];
EXITS
notFound =>
BEGIN ENABLE CIFS.Error => CONTINUE;
squirrelIcon ← Icons.NewIconFromFile["/Indigo/Squirrel/Icons/Nut.icons", 0];
END;
END;
info.icon← squirrelIcon;
squirrel ← ViewerOps.CreateViewer[flavor: $Container, info: info];
v ← BuildSquirrelArea[squirrel];
v ← Nut.MakeRuler[sib: v];
typeScript ← Nut.MakeTypescript[sib: v];
[tsIn, tsOut] ← ViewerIO.CreateViewerStreams[NIL, typeScript];
logOut← IO.CreateFileStream["Squirrel.log"];
logOut.SetLength[0];
tsOut← IO.CreateDribbleStream[tsOut, logOut, 30];
ViewerOps.PaintViewer[squirrel, all];
ViewerTools.SetContents[databaseText, databasePathName];
ViewerTools.SetContents[domainText, "Domain"];
ViewerTools.SetContents[nameEText, "Domain"];
Message[StartUpMessage];
-- destroy Squirrel at checkpoint time
CedarSnapshot.Register[c: SquirrelCheckpointProc, r: SquirrelRollbackProc];
};
---- ---- ---- ---- ---- ---- ----
databaseText: Viewer; -- current database name
domainText: Viewer; -- the text argument for Domain
nameEText: Viewer; -- the text argument for Name
--**************************
BuildSquirrelArea: PROC [squirrel: Viewer] RETURNS [Viewer] = {
tLabel, bt: Viewer;
tLabel ← Nut.FirstButton[name: "DataBase: ", proc: DataBaseNameProc, border: FALSE,
parent: squirrel];
databaseText ← Nut.NextRightTextViewer[sib: tLabel, w: squirrel.cw - tLabel.ww];
Containers.ChildXBound[databaseText.parent, databaseText];
tLabel ← Nut.AnotherButton[name: "Domain:", proc: DomainNameProc,
border: FALSE, sib: tLabel, newLine: TRUE];
domainText ← Nut.NextRightTextViewer[sib: tLabel, w: squirrel.cw - tLabel.ww];
Containers.ChildXBound[domainText.parent, domainText];
tLabel ← Nut.AnotherButton[name: "Name:", proc: NameNameProc,
border: FALSE, sib: tLabel, newLine: TRUE];
nameEText ← Nut.NextRightTextViewer[sib: tLabel, w: squirrel.cw - tLabel.ww];
Containers.ChildXBound[nameEText.parent, nameEText];
bt ←
Nut.AnotherButton
[name: "* Displayer", proc: DisplayerProc, sib: nameEText, border: TRUE,
newLine: TRUE];
bt ←
Nut.AnotherButton
[name: "o Editor", proc: EditorProc, sib: bt, border: TRUE];
bt ←
Nut.AnotherButton
[name: "# Query", proc: QueryerProc, sib: bt, border: TRUE];
RETURN [bt]
};
Message: PUBLIC PROC [msg1, msg2, msg3, msg4: ROPE ← NIL] = {
IF tsOut # NIL
THEN
{IF msg1 # NIL THEN tsOut.PutRope[msg1];
IF msg2 # NIL THEN tsOut.PutRope[msg2];
IF msg3 # NIL THEN tsOut.PutRope[msg3];
IF msg4 # NIL THEN tsOut.PutRope[msg4];
tsOut.PutChar[IO.CR]}
ELSE
{MessageWindow.Blink[];
IF msg1 # NIL THEN MessageWindow.Append[msg1, TRUE];
IF msg2 # NIL THEN MessageWindow.Append[msg2];
IF msg3 # NIL THEN MessageWindow.Append[msg3];
IF msg4 # NIL THEN MessageWindow.Append[msg4]}
};
MessageRope: PUBLIC PROC [msg1: ROPE] = {
IF tsOut # NIL
THEN tsOut.PutRope[msg1]
ELSE MessageWindow.Append[msg1]
};
MessageResponse: PUBLIC PROC [msg1: ROPE] RETURNS [r: ROPE] = {
-- Prints msg1, asks the user for a response, and returns the string he types
IF tsOut # NIL
THEN
{tsOut.PutRope[msg1]; RETURN [tsIn.GetLine[]]}
ELSE
{MessageWindow.Blink[];
MessageWindow.Append[msg1, TRUE];
r ← MessageWindow.ReadFrom[];
RETURN [Rope.Substr[r, 0, r.Length[] - 1]]}
}; -- exclude termination char
MessageConfirm: PUBLIC INTERNAL PROC [msg1: ROPE] RETURNS [BOOL] = {
IF tsOut # NIL THEN
{ oldM: Menus.Menu← ChangeMainMenu[confirmMenu];
tsOut.PutRope[msg1];
IF squirrel.iconic THEN ViewerOps.BlinkIcon[squirrel];
UNTIL userHasResponded DO WAIT squirrelConfirm; ENDLOOP;
userHasResponded← FALSE;
tsOut.PutRope[IF userConfirmed THEN "..confirmed\n" ELSE "..NOT confirmed\n"];
[]← ChangeMainMenu[oldM];
RETURN[userConfirmed];
};
MessageWindow.Blink[];
RETURN [MessageWindow.Confirm[msg1]]
};
-- ***********************
squirrelMenu: Menus.Menu ← Menus.CreateMenu[1];
utilityMenu: ViewerClasses.MenuEntry;
confirmMenu: Menus.Menu ← Menus.CreateMenu[];
BuildSquirrelMenu: PROC = {
Menus.InsertMenuEntry[confirmMenu, "Deny", SqDenyProc, TRUE];
Menus.InsertMenuEntry[confirmMenu, "Confirm", SqConfirmProc, TRUE];
Menus.InsertMenuEntry[confirmMenu, "<-->", ViewerMenus.Move];
Menus.InsertMenuEntry[confirmMenu, "Grow", ViewerMenus.Grow];
Menus.InsertMenuEntry[confirmMenu, "Close", ViewerMenus.Close];
Menus.InsertMenuEntry[squirrelMenu, "UtilityMenu", MyUtilityMenuProc];
Menus.InsertMenuEntry[squirrelMenu, "Open", MyOpenProc, TRUE];
Menus.InsertMenuEntry[squirrelMenu, "Save", MyCommitProc];
Menus.InsertMenuEntry[squirrelMenu, "Reset", MyAbortProc];
Menus.InsertMenuEntry[squirrelMenu, "Destroy", MyDestroyProc, TRUE];
Menus.InsertMenuEntry[squirrelMenu, "<-->", ViewerMenus.Move];
Menus.InsertMenuEntry[squirrelMenu, "Grow", ViewerMenus.Grow];
Menus.InsertMenuEntry[squirrelMenu, "Close", ViewerMenus.Close];
-- build the utilities menu
Menus.InsertMenuEntry[squirrelMenu, "EraseAll", EraseAllProc, TRUE, 1];
Menus.InsertMenuEntry[squirrelMenu, "EraseRelation(s)", MyRelationEraseProc, TRUE, 1];
Menus.InsertMenuEntry[squirrelMenu, "EraseDomain(s)", MyDomainEraseProc, TRUE, 1];
Menus.InsertMenuEntry[squirrelMenu, "Dump", MyDumpProc, TRUE, 1];
Menus.InsertMenuEntry[squirrelMenu, "Load", MyLoadProc, TRUE, 1];
Menus.InsertMenuEntry[squirrelMenu, "Debug", DebugProc, FALSE, 1];
utilityMenu ← squirrelMenu.entries[1];
squirrelMenu.entries[1] ← NIL;
squirrelMenu.rowsUsed ← 1
}; -- only show the top level to start
DebugProc: Menus.MenuProc = {Nut.debug ← NOT Nut.debug};
EraseAllProc: ENTRY Menus.MenuProc = {
IF MessageConfirm[" You are about to erase the entire database - please confirm. . ."]
THEN
{MessageRope["Erasing database. . . "]; InternalEraseDataBase[]}
ELSE
Message["Database was NOT erased."]
};
MyUtilityMenuProc: Menus.MenuProc = {
ChangeMenu[viewer, utilityMenu]
};
ChangeMenu: PROC
[parent: ViewerClasses.Viewer, subMenu: ViewerClasses.MenuEntry] = {
-- This proc copied from TEditDocumentsImpl
menu: Menus.Menu ← parent.menu;
found: BOOLEAN ← FALSE;
FOR i: NAT IN [1..menu.rowsUsed) DO -- see if already showing the submenu
IF menu.entries[i] = subMenu THEN -- yes, so remove it
{FOR j: NAT IN (i..menu.rowsUsed) DO
menu.entries[j - 1] ← menu.entries[j]
ENDLOOP;
menu.rowsUsed ← menu.rowsUsed - 1;
found ← TRUE;
EXIT}
ENDLOOP;
IF NOT found THEN -- add it
{IF menu.rowsUsed < 3 THEN menu.rowsUsed ← menu.rowsUsed + 1;
menu.entries[menu.rowsUsed - 1] ← subMenu};
ViewerOps.EstablishViewerPosition
[parent, parent.wx, parent.wy, parent.ww, parent.wh];
ViewerOps.PaintViewer[parent, all]
};
ChangeMainMenu: PROC[menu: Menus.Menu] RETURNS[oldM: Menus.Menu] = {
oldM← squirrel.menu;
squirrel.menu← menu;
ViewerOps.EstablishViewerPosition
[squirrel, squirrel.wx, squirrel.wy, squirrel.ww, squirrel.wh];
ViewerOps.PaintViewer[squirrel, all];
};
---------------------------
MyDomainEraseProc: Menus.MenuProc = {
domainsToDelete: ROPE ← ViewerTools.GetContents[nameEText];
EraseDomains
[NameListToEntityList
[RopeToNameList[domainsToDelete], DBView.DomainDomain]];
Message["Do Save to commit deletions."]
};
MyRelationEraseProc: Menus.MenuProc = {
relationsToDelete: ROPE ← ViewerTools.GetContents[nameEText];
EraseRelations
[NameListToEntityList
[RopeToNameList[relationsToDelete], DBView.RelationDomain]];
Message["Do Save to commit deletions."]
};
MyDumpProc: Menus.MenuProc = {
domainsToDump: ROPE ← ViewerTools.GetContents[nameEText];
Nut.DumpToFile [NIL -- later change for selective dump --, "DB.dump"];
-- NameListToEntityList[RopeToNameList[domainsToDump]
};
MyLoadProc: Menus.MenuProc = {
Nut.LoadFromFile["DB.dump"]
}; -- for now. . .
MyDestroyProc: ENTRY Menus.MenuProc = {
IF ~SquirrelCleanup[viewer, clientData, redButton, FALSE] THEN RETURN;
CedarSnapshot.Deregister[c: SquirrelCheckpointProc, r: SquirrelRollbackProc];
};
SqDenyProc: ENTRY Menus.MenuProc =
{ userConfirmed← FALSE; userHasResponded← TRUE; BROADCAST squirrelConfirm};
SqConfirmProc: ENTRY Menus.MenuProc =
{ userConfirmed← TRUE; userHasResponded← TRUE; BROADCAST squirrelConfirm};
SquirrelCleanup: PROC
[viewer: Viewer, clientData: REF ANY← NIL, redButton: BOOL← TRUE, forceDestroy: BOOL]
RETURNS[okToQuit: BOOL] = {
okToQuit← Nut.DestroyNutList[forceDestroy];
IF ~okToQuit THEN RETURN;
Message["\n Closing database. . ."];
Nut.DBNotify[beforeClose];
dbOpen← FALSE;
DBView.CloseDatabase
[! DBView.RelationOrDomainSubsetsStillOpen, DBView.DatabaseNotOpen => NULL];
domainText ← nameEText ← NIL; -- clear globals
-- tsIn.Close[]; tsOut.Close[]; causes crash with Cedar2.6 viewers
tsIn ← tsOut ← NIL;
squirrel← NIL;
-- squirrelMenu ← NIL; may run squirrel again
ViewerMenus.Destroy[viewer, clientData, redButton]
};
MyOpenProc: ENTRY Menus.MenuProc =
BEGIN
[]← Nut.DestroyNutList[forceDestroy: TRUE];
Message["Committing transactions on ", databasePathName, ". . ."];
Nut.DBNotify[beforeClose];
DBView.CloseDatabase
[! DBView.RelationOrDomainSubsetsStillOpen, DBView.DatabaseNotOpen => NULL];
databasePathName ← ViewerTools.GetContents[databaseText];
OpenUpDB[];
END;
MyCommitProc: Menus.MenuProc = {CommitDBTransactions[]};
MyAbortProc: Menus.MenuProc = {AbortDBTransactions[]};
CommitDBTransactions: PUBLIC ENTRY PROC = {
Nut.DBNotify[beforeCommit];
InternalCommit[];
Nut.DBNotify[afterCommit];
};
AbortDBTransactions: PUBLIC ENTRY PROC = {
Nut.DBNotify[beforeAbort];
MessageRope["Aborting transactions. . ."];
DBView.AbortTransaction[];
MessageRope["reopening database. . ."];
dbTransactionID ← NARROW[DBView.OpenDatabase[databasePathName].transID];
Nut.StartNut[];
Message[" done."];
Nut.DBNotify[afterAbort];
};
EraseDataBase: PUBLIC ENTRY PROC = {InternalEraseDataBase[]};
-- If you call this, you really mean to erase the entire Database
InternalEraseDataBase: INTERNAL PROC =
BEGIN OPEN DBView;
Nut.DBNotify[beforeClose];
DBView.CloseDatabase[! RelationOrDomainSubsetsStillOpen => NULL];
dbTransactionID ← NARROW[
OpenDatabase[databaseName: databasePathName, version: NewOnly].transID];
InternalCommit[];
Nut.StartNut[]; -- re-init some Nut variables
Nut.DBNotify[afterOpen];
END;
InternalCommit: INTERNAL PROC = {
MessageRope["Committing transactions. . ."];
DBView.MarkTransaction[];
Message[" done."]
};
GetDBTransaction: PUBLIC PROC RETURNS [REF ANY] = {
-- Returns database transaction, or NIL if database currently not open.
IF dbOpen THEN RETURN[dbTransactionID] ELSE RETURN[NIL] };
---- ---- ---- ---- ---- ---- ----
DataBaseNameProc: Buttons.ButtonProc =
{ ViewerTools.SetSelection[databaseText, NIL]};
DomainNameProc: Buttons.ButtonProc =
{ ViewerTools.SetSelection[domainText, NIL]};
NameNameProc: Buttons.ButtonProc =
{ ViewerTools.SetSelection[nameEText, NIL]};
DisplayerProc: Buttons.ButtonProc = {
domName: ROPE ← ViewerTools.GetContents[domainText];
entName: ROPE ← ViewerTools.GetContents[nameEText];
DisplayEntity[domName, entName]};
DisplayEntity: PROC[domName, entName: ROPE] = {
-- Tries to display an entity with name entName in domain domName
dom: DBView.Domain ←
DBView.GetEntityByName
[DBView.DomainDomain, domName
! DBView.NotFound => GO TO BadDomain;
DBView.NotImplemented => GO TO NotImplemented];
ent: DBView.Entity;
enl: INT← entName.Length[];
IF enl#0 AND entName.Fetch[enl-1]='* THEN
BEGIN
es: DBView.EntitySet← DBView.DomainSubset[dom, LIST[
[DBView.NameProp, entName.Substr[0, enl-1],
entName.Cat[entName.Substr[0, enl-1],"\177"]]] ];
count: INT← 0;
UNTIL (ent← DBView.NextEntity[es])=NIL DO
count← count+1; IF count>5 THEN {Message["...more than 5; others not displayed"]; EXIT};
[]← Nut.Display[ent];
ENDLOOP;
IF count=0 THEN Message["No such entity"];
END
ELSE
BEGIN
ent ← DBView.GetEntityByName
[dom, entName
! DBView.NotFound => GO TO BadEntity;
DBView.NotImplemented => GO TO NotImplemented];
IF DBView.Null[ent]
THEN Message["No such entity"]
ELSE [] ← Nut.Display[ent]
END;
EXITS
NotImplemented =>
Message["Not implemented"];
BadDomain =>
Message[domName, " is not a domain"];
BadEntity =>
Message[entName, " does not exist in domain ", domName]
};
EditorProc: Buttons.ButtonProc = {
domName: ROPE ← ViewerTools.GetContents[domainText];
entName: ROPE ← ViewerTools.GetContents[nameEText];
dom: DBView.Domain ←
DBView.GetEntityByName
[DBView.DomainDomain, domName
! DBView.NotFound => GO TO BadDomain];
Nut.Edit[dom, entName]
EXITS
BadDomain =>
Message["No such domain"]
};
QueryerProc: Buttons.ButtonProc = {
domName: ROPE ← ViewerTools.GetContents[domainText];
entName: ROPE ← ViewerTools.GetContents[nameEText];
dom: DBView.Domain ←
DBView.GetEntityByName
[DBView.DomainDomain, domName
! DBView.NotFound => GO TO BadDomain];
Nut.Query[dom]
EXITS
BadDomain =>
Message["No such domain"]
};
-- **********************
NameListToEntityList: PROC
[nl: LIST OF ROPE, d: DBView.Domain]
RETURNS [el: LIST OF DBView.Entity] = {
-- Turns a list of names into a list of entities
OPEN DBView;
e: Entity;
IF nl = NIL THEN RETURN [NIL];
e ← GetEntityByName[d, nl.first ! NotFound => {e ← NIL; CONTINUE}];
IF e = NIL
THEN
{Message[nl.first, " is not a ", GetName[d]];
RETURN [NameListToEntityList[nl.rest, d]]}
ELSE
RETURN [CONS[e, NameListToEntityList[nl.rest, d]]]
};
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]]]]
};
EraseDomains: PROC [dl: LIST OF DBView.Domain] = {
-- Erases all domains in dl, all their entities, and all relations that ref them. Careful. . .
al: LIST OF DBView.Attribute;
FOR dlT: LIST OF DBView.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 ← GetDomainDirectRefAttributes[dlT.first]) # NIL THEN
{Nut.Message["Erasing Relations referencing ", DBView.GetName[dlT.first], ":"];
EraseAttributesRelations[al]};
Nut.Message["Erasing Domain ", DBView.GetName[dlT.first], ". . ."];
DBView.DestroyDomain[dlT.first]
ENDLOOP;
Nut.StartNut[]
}; -- re-init
EraseRelations: PROC [rl: LIST OF DBView.Relation] = {
-- Erases all relations in rl, and all their relships. Careful. . .
FOR rlT: LIST OF DBView.Relation ← rl, rlT.rest WHILE NOT (rlT = NIL) DO
Nut.Message["Erasing Relation ", DBView.GetName[rlT.first], ". . ."];
DBView.DestroyRelation[rlT.first]
ENDLOOP;
Nut.StartNut[]
}; -- re-init
EraseAttributesRelations: PROC [al: LIST OF DBView.Attribute] = {
-- Erases relations that attributes belong to
OPEN DBView;
FOR alT: LIST OF Attribute ← al, alT.rest WHILE NOT (alT = NIL) DO
IF NOT DBView.Null[alT.first] THEN
{r: DBView.Relation ← V2E[GetP[alT.first, aRelationProp]];
Nut.Message["Erasing Relation ", DBView.GetName[r], ". . ."];
DBView.DestroyRelation[r]}
ENDLOOP;
Nut.StartNut[]
}; -- re-init
GetDomainDirectRefAttributes: PROC
[d: DBView.Domain] RETURNS [al: DBView.AttributeList] = {
-- copied from DBViewSetImpl: finds attributes that ref d directly
es: DBView.EntitySet;
es ← DBView.DomainSubset[DBView.AttributeDomain, LIST[[DBView.aTypeProp, d]]];
RETURN [DBView.EntitySetToList[es]]
};
---- ---- ---- ---- ---- ---- ----
StartSquirrel: PROC[exec: UserExec.ExecHandle] = {
r: ROPE; ch: CHAR;
h: IO.Handle ← exec.commandLineStream;
UserProfile.CallWhenProfileChanges[SetSquirrelProfileVars];
IF (r ← h.GetToken[]) # NIL THEN
SELECT ch ← r.Fetch[0] FROM
'/ =>
-- Process a switch
SELECT Rope.Lower[h.GetChar[]] FROM
'r => databasePathName ← remoreDBName;
't => tiptoe ← TRUE;
ENDCASE => Nut.Message["Unrecognized switch!"];
'[, '< => databasePathName ← Rope.Concat[r, h.GetRope[]]
ENDCASE =>
IF Rope.Letter[ch] THEN databasePathName ← Rope.Concat["[Local]", r]
};
OpenUpDB: PROC = {
-- Does OpenDatabase call, sets up transaction
{ENABLE {
DBView.IllegalDatabaseName,
DBView.ProtectionViolation,
DBView.ServerNotFound =>
{Message["Can't open database!"]; GO TO Failure}};
MessageRope[Rope.Cat["Opening ", databasePathName, ". . ."]];
dbOpen ← TRUE;
dbTransactionID ← NARROW[DBView.OpenDatabase
[databaseName: databasePathName, version: OldOnly
! DBView.DatabaseNotFound => {dbOpen ← FALSE; CONTINUE}].transID];
IF NOT dbOpen THEN
{Message["\nCan't find database ", databasePathName, ", so creating it. . ."];
dbTransactionID ← NARROW[DBView.OpenDatabase
[databaseName: databasePathName, version: NewOnly].transID];
CommitDBTransactions[];
dbOpen← TRUE
};
Nut.StartNut[];
Nut.DBNotify[afterOpen];
Message[" done."]}
EXITS
Failure => NULL
}; -- actually ought to take down Squirrel window if its up
----------------------------
SetSquirrelProfileVars: UserProfile.ProfileChangedProc = CHECKED
BEGIN
remoreDBName←
UserProfile.String[key: "RemoteDatabaseName", default: "<CedarDB>DB"];
createSquirrelWindow ←
UserProfile.Boolean[key: "SquirrelWindow", default: TRUE];
databasePathName ←
UserProfile.String[key: "LocalDatabaseName", default: "[Local]DB"];
END;
----------------------------
SquirrelCheckpointProc: CedarSnapshot.CheckpointProc =
{ []← SquirrelCleanup[viewer: squirrel, forceDestroy: TRUE]};
SquirrelRollbackProc: CedarSnapshot.RollbackProc =
-- assume one doesn't change users at rollback time, if Squirrel is in checkpoint
BEGIN
IF createSquirrelWindow THEN BuildSquirrel[];
OpenUpDB[];
END;
ShowEntityProc: UserExec.CommandProc = TRUSTED
-- Read line of the form "ShowEntity DomainName: Entity Name".
-- Entity name is everything after ": " and up to CR.
BEGIN
h: IO.Handle ← exec.commandLineStream;
domName: ROPE← h.GetToken[IDBreak];
entName: ROPE← h.GetToken[CRBreak];
DisplayEntity[domName, entName];
END;
DumpProc: UserExec.CommandProc = TRUSTED
BEGIN
Nut.DumpToFile[NIL, "DB.dump"];
END;
LoadProc: UserExec.CommandProc = TRUSTED
BEGIN
Nut.LoadFromFile["DB.dump"];
END;
EraseProc: UserExec.CommandProc = TRUSTED
BEGIN
EraseDataBase[];
END;
SquirrelProc: UserExec.CommandProc = TRUSTED
BEGIN
StartSquirrel[exec];
IF createSquirrelWindow THEN BuildSquirrel[];
OpenUpDB[];
END;
BuildSquirrelMenu[]; -- done once
UserExec.RegisterCommand["Squirrel", SquirrelProc, "Database application tool"];
UserExec.RegisterCommand["DBShow", ShowEntityProc, "Displays a database entity"];
UserExec.RegisterCommand["DBDump", DumpProc, "Dumps database to db.dump"];
UserExec.RegisterCommand["DBLoad", LoadProc, "Loads database from db.dump"];
UserExec.RegisterCommand["DBEraseAll", EraseProc, "Erases a database (careful!)"];
END.
Change Log since August 1, 1982:
By Cattell August 5, 1982 7:26 pm: Added GetDBTransaction, logging to Squirrel.log file.
By Cattell August 9, 1982 2:55 pm: Set dbOpen in cleanup and db creation.
By Cattell August 10, 1982 2:04 pm: Fork the erase relation/domain buttons.
By Cattell for Willie-Sue August 11, 1982 10:10 am: Make GetDBTransaction not an ENTRY proc.
By Cattell August 11, 1982 12:11 pm: Added "tiptoe" switch.