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