DIRECTORY 
Rope, 
Xl,
XTkCollections,
XTk,
XTkFriends;

XTkCollectionsImpl: CEDAR MONITOR 
IMPORTS Xl, XTk, XTkCollections, XTkFriends
EXPORTS XTkCollections
SHARES XTk =
BEGIN OPEN XTk, XTkCollections;

collectionClass: PUBLIC Class ¬ InitSuperClass[];
InitSuperClass: PROC [] RETURNS [csc: ImplementorClass] = {
csc ¬ XTkFriends.CreateClass[[
key: $collectionSuper, classNameHint: $Collection, 
wDataNum: 1, cDataNum: 1, 
initInstPart: CollectionInitInstPart, 
removeChildLR: NIL,
internalEnumerateChildren: InternalEnumerateChildren, 
pleaseResizeChild: XTkFriends.PropagateUpPleaseResizeChild
]];
csc.cClassData[csc.cDataIdx] ¬ NEW[CollectionClassPartRec ¬ [
addChildLR: AddChildInFirstPlaceLR,
addChildrenLR: DefaultAddChildrenLR,
enumerateChildren: BasicEnumerateChildren
]];
};

dymmyChildren: REF ChildrenData ~ NEW[ChildrenData[0]];

GetCollectionClassPart: PROC [collection: CollectionWidget] RETURNS [CollectionClassPart] = INLINE {
RETURN [ NARROW[XTkFriends.ClassPart[collection, collectionClass]] ]
};

CollectionInitInstPart: XTk.InitInstancePartProc = {
ip: CollectionInstPart ~ NEW[CollectionInstPartRec ¬ [children: dymmyChildren]];
IF widget.s.geometry.borderWidth<0 THEN widget.s.geometry.borderWidth ¬ 0;
XTkFriends.AssignInstPart[widget, collectionClass, ip];
};

Create: PUBLIC PROC [widgetSpec: XTk.WidgetSpec ¬ [], children: LIST OF Widget ¬ NIL, childCount: NAT ¬ 0] RETURNS [widget: CollectionWidget] = {
widget ¬ XTk.CreateWidget[widgetSpec, collectionClass];
IF childCount>0 THEN AssertEmptySlotsLR[widget, childCount]; --creation
IF children#NIL THEN AddChildrenLR[widget, children, FALSE]; --creation
};

RemoveChild: PUBLIC PROC [collection: CollectionWidget, child: Widget, reConsiderNow: BOOL ¬ TRUE, preventDestruction: BOOL ¬ FALSE] = {
rootTQ: Xl.TQ ~ collection.rootTQ;
action: PROC = {RemoveChildLR[collection, child, reConsiderNow, preventDestruction]};
IF rootTQ=NIL 
THEN action[] --container is not yet stuck into shell...
ELSE Xl.CallWithLock[rootTQ, action];
};

RemoveChildLR: PUBLIC PROC [collection: CollectionWidget, child: Widget, reConsiderNow: BOOL ¬ TRUE, preventDestruction: BOOL ¬ FALSE] = {
done: BOOL;
IF child.parent#collection THEN ERROR;
child.s.mapping ¬ MAX[unconfigured, child.s.mapping];
done ¬ XTkFriends.RemoveChildLR[collection, child];
IF done THEN {
IF child.state<screened THEN 
XTkFriends.ConfigureLR[child, [], unconfigured, TRUE];
IF preventDestruction 
THEN XTkFriends.ForgetScreenLR[child]
ELSE XTkFriends.OrphanizeLR[child, normal]
};
IF reConsiderNow THEN XTkFriends.ReconfigureChildrenLR[collection]
};

AddChild: PUBLIC PROC [collection: CollectionWidget, newChild: Widget, position: REF ¬ NIL, reConsiderNow: BOOL ¬ TRUE] = {
rootTQ: Xl.TQ ~ collection.rootTQ;
action: PROC = {AddChildLR[collection, newChild, position, reConsiderNow]};
IF rootTQ=NIL 
THEN action[] --container is not yet stuck into shell...
ELSE Xl.CallWithLock[rootTQ, action];
};

AddChildLR: PUBLIC PROC [collection: CollectionWidget, newChild: Widget, position: REF ¬ NIL, reConsiderNow: BOOL ¬ TRUE] = {
classPart: CollectionClassPart ~ GetCollectionClassPart[collection];
SELECT newChild.parent FROM
NIL, collection => XTkFriends.AssignParentAndCheckScreenLR[newChild, collection];
ENDCASE => ERROR;
IF newChild.s.mapping=dontUse THEN newChild.s.mapping ¬ mapped;
classPart.addChildLR[collection, newChild, position, reConsiderNow];
};

