-- 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: June 7, 1983 2:54 pm
 --  Donahue on: June 1, 1983 4:53 pm


DIRECTORY
  Atom USING [GetPName, MakeAtom],
  Buttons USING [ButtonProc],
  CIFS USING [Error],
  CommandTool USING [DoCommand],
  Containers USING [ChildXBound], 
  DB,
  Icons, 
  IO, 
  Menus USING [AppendMenuEntry, CreateMenu, Menu, MenuProc, CreateEntry], 
  MessageWindow USING [Append],
  Nut,
  NutDump USING [DumpToFile, LoadFromFile],
  NutOps,
  NutViewer, 
  Process,
  Rope,
  Runtime USING [IsBound],
  SquirrelTool, 
  UserExec USING [CommandProc, RegisterCommand],
  UserProfile USING[ Number, Token ], 
  ViewerEvents,
  ViewerOps, 
  ViewerTools USING [GetContents, SetContents, SetSelection], 
  ViewerIO USING [CreateViewerStreams], 
  ViewerClasses,
  Whiteboard USING[ OpenSegment ];

SquirrelToolImpl: CEDAR MONITOR
  IMPORTS Atom, CIFS, Containers, CommandTool, DB, Icons, IO,
          MessageWindow, Menus, Nut, NutDump, NutOps,
          NutViewer, Process, Rope, Runtime, UserProfile, UserExec,
          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;
  segmentName: ROPE _ UserProfile.Token["Squirrel.Segment", "[Local]Squirrel.segment"];
  
  stopped: PUBLIC BOOLEAN;
   
  Initialize: PROCEDURE = TRUSTED {
    IF ~Runtime.IsBound[DB.Initialize] THEN {
      err: ROPE;
      MessageRope["Loading and starting Cypress... "];
      err_ CommandTool.DoCommand["Run", "Cypress"].err;
      IF err.Length[]#0 THEN Message[err] ELSE Message["Done."]};
    DB.Initialize[ nCachePages: UserProfile.Number["Squirrel.nCachePages", 256]];
    stopped _ FALSE };

  SquirrelProc: UserExec.CommandProc =
    BEGIN
    segName: ROPE;
    r: ROPE; ch: CHAR; 
    h: IO.STREAM _ IO.RIS[ event.commandLine ]; 
	 IF (r _ h.GetToken[]) # NIL THEN 
       SELECT ch _ r.Fetch[0] FROM 
         '[, '< => segName _ Rope.Concat[r, h.GetSequence[]]
         ENDCASE => 
           IF Rope.Letter[ch] THEN segName _ Rope.Concat["[Local]", r]; 
    IF segName.Length[] # 0 AND NOT Rope.Equal[segName, segmentName] THEN
      { TRUSTED{ Whiteboard.OpenSegment[ segName ] };
        segmentName _ segName };
    BuildSquirrel[];
    END;
  

-- ***********************************************
-- Window and buttons 
-- ***********************************************
  
  squirrel: PUBLIC Viewer;
  squirrelIcon: Icons.IconFlavor _ tool;
  tsIn, tsOut: IO.Handle _ 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 4.2 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 ! CIFS.Error => {CONTINUE}];
    IF squirrelIcon = tool THEN squirrelIcon _ 
       Icons.NewIconFromFile["/Indigo/Squirrel/Icons/Nut.icons", 0 ! CIFS.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]; 
       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 = {
    domName: ROPE _ ViewerTools.GetContents[domainText]; 
    entName: ROPE _ ViewerTools.GetContents[nameText];
    DisplayEntity[domName, entName, GetSegment[]]};
  
  EditorProc: Buttons.ButtonProc = {
    domName: ROPE _ ViewerTools.GetContents[domainText]; 
    entName: ROPE _ ViewerTools.GetContents[nameText];
    EditEntity[domName, entName, GetSegment[]]
    }; 
  
  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["transaction for ", ViewerTools.GetContents[segmentText], " committed."] };
  
MyResetProc: Menus.MenuProc = {
	s: DB.Segment = GetSegment[];
	fileName: ROPE = ViewerTools.GetContents[segmentText];
	DB.AbortTransaction[DB.TransactionOf[s]];
	Message["Transaction for ", fileName, " aborted."];
	DB.OpenTransaction[ s ];
	IF s = $Squirrel THEN TRUSTED{ Whiteboard.OpenSegment[fileName] };
	Message["Transaction for ", fileName, " opened."] }; 

MyCloseProc: Menus.MenuProc = {
	DB.CloseTransaction[DB.TransactionOf[GetSegment[]]];
	Message[ViewerTools.GetContents[segmentText], " has been closed"] };

MyOpenProc: Menus.MenuProc = 
  { s: DB.Segment = GetSegment[];
    fileName: ROPE = ViewerTools.GetContents[segmentText];
    IF s = $Squirrel THEN TRUSTED{ Whiteboard.OpenSegment[fileName] }
    ELSE NutOps.SetUpSegment[fileName, s];
    Message[ fileName, " has been opened"] };

