-- File: DomainNutImpl.mesa
-- Contents: Implementation of the Domain Nut windows.
-- Last edited by:
-- Willie-Sue on: February 22, 1983 3:49 pm
-- Cattell on: October 5, 1983 10:26 am
-- Maxwell on: June 3, 1982 9:27 am
-- Donahue on: April 11, 1983 4:56 pm

DIRECTORY
Buttons USING [ButtonProc], Containers USING [ChildYBound],
DB, InputFocus USING [SetInputFocus],
MBWindows, Menus USING [AppendMenuEntry, CreateMenu, Menu, MenuProc],
Nut, NutOps, NutViewer, Rope, Schema, SystemNuts,
ViewerOps, ViewerTools, ViewerClasses;


-- Need to call ReleaseEntitySet[myEntities] when viewer destroyed!
-- Can't use MBQueue's clientData


DomainNutImpl: CEDAR PROGRAM
IMPORTS Containers, DB, Nut, NutOps, InputFocus, MBWindows, Menus, Schema,
   NutViewer, Rope, ViewerOps, ViewerTools
EXPORTS SystemNuts =

BEGIN OPEN DB, NutViewer, 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 OPEN NutViewer;
Menus.AppendMenuEntry[
displayerMenu, MakeMenuEntry[DBQueue[], "Edit", EditProc]];
Menus.AppendMenuEntry[
displayerMenu, MakeMenuEntry[DBQueue[], "Freeze", DefaultFreezeProc]];
Menus.AppendMenuEntry[
displayerMenu, MakeMenuEntry[DBQueue[], "ShowDomainInfo", ShowDomainInfoProc]];
Menus.AppendMenuEntry[
editorMenu, MakeMenuEntry[DBQueue[], "Erase", EraseProc]];
Menus.AppendMenuEntry[
editorMenu, MakeMenuEntry[DBQueue[], "Rename", RenameProc]];
Menus.AppendMenuEntry[
editorMenu, MakeMenuEntry[DBQueue[], "Save", SaveProc]];
Menus.AppendMenuEntry[
editorMenu, MakeMenuEntry[DBQueue[], "Reset", ResetProc]];
END;

EditProc: Menus.MenuProc = {
-- Copied from NutDefaultImpl.EditDisplayerProc
viewer: Viewer = NARROW[parent];
dInfo: DomainInfo = NARROW[ ViewerOps.FetchProp[viewer, $DomainInfo] ];
seg: DB.Segment = dInfo.segment;
dName: ROPE = dInfo.dName;
InputFocus.SetInputFocus[];
[] ← Nut.Edit[d: DomainDomain, eName: dName, parent: viewer, method: replace, seg: seg]};

ShowDomainInfoProc: Menus.MenuProc = {
-- Replace client portion of window, to show entities instead of schema info for domain,
-- or vice versa.
vp: Viewer = NARROW[parent];
mode: ATOM← NARROW[ ViewerOps.FetchProp[vp, $DisplayMode]];
dInfo: DomainInfo = NARROW[ ViewerOps.FetchProp[vp, $DomainInfo]];
vp.child← NIL; -- Throw away children
IF mode=$Entities AND NOT NutOps.IsSystemDomain[dInfo.domain] THEN {
vp.scrollable← TRUE;
ViewerOps.AddProp[vp, $DisplayMode, $Info];
[]← BuildInfoWindowButtons[NutViewer.Initialize[vp], dInfo.domain]
}
ELSE {
vp.scrollable← FALSE;
ViewerOps.AddProp[vp, $DisplayMode, $Entities];
ShowEntitiesInWindow[vp, dInfo.domain, dInfo.segment];
};
ViewerOps.EstablishViewerPosition[vp, vp.wx, vp.wy, vp.ww, vp.wh];
ViewerOps.PaintViewer[viewer: vp, hint: client, clearClient: TRUE];
};

DomainQueryer: PUBLIC Nut.QueryProc =
BEGIN
Message[NIL, "Domain queryers not implemented!"];
END;

----------------------------
DomainCreate: PUBLIC Nut.CreateProc = {
-- Need our own create proc in order to set scrollable bit correctly. Foo.
segment: DB.Segment = IF NutOps.IsSystemDomain[d] THEN seg ELSE SegmentOf[d];
defaultLabel: ROPE = Rope.Cat[ NameOf[d], ": ", eName,
IF Nut.debug THEN Rope.Cat[ " (", Atom.GetPName[segment], " segment)" ] ELSE NIL ];
info: ViewerClasses.ViewerRec = [
name: defaultLabel,
iconic: FALSE,
scrollable: eName.Equal["Domain"] OR eName.Equal["Relation"] OR NOT nutType=displayer,
column: column];
RETURN[ViewerOps.CreateViewer[flavor: $Container, info: info, paint: FALSE]]
};