AddChildren: PUBLIC PROC [collection: CollectionWidget, children: LIST OF Widget, reConsiderNow: BOOL ¬ TRUE] = {
rootTQ: Xl.TQ ~ collection.rootTQ;
action: PROC = {AddChildrenLR[collection, children, reConsiderNow]};
IF rootTQ=NIL 
THEN action[] --container is not yet stuck into shell...
ELSE Xl.CallWithLock[rootTQ, action];
};

AddChildrenLR: PUBLIC PROC [collection: CollectionWidget, children: LIST OF Widget, reConsiderNow: BOOL ¬ TRUE] = {
classPart: CollectionClassPart ~ GetCollectionClassPart[collection];
FOR l: LIST OF Widget ¬ children, l.rest WHILE l#NIL DO
SELECT l.first.parent FROM
NIL, collection => XTkFriends.AssignParentAndCheckScreenLR[l.first, collection];
ENDCASE => ERROR;
IF l.first.s.mapping=dontUse THEN l.first.s.mapping ¬ mapped;
ENDLOOP;
classPart.addChildrenLR[collection, children, reConsiderNow];
};

EnumerateChildren: PUBLIC PROC [collection: CollectionWidget, eachChild: EachChildProc, data: REF ¬ NIL] = {
classPart: CollectionClassPart ~ GetCollectionClassPart[collection];
classPart.enumerateChildren[collection, eachChild, data];
};

Find: PROC [ip: CollectionInstPart, child: Widget ¬ NIL, start: NAT ¬ 0] RETURNS [INT¬-1] = {
FOR i: NAT IN [start..ip.slotsUsed) DO
IF ip.children[i]=child THEN RETURN [i];
ENDLOOP;
};

RemoveXWindowsLR: PROC [child: Widget] = {
IF child#NIL THEN {
p: Widget ¬ child.parent;
IF p#NIL THEN XTkFriends.ForgetScreenLR[child];
};
};

RemoveAndSquezeLR: PROC [ip: CollectionInstPart, child: Widget] RETURNS [idx: INT] = {
idx ¬ Find[ip, child];
IF idx>=0 THEN {
ip.sizing ¬ NIL; 
FOR i: INT IN (idx..ip.slotsUsed) DO
ip.children[i-1] ¬ ip.children[i];
ENDLOOP;
ip.slotsUsed ¬ ip.slotsUsed-1;
ip.children[ip.slotsUsed] ¬ [NIL];
};
};

AssertEmptySlotsLR: PUBLIC PROC [collection: CollectionWidget, num: NAT] = {
ip: CollectionInstPart ~ GetCollectionInstPart[collection];
AssertEmptySlotsILR[ip, num];
};

AssertEmptySlotsILR: PROC [ip: CollectionInstPart, num: NAT] = {
oldCount: NAT ¬ ip.children.count;
IF num<1 THEN num ¬ 7;
IF ip.slotsUsed+num<=oldCount THEN RETURN;
IF ip.hasEmptySlots THEN {
FOR i: INT IN [0..ip.slotsUsed) DO
IF ip.children[i].child=NIL THEN {num ¬ num-1; IF num = 0 THEN RETURN};
ENDLOOP;
};
IF ip.slotsUsed+num<=oldCount THEN RETURN;
BEGIN
newCount: NAT ¬ MAX[oldCount+5, oldCount+oldCount+1, ip.slotsUsed+num];
newCd: REF ChildrenData ~ NEW[ChildrenData[newCount]];
ip.sizing ¬ NIL;
FOR i: INT IN [0..ip.slotsUsed) DO
newCd.children[i] ¬ ip.children.children[i];
ENDLOOP;
ip.children ¬ newCd;
END;
};

RemoveChildInPlaceLR: PUBLIC PROC [widget, child: Widget] RETURNS [done: BOOL ¬ FALSE] = {
RemoveInPlaceLR: PROC [ip: CollectionInstPart, child: Widget] RETURNS [idx: INT] = {
idx ¬ Find[ip, child];
IF idx>=0 THEN {
ip.sizing ¬ NIL; 
ip.children[idx] ¬ [NIL];
IF idx+1=ip.slotsUsed 
THEN ip.slotsUsed ¬ ip.slotsUsed-1 
ELSE ip.hasEmptySlots ¬ TRUE;
};
};
ip: CollectionInstPart ~ GetCollectionInstPart[widget];
IF child=NIL THEN ERROR;
IF RemoveInPlaceLR[ip, child]>=0 THEN {
done ¬ TRUE;
RemoveXWindowsLR[child];
XTk.NoteChildChange[widget];
};
};

