hg/stx-libwidg2: comparison HierarchicalFileList.st

equal deleted inserted replaced

-:b2e2242fd240
+:24e9cca2b5f6
 	poolDictionaries:''
 	privateIn:HierarchicalFileList
 !
 HierarchicalFileList::HierarchicalFileItem subclass:#Directory
-	instanceVariableNames:'modificationTime makeIconGray quickChildrenInfo'
+	instanceVariableNames:'modificationTime makeIconGray quickChildrenInfo isInAccessible'
 	classVariableNames:'StateUnknown StateHasChildren StateHasNoChildren StateFetching'
 	poolDictionaries:''
 	privateIn:HierarchicalFileList
 !
 childrenFor:anItem
 "returns all visible children derived from the physical
 directory contents."
-|contents list matchBlock|
+|contents list match|
 anItem isDirectory ifFalse:[^ #()].
 contents := DirectoryContents directoryNamed:anItem fileName.
-contents isNil ifTrue:[ ^ #() ].
+(contents isNil or:[contents isReadable not]) ifTrue:[
-list := OrderedCollection new.
+anItem beInAccessible.
-matchBlock := self matchBlockFor:anItem.
+] ifFalse:[
+contents notEmpty ifTrue:[
-contents itemsDo:[:anItem|
+list  := OrderedCollection new.
-(matchBlock isNil or:[matchBlock value:(anItem fileName) value:(anItem isDirectory)]) ifTrue:[
+match := self matchBlockFor:anItem.
-list add:(HierarchicalFileItem forContentsItem:anItem).
-]
+contents itemsDo:[:each|
-].
+(    match isNil
+or:[match value:(each fileName) value:(each isDirectory)]
-list isEmpty ifTrue:[^ #()].
+) ifTrue:[
-list sort:self sortBlock.
+list add:(HierarchicalFileItem forContentsItem:each).
-^ list
+]
+].
+list notEmpty ifTrue:[
+list sort:self sortBlock.
+^ list
+].
+].
+].
+^ #()
 !
 hasChildrenFor:anItem
 "returns true if the physical directory contains at least
 one visible item; otherwise false."
 self fileName printOn:aStream
 ! !
 !HierarchicalFileList::HierarchicalFileItem methodsFor:'protocol'!
+displayIcon:anIcon atX:x y:y on:aGC
+"called to draw the icon - if the item is inaccessible
+a red cross is drawn over thge item"
+|x0 y0 y1 w|
+anIcon displayOn:aGC x:x y:y.
+self isInAccessible ifTrue:[
+aGC paint:(Color red).
+y0 := y + 1.
+y1 := y + anIcon height - 2.
+x0 := x - 1.
+w  := anIcon width.
+2 timesRepeat:[
+aGC displayLineFromX:x0 y:y0 toX:(x0 + w) y:y1.
+aGC displayLineFromX:x0 y:y1 toX:(x0 + w) y:y0.
+x0 := x0 + 1.
+].
+].
+!
 flushChildren
 "flush the children (because node is not visible)
 Can be redefined by subclass"
 children := nil.
 isDirectoryItem
 ^ self isDirectory
 "Created: / 23-02-2007 / 12:04:37 / User"
+!
+isInAccessible
+"answer true if the underlaying file is not accessible - for example a directors
+than we will draw a red cross through the item..."
+^ false
 !
 isRemoteDirectory
 ^ false
 !
 !
 icon
 "returns the icon"
-|nameKey|
+|nameKey filename|
 isExpanded ifTrue:[
-(makeIconGray == true) ifTrue:[
+makeIconGray == true ifTrue:[ nameKey := #directoryOpenGray ]
-nameKey := #directoryOpenGray
+ifFalse:[ nameKey := #directoryOpen ].
-] ifFalse:[
-nameKey := #directoryOpen
-]
 ] ifFalse:[
-makeIconGray == true ifTrue:[
+makeIconGray == true ifTrue:[ nameKey := #directoryGray ]
-nameKey := #directoryGray
-]
 ].
 nameKey notNil ifTrue:[
 ^ FileBrowser iconForKeyMatching:nameKey
 ].
+icon notNil ifTrue:[^ icon ].
-icon isNil ifTrue:[
-^ super icon
+filename := contentsItem fileName.
+self isRemoteDirectory ifTrue:[
+nameKey := FileBrowser iconKeyForRemoteDirectory:filename.
+] ifFalse:[
+contentsItem isSymbolicLink ifTrue:[
+icon := FileBrowser iconForLinkedDirectory.
+] ifFalse:[
+nameKey := filename mimeTypeFromName.
+nameKey isNil ifTrue:[ nameKey := #directory ].
+icon := FileBrowser iconForKeyMatching:nameKey.
+].
 ].
 ^ icon
 !
 label
 "/ set to suppress reading of children
 children := #().
 modificationTime := self fileName modificationTime.
 model stopIndicatorValidationFor:self.
+"/ set to false - will be set by my model during reading the contents
+isInAccessible := false.
 list := model childrenFor:self.
 list size ~~ 0 ifTrue:[
 list do:[:aChild| aChild parent:self].
 children := list.
 ! !
 !HierarchicalFileList::Directory methodsFor:'fetching'!
 basicFetchIndicator
-|linkName fileName hasChildren info fileItem|
+|linkName fileName hasChildren info fileItem model|
 fileName := self fileName.
 fileItem := DirectoryContents contentsItemForFileName:fileName.
 fileItem notNil ifTrue:[
 (OperatingSystem mountPoints contains:[:mp | mp mountPointPath = linkName and:[mp isRemote]]) ifTrue:[
 "do not follow mounted directories automatically (could be an NFS hardlink)"
 ^ self.
 ].
-hasChildren := self model notNil and:[ DirectoryContents directoryNamed:fileName detect:(self model matchBlock) ].
+(model := self model) notNil ifTrue:[
+isInAccessible := false.
+hasChildren := DirectoryContents
+directoryNamed:fileName
+detect:(model matchBlock)
+onOpenErrorDo:[:fn| isInAccessible := true ].
+] ifFalse:[
+hasChildren := false.
+].
 self knownToHaveChildren:hasChildren.
 "/ self assert:children isNil.
 (children isNil and:[info notNil]) ifTrue:[
 "setup modification time to suppress monitorCycle"
 quickChildrenInfo := StateFetching
 ! !
 !HierarchicalFileList::Directory methodsFor:'queries'!
+beInAccessible
+isInAccessible := true.
+!
 canExpand
 super canExpand ifTrue:[^ true].
 "/ in case we are currently fetching the subdirectory
 "/    self isFetchingChildrenInfo ifTrue:[
 isDirectory
 "always true here"
 ^ true
+!
+isInAccessible
+"answer true if the directory is not accessible"
+^ isInAccessible ? false
 ! !
 !HierarchicalFileList::Directory methodsFor:'validation'!
 invalidateRepairNow:doRepair
 ! !
 !HierarchicalFileList class methodsFor:'documentation'!
 version
-^ '$Header: /cvs/stx/stx/libwidg2/HierarchicalFileList.st,v 1.70 2008-12-17 09:18:46 ca Exp $'
+^ '$Header: /cvs/stx/stx/libwidg2/HierarchicalFileList.st,v 1.71 2008-12-19 08:59:27 ca Exp $'
 ! !
 HierarchicalFileList::Directory initialize!

changeset 3616	24e9cca2b5f6
parent 3611	fd548fa851ac
child 3617	86ab45e1e77f