-- 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

DIRECTORY
  Atom USING [GetPropFromList],
  Buttons,
  Convert,
  DB,
  InputFocus USING [SetInputFocus],
  Menus USING [AppendMenuEntry, CreateMenu, Menu, MenuProc],
  MessageWindow,
  Nut,
  NutOps,
  NutViewer,
  Rope,
  Schema,
  SystemNuts,
  ViewerOps USING [AddProp, FetchProp, PaintViewer, SetMenu, DestroyViewer],
  ViewerTools,
  ViewerClasses;


RelationNutImpl: CEDAR PROGRAM
  IMPORTS
   Atom, DB, InputFocus, Nut, NutOps, NutViewer, Rope, Schema,
   Menus, MessageWindow, ViewerOps, ViewerTools, Convert
  EXPORTS SystemNuts =

BEGIN OPEN DB, Schema, 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
  {viewer: Viewer = NARROW[parent];
     rInfo: RelationInfo = NARROW[ ViewerOps.FetchProp[viewer, $RelationInfo] ];
     seg: DB.Segment = rInfo.segment;
    rName: ROPE = rInfo.rName;
    InputFocus.SetInputFocus[];        -- kill the caret
    ViewerOps.DestroyViewer[viewer.child];
    [] _ Nut.Edit[d: RelationDomain, eName: rName, parent: viewer, method: replace, seg: seg]};

----------------------------
RelationCreate: PUBLIC Nut.CreateProc =
  { RETURN[ Nut.DefaultCreate[nutType, d, eName, seg, column] ] };

RelationDisplayer: PUBLIC Nut.DisplayProc =
  BEGIN
  IF NutOps.IsSystemRelation[e] THEN
    { NutViewer.Message[NIL, "Displaying system relation not implemented"  ]; RETURN };
  { lastViewer: Viewer_ NutViewer.Initialize[newV];
    rInfo: RelationInfo = NEW[ RelationInfoRecord ];
    ViewerOps.SetMenu[newV, displayerMenu];
    ViewerOps.AddProp[newV, $RelationInfo, rInfo];
    --ViewerOps.AddProp[newV, $Domain, DB.RelationDomain];
    ViewerOps.AddProp[newV, $Implementor, $Squirrel ];
    rInfo.rName _ NameOf[e];
    rInfo.segment _ seg;
    rInfo.relation _ e;
    lastViewer_ NutViewer.MakeLabel[
       name: Rope.Cat["------------------", NameOf[e], ": ------------------"], sib: lastViewer];
    lastViewer_ BuildTitleButtons[lastViewer, e];
    lastViewer_ NutViewer.MakeRuler[lastViewer];
    BuildRelshipWindowButtons[lastViewer, e];
    ViewerOps.PaintViewer[newV, all] }
  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: NutViewer.ProcessSelection,
        data: NEW[NutViewer.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
    [] _ Nut.Display[e: V2E[GetP[fd.attribute, fd.property]], parent: (v_ NARROW[parent]).parent];
  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.EditProc =
    BEGIN
    info: RelationInfo;
    lastV: Buttons.Button;
    attributes: AttributeList;
    segment: Segment = seg;
    IF NutOps.IsSystemRelation[DB.DeclareRelation[name: eName, segment: seg, version: OldOnly]]
    THEN {
       NutViewer.Error[NIL, eName, " is a system relation.  You may not edit it."]; RETURN};
    ViewerOps.SetMenu[newV, editorMenu];
    lastV_ NutViewer.Initialize[newV];
    info _ NEW[RelationInfoRecord];
    info.segment_ segment;
    info.relation _ FetchEntity[d, eName, segment];
    info.rName_ eName;
    lastV _ NutViewer.MakeButton[
       q: NutViewer.DBQueue[], name: "NEW ATTRIBUTE", proc: NewAttribute, 
       sib: lastV, border: TRUE];
    IF info.relation = NIL THEN {ViewerOps.AddProp[newV, $RelationInfo, info]; RETURN};
    attributes _ NutOps.AttributesOf[info.relation];
    FOR attributes _ attributes, attributes.rest WHILE attributes # NIL DO
       info.attributes_CONS[
         DisplayAttribute[NIL, attributes.first, lastV, info.segment], info.attributes];
       lastV _ info.attributes.first.length;
       ENDLOOP;
    info.attributes _ Reverse[info.attributes];
    ViewerOps.AddProp[newV, $RelationInfo, info];
    ViewerOps.AddProp[newV, $Implementor, $Squirrel ];
    END;

RenameProc: Menus.MenuProc = 
    BEGIN
     viewer: Viewer = NARROW[parent];
    rInfo: 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: 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: RelationInfo = NARROW[ViewerOps.FetchProp[viewer, $RelationInfo]];
    viewer.child _ NIL;
    ViewerOps.PaintViewer[viewer, client];
    IF rInfo # NIL THEN
      RelationEditor[RelationDomain, rInfo.rName, viewer, rInfo.segment];
    END;

SaveProc: Menus.MenuProc = 
    BEGIN
    viewer: Viewer = NARROW[parent];
    rInfo: RelationInfo = NARROW[ViewerOps.FetchProp[viewer, $RelationInfo]];
    IF rInfo # NIL THEN SaveRelation[viewer];
    END;
    
SaveRelation: PROCEDURE[viewer: Viewer] =
    BEGIN
    new: Relation;
    info: RelationInfo;
    ok: BOOLEAN _ TRUE;
    info _ NARROW[ViewerOps.FetchProp[viewer, $RelationInfo]];
    new _ DeclareRelation[NIL, info.segment];
    FOR list: LIST OF AttributeInfo _ info.attributes, list.rest WHILE list # NIL DO
       IF ~SaveAttribute[new, list.first] THEN ok _ FALSE;
       ENDLOOP;
    IF ~ok THEN {DestroyRelation[new]; RETURN};
    IF info.relation # NIL THEN {
       Schema.CopyRelships[info.relation, new]; 
       DestroyRelation[info.relation]};
    SetName[new, info.rName];
    viewer.child _ NIL;
    ViewerOps.AddProp[viewer, $RelationInfo, NIL];
    [] _ Nut.Display[e: new, seg: info.segment, parent: viewer, method: replace];
    END;
    
SaveAttribute: PROCEDURE[r: Relation, info: 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 _ 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;
    
RelationQueryer: PUBLIC Nut.QueryProc = { Nut.DefaultQuery[d, newV, segment] };

--  start code
BuildMenus[];

END.

Change log.

Willie-Sue December 13, 1982: aFooProp => aFooIs, for new system propertiesk