-- File: RelationNutImpl.mesa -- Contents: Implementation of the Relation Nut windows. -- Last edited by: -- Cattell on: August 10, 1983 11:45 am -- Willie-Sue on: February 22, 1983 3:51 pm -- Maxwell on: June 8, 1982 8:43 am -- Donahue, May 11, 1983 4:35 pm -- Butler on: June 27, 1984 3:55:02 pm PDT DIRECTORY Atom USING [GetPropFromList], Buttons, Convert, DB, DefaultNutUtilities, Menus USING [AppendMenuEntry, CreateMenu, Menu, MenuProc], MessageWindow, Nut, NutOps, NutViewer, Rope, SchemaNut, ViewerOps USING [AddProp, FetchProp, PaintViewer, SetMenu], ViewerTools, ViewerClasses; RelationNutImpl: CEDAR PROGRAM IMPORTS Atom, DB, Nut, NutOps, NutViewer, Rope, SchemaNut, DefaultNutUtilities, Menus, MessageWindow, ViewerOps, ViewerTools, Convert = BEGIN OPEN DB, ViewerTools; Viewer: TYPE = ViewerClasses.Viewer; AttributeFieldObject: TYPE = RECORD[ attribute: Attribute, property: Attribute ]; AttributeFieldHandle: TYPE = REF AttributeFieldObject; displayerMenu: Menus.Menu _ Menus.CreateMenu[]; editorMenu: Menus.Menu = Menus.CreateMenu[]; BuildMenus: PROC = BEGIN Menus.AppendMenuEntry[ displayerMenu, NutViewer.MakeMenuEntry[NutViewer.DBQueue[], "Edit", EditProc]]; Menus.AppendMenuEntry[ displayerMenu, NutViewer.MakeMenuEntry[NutViewer.DBQueue[], "Freeze", NutViewer.DefaultFreezeProc]]; Menus.AppendMenuEntry[ editorMenu, NutViewer.MakeMenuEntry[NutViewer.DBQueue[], "Erase", EraseProc]]; Menus.AppendMenuEntry[ editorMenu, NutViewer.MakeMenuEntry[NutViewer.DBQueue[], "Rename", RenameProc]]; Menus.AppendMenuEntry[ editorMenu, NutViewer.MakeMenuEntry[NutViewer.DBQueue[], "Save", SaveProc]]; Menus.AppendMenuEntry[ editorMenu, NutViewer.MakeMenuEntry[NutViewer.DBQueue[], "Reset", ResetProc]]; END; EditProc: Menus.MenuProc = -- Copied from NutDefaultImpl.EditDisplayerProc BEGIN viewer: Viewer = NARROW[parent]; rInfo: SchemaNut.RelationInfo = NARROW[ ViewerOps.FetchProp[viewer, $RelationInfo] ]; DefaultNutUtilities.Edit[eName: rInfo.rName, d: RelationDomain, seg: rInfo.segment, parent: viewer]; END; ---------------------------- RelationDisplayer: PUBLIC Nut.ProcType = BEGIN e: DB.Entity = FetchEntity[d, eName]; IF newV = NIL THEN newV _ NutViewer.SpawnViewer[e: e, eName: eName, d: RelationDomain, seg: seg]; IF NutOps.IsSystemRelation[e] THEN BEGIN NutViewer.Message[NIL, "Displaying system relation not implemented" ]; RETURN END; BEGIN lastViewer: Viewer_ NutViewer.Initialize[newV]; rInfo: SchemaNut.RelationInfo = NEW[ SchemaNut.RelationInfoRecord ]; ViewerOps.SetMenu[newV, displayerMenu]; ViewerOps.AddProp[newV, $RelationInfo, rInfo]; --ViewerOps.AddProp[newV, $Domain, DB.RelationDomain]; ViewerOps.AddProp[newV, $Implementor, $Squirrel ]; rInfo.rName _ eName; rInfo.segment _ seg; rInfo.relation _ e; lastViewer_ NutViewer.MakeLabel[ name: Rope.Cat["------------------", eName, ": ------------------"], sib: lastViewer]; lastViewer_ BuildTitleButtons[lastViewer, e]; TRUSTED { lastViewer_ NutViewer.MakeRuler[lastViewer] }; BuildRelshipWindowButtons[lastViewer, e]; ViewerOps.PaintViewer[newV, all] END; END; BuildTitleButtons: PROC[lastViewer: Viewer, e: Relation] RETURNS [Viewer] = BEGIN firstOnLine: BOOL; myAttrs: AttributeList = NutOps.AttributesOf[e]; colWidth: INTEGER; -- Put up attributes names line IF myAttrs=NIL THEN RETURN[lastViewer]; -- no attributes! colWidth _ lastViewer.parent.ww / ALength[myAttrs] - 1; firstOnLine_ TRUE; FOR alT: AttributeList_ myAttrs, alT.rest UNTIL alT=NIL DO lastViewer_ NutViewer.MakeButton[ q: NutViewer.DBQueue[], name: GetName[alT.first], proc: ProcessAttributeSelection, data: NEW[AttributeFieldObject_ [alT.first, NIL]], width: colWidth, sib: lastViewer, newLine: firstOnLine]; firstOnLine_ FALSE; ENDLOOP; -- Put up attributes types and uniquenesses line firstOnLine_ TRUE; FOR alT: AttributeList_ myAttrs, alT.rest UNTIL alT=NIL DO lastViewer_ NutViewer.MakeButton[ q: NutViewer.DBQueue[], name: Rope.Cat[GetName[V2E[GetP[alT.first, aTypeIs]]], " (", NutOps.GetUniquenessString[alT.first], ")" ], proc: ProcessAttributeSelection, data: NEW[AttributeFieldObject_ [alT.first, aTypeIs]], width: colWidth, sib: lastViewer, newLine: firstOnLine]; firstOnLine_ FALSE; ENDLOOP; RETURN[lastViewer] END; BuildRelshipWindowButtons: PROC[lastViewer: Viewer, e: Relation] = -- Display all the relships in relation e BEGIN count: INT_ 0; t: Relship; myTuples: RelshipSet_ RelationSubset[e]; al: AttributeList_ NutOps.AttributesOf[e]; UNTIL Null[t_ NextRelship[myTuples]] DO IF (count_ count+1)>100 THEN {lastViewer_ NutViewer.MakeLabel[ "... more than 100 tuples: rest truncated ...", lastViewer, TRUE]; EXIT}; lastViewer_ BuildTuplesButtons[lastViewer, al, t]; ENDLOOP; ReleaseRelshipSet[myTuples]; END; BuildTuplesButtons: PROC[lastViewer: Viewer, al: AttributeList, t: Relship] RETURNS [Viewer] = -- Creates one line of buttons on the screen for one database tuple BEGIN aValue: ROPE; colWidth: INTEGER; firstOnLine: BOOL_ TRUE; colWidth _ lastViewer.parent.ww / ALength[al] - 1; FOR alT: AttributeList_ al, alT.rest UNTIL alT=NIL DO aValue_ GetFS[t, alT.first]; lastViewer_ NutViewer.MakeButton[ q: NutViewer.DBQueue[], name: aValue, proc: DefaultNutUtilities.ProcessSelection, data: NEW[DefaultNutUtilities.FieldObject_ [t, alT.first]], sib: lastViewer, width: colWidth, newLine: firstOnLine]; firstOnLine_ FALSE; ENDLOOP; RETURN[lastViewer] END; ProcessAttributeSelection: Buttons.ButtonProc = BEGIN fd: AttributeFieldHandle_ NARROW[clientData]; v: Viewer; IF fd.property=NIL THEN MessageWindow.Append["Not an entity-valued field"] ELSE BEGIN e: Entity _ V2E[GetP[fd.attribute, fd.property]]; parent: Viewer _ (v_ NARROW[parent]).parent; newV: Viewer _ NutViewer.SpawnViewer[e: e, eName: NutOps.SafeNameOf[e], parent: parent]; Nut.Display[e: e, eName: NutOps.SafeNameOf[e], newV: newV]; END; END; ALength: PROC[al: AttributeList] RETURNS[len: INTEGER] = -- Why the FOO won't List.Length work on AttributeLists? compiler complains... {len_0; FOR alT: AttributeList_ al, alT.rest UNTIL alT=NIL DO len_len+1 ENDLOOP}; -- Relation Editor -- RelationEditor: PUBLIC Nut.ProcType = BEGIN info: SchemaNut.RelationInfo; lastV: Buttons.Button; attributes: AttributeList; segment: Segment = seg; e: Entity _ FetchEntity[d, eName, segment]; IF newV = NIL THEN newV _ NutViewer.SpawnViewer[e: e, eName: eName, d: d, seg: segment]; IF NutOps.IsSystemRelation[DB.DeclareRelation[name: eName, segment: seg, version: OldOnly]] THEN BEGIN NutViewer.Error[NIL, eName, " is a system relation. You may not edit it."]; RETURN END; ViewerOps.SetMenu[newV, editorMenu]; lastV_ NutViewer.Initialize[newV]; info _ NEW[SchemaNut.RelationInfoRecord]; info.segment_ segment; info.relation _ e; info.rName_ eName; lastV _ NutViewer.MakeButton[q: NutViewer.DBQueue[], name: "NEW ATTRIBUTE", proc: SchemaNut.NewAttribute, sib: lastV, border: TRUE]; IF info.relation = NIL THEN BEGIN ViewerOps.AddProp[newV, $RelationInfo, info]; RETURN; END; attributes _ NutOps.AttributesOf[info.relation]; FOR attributes _ attributes, attributes.rest WHILE attributes # NIL DO info.attributes_CONS[SchemaNut.DisplayAttribute[NIL, attributes.first, lastV, info.segment], info.attributes]; lastV _ info.attributes.first.length; ENDLOOP; info.attributes _ SchemaNut.Reverse[info.attributes]; ViewerOps.AddProp[newV, $RelationInfo, info]; ViewerOps.AddProp[newV, $Implementor, $Squirrel ]; END; RenameProc: Menus.MenuProc = BEGIN viewer: Viewer = NARROW[parent]; rInfo: SchemaNut.RelationInfo = NARROW[ViewerOps.FetchProp[viewer, $RelationInfo]]; rInfo.rName_ ViewerTools.GetSelectionContents[]; IF rInfo.relation#NIL THEN SetName[rInfo.relation, rInfo.rName]; viewer.name_ Rope.Cat["Relation: ", rInfo.rName]; ViewerOps.PaintViewer[viewer, caption]; END; EraseProc: Menus.MenuProc = BEGIN viewer: Viewer = NARROW[parent]; rInfo: SchemaNut.RelationInfo = NARROW[ViewerOps.FetchProp[viewer, $RelationInfo]]; IF rInfo.relation = NIL THEN NutViewer.Message[viewer, "Relation does not yet exist!"] ELSE DestroyRelation[rInfo.relation]; ResetProc[viewer]; END; ResetProc: Menus.MenuProc = BEGIN viewer: Viewer = NARROW[parent]; rInfo: SchemaNut.RelationInfo = NARROW[ViewerOps.FetchProp[viewer, $RelationInfo]]; viewer.child _ NIL; ViewerOps.PaintViewer[viewer, client]; IF rInfo # NIL THEN DefaultNutUtilities.Reset[eName: rInfo.rName, d: RelationDomain, seg: rInfo.segment, parent: viewer]; END; SaveProc: Menus.MenuProc = BEGIN viewer: Viewer = NARROW[parent]; rInfo: SchemaNut.RelationInfo = NARROW[ViewerOps.FetchProp[viewer, $RelationInfo]]; IF rInfo # NIL THEN SaveRelation[viewer]; END; SaveRelation: PROCEDURE[viewer: Viewer] = BEGIN new: Relation; info: SchemaNut.RelationInfo; ok: BOOLEAN _ TRUE; newV: Viewer; e: Entity; info _ NARROW[ViewerOps.FetchProp[viewer, $RelationInfo]]; new _ DeclareRelation[NIL, info.segment]; FOR list: LIST OF SchemaNut.AttributeInfo _ info.attributes, list.rest WHILE list # NIL DO IF ~SaveAttribute[new, list.first] THEN ok _ FALSE; ENDLOOP; IF ~ok THEN BEGIN DestroyRelation[new]; RETURN; END; IF info.relation # NIL THEN BEGIN SchemaNut.CopyRelships[info.relation, new]; DestroyRelation[info.relation]; END; SetName[new, info.rName]; viewer.child _ NIL; ViewerOps.AddProp[viewer, $RelationInfo, NIL]; e _ FetchEntity[NIL, info.rName]; newV _ NutViewer.ReplaceViewer[e: e, eName: info.rName, seg: info.segment, parent: viewer]; Nut.Display[e: e, eName: info.rName, seg: info.segment, newV: newV]; END; SaveAttribute: PROCEDURE[r: Relation, info: SchemaNut.AttributeInfo] RETURNS[ok: BOOLEAN _ TRUE] = BEGIN name: ROPE; type: DataType; length: INT _ 0; uniqueness: Uniqueness; name _ GetContents[info.name]; IF name.Length[] = 0 THEN RETURN[TRUE]; type _ SchemaNut.GetDataType[GetContents[info.type], info.segment]; IF type = NIL THEN RETURN[FALSE]; length _ GetLengthNumber[GetContents[info.length]]; uniqueness _ GetUniquenessValue[info.uniqueness.name]; []_ DeclareAttribute[r, name, type, uniqueness, length ! Error => { ok _ FALSE; CONTINUE}]; IF ~ok THEN NutViewer.Error[NIL, "Bad attribute: ", name]; END; GetLengthNumber: PROCEDURE[rope: ROPE] RETURNS[length: INT _ 0] = INLINE BEGIN ENABLE ANY => {MessageWindow.Append[Rope.Cat["BAD NUMBER: ", rope]]; CONTINUE}; IF rope.Length[] = 0 THEN RETURN[0]; length _ Convert.IntFromRope[rope]; END; GetUniquenessValue: PROCEDURE[rope: ROPE] RETURNS[Uniqueness] = BEGIN SELECT TRUE FROM Rope.Equal[rope, "uniqueness: Key"] => RETURN[Key]; Rope.Equal[rope, "uniqueness: OptionalKey"] => RETURN[OptionalKey]; Rope.Equal[rope, "uniqueness: NonKey"] => RETURN[None]; ENDCASE => ERROR; END; -- start code BuildMenus[]; Nut.Register["Relation", NIL, RelationDisplayer, RelationEditor]; END. Change log. Willie-Sue December 13, 1982: aFooProp => aFooIs, for new system propertiesk Butler June 26, 1984: Updated to register relation displayer and editor. Many minor changes to comply with new Nut organization.