DomainDisplayer: PUBLIC Nut.DisplayProc =
BEGIN
dInfo: DomainInfo = NEW[ DomainInfoRecord ];
ViewerOps.SetMenu[newV, displayerMenu];
dInfo.dName ← NameOf[e];
dInfo.segment ← seg;
dInfo.domain ← e;
ViewerOps.AddProp[newV, $DomainInfo, dInfo];
ViewerOps.AddProp[newV, $Domain, DB.DomainDomain];
ViewerOps.AddProp[newV, $Implementor, $Squirrel ];
ViewerOps.AddProp[newV, $DisplayMode, $Entities ];
ShowEntitiesInWindow[newV, e, seg];
ViewerOps.PaintViewer[newV, client];
END;

BuildInfoWindowButtons: PROC[
lastViewer: Viewer, e: Entity] RETURNS[newLastViewer: Viewer]=
-- Display information about domain if showDomainInfo, else show entities.
BEGIN rs: RelshipSet; r: Relship; other: Domain;
myAttrs: AttributeList = GetDomainRefAttributes[e];
lastViewer← NutViewer.MakeLabel[
name: "* Relation / attribute / uniqueness for attributes that reference this domain *",
sib: lastViewer];
FOR alT: AttributeList← myAttrs, alT.rest UNTIL alT=NIL DO
lastViewer← NutViewer.MakeButton[
  q: NutViewer.DBQueue[], name: GetName[V2E[GetP[alT.first, aRelationIs]]],
  proc: ProcessAttributeSelection,
  data: NEW[AttributeFieldObject← [alT.first, aRelationIs]],
  sib: lastViewer, newLine: TRUE];
lastViewer← NutViewer.MakeButton
  [q: NutViewer.DBQueue[], name: GetName[alT.first], proc: ProcessAttributeSelection,
  data: NEW[AttributeFieldObject← [alT.first, NIL]], sib: lastViewer];
lastViewer← NutViewer.MakeButton[
  q: NutViewer.DBQueue[], name: GetName[V2E[GetP[alT.first, aTypeIs]]],
  proc: ProcessAttributeSelection,
  data: NEW[AttributeFieldObject← [alT.first, aTypeIs]], sib: lastViewer];
lastViewer← NutViewer.MakeButton[
  q: NutViewer.DBQueue[], name: NutOps.GetUniquenessString[alT.first],
  proc: ProcessAttributeSelection,
  data: NEW[AttributeFieldObject← [alT.first, NIL]], sib: lastViewer];
ENDLOOP;
lastViewer← NutViewer.MakeLabel["* Related domains *", lastViewer, TRUE];
rs← RelationSubset[dSubType, LIST[[dSubTypeIs, e]]];
UNTIL Null[r← NextRelship[rs]] DO
other← V2E[GetF[r, dSubTypeOf]];
lastViewer← NutViewer.MakeLabel["Supertype:", lastViewer, TRUE];
lastViewer← NutViewer.MakeButton[
  q: NutViewer.DBQueue[], name: GetName[other], proc: ProcessEntitySelection,
  data: other, sib: lastViewer];
ENDLOOP;
ReleaseRelshipSet[rs];
rs← RelationSubset[dSubType, LIST[[dSubTypeOf, e]]];
UNTIL Null[r← NextRelship[rs]] DO
other← V2E[GetF[r, dSubTypeIs]];
lastViewer← NutViewer.MakeLabel["Subtype:", lastViewer, TRUE];
lastViewer← NutViewer.MakeButton[
  q: NutViewer.DBQueue[], name: GetName[other], proc: ProcessEntitySelection,
  data: other, sib: lastViewer];
ENDLOOP;
ReleaseRelshipSet[rs];
RETURN[lastViewer]
END;