RemoveChildAndSqueezeLR: PUBLIC PROC [widget, child: Widget] RETURNS [done: BOOL ¬ FALSE] = {
SqueezeNRemoveLR: PROC [ip: CollectionInstPart, child: Widget] RETURNS [found: BOOL¬FALSE] = {
nextToUse, nextToWatch: NAT ¬ 0;
WHILE nextToWatch<ip.slotsUsed DO
c: XTk.Widget ¬ ip.children[nextToWatch].child; nextToWatch ¬ nextToWatch+1;
SELECT TRUE FROM
c=NIL OR c.state=dead => {ip.sizing ¬ NIL; LOOP};
c=child => {found ¬ TRUE; ip.sizing ¬ NIL; LOOP};
ENDCASE => {
ip.children[nextToUse].child ¬ c; nextToUse ¬ nextToUse+1;
};
ENDLOOP;
FOR empty: NAT IN [nextToUse..ip.slotsUsed) DO ip.children[empty] ¬ [NIL] ENDLOOP;
ip.slotsUsed ¬ nextToUse;
ip.hasEmptySlots ¬ FALSE;
};
ip: CollectionInstPart ~ GetCollectionInstPart[widget];
IF child=NIL THEN ERROR;
IF SqueezeNRemoveLR[ip, child].found THEN {
done ¬ TRUE;
RemoveXWindowsLR[child];
XTk.NoteChildChange[widget];
};
};

AddChildInFirstPlaceLR: PUBLIC PROC [collection: CollectionWidget, newChild: Widget, position: REF, reConsiderNow: BOOL] = {
IncludeHardLR: PROC [ip: CollectionInstPart, newChild: Widget] = {
IncludeLR: PROC [ip: CollectionInstPart, w: Widget] RETURNS [INT¬-1] = {
IF ip.hasEmptySlots THEN {
idx: INT ~ Find[ip, NIL];
IF idx<0 THEN ERROR; --there was no empty slot
ip.children[idx] ¬ [w];
IF Find[ip, NIL, idx+1]<0 THEN ip.hasEmptySlots ¬ FALSE;
RETURN [idx]
};
IF ip.slotsUsed<ip.children.count THEN {
idx: NAT ~ ip.slotsUsed;
ip.children[idx] ¬ [w];
ip.slotsUsed ¬ idx+1;
RETURN [idx];
};
};
idx: INT ¬ IncludeLR[ip, newChild];
IF idx<0 THEN {
AssertEmptySlotsILR[ip, 1];
[] ¬ IncludeLR[ip, newChild];
};
};
ip: CollectionInstPart ~ GetCollectionInstPart[collection];
IF newChild=NIL OR newChild.parent#collection THEN ERROR;
IF Find[ip, newChild]>=0 THEN ERROR; --tried to include multiple times
IncludeHardLR[ip, newChild];
XTk.NoteChildChange[collection];
IF reConsiderNow THEN XTkFriends.ReconfigureChildrenLR[collection];
};

