<> <> <> <> <> <> DIRECTORY Atom USING [GetPropFromList], BasicTime USING [GMT], Buttons USING [ButtonProc, ReLabel], DB, DBEnvironment, IO, Menus USING[ MouseButton ], Nut, NutOps, NutViewer USING [Error, Message], Rope, TuplesEditor, VFonts USING[CharWidth, FontHeight], ViewerOps USING [AddProp, FetchProp, FetchViewerClass, PaintViewer], Containers, ViewerTools USING [GetContents, SetContents, SetSelection], ViewerClasses, VTables; TuplesEditorImpl: CEDAR MONITOR IMPORTS Atom, Buttons, DB, DBEnvironment, IO, Nut, NutOps, NutViewer, Rope, VTables, VFonts, ViewerOps, ViewerTools EXPORTS TuplesEditor = { OPEN DB, Rope, Nut, ViewerClasses, VTables; PosPair: TYPE = RECORD[ row: CARDINAL, col: CARDINAL]; anyErrors: BOOL; -- Set if any procedure discovered user errors in saving the new entries defaultOld: PUBLIC BOOL_ TRUE; -- FALSE => attributes start in NewOrOld mode, else OldOnly updateList: AttributeValueList; allFieldsNull: BOOLEAN; relTable: Viewer; relRows: CARDINAL; newRelship, oldRelship: Relship; DisplayTuples: PUBLIC ENTRY PROC[e: Entity, attrList: AttributeList, parent: Viewer] RETURNS[ TuplesTable: VTable ] = <
> <> <> <> <> { ENABLE UNWIND => NULL; row: CARDINAL _ 0; TuplesTable _ Create[ parent: parent, rows: Length[attrList]+1, columns: 1 ]; FOR attrL: AttributeList _ attrList, attrL.rest UNTIL attrL = NIL DO { tupleList: LIST OF Relship = IF e = NIL THEN NIL ELSE NutOps.GetTuples[e, attrL.first]; relTable: VTable = Create[ rows: 1, columns: 3, parent: TuplesTable ]; IF tupleList = NIL THEN AddRow[ relTable, attrL.first ] ELSE FOR tlT: LIST OF Relship _ tupleList, tlT.rest UNTIL tlT=NIL DO AddRow[ relTable, attrL.first, tlT.first ] ENDLOOP; SetTableEntry[table: TuplesTable, row: row, flavor: $Viewer, clientData: relTable, border: NullBorder ]; row _ row+1 } ENDLOOP; ViewerOps.AddProp[ TuplesTable, $Entity, e ]; Install[TuplesTable, FALSE] }; AddRow: PROC[ table: VTable, attribute: Attribute, relship: Relship _ NIL ] = <> <> <> { row: CARDINAL _ GetRowsAndColumns[table: table].rows-1; r: Relation = NutOps.GetRelation[attribute]; allAttrs: LIST OF Attribute _ NutOps.AttributesOf[r]; firstRow: BOOLEAN _ TRUE; displayAttrs: LIST OF Attribute = NutOps.RemoveAttribute[attribute, allAttrs]; howLong: INT = Length[displayAttrs]; howMuchSpace: INT = IF howLong MOD 2 = 0 THEN howLong/2 ELSE (howLong/2)+1; i: INT _ 1; -- the index of the next column to be updated <> <<(or blank if in succeeding rows), while the second and third give two attributes of the>> <> <> SetTableEntry[ table: table, row: row, column: 0, flavor: $Button, name: GetName[r], clientData: attribute, proc: RelProc, border: NullBorder ]; { relViewer: Viewer = GetTableEntry[ table: table, row: row, column: 0 ]; ViewerOps.AddProp[ relViewer, $newLine, NEW[BOOLEAN _ TRUE] ]; ViewerOps.AddProp[ viewer: relViewer, prop: $relShip, val: relship ]; ViewerOps.AddProp[ viewer: relViewer, prop: $r, val: r]; ViewerOps.AddProp[ viewer: relViewer, prop: $a, val: attribute ]; ViewerOps.AddProp[ viewer: relViewer, prop: $row, val: NEW[ INT _ row ] ] }; <> SetRowsAndColumns[ table: table, rows: row+1+howMuchSpace, columns: 3 ]; FOR da: LIST OF Attribute _ displayAttrs, da.rest UNTIL da = NIL DO nextAttr: Attribute = da.first; attrViewer: VTable = Create[ parent: table, columns: 4 ]; ViewerOps.AddProp[ attrViewer, $attr, nextAttr ]; ViewerOps.AddProp[ attrViewer, $which, NEW[ INT_ IF defaultOld THEN 2 ELSE 0 ] ]; VTables.SetTableEntry[ table: attrViewer, column: 0, flavor: $Button, proc: AttrProc, clientData: attrViewer, name: Rope.Cat[DB.NameOf[nextAttr], ":"], border: NullBorder]; IF NutOps.EntityValued[nextAttr] THEN { VTables.SetTableEntry[ table: attrViewer, column: 2, name: IF defaultOld THEN "O" ELSE "", flavor: $Button, w: VFonts.CharWidth['O]+5, border: NullBorder, clientData: attrViewer, proc: CycleNewOld ]; VTables.GetTableEntry[ table: attrViewer, column: 2].border _ TRUE }; VTables.SetTableEntry[ table: attrViewer, column: 3, useMaxSize: TRUE, border: NullBorder, w: 20*VFonts.CharWidth['A], flavor: $Text ]; VTables.GetTableEntry[ table: attrViewer, column: 3 ].scrollable _ TRUE; IF relship # NIL THEN ViewerTools.SetContents[ viewer: GetTableEntry[ table: attrViewer, column: 3 ], contents: GetFS[ relship, nextAttr ], paint: FALSE ]; Install[ attrViewer, FALSE ]; VTables.SetTableEntry[ table: table, row: row, column: i, flavor: $Viewer, clientData: attrViewer, border: NullBorder, useMaxSize: TRUE ]; i _ (i+1) MOD 3; IF i = 0 THEN -- it's time for a new row { row _ row + 1; SetTableEntry[ table: table, row: row, column: 0, name: "", border: NullBorder ]; ViewerOps.AddProp[ GetTableEntry[ table, row, 0 ], $newLine, NEW[BOOLEAN _ FALSE] ]; i _ i+1 } ENDLOOP; VTables.Install[ table, FALSE ] }; Length: PROC[ l: LIST OF Attribute ] RETURNS[ n: INT ] = { n _ 0; UNTIL l = NIL DO n _ n+1; l _ l.rest ENDLOOP }; AttrProc: Buttons.ButtonProc = TRUSTED { viewer: ViewerClasses.Viewer = NARROW[ parent, ViewerClasses.Viewer ]; attrViewer: VTable = NARROW[ clientData, VTable ]; textViewer: Viewer = GetTableEntry[ table: attrViewer, column: 3 ]; attr: Attribute = V2E[ViewerOps.FetchProp[attrViewer, $attr]]; domain: Domain = V2E[GetP[attr, aTypeIs, aTypeOf]]; entity: Entity; SELECT mouseButton FROM Menus.MouseButton[red] => ViewerTools.SetSelection[ textViewer, NIL ]; Menus.MouseButton[yellow] => { entity _ DeclareEntity[ domain, ViewerTools.GetContents[textViewer], Version[OldOnly] ! DB.Error => { entity _ NIL; CONTINUE } ]; IF entity # NIL THEN [] _ Nut.Display[ entity ] ELSE NutViewer.Message[viewer, ViewerTools.GetContents[textViewer], " not found!"] }; ENDCASE => ViewerTools.SetSelection[ textViewer, NIL ] }; RelProc: Buttons.ButtonProc = TRUSTED { viewer: ViewerClasses.Viewer = NARROW[ parent, ViewerClasses.Viewer ]; attribute: Attribute = V2E[clientData]; relTable: VTable _ viewer.parent; TuplesTable: VTable = relTable.parent; SELECT mouseButton FROM Menus.MouseButton[red] => { u: Uniqueness = V2U[GetP[attribute, aUniquenessIs, aUniquenessOf]]; IF u = Key OR u = OptionalKey THEN {anyErrors_ TRUE; NutViewer.Message[viewer, "Only one allowed!"]} ELSE AddRow[ relTable, attribute ] }; Menus.MouseButton[blue] => { row: INT _ (NARROW[ ViewerOps.FetchProp[ viewer, $row ], REF INT ])^; newLine: BOOLEAN _ FALSE; UNTIL newLine DO FOR i: NAT IN [0..2) DO { attrViewer: VTable = GetTableEntry[ relTable, row, i+1 ]; IF attrViewer # NIL THEN { textViewer: Viewer _ GetTableEntry[ attrViewer, 0, 3 ]; attrButton: Viewer _ GetTableEntry[ attrViewer, 0, 0 ]; xoff, yoff: INTEGER; text: ROPE = ViewerTools.GetContents[ textViewer ]; textHeight: INT = textViewer.wh; newTextViewer: Viewer; [xoff, yoff] _ GetEntryOffset[ table: relTable, row: row, column: 0 ]; SetTableEntry[ table: attrViewer, column: 3, flavor: $Text, border: NullBorder, useMaxSize: TRUE, w: 20*VFonts.CharWidth['A], h: textHeight+VFonts.FontHeight[]+1 ]; newTextViewer _ GetTableEntry[ table: attrViewer, column: 3 ]; newTextViewer.scrollable _ TRUE; ViewerTools.SetContents[ viewer: newTextViewer, contents: text, paint: FALSE ]; Install[ attrViewer, FALSE ]; newTextViewer.newVersion _ textViewer.newVersion; SetEntryOffset[ table: relTable, row: row, column: 0, yoff: GetEntryOffset[ table: attrViewer, column: 0 ].yoff ]; Install[ relTable, FALSE ] } } ENDLOOP; row _ row + 1; IF row = GetRowsAndColumns[relTable].rows-1 THEN EXIT; { relViewer: VTable = GetTableEntry[ relTable, row, 0 ]; newLineProp: REF BOOLEAN = IF relViewer = NIL THEN NIL ELSE NARROW[ViewerOps.FetchProp[relViewer, $newLine]]; newLine _ IF newLineProp = NIL THEN TRUE ELSE newLineProp^ } ENDLOOP; Install[ relTable, FALSE ] }; Menus.MouseButton[yellow] => { row: INT _ (NARROW[ ViewerOps.FetchProp[ viewer, $row ], REF INT ])^; newLine: BOOLEAN _ FALSE; UNTIL newLine DO FOR i: NAT IN [0..2) DO { attrViewer: VTable = GetTableEntry[ relTable, row, i+1 ]; IF attrViewer # NIL THEN { attr: Attribute = V2E[ViewerOps.FetchProp[attrViewer, $attr]]; type: Entity = V2E[GetP[attr, aTypeIs, aTypeOf]]; SetTableEntry[ table: attrViewer, row: 0, column: 1, name: TypeLabel[type], border: NullBorder ]; Install[ attrViewer, FALSE ] } } ENDLOOP; row _ row + 1; IF row = GetRowsAndColumns[relTable].rows-1 THEN EXIT; { relViewer: VTable = GetTableEntry[ relTable, row, 0 ]; newLineProp: REF BOOLEAN = IF relViewer = NIL THEN NIL ELSE NARROW[ViewerOps.FetchProp[relViewer, $newLine]]; newLine _ IF newLineProp = NIL THEN TRUE ELSE newLineProp^ } ENDLOOP; Install[ relTable, FALSE ] }; ENDCASE; InstallAll[ TuplesTable] }; InstallAll: PROC[ viewer: Viewer ] = { tableClass: ViewerClasses.ViewerClass = ViewerOps.FetchViewerClass[$VTable]; IF viewer = NIL THEN RETURN; UNTIL viewer.parent = NIL DO IF viewer.class = tableClass THEN Install[viewer, FALSE]; viewer _ viewer.parent; ENDLOOP; ViewerOps.PaintViewer[viewer, all] }; TypeLabel: PROC[ type: Entity ] RETURNS[ Rope.ROPE ] = { IF DB.Eq[type, DB.RopeType] THEN RETURN["(String)"] ELSE IF DB.Eq[type, DB.IntType] THEN RETURN["(Int)"] ELSE IF DB.Eq[type, DB.BoolType] THEN RETURN["(Bool)"] ELSE IF DB.Eq[type, DB.TimeType] THEN RETURN["(Time)"] ELSE RETURN[ Rope.Cat["(", GetName[type], ")"] ] }; CycleNewOld: Buttons.ButtonProc = TRUSTED { viewer: ViewerClasses.Viewer = NARROW[ parent, ViewerClasses.Viewer ]; Labels: ARRAY[0..3) OF ROPE = ["", "N", "O"]; attrViewer: VTable = viewer.parent; relRow: VTable = attrViewer.parent; TuplesTable: VTable = relRow.parent; EventTable: VTable = TuplesTable.parent; attr: Attribute = V2E[ ViewerOps.FetchProp[ attrViewer, $attr ] ]; which: REF INT = NARROW[ViewerOps.FetchProp[attrViewer, $which], REF INT]; IF NOT NutOps.EntityValued[attr] THEN RETURN; which^ _ (which^ + 1) MOD 3; Buttons.ReLabel[viewer, Labels[which^] ]; ViewerOps.AddProp[attrViewer, $which, which ]; Install[ relRow, FALSE ]; Install[ TuplesTable, FALSE ]; Install[ EventTable, TRUE ] }; SaveTuples: PUBLIC ENTRY PROC[viewer: VTable, newEntity: Entity _ NIL ] RETURNS [errors: BOOL] = <> <> <> <> <> <> <> { ENABLE UNWIND => NULL; tupleRows: CARDINAL = GetRowsAndColumns[ viewer ].rows; oldEntity: DB.Entity = V2E[ViewerOps.FetchProp[viewer, $Entity]]; update: BOOLEAN = NOT DB.Null[oldEntity] AND DB.Eq[oldEntity, newEntity]; destroy: BOOLEAN = NOT DB.Null[oldEntity] AND newEntity = NIL; create: BOOLEAN = NOT DB.Null[newEntity] AND oldEntity = NIL; copy: BOOLEAN = NOT (destroy OR create OR update); parent: Viewer = viewer.parent; anyErrors_ FALSE; FOR i: CARDINAL IN [0..tupleRows-1) DO j: CARDINAL _ 0; relTable _ GetTableEntry[ table: viewer, row: i, column: 0 ]; relRows _ GetRowsAndColumns[ relTable ].rows; WHILE j < relRows-1 DO <> <1 row), we want to destroy, create, or update the relationship as specified.>> relViewer: Viewer = GetTableEntry[relTable, j, 0]; rel: Relation = V2E[ViewerOps.FetchProp[relViewer, $r ] ]; attr: Attribute = V2E[ViewerOps.FetchProp[ relViewer, $a ] ]; oldRelship_ V2E[ViewerOps.FetchProp[relViewer, $relShip ] ]; updateList_ NIL; allFieldsNull_ TRUE; newRelship_ NIL; <> <> DO AddFields[ parent: parent, row: j, copy: NOT (destroy OR create OR update) ]; <> IF PastLastRowOfTuple[j_ j + 1, relRows, relTable] THEN EXIT; ENDLOOP; <> IF destroy THEN <> {IF NOT DB.Null[oldRelship] THEN DB.DestroyRelship[oldRelship]} ELSE IF updateList#NIL THEN -- Continue only if user modified something in this tuple.. IF update AND NOT DB.Null[oldRelship] THEN <> IF allFieldsNull THEN DB.DestroyRelship[oldRelship] ELSE UpdateTuple[oldRelship, updateList] ELSE IF NOT allFieldsNull THEN <> <> { updateList _ CONS[ AttributeValue[ attribute: attr, lo: newEntity], updateList ]; UpdateTuple[CreateRelship[rel], updateList]; ViewerOps.AddProp[ relViewer, $relShip, newRelship ] }; ENDLOOP; ENDLOOP; RETURN[anyErrors] }; PastLastRowOfTuple: PROC[j: CARDINAL, relRows: CARDINAL, relTable: VTable ] RETURNS [BOOL] = <> <> <> <> { RETURN[ j >= relRows-1 OR NARROW[ViewerOps.FetchProp[GetTableEntry[relTable, j, 0], $newLine], REF BOOL]^]}; UpdateTuple: PROC[ t: Relship, updateList: AttributeValueList ] = <> <> { <> FOR ul: AttributeValueList _ updateList, ul.rest UNTIL ul = NIL DO av: AttributeValue = ul.first; u: Uniqueness = V2U[GetP[av.attribute, aUniquenessIs]]; IF u = Key THEN SetF[ t, av.attribute, av.lo ] ENDLOOP; <> FOR ul: AttributeValueList _ updateList, ul.rest UNTIL ul = NIL DO av: AttributeValue = ul.first; u: Uniqueness = V2U[GetP[av.attribute, aUniquenessIs]]; IF u # Key THEN SetF[ t, av.attribute, av.lo ] ENDLOOP }; PropertyValueList: TYPE = LIST OF PropertyValue; PropertyValue: TYPE = RECORD[ from: Attribute, -- entity-valued attribute of a relation avl: AttributeValueList -- value contraints on other attributes of same relation ]; QueryTuples: PUBLIC ENTRY PROC[ viewer: VTable, domain: Domain ] RETURNS [el: LIST OF Entity] = <> <> <> { ENABLE UNWIND => NULL; tupleRows: CARDINAL = GetRowsAndColumns[ viewer ].rows; queryList: PropertyValueList_ NIL; parent: Viewer = viewer.parent; FOR i: CARDINAL IN [0..tupleRows-1) DO j: CARDINAL _ 0; relTable _ GetTableEntry[ table: viewer, row: i, column: 0 ]; relRows _ GetRowsAndColumns[ relTable ].rows; WHILE j < relRows-1 DO <> <1 row), we want to handle the relationship as specified.>> relViewer: Viewer = GetTableEntry[relTable, j, 0]; rel: Relation = V2E[ViewerOps.FetchProp[relViewer, $r ] ]; attr: Attribute = V2E[ViewerOps.FetchProp[ relViewer, $a ] ]; updateList_ NIL; allFieldsNull_ TRUE; <> <> DO AddFields[ parent: parent, row: j, copy: FALSE ]; <> IF PastLastRowOfTuple[j_ j + 1, relRows, relTable] THEN EXIT; ENDLOOP; IF updateList#NIL AND NOT allFieldsNull THEN <> queryList_ CONS[[from: attr, avl: updateList], queryList]; ENDLOOP; -- WHILE j < relRows-1 ENDLOOP; -- FOR i: CARDINAL RETURN[EntityQuery[queryList]]; }; EntityQuery: PROC[pvl: PropertyValueList] RETURNS[LIST OF Entity] = <> <> <> <<"from" attribute equals the entity and whose other attributes satisfy the>> <> { f: Attribute_ pvl.first.from; r: Relation_ V2E[GetP[f, aRelationIs]]; elNew: LIST OF Entity_ NIL; nestedRS: RelshipSet_ RelationSubset[r, pvl.first.avl]; FOR t: Relship_ NextRelship[nestedRS], NextRelship[nestedRS] UNTIL t=NIL DO elNew_ CONS[V2E[GetF[t, f]], elNew] ENDLOOP; ReleaseRelshipSet[nestedRS]; RETURN[NestedEntityQuery[elNew, pvl.rest]] }; NestedEntityQuery: PROC[elOld: LIST OF Entity, pvl: PropertyValueList] RETURNS[LIST OF Entity] = <> <> <> <> <> <> { IF pvl=NIL THEN RETURN[elOld] ELSE { f: Attribute_ pvl.first.from; r: Relation_ V2E[GetP[f, aRelationIs]]; elNew, elEnd: LIST OF Entity_ NIL; -- will equal those in elOld that satisfy pvl.first FOR elOldT: LIST OF Entity_ elOld, elOldT.rest UNTIL elOldT=NIL DO nestedRS: RelshipSet_ RelationSubset[r, CONS[ [f, elOldT.first], pvl.first.avl]]; <> <> IF NextRelship[nestedRS] #NIL THEN IF elNew=NIL THEN elEnd_ elNew_ CONS[elOldT.first, NIL] ELSE elEnd_ elEnd.rest_ CONS[elOldT.first, NIL]; ReleaseRelshipSet[nestedRS]; ENDLOOP; RETURN[NestedEntityQuery[elNew, pvl.rest]]; }}; AddFields: PROC[parent: Viewer, row: CARDINAL, copy: BOOL] = <> <> <> <> <> <> <> <> { FOR i: INT IN [0..2) DO attrViewer: VTable = GetTableEntry[relTable, row, i+1]; IF attrViewer # NIL THEN { attr: Attribute = V2E[ViewerOps.FetchProp[attrViewer, $attr]]; newOld: INT = NARROW[ViewerOps.FetchProp[attrViewer, $which], REF INT]^; textViewer: Viewer = GetTableEntry[table: attrViewer, column: 3]; contents: ROPE = ViewerTools.GetContents[textViewer]; type: Entity = V2E[GetP[attr, aTypeIs, aTypeOf]]; value: DB.Value; IF NOT textViewer.newVersion THEN <> IF oldRelship=NIL OR NOT copy THEN LOOP; IF NOT Rope.Equal[contents, ""] THEN allFieldsNull_ FALSE; SELECT type FROM IntType => { val: INT = IF Rope.Equal[contents, ""] THEN 0 ELSE IO.GetInt[ IO.RIS[contents] ]; value _ I2V[val]}; RopeType => value _ S2V[ contents ]; BoolType => value _ B2V[ Rope.Equal[contents, "TRUE"] ]; TimeType => { time: DB.GMT; time.time _ IO.GetTime[IO.RIS[contents] ! IO.Error => TRUSTED { anyErrors_ TRUE; NutViewer.Error[parent, "Unintelligible time/date: ", contents]}]; value _ T2V[time] }; ENDCASE => IF Rope.Equal[contents, ""] THEN value_ NIL ELSE SELECT newOld FROM 0 => -- NewOrOld { value _ DeclareEntity[ d: type, name: contents, version: OldOnly ]; IF value = NIL THEN { NutViewer.Message[parent, "Automatically creating ", contents]; value _ DeclareEntity[ d: type, name: contents ]; IF value = NIL THEN { allFieldsNull_ TRUE; -- pretend this tuple didn't happen anyErrors_ TRUE; NutViewer.Error[parent, " Error: ", contents, " could not be created automatically."]; } } }; 1 => -- NewOnly { value _ CreateEntity[ d: type, name: contents ! DBEnvironment.Error => TRUSTED { codeRef: REF DBEnvironment.ErrorCode ~ NEW[DBEnvironment.ErrorCode _ code]; NutViewer.Error[parent, IO.PutFR["%g", IO.refAny[codeRef]], " Error trying to create \"", contents, "\" entity."]; allFieldsNull_ TRUE; -- pretend this tuple didn't happen anyErrors_ TRUE; CONTINUE}]}; 2 => -- OldOnly { value _ DeclareEntity[ type, contents, Version[OldOnly] ]; IF value = NIL THEN { allFieldsNull_ TRUE; -- pretend this tuple didn't happen anyErrors_ TRUE; NutViewer.Error[parent, " Error: ", contents, " does not exist."] }}; ENDCASE; updateList _ CONS[ AttributeValue[attribute: attr, lo: value], updateList ] } ENDLOOP }; }. Change Log: Changed by Cattell April 6, 1983 1:12 pm: The CONS in AddRow's first loop was causing it to reverse the order of the attributes to be displayed from the order in the database. Changed loop to destructively modify list, more efficient anyway since no space allocation. Changed by Cattell April 15, 1983 11:08 am: Numerous changes and bug fixes to SaveTuples. Reduced complexity of inner loop from 22 to 11 lines! <> <> <> <> <> <> <<>> <<>> <<>> <<>>