"
 COPYRIGHT (c) 1997 by eXept Software AG 
	      All Rights Reserved

 This software is furnished under a license and may be used
 only in accordance with the terms of that license and with the
 inclusion of the above copyright notice.   This software may not
 be provided or otherwise made available to, or used by, any
 other person.  No title to or ownership of the software is
 hereby transferred.


"

"{ Package: 'stx:libview2' }"

Object subclass:#MIMETypes
	instanceVariableNames:''
	classVariableNames:'TypeToImageReaderClassMapping FileSuffixToTypeMapping
		FilenameToTypeMapping FileSuffixToImageReaderClassMapping
		CharSetToFontMapping LastSuffix LastType'
	poolDictionaries:''
	category:'System-Documentation'
!

!MIMETypes class methodsFor:'documentation'!

copyright
"
 COPYRIGHT (c) 1997 by eXept Software AG 
	      All Rights Reserved

 This software is furnished under a license and may be used
 only in accordance with the terms of that license and with the
 inclusion of the above copyright notice.   This software may not
 be provided or otherwise made available to, or used by, any
 other person.  No title to or ownership of the software is
 hereby transferred.


"
!

documentation
"
    just a place to keep MIME information
    (avoid spreading things at many places)

    MIMETypes is abstract and functional.
    Actually, in some OperatingSystems, this information may
    be found in some config files (or registries).
    Therefore, this class may have to be extended to support this
    and fetch the information from there eventually.

    [author:]
        Claus Gittinger
"
!

knownTypes
"
    simply a reminder for me ...

    application         mime                            file extentsions

        powerpoint      application/ms-powerpoint       .pot, .ppz, .ppt, .pps, 
                        application/mspowerpoint        
                        application/vnd.ms-powerpoint   
                        application/x-mspowerpoint

        shockwave       application/x-shockwave-flash   .swf     

        futuresplash    application/futuresplash        .spl
"
! !

!MIMETypes class methodsFor:'initialization'!

applicationComprAndArchiveTypeList
    "compressors and archivers"

    ^ #(

        'tar'                   'application/x-tar'
        'gtar'                  'application/x-gtar'
        'tgz'                   'application/x-tar-compressed'
        'zip'                   'application/x-zip-compressed'
        ('gz' 'z')              'application/x-gzip-compressed'
        'cpio'                  'application/x-cpio'
        'shar'                  'application/x-shar'
        'jar'                   'application/java-archive'
    )
!

applicationProgLangTypeList
    "applications for programm languages"

    ^ #(
        ('st' 'cls')                 'application/x-smalltalk-source'
        'sif'                        'application/x-smalltalk-source-sif'
        'c'                          'application/x-c-source'
        ('cc' 'cpp')                 'application/x-cpp-source'
        ('js' 'mocha')               'application/x-javascript'
        ('java' 'jav')               'application/x-java-source'
        'sh'                         'application/x-sh'
        'csh'                        'application/x-csh'
        'tcl'                        'application/x-tcl'
        'pl'                         'application/x-perl'
        'mak'                        'application/x-make'
        'bat'                        'application/x-batch-script'
        ('asn1' 'x409' 'gdmo' 'gdm') 'application/x-asn1-source'
    )
!

applicationTextTypeList
    "text applications"

    ^ #(
        ('ps' 'eps')                 'application/postscript'
        'pdf'                        'application/pdf'
        'rtf'                        'application/rtf'
        'doc'                        'application/winword'
    )
!

applicationTypeList
    "applications"

    |types|                            

    types := OrderedCollection new.
    types addAll:self applicationProgLangTypeList.
    types addAll:self applicationTextTypeList.
    types addAll:self applicationComprAndArchiveTypeList.
    ^ types
!

audioTypeList
    "audio formats ..."

    ^ #(
        ('ra' 'ram')            'audio/x-pn-realaudio'
        ('mpa' 'mpega')         'audio/x-mpeg'
        ('mp3' )                'audio/x-mp3'
        'wav'                   'audio/x-wav'
        ('aif' 'aiff' 'aifc')   'audio/x-aiff'
        ('au' 'snd')            'audio/basic'
        ('swf')                 'audio/x-shockwave-flash'
    )
!

imageTypeList

    ^ #(
        "/ image formats ...

        ('jpg' 'jpeg')  'image/jpeg'
        'gif'           'image/gif'
        ('tif' 'tiff')  'image/tiff'
        'xbm'           'image/x-xbitmap'
        'xpm'           'image/x-xpixmap'
        'png'           'image/x-png'
        'pcd'           'image/x-photo-cd'
        'bmp'           'image/x-MS-bmp'
        'rgb'           'image/x-rgb'
        'ppm'           'image/x-portable-pixmap'
        'pgm'           'image/x-portable-graymap'
        'pbm'           'image/x-portable-bitmap'
        'pnm'           'image/x-portable-anymap'
        'xwd'           'image/x-xwindowdump'
        'ras'           'image/x-cmu-raster'
        'tga'           'image/x-targa'

    ) 