ShowEntitiesInWindow: PROC[parent: Viewer, e: Entity, seg: Segment] =
-- Display all the entities in domain e
BEGIN
count: INT← 0;
lastViewer: Viewer;
myEntities: EntitySet;
IF Eq[e, DomainDomain] THEN {
lastViewer ← NutViewer.Initialize[parent];
lastViewer ← NewEntity[DataTypeDomain, lastViewer];
lastViewer ← NewEntity[RelationDomain, lastViewer];
myEntities ← DomainSubset[d: e, searchSegment: seg];
UNTIL Null[e← NextEntity[myEntities]] DO
lastViewer← NewEntity[e, lastViewer] ENDLOOP;
ReleaseEntitySet[myEntities];
RETURN};
IF Eq[e, RelationDomain] THEN {
lastViewer ← NutViewer.Initialize[parent];
myEntities ← DomainSubset[d: e, searchSegment: seg];
UNTIL Null[e← NextEntity[myEntities]] DO
lastViewer← NewEntity[e, lastViewer] ENDLOOP;
ReleaseEntitySet[myEntities];
RETURN};
IF Eq[e, DataTypeDomain] THEN {
lastViewer ← NutViewer.Initialize[parent];
lastViewer ← NewEntity[RopeType, lastViewer];
lastViewer ← NewEntity[IntType, lastViewer];
lastViewer ← NewEntity[BoolType, lastViewer];
lastViewer ← NewEntity[TimeType, lastViewer];
RETURN};
IF Eq[e, AttributeDomain] OR Eq[e, IndexDomain] OR Eq[e, IndexFactorDomain] THEN
RETURN;
parent.scrollable← FALSE; -- Scrollbar will be provided by MBWindow
lastViewer← MBWindows.CreateMBWindow[
count: GetThingCount,
thumb: DomainThumb,
next: DomainNextProc,
prev: DomainPrevProc,
buttonProc: ProcessEntitySelection,
info: [parent: parent, wx: 0, wy: 0, ww: parent.ww, wh: 800, border: FALSE],
q: NIL ];
Containers.ChildYBound[container: parent, child: lastViewer];
END;

GetThingCount: MBWindows.CountProc = {
parent: Viewer← GetTopLevel[v];
dInfo: DomainInfo← NARROW[ ViewerOps.FetchProp[parent, $DomainInfo] ];
SELECT TRUE FROM
dInfo.dName.Equal["Person"] => RETURN[1000];
dInfo.dName.Equal["Organization"] => RETURN[500];
ENDCASE => RETURN[EntitySetSize[DomainSubset[dInfo.domain, "", "\177"], FALSE]];
};

EntitySetSize: PROC [awesome: EntitySet, forSure: BOOL] RETURNS [totally: INT] = {
-- Estimate total size of an EntitySet. If it's larger than 100, just guess 500.
totally← 0;
UNTIL DB.NextEntity[awesome]=NIL DO
IF (totally← totally+1)>100 AND NOT forSure THEN {totally← 500; EXIT}; -- just estimate
ENDLOOP;
DB.ReleaseEntitySet[awesome];
RETURN[totally]
};

DomainNextProc: MBWindows.EnumProc = TRUSTED
BEGIN es: EntitySet← LOOPHOLE[enum];
e: Entity← NextEntity[es];
RETURN[IF e=NIL THEN NIL ELSE NameOf[e], e];
END;

DomainPrevProc: MBWindows.EnumProc = TRUSTED
BEGIN es: EntitySet← LOOPHOLE[enum];
e: Entity← PrevEntity[es];
RETURN[IF e=NIL THEN NIL ELSE NameOf[e], e];
END;

DomainThumb: MBWindows.ThumbProc = TRUSTED
BEGIN es: EntitySet← LOOPHOLE[enum];
dInfo: DomainInfo = NARROW[ViewerOps.FetchProp[GetTopLevel[v], $DomainInfo]];
DB.ReleaseEntitySet[es];
IF where<10 THEN
es← DB.DomainSubset[dInfo.domain, "", "\177", First]
ELSE IF where>90 THEN {
es← DB.DomainSubset[dInfo.domain, "", "\177", Last];
[]← PrevEntity[es]; []← PrevEntity[es]; []← PrevEntity[es]}
ELSE {
-- Get there the hard way, though NextEntity calls
es← DB.DomainSubset[dInfo.domain, "", "\177", First];
THROUGH [0..where*GetThingCount[v, es]/100) DO []← NextEntity[es] ENDLOOP;
};
RETURN[es]
END;

NewEntity
: PROC[e: Entity, sib: Viewer] RETURNS[Viewer] =
{RETURN[NutViewer.MakeButton[
  q: NutViewer.DBQueue[], name: GetName[e], proc: ProcessEntitySelection,
  data: e, sib: sib, newLine: TRUE]]};

