DropObject.st
changeset 2819 691218db6b3c
parent 2749 adec4c4c7874
child 2928 37224b335551
--- a/DropObject.st	Mon Feb 01 19:17:08 2010 +0100
+++ b/DropObject.st	Tue Feb 02 15:18:09 2010 +0100
@@ -384,12 +384,18 @@
 
 !DropObject::File methodsFor:'accessing'!
 
+fetchFileInfo
+    info isNil ifTrue:[
+        info := theObject info
+    ].
+    ^ info
+!
+
 theObject:aPathname
-    |f path|
+    |f|
 
     f := aPathname asFilename.
-    path := f pathName.
-    info := f info.
+"/    info := f info.
 
     super theObject:f
 
@@ -399,56 +405,54 @@
 !DropObject::File methodsFor:'queries'!
 
 asFilename
+    theObject isFilename ifTrue:[^ theObject].
+
     ^ theObject asString asFilename
 
     "Created: / 13-10-2006 / 17:22:24 / cg"
 !
 
 exists
-    "returns true if the file or directory exists
-    "
+    "returns true if the file or directory exists"
+
+    info isNil ifTrue:[ self fetchFileInfo ].
     ^ info notNil
 
     "Modified: 19.4.1997 / 12:49:30 / cg"
 !
 
 isDirectory
-    "checks whether file is a directory
-    "
-    ^ (info notNil and:[info type == #directory])
+    "checks whether file is a directory"
+
+    ^ self exists 
+        and:[ self fetchFileInfo type == #directory ]
 !
 
 isHtmlFile
-    "checks whether file is an html file
-    "
-    |suffixes pathName|
+    "checks whether file is an html file"
+
+    |mimeType|
 
     isHtmlFile isNil ifTrue:[
-        (info isNil or:[self isDirectory]) ifTrue:[
-            isHtmlFile := false
-        ] ifFalse:[
-            pathName   := theObject asString.
-            suffixes   := #( '.html' '.htm' '.HTML' '.HTM' ).
-            isHtmlFile := (suffixes findFirst:[:el|pathName endsWith:el]) ~~ 0
-        ]
+        isHtmlFile := self exists 
+                        and:[ self isDirectory not
+                        and:[ (mimeType := MIMETypes mimeTypeForFilename:(self asFilename)) notNil
+                        and:[ mimeType isHtml ]]].
+
+"/        isHtmlFile := self exists 
+"/                        and:[ self isDirectory not
+"/                        and:[ #( '.html' '.htm' '.HTML' '.HTM' ) includes: theObject suffix ]].
     ].
     ^ isHtmlFile
-
-    "Modified: 19.4.1997 / 12:49:37 / cg"
 !
 
 isImageFile
-    "returns true if file is an image file
-    "
-    |pathName|
+    "returns true if file is an image file"
 
     isImageFile isNil ifTrue:[
-        (info isNil or:[self isDirectory]) ifTrue:[
-            isImageFile := false
-        ] ifFalse:[
-            pathName    := theObject asString.
-            isImageFile := Image isImageFileSuffix:(pathName asFilename suffix).
-        ]
+        isImageFile := self exists 
+                        and:[self isDirectory not
+                        and:[ Image isImageFileSuffix:(self asFilename suffix) ]].
     ].
     ^ isImageFile
 
@@ -464,16 +468,16 @@
 
     isPrintable isNil ifTrue:[
         isPrintable := false.
-        (info isNil or:[ self isDirectory ]) ifFalse:[
-            stream := theObject readStreamOrNil.
+
+        (self exists and:[ self isDirectory not ]) ifTrue:[
+            stream := self asFilename readStreamOrNil.
             stream notNil ifTrue:[
                 buff := String new:nChars.
                 size := stream nextBytes:nChars into:buff.
                 stream close.
-                1 to:size do:[:i | 
-                    (buff at:i) isPrintable ifFalse:[
-                        ^ false
-                    ]
+
+                (buff contains:[:char | char isPrintable not]) ifTrue:[
+                    ^ false
                 ].
             ].
             isPrintable := true
@@ -580,5 +584,9 @@
 !DropObject class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libview2/DropObject.st,v 1.20 2009-09-22 08:22:40 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/libview2/DropObject.st,v 1.21 2010-02-02 14:18:09 cg Exp $'
+!
+
+version_CVS
+    ^ '$Header: /cvs/stx/stx/libview2/DropObject.st,v 1.21 2010-02-02 14:18:09 cg Exp $'
 ! !