!

initialize
    "initialize wellKnown facts"

    |typeToImageReaderClassMapping fileSuffixToTypeMapping
     fileSuffixToImageReaderClassMapping charSetToFontMapping types|

    LastSuffix := LastType := nil.

    (fileSuffixToImageReaderClassMapping := FileSuffixToImageReaderClassMapping) isNil ifTrue:[
        FileSuffixToImageReaderClassMapping := fileSuffixToImageReaderClassMapping := Dictionary new
    ].
    (typeToImageReaderClassMapping := TypeToImageReaderClassMapping) isNil ifTrue:[
        TypeToImageReaderClassMapping := typeToImageReaderClassMapping := Dictionary new
    ].
    (fileSuffixToTypeMapping := FileSuffixToTypeMapping) isNil ifTrue:[
        FileSuffixToTypeMapping := fileSuffixToTypeMapping := Dictionary new
    ].

    "/ setup file-suffix to mimeType mapping ...

    types := OrderedCollection new.
    types addAll:self textTypeList.
    types addAll:self imageTypeList.
    types addAll:self videoTypeList.
    types addAll:self audioTypeList.
    types addAll:self applicationTypeList.
    types pairWiseDo:[:suff :type|
        suff isArray ifTrue:[
            suff do:[:s | fileSuffixToTypeMapping at:s put:type]
        ] ifFalse:[
            fileSuffixToTypeMapping at:suff put:type
        ]
    ].

    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.
    typeToImageReaderClassMapping at:'image/gif'  put:GIFReader.
    typeToImageReaderClassMapping at:'image/tiff' put:TIFFReader.

    "/ setup suffix to image reader class mapping ...

    fileSuffixToImageReaderClassMapping at:'jpg'  put:JPEGReader.
    fileSuffixToImageReaderClassMapping at:'gif'  put:GIFReader.
    fileSuffixToImageReaderClassMapping at:'tif'  put:TIFFReader.


    "/ character sets (not really mime stuff, but also placed here)

    (charSetToFontMapping := CharSetToFontMapping) isNil ifTrue:[
        CharSetToFontMapping := charSetToFontMapping := Dictionary new
    ].

    #(
        'iso2022-jp'   'jis*0208*'
        'x-iso2022-jp' 'jis*0208*'
        'x-euc-jp'     'jis*0208*'
        'x-shift-jis'  'jis*0208*'
        'x-sjis'       'jis*0208*'
        'x-jis7'       'jis*0208*'
        'jis7'         'jis*0208*'
        'euc'          'jis*0208*'
        'euc-jp'       'jis*0208*'
        'sjis'         'jis*0208*'

        'big5'         'big5*'

        'gb2312'       'gb*'
        'hz-gb-2312'   'gb*'
        'x-gbk'        'gb*'

        'iso2022-kr'   'ksc*'
        'x-euc-kr'     'ksc*'
    ) pairWiseDo:[:charSet :fontEncoding|
         charSetToFontMapping at:charSet put:fontEncoding
    ].

    "
     self initialize
    "

    "Modified: / 19.11.1999 / 15:01:53 / cg"
!

textTypeList
   "/ misc text ...

    ^ #(
        ('htm' 'html')          'text/html'
        ('shtml')               'text/html'
        ('txt' 'text')          'text/plain'
    )
!

videoTypeList
    "/ 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'
    )
! !

!MIMETypes class methodsFor:'accessing'!

commentStringsForFilename:aFilename
    "return a useful comment definition; heuristics for now.
     The returned value is an array of 2 elements;
     the first is the end-of-line comment string (or nil);
     the second an array of opening/closing delimiters (or an array of nils)"

     |mime|

     mime := MIMETypes mimeTypeForFilename:aFilename.
     ^ self commentStringsForMimeType:mime suffix:(aFilename asFilename suffix)

    "
     MIMETypes commentStringsForFilename:'Makefile'.
     MIMETypes commentStringsForFilename:'Object.st'. 
     MIMETypes commentStringsForFilename:'Foo.java'. 
    "
!

commentStringsForFilename:aFilename ifUnknown:alternativeBlockReturningCommentString
    "return a useful comment definition; heuristics for now.
     The returned value is an array of 2 elements;
     the first is the end-of-line comment string (or nil);
     the second an array of opening/closing delimiters (or an array of nils)"

     |mime|

     mime := MIMETypes mimeTypeForFilename:aFilename.
     ^ self commentStringsForMimeType:mime suffix:(aFilename asFilename suffix) ifUnknown:alternativeBlockReturningCommentString

    "
     MIMETypes commentStringsForFilename:'Makefile'.
     MIMETypes commentStringsForFilename:'Object.st'. 
     MIMETypes commentStringsForFilename:'Foo.java'. 
    "