DebugProc: Menus.MenuProc = {Nut.debug _ NOT Nut.debug};
  
EraseAllProc: Menus.MenuProc = {
   s: DB.Segment = GetSegment[];
   fileName: ROPE = ViewerTools.GetContents[segmentText];
   NutOps.SetUpSegment[fileName, s];
   IF DB.TransactionOf[s]#NIL THEN DB.CloseTransaction[DB.TransactionOf[s]];
   DB.DeclareSegment[fileName, s, , , NewOnly];
   DB.OpenTransaction[s];
   IF s = $Squirrel THEN TRUSTED{ Whiteboard.OpenSegment[fileName, FALSE] };
   Message[fileName, " has been erased and re-initialized"] };

ListSegsProc: Menus.MenuProc = {
	segs: LIST OF DB.Segment = DB.GetSegments[];
	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[" "];
	 MessageRope[Atom.GetPName[s1.first]];
	 IF DB.TransactionOf[s1.first]#NIL THEN 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[] ];
   command: ROPE = Rope.Cat[ segment, " ", ViewerTools.GetContents[nameText] ]; 
   stopped _ FALSE; DumpData[command]; };
    
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 = {
	ViewerEvents.UnRegisterEventProc[squirrelEventReg, destroy];
	squirrelEventReg_ NIL;
   ViewerOps.DestroyViewer[squirrel] };

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

-- ***********************************************
-- Support procedures 
-- ***********************************************
  
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.GetToken[IO.WhiteSpace];
    seg: DB.Segment_ Atom.MakeAtom[segName];
    SetPriority[];	
    BEGIN
     IF command.Find["_"] = -1 THEN
       { file _ FALSE; fileName _ Rope.Cat[segName, ".dump"] };
    WHILE ~stream.EndOf[] DO
       token _ stream.GetToken[IO.WhiteSpace];
       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: UserExec.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[event.commandLine];
    segName, domName, entName: ROPE;
    segName_ h.GetToken[IO.IDProc];
    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.GetSequence[IO.LineAtATime]];
      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.SkipOver[IO.IDProc]; -- skip over the ":" and following blanks
    domName_ h.GetToken[IO.IDProc];
    IF h.PeekChar[]#': THEN {
      -- Segment was defaulted, since no domain was given: search the Squirrel segment
      entName_ Rope.Cat[domName, h.GetSequence[IO.LineAtATime]];
      domName_ segName;  segName_ "Squirrel" }
    ELSE {
      h.SkipOver[IO.IDProc]; -- Skip over the ":" and following blanks
      entName _ h.GetSequence[IO.LineAtATime]};
    DisplayEntity[domName, entName, Atom.MakeAtom[segName]]; 
    END;

EraseProc: UserExec.CommandProc = {
    h: IO.STREAM _ IO.RIS[event.commandLine];
    segName: ROPE = h.GetToken[IO.IDProc];
    s: DB.Segment = NutOps.AtomFromSegment[ segName ];
    NutOps.SetUpSegment[segName, s]; 
    IF DB.TransactionOf[s]#NIL THEN DB.CloseTransaction[DB.TransactionOf[s]];
    DB.DeclareSegment[segName, s, , , NewOnly];
    DB.OpenTransaction[s] };
       
DumpProc: UserExec.CommandProc = {
    stopped_ FALSE;
    DumpData[event.commandLine]};
    
LoadProc: UserExec.CommandProc = {
    h: IO.STREAM = IO.RIS[event.commandLine];
    fileName: ROPE = h.GetToken[];
    DBName: ROPE = h.GetToken[IDProc]; 
    SetPriority[];	
    NutDump.LoadFromFile[IF fileName = NIL THEN "DB.dump" ELSE fileName,
    							  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;
    -- 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]; RETURN}
      ELSE IF name.Equal["Relation", FALSE] THEN
        {[] _ Nut.Display[e: DB.RelationDomain, seg: segment]; 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];
        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]
      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], " 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] } };

SetPriority: PROC = TRUSTED {
    Process.SetPriority[Process.priorityBackground] };


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

