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