GetTopLevel: PROCEDURE [v: Viewer] RETURNS [ancestor: Viewer] = {
FOR ancestor ← v, ancestor.parent UNTIL ancestor.parent=NIL DO ENDLOOP;
};
ProcessEntitySelection: Buttons.ButtonProc =
-- Used with MBWindows buttons
BEGIN
 e: Entity = V2E[clientData];
 viewer: Viewer = GetTopLevel[NARROW[parent]];
 dInfo: DomainInfo = NARROW[ ViewerOps.FetchProp[viewer, $DomainInfo] ];
 IF e=NIL THEN RETURN; -- really not a button
 []← Nut.Display[e: e, parent: viewer, seg: dInfo.segment]
END;

ProcessAttributeSelection: Buttons.ButtonProc =
BEGIN
 fd: AttributeFieldHandle = NARROW[clientData];
 v: Viewer = NARROW[parent];
 dInfo: DomainInfo = NARROW[ ViewerOps.FetchProp[v.parent, $DomainInfo] ];
IF fd.property = NIL THEN Message[v, "Not an entity-valued field"]
ELSE
[]← Nut.Display[ e: V2E[GetP[fd.attribute, fd.property]], parent: v.parent, seg: dInfo.segment];
END;

RenameProc: Menus.MenuProc =
BEGIN
  viewer: Viewer = NARROW[parent];
dInfo: DomainInfo = NARROW[ViewerOps.FetchProp[viewer, $DomainInfo]];
dInfo.dName← ViewerTools.GetSelectionContents[];
IF dInfo.domain#NIL THEN SetName[dInfo.domain, dInfo.dName];
viewer.name← Rope.Cat["Domain: ", dInfo.dName];
ViewerOps.PaintViewer[viewer, caption];
END;

ResetProc: Menus.MenuProc =
BEGIN
viewer: Viewer = NARROW[parent];
dInfo: DomainInfo = NARROW[ViewerOps.FetchProp[viewer, $DomainInfo]];
viewer.child ← NIL;
ViewerOps.PaintViewer[viewer, client];
DomainEditor[DomainDomain, dInfo.dName, viewer, dInfo.segment];
END;

SaveProc: Menus.MenuProc =
BEGIN
  viewer: Viewer = NARROW[parent];
dInfo: DomainInfo = NARROW[ViewerOps.FetchProp[viewer, $DomainInfo]];
SaveDomain[viewer];
END;

EraseProc: Menus.MenuProc =
BEGIN
viewer: Viewer = NARROW[parent];
dInfo: DomainInfo = NARROW[ViewerOps.FetchProp[viewer, $DomainInfo]];
name: ROPE = IF dInfo # NIL THEN dInfo.dName ELSE NIL;
domain: Domain = IF name # NIL THEN
      DeclareDomain[name, dInfo.segment, OldOnly] ELSE NIL;
subTypes: BOOLEANFALSE;
IF domain = NIL THEN RETURN;
DestroyDomain[domain ! DB.Error =>
{ IF code = NotImplemented THEN {subTypes ← TRUE; CONTINUE} }];
IF subTypes THEN
 {Message[viewer, "You must delete the subtypes first."]; RETURN}
END;


-- Domain Editor --