!

commentStringsForMimeType:mime suffix:suff
    "return a useful comment definition; heuristics for now.
     The returned value is an array of 2 elements;
     the first is the end-of-line comment string (or nil);
     the second an array of opening/closing delimiters (or an array of nils)"

    ^ self
        commentStringsForMimeType:mime suffix:suff 
        ifUnknown: #(';' (nil nil))  

    "
     |mime|

     mime := MIMETypes mimeTypeForFilename:'Makefile'.
     MIMETypes commentStringsForMimeType:mime suffix:nil.     
    "

    "
     |mime|

     mime := MIMETypes mimeTypeForFilename:'Object.st'.
     MIMETypes commentStringsForMimeType:mime suffix:nil.    
    "
!

commentStringsForMimeType:mime suffix:suff ifUnknown:alternativeBlockReturningCommentString
    "return a useful comment definition; heuristics for now.
     The returned value is an array of 2 elements;
     the first is the end-of-line comment string (or nil);
     the second an array of opening/closing delimiters (or an array of nils)"

    (mime = 'application/x-make') ifTrue:[
        "/ makefile
        ^ #('#' (nil nil)).
    ].
    (mime = 'application/x-sh') ifTrue:[
        "/ shell script
        ^ #('#' (nil nil)).
    ].
    ((mime = 'text/html') 
    or:[(mime = 'text/xml')
    or:[(mime = 'application/xml')]]) ifTrue:[
        ^ #(nil ('<!!-- ' ' -->')).
    ].
    (mime = 'application/x-batch-script') ifTrue:[
        ^ #('rem ' (nil nil)).
    ].
    (mime = 'application/x-smalltalk-source') ifTrue:[
        ^ #('"/' ('"' '"')).
    ].
    (mime = 'application/x-pascal-source') ifTrue:[
        ^ #(nil ('{' '}')).
    ].
    (mime = 'application/x-c-source') ifTrue:[
        ^ #(nil ('/*' '*/')).
    ].
    (mime = 'application/x-cpp-source') ifTrue:[
        ^ #('//' ('/*' '*/')).
    ].
    (mime = 'application/x-java-source') ifTrue:[
        ^ #('//' ('/*' '*/')).
    ].
    (mime = 'application/x-asn1-source') ifTrue:[
        ^ #('--' ('--' '--')).
    ].

    "/ st/x support files
    (suff = 'style') ifTrue:[
        ^ #(';' (nil nil)).
    ].
    (suff = 'rs') ifTrue:[
        ^ #(';' (nil nil)).
    ].

    ^ alternativeBlockReturningCommentString value

    "
     |mime|

     mime := MIMETypes mimeTypeForFilename:'Makefile'.
     MIMETypes commentStringsForMimeType:mime suffix:nil.     
    "

    "
     |mime|

     mime := MIMETypes mimeTypeForFilename:'Object.st'.
     MIMETypes commentStringsForMimeType:mime suffix:nil.    
    "
!

defineImageType:mimeType suffix:aSuffix reader:aReaderClass
    "register an image reader."

    aSuffix notNil ifTrue:[
        self imageReaderForSuffix:aSuffix put:aReaderClass.
    ].

    mimeType notNil ifTrue:[
        self imageReaderForType:mimeType put:aReaderClass
    ].

    (aSuffix notNil and:[mimeType notNil]) ifTrue:[
        self mimeTypeForSuffix:aSuffix put:mimeType
    ].
!

fileSuffixToImageReaderMapping
    "return the suffix-to-imageReader mapping"

    ^ FileSuffixToImageReaderClassMapping ? #()

    "Modified: / 1.8.1998 / 17:00:11 / cg"
!

fontForCharset:aCharSet
    "return the font-encoding for an iso-charset"

    ^ CharSetToFontMapping at:aCharSet ifAbsent:nil

    "
     MIMETypes fontForCharset:'iso2022-jp'       
     MIMETypes fontForCharset:'euc-jp'     
    "

    "Modified: / 1.8.1998 / 17:00:57 / cg"
!