BuildSquirrelMenu[];
UserExec.RegisterCommand["Squirrel", SquirrelProc, "Database application tool"];
UserExec.RegisterCommand["DBDisplay", ShowEntityProc, "Displays a database entity"];
UserExec.RegisterCommand["DBDump", DumpProc, "[file _ ] [~] [!] [[Domains: ] aaa bbb] [Relations: rrr sss]"];
UserExec.RegisterCommand["DBLoad", LoadProc, "Loads given file (DB.dump default) from given segment"];
UserExec.RegisterCommand["DBEraseSegment", EraseProc, "Erases a database segment"];

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 GetToken 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.
Ę
÷˜J•StartOfExpansion[segment: 
DB.Segment]š„Īc2œ
*œ
-œ
%œ
%œĪk	œžœ!žœžœ
žœžœžœ0žœožœžœ/žœ@žœ7žœ7žœ$žœ
žœžœžœë
žœžœžœ
žœžœžœžœžœyœžœžœžœžœžœSžœ
žœĪnœž	œžœžœ!žœˆ
žœžœžœtžœĪbœžœžœ	žœžœ
žœ
žœžœ
žœžœžœ
žœ	žœžœHžœžœžœ+žœžœ
žœ"žœ	žœažœ~œžœAžœ
žœ!œ œœžœŸœžœ	*œfžœ"žœžœžœ?žœžœžœžœVžœžœ
žœžœ
žœžœĒžœģŸœžœžœ°
žœ”žœžœö
žœžœ›
žœ œBžœ œ@žœ œCžœ œ&žœ6žœ] œ&žœ6žœ` 
œ&žœ6žœ*Fœžœžœžœžœ#žœ4Ÿœžœ
žœžœ
žœ
žœ`œžœ
žœ
žœžœžœ
žœ
žœžœ
žœžœžœ
\œžœ7žœ
žœ8žœš
žœ
Ÿœžœ
žœžœ
žœ
žœEœžœžœ
žœžœ
žœžœžœwžœŸœžœžœ
žœ
žœ.œžœ
žœžœžœ
žœžœ
žœžœžœ
žœ
žœ
žœžœžœYžœCžœ3Ÿœžœ
žœžœ
žœF|˜“@Jš
œ1˜1JšĀŸœžœžœÁžœËžœ‘
žœ
œvœ
 
œ3/œ
 œžœRžœ^žœžœžœ
žœ^ œžœz 
œžœXžœžœ
žœ 	œ žœ œžœ{žœžœ
žœ
žœ+žœ.žœžœžœ
žœm œžœ
žœ
žœžœžœžœ
žœ$žœ*žœžœ
žœ
žœžœžœ
žœ?žœžœžœŸ
œžœ+žœžœžœžœžœžœžœž
œžœ-žœžœĮ
Ÿ œžœžœ2žœRžœS œžœžœ3žœVžœW 
œ!žœ.žœNžœ 
œžœ	 œ"žœ 	œžœž
œ
ž	œ
žœ
žœ
žœžœžœžœ
žœ œžœVžœ* œ!žœ/žœ|~œŸœž	œ
žœ^œžœžœžœ
žœ
žœ
žœžœ
žœ
žœžœžœžœžœžœžœžœžœžœ
žœžœ
žœžœžœžœ:žœžœžœžœ/žœžœ žœžœžœžœžœ
žœ	žœ
žœ
žœ	žœ
žœ
žœ!žœžœ$žœžœ$žœžœ&žœžœ-žœ žœ/žœžœžœ	žœžœ
žœ5žœžœ
žœ
žœ
žœ
žœžœžœžœžœ7žœ
žœ
žœ
žœ
žœ
žœžœžœžœžœ
žœžœ
žœžœTžœžœ	žœ8žœ8žœ
žœŸœžœ
žœ
žœ
žœžœžœ
žœžœ
žœ
žœSœžœ
žœžœžœ
žœ
žœžœ0žœžœ	žœDžœ2žœžœžœ7Ÿœžœžœžœžœ
žœ
žœ
Dœ
žœžœžœžœ
žœžœ%%œžœžœ
žœžœœ!'œ)œžœžœ6Ÿœžœ
žœ
žœžœžœ“
Ÿœžœ
žœ
žœžœ^‚
œŸœFœ=œžœžœ
žœžœ
žœ4žœžœžœžœ	Sœ	žœžœžœžœYžœžœ
žœ	žœžœ	žœ
žœžœ
žœžœ!žœžœ=žœžœ
*œžœžœžœ	Qœ/žœCžœžœ
*œžœRžœ 	œ"žœ
žœžœ
žœ"žœžœžœXžœ
žœžœ
žœ
žœžœžœ.žœ œ(žœ) œ"žœ
žœžœ
žœ#žœžœEžœžœ
žœžœžœ
žœ
žœ
žœ~œ
Ÿ
œžœžœžœVœ	žœžœžœžœ
žœžœ
žœ9œžœžœžœžœžœžœžœžœžœ
žœžœžœžœ žœžœ
žœ%žœžœ
žœ(žœžœžœžœ
žœž
Cœžœžœžœ\žœžœžœžœžœ
žœ#žœ	žœ4žœ2žœžœ	žœ"žœžœžœžœ(žœžœ
žœ>žœ
žœ
žœžœ$žœ&žœŸœžœžœžœžœžœžœžœ
žœ
žœžœžœžœ
žœžœžœ
žœžœžœ4Ÿœžœžœžœžœžœžœ
žœ
žœžœžœ
žœ.žœžœ
žœžœžœ
žœ
žœ&Ÿ
œžœžœžœ5œžœ
žœžœ
žœžœ
žœ	žœ
žœ)žœžœ
žœ#žœ:Ÿœžœ	žœžœ5œžœ
žœžœ
žœžœ
žœ	žœ
žœ(žœžœ
žœžœ#Ÿœžœžœ;vœõžœĄžœÕ
˜Œ|—…—^TiQ