DomainEditor: PUBLIC Nut.EditProc = -- d: Domain, eName: ROPE, newV: Viewer
BEGIN
rope: ROPE;
rs: RelshipSet;
lastV: Viewer;
relation: Relation;
info: DomainInfo = NEW[DomainInfoRecord];
subTypeRS: Relship;
isAttribute: Attribute;
list: LIST OF Attribute;
attributes: AttributeList;
segment: Segment = seg;
IF Rope.Equal[eName, "Domain", FALSE] THEN {
[] ← Nut.Edit[d, "NEW", segment, newV]; RETURN};
IF Rope.Equal[eName, "Relation", FALSE] THEN {
[] ← Nut.Edit[RelationDomain, "NEW", segment, newV]; RETURN};
IF Rope.Equal[eName, "Attribute", FALSE] OR Rope.Equal[eName, "DataType", FALSE]
THEN {[] ← NutViewer.Message[NIL,
eName, " is a system entity. You may not edit it."]; RETURN};
ViewerOps.SetMenu[newV, editorMenu];
lastV← NutViewer.Initialize[newV];
info.segment ← segment;
info.domain ← FetchEntity[d, eName, segment];
lastV ← NutViewer.MakeLabel["", lastV];
lastV ← NutViewer.MakeLabel["superTypes:", lastV, FALSE];
info.superTypes← lastV ← NutViewer.NextRightTextViewer[lastV, 400];
lastV ← NutViewer.MakeLabel["subTypes:", lastV, TRUE];
info.subTypes ← NutViewer.NextRightTextViewer[lastV, 400];
lastV ← NutViewer.MakeButton[
q: NutViewer.DBQueue[], name: "NEW PROPERTY", proc: NewAttribute, sib: lastV,
border: TRUE, newLine: TRUE];
IF info.domain = NIL THEN {ViewerOps.AddProp[newV, $DomainInfo, info]; RETURN};
-- print the subtypes of the domain
rope ← NIL;
rs ← RelationSubset[dSubType, LIST[[dSubTypeOf, info.domain]]];
WHILE (subTypeRS ← NextRelship[rs]) # NIL DO
IF rope # NIL THEN rope ← Rope.Concat[rope, ", "];
rope ← Rope.Concat[rope, GetFS[subTypeRS, dSubTypeIs]];
ENDLOOP;
ReleaseRelshipSet[rs];
SetContents[info.subTypes, rope];
info.subTypes.newVersion ← FALSE;
-- Print the supertypes of the domain
rope ← NIL;
rs ← RelationSubset[dSubType, LIST[[dSubTypeIs, info.domain]]];
WHILE (subTypeRS ← NextRelship[rs]) # NIL DO
IF rope # NIL THEN rope ← Rope.Concat[rope, ", "];
rope ← Rope.Concat[rope, GetFS[subTypeRS, dSubTypeOf]];
ENDLOOP;
ReleaseRelshipSet[rs];
SetContents[info.superTypes, rope];
info.superTypes.newVersion ← FALSE;
-- Print the current properties
list ← NutOps.GetRefAttributes[info.domain];
FOR list ← list, list.rest WHILE list # NIL DO -- find all of the "of" attributes
IF Null[list.first] THEN LOOP;
IF ~Rope.Equal[GetName[list.first], "of"] THEN LOOP;
IF ~Eq[V2E[GetP[list.first, aTypeIs]], info.domain] THEN LOOP; -- skip superclasses
IF LOOPHOLE[V2U[GetP[list.first, aUniquenessIs]], Uniqueness] # Key THEN LOOP;
-- We have a likely candidate
relation ← NutOps.GetRelation[list.first];
attributes ← NutOps.AttributesOf[relation];
IF attributes = NIL OR attributes.rest = NIL OR attributes.rest.rest # NIL THEN LOOP;
isAttribute ← NIL;
IF Rope.Equal[GetName[attributes.first], "is"] THEN isAttribute ← attributes.first;
IF Rope.Equal[GetName[attributes.rest.first], "is"] THEN isAttribute ← attributes.rest.first;
IF isAttribute = NIL THEN LOOP;
info.properties ← CONS[DisplayAttribute[relation, isAttribute, lastV], info.properties];
lastV ← info.properties.first.length;
ENDLOOP;
info.properties ← Reverse[info.properties];
ViewerOps.AddProp[newV, $DomainInfo, info];
ViewerOps.AddProp[newV, $Domain, DB.DomainDomain];
ViewerOps.AddProp[newV, $Implementor, $Squirrel ];
END;

