#BUGFIX by cg
authorClaus Gittinger <cg@exept.de>
Tue, 12 Feb 2019 19:01:33 +0100
changeset 5996 e89a322b31da
parent 5995 2acec64a833b
child 5997 dda46d10430a
#BUGFIX by cg class: AbstractHierarchicalItem BUGFIX: recursive expand/recursive collapse comment/format in: #from:to:do: #from:to:reverseDo: #getChildren #keysAndValuesReverseDo: #nonCriticalDo: #nonCriticalFrom:to:reverseDo: #nonCriticalKeysAndValuesReverseDo: #nonCriticalRecursiveDo: #nonCriticalRecursiveReverseDo: #recursiveCollapse #recursiveDo: #recursiveExpand #recursiveReverseDo: #withAllDo: changed: #addVisibleChildrenTo: #collapse #criticalDo: #nonCriticalFrom:to:do: #numberOfVisibleChildren #numberOfVisibleChildren_v2 #recursiveExpand_v2 #recursiveSetCollapsed #recursiveSetCollapsedHelper #recursiveSetExpandedAndAddToList: #recursiveSetExpandedAndAddToListHelper:
AbstractHierarchicalItem.st
--- a/AbstractHierarchicalItem.st	Tue Feb 12 04:24:54 2019 +0100
+++ b/AbstractHierarchicalItem.st	Tue Feb 12 19:01:33 2019 +0100
@@ -117,9 +117,12 @@
 !AbstractHierarchicalItem methodsFor:'accessing'!
 
 getChildren
-    "returns the children as they are present (or not); not going to the model..."
+    "returns the children as they are present (or not); 
+     not going to the model, and especially not creating autocreated children..."
 
     ^ children
+
+    "Modified (comment): / 12-02-2019 / 17:41:06 / Claus Gittinger"
 !
 
 level
@@ -267,26 +270,30 @@
 collapse
     "hide all my subitems"
 
