<> <> <> <> 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 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] = { <<--Makes shure collection has at least num empty children slots>> <<--Must be called on rootTQ only!!>> 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.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> }; 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