DefaultAddChildrenLR: PROC [collection: CollectionWidget, children: LIST OF Widget, reConsiderNow: BOOL] = {
classPart: CollectionClassPart ~ GetCollectionClassPart[collection];
FOR l: LIST OF Widget ¬ children, l.rest WHILE l#NIL DO
classPart.addChildLR[collection, l.first, NIL, (l.rest#NIL AND reConsiderNow)];
ENDLOOP;
};

CountChildren: PROC [collection: CollectionWidget] RETURNS [n: INT ¬ 0] = {
ip: CollectionInstPart ~ GetCollectionInstPart[collection];
FOR i: NAT IN [0..ip.slotsUsed) DO
c: Widget ¬ ip.children[i];
IF c#NIL AND c.state<dead THEN n ¬ n+1 
ENDLOOP;
};

BasicEnumerateChildren: PUBLIC PROC [collection: CollectionWidget, eachChild: EachChildProc, data: REF ¬ NIL] = {
ip: CollectionInstPart ~ GetCollectionInstPart[collection];
FOR i: NAT IN [0..ip.slotsUsed) DO
c: Widget ¬ ip.children[i];
IF c#NIL AND c.state<dead THEN 
IF eachChild[collection, c, data, i].stop THEN RETURN;
ENDLOOP;
};

InternalEnumerateChildren: XTk.InternalEnumerateChildrenProc = {
ip: CollectionInstPart ~ GetCollectionInstPart[self];
FOR i: NAT IN [0..ip.slotsUsed) DO
c: Widget ¬ ip.children[i];
IF c#NIL AND c.state<dead THEN { 
IF proc[self, c, data].stop THEN {stop ¬ TRUE; RETURN};
};
ENDLOOP;
};

NewCollectionClassPart: PUBLIC PROC [class: XTk.ImplementorClass] RETURNS [newClassPart: CollectionClassPart] = {
oldClassPart: CollectionClassPart ~ NARROW[class.cClassData[collectionClass.cDataIdx]];  
newClassPart ¬ NEW[CollectionClassPartRec ¬ oldClassPart­];
class.cClassData[collectionClass.cDataIdx] ¬ newClassPart;
};

END.



8XTkCollectionsImpl.mesa
Copyright Σ 1989, 1991 by Xerox Corporation.  All rights reserved.
Christian Jacobi, July 3, 1989 2:25:25 pm PDT
Christian Jacobi, June 12, 1992 10:42 am PDT
--Makes shure collection has at least num empty children slots
--Must be called on rootTQ only!!
-- no space available ! --
Κp–
(cedarcode) style•NewlineDelimiter

˜
codeš
œ™Kšœ
Οe
œ7™BKšœ*Οk™-K™,—K˜šž	œ
˜
Kš
œ˜Kš
œ˜Kš
œ˜Kš
œ˜Kš
œ˜K˜—šΟnœžœ
žœ
˜"Kšžœ$˜+Kšžœ˜Kšžœ˜—Kšžœ
žœ˜K˜šœžœ˜1šŸœžœžœ˜;š
œ˜Kš
œ3˜3Kš
œ˜Kš
œ&˜&Kšœžœ
˜Kš
œ6˜6Kš
œ:˜:Kš
œ˜—šœžœ˜=Kš
œ#˜#Kš
œ$˜$Kš
œ)˜)Kš
œ˜—Kš
œ˜——K˜Kšœžœžœ˜7K˜šŸœžœ žœžœ˜dKšžœžœ5˜DK˜—K˜šŸœ˜4Kšœžœ4˜PKšžœ!žœ#˜JKš
œ7˜7K˜K˜—šŸœžœ
žœ-žœ
žœ
žœžœžœ˜‘
Kš
œ7˜7Kšžœžœ3˜GKšžœ
žœ
žœ!žœ
˜GKš
œ˜—K˜šŸœžœ
žœ>žœžœžœžœ˜ˆ
K˜"KšœžœI˜Ušžœžœ
˜Kšžœ
Οc*˜8Kšžœ!˜%—K˜K˜—šŸ
œžœ
žœ>žœžœžœžœ˜Š
Kšœžœ
˜Kšžœžœ
žœ
˜&Kšœžœ ˜5Kš
œ3˜3šžœžœ˜šžœžœ
˜Kšœ0žœ˜6—šžœ˜Kšžœ!˜%Kšžœ&˜*—K˜—Kšžœžœ-˜BK˜K˜—šŸœžœ
žœ<žœžœžœžœ˜{K˜"Kšœžœ?˜Kšžœžœ
˜Kšžœ
 *˜8Kšžœ!˜%—K˜K˜—šŸ
œžœ
žœ<žœžœžœžœ˜}Kš
œD˜Dšžœž˜KšžœN˜QKšžœžœ
˜—Kšžœžœ˜?Kš
œD˜DK˜K˜—šŸœžœ
žœ*žœ
žœžœžœ˜qK˜"Kšœžœ8˜Dšžœžœ
˜Kšžœ
 *˜8Kšžœ!˜%—K˜K˜—šŸ
