-- File: NutDefaultImpl.mesa -- Contents: Implementation of the Default Create, Display, Edit, and Query windows. -- Last edited by: -- Willie-Sue on: January 21, 1983 8:57 am -- Cattell on: January 13, 1984 6:12 pm: removed Finch stuff -- Donahue on: July 29, 1983 2:41 pm -- Butler on: June 27, 1984 4:08:39 pm PDT -- Table of contents [use find command to locate]: -- Default Editor *** -- Default Displayer *** -- Default Queryer *** DIRECTORY Atom USING [GetPropFromList, GetPName], Buttons, DB, DBIcons USING [GetIcon], DefaultNutUtilities, EntityEditor, Icons USING [IconFlavor, NewIconFromFile], IO, Menus USING [AppendMenuEntry, CreateMenu, Menu, MenuProc], NoteEditor, Nut, NutOps, NutViewer, Rope, SafeStorage USING [NarrowRefFault], TiogaOps USING [InsertRope], TuplesEditor, TypeScript, ViewerIO, ViewerOps, ViewerClasses, ViewerTools, VTables; NutDefaultImpl: CEDAR PROGRAM IMPORTS Atom, DB, DBIcons, DefaultNutUtilities, IO, Nut, NutOps, NutViewer, EntityEditor, Icons, Menus, NoteEditor, Rope, SafeStorage, TiogaOps, TuplesEditor, TypeScript, ViewerIO, ViewerOps, ViewerTools, VTables = BEGIN OPEN DB, NutViewer, ViewerClasses, VTables; Viewer: TYPE = ViewerClasses.Viewer; -- Default Editor ************************************************************ editorMenu: Menus.Menu _ Menus.CreateMenu[]; MyToolViewer: Rope.ROPE _ "ToolViewer"; MyTextViewer: Rope.ROPE _ "TextViewer"; <<-- from whiteboard, may be removable??>> ToolInfo: TYPE = RECORD[ tool: ATOM, icon: ATOM _ NIL, commandLine: ROPE ]; -- this procedure will return either the entity or the entity name for the viewer if the -- segment in which the entity would live is not currently open -- the name returned may be NIL if none of the heuristics work or no $Squirrel segment -- is open ConvertViewerToEntity: PROC [v: Viewer, create: BOOL _ TRUE, instructions: DB.Attribute _ NIL] RETURNS[e: Entity, name: ROPE] = BEGIN name _ NARROW[ViewerOps.FetchProp[v, $Entity]]; IF name # NIL THEN { e _ NutOps.NameToEntity[name]; RETURN }; IF e # NIL THEN RETURN; -- make a guess at the entity type { squirrelName: ROPE = DB.GetSegmentInfo[$Squirrel].filePath; IF squirrelName = NIL THEN RETURN; -- if there is a ToolInfo record, then it must be a toolviewer {toolInfo: REF ToolInfo = NARROW[ViewerOps.FetchProp[v, $ToolInfo]]; IF toolInfo # NIL THEN {toolDomain: Domain; toolDomain _ DeclareDomain[MyToolViewer, $Squirrel ! DB.Error => {toolDomain _ NIL; CONTINUE} ]; IF toolDomain # NIL THEN { name _ NutOps.MakeName[$Squirrel, toolDomain, Atom.GetPName[toolInfo.tool]]; e _ DeclareEntity[toolDomain, v.name, IF create THEN NewOrOld ELSE OldOnly]; IF e # NIL AND Rope.Equal[V2S[GetP[e, instructions]], ""] THEN [] _ SetP[e, instructions, S2V[toolInfo.commandLine]] }; RETURN } }; IF v.icon = document OR v.icon = dirtyDocument THEN { textDomain: Domain; textDomain _ DeclareDomain[MyTextViewer, $Squirrel ! DB.Error => {textDomain _ NIL; CONTINUE}]; IF textDomain # NIL THEN { name _ NutOps.MakeName[$Squirrel, textDomain, v.name]; e _ DeclareEntity[textDomain, v.name, IF create THEN NewOrOld ELSE OldOnly] } } } END; ResetProc: Menus.MenuProc = BEGIN -- Resets contents of editor to its statebefore edits started. viewer: Viewer = NARROW[parent]; seg: Segment; d: Domain; eName: ROPE; [seg, d, eName]_ NutViewer.GetNutInfo[viewer]; DefaultNutUtilities.Reset[eName: eName, d: d, seg: seg, parent: viewer]; END; SaveProc: Menus.MenuProc = BEGIN -- Invoked when hit the "Save" button on an editor: makes edits and then turns into displayer. viewer: Viewer = NARROW[parent]; newV: Viewer; seg: Segment; d: Domain; eName: ROPE; e: Entity; [seg, d, eName]_ NutViewer.GetNutInfo[viewer]; e _ DB.DeclareEntity[d, eName, NewOrOld ]; TRUSTED BEGIN table: VTable = viewer.child; tuplesRow: VTable = GetTableEntry[ table: table, row: 1 ]; entityRow: VTable = GetTableEntry[ table: table, row: 2 ]; noteRow: VTable = GetTableEntry[ table: table, row: 3 ]; errors: BOOL_ TuplesEditor.SaveTuples[viewer: tuplesRow, newEntity: e].errors; EntityEditor.SaveEntities[viewer: entityRow, newOf: e]; NoteEditor.SaveNote[newEntity: e, viewer: noteRow, update: TRUE]; -- Replace editor with displayer iff there were no error messages IF errors THEN NutViewer.Message[viewer, "You may correct any errors and save again."] ELSE BEGIN newV _ NutViewer.ReplaceViewer[e: e, eName: eName, d: d, seg: seg, parent: viewer]; Nut.Display[e: e, eName: eName, d: d, seg: seg, newV: newV]; END; END; END; MergeProc: Menus.MenuProc = BEGIN -- Invoked when hit the "Merge" button. Is supposed to copy all of the relationships connected -- with this entity to the entity in the same domain with the selected name, then delete the -- existing entity if any. viewer: Viewer = NARROW[parent]; seg: Segment; d: Domain; eName: ROPE; e: Entity; otherEntity: Entity; otherName: ROPE = ViewerTools.GetSelectionContents[]; [seg, d, eName]_ NutViewer.GetNutInfo[viewer]; otherEntity_ IF otherName=NIL THEN NIL ELSE DB.FetchEntity[d, otherName, seg]; e_ DB.FetchEntity[d, eName, seg ! DB.Error => { e _ NIL; CONTINUE } ]; IF e = NIL THEN Message[viewer, "This entity does not exist yet!"] ELSE IF otherName=NIL THEN Message[viewer, "Please select name for entity to merge with!"] ELSE IF otherEntity=NIL THEN Message[viewer, "Selected entity not found in this domain!"] ELSE TRUSTED BEGIN table: VTable = viewer.child; newV: Viewer; tuplesRow: VTable = GetTableEntry[ table: table, row: 1 ]; entityRow: VTable = GetTableEntry[ table: table, row: 2 ]; noteRow: VTable = GetTableEntry[ table: table, row: 3 ]; NutViewer.Message[ viewer, "Copying ", eName, " to ", Rope.Concat[otherName, ", and deleting it..."]]; []_ TuplesEditor.SaveTuples[viewer: tuplesRow, newEntity: otherEntity]; EntityEditor.SaveEntities[viewer: entityRow, newOf: otherEntity]; NoteEditor.SaveNote[newEntity: otherEntity, viewer: noteRow, update: TRUE]; DB.DestroyEntity[e]; -- Get rid of old entity, its relationships have been moved newV _ NutViewer.ReplaceViewer[e: otherEntity, eName: eName, d: d, seg: seg, parent: viewer]; Nut.Display[e: otherEntity, eName: eName, d: d, seg: seg, newV: newV]; END; END; RenameProc: Menus.MenuProc = { ENABLE DB.Error => IF code=NonUniqueEntityName THEN {NutViewer.Message[NARROW[parent], "Entity already exists with that name!"]; CONTINUE}; viewer: Viewer = NARROW[parent]; seg: Segment; d: Domain; eName: ROPE; e: Entity; newName: ROPE = ViewerTools.GetSelectionContents[]; [seg, d, eName]_ NutViewer.GetNutInfo[viewer]; e_ DB.FetchEntity[d, eName, seg ]; IF e = NIL THEN Message[viewer, "Entity does not exist yet!"] ELSE IF newName=NIL THEN Message[viewer, "Please select new name for entity first!"] ELSE { DB.ChangeName[e, newName]; ViewerOps.AddProp[viewer, $EntityName, newName]; viewer.name_ Rope.Cat[NutOps.SafeNameOf[d],": ", newName]; ViewerOps.PaintViewer[viewer, caption] }; }; EraseAllProc: Menus.MenuProc = { viewer: Viewer = NARROW[parent]; seg: Segment; d: Domain; eName: ROPE; e: Entity; [seg, d, eName]_ NutViewer.GetNutInfo[viewer]; e_ DB.FetchEntity[d, eName, seg ! DB.Error => { e _ NIL; CONTINUE } ]; IF e = NIL THEN RETURN; -- Print message in Squirrel window since this one won't be there ... NutViewer.Message[NutViewer.squirrel, eName, " and all associated relationships erased."]; DB.DestroyEntity[e]; ViewerOps.DestroyViewer[viewer]; }; AddProc: Menus.MenuProc = TRUSTED { viewer: Viewer = NARROW[parent]; entityRow: VTable = GetTableEntry[ table: viewer.child, row: 2 ]; selected: Viewer = ViewerTools.GetSelectedViewer[]; entity: Entity; IF selected=NIL THEN {NutViewer.Error[viewer, "No viewer selected!"]; RETURN}; entity_ ConvertViewerToEntity[ParentOf[selected]].e; EntityEditor.NewEntry[ entity, entityRow ]; Install[ viewer.child, TRUE ] }; ---------------------------- ParentOf: PROC[ v: Viewer ] RETURNS[ parent: Viewer ] = { parent _ v; WHILE parent.parent # NIL DO parent _ parent.parent ENDLOOP }; DefaultEdit: PUBLIC Nut.ProcType = TRUSTED BEGIN tsOut: IO.STREAM; al: LIST OF Attribute = NutOps.GetRefAttributes[d]; -- need to xreate a viewer table: VTables.VTable; tsV: Viewer; e: DB.Entity; table _ VTables.Create[ parent: newV, rows: 4 ]; tsV _ TypeScript.Create[info: [parent: table, ww: newV.cw, wh: 32], paint: FALSE]; e _ DeclareEntity[d, eName, OldOnly]; IF seg = NIL THEN seg _ NutOps.SafeSegmentOf[d]; ViewerOps.SetMenu[newV, editorMenu]; VTables.SetTableEntry[ table: table, row: 0, flavor: $Viewer, clientData: tsV, border: [FALSE, TRUE, FALSE, FALSE] ]; VTables.SetTableEntry[ table: table, row: 1, flavor: $Viewer, clientData: TuplesEditor.DisplayTuples[e: e, attrList: al, parent: table], border: NullBorder ]; VTables.SetTableEntry[ table: table, row: 2, flavor: $Viewer, clientData: EntityEditor.DisplayEntities[of: e, parent: table, in: seg], border: NullBorder ]; VTables.SetTableEntry[ table: table, row: 3, flavor: $Viewer, clientData: NoteEditor.DisplayNote[entity: e, parent: table, segment: seg], border: NullBorder ]; tsOut_ ViewerIO.CreateViewerStreams[NIL, tsV].out; ViewerOps.AddProp[ newV, $Typescript, tsOut ]; ViewerOps.AddProp[ newV, $Implementor, $Squirrel ]; VTables.Install[ table, FALSE ]; ViewerOps.PaintViewer[newV, client]; END; -- Default Displayer ************************************************************ displayerMenu: Menus.Menu _ Menus.CreateMenu[]; DefaultDisplay: PUBLIC Nut.ProcType = TRUSTED BEGIN table: VTables.VTable; lastViewer: Viewer; endOfTupleSubwindow: INTEGER; e: DB.Entity _ DB.FetchEntity[d, eName, seg]; dName: ROPE = NutOps.SafeNameOf[d]; ViewerOps.SetMenu[newV, displayerMenu]; lastViewer_ BuildTupleWindowButtons[e, seg, newV]; IF lastViewer=NIL THEN -- Empty tuple subwindow, start immediately with related entities endOfTupleSubwindow_ 0 ELSE -- Create another zero-size button on next line just to get right y position to start at ... endOfTupleSubwindow_ NutViewer.MakeButton[ q: NutViewer.DBQueue[], name: NIL, proc: NIL, sib: lastViewer, width: 0, newLine: TRUE].wy; table_ VTables.Create[ parent: newV, rows: 2, y: endOfTupleSubwindow]; VTables.SetTableEntry[ table: table, row: 0, flavor: $Viewer, clientData: EntityEditor.DisplayEntities[of: e, parent: table, in: seg, noEdits: TRUE], border: NullBorder ]; VTables.SetTableEntry[ table: table, row: 1, flavor: $Viewer, clientData: NoteEditor.DisplayNote[entity: e, parent: table, segment: seg, noEdits: TRUE], border: NullBorder ]; VTables.Install[ table, FALSE ]; ViewerOps.AddProp[ newV, $Implementor, $Squirrel ]; ViewerOps.PaintViewer[newV, client]; END; BuildTupleWindowButtons: PROC[e: Entity, seg: Segment, v: Viewer] RETURNS [Viewer] = BEGIN alT: AttributeList; t: Relship; myRel: Relation; tuples: RelshipSet; lastButton: Viewer; myAttrs: AttributeList; myAttrs_ RemoveSpecialAttributesFrom[DB.GetAllRefAttributes[e], seg]; lastButton_ NutViewer.Initialize[v]; FOR alT_ myAttrs, alT.rest UNTIL alT=NIL DO IF Null[alT.first] THEN LOOP; myRel_ V2E[GetP[alT.first, aRelationIs]]; tuples_ RelationSubset[myRel, LIST[[alT.first, e]]]; IF NutOps.RSetSize[RelationSubset[myRel, LIST[[alT.first, e]]]]#9999 THEN UNTIL Null[t_ NextRelship[tuples]] DO lastButton _ BuildTuplesButtons[v, alT.first, myRel, t, lastButton]; ENDLOOP ELSE BuildMultiTupleButtons[v, alT.first, myRel, tuples]; ReleaseRelshipSet[tuples]; ENDLOOP; RETURN[lastButton] END; BuildMultiTupleButtons: PROC[viewer: Viewer, a: Attribute, r: Relation, ts: RelshipSet] = -- Overflow not yet implemented... {Message[viewer, "Too many ", GetName[r], "s to display"]}; BuildTuplesButtons: PROC[ v: Viewer, a: Attribute, r: Relation, t: Relship, lastButton: Viewer] RETURNS[Viewer] = -- Creates one line of buttons on the screen, for one database tuple BEGIN aValue: ROPE; al: AttributeList_ NutOps.RemoveAttribute[a, DB.VL2EL[DB.GetPList[r, aRelationOf]]]; lastButton_ MakeButton[ q: DBQueue[], name: GetName[r], proc: ProcessSelection, data: r, sib: lastButton, newLine: TRUE]; FOR alT: AttributeList_ al, alT.rest UNTIL alT=NIL DO aValue_ GetFS[t, alT.first]; IF aValue.Length[]>0 THEN -- only print if non-null value lastButton_ MakeButton[ q: DBQueue[], name: Rope.Cat[GetName[alT.first], ": ", aValue], proc: ProcessSelection, sib: lastButton, data: GetF[t, alT.first] ]; ENDLOOP; RETURN[lastButton]; END; RemoveSpecialAttributesFrom: PROC [ old: LIST OF Attribute, seg: Segment] RETURNS[new: LIST OF Attribute] = { -- Removes the "*" and "note" attributes that will be displayed in the later sections ENABLE DB.Error => {IF code=NotFound THEN {new_ old; CONTINUE}}; star: Relation = DeclareRelation["*", seg, OldOnly]; starOf: Attribute = DeclareAttribute[r: star, name: "of", version: OldOnly]; starIs: Attribute = DeclareAttribute[r: star, name: "is", version: OldOnly]; note: Relation = DeclareRelation["note", seg, OldOnly]; noteOf: Attribute = DeclareAttribute[r: note, name: "of", version: OldOnly]; new_ old; IF star # NIL THEN {new_ NutOps.RemoveAttribute[starOf, new]; new_ NutOps.RemoveAttribute[starIs, new]}; IF note # NIL THEN new _ NutOps.RemoveAttribute[noteOf, new]; RETURN[new] }; EditProc: Menus.MenuProc = BEGIN -- Invoked when hit the "Edit" button on the default displayer. -- Should replace the displayer viewer with an editor viewer. viewer: Viewer = NARROW[parent]; seg: DB.Segment; d: DB.Domain; eName: ROPE; [seg, d, eName]_ NutViewer.GetNutInfo[viewer]; DefaultNutUtilities.Edit[ eName: eName, d: d, seg: seg, parent: viewer]; END; PasteNameProc: Menus.MenuProc = { viewer: Viewer = NARROW[parent]; eName: ROPE_ NutViewer.GetNutInfo[viewer].entity; TiogaOps.InsertRope[eName]; }; -- Default Queryer ************************************************************ queryerMenu: Menus.Menu _ Menus.CreateMenu[]; queryerIcon: Icons.IconFlavor_ Icons.NewIconFromFile["[Indigo]Icons>Nut.Icons", 11]; qNumber: INT_ 0; entryHeight: INTEGER = 14; NextQNumber: PROC RETURNS[INT] = { RETURN[qNumber_ qNumber + 1] }; DefaultQuery: PUBLIC Nut.ProcType = BEGIN dName: ROPE = NutOps.SafeNameOf[d]; table: VTables.VTable; al: AttributeList; tsOut: IO.STREAM; tsV: Viewer; e: Entity _ FetchEntity[d, eName, seg]; IF DB.IsSystemEntity[d] THEN {Message[newV, "Query not allowed on system domains!"]; RETURN}; ViewerOps.SetMenu[newV, queryerMenu]; newV.icon_ queryerIcon; al_ DB.GetDomainRefAttributes[d]; table_ VTables.Create[ parent: newV, rows: 2 ]; tsV_ TypeScript.Create[info: [parent: table, ww: newV.cw, wh: 32], paint: FALSE]; VTables.SetTableEntry[ table: table, row: 0, flavor: $Viewer, clientData: tsV, border: [FALSE, TRUE, FALSE, FALSE] ]; VTables.SetTableEntry[ table: table, row: 1, flavor: $Viewer, clientData: TuplesEditor.DisplayTuples[e: NIL, attrList: al, parent: table], border: NullBorder ]; tsOut_ ViewerIO.CreateViewerStreams[NIL, tsV].out; VTables.Install[ table, FALSE ]; ViewerOps.AddProp[ newV, $Typescript, tsOut ]; ViewerOps.AddProp[ newV, $Implementor, $Squirrel ]; ViewerOps.PaintViewer[newV, all]; END; QueryProc: Menus.MenuProc = BEGIN <> <> viewer: Viewer = NARROW[parent]; seg: Segment_ NARROW[ViewerOps.FetchProp[viewer, $Segment] ]; dName: ROPE = V2S[ ViewerOps.FetchProp[viewer, $DomainName] ]; d: Domain = DeclareDomain[dName, seg]; number: INT = NextQNumber[]; table: VTable = viewer.child; tuplesRow: VTable = GetTableEntry[ table: table, row: 1 ]; answer: LIST OF Entity_ TuplesEditor.QueryTuples[viewer: tuplesRow, domain: d]; IF answer=NIL THEN Message[viewer, "No entities satisfied query!"] ELSE IF answer.rest=NIL THEN BEGIN newV: Viewer; Message[viewer, "One entity satisfied query; displaying it..."]; newV _ NutViewer.SpawnViewer[e: answer.first, d: d, seg: seg, parent: viewer]; Nut.Display[e: answer.first, d: d, seg: seg, newV: newV]; END ELSE BEGIN Message[ viewer, "Entities satisfying query displayed in Answer viewer..."]; MultiDisplay[ entities: answer, title: IO.PutFR["Answer to %g query #%g", IO.rope[dName], IO.int[number]], icon: DBIcons.GetIcon[iconName: dName, default: queryerIcon] ]; END; END; MultiDisplay: PROC[entities: LIST OF Entity, title: ROPE, icon: Icons.IconFlavor] = BEGIN v, lastButton: Viewer; v_ ViewerOps.CreateViewer[ flavor: $Container, info: [name: title, iconic: FALSE, icon: icon], paint: FALSE]; lastButton_ NutViewer.Initialize[v]; FOR elT: LIST OF Entity_ entities, elT.rest UNTIL elT=NIL DO e: Entity= elT.first; lastButton _ NutViewer.MakeButton[ q: DBQueue[], name: GetName[e], proc: ProcessSelection, data: e, sib: lastButton, newLine: TRUE]; ENDLOOP; ViewerOps.PaintViewer[v, all] END; ProcessSelection: Menus.MenuProc = -- Processes a button press on a displayer button. If the shift key is held down, we -- stuff the contents of the button as text at the input point; else we display the entity. BEGIN viewer: ViewerClasses.Viewer = NARROW[parent]; IF shift THEN -- Insert the part of the string after the attribute name and ":" (entity name or other string) TiogaOps.InsertRope[Rope.Substr[viewer.name, Rope.Find[viewer.name, ":"]+2]] ELSE BEGIN newV: Viewer; e: Entity_ V2E[clientData ! SafeStorage.NarrowRefFault => GO TO NotEntity]; newV _ NutViewer.SpawnViewer[e: e, parent: DefaultNutUtilities.GetTopLevel[NARROW[parent]]]; Nut.Display[e: e, newV: newV]; EXITS NotEntity => NutViewer.Message[viewer, "Not an entity-valued field!"]; END; END; -- Start Code ************************************************************ Menus.AppendMenuEntry[ displayerMenu, MakeMenuEntry[DBQueue[], "Edit", EditProc]]; Menus.AppendMenuEntry[ displayerMenu, MakeMenuEntry[DBQueue[], "Freeze", DefaultFreezeProc]]; Menus.AppendMenuEntry[ displayerMenu, MakeMenuEntry[DBQueue[], "Paste", PasteNameProc]]; Menus.AppendMenuEntry[ editorMenu, MakeMenuEntry[DBQueue[], "Freeze", DefaultFreezeProc]]; Menus.AppendMenuEntry[ editorMenu, MakeMenuEntry[DBQueue[], "Paste", PasteNameProc]]; Menus.AppendMenuEntry[ editorMenu, MakeMenuEntry[DBQueue[], "Reset", ResetProc]]; Menus.AppendMenuEntry[ editorMenu, MakeMenuEntry[DBQueue[], "Save", SaveProc]]; Menus.AppendMenuEntry[ editorMenu, MakeMenuEntry[DBQueue[], "Rename", RenameProc]]; Menus.AppendMenuEntry[ editorMenu, MakeMenuEntry[DBQueue[], "Merge", MergeProc]]; Menus.AppendMenuEntry[ editorMenu, MakeMenuEntry[DBQueue[], "EraseAll", EraseAllProc]]; Menus.AppendMenuEntry[ editorMenu, MakeMenuEntry[DBQueue[], "AddSelected", AddProc]]; Menus.AppendMenuEntry[ queryerMenu, MakeMenuEntry[DBQueue[], "Query", QueryProc]]; Nut.Register[ NIL, NIL, DefaultDisplay, DefaultEdit, DefaultQuery ]; END. Change log [since copied some of this code into Walnut]: Cattell March 18, 1982 1:48 pm: Palm updates Cattell April 6, 1983 11:17 am: re-insert default displayer from old NutViewerDefaultImpl: Jim's editor is now default editor, old displayer is default displayer. No default queryer yet. Use VTables for the BuildTupleWindowButtons. Cattell April 7, 1983 11:58 am: various fixes everywhere. Cattell April 15, 1983 11:41 am: added Rename, Merge, EraseAll, etc. Not all checked yet. Changed "Remove" to EraseAll, as it erases all rather than what a user might think it does, i.e. removing one of the related entities. Cattell May 30, 1983 4:15 pm: added message subwindow to editor, fixed up icon for queryer, fixed some error conditions in editor, etc. Cattell June 22, 1983 3:49 pm: bug in RemoveSpecialAttributesFrom Cattell July 5, 1983 5:17 pm: fixed NutImpl and all procs to uniformly use a $NutType, $DomainName, $EntityName, and $Segment prop associated with all nut viewers. Butler June 26, 1984: Minor changes due to reorganization of Nut. Defaults now register with Nut instead of Nut knowing about them.