imageFileSuffixes
    "return a collection with known file suffixes"

    FileSuffixToImageReaderClassMapping isNil ifTrue:[^ #()].
    ^ FileSuffixToImageReaderClassMapping keys

    "Created: / 30.6.1997 / 22:04:48 / cg"
    "Modified: / 1.8.1998 / 17:01:26 / cg"
!

imageReaderClasses
    "return a collection of registered image reader classes"

    |setOfClasses|

    setOfClasses := IdentitySet new.
    FileSuffixToImageReaderClassMapping notNil ifTrue:[
        FileSuffixToImageReaderClassMapping keysAndValuesDo:[:suff :cls |
            setOfClasses add:cls
        ].
    ].
    TypeToImageReaderClassMapping notNil ifTrue:[
        TypeToImageReaderClassMapping keysAndValuesDo:[:suff :cls |
            setOfClasses add:cls
        ].
    ].
    ^ setOfClasses

    "Created: / 30.6.1997 / 22:03:42 / cg"
    "Modified: / 1.8.1998 / 16:59:52 / cg"
!

imageReaderForSuffix:aSuffix
    "given a file suffix, return an approriate image reader class"

    FileSuffixToImageReaderClassMapping isNil ifTrue:[^ nil].
    ^ FileSuffixToImageReaderClassMapping at:aSuffix asLowercase ifAbsent:nil

    "Created: / 30.6.1997 / 21:59:11 / cg"
    "Modified: / 1.8.1998 / 17:01:58 / cg"
!

imageReaderForSuffix:aSuffix put:aReaderClass
    "register an image reader for a file suffix"

    FileSuffixToImageReaderClassMapping isNil ifTrue:[
        FileSuffixToImageReaderClassMapping := Dictionary new.
    ].
    FileSuffixToImageReaderClassMapping at:aSuffix asLowercase put:aReaderClass

    "Created: / 30.6.1997 / 21:59:43 / cg"
    "Modified: / 1.8.1998 / 17:02:14 / cg"
!

imageReaderForType:mimeTypeString
    "given a mime-type, return an approriate image reader class"

    TypeToImageReaderClassMapping isNil ifTrue:[^ nil].
    ^ TypeToImageReaderClassMapping at:mimeTypeString asLowercase ifAbsent:nil

    "Created: / 30.6.1997 / 21:56:01 / cg"
    "Modified: / 1.8.1998 / 17:02:28 / cg"
!

imageReaderForType:mimeTypeString put:aReaderClass
    "register an image reader for a mime-type"

    TypeToImageReaderClassMapping isNil ifTrue:[
        TypeToImageReaderClassMapping := Dictionary new.
    ].
    TypeToImageReaderClassMapping at:mimeTypeString asLowercase put:aReaderClass

    "Created: / 30.6.1997 / 21:56:11 / cg"
    "Modified: / 1.8.1998 / 17:02:40 / cg"
!

mimeTypeForFilename:filenameArg
    "given a filename, return the mime-type or nil, if unknown"

    |type filename lcFilename suff|

    filename := filenameArg asFilename.

    lcFilename := filename baseName 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:[
"/            FilenameToTypeMapping at:lcFilename put:#unknown
"/        ].
    ].

    type == #unknown ifTrue:[
        type := nil.
    ].

    type isNil ifTrue:[
        suff := filename suffix.
        suff size ~~ 0 ifTrue:[
            ^ self mimeTypeForSuffix:suff
        ]
    ].

    ^ 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"

    |type lcSuffix|

    lcSuffix := suffix asLowercase.
    lcSuffix = LastSuffix ifTrue:[
        type := LastType
    ] ifFalse:[
        type := FileSuffixToTypeMapping at:lcSuffix ifAbsent:nil.
        type isNil ifTrue:[
            "/ allow for fallback ...
            type := OperatingSystem mimeTypeForSuffix:lcSuffix.
            "/ the special value #unknown is returned as nil;
            "/ this avoids constant retry if a mimeType is not known in
            "/ the OS.
    "/        type isNil ifTrue:[
    "/            FileSuffixToTypeMapping at:lcSuffix put:#unknown
    "/        ].
        ].
        LastSuffix := lcSuffix.
        LastType := type.
    ].
    type == #unknown ifTrue:[
        type := nil
    ].
    ^ type

    "Created: / 30.6.1997 / 21:55:51 / cg"
    "Modified: / 23.12.1999 / 22:30:55 / cg"
!

mimeTypeForSuffix:suffix put:mimeType
    "register a mime type for a file suffix"

    FileSuffixToTypeMapping isNil ifTrue:[
        FileSuffixToTypeMapping := Dictionary new
    ].
    FileSuffixToTypeMapping at:suffix put:mimeType asLowercase

    "Created: / 30.6.1997 / 21:56:20 / cg"
    "Modified: / 1.8.1998 / 17:03:18 / cg"
!

mimeTypeForSuffixMapping

    ^ FileSuffixToTypeMapping
! !

!MIMETypes class methodsFor:'documentation'!

version
    ^ '$Header: /cvs/stx/stx/libview2/MIMETypes.st,v 1.38 2002-09-10 15:05:09 cg Exp $'
! !
MIMETypes initialize!