-    |visChd index|
-
     self canCollapse ifTrue:[
-        self setExpanded:false.
-
         self synchronized:[
+            |overAllNrOfVisibleChildren nrOfVisibleChildren index|
+
+            overAllNrOfVisibleChildren := self numberOfVisibleChildren.
+
+            self setExpanded:false.
+
             (index := self listIndex) notNil ifTrue:[
-                "/ do not call :#size: children will be autoloaded !!!!
-                (visChd := children size) ~~ 0 ifTrue:[
-                    self nonCriticalFrom:1 to:nil do:[:el|
-                        visChd := visChd + el numberOfVisibleChildren
+                "/ do not call self size or self children,
+                "/ as this might autocreate children !!!!
+                (nrOfVisibleChildren := children size) ~~ 0 ifTrue:[
+                    children do:[:el|
+                        nrOfVisibleChildren := nrOfVisibleChildren + el numberOfVisibleChildren
                     ].
-                    self model itemRemoveFromIndex:(index + 1) toIndex:(index + visChd).
+                    self assert:(nrOfVisibleChildren = overAllNrOfVisibleChildren).
+                    self model itemRemoveFromIndex:(index + 1) toIndex:(index + nrOfVisibleChildren).
                 ].
                 index ~~ 0 ifTrue:[self hierarchyChanged].
             ]
         ]
     ]
 
-    "Modified: / 28-07-2018 / 15:47:29 / Claus Gittinger"
+    "Modified: / 12-02-2019 / 18:53:55 / Claus Gittinger"
 !
 
 enforcedExpand
@@ -402,67 +409,75 @@
      **** must be expanded
     "
     self synchronized:[
-        |visChd index|
+        |nrOfVisibleChildren index|
 
         self canCollapse ifTrue:[
             (index := self listIndex) notNil ifTrue:[
-                "/ do not call :#size: children will be autoloaded !!!!
-                (visChd := children size) ~~ 0 ifTrue:[
-                    self nonCriticalFrom:1 to:nil do:[:el|
-                        visChd := visChd + el numberOfVisibleChildren
+                "/ do not call self size or self children here;
+                "/ otherwise, lazy children would be autocreated !!!!
+                (nrOfVisibleChildren := children size) ~~ 0 ifTrue:[
+                    children do:[:el|
+                        nrOfVisibleChildren := nrOfVisibleChildren + el numberOfVisibleChildren
                     ].
                 ].
-                self recursiveSetCollapsed.
-
-                visChd ~~ 0 ifTrue:[
-                    self model itemRemoveFromIndex:(index + 1)
-                                           toIndex:(index + visChd)
+                self recursiveSetCollapsedHelper.
+
+                nrOfVisibleChildren ~~ 0 ifTrue:[
+                    self model itemRemoveFromIndex:(index + 1) toIndex:(index + nrOfVisibleChildren)
                 ].
                 index ~~ 0 ifTrue:[
                     self hierarchyChanged
                 ]
             ] ifFalse:[
-                self recursiveSetCollapsed
+                self recursiveSetCollapsedHelper
             ]
         ]
     ]
 
-    "Modified (format): / 28-07-2018 / 15:48:20 / Claus Gittinger"
+    "Modified: / 12-02-2019 / 18:54:26 / Claus Gittinger"
 !
 
 recursiveExpand
     "expand children and sub-children
      Precondition: must be collapsed"
 
-    |index list|
-
-    "/ test whether the item already is expanded; #canExpand could be redefined
-    "/ without checking whether the node is expanded (happens actually) !!
-    self isExpanded ifTrue:[ ^ self ].
-    self canExpand ifFalse:[ ^ self ].
-
-    self setExpanded:true.
+    |index todo toExpand myList childrenOfToExpand|
 
     self synchronized:[
-        self size ~~ 0 ifTrue:[
-            index := self listIndex.    "/ get the visible list index
-
-            index isNil ifTrue:[        "/ not visible
-                self nonCriticalFrom:1 to:nil do:[:el|
-                    el setExpanded:true
+        myList := self model.
+        todo := OrderedCollection with:self.
+        [todo notEmpty] whileTrue:[
+            toExpand := todo removeFirst.
+            
+            "/ test whether the item already is expanded; #canExpand could be redefined
+            "/ without checking whether the node is expanded (happens actually) !!
+            (toExpand isExpanded or:[toExpand canExpand]) ifTrue:[
+                toExpand setExpanded:true.
+                childrenOfToExpand := toExpand children.
+
+                index := toExpand listIndex.    "/ get the visible list index
+                index isNil ifTrue:[        
+                    "/ not visible
+                    childrenOfToExpand do:[:eachChild |
+                        (eachChild isExpanded not and:[eachChild canExpand]) ifTrue:[
+                            eachChild setExpanded:true
+                        ].    
+                    ].    
+                ] ifFalse:[
+                    "/ visible
+                    myList itemAddAll:childrenOfToExpand afterIndex:index.
+                    childrenOfToExpand do:[:eachChild |
+                        (eachChild isExpanded or:[eachChild canExpand]) ifTrue:[
+                            todo add:eachChild.
+                        ].    
+                    ].    
                 ].
-            ] ifFalse:[
-                list := OrderedCollection new.
-                self recursiveSetExpandedAndAddToList:list.
-                self model itemAddAll:list beforeIndex:(index + 1).
-
-                index ~~ 0 ifTrue:[self hierarchyChanged]
             ]
         ]
     ].
 
-    "Modified (format): / 28-07-2018 / 13:56:15 / Claus Gittinger"
     "Modified (comment): / 02-08-2018 / 16:16:17 / Stefan Vogel"
+    "Modified: / 12-02-2019 / 18:39:49 / Claus Gittinger"
 !
 
 recursiveToggleExpand
@@ -1146,7 +1161,8 @@
 !
 
 from:startIndex to:endIndex do:aOneArgBlock
-    "evaluate a block on each child (non recursive),
+    "WARNING: may fetch lazy children
+     evaluate a block on each child (non recursive),
      starting with the child at startIndex to the endIndex (last index if nil).
      Answer the value of the block executed on the last element."
 
@@ -1157,10 +1173,12 @@
     "Modified (comment): / 25-11-2016 / 08:43:51 / cg"
     "Modified: / 28-07-2018 / 13:48:49 / Claus Gittinger"
     "Modified: / 02-08-2018 / 16:04:04 / Stefan Vogel"
+    "Modified (comment): / 12-02-2019 / 18:49:58 / Claus Gittinger"
 !
 
 from:startIndex to:endIndex reverseDo:aOneArgBlock
-    "evaluate a block on each child (non recursive),
+    "WARNING: may fetch lazy children
+     evaluate a block on each child (non recursive),
      starting with the child at endIndex to the startIndex."
 
     self synchronized:[
@@ -1171,6 +1189,7 @@
 
     "Modified (comment): / 25-11-2016 / 08:43:58 / cg"
     "Modified: / 28-07-2018 / 13:49:17 / Claus Gittinger"
+    "Modified (comment): / 12-02-2019 / 18:50:04 / Claus Gittinger"
 !
 
 keysAndValuesDo:aTwoArgBlock
@@ -1191,7 +1210,8 @@
 !
 
 keysAndValuesReverseDo:aTwoArgBlock
-    "evaluate the argument, aBlock in reverse order for every child (non recursive), 
+    "WARNING: may fetch lazy children
+     evaluate the argument, aBlock in reverse order for every child (non recursive), 
      passing both index and element as arguments."
 
     self synchronized:[
@@ -1202,6 +1222,7 @@
 
     "Modified (comment): / 25-11-2016 / 08:44:06 / cg"
     "Modified: / 28-07-2018 / 13:50:14 / Claus Gittinger"
+    "Modified (comment): / 12-02-2019 / 18:50:08 / Claus Gittinger"
 !
 
 recursiveCollect:aBlock
@@ -1220,7 +1241,8 @@
 !
 
 recursiveDo:aOneArgBlock
-    "evaluate a block on each item and all the sub-items.
+    "WARNING: may fetch lazy children
+     evaluate a block on each item and all the sub-items.
      Warning: this only enumerates already visible child elements
      i.e. any collapsed items are not visited."
 
@@ -1230,11 +1252,12 @@
     ].
 
     "Modified (comment): / 25-11-2016 / 08:43:04 / cg"
-    "Modified (format): / 28-07-2018 / 13:56:02 / Claus Gittinger"
+    "Modified (comment): / 12-02-2019 / 18:51:21 / Claus Gittinger"
 !
 
 recursiveReverseDo:aOneArgBlock
-    "evaluate a block on each item and all the sub-items;
+    "WARNING: may fetch lazy children
+     evaluate a block on each item and all the sub-items;
      proccesing children in reverse direction.
      Warning: this only enumerates already visible child elements
      i.e. any collapsed items are not visited."
@@ -1245,7 +1268,7 @@
     ].
 
     "Modified (comment): / 25-11-2016 / 08:43:09 / cg"
-    "Modified (format): / 28-07-2018 / 13:56:34 / Claus Gittinger"
+    "Modified (comment): / 12-02-2019 / 18:51:09 / Claus Gittinger"
 !
 
 recursiveSelect:aBlock
@@ -1285,7 +1308,8 @@
 !
 
 withAllDo:aOneArgBlock
-    "recursively evaluate aOneArgBlock on each item and subitem including self"
+    "WARNING: may fetch lazy children
+     recursively evaluate aOneArgBlock on each item and subitem including self"
 
     aOneArgBlock value:self.
 
@@ -1295,7 +1319,7 @@
     ].
 
     "Modified (comment): / 25-11-2016 / 08:44:49 / cg"
-    "Modified (format): / 28-07-2018 / 15:44:45 / Claus Gittinger"
+    "Modified (comment): / 12-02-2019 / 18:50:40 / Claus Gittinger"
 ! !
 
 !AbstractHierarchicalItem methodsFor:'enumerating parents'!
@@ -1362,10 +1386,12 @@
 
     self from:1 to:nil do:[:el|
         aList add:el.
-        el addVisibleChildrenTo:aList.
+        el isExpanded ifTrue:[
+            el addVisibleChildrenTo:aList.
+        ].
     ].
 
-    "Modified: / 28-07-2018 / 13:58:20 / Claus Gittinger"
+    "Modified: / 12-02-2019 / 19:00:25 / Claus Gittinger"
 !
 
 clearExpandedWhenLastChildWasRemoved
@@ -1382,6 +1408,7 @@
 !
 
 criticalDo:aBlock
+    <resource: #obsolete>
     self synchronized:aBlock
 
     "Modified: / 23-07-2018 / 13:25:11 / Stefan Vogel"
@@ -1404,19 +1431,27 @@
 !
 
 numberOfVisibleChildren
-    "returns the number of all visible children including subchildren"
-
-    |count|
+    "returns the number of all visible children including subchildren,
+     but excluding myself"
+
+    |count todo toCount|
 
     self isExpanded ifFalse:[^ 0].
 
     count := 0.
-    self from:1 to:nil do:[:el|
-        count := 1 + count + (el numberOfVisibleChildren)
+    todo := OrderedCollection with:self.
+    [todo notEmpty] whileTrue:[
+        toCount := todo removeFirst.
+        count := count + toCount getChildren size. 
+        toCount getChildren do:[:each |
+            each isExpanded ifTrue:[
+                todo add:each
+            ].    
+        ].    
     ].
     ^ count
 
-    "Modified: / 28-07-2018 / 13:55:36 / Claus Gittinger"
+    "Modified: / 12-02-2019 / 18:42:05 / Claus Gittinger"
 !
 
 parentOrModel
@@ -1550,17 +1585,19 @@
 !AbstractHierarchicalItem methodsFor:'private-enumerating'!
 
 nonCriticalDo:aOneArgBlock
-    "evaluate a block noncritical for each child.
+    "WARNING: may fetch lazy children
+     evaluate a block noncritical for each child.
      Not synchronized - should only be called internally
      within a synchronized region."
 
     ^ self nonCriticalFrom:1 to:nil do:aOneArgBlock
 
-    "Modified (comment): / 28-07-2018 / 13:52:18 / Claus Gittinger"
+    "Modified (comment): / 12-02-2019 / 18:49:05 / Claus Gittinger"
 !
 
 nonCriticalFrom:startIndex to:endIndex do:aOneArgBlock
-    "evaluate a block noncritical for each child starting with the
+    "WARNING: may fetch lazy children
+     evaluate a block noncritical for each child starting with the
      child at startIndex to the endIndex (if nil to end of list).
      Not synchronized - should only be called internally
      within a synchronized region.
@@ -1581,17 +1618,19 @@
         |item|
 
         item := list at:i ifAbsent:nil.
-        item isNil ifTrue:[^ resp].
+        item isNil ifTrue:[self halt:'oops - lost child item?'. ^ resp].
         resp := aOneArgBlock value:item.
     ].
     ^ resp
 
-    "Modified (comment): / 28-07-2018 / 13:52:24 / Claus Gittinger"
     "Modified (comment): / 02-08-2018 / 16:02:13 / Stefan Vogel"
+    "Modified: / 12-02-2019 / 16:55:20 / Claus Gittinger"
+    "Modified (comment): / 12-02-2019 / 18:48:58 / Claus Gittinger"
 !
 
 nonCriticalFrom:startIndex to:endIndex reverseDo:aOneArgBlock
-    "evaluate a block non critical for each child starting with the
+    "WARNING: may fetch lazy children
+     evaluate a block non critical for each child starting with the
      child at endIndex (if nil to end of list) to startIndex.
      Not synchronized - should only be called internally
      within a synchronized region."
@@ -1614,11 +1653,12 @@
     ].
     ^ resp
 
-    "Modified (comment): / 28-07-2018 / 13:52:30 / Claus Gittinger"
+    "Modified (comment): / 12-02-2019 / 18:49:11 / Claus Gittinger"
 !
 
 nonCriticalKeysAndValuesReverseDo:aOneArgBlock
-    "evaluate the argument, aBlock in reverse order for every
+    "WARNING: may fetch lazy children
+     evaluate the argument, aBlock in reverse order for every
      child, passing both index and element as arguments.
      Not synchronized - should only be called internally
      within a synchronized region."
@@ -1638,11 +1678,12 @@
     ].
     ^ resp
 
-    "Modified (comment): / 28-07-2018 / 13:52:35 / Claus Gittinger"
+    "Modified (comment): / 12-02-2019 / 18:49:16 / Claus Gittinger"
 !
 
 nonCriticalRecursiveDo:aOneArgBlock
-    "evaluate the block non critical for each item and all the sub-items.
+    "WARNING: may fetch lazy children
+     evaluate the block non critical for each item and all the sub-items.
      Not synchronized - should only be called internally
      within a synchronized region."
 
@@ -1651,11 +1692,12 @@
         eachChild nonCriticalRecursiveDo:aOneArgBlock
     ].
 
-    "Modified (comment): / 28-07-2018 / 13:52:41 / Claus Gittinger"
+    "Modified (comment): / 12-02-2019 / 18:49:23 / Claus Gittinger"
 !
 
 nonCriticalRecursiveReverseDo:aOneArgBlock
-    "evaluate the block non critical for each item and all the sub-items;
+    "WARNING: may fetch lazy children
+     evaluate the block non critical for each item and all the sub-items;
      proccesing children in reverse direction.
      Not synchronized - should only be called internally
      within a synchronized region."
@@ -1665,7 +1707,7 @@
         aOneArgBlock value:eachChild.
     ].
 
-    "Modified (comment): / 28-07-2018 / 13:52:46 / Claus Gittinger"
+    "Modified (comment): / 12-02-2019 / 18:48:45 / Claus Gittinger"
 !
 
 nonCriticalRecursiveSort:aSortBlock
@@ -1689,6 +1731,7 @@
 !AbstractHierarchicalItem methodsFor:'private-hierarchy'!
 
 recursiveSetCollapsed
+    <resource: #obsolete>
     "collapse all children and sub-children without notifications"
 
     self synchronized:[
@@ -1704,20 +1747,27 @@
      Helper; not synchronized - should only be called internally
      within a synchronized region."
 
-    self setExpanded:false.
-
-    "/ do not call #size: children will be autoloaded !!!!
-    self nonCriticalFrom:1 to:nil do:[:eachChild| 
-        eachChild canRecursiveCollapse ifTrue:[
-            eachChild recursiveSetCollapsedHelper
+    |todo toCollapse|
+    
+    todo := OrderedCollection with:self.
+    [todo notEmpty] whileTrue:[
+        "/ do not call self size or self children;
+        "/ otherwise, children might will be autocreated !!!!
+        toCollapse := todo removeFirst.
+        toCollapse setExpanded:false.
+        toCollapse getChildren do:[:eachChild |
+            eachChild canRecursiveCollapse ifTrue:[
+                todo add:eachChild
+            ].    
         ]
     ].
 
-    "Modified (comment): / 28-07-2018 / 13:57:40 / Claus Gittinger"
     "Modified: / 02-08-2018 / 16:07:35 / Stefan Vogel"
+    "Modified: / 12-02-2019 / 17:42:11 / Claus Gittinger"
 !
 
 recursiveSetExpandedAndAddToList:aList
+    <resource: #obsolete>
     "expand all children and sub-children without notifications;
      add children to list"
 
@@ -1734,23 +1784,25 @@
      Helper; not synchronized - should only be called internally
      within a synchronized region."
 
-    |toDo toExpand|
-
-    toDo := OrderedCollection with:self.
+    |toDo work toExpand indexToAddAfter|
+
+    toDo := OrderedCollection with:(self -> aList size).
     [ toDo notEmpty ] whileTrue:[
-        toExpand := toDo removeFirst.
+        work := toDo removeFirst.
+        toExpand := work key.
+        indexToAddAfter := work value.
         toExpand setExpanded:true.
-
-        toExpand nonCriticalFrom:1 to:nil do:[:eachChild|
-            aList add:eachChild.
-
-            eachChild canRecursiveExpand ifTrue:[
-                 toDo add:eachChild
+        (children := toExpand children) size > 0 ifTrue:[
+            aList addAll:children afterIndex:indexToAddAfter.
+            children doWithIndex:[:eachChild :index |
+                eachChild canRecursiveExpand ifTrue:[
+                     toDo add:(eachChild -> (indexToAddAfter+index))
+                ].
             ].
         ].
     ].
 
-    "Modified (comment): / 28-07-2018 / 14:00:04 / Claus Gittinger"
+    "Modified: / 12-02-2019 / 17:08:48 / Claus Gittinger"
 ! !
 
 !AbstractHierarchicalItem methodsFor:'private-to be redefined'!