œžœ
žœ*žœ
žœžœžœ˜sKš
œD˜Dšžœžœ
žœžœžœ
ž˜7šžœž˜KšžœM˜PKšžœžœ
˜—Kšžœžœ˜=Kšžœ
˜—Kš
œ=˜=K˜K˜—š
Ÿœžœ
žœ@žœžœ˜lKš
œD˜DKš
œ9˜9Kš
œ˜—K˜šŸœžœ*žœ	žœžœžœ˜]šžœžœ
žœž˜&Kšžœžœ
žœ˜(Kšžœ
˜—K˜K˜—šŸœžœ˜*šžœžœ
žœ˜Kš
œ˜Kšžœžœ
žœ"˜/K˜—K˜—K˜šŸœžœ)žœžœ˜VKš
œ˜šžœžœ˜Kšœž˜šžœžœ
žœž˜$Kš
œ"˜"Kšžœ
˜—Kš
œ˜Kšœžœ˜"K˜—K˜—K˜šŸœžœ
žœ%žœ˜LJš
 >™>Jš
 !™!Kš
œ;˜;Kš
œ˜K˜—K˜šŸœžœžœ˜@Kšœ
žœ˜"Kšžœžœ	˜Kšžœžœ
žœ
˜*šžœžœ˜šžœžœ
žœž˜"Kšžœžœ
žœžœ	žœ
žœ˜GKšžœ
˜—K˜—Kšžœžœ
žœ
˜*š
ž˜Kšœ
žœžœ4˜GKšœžœžœ˜6Kšœžœ
˜šžœžœ
žœž˜"Kš
œ,˜,Kšžœ
˜—Kš
œ˜Kšžœ
˜—K˜—K˜šŸœžœ
žœžœžœžœ˜ZšŸœžœ)žœžœ˜TKš
œ˜šžœžœ˜Kšœžœ˜Kšœžœ˜šžœ˜Kšžœ˜#Kšžœžœ
˜—K˜—K˜—Kš
œ7˜7Kšžœžœ
žœ
žœ
˜šžœžœ˜'Kšœžœ
˜Kš
œ˜Kš
œ˜K˜—K˜K˜—šŸœžœ
žœžœžœžœ˜]š
Ÿœžœ)žœ	žœ
žœ˜^Kšœžœ˜ šžœž˜!Kš
œL˜Lšžœ
žœ
ž˜Kš	œžœ
žœžœžœ˜1Kšœžœžœžœ˜1šžœ˜Kš
œ:˜:K˜——Kšžœ
˜—Kšžœžœ
žœžœžœžœ
˜RKš
œ˜Kšœžœ
˜K˜—Kš
œ7˜7Kšžœžœ
žœ
žœ
˜šžœ#žœ˜+Kšœžœ
˜Kš
œ˜Kš
œ˜K˜—K˜K˜—š
Ÿœžœ
žœ<žœžœ˜|šŸ
œžœ/˜BšŸ	œžœ%žœžœ˜Hšžœžœ˜Kšœžœžœ˜Kšžœžœ
žœ ˜.Kš
œ˜Kšžœ
žœžœžœ
˜8Kšžœ˜Kš
œ˜—šžœ žœ˜(Kšœžœ˜Kš
œ˜Kš
œ˜Kšžœ˜
K˜—Jš
 ™K˜—Kšœžœ˜#šžœžœ˜Kš
œ˜Kš
œ˜K˜—K˜—Kš
œ;˜;Kš
žœ
žœ
žœžœ
žœ
˜9Kšžœžœ
žœ !˜FKš
œ˜Kš
œ ˜ Kšžœžœ.˜CK˜K˜—š
Ÿœžœ*žœ
žœžœ˜lKš
œD˜Dšžœžœ
žœžœžœ
ž˜7Kšœ*žœ
žœ
žœ˜OKšžœ
˜—K˜K˜—šŸ
œžœ žœžœ	˜KKš
œ;˜;šžœžœ
žœž˜"Kš
œ˜Kšžœžœ
žœžœ	˜'Kšžœ
˜—K˜—K˜š
Ÿœžœ
žœ@žœžœ˜qKš
œ;˜;šžœžœ
žœž˜"Kš
œ˜šžœžœ
žœžœ
˜Kšžœ(žœ
žœ
˜6—Kšžœ
˜—K˜K˜—šŸœ'˜@Kš
œ5˜5šžœžœ
žœž˜"Kš
œ˜šžœžœ
žœžœ˜!Kšžœžœ	žœžœ˜7K˜—Kšžœ
˜—K˜—K˜šŸœžœ
žœžœ(˜qKšœ$žœ/˜YKšœžœ)˜;Kš
œ:˜:K˜—K˜Kšžœ
˜K˜K˜—…—&ž4F