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