SaveDomain: PROCEDURE[viewer: Viewer] =
BEGIN
new: Domain;
info: DomainInfo;
ok, copy: BOOLEANTRUE;
info ← NARROW[ViewerOps.FetchProp[viewer, $DomainInfo]];
-- Will we have to copy the domain?
IF info.domain = NIL THEN copy ← TRUE
ELSE IF ~Optimized[info.domain] THEN copy ← FALSE
ELSE {subType: ROPE;
[subType, , ] ← NextName[GetContents[info.subTypes]];
copy ← (subType.Length[] # 0)};
IF copy THEN new ← DeclareDomain[NIL, info.segment] ELSE new ← info.domain;
-- Check to see if this is a legal edit
IF ~CheckTypeList[GetContents[info.superTypes], info.segment] THEN ok ← FALSE;
IF ~CheckTypeList[GetContents[info.subTypes], info.segment] THEN ok ← FALSE;
FOR list: LIST OF AttributeInfo ← info.properties, list.rest WHILE list # NIL DO
IF ~CheckProperty[new, list.first, info.deleted] THEN ok ← FALSE;
ENDLOOP;
IF ~ok THEN {IF copy THEN DestroyDomain[new]; RETURN};
-- WE ARE COMMITTED BEYOND THIS POINT
-- handle the SubTypeRelations
IF info.domain # NIL THEN
{RemoveSubTypes[info.domain]; RemoveSuperTypes[info.domain]};
AddSubTypes[new, GetContents[info.subTypes], info.segment];
AddSuperTypes[new, GetContents[info.superTypes], info.segment];
-- Insert the new properties
FOR list: LIST OF AttributeInfo ← info.properties, list.rest WHILE list # NIL DO
info.deleted ← RemoveDeleted[list.first, info.deleted];
SaveProperty[new, list.first];
ENDLOOP;
-- Destroy the properties deleted by the user
FOR list: LIST OF Relation ← info.deleted, list.rest WHILE list # NIL DO
DestroyRelation[list.first];
ENDLOOP;
-- Copy the domain's contents
IF info.domain # NIL AND copy THEN {
Schema.CopyDomainContents[info.domain, new];
RemoveSubTypes[info.domain];
DestroyDomain[info.domain]};
SetName[new, info.dName];
viewer.child ← NIL;
ViewerOps.AddProp[viewer, $DomainInfo, NIL];
[] ← Nut.Display[e: new, parent: viewer, method: replace, seg: info.segment];
END;

CheckTypeList: PROCEDURE[types: ROPE, seg: Segment] RETURNS[ok: BOOLEANTRUE] =
BEGIN
d: Domain;
type: ROPE;
WHILE types.Length[] > 0 DO
[type, types, ok] ← NextName[types];
IF ~ok THEN EXIT;
IF type.Length[] = 0 THEN LOOP;
d ← FetchEntity[DomainDomain, type, seg];
IF d # NIL THEN LOOP;
NutViewer.Message[NIL, Rope.Cat["Bad type: ", type]];
RETURN[FALSE];
ENDLOOP;
IF ~ok THEN NutViewer.Message[NIL, "Bad type list."];
END;

RemoveSubTypes: PROCEDURE[d: Domain] =
BEGIN
rs: RelshipSet;
subTypeRS: Relship;
rs ← RelationSubset[dSubType, LIST[[dSubTypeOf, d]]];
WHILE (subTypeRS ← NextRelship[rs]) # NIL DO
DestroySubType[of: d, is: V2E[GetF[subTypeRS, dSubTypeIs]]];
ENDLOOP;
ReleaseRelshipSet[rs];
END;

RemoveSuperTypes: PROCEDURE[d: Domain] =
BEGIN
rs: RelshipSet;
subTypeRS: Relship;
rs ← RelationSubset[dSubType, LIST[[dSubTypeIs, d]]];
WHILE (subTypeRS ← NextRelship[rs]) # NIL DO
DestroySubType[is: d, of: V2E[GetF[subTypeRS, dSubTypeOf]]];
ENDLOOP;
ReleaseRelshipSet[rs];
END;

AddSuperTypes: PROCEDURE[d: Domain, types: ROPE, seg: Segment] =
BEGIN
type: ROPE;
new: Domain;
superType: Domain;
WHILE types.Length[] > 0 DO
[type, types, ] ← NextName[types];
IF type.Length[] = 0 THEN LOOP;
superType ← FetchEntity[DomainDomain, type, seg];
DeclareSubType[of: superType, is: d
! DB.Error => IF code=NotImplemented THEN RESUME]; -- we know better than DB!
IF ~Optimized[superType] THEN LOOP;
new ← DeclareDomain[NIL, SegmentOf[d]];
Schema.CopyDomainContents[superType, new];
RemoveSubTypes[superType];
DestroyDomain[superType];
SetName[new, type];
ENDLOOP;
END;

AddSubTypes: PROCEDURE[d: Domain, types: ROPE, seg: Segment] =
BEGIN
type: ROPE;
subType: Domain;
WHILE types.Length[] > 0 DO
[type, types, ] ← NextName[types];
IF type.Length[] = 0 THEN LOOP;
subType ← FetchEntity[DomainDomain, type, seg];
DeclareSubType[of: d, is: subType
! DB.Error => IF code=NotImplemented THEN RESUME]; -- we know better than DB!
ENDLOOP;
END;

DomainQuery: PUBLIC Nut.QueryProc = { Nut.DefaultQuery[d, newV, segment] };

-- Start code
BuildMenus[];

END.