*** empty log message ***
authorClaus Gittinger <cg@exept.de>
Mon, 06 Nov 2006 11:45:32 +0100
changeset 10153 73f14e708d88
parent 10152 682522b59c9d
child 10154 abf2c5f9ba8c
*** empty log message ***
Filename.st
--- a/Filename.st	Sat Oct 28 16:11:17 2006 +0200
+++ b/Filename.st	Mon Nov 06 11:45:32 2006 +0100
@@ -9,7 +9,6 @@
  other person.  No title to or ownership of the software is
  hereby transferred.
 "
-
 "{ Package: 'stx:libbasic' }"
 
 Object subclass:#Filename
@@ -3906,7 +3905,7 @@
      or the contents is unknown.
      This is done using some heuristics, and may need some improvement"
 
-    |type buffer s size idx idx2|
+    |type buffer lcBuffer s size idx idx2|
 
     type := self type.
     type isNil ifTrue:[
@@ -3938,20 +3937,34 @@
         size := s nextBytes:buffer size into:buffer.
     ].
     s close.
-    buffer := buffer asLowercase.
-
-    (idx := buffer findString:'mimetype:') ~~ 0 ifTrue:[
+    lcBuffer := buffer asLowercase.
+
+    (idx := lcBuffer findString:'mimetype:') ~~ 0 ifTrue:[
         idx := idx + 'mimetype:' size.
-        idx := buffer indexOfNonSeparatorStartingAt:idx.
-        idx2 := buffer indexOfSeparatorStartingAt:idx.
+        idx := lcBuffer indexOfNonSeparatorStartingAt:idx.
+        idx2 := lcBuffer indexOfSeparatorStartingAt:idx.
         idx2 > idx ifTrue:[
-            ^ buffer copyFrom:idx to:idx2-1
+            ^ lcBuffer copyFrom:idx to:idx2-1
         ].
     ].
 
     #(
+        ( 'lnk' #[16r4C 16r00 16r00 16r00 16r01 16r14 16r02 16r00 16r00 16r00 16r00 16r00 16rC0 16r00 16r00 16r00 16r00 16r00 16r00 16r46] 'application/x-ms-shortcut' )
+     ) triplesDo:[:suffixMatch :pattern :what |
+        |patternString|
+
+        (suffixMatch isNil or:[suffixMatch match:self suffix]) ifTrue:[
+            patternString := pattern asString.
+            (buffer startsWith:patternString) ifTrue:[
+                ^ 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')
@@ -3969,20 +3982,20 @@
             ('methodsfor:'              'application/x-smalltalk-source')
 
      ) pairsDo:[:pattern :what | 
-        (buffer findString:pattern) ~~ 0 ifTrue:[
+        (lcBuffer findString:pattern) ~~ 0 ifTrue:[
             ^ what
         ]
     ].
 
-    (idx := buffer findString:'<H') ~~ 0 ifTrue:[
-        ((buffer continuesWith:'<HEAD' startingAt:idx)
-        or:[(buffer continuesWith:'<HTML' startingAt:idx)
-        or:[(buffer continuesWith:'<H1' startingAt:idx)
-        or:[(buffer continuesWith:'<H2' startingAt:idx)
-        or:[(buffer continuesWith:'<H3' startingAt:idx)
-        or:[(buffer continuesWith:'<H4' startingAt:idx)
-        or:[(buffer continuesWith:'<H5' startingAt:idx)
-        or:[(buffer continuesWith:'<H6' startingAt:idx)]]]]]]])
+    (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:[
             ^ 'text/html'
         ]
@@ -3999,14 +4012,15 @@
      'Makefile' asFilename mimeTypeOfContents     
      '.' asFilename mimeTypeOfContents            
      '/dev/null' asFilename mimeTypeOfContents 
-     '/tmp/.X11-unix/X0' asFilename mimeTypeOfContents 
-     'smalltalk.rc' asFilename mimeTypeOfContents    
+     '/tmp/.X11-unix/X0' asFilename mimeTypeOfContents   
+     'smalltalk.rc' asFilename mimeTypeOfContents     
      'bitmaps/SBrowser.xbm' asFilename mimeTypeOfContents    
-     '../../rules/stmkmf' asFilename mimeTypeOfContents
-     '/bläh' asFilename mimeTypeOfContents
-    "
-
-    "Modified: / 19.11.1999 / 15:58:29 / cg"
+     '../../rules/stmkmf' asFilename mimeTypeOfContents 
+     '/bläh' asFilename mimeTypeOfContents      
+     'C:\Dokumente und Einstellungen\cg\Favoriten\languages.lnk' asFilename mimeTypeOfContents
+    "
+
+    "Modified: / 06-11-2006 / 11:44:58 / cg"
 ! !
 
 !Filename methodsFor:'queries-path & name'!
@@ -5363,7 +5377,7 @@
 !Filename class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libbasic/Filename.st,v 1.307 2006-09-29 14:25:58 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/libbasic/Filename.st,v 1.308 2006-11-06 10:45:32 cg Exp $'
 ! !
 
 Filename initialize!