# HG changeset patch
# User ca
# Date 1229677167 -3600
# Node ID 24e9cca2b5f6508e8d655306664171bbc76e4520
# Parent  b2e2242fd24061a4063206c7effbe85b0a32ab65
optimized directories

diff -r b2e2242fd240 -r 24e9cca2b5f6 HierarchicalFileList.st
--- a/HierarchicalFileList.st	Fri Dec 19 09:15:33 2008 +0100
+++ b/HierarchicalFileList.st	Fri Dec 19 09:59:27 2008 +0100
@@ -33,7 +33,7 @@
 !
 
 HierarchicalFileList::HierarchicalFileItem subclass:#Directory
-	instanceVariableNames:'modificationTime makeIconGray quickChildrenInfo'
+	instanceVariableNames:'modificationTime makeIconGray quickChildrenInfo isInAccessible'
 	classVariableNames:'StateUnknown StateHasChildren StateHasNoChildren StateFetching'
 	poolDictionaries:''
 	privateIn:HierarchicalFileList
@@ -332,25 +332,33 @@
     "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:[ ^ #() ].
 
-    list := OrderedCollection new.
-    matchBlock := self matchBlockFor:anItem.
+    (contents isNil or:[contents isReadable not]) ifTrue:[
+        anItem beInAccessible.
+    ] ifFalse:[
+        contents notEmpty ifTrue:[
+            list  := OrderedCollection new.
+            match := self matchBlockFor:anItem.
 
-    contents itemsDo:[:anItem|
-        (matchBlock isNil or:[matchBlock value:(anItem fileName) value:(anItem isDirectory)]) ifTrue:[
-            list add:(HierarchicalFileItem forContentsItem:anItem).
-        ]
+            contents itemsDo:[:each|
+                (    match isNil
+                 or:[match value:(each fileName) value:(each isDirectory)]
+                ) ifTrue:[
+                    list add:(HierarchicalFileItem forContentsItem:each).
+                ]
+            ].
+            list notEmpty ifTrue:[
+                list sort:self sortBlock.
+                ^ list
+            ].
+        ].
     ].
-
-    list isEmpty ifTrue:[^ #()].
-    list sort:self sortBlock.
-    ^ list
+    ^ #()
 !
 
 hasChildrenFor:anItem
@@ -725,6 +733,31 @@
 
 !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"
@@ -744,6 +777,13 @@
     "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
 !
@@ -819,26 +859,32 @@
 icon
     "returns the icon"
 
-    |nameKey|
+    |nameKey filename|
 
     isExpanded ifTrue:[
-        (makeIconGray == true) ifTrue:[
-            nameKey := #directoryOpenGray
-        ] ifFalse:[
-            nameKey := #directoryOpen
-        ]
+        makeIconGray == true ifTrue:[ nameKey := #directoryOpenGray ]
+                            ifFalse:[ nameKey := #directoryOpen ].
     ] ifFalse:[
-        makeIconGray == true ifTrue:[
-            nameKey := #directoryGray
-        ]
+        makeIconGray == true ifTrue:[ 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
 !
@@ -889,6 +935,8 @@
     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:[
@@ -936,7 +984,7 @@
 !HierarchicalFileList::Directory methodsFor:'fetching'!
 
 basicFetchIndicator
-    |linkName fileName hasChildren info fileItem|
+    |linkName fileName hasChildren info fileItem model|
 
     fileName := self fileName.
     fileItem := DirectoryContents contentsItemForFileName:fileName.
@@ -956,7 +1004,17 @@
         ^ 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.
 
@@ -1060,6 +1118,10 @@
 
 !HierarchicalFileList::Directory methodsFor:'queries'!
 
+beInAccessible
+    isInAccessible := true.
+!
+
 canExpand
     super canExpand ifTrue:[^ true].
 
@@ -1116,6 +1178,12 @@
     "always true here"
 
     ^ true
+!
+
+isInAccessible
+    "answer true if the directory is not accessible"
+
+    ^ isInAccessible ? false
 ! !
 
 !HierarchicalFileList::Directory methodsFor:'validation'!
@@ -1262,7 +1330,7 @@
 !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!