MIMETypes.st
changeset 1272 91ba4078b690
parent 1269 4362ec6dd5c2
child 1273 7a52d4bcdb10
--- a/MIMETypes.st	Mon Nov 22 16:05:05 1999 +0100
+++ b/MIMETypes.st	Wed Dec 01 11:19:43 1999 +0100
@@ -15,7 +15,8 @@
 Object subclass:#MIMETypes
 	instanceVariableNames:''
 	classVariableNames:'TypeToImageReaderClassMapping FileSuffixToTypeMapping
-		FileSuffixToImageReaderClassMapping CharSetToFontMapping'
+		FilenameToTypeMapping FileSuffixToImageReaderClassMapping
+		CharSetToFontMapping'
 	poolDictionaries:''
 	category:'System-Documentation'
 !
@@ -105,11 +106,11 @@
 
         "/ video formats ...
 
-        'movie'                         'video/x-sgi-movie'
-        'avi'                           'video/x-msvideo'
-        ('qt' 'mov' 'moov')             'video/quicktime'
-        ('mpv2' 'mp2v' 'mp2' 'mpeg2')         'video/x-mpeg2'
-        ('mpv' 'mpegv' 'mpg' 'mpeg' 'mpe')    'video/mpeg'
+        'movie'                            'video/x-sgi-movie'
+        'avi'                              'video/x-msvideo'
+        ('qt' 'mov' 'moov')                'video/quicktime'
+        ('mpv2' 'mp2v' 'mp2' 'mpeg2')      'video/x-mpeg2'
+        ('mpv' 'mpegv' 'mpg' 'mpeg' 'mpe') 'video/mpeg'
 
         "/ audio formats ...
 
@@ -124,7 +125,7 @@
         "/ progr. languages
         'st'                    'application/x-smalltalk-source'
         ('js' 'mocha')          'application/x-javascript'
-        'java'                  'application/x-java-source'
+        ('java' 'jav')          'application/x-java-source'
         'sh'                    'application/x-sh'
         'csh'                   'application/x-csh'
         'tcl'                   'application/x-tcl'
@@ -148,6 +149,17 @@
         ]
     ].
 
+    FilenameToTypeMapping := Dictionary new.
+    #(
+        ('makefile' 'make.proto')  'application/x-make'
+    ) pairWiseDo:[:nm :type|
+        nm isArray ifTrue:[
+            nm do:[:s | FilenameToTypeMapping at:s put:type]
+        ] ifFalse:[
+            FilenameToTypeMapping at:nm put:type
+        ]
+    ].
+
     "/ setup mimeType to image reader class mapping ...
 
     typeToImageReaderClassMapping at:'image/jpeg' put:JPEGReader.
@@ -313,6 +325,48 @@
     "Modified: / 1.8.1998 / 17:02:40 / cg"
 !
 
+mimeTypeForFilename:filename
+    "given a filename, return the mime-type or nil, if unknown"
+
+    |type lcFilename|
+
+    lcFilename := filename asFilename name asLowercase.
+    type := FilenameToTypeMapping at:lcFilename ifAbsent:nil.
+    type isNil ifTrue:[
+        "/ allow for fallback ...
+        type := OperatingSystem mimeTypeForFilename:lcFilename.
+        "/ the special value #unknown is returned as nil;
+        "/ this avoids constant retry if a mimeType is not known in
+        "/ the OS.
+        type isNil ifTrue:[
+            (#('make.proto'
+               'makefile'
+            ) includes:lcFilename) ifTrue:[
+                type := 'application/x-make'
+            ].
+        ].
+        type isNil ifTrue:[
+            FilenameToTypeMapping at:lcFilename put:#unknown
+        ].
+    ].
+
+    type == #unknown ifTrue:[
+        type := nil.
+    ].
+    ^ type
+
+!
+
+mimeTypeForFilename:filename put:mimeType
+    "register a mime type for a filename"
+
+    FilenameToTypeMapping isNil ifTrue:[
+        FilenameToTypeMapping := Dictionary new
+    ].
+    FilenameToTypeMapping at:filename put:mimeType asLowercase
+
+!
+
 mimeTypeForSuffix:suffix
     "given a file suffix, return the mime-type"
 
@@ -331,7 +385,7 @@
         ].
     ].
     type == #unknown ifTrue:[
-        ^ nil
+        type := nil
     ].
     ^ type
 
@@ -354,6 +408,6 @@
 !MIMETypes class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libview2/MIMETypes.st,v 1.18 1999-11-19 14:18:51 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/libview2/MIMETypes.st,v 1.19 1999-12-01 10:19:43 cg Exp $'
 ! !
 MIMETypes initialize!