--- a/HierarchicalFileList.st Thu Oct 10 09:00:20 2002 +0200
+++ b/HierarchicalFileList.st Thu Oct 10 09:33:05 2002 +0200
@@ -21,7 +21,7 @@
!
HierarchicalItem subclass:#HierarchicalFileItem
- instanceVariableNames:'fileName icon'
+ instanceVariableNames:'fileName icon fileInfo'
classVariableNames:''
poolDictionaries:''
privateIn:HierarchicalFileList
@@ -151,7 +151,7 @@
]
].
aRoot ifNotNil:[
- showRoot ifFalse:[aRoot setExpanded:true ]
+ self showRoot ifFalse:[aRoot setExpanded:true ]
].
^ super root:aRoot
! !
@@ -189,9 +189,9 @@
"
|index item mountInfo|
- mountPoints isNil ifTrue:[
- mountPoints := OperatingSystem mountPoints.
- ].
+"/ mountPoints isNil ifTrue:[
+"/ mountPoints := OperatingSystem mountPoints.
+"/ ].
item := root.
index := showRoot ifTrue:[1] ifFalse:[0].
@@ -202,22 +202,26 @@
[item notNil] whileTrue:[
item isDirectory ifTrue:[
- (item getChildren isNil) ifTrue:[
- "/ care for auto-mount points - we dont want to look into those automatically
- "/ i.e. user must explicitely click into them
- mountInfo := mountPoints detect:[:mInfo | mInfo mountPointPath = item fileName name] ifNone:nil.
- (mountInfo notNil and:[mountInfo isRemote]) ifTrue:[
- "/ type := #remoteFileSystem.
- item readChildren
- ] ifFalse:[
- "/ must read children info
- item readChildren
- ].
- ] ifFalse:[
- "/ children already initialized; thus we can update the contents
- item monitoringCycle
- ].
+ item monitoringCycle
].
+
+"/ item isDirectory ifTrue:[
+"/ (item getChildren isNil) ifTrue:[
+"/ "/ care for auto-mount points - we dont want to look into those automatically
+"/ "/ i.e. user must explicitely click into them
+"/ mountInfo := mountPoints detect:[:mInfo | mInfo mountPointPath = item fileName name] ifNone:nil.
+"/ (mountInfo notNil and:[mountInfo isRemote]) ifTrue:[
+"/ "/ type := #remoteFileSystem.
+"/ item readChildren
+"/ ] ifFalse:[
+"/ "/ must read children info
+"/ item readChildren
+"/ ].
+"/ ] ifFalse:[
+"/ "/ children already initialized; thus we can update the contents
+"/ item monitoringCycle
+"/ ].
+"/ ].
Processor yield.
index := index + 1.
item := self at:index ifAbsent:nil.
@@ -463,6 +467,55 @@
"/ baseName := fname baseName.
!
+filePropertyFor:aKey
+
+ | suffix retVal |
+
+ fileInfo isNil ifTrue:[
+ fileInfo := IdentityDictionary new.
+ ].
+ retVal := fileInfo at:aKey ifAbsent:nil.
+ retVal notNil ifTrue:[ ^ retVal].
+ aKey == #suffix ifTrue:[
+ suffix := (OperatingSystem isUNIXlike and:[(self baseName at:1) == $.]) ifTrue:[
+ suffix := ''.
+ ] ifFalse:[
+ suffix := fileName suffix.
+ ].
+ fileInfo at:#suffix put:suffix.
+ ^ suffix
+ ].
+ aKey == #permissions ifTrue:[
+ | permissions mode |
+ (mode := self valueAt:#mode) notNil ifTrue:[
+ permissions := String new:9 withAll:$-.
+
+ 1 to:9 by:3 do:[:i|
+ (mode bitAt:i ) == 1 ifTrue:[permissions at:10 - i put:$x].
+ (mode bitAt:i + 1) == 1 ifTrue:[permissions at:9 - i put:$w].
+ (mode bitAt:i + 2) == 1 ifTrue:[permissions at:8 - i put:$r].
+ ]
+ ].
+ fileInfo at:#permissions put:(permissions ? '???').
+ ^ permissions
+ ].
+ aKey == #owner ifTrue:[
+ | uid owner |
+ uid := self valueAt:#uid.
+ owner := uid notNil ifTrue:[OperatingSystem getUserNameFromID:uid] ifFalse:[^ '???'].
+ fileInfo at:#owner put:owner.
+ ^ owner
+ ].
+ aKey == #group ifTrue:[
+ | gid group |
+ gid := self valueAt:#gid.
+ group := gid notNil ifTrue:[OperatingSystem getGroupNameFromID:gid] ifFalse:[^ '???'].
+ fileInfo at:#group put:group.
+ ^ group
+ ].
+ ^ nil
+!
+
icon
"returns the icon key
"
@@ -490,6 +543,49 @@
"returns the pathName
"
^ fileName pathName
+!
+
+valueAt:aKey
+
+ |info suffix permissions mode|
+
+ fileInfo isNil ifTrue:[
+ fileInfo := IdentityDictionary new.
+ self isRemoteDirectory ifTrue:[
+ "/ do not access, to avoid automount
+ ] ifFalse:[
+ info := fileName linkInfo.
+ info isNil ifTrue:[
+ info := fileName info.
+ ].
+ info notNil ifTrue:[
+ fileInfo at:#size put:(info size).
+ fileInfo at:#mode put:(info mode).
+ fileInfo at:#type put:(info type).
+ fileInfo at:#uid put:(info uid).
+ fileInfo at:#gid put:(info gid).
+ fileInfo at:#accessed put:(info accessed).
+ fileInfo at:#modified put:(info modified).
+ ].
+ suffix := (OperatingSystem isUNIXlike and:[(self baseName at:1) == $.]) ifTrue:[
+ suffix := ''.
+ ] ifFalse:[
+ suffix := fileName suffix.
+ ].
+ fileInfo at:#suffix put:suffix.
+ (mode := self valueAt:#mode) notNil ifTrue:[
+ permissions := String new:9 withAll:$-.
+
+ 1 to:9 by:3 do:[:i|
+ (mode bitAt:i ) == 1 ifTrue:[permissions at:10 - i put:$x].
+ (mode bitAt:i + 1) == 1 ifTrue:[permissions at:9 - i put:$w].
+ (mode bitAt:i + 2) == 1 ifTrue:[permissions at:8 - i put:$r].
+ ]
+ ].
+ fileInfo at:#permissions put:(permissions ? '???').
+ ]
+ ].
+ ^ fileInfo at:aKey ifAbsent:nil
! !
!HierarchicalFileList::HierarchicalFileItem methodsFor:'invalidate'!
@@ -531,12 +627,44 @@
!HierarchicalFileList::HierarchicalFileItem methodsFor:'queries'!
+fileSize
+
+ ^ self valueAt:#size
+!
+
+group
+ "returns the owner
+ "
+ ^ self filePropertyFor:#group.
+!
+
isDirectory
^ false
!
isRemoteDirectory
^ false
+!
+
+owner
+ "returns the owner
+ "
+ ^ self filePropertyFor:#owner.
+!
+
+permissions
+
+ ^ self filePropertyFor:#permissions
+!
+
+suffix
+
+ ^ self filePropertyFor:#suffix.
+!
+
+time
+
+ ^ self valueAt:#modified
! !
!HierarchicalFileList::File methodsFor:'accessing'!
@@ -561,10 +689,10 @@
"
[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)
+ fetchOperation <Symbol/Boolean> nil if children is nil, no information about has children
+ #fetching registered in list to be updated for indication
+ #hasChildren registered in list to be updated for indication
+ #hasNoChildren has children but children list might be nil (remote)
"
! !
@@ -652,7 +780,20 @@
!HierarchicalFileList::Directory methodsFor:'fetching'!
basicFetchIndicator
- self readChildren.
+ |hasChildren|
+
+ hasChildren := DirectoryContents directoryNamed:fileName
+ detect:(self model matchBlock).
+ hasChildren ifTrue:[
+ fetchOperation := #hasChildren
+ ] ifFalse:[
+ fetchOperation := #hasNoChildren
+ ].
+ children isNil ifTrue:[
+ "setup modification time to suppress monitorCycle
+ "
+ modificationTime := fileName modificationTime.
+ ].
!
fetchIndicator
@@ -665,12 +806,11 @@
^ self
].
- fetchOperation ~~ #active ifTrue:[
+ fetchOperation ~~ #fetching ifTrue:[
"/ children will be updated ....
^ self
].
"/ suppress restart of fetchIndicator
- fetchOperation := false.
self basicFetchIndicator.
@@ -679,7 +819,9 @@
children notEmpty ifTrue:[ self changed:#redraw ].
] ifFalse:[
"/ is a remote or very slow file system
- fetchOperation == true ifTrue:[ self changed:#redraw ].
+ fetchOperation == #hasChildren ifTrue:[
+ self changed:#redraw
+ ].
].
!
@@ -702,19 +844,19 @@
].
fetchOperation ifNotNil:[
- fetchOperation == #active ifTrue:[^ false].
- ^ fetchOperation "/ true or false
+ ^ fetchOperation == #hasChildren
].
model := self model.
model notNil ifTrue:[
- fetchOperation := #active.
+ fetchOperation := #fetching.
model startIndicatorValidationFor:self.
] ifFalse:[
+ self error:'should not happen' mayProceed:true.
fetchOperation := nil
].
- ^ false
+ ^ children size ~~ 0
!
isDirectory
@@ -727,48 +869,16 @@
!HierarchicalFileList::Directory methodsFor:'validation'!
-invalidateRepairNow:doRepair
- "invalidate contents
- "
- fetchOperation := modificationTime := 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
- "called if the matchBlock changed
- "
- modificationTime := nil.
-
- isExpanded ifFalse:[
- fetchOperation := children := nil.
- ] ifTrue:[
- self monitoringCycle.
-
- children size ~~ 0 ifTrue:[
- children do:[:aChild| aChild matchBlockChanged ]
- ]
- ].
-!
-
-monitoringCycle
+XXmonitoringCycle
"run monitoring cycle
!!!! called by the HierarchicalList only !!!!
"
|list existingNames size name modifyTime model shownNames|
modifyTime := fileName modificationTime.
+ modifyTime isNil ifTrue:[
+ ^ self
+ ].
children ifNotNil:[
(modificationTime notNil and:[modifyTime <= modificationTime]) ifTrue:[
@@ -822,25 +932,143 @@
self add:anItem beforeIndex:anIndex
]
].
+!
+
+invalidateRepairNow:doRepair
+ "invalidate contents
+ "
+ fetchOperation := modificationTime := 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
+ "called if the matchBlock changed
+ "
+ modificationTime := nil.
+
+ isExpanded ifFalse:[
+ fetchOperation := children := nil.
+ ] ifTrue:[
+ self monitoringCycle.
+
+ children size ~~ 0 ifTrue:[
+ children do:[:aChild| aChild matchBlockChanged ]
+ ]
+ ].
+!
+
+monitoringCycle
+ "run monitoring cycle
+ !!!!!!!! called by the HierarchicalList only !!!!!!!!
+ "
+ |unusedDict addedItems mergedList size modifyTime model timeChanged|
+
+ modifyTime := fileName modificationTime.
+ modifyTime ifNil:[^ self].
+
+ timeChanged := (modificationTime isNil or:[modifyTime > modificationTime]).
+ modificationTime := modifyTime.
+
+ children ifNotNil:[
+ timeChanged ifFalse:[
+ ^ self
+ ].
+ ].
+ icon := nil.
+
+ isExpanded ifFalse:[
+ timeChanged ifTrue:[
+ fetchOperation := children := nil.
+ self changed:#redraw.
+ ].
+ ^ self
+ ].
+ model := self model.
+ children ifNil:[ children := #() ]. "/ disable update during merge
+
+
+ fetchOperation := nil.
+ mergedList := model childrenFor:self.
+
+ mergedList size == 0 ifTrue:[
+ self removeAll.
+ ^ self
+ ].
+
+ size := children size.
+
+ size == 0 ifTrue:[
+ self addAll:mergedList.
+ ^ self
+ ].
+
+ model criticalDo:[
+ addedItems := OrderedCollection new:128.
+ unusedDict := Dictionary new:size.
+
+ children do:[:el| unusedDict at:(el fileName) put:el ].
+
+ mergedList keysAndValuesDo:[:anIndex :anItem| |item|
+ item := unusedDict removeKey:(anItem fileName) ifAbsent:nil.
+
+ item notNil ifTrue:[
+ mergedList at:anIndex put:item
+ ] ifFalse:[
+ addedItems add:anItem.
+ anItem parent:self.
+ ].
+ ].
+ "/ 12 is hardcoded !!!!!!!!
+
+ (unusedDict size + addedItems size) > 12 ifTrue:[
+ "/ generate two nofifications: collapse and expand
+ self collapse.
+ children := mergedList.
+ self expand.
+ ] ifFalse:[
+ unusedDict do:[:el| self remove:el ].
+
+ addedItems notEmpty ifTrue:[
+ self addAll:addedItems
+ ].
+ "/ children order changed test
+ children := mergedList.
+ self childrenOrderChanged.
+ ].
+ ].
! !
!HierarchicalFileList::RemoteDirectory methodsFor:'queries'!
+hasChildren
+ "returns true if children exists
+ "
+ children notNil ifTrue:[
+ fetchOperation := nil.
+ ^ children size ~~ 0
+ ].
+ fetchOperation := #hasChildren.
+ ^ true
+!
+
isRemoteDirectory
^ 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.24 2002-10-09 10:03:29 ca Exp $'
+ ^ '$Header: /cvs/stx/stx/libwidg2/HierarchicalFileList.st,v 1.25 2002-10-10 07:33:05 penk Exp $'
! !