--- a/HierarchicalFileList.st Wed Oct 09 07:49:25 2002 +0200
+++ b/HierarchicalFileList.st Wed Oct 09 12:03:29 2002 +0200
@@ -14,7 +14,7 @@
"{ Package: 'stx:libwidg2' }"
HierarchicalList subclass:#HierarchicalFileList
- instanceVariableNames:'matchBlock showCursor mountPoints'
+ instanceVariableNames:'matchBlock showCursor mountPoints indicatorList indicatorTask'
classVariableNames:''
poolDictionaries:''
category:'Views-Support'
@@ -35,7 +35,7 @@
!
HierarchicalFileList::HierarchicalFileItem subclass:#Directory
- instanceVariableNames:'modificationTime'
+ instanceVariableNames:'modificationTime fetchOperation'
classVariableNames:''
poolDictionaries:''
privateIn:HierarchicalFileList
@@ -81,14 +81,14 @@
sel := ScrollableView for:HierarchicalListView miniScroller:true
origin:0.0@0.0 corner:1.0@1.0 in:top.
- sel list:list.
- list root expand.
-
sel doubleClickAction:[:i| (list at:i) toggleExpand ].
sel indicatorAction:[:i| (list at:i) toggleExpand ].
+ sel list:list.
+ list monitoringTaskDelay:0.2.
+
top open.
- [exEnd]
+ [exEnd]
"
! !
@@ -139,6 +139,21 @@
].
self root:directory
].
+!
+
+root:aRoot
+ "stop update-task
+ "
+ self criticalDo:[
+ indicatorList ifNotNil:[
+ indicatorList do:[:el| el resetFetchIndicator ].
+ indicatorList removeAll.
+ ]
+ ].
+ aRoot ifNotNil:[
+ showRoot ifFalse:[aRoot setExpanded:true ]
+ ].
+ ^ super root:aRoot
! !
!HierarchicalFileList methodsFor:'actions'!
@@ -326,6 +341,86 @@
^ node
! !
+!HierarchicalFileList methodsFor:'update'!
+
+startIndicatorValidationFor:anItem
+ "an item will be registered for an indication update
+ "
+ |prio|
+
+ self criticalDo:[
+ indicatorList size == 0 ifTrue:[
+ indicatorList := OrderedCollection new.
+ ] ifFalse:[
+ indicatorList removeIdentical:anItem ifAbsent:nil.
+ ].
+ "/ indicatorList addFirst:anItem.
+ indicatorList add:anItem.
+
+ indicatorTask ifNil:[
+ prio := Processor activePriority.
+ indicatorTask := [ self updateIndicatorCycle. ] forkAt:(prio - 1).
+ indicatorTask priorityRange:(prio-1 to:prio).
+ ]
+ ].
+!
+
+stopIndicatorValidationFor:anItem
+ "stop the indicator validation for an item
+ "
+ self criticalDo:[
+ indicatorList ifNotNil:[
+ indicatorList removeIdentical:anItem ifAbsent:nil.
+ anItem resetFetchIndicator.
+ ]
+ ].
+!
+
+updateIndicatorCycle
+ "run fetching indicator task cycle.
+ This is done in the background to avoid long startup
+ delays, in case the indicator information takes long to
+ gather (i.e. when reading directories)
+ "
+ |repeat task item|
+
+ repeat := true.
+ task := indicatorTask.
+
+ [ [ task notNil ] whileTrue:[
+ self criticalDo:[
+ ( dependents size ~~ 0 "/ no dependencies (stop task)
+ and:[indicatorList size ~~ 0] "/ nothing to do
+ ) ifTrue:[
+ item := indicatorList removeFirst.
+
+ (self includesIdentical:item) ifFalse:[
+ "/ no longer visible
+ item resetFetchIndicator.
+ item := nil
+ ]
+ ] ifFalse:[
+ item := indicatorTask := task := nil
+ ]
+ ].
+ item ifNotNil:[
+ item fetchIndicator.
+ Processor yield.
+ ].
+ ]
+ ] valueNowOrOnUnwindDo:[
+ task ifNotNil:[
+ "/ oops, process terminated
+ self criticalDo:[
+ "/ test whether a new task already started
+ indicatorTask == task ifTrue:[
+ indicatorTask := nil
+ ]
+ ]
+ ]
+ ].
+! !
+
!HierarchicalFileList::HierarchicalFileItem class methodsFor:'instance creation'!
fileName:aFileName
@@ -460,6 +555,19 @@
^ false
! !
+!HierarchicalFileList::Directory class methodsFor:'documentation'!
+
+documentation
+"
+ [Instance variables:]
+
+ fetchOperation <Symbol/Boolean> nil if children is nil, no information about has children
+ #active registered in list to be updated for indication
+ true has children but children list might be nil (remote)
+ false has no children but children list might be nil (remote)
+"
+! !
+
!HierarchicalFileList::Directory methodsFor:'accessing'!
children
@@ -467,46 +575,48 @@
"
|model|
- children notNil ifTrue:[
- ^ children
- ].
+ children ifNotNil:[ ^ children ].
- (model := self model) isNil ifTrue:[
- "/ must reread later
- modificationTime := children := nil.
- ^ nil
- ].
+ model := self model.
+ model ifNil:[ ^ nil ].
- true "readDirectoriesChildrenInBackground" ifTrue:[
- model triggerUpdateCycle.
- ^ nil.
+ model criticalDo:[
+ children ifNil:[ self readChildren ].
].
- self readChildren.
^ children
!
readChildren
"reads the list of children
"
- |model list|
+ |model list hadChildren hasChildren|
+
+ model := self model.
- (model := self model) isNil ifTrue:[
+ model ifNil:[
"/ must reread later
- modificationTime := children := nil.
- ^ nil
+ fetchOperation := modificationTime := children := nil.
+ ^ nil
].
+ hadChildren := children size ~~ 0.
+
+ "/ set to suppress reading of children
children := #().
+ fetchOperation := nil.
modificationTime := fileName modificationTime.
+ model stopIndicatorValidationFor:self.
+
list := model childrenFor:self.
list size ~~ 0 ifTrue:[
list do:[:aChild| aChild parent:self].
children := list.
].
+ hasChildren := children size ~~ 0.
- children size > 0 ifTrue:[
- self changed.
+ hasChildren ~~ hadChildren ifTrue:[
+ self changed:#redraw
].
^ children
! !
@@ -522,19 +632,8 @@
"expand children; must redefine to raise a notification
if children are not yet initialized and after initialization empty.
"
- |notInit|
-
- notInit := children isNil.
icon := nil.
super expand.
-
- notInit ifTrue:[
- (children notNil and:[children isEmpty]) ifTrue:[
- "/ no children exists
- "/ indicator +/- has changed to unexistant
- self changed:#redraw
- ]
- ].
!
recursiveCollapse
@@ -550,12 +649,72 @@
! !
+!HierarchicalFileList::Directory methodsFor:'fetching'!
+
+basicFetchIndicator
+ self readChildren.
+!
+
+fetchIndicator
+ "fetch the indicator value which indicates whether children exists or not
+ called by the list
+ "
+ children ifNotNil:[
+ "/ children already read
+ fetchOperation := nil.
+ ^ self
+ ].
+
+ fetchOperation ~~ #active ifTrue:[
+ "/ children will be updated ....
+ ^ self
+ ].
+ "/ suppress restart of fetchIndicator
+ fetchOperation := false.
+
+ self basicFetchIndicator.
+
+ children notNil ifTrue:[
+ fetchOperation := nil.
+ children notEmpty ifTrue:[ self changed:#redraw ].
+ ] ifFalse:[
+ "/ is a remote or very slow file system
+ fetchOperation == true ifTrue:[ self changed:#redraw ].
+ ].
+!
+
+resetFetchIndicator
+ "update indication cycle has deregistered the item
+ "
+ fetchOperation := nil.
+! !
+
!HierarchicalFileList::Directory methodsFor:'queries'!
hasChildren
"returns true if children exists
"
- ^ super hasChildren
+ |model|
+
+ children notNil ifTrue:[
+ fetchOperation := nil.
+ ^ children size ~~ 0
+ ].
+
+ fetchOperation ifNotNil:[
+ fetchOperation == #active ifTrue:[^ false].
+ ^ fetchOperation "/ true or false
+ ].
+
+ model := self model.
+
+ model notNil ifTrue:[
+ fetchOperation := #active.
+ model startIndicatorValidationFor:self.
+ ] ifFalse:[
+ fetchOperation := nil
+ ].
+ ^ false
!
isDirectory
@@ -571,16 +730,20 @@
invalidateRepairNow:doRepair
"invalidate contents
"
- modificationTime := nil.
+ fetchOperation := modificationTime := nil.
- doRepair ifTrue:[
- self monitoringCycle
- ] ifFalse:[
- (isExpanded or:[children size == 0]) ifFalse:[
- children := nil
+ isExpanded ifFalse:[
+ children := nil
+ ] ifTrue:[
+ doRepair ifTrue:[
+ self monitoringCycle
+ ] ifFalse:[
+ children size == 0 ifTrue:[
+ "/ expanded but no children added, thus can reset the children
+ children := nil
+ ]
]
].
-
!
matchBlockChanged
@@ -589,71 +752,60 @@
modificationTime := nil.
isExpanded ifFalse:[
- children := nil.
+ fetchOperation := children := nil.
] ifTrue:[
self monitoringCycle.
children size ~~ 0 ifTrue:[
- children do:[:aChild| aChild matchBlockChanged]
+ children do:[:aChild| aChild matchBlockChanged ]
]
].
!
monitoringCycle
"run monitoring cycle
+ !!!! called by the HierarchicalList only !!!!
"
- |list existingNames size name modifyTime isNotEmpty wasNotEmpty model shownNames|
-
- children isNil ifTrue:[
- self readChildren.
- ].
+ |list existingNames size name modifyTime model shownNames|
modifyTime := fileName modificationTime.
- (modificationTime notNil and:[modifyTime <= modificationTime]) ifTrue:[
- ^ self
+
+ children ifNotNil:[
+ (modificationTime notNil and:[modifyTime <= modificationTime]) ifTrue:[
+ ^ self
+ ].
].
-
- "/ something changed
icon := nil.
-
- model := self model.
modificationTime := modifyTime.
isExpanded ifFalse:[
-
- "/ CHECK WHETHER CHILDREN EXIST( INDICATOR )
- "/ =========================================
-
- isNotEmpty := model hasChildrenFor:self.
-
- "/ check whether has changed durring evaluation
- (isExpanded or:[modificationTime ~= modifyTime]) ifFalse:[
- wasNotEmpty := children isNil.
- children := isNotEmpty ifTrue:[nil] ifFalse:[#()].
+ "/ collapsed; only indicator must be updated
+ fetchOperation := children := nil.
+ self changed:#redraw.
+ ^ self
+ ].
+ model := self model.
+ children ifNil:[ children := #() ]. "/ disable update during merge
- wasNotEmpty ~~ isNotEmpty ifTrue:[
- self changed
- ]
- ].
- ^ self
-
- ].
-
- "/ START MERGING( CONTENTS IS VISIBLE )
- "/ ====================================
+ size := children size.
+ fetchOperation := nil.
list := model childrenFor:self.
- list size == 0 ifTrue:[ "/ contents becomes empty
- self removeAll. "/ clear contents
- ^ self.
+ list size == 0 ifTrue:[
+ self removeAll.
+ ^ self
].
- size := children size.
- size == 0 ifTrue:[ "/ old contents was empty
- self addAll:list. "/ take over new contents
- ^ self.
+
+ size == 0 ifTrue:[
+ self addAll:list.
+ ^ self
].
+
+
+
+
existingNames := Set new:list size.
list do:[:l| existingNames add:l baseName].
size to:1 by:-1 do:[:anIndex| "/ remove invisible items from tail
@@ -678,8 +830,17 @@
^ true
! !
+!HierarchicalFileList::RemoteDirectory methodsFor:'validation'!
+
+basicFetchIndicator
+ "fetch the indicator value; hasChildren or not
+ "
+ fetchOperation := DirectoryContents directoryNamed:fileName
+ detect:(self model matchBlock).
+! !
+
!HierarchicalFileList class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libwidg2/HierarchicalFileList.st,v 1.23 2002-10-08 13:14:39 penk Exp $'
+ ^ '$Header: /cvs/stx/stx/libwidg2/HierarchicalFileList.st,v 1.24 2002-10-09 10:03:29 ca Exp $'
! !