XTkContainersImpl.mesa
Copyright Ó 1988, 1991, 1992 by Xerox Corporation. All rights reserved.
Created by Christian Jacobi, October 18, 1988 11:22:01 am PDT
Christian Jacobi, May 11, 1993 11:46 am PDT
DIRECTORY
Xl,
XTk,
XTkCollections,
XTkContainers,
XTkFriends;
XTkContainersImpl: CEDAR MONITOR
IMPORTS XTk, XTkCollections, XTkFriends
EXPORTS XTkContainers =
BEGIN OPEN XTkContainers;
exceptWidth: XTk.GeometryRequest = [TRUE, TRUE, FALSE, TRUE, TRUE];
exceptHeight: XTk.GeometryRequest = [TRUE, TRUE, TRUE, FALSE, TRUE];
yStack: PUBLIC XTk.Class ¬ XTkFriends.CreateClass[[super: XTkCollections.collectionClass, key: $yStack, removeChildLR: XTkCollections.RemoveChildAndSqueezeLR, preferredSizeLR: YPreferredSizeLR, configureLR: YConfigureLR]];
xStack: PUBLIC XTk.Class ¬ XTkFriends.CreateClass[[super: XTkCollections.collectionClass, key: $xStack, removeChildLR: XTkCollections.RemoveChildAndSqueezeLR, preferredSizeLR: XPreferredSizeLR, configureLR: XConfigureLR]];
container: PUBLIC XTk.Class ¬ XTkFriends.CreateClass[[super: XTkCollections.collectionClass, key: $container, removeChildLR: XTkCollections.RemoveChildAndSqueezeLR, preferredSizeLR: ContPreferredSizeLR, configureLR: ContConfigureLR]];
CreateContainer: PUBLIC PROC [widgetSpec: WidgetSpec ¬ [], children: LIST OF Widget ¬ NIL] RETURNS [widget: Widget] = {
widgetSpec.class ¬ XTkFriends.InitClassField[widgetSpec.class, container];
widget ¬ XTkCollections.Create[widgetSpec, children];
};
RemoveChild: PUBLIC PROC [container: ContainerWidget, child: Widget, destroyChild: BOOL ¬ TRUE, startReconfigure: BOOL ¬ TRUE] = {
XTkCollections.RemoveChild[container, child, startReconfigure, ~destroyChild]
};
AppendChild: PUBLIC PROC [container: Widget, child: Widget, startReconfigure: BOOL ¬ TRUE] = {
XTkCollections.AddChild[container, child, NIL, startReconfigure]
};
AppendChildren: PUBLIC PROC [container: Widget, children: LIST OF Widget, startReconfigure: BOOL] = {
XTkCollections.AddChildren[container, children, startReconfigure];
};
SetForce: PUBLIC PROC [container: ContainerWidget, force: INT] = {
ip: XTkCollections.CollectionInstPart ~ XTkCollections.GetCollectionInstPart[container];
IF force#-1 THEN ip.reserved ¬ NEW[INT¬force] ELSE ip.reserved ¬ NIL;
};
CreateXStack: PUBLIC PROC [widgetSpec: WidgetSpec, stack: LIST OF Widget ¬ NIL, force: INT ¬ -1] RETURNS [widget: Widget] = {
widgetSpec.class ¬ XTkFriends.InitClassField[widgetSpec.class, xStack];
widget ¬ XTkCollections.Create[widgetSpec, stack];
SetForce[widget, force];
};
CreateYStack: PUBLIC PROC [widgetSpec: WidgetSpec, stack: LIST OF Widget ¬ NIL, force: INT ¬ -1] RETURNS [widget: Widget] = {
widgetSpec.class ¬ XTkFriends.InitClassField[widgetSpec.class, yStack];
widget ¬ XTkCollections.Create[widgetSpec, stack];
SetForce[widget, force];
};
CreateAbut: PUBLIC PROC [widgetSpec: WidgetSpec ¬ [], children: LIST OF Widget ¬ NIL, orient: Orientation, force: INT ¬ -1] RETURNS [widget: ContainerWidget] = {
SELECT orient FROM
inX => {widgetSpec.class ¬ XTkFriends.InitClassField[widgetSpec.class, xStack]};
inY => {widgetSpec.class ¬ XTkFriends.InitClassField[widgetSpec.class, yStack]};
ENDCASE => ERROR;
widget ¬ XTkCollections.Create[widgetSpec, children];
SetForce[widget, force];
};
DefineBorders: PROC [widget: XTk.Widget] = {
EachChild: XTkCollections.EachChildProc = {
--forget dynamic borders; its not worth the troubles--
IF child.actual.borderWidth<0 THEN
child.actual.borderWidth ¬ widget.actual.borderWidth;
};
IF widget.actual.borderWidth<0 THEN {
IF widget.parent#NIL THEN
widget.actual.borderWidth ¬ widget.parent.actual.borderWidth;
IF widget.actual.borderWidth<0 THEN
widget.actual.borderWidth ¬ 0;
};
XTkCollections.BasicEnumerateChildren[widget, EachChild];
};
GetForce: PROC [widget: Widget] RETURNS [INT¬-1] = {
ip: XTkCollections.CollectionInstPart ~ XTkCollections.GetCollectionInstPart[widget];
WITH ip.reserved SELECT FROM
ri: REF INT => RETURN [ri­];
ENDCASE => {};
};
AddPos: PROC [gr: XTk.GeometryRequest] RETURNS [XTk.GeometryRequest] = {
gr[x] ¬ TRUE; gr[y] ¬ TRUE;
RETURN [gr]
};
YPreferredSizeLR: XTk.PreferredSizeProc = {
force: INT ¬ -1;
EachChild: XTkCollections.EachChildProc = {
b: INT ¬ XTk.BorderWidth[child];
g: Xl.Geometry ¬ child.s.geometry;
IF child.s.mapping=unmapped THEN RETURN;
g.borderWidth ¬ b;
g.size.width ¬ proposed.size.width;
g ¬ XTkFriends.PreferredSizeLR[widget: child, proposed: g, maySkip: maySkip];
IF force>0 THEN g.size.height ¬ MAX[force-2*b, 1];
IF g.size.height<=0 THEN g.size.height ¬ 20;
preferred.size.width ¬ MAX[preferred.size.width, g.size.width];
preferred.size.height ¬ preferred.size.height + g.size.height + 2*b;
};
IF widget.s.geometry.size.width>0 THEN maySkip[w] ¬ TRUE;
IF widget.s.geometry.size.height>0 THEN maySkip[h] ¬ TRUE;
IF maySkip[w] AND maySkip[h] THEN RETURN [widget.s.geometry];
preferred ¬ [
size: [0, 0],
pos: widget.s.geometry.pos,
borderWidth: widget.s.geometry.borderWidth
];
force ¬ GetForce[widget];
maySkip ¬ AddPos[maySkip];
XTkCollections.BasicEnumerateChildren[widget, EachChild];
IF widget.s.geometry.size.width>0 THEN preferred.size.width ¬ widget.s.geometry.size.width;
IF widget.s.geometry.size.height>0 THEN preferred.size.height ¬ widget.s.geometry.size.height;
};
XPreferredSizeLR: XTk.PreferredSizeProc = {
force: INT ¬ -1;
EachChild: XTkCollections.EachChildProc = {
b: INT ¬ XTk.BorderWidth[child];
g: Xl.Geometry ¬ child.s.geometry;
IF child.s.mapping=unmapped THEN RETURN;
g.borderWidth ¬ b;
g.size.height ¬ proposed.size.height;
g ¬ XTkFriends.PreferredSizeLR[widget: child, proposed: g, maySkip: maySkip];
IF force>0 THEN g.size.width ¬ MAX[force-2*b, 1];
IF g.size.width<=0 THEN g.size.width ¬ 20;
preferred.size.height ¬ MAX[preferred.size.height, g.size.height];
preferred.size.width ¬ preferred.size.width + g.size.width + 2*b;
};
IF widget.s.geometry.size.width>0 THEN maySkip[h] ¬ TRUE;
IF widget.s.geometry.size.height>0 THEN maySkip[w] ¬ TRUE;
IF maySkip[w] AND maySkip[h] THEN RETURN [widget.s.geometry];
preferred ¬ [
size: [0, 0],
pos: widget.s.geometry.pos,
borderWidth: widget.s.geometry.borderWidth
];
force ¬ GetForce[widget];
maySkip ¬ AddPos[maySkip];
XTkCollections.BasicEnumerateChildren[widget, EachChild];
IF widget.s.geometry.size.width>0 THEN preferred.size.width ¬ widget.s.geometry.size.width;
IF widget.s.geometry.size.height>0 THEN preferred.size.height ¬ widget.s.geometry.size.height;
};
ContPreferredSizeLR: XTk.PreferredSizeProc = {
EachChild: XTkCollections.EachChildProc = {
b: INT ¬ XTk.BorderWidth[child];
g: Xl.Geometry ¬ [size: proposed.size, pos: child.actual.pos, borderWidth: b];
IF child.s.mapping=unmapped THEN RETURN;
g ¬ XTkFriends.PreferredSizeLR[widget: child, proposed: g, maySkip: maySkip];
IF g.size.width<=0 THEN g.size.width ¬ 1;
IF g.size.height<=0 THEN g.size.height ¬ 1;
IF g.pos.x=XTk.dontUse THEN g.pos.x ¬ child.actual.pos.x;
IF g.pos.y=XTk.dontUse THEN g.pos.y ¬ child.actual.pos.y;
preferred.size.width ¬ MAX[preferred.size.width, g.pos.x + g.size.width + b*2];
preferred.size.height ¬ MAX[preferred.size.height, g.pos.y + g.size.height + b*2];
};
IF widget.s.geometry.size.width>0 THEN maySkip[w] ¬ TRUE;
IF widget.s.geometry.size.height>0 THEN maySkip[h] ¬ TRUE;
IF maySkip[w] AND maySkip[h] THEN RETURN [widget.s.geometry];
preferred ¬ [
size: [0, 0],
pos: widget.s.geometry.pos,
borderWidth: widget.s.geometry.borderWidth
];
XTkCollections.BasicEnumerateChildren[widget, EachChild];
IF widget.s.geometry.size.width>0 THEN preferred.size.width ¬ widget.s.geometry.size.width;
IF widget.s.geometry.size.height>0 THEN preferred.size.height ¬ widget.s.geometry.size.height;
};
YConfigureLR: XTk.ConfigureProc = {
existW: BOOL ¬ widget.actualMapping<unconfigured;
createW: BOOL ¬ mapping<unconfigured AND ~existW;
IF createW THEN DefineBorders[widget];
XTkFriends.SimpleConfigureOneLevelLR[widget, geometry, mapping];
IF existW OR createW THEN YSizingLR[widget, reConsiderChildren OR createW];
};
XConfigureLR: XTk.ConfigureProc = {
existW: BOOL ¬ widget.actualMapping<unconfigured;
createW: BOOL ¬ mapping<unconfigured AND ~existW;
IF createW THEN DefineBorders[widget];
XTkFriends.SimpleConfigureOneLevelLR[widget, geometry, mapping];
IF existW OR createW THEN XSizingLR[widget, reConsiderChildren OR createW];
};
ContConfigureLR: XTk.ConfigureProc = {
existW: BOOL ¬ widget.actualMapping<unconfigured;
createW: BOOL ¬ mapping<unconfigured AND ~existW;
IF createW THEN {
DefineBorders[widget];
IF widget.attributes.backgroundPixel=Xl.illegalPixel THEN
widget.attributes.backgroundPixel ¬ widget.screenDepth.screen.whitePixel
};
XTkFriends.SimpleConfigureOneLevelLR[widget, geometry, mapping];
IF existW OR createW THEN {
ContSizingLR[widget, reConsiderChildren OR createW];
};
};
MyCount: PROC [widget: Widget] RETURNS [n: NAT ¬ 0, lastChild: Widget ¬ NIL] = {
EachChild: XTkCollections.EachChildProc = {
IF child.s.mapping#unmapped THEN {n ¬ n+1; lastChild ¬ child}
};
XTkCollections.BasicEnumerateChildren[widget, EachChild];
};
XCount: PROC [widget: Widget, reConsiderChildren: BOOL] RETURNS [mapCount: NAT ¬ 0, considerCount: NAT ¬ 0, lastChild: Widget ¬ NIL] = {
--Special count procedure used for YSizingLR and XSizingLR
EachChild: XTkCollections.EachChildProc = {
IF child.state#realized AND ~reConsiderChildren THEN RETURN;
IF child.s.mapping#unmapped THEN {mapCount ¬ mapCount+1; lastChild ¬ child};
considerCount ¬ considerCount+1;
};
XTkCollections.BasicEnumerateChildren[widget, EachChild];
};
OldYSizingLR: PROC [widget: Widget, reConsiderChildren: BOOL] = {
force: INT ¬ GetForce[widget];
count: INT; lastChild: Widget;
pos: Xl.Point ¬ [0, 0];
fixCommon: BOOL = TRUE;
EachChild: XTkCollections.EachChildProc = {
g: Xl.Geometry ¬ [];
IF child.state#realized<<or in progress@@>> AND ~reConsiderChildren THEN RETURN;
IF child.s.mapping=mapped THEN {
g ¬ XTkFriends.PreferredSizeLR[widget: child, proposed: child.actual, maySkip: exceptHeight];
g.pos ¬ pos;
IF g.borderWidth<0 THEN g.borderWidth ¬ 0;
IF fixCommon OR g.size.width<=0 THEN {
g.size.width ¬ widget.actual.size.width - g.borderWidth*2;
};
IF force>0 THEN g.size.height ¬ MAX[1, force - g.borderWidth*2];
IF g.size.height<=0 THEN g.size.height ¬ 20;
IF g.size.width<=0 THEN g.size.width ¬ 1;
IF g.borderWidth<0 THEN g.borderWidth ¬ 0;
IF child=lastChild THEN {
g.size.height ¬ MAX[widget.actual.size.height-pos.y-g.borderWidth*2, 1];
};
};
XTkFriends.ConfigureLR[child, g, child.s.mapping, reConsiderChildren];
IF child.actualMapping=mapped THEN pos.y ¬ pos.y+g.size.height+2*g.borderWidth;
};
IF reConsiderChildren THEN XTk.SetWidgetFlag[widget, XTk.mustReConsiderChildren, FALSE];
[count, lastChild] ¬ MyCount[widget];
IF count>0 AND force=0 THEN {
force ¬ MAX[1, widget.actual.size.height / count];
};
XTkCollections.BasicEnumerateChildren[widget, EachChild];
};
YSizingLR: PROC [widget: Widget, reConsiderChildren: BOOL] = {
cd: REF MyConfigureData ¬ NIL;
force: INT ¬ GetForce[widget];
mapCount: INT; allCount: INT; index: INT ¬ 0;
varyingCount: INT ¬ 0; lastChild: Widget;
pos: Xl.Point ¬ [0, 0];
fixCommon: BOOL = TRUE;
FirstPassPerChild: XTkCollections.EachChildProc = {
--used in first pass to get ideal geometry
g: Xl.Geometry ¬ child.actual;
IF child.state#realized AND ~reConsiderChildren THEN RETURN;
IF child.s.mapping=dontUse THEN child.s.mapping ¬ mapped;
cd[index].child ¬ child;
cd[index].mapping ¬ child.s.mapping;
IF child.s.mapping=mapped THEN {
IF Varying[child] THEN varyingCount ¬ varyingCount+1;
g ¬ XTkFriends.PreferredSizeLR[widget: child, proposed: child.actual, maySkip: exceptHeight];
g.pos ¬ pos;
IF g.borderWidth<0 THEN g.borderWidth ¬ 0;
IF fixCommon OR g.size.width<=0 THEN {
g.size.width ¬ widget.actual.size.width - g.borderWidth*2;
};
IF force>0 THEN g.size.height ¬ MAX[1, force - g.borderWidth*2];
IF g.size.height<=0 THEN g.size.height ¬ 20;
IF g.size.width<=0 THEN g.size.width ¬ 1;
IF child=lastChild AND varyingCount=0 THEN {
g.size.height ¬ MAX[widget.actual.size.height-pos.y-g.borderWidth*2, 1];
};
pos.y ¬ pos.y+g.size.height+2*g.borderWidth;
};
cd[index].g ¬ g;
index ¬ MIN[allCount, index+1];
};
IF reConsiderChildren THEN XTk.SetWidgetFlag[widget, XTk.mustReConsiderChildren, FALSE];
[mapCount, allCount, lastChild] ¬ XCount[widget, reConsiderChildren]; --zero'th path: count
IF mapCount>0 AND force=0 THEN {
force ¬ MAX[1, widget.actual.size.height / mapCount];
};
cd ¬ NEW[MyConfigureData[allCount]];
XTkCollections.BasicEnumerateChildren[widget, FirstPassPerChild]; -- first real pass: get ideal geometry
IF varyingCount>0 THEN {
offset: INT ¬ 0;
wrong: INT ¬ widget.actual.size.height-pos.y;
IF wrong#0 THEN {
FOR i: INT IN [0..allCount) DO -- second pass: fix geometry evenly
child: XTk.Widget ¬ cd[i].child;
cd[i].g.pos.y ¬ cd[i].g.pos.y + offset;
IF Varying[child] THEN {
correction: INT ¬ wrong/varyingCount; varyingCount ¬ varyingCount-1;
IF (cd[i].g.size.height+correction)<1 THEN {
correction ¬ 1-cd[i].g.size.height;
};
wrong ¬ wrong-correction;
cd[i].g.size.height ¬ cd[i].g.size.height + correction;
offset ¬ offset + correction;
};
ENDLOOP;
};
};
FOR i: INT IN [0..allCount) DO-- last pass: now really set the fixed geometry
child: XTk.Widget ¬ cd[i].child;
XTkFriends.ConfigureLR[child, cd[i].g, cd[i].mapping, reConsiderChildren];
ENDLOOP;
};
OldXSizingLR: PROC [widget: Widget, reConsiderChildren: BOOL] = {
force: INT ¬ GetForce[widget];
count: INT; lastChild: Widget;
pos: Xl.Point ¬ [0, 0];
fixCommon: BOOL = TRUE;
EachChild: XTkCollections.EachChildProc = {
g: Xl.Geometry ¬ [];
IF child.state#realized<<or in progress@@>> AND ~reConsiderChildren THEN RETURN;
IF child.s.mapping=mapped THEN {
g ¬ XTkFriends.PreferredSizeLR[widget: child, proposed: child.actual, maySkip: exceptWidth];
g.pos ¬ pos;
IF g.borderWidth<0 THEN g.borderWidth ¬ 0;
IF fixCommon OR g.size.height<=0 THEN {
g.size.height ¬ widget.actual.size.height - g.borderWidth*2;
};
IF force>0 THEN g.size.width ¬ MAX[1, force - g.borderWidth*2];
IF g.size.width<=0 THEN g.size.width ¬ 40;
IF g.size.height<=0 THEN g.size.height ¬ 1;
IF g.borderWidth<0 THEN g.borderWidth ¬ 0;
IF child=lastChild THEN {
g.size.width ¬ MAX[widget.actual.size.width-pos.x-g.borderWidth*2, 1];
};
};
XTkFriends.ConfigureLR[child, g, child.s.mapping, reConsiderChildren];
IF child.actualMapping=mapped THEN pos.x ¬ pos.x + g.size.width + 2*g.borderWidth;
};
IF reConsiderChildren THEN XTk.SetWidgetFlag[widget, XTk.mustReConsiderChildren, FALSE];
[count, lastChild] ¬ MyCount[widget];
IF count>0 AND force=0 THEN {
force ¬ MAX[1, widget.actual.size.width / count];
};
XTkCollections.BasicEnumerateChildren[widget, EachChild];
};
MyConfigureData: TYPE = RECORD [
d: SEQUENCE count: NAT OF MyConfigureRec
];
MyConfigureRec: TYPE = RECORD [
child: XTk.Widget,
g: Xl.Geometry ¬ [],
mapping: XTk.Mapping ¬ dontUse
];
varyingFlag: XTk.WidgetFlagKey ~ wf6;
SetVaryingSize: PUBLIC PROC [childOfStack: XTk.Widget, varyingSize: BOOL ¬ TRUE] = {
XTk.SetWidgetFlag[childOfStack, varyingFlag, varyingSize]
};
Varying: PROC [widget: Widget] RETURNS [BOOL] = {
RETURN [XTk.GetWidgetFlag[widget, varyingFlag]]
};
XSizingLR: PROC [widget: Widget, reConsiderChildren: BOOL] = {
cd: REF MyConfigureData ¬ NIL;
force: INT ¬ GetForce[widget];
mapCount: INT; allCount: INT; index: INT ¬ 0;
varyingCount: INT ¬ 0; lastChild: Widget;
pos: Xl.Point ¬ [0, 0];
fixCommon: BOOL = TRUE;
FirstPassPerChild: XTkCollections.EachChildProc = {
--used in first pass to get ideal geometry
g: Xl.Geometry ¬ child.actual;
IF child.state#realized AND ~reConsiderChildren THEN RETURN;
IF child.s.mapping=dontUse THEN child.s.mapping ¬ mapped;
cd[index].child ¬ child;
cd[index].mapping ¬ child.s.mapping;
IF child.s.mapping=mapped THEN {
IF Varying[child] THEN varyingCount ¬ varyingCount+1;
g ¬ XTkFriends.PreferredSizeLR[widget: child, proposed: child.actual, maySkip: exceptWidth];
g.pos ¬ pos;
IF g.borderWidth<0 THEN g.borderWidth ¬ 0;
IF fixCommon OR g.size.height<=0 THEN {
g.size.height ¬ widget.actual.size.height - g.borderWidth*2;
};
IF force>0 THEN g.size.width ¬ MAX[1, force - g.borderWidth*2];
IF g.size.width<=0 THEN g.size.width ¬ 40;
IF g.size.height<=0 THEN g.size.height ¬ 1;
IF child=lastChild AND varyingCount=0 THEN {
g.size.width ¬ MAX[widget.actual.size.width-pos.x-g.borderWidth*2, 1];
};
pos.x ¬ pos.x + g.size.width + 2*g.borderWidth;
};
cd[index].g ¬ g;
index ¬ MIN[allCount, index+1];
};
IF reConsiderChildren THEN XTk.SetWidgetFlag[widget, XTk.mustReConsiderChildren, FALSE];
[mapCount, allCount, lastChild] ¬ XCount[widget, reConsiderChildren]; --zero'th path: count
IF mapCount>0 AND force=0 THEN {
force ¬ MAX[1, widget.actual.size.width / mapCount];
};
cd ¬ NEW[MyConfigureData[allCount]];
XTkCollections.BasicEnumerateChildren[widget, FirstPassPerChild]; -- first real pass: get ideal geometry
IF varyingCount>0 THEN {
offset: INT ¬ 0;
wrong: INT ¬ widget.actual.size.width-pos.x;
IF wrong#0 THEN {
FOR i: INT IN [0..allCount) DO -- second pass: fix geometry evenly
child: XTk.Widget ¬ cd[i].child;
cd[i].g.pos.x ¬ cd[i].g.pos.x + offset;
IF Varying[child] THEN {
correction: INT ¬ wrong/varyingCount; varyingCount ¬ varyingCount-1;
IF (cd[i].g.size.width+correction)<1 THEN {
correction ¬ 1-cd[i].g.size.width;
};
wrong ¬ wrong-correction;
cd[i].g.size.width ¬ cd[i].g.size.width + correction;
offset ¬ offset + correction;
};
ENDLOOP;
};
};
FOR i: INT IN [0..allCount) DO-- last pass: now really set the fixed geometry
child: XTk.Widget ¬ cd[i].child;
XTkFriends.ConfigureLR[child, cd[i].g, cd[i].mapping, reConsiderChildren];
ENDLOOP;
};
skipNone: XTk.GeometryRequest = [FALSE, FALSE, FALSE, FALSE, FALSE];
ContSizingLR: PROC [widget: Widget, reConsiderChildren: BOOL] = {
pos: Xl.Point ¬ [0, 0];
EachChild: XTkCollections.EachChildProc = {
g: Xl.Geometry ¬ [];
IF child.state#realized<<or in progress@@>> AND ~reConsiderChildren THEN RETURN;
IF child.s.mapping=mapped THEN {
g ¬ XTkFriends.PreferredSizeLR[widget: child, proposed: child.actual, maySkip: skipNone];
IF g.size.width<=0 THEN g.size.width ¬ 1;
IF g.size.height<=0 THEN g.size.height ¬ 1;
IF g.borderWidth<0 THEN g.borderWidth ¬ 0;
};
XTkFriends.ConfigureLR[child, g, child.s.mapping, reConsiderChildren];
};
IF reConsiderChildren THEN XTk.SetWidgetFlag[widget, XTk.mustReConsiderChildren, FALSE];
XTkCollections.BasicEnumerateChildren[widget, EachChild];
};
END.