--- a/MIMETypes.st	Thu Dec 11 17:14:52 2008 +0100
+++ b/MIMETypes.st	Fri Dec 12 13:51:03 2008 +0100
@@ -822,6 +822,90 @@
     ^ MIMEType fromString:typeString.
 !
 
+mimeTypeOfData:someData
+    "this tries to guess the mime type of contents of someData.
+     Returns nil, if unknown.
+     This is done using some heuristics, and may need some improvement"
+
+    |buffer lcBuffer size idx idx2|
+
+    someData size == 0 ifTrue:[^ nil].
+
+    "/ read some data from the file ...
+    buffer := (someData copyTo:(2048 min:someData size)) asString.
+    lcBuffer := buffer asLowercase.
+
+    (idx := lcBuffer findString:'mimetype:') ~~ 0 ifTrue:[
+        idx := idx + 'mimetype:' size.
+        idx := lcBuffer indexOfNonSeparatorStartingAt:idx.
+        idx2 := lcBuffer indexOfSeparatorStartingAt:idx.
+        idx2 > idx ifTrue:[
+            ^ self fromString:(lcBuffer copyFrom:idx to:idx2-1)
+        ].
+    ].
+
+    #(
+        ( #[16r4C 16r00 16r00 16r00 16r01 16r14 16r02 16r00 16r00 16r00 16r00 16r00 16rC0 16r00 16r00 16r00 16r00 16r00 16r00 16r46] 
+                #'application/x-ms-shortcut' )
+        ( 'WALTOP' 
+                #'application/x-waltop-digital-notepad' )
+     ) pairsDo:[:pattern :what |
+        |patternString|
+
+        patternString := pattern asString.
+        (buffer startsWith:patternString) ifTrue:[
+            ^ self fromString:what
+        ]
+    ].
+
+    #(
+            ('<body:'                   #'text/html')
+            ('%!!ps-adobe'               #'application/postscript')
+            ('%PDF-'                    #'application/pdf')
+            ('#!! /bin/sh'               #'application/x-sh')
+            ('#!!/bin/sh'                #'application/x-sh')
+            "/ ('#!! /bin/bash'              'application/x-bash')
+            "/ ('#!!/bin/bash'               'application/x-bash')
+            ('<?xml version='           #'text/xml')
+
+            ('from dolphin'             #'application/x-smalltalk-source')
+            ('from visualworks'         #'application/x-smalltalk-source')
+            ('categoriesforclass'       #'application/x-smalltalk-source')
+            ('methodsfor!!'              #'application/x-smalltalk-source')
+            ('subclass:'                #'application/x-smalltalk-source')
+            ('methodsfor:'              #'application/x-smalltalk-source')
+            ('interchangeversion:'      #'application/x-smalltalk-source-sif')
+            ('subclass:'                #'application/x-smalltalk-source')
+            ('methodsfor:'              #'application/x-smalltalk-source')
+
+    ) pairsDo:[:pattern :what | 
+        (lcBuffer findString:pattern) ~~ 0 ifTrue:[
+            ^ self fromString:what
+        ]
+    ].
+
+    (idx := lcBuffer findString:'<h') ~~ 0 ifTrue:[
+        ((lcBuffer continuesWith:'<head' startingAt:idx)
+        or:[(lcBuffer continuesWith:'<html' startingAt:idx)
+        or:[(lcBuffer continuesWith:'<h1' startingAt:idx)
+        or:[(lcBuffer continuesWith:'<h2' startingAt:idx)
+        or:[(lcBuffer continuesWith:'<h3' startingAt:idx)
+        or:[(lcBuffer continuesWith:'<h4' startingAt:idx)
+        or:[(lcBuffer continuesWith:'<h5' startingAt:idx)
+        or:[(lcBuffer continuesWith:'<h6' startingAt:idx)]]]]]]])
+        ifTrue:[
+            ^ self fromString:'text/html'
+        ]
+    ].
+
+    [size ~~ 0 and:[(buffer at:size) isPrintable]] whileTrue:[size := size - 1].
+
+    size == 0 ifTrue:[
+        ^ self fromString:'text/plain'
+    ].
+    ^ nil
+!
+
 suffixForMimeType:mimeType
     "given a file suffix, return the mime-type"
 
@@ -1238,7 +1322,7 @@
 !MIMETypes class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libview2/MIMETypes.st,v 1.99 2008-12-02 15:32:21 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/libview2/MIMETypes.st,v 1.100 2008-12-12 12:51:03 cg Exp $'
 ! !
 
 MIMETypes initialize!