<> <> <> <> <> <> <> <> DIRECTORY Atom USING [GetPName, MakeAtom], Buttons USING [ButtonProc], FS USING [Error], Commander USING[ CommandObject, CommandProc, Register ], CommandTool, Containers USING [ChildXBound], DB, Icons, IO, Menus USING [AppendMenuEntry, CreateMenu, Menu, MenuProc, CreateEntry], MessageWindow USING [Append, Confirm], Nut USING [Display, Edit, Query, PushDefaults], SquirrelTool, SquirrelDump USING [DumpToFile, LoadFromFile], NutOps USING [SetUpSegment], NutViewer, Process, Rope, UserCredentials USING[Get], UserProfile USING[Token], ViewerEvents, ViewerOps, ViewerTools USING [GetContents, SetContents, SetSelection], ViewerClasses; SquirrelToolImpl: CEDAR MONITOR IMPORTS Atom, FS, Containers, DB, Icons, IO, MessageWindow, Menus, Nut, SquirrelDump, NutOps, NutViewer, Process, Rope, UserCredentials, UserProfile, Commander, ViewerEvents, ViewerOps, ViewerTools EXPORTS SquirrelTool SHARES ViewerClasses = BEGIN OPEN IO; Viewer: TYPE = ViewerClasses.Viewer; ROPE: TYPE = Rope.ROPE; <<***********************************************>> <> <<***********************************************>> createSquirrelWindow: BOOL _ FALSE; openSquirrel: BOOL _ FALSE; squirrelSegment: PUBLIC ROPE; -- the name of any $Squirrel segment opened segmentName: ROPE; -- the name of the last segment opened with the Tool fileName: ROPE; -- the name of the last file opened with the Tool defaultPrefix: ROPE _ Rope.Cat["[Luther.Alpine]<", UserCredentials.Get[].name, ">"]; Initialize: PROCEDURE = TRUSTED { DB.Initialize[ nCachePages: 512]; stopped _ FALSE; IF squirrelIcon = tool THEN squirrelIcon _ Icons.NewIconFromFile["Nut.icons", 0 ! FS.Error => {CONTINUE}]; }; SquirrelProc: Commander.CommandProc = BEGIN segName: ROPE; r: ROPE; ch: CHAR; h: IO.STREAM _ IO.RIS[ cmd.commandLine ]; IF (r _ h.GetTokenRope[ ! IO.EndOfStream => {r _ NIL; CONTINUE}].token) # NIL THEN SELECT ch _ r.Fetch[0] FROM '[ => segName _ Rope.Concat[r, h.GetLineRope[]] ENDCASE => segName _ Rope.Concat[defaultPrefix, r]; SELECT TRUE FROM segName.Length[] # 0 => segmentName _ segName; ENDCASE => { segmentName _ UserProfile.Token["Squirrel.Segment", ""]; fileName _ UserProfile.Token["Squirrel.File", ""]; }; BuildSquirrel[]; IF segName # NIL THEN MyOpenProc[squirrel] -- user specified it, open it up END; <<***********************************************>> <> <<***********************************************>> squirrelIcon: Icons.IconFlavor _ tool; tsIn, tsOut: IO.STREAM _ NIL; segmentText: Viewer; -- the text argument for Segment fileText: Viewer; -- the text argument for File domainText: Viewer; -- the text argument for Domain nameText: Viewer; -- the text argument for Name StartUpMessage: ROPE _ "Squirrel 5.2 Release"; stopped: PUBLIC BOOLEAN _ FALSE; squirrel: PUBLIC Viewer; squirrelOut: PUBLIC IO.STREAM; BuildSquirrel: PROC = { <> v: Viewer; typeScript: Viewer; info: ViewerClasses.ViewerRec = [name: "Squirrel", iconic: TRUE, column: right, scrollable: FALSE, menu: squirrelMenu, icon: squirrelIcon]; IF squirrelIcon = tool THEN squirrelIcon _ Icons.NewIconFromFile["Nut.icons", 0 ! FS.Error => {CONTINUE}]; IF squirrel = NIL OR squirrel.destroyed THEN { squirrel _ ViewerOps.CreateViewer[flavor: $Container, info: info]; v _ BuildSquirrelArea[squirrel]; v _ NutViewer.MakeRuler[sib: v]; typeScript _ NutViewer.MakeTypescript[sib: v]; squirrelOut _ tsOut _ NutViewer.GetTypescript[squirrel]; ViewerOps.PaintViewer[squirrel, all]; squirrelEventReg_ ViewerEvents.RegisterEventProc[proc: QuitProc, event: destroy, filter: squirrel]; Message[StartUpMessage]; }; ViewerTools.SetContents[segmentText, segmentName]; ViewerTools.SetContents[fileText, fileName]; ViewerTools.SetContents[domainText, "Domain"]; ViewerTools.SetContents[nameText, "Domain"] }; BuildSquirrelArea: PROC [squirrel: Viewer] RETURNS [Viewer] = { tLabel: Viewer_ NutViewer.Initialize[squirrel]; tLabel _ NutViewer.MakeButton[ q: NIL, name: "Segment: ", proc: SegmentNameProc, border: FALSE, sib: tLabel]; segmentText _ NutViewer.NextRightTextViewer[sib: tLabel, w: squirrel.cw - tLabel.ww]; Containers.ChildXBound[segmentText.parent, segmentText]; tLabel _ NutViewer.MakeButton[ q: NIL, name: "File: ", proc: FileNameProc, border: FALSE, sib: tLabel, newLine: TRUE]; fileText _ NutViewer.NextRightTextViewer[sib: tLabel, w: squirrel.cw - tLabel.ww]; Containers.ChildXBound[fileText.parent, fileText]; tLabel _ NutViewer.MakeButton[ q: NIL, name: "Domain:", proc: DomainNameProc, border: FALSE, sib: tLabel, newLine: TRUE]; domainText _ NutViewer.NextRightTextViewer[sib: tLabel, w: squirrel.cw - tLabel.ww]; Containers.ChildXBound[domainText.parent, domainText]; tLabel _ NutViewer.MakeButton[q: NIL, name: "Name:", proc: NameNameProc, border: FALSE, sib: tLabel, newLine: TRUE]; nameText _ NutViewer.NextRightTextViewer[sib: tLabel, w: squirrel.cw - tLabel.ww]; Containers.ChildXBound[nameText.parent, nameText]; RETURN [nameText] }; DomainNameProc: Buttons.ButtonProc = { ViewerTools.SetSelection[domainText, NIL]}; NameNameProc: Buttons.ButtonProc = { ViewerTools.SetSelection[nameText, NIL]}; SegmentNameProc: Buttons.ButtonProc = { ViewerTools.SetSelection[segmentText, NIL]}; FileNameProc: Buttons.ButtonProc = { ViewerTools.SetSelection[fileText, NIL]}; DisplayerProc: Buttons.ButtonProc = { <> physicalSegName: ROPE _ ViewerTools.GetContents[fileText]; domName: ROPE _ ViewerTools.GetContents[domainText]; entName: ROPE _ ViewerTools.GetContents[nameText]; seg: DB.Segment_ GetSegment[]; []_ NutOps.SetUpSegment[physicalSegName, seg]; DisplayEntity[domName, entName, seg]}; EditorProc: Buttons.ButtonProc = { <> physicalSegName: ROPE _ ViewerTools.GetContents[fileText]; domName: ROPE _ ViewerTools.GetContents[domainText]; entName: ROPE _ ViewerTools.GetContents[nameText]; seg: DB.Segment_ GetSegment[]; []_ NutOps.SetUpSegment[physicalSegName, seg]; EditEntity[domName, entName, seg]; }; QueryerProc: Buttons.ButtonProc = { domName: ROPE _ ViewerTools.GetContents[domainText]; entName: ROPE _ ViewerTools.GetContents[nameText]; <> IF domName.Equal["Domain"] THEN domName _ entName; IF domName.Length[]=0 THEN {Message["No domain specified!"]; RETURN}; QueryDomain[entName, domName, GetSegment[]] }; EraseDomains: PROC [dl: LIST OF DB.Domain] = { <> al: LIST OF DB.Attribute; FOR dlT: LIST OF DB.Domain _ dl, dlT.rest WHILE NOT (dlT = NIL) DO <> IF (al _ DB.VL2EL[DB.GetPList[dlT.first, DB.aTypeOf]]) # NIL THEN {Message["Erasing Relations referencing ", DB.GetName[dlT.first], ":"]; EraseAttributesRelations[al]}; Message["Erasing Domain ", DB.GetName[dlT.first], ". . ."]; DB.DestroyDomain[dlT.first] ENDLOOP; }; EraseRelations: PROC [rl: LIST OF DB.Relation] = { <> 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] = { <> OPEN DB; FOR alT: LIST OF Attribute _ al, alT.rest WHILE NOT (alT = NIL) DO IF NOT DB.Null[alT.first] THEN {r: DB.Relation _ V2E[GetP[alT.first, aRelationIs]]; Message["Erasing Relation ", DB.GetName[r], ". . ."]; DB.DestroyRelation[r]} ENDLOOP; }; GetSegment: PROC RETURNS [ATOM] = BEGIN segName: ROPE _ ViewerTools.GetContents[segmentText]; fileName: ROPE _ ViewerTools.GetContents[fileText]; IF Rope.Equal[segName, NIL] THEN -- user has not specified a segment to use, so extract it from the file RETURN[ AtomFromSegment[fileName] ] ELSE -- user has specified a segment RETURN[Atom.MakeAtom[segName]]; END; AtomFromSegment: PROC[ segR: ROPE ] RETURNS[ ATOM ] = { end: INT; begin: INT_ Rope.Find[segR, ">"]; IF begin < 0 THEN begin_ Rope.Find[segR, "]" ] -- local file ELSE UNTIL (end_ Rope.Find[segR, ">", begin+1])=-1 DO begin_ end ENDLOOP; -- last one! end_ Rope.Find[segR, ".", MAX[begin, 0] ]; IF end < 0 THEN end_ segR.Length[]; begin _ MAX[ begin+1, 0 ]; RETURN[Atom.MakeAtom[Rope.Substr[ segR, begin, (end-1)-begin+1]]] }; <<***********************************************>> <> <<***********************************************>> 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]; }; <<***********************************************>> <> <<***********************************************>> MySaveProc: Menus.MenuProc = { MessageRope["Saving ... "]; -- sometimes takes a while, so tell him before DB.MarkTransaction[DB.TransactionOf[GetSegment[]]]; Message[Atom.GetPName[GetSegment[]], " transaction committed."] }; MyResetProc: Menus.MenuProc = { s: DB.Segment = GetSegment[]; fileName: ROPE = ViewerTools.GetContents[fileText]; DB.AbortTransaction[DB.TransactionOf[s]]; Message[Atom.GetPName[s], " transaction aborted."]; DB.OpenTransaction[ s ]; Message[Atom.GetPName[s], " transaction opened."] }; MyCloseProc: Menus.MenuProc = { s: DB.Segment = GetSegment[]; fileName: ROPE = ViewerTools.GetContents[fileText]; DB.CloseTransaction[DB.TransactionOf[s]]; Message[Atom.GetPName[s], " segment has been closed"] }; MyOpenProc: Menus.MenuProc = { ENABLE DB.Error, DB.Aborted, DB.Failure => {Message["Can't open transaction on ", ViewerTools.GetContents[fileText], "!"]; CONTINUE}; s: DB.Segment = GetSegment[]; fileName: ROPE _ ViewerTools.GetContents[fileText]; oldName: ROPE = DB.GetSegmentInfo[s].filePath; open: BOOL = DB.TransactionOf[s] # NIL; switch: CHAR; sameFile, readOnly: BOOL; [fileName, switch] _ ExtractSwitch[fileName]; readOnly _ switch='r OR switch='R; <> IF Rope.Fetch[fileName, 0] # '[ THEN fileName _ Rope.Concat[defaultPrefix, fileName]; IF Rope.Find[fileName, ".segment"] = -1 THEN fileName _ Rope.Concat[fileName, ".segment"]; sameFile _ Rope.Equal[fileName, oldName]; IF NOT sameFile AND open THEN { Message[oldName, " must be closed first!"]; RETURN }; IF sameFile AND open THEN { Message[oldName, " already open!"]; RETURN }; <> readOnly _ NutOps.SetUpSegment[segmentFile: fileName, seg: s, makeReadOnly: readOnly]; Message[ fileName, " has been opened", IF readOnly THEN ", read-only" ELSE ""] }; DebugProc: Menus.MenuProc = BEGIN Nut.PushDefaults[domain: ViewerTools.GetContents[domainText], segment: GetSegment[]]; END; EraseAllProc: Menus.MenuProc = { ENABLE DB.Error, DB.Aborted, DB.Failure => {Message["Can't open transaction on segment"]; CONTINUE}; s: DB.Segment = GetSegment[]; fileName: ROPE = ViewerTools.GetContents[fileText]; IF NutOps.SetUpSegment[fileName, s] THEN {Message["Can't open file for updates"]; RETURN}; -- file was readonly DB.EraseSegment[s]; DB.OpenTransaction[s]; Message[fileName, " has been erased and re-initialized"] }; ListSegsProc: Menus.MenuProc = { segs: LIST OF DB.Segment = DB.GetSegments[]; trans: DB.Transaction; filePath: ROPE; readOnly: BOOL; IF segs=NIL THEN { Message["No declared segments"]; RETURN}; MessageRope["\nDeclared segments:"]; FOR s1: LIST OF DB.Segment_ segs, s1.rest UNTIL s1=NIL DO MessageRope["\n "]; MessageRope[Atom.GetPName[s1.first]]; [filePath,, trans, readOnly]_ DB.GetSegmentInfo[s1.first]; MessageRope[ Rope.Cat[": ", filePath] ]; IF trans#NIL THEN IF readOnly THEN MessageRope[" (Open read-only)"] ELSE MessageRope[" (Open)"]; ENDLOOP; Message[""]; }; MyEraseProc: Menus.MenuProc = { domain: ROPE = ViewerTools.GetContents[domainText]; IF domain.Equal["Domain", FALSE] THEN MyDomainEraseProc[] ELSE IF domain.Equal["Relation", FALSE] THEN MyRelationEraseProc[] ELSE { ENABLE DB.Error => {Message["Can't find entity!"]; CONTINUE}; entityToDelete: ROPE = ViewerTools.GetContents[nameText]; DB.DestroyEntity[DB.FetchEntity[ DB.DeclareDomain[domain, GetSegment[], OldOnly], entityToDelete]]; Message[entityToDelete, " erased."]}; }; MyDomainEraseProc: PROC = { domainsToDelete: ROPE = ViewerTools.GetContents[nameText]; stopped_ FALSE; EraseDomains[NameListToEntityList [RopeToNameList[domainsToDelete], DB.DomainDomain, GetSegment[]]]; Message["Do Save to commit deletions."] }; MyRelationEraseProc: PROC = { relationsToDelete: ROPE = ViewerTools.GetContents[nameText]; stopped_ FALSE; EraseRelations[NameListToEntityList [RopeToNameList[relationsToDelete], DB.RelationDomain, GetSegment[]]]; Message["Do Save to commit deletions."] }; MyDumpProc: Menus.MenuProc = { segment: ROPE = Atom.GetPName[ GetSegment[] ]; stopped _ FALSE; DumpData[segment]; }; MyStopProc: Menus.MenuProc = { stopped _ TRUE }; squirrelEventReg: ViewerEvents.EventRegistration_ NIL; QuitProc: ViewerEvents.EventProc = { IF squirrelEventReg = NIL THEN RETURN[FALSE]; TRUSTED {Process.Detach[ FORK DoQuit[] ]}; RETURN[TRUE] }; DoQuit: PROC = { s: DB.Segment = GetSegment[]; fileName: ROPE = ViewerTools.GetContents[fileText]; trans: DB.Transaction = DB.TransactionOf[s]; ViewerEvents.UnRegisterEventProc[squirrelEventReg, destroy]; squirrelEventReg_ NIL; IF trans # NIL THEN { IF MessageWindow.Confirm[prompt: Rope.Cat["Close ", fileName, " first?"]] THEN { DB.CloseTransaction[trans] } }; ViewerOps.DestroyViewer[squirrel]; squirrel _ NIL; squirrelOut _ IO.noWhereStream }; MyLoadProc: Menus.MenuProc = { segment: DB.Segment = GetSegment[]; segmentName: ROPE = IF segment # NIL THEN Atom.GetPName[segment] ELSE NIL; IF segment = NIL THEN RETURN; stopped _ FALSE; SetPriority[]; SquirrelDump.LoadFromFile[dumpFile: Rope.Concat[ segmentName, ".dump" ], segment: segment, DBFile: ViewerTools.GetContents[fileText]]; }; <<***********************************************>> <> <<***********************************************>> WhiteSpace: IO.BreakProc = { RETURN[ IF char = IO.SP OR char = IO.CR THEN IO.CharClass[break] ELSE IO.CharClass[other] ] }; DumpData: PROCEDURE[command: ROPE] = <> BEGIN token: ROPE; fileName: ROPE; dl: LIST OF DB.Domain; rl: LIST OF DB.Relation; file: BOOLEAN _ TRUE; domains: BOOLEAN _ TRUE; complement: BOOLEAN _ FALSE; entityCentric: BOOLEAN _ FALSE; stream: IO.STREAM _ IO.RIS[command]; segName: ROPE = stream.GetTokenRope[].token; seg: DB.Segment = Atom.MakeAtom[segName]; IF DB.TransactionOf[seg]=NIL THEN {Message["Segment not open!"]; RETURN}; SetPriority[]; BEGIN IF command.Find["_"] = -1 THEN { file _ FALSE; fileName _ Rope.Cat[segName, ".dump"] }; WHILE ~stream.EndOf[] DO [] _ stream.SkipWhitespace[]; token _ stream.GetTokenRope[WhiteSpace ! IO.EndOfStream => {token _ NIL; CONTINUE}].token; IF file THEN {fileName _ token; file _ FALSE; LOOP}; IF token = NIL THEN EXIT; SELECT TRUE FROM token.Equal["Domain", FALSE] => NULL; token.Equal["Relation", FALSE] => NULL; token.Equal["Domains:", FALSE] => domains _ TRUE; token.Equal["Relations:", FALSE] => domains _ FALSE; token.Equal["~"] => complement _ TRUE; token.Equal["_"] => NULL; token.Equal["!"] => entityCentric_ TRUE; ENDCASE => IF domains THEN { domain: DB.Domain = DB.DeclareDomain[token, seg, OldOnly]; IF domain=NIL THEN GO TO NotFound ELSE dl _ CONS[domain, dl] } ELSE { relation: DB.Relation = DB.DeclareRelation[token, seg, OldOnly]; IF relation=NIL THEN GO TO NotFound ELSE rl _ CONS[relation, rl] }; ENDLOOP; IF dl = NIL AND rl = NIL THEN complement _ TRUE; SquirrelDump.DumpToFile[segName, fileName, dl, rl, complement, entityCentric]; EXITS NotFound => IF domains THEN Message[token, " not a domain. Dump aborted."] ELSE Message[token, " not a relation. Dump aborted."]; END END; NameListToEntityList: PROC [nl: LIST OF ROPE, d: DB.Domain, seg: DB.Segment] RETURNS [el: LIST OF DB.Entity] = { <> 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] = { <> 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] = <> {NutViewer.Message[squirrel, msg1, msg2, msg3, msg4]}; MessageRope: PUBLIC SAFE PROC [msg: ROPE] = { IF squirrel=NIL THEN MessageWindow.Append[msg] ELSE tsOut.PutRope[msg]; }; <<***********************************************>> <> <<***********************************************>> ShowEntityProc: Commander.CommandProc = <> <> BEGIN ENABLE IO.EndOfStream => {Message[ "Illegal command syntax: expect DBDisplay [Segment:] [Domain:] Entity"]; CONTINUE}; h: IO.STREAM = IO.RIS[cmd.commandLine]; segName, domName, entName: ROPE; segName _ h.GetTokenRope[].token; IF h.PeekChar[]#': THEN { <> d: DB.Domain; ds: DB.EntitySet_ DB.DomainSubset[d: DB.DomainDomain, searchSegment: $Squirrel]; entName_ Rope.Cat[segName, h.GetLineRope[]]; UNTIL DB.Null[d_ DB.NextEntity[ds]] DO IF DB.FetchEntity[d, entName]#NIL THEN {DisplayEntity[DB.NameOf[d], entName, $Squirrel]; RETURN}; ENDLOOP; Message[entName, " not found in any domain!"]; RETURN }; domName_ h.GetTokenRope[].token; IF h.PeekChar[]#': THEN { <> entName_ Rope.Cat[domName, h.GetLineRope[]]; domName_ segName; segName_ "Squirrel" } ELSE { [] _ h.GetChar[]; []_ h.SkipWhitespace[]; -- Skip over the ":" and following blanks entName _ h.GetLineRope[] }; DisplayEntity[domName, entName, Atom.MakeAtom[segName]]; END; OpenProc: Commander.CommandProc = { ENABLE BEGIN DB.Error, DB.Aborted, DB.Failure => {cmd.err.Put[IO.rope["Can't Open Database!"]]; CONTINUE}; IO.EndOfStream => {cmd.err.Put[IO.rope["Illegal command syntax: expect DBOpen Filename SegmentAtom"]]; CONTINUE}; END; h: IO.STREAM _ IO.RIS[cmd.commandLine]; fileName: ROPE = h.GetTokenRope[IO.IDProc].token; segmentName: ROPE = h.GetTokenRope[IO.IDProc].token; s: DB.Segment = Atom.MakeAtom[segmentName]; []_ NutOps.SetUpSegment[fileName, s] }; EraseProc: Commander.CommandProc = { ENABLE BEGIN DB.Error, DB.Aborted, DB.Failure => {cmd.err.Put[IO.rope["Can't Open Database!"]]; CONTINUE}; IO.EndOfStream => {cmd.err.Put[IO.rope["Illegal command syntax: expect DBErase Filename SegmentAtom"]]; CONTINUE}; END; h: IO.STREAM _ IO.RIS[cmd.commandLine]; fileName: ROPE = h.GetTokenRope[IO.IDProc].token; segmentName: ROPE = h.GetTokenRope[IO.IDProc].token; s: DB.Segment = Atom.MakeAtom[segmentName]; IF NutOps.SetUpSegment[fileName, s] THEN { cmd.err.Put[IO.rope["Can't Write Database!"]]; RETURN }; IF DB.TransactionOf[s]#NIL THEN DB.CloseTransaction[DB.TransactionOf[s]]; DB.EraseSegment[s]; DB.OpenTransaction[s] }; DumpProc: Commander.CommandProc = { stopped _ FALSE; DumpData[cmd.commandLine] }; LoadProc: Commander.CommandProc = { ENABLE BEGIN DB.Error, DB.Aborted, DB.Failure => {cmd.err.Put[IO.rope["Can't Open Database!"]]; CONTINUE}; IO.EndOfStream => {cmd.err.Put[IO.rope["Illegal command syntax: expect DBLoad Filename DBName SegmentAtom"]]; CONTINUE}; END; h: IO.STREAM = IO.RIS[cmd.commandLine]; fileName: ROPE = h.GetTokenRope[].token; DBName: ROPE = h.GetTokenRope[].token; segmentName: ROPE = h.GetTokenRope[IO.IDProc].token; s: DB.Segment = Atom.MakeAtom[segmentName]; SetPriority[]; SquirrelDump.LoadFromFile[ IF fileName = NIL THEN "DB.dump" ELSE fileName, s, IF DBName = NIL THEN segmentName ELSE DBName ] }; <<***********************************************>> <> <<***********************************************>> DisplayEntity: PROC[domain, name: ROPE, segment: DB.Segment] = { <> dom: DB.Domain; ent: DB.Entity; enl: INT; IF NOT IsOpen[segment] THEN RETURN; dom _ DB.DeclareDomain[domain, segment, OldOnly]; IF DB.Null[dom] THEN {Message[domain, " is not a domain."]; RETURN}; enl_ name.Length[]; IF enl#0 AND name.Fetch[enl-1]='* THEN <> BEGIN es: DB.EntitySet_ DB.DomainSubset[dom, name.Substr[0, enl-1], name.Substr[0, enl-1].Cat["\177"], First, TRUE, segment]; count: INT_ 0; UNTIL (ent_ DB.NextEntity[es])=NIL DO count_ count+1; IF count>5 THEN {Message["... more than 5; others not displayed"]; EXIT}; [] _ Nut.Display[eName: DB.NameOf[ent], domain: domain, segment: segment, parent: NIL]; ENDLOOP; IF count=0 THEN Message["No such entity"]; END ELSE BEGIN ent _ DB.FetchEntity[dom, name, segment]; IF DB.Null[ent] THEN {Message[name, " does not exist in domain ", domain]; RETURN}; [] _ Nut.Display[eName: name, domain: domain, segment: segment, parent: NIL]; END; }; IsOpen: PROC[ seg: DB.Segment ] RETURNS[ open: BOOLEAN ] = { open _ FALSE; FOR sl: LIST OF DB.Segment _ DB.GetSegments[], sl.rest UNTIL sl = NIL DO IF sl.first = seg THEN { open _ TRUE; RETURN } ENDLOOP; Message[ Atom.GetPName[seg], " segment not open" ] }; EditEntity: PROC[domain, name: ROPE, segment: DB.Segment] = { <> IF NOT IsOpen[segment] THEN RETURN ELSE { dom: DB.Domain_ DB.DeclareDomain[domain, segment, OldOnly]; IF dom=NIL THEN Message["No such domain."] ELSE [] _ Nut.Edit[eName: name, domain: domain, segment: segment, parent: NIL] } }; QueryDomain: PROC[entity, domain: ROPE, segment: DB.Segment] = { <> IF NOT IsOpen[segment] THEN RETURN ELSE { dom: DB.Domain = DB.DeclareDomain[domain, segment]; IF DB.Null[dom] THEN Message["No such domain."] ELSE [] _ Nut.Query[eName: entity, domain: domain, segment: segment] } }; ExtractSwitch: PROC[old: ROPE] RETURNS [new: ROPE, switch: CHAR] = <> 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] }; <<***********************************************>> <> <<***********************************************>> BuildSquirrelMenu[]; Commander.Register[ "Squirrel", SquirrelProc, "Database application tool"]; Commander.Register[ "DBDisplay", ShowEntityProc, "Displays a database entity"]; Commander.Register[ "DBDump", DumpProc, "segment [file _ ] [~] [!] [[Domains: ] aaa bbb] [Relations: rrr sss]"]; Commander.Register[ "DBLoad", LoadProc, "Loads given dump file (Squirrel.dump default) into given segment"]; Commander.Register[ "DBEraseSegment", EraseProc, "Erases a database segment"]; Commander.Register[ "DBOpen", OpenProc, "Open a database segment file"]; Initialize[]; END. CHANGE LOG: Butler, June 26, 1984: Made many changes to comply with new organization of Squirrel Butler, July 3, 1984: Added "File:" Button to squirrelTool. This distinguishes between the physical segment (File) and the logical segment (Segment).