-- SchemaImpl.mesa
-- Last edited by
  --  John Maxwell on June 7, 1982 10:55 am
  --  Rick Cattell on June 6, 1983 1:13 pm
  --  Willie-Sue on February 22, 1983 4:26 pm
  --  Jim Donahue, May 12, 1983 8:34 am

DIRECTORY
  Buttons USING [Button, ButtonProc],
  Convert USING [IntFromRope, ValueToRope],
  DB,
  Labels USING [Label],
  Menus USING [Menu],
  MessageWindow,
  NutOps USING [GetRefAttributes, GetRelation ],
  NutViewer,
  Rope,
  Schema,
  ViewerClasses USING [Viewer],
  ViewerOps,
  ViewerTools USING [GetContents, SetContents];
  
SchemaImpl: CEDAR PROGRAM
  IMPORTS 
    Convert, DB, MessageWindow, NutOps, NutViewer, Rope, 
    Schema, ViewerOps, ViewerTools 
  EXPORTS Schema =
  
  BEGIN
  OPEN DB, ViewerTools, Schema;
  
  ROPE: TYPE = Rope.ROPE;
  Viewer: TYPE = ViewerClasses.Viewer;
  
  DisplayAttribute: PUBLIC PROCEDURE[r: Relation, a: Attribute,
                          lastV: Viewer, segment: DB.Segment _ NIL] RETURNS[info: AttributeInfo]= 
    BEGIN -- r # NIL means that we are displaying a PROPERTY 
    -- [name: ]          type:           uniqueness: OptionalKey   length:     
    info _ NEW[AttributeInfoRecord];
    info.relation _ r;
    info.segment _ IF segment = NIL THEN SegmentOf[r] ELSE segment;
    info.nameLabel _ NutViewer.MakeButton[
      q: NutViewer.DBQueue[], name: "name:", proc: NewAttribute, 
      sib: lastV, border: TRUE, newLine: TRUE];
    info.name _ NutViewer.NextRightTextViewer[info.nameLabel, 110];
    info.typeLabel _ NutViewer.MakeLabel["type:", info.name];
    info.type _ NutViewer.NextRightTextViewer[info.typeLabel, 130];
    info.uniqueness _ NutViewer.MakeButton[
       NutViewer.DBQueue[], OptionalKeyLabel, ToggleUniqueness, info.type];
    info.lengthLabel _ NutViewer.MakeLabel["length:", info.uniqueness];
    info.length _ NutViewer.NextRightTextViewer[info.lengthLabel, 50];
    IF a = NIL THEN {SetContents[info.uniqueness, GetUniquenessLabel[None]]; RETURN};
    SetContents[info.name, GetName[IF r # NIL THEN r ELSE a]];
    SetContents[info.type, GetName[V2E[GetP[a, aTypeIs]]]];
    SetContents[info.uniqueness, GetUniquenessLabel[V2U[GetP[a, aUniquenessIs]]]];
    SetContents[info.length, GetLengthString[a]];
    END; 
  
  AddAttribute: PUBLIC PROCEDURE[button: Viewer, segment: DB.Segment, 
                          oldList: LIST OF AttributeInfo] RETURNS[newList: LIST OF AttributeInfo] =
    BEGIN
    y: INTEGER;
    found: BOOLEAN;
    attribute: AttributeInfo;
    MoveChild: ViewerOps.EnumProc = {
       IF v.wy > y THEN ViewerOps.MoveViewer[v, v.wx, v.wy + dy, v.ww, v.wh, FALSE]};
    -- move everything below it down
    y _ button.wy + 5;
    ViewerOps.EnumerateChildren[button.parent, MoveChild];
    -- append a new attribute line on the screen AND in the list
    attribute _ DisplayAttribute[NIL, NIL, button, segment];
    found _ FALSE;
    FOR list: LIST OF AttributeInfo _ oldList, list.rest WHILE list # NIL DO
       IF list.first.nameLabel # button THEN LOOP;
       list.rest _ CONS[attribute, list.rest];
       found _ TRUE; 
       EXIT; ENDLOOP;
    IF ~found THEN oldList _ CONS[attribute, oldList];
    RETURN[oldList]; 
    END;
  
 dy: INTEGER _ 17;
    
 RemoveAttribute: PUBLIC PROCEDURE[button: Viewer, oldList: LIST OF AttributeInfo] 
       RETURNS[newList: LIST OF AttributeInfo, relation: Relation] = 
    BEGIN
    y: INTEGER;
    parent: Viewer;
    found: BOOLEAN;
    attribute: AttributeInfo;
    MoveChild: ViewerOps.EnumProc = {
       IF v.wy > y THEN ViewerOps.MoveViewer[v, v.wx, v.wy - dy, v.ww, v.wh, FALSE]};
    -- remove attribute from list
    found _ FALSE;
    IF oldList = NIL THEN RETURN[NIL, NIL];
    FOR list: LIST OF AttributeInfo _ oldList, list.rest DO
       IF list.rest = NIL THEN EXIT;
       IF list.rest.first.nameLabel # button THEN LOOP;
       attribute _ list.rest.first;
       list.rest _ list.rest.rest;
       found _ TRUE; 
       EXIT; ENDLOOP;
    IF ~found THEN {
       IF oldList.first.nameLabel # button THEN RETURN[oldList, NIL];
       attribute _ oldList.first;
       oldList _ oldList.rest};
    -- remove attribute from display
    y _ button.wy + 5;
    parent _ button.parent;
    ViewerOps.DestroyViewer[attribute.nameLabel, FALSE];
    ViewerOps.DestroyViewer[attribute.name, FALSE];
    ViewerOps.DestroyViewer[attribute.typeLabel, FALSE];
    ViewerOps.DestroyViewer[attribute.type, FALSE];
    ViewerOps.DestroyViewer[attribute.uniqueness, FALSE];
    ViewerOps.DestroyViewer[attribute.lengthLabel, FALSE];
    ViewerOps.DestroyViewer[attribute.length, FALSE];
    -- move everything below it up a line
    ViewerOps.EnumerateChildren[parent, MoveChild];
    RETURN[oldList, attribute.relation];
    END;
      
  NewAttribute: PUBLIC Buttons.ButtonProc = {
    property: Relation;
    viewer: Viewer = NARROW[parent];
    dInfo: DomainInfo = NARROW[ViewerOps.FetchProp[viewer.parent, $DomainInfo]];
    rInfo: RelationInfo = NARROW[ViewerOps.FetchProp[viewer.parent, $RelationInfo]];
    IF dInfo # NIL
       THEN IF mouseButton = red 
          THEN dInfo.properties _ AddAttribute[viewer, dInfo.segment, dInfo.properties]
          ELSE { [dInfo.properties, property] _ RemoveAttribute[viewer, dInfo.properties];
                   IF property # NIL THEN dInfo.deleted _ CONS[property, dInfo.deleted]};
    IF rInfo # NIL
       THEN IF mouseButton = red 
          THEN rInfo.attributes _ AddAttribute[viewer, rInfo.segment, rInfo.attributes]
          ELSE rInfo.attributes _ RemoveAttribute[viewer, rInfo.attributes].newList;
    ViewerOps.PaintViewer[viewer.parent, client] };
  
 
  GetDataType: PUBLIC PROCEDURE[type: ROPE, segment: DB.Segment] RETURNS[dt: DataType] =
    BEGIN
    dt _ FetchEntity[DomainDomain, type, segment];
    IF dt = NIL THEN dt _ FetchEntity[DataTypeDomain, type, segment];
    IF dt = NIL AND Rope.Equal[type, "AnyDomainType", FALSE] THEN dt _ AnyDomainType;
    IF dt = NIL THEN MessageWindow.Append[Rope.Cat["INVALID TYPE: ", type]];
    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;
            
  GetLengthString: PROCEDURE[a: Attribute] RETURNS[length: ROPE] =
    {length _ Convert.ValueToRope[[signed[V2I[GetP[a, aLengthIs]]]]]};
    
  KeyLabel: ROPE = "uniqueness: Key";
  OptionalKeyLabel: ROPE = "uniqueness: OptionalKey";
  NoneLabel: ROPE = "uniqueness: NonKey";
  
  GetUniquenessValue: PROCEDURE[rope: ROPE] RETURNS[Uniqueness] =
    BEGIN
    SELECT TRUE FROM
      rope = KeyLabel => RETURN[Key];
      rope = OptionalKeyLabel => RETURN[OptionalKey];
      rope = NoneLabel => RETURN[None];
      ENDCASE => ERROR;
    END;
  
  GetUniquenessLabel: PROCEDURE[uniqueness: Uniqueness] RETURNS[ROPE] =
    BEGIN
    SELECT uniqueness FROM
       Key => RETURN[KeyLabel];
       OptionalKey => RETURN[OptionalKeyLabel];
       None => RETURN[NoneLabel];
       ENDCASE => ERROR;
    END;
  
  ToggleUniqueness: Buttons.ButtonProc =TRUSTED
    BEGIN
    viewer: Viewer_ NARROW[parent];
    SELECT GetUniquenessValue[viewer.name] FROM
       None => SetContents[viewer, KeyLabel];
       Key => SetContents[viewer, OptionalKeyLabel];
       OptionalKey => SetContents[viewer, NoneLabel];
       ENDCASE => ERROR;
    viewer.newVersion _ TRUE;
    END;
       
  NextName: PUBLIC PROCEDURE[list: ROPE]
                  RETURNS[token, newList: ROPE, ok: BOOLEAN _ TRUE] =
    BEGIN
    comma, length: INT;
    -- remove leading spaces
    WHILE TRUE DO
       IF list.Length[] = 0 THEN RETURN[NIL, NIL, TRUE];
       IF list.Fetch[0] = '  THEN list _ list.Substr[1] ELSE EXIT; 
       ENDLOOP;
    length _ list.Length[];
    -- find the terminator
    comma _ Rope.Find[list, ","];
    IF comma = -1 THEN comma _ Rope.Find[list, " "];
    IF comma = -1 THEN comma _ length;
    token _ list.Substr[0, comma];
    IF comma+1 >= length 
       THEN newList _ NIL
       ELSE newList _ list.Substr[comma+1, length];
    END;
    
  RemoveDeleted: PUBLIC PROCEDURE[info: AttributeInfo, relations: LIST OF Relation] 
      RETURNS[LIST OF Relation] =
    BEGIN -- look for properties that have been deleted and then reinserted.
    name: ROPE;
    relation: Relation;
    last: LIST OF Relation;
    IF relations = NIL THEN RETURN[relations];
    IF NoChange[info] THEN RETURN[relations];
    IF info.relation # NIL THEN RETURN[relations];
    name _ GetContents[info.name];
    IF name.Length[] = 0 THEN RETURN[relations];
    relation _ DeclareRelation[name, info.segment, OldOnly];
    IF relation = NIL THEN RETURN[relations];
    FOR list: LIST OF Relation _ relations, list.rest WHILE list # NIL DO
       IF ~Eq[relation, list.first] THEN {last _ list; LOOP};
       -- we found it!
       info.relation _ relation;
       IF list = relations THEN RETURN[relations.rest];
       last.rest _ list.rest;
       RETURN[relations];
       ENDLOOP;
    RETURN[relations];
    END;
  
  CheckProperty: PUBLIC PROCEDURE[d: Domain, info: AttributeInfo, deleted: LIST OF Relation] 
      RETURNS[ok: BOOLEAN _ TRUE] =
    BEGIN
    length: INT;
    name: ROPE;
    old: Relation;
    type: DataType;
    property: Attribute;
    uniqueness: Uniqueness;
    name _ GetContents[info.name];
    IF name.Length[] = 0 OR NoChange[info] THEN RETURN[TRUE];
    -- does a relation of this name already exist?
    old _ DeclareRelation[name, info.segment, OldOnly];
    IF old # NIL AND ~Eq[old, info.relation] THEN {
       MessageWindow.Append[Rope.Cat[name, " PROPERTY ALREADY EXISTS."]];
       RETURN[FALSE]};
    -- check the new property
    type _ GetDataType[GetContents[info.type], info.segment];
    IF type = NIL THEN RETURN[FALSE];
    length _ GetLengthNumber[GetContents[info.length]];
    uniqueness _ GetUniquenessValue[info.uniqueness.name];
    property _ DeclareProperty["xxyxx", d, type, info.segment, uniqueness !
                                        Error => {ok _ FALSE; CONTINUE} ];
    DestroyRelation[DeclareRelation["xxyxx", info.segment, OldOnly]];
    IF ~ok THEN MessageWindow.Append[Rope.Cat["BAD PROPERTY: ", name]];
    END;
  
  SaveProperty: PUBLIC PROCEDURE[d: Domain, info: AttributeInfo] =
    BEGIN
    length: INT;
    name: ROPE;
    type: DataType;
    property: Attribute;
    old, new: Relation;
    uniqueness: Uniqueness;
    name _ GetContents[info.name];
    IF NoChange[info] OR name.Length[] = 0 THEN RETURN;
    -- create the new property
    old _ info.relation;
    type _ GetDataType[GetContents[info.type], info.segment];
    length _ GetLengthNumber[GetContents[info.length]];
    uniqueness _ GetUniquenessValue[info.uniqueness.name];
    property _
     DeclareProperty[IF old = NIL THEN name ELSE "xxyxx", d, type, info.segment, uniqueness];
    -- destroy the old property (might have a different name)
    IF old # NIL THEN {
       new _ DeclareRelation["xxyxx", info.segment, OldOnly];
       Schema.CopyRelships[old, new];
       DestroyRelation[old];
       SetName[new, name]};
    END;
  
  NoChange: PROCEDURE[info: AttributeInfo] RETURNS[BOOLEAN] =
    INLINE BEGIN
    RETURN[~info.name.newVersion AND ~info.uniqueness.newVersion AND 
       ~info.type.newVersion AND ~info.length.newVersion];
    END;
  
  Optimized: PUBLIC PROCEDURE[d: Domain] RETURNS[opt: BOOLEAN] =
    BEGIN
    rs: RelshipSet;
    relation: Relation;
    uniqueness: Uniqueness;
    attributes: AttributeList;
    attributes _ NutOps.GetRefAttributes[d];
    FOR attributes _ attributes, attributes.rest WHILE attributes # NIL DO
       IF Null[attributes.first] THEN LOOP;
       uniqueness _ V2U[GetP[attributes.first, aUniquenessIs]];
       IF uniqueness # Key THEN LOOP;
       relation _ NutOps.GetRelation[attributes.first];
       IF ~V2B[GetP[relation, DB.r1to1Prop]] THEN LOOP;
       rs _ RelationSubset[relation];
       opt _ ~Null[NextRelship[rs]];
       ReleaseRelshipSet[rs];
       IF opt THEN RETURN[TRUE]; 
       ENDLOOP;
    RETURN[FALSE];
    END;
    
  
  Reverse: PUBLIC PROCEDURE[old: LIST OF AttributeInfo] RETURNS[new: LIST OF AttributeInfo]=
    BEGIN
    FOR old _ old, old.rest WHILE old # NIL DO
       new _ CONS[old.first, new];
       ENDLOOP;
    END;
    
   END . . 
  
Change log


Changed by Cattell on August 10, 1982 1:52 pm: Removed refn to DBViewPrivate.r1to1Prop.  Removed 10-line using list for DBView.

Change log.

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

Cattell February 24, 1983 5:05 pm: fixed overlapping last item on domain editor.  Also need to pass segment to various procedures.  
Also need to catch NotImplemented and RESUME on DeclareSubType.