Filename.st
changeset 16755 c71ec8d77abd
parent 16676 0055047fdd76
child 16761 3b2057603c18
equal deleted inserted replaced
16754:0e2a27636731 16755:c71ec8d77abd
  3561      Warning:
  3561      Warning:
  3562          Since the returned string differs among systems (and language settings),
  3562          Since the returned string differs among systems (and language settings),
  3563          it is only useful for user-information; 
  3563          it is only useful for user-information; 
  3564          NOT as a tag to be used by a program."
  3564          NOT as a tag to be used by a program."
  3565 
  3565 
  3566     |buffer s n suffix idx baseNm info|
  3566     |suffix baseNm info mime|
  3567 
  3567 
  3568     "/ since we cannot depend on a 'file' command being available,
  3568     "/ since we cannot depend on a 'file' command being available,
  3569     "/ do the most obvious ones here. 
  3569     "/ do the most obvious ones here. 
  3570     "/ (also useful since the 'file' command takes some time, and the code
  3570     "/ (also useful since the 'file' command takes some time, and the code
  3571     "/  below is faster for common things like directories)
  3571     "/  below is faster for common things like directories)
  3600     info fileSize == 0 ifTrue:[^ 'empty'].
  3600     info fileSize == 0 ifTrue:[^ 'empty'].
  3601 
  3601 
  3602     suffix := self suffix asLowercase.
  3602     suffix := self suffix asLowercase.
  3603     baseNm := self withoutSuffix baseName asLowercase.
  3603     baseNm := self withoutSuffix baseName asLowercase.
  3604 
  3604 
  3605     ((#('st' 'rc' 'chg' 'htm' 'html' 'ps' 'cls' 'pac') includes:suffix)
  3605     mime := self mimeTypeOfContents.
  3606     or:[#('makefile') includes:baseNm]) ifTrue:[
  3606     mime notNil ifTrue:[
  3607 
  3607         "/ kludge to avoid making libview a prereq. of libbasic
  3608         buffer := String new:2048.
  3608         (Smalltalk at:#MIMETypes) notNil ifTrue:[
  3609         s := self readStreamOrNil.
  3609             info := (Smalltalk at:#MIMETypes) fileInfoForMimeType:mime.
  3610         s notNil ifTrue:[
  3610             info notNil ifTrue:[^ info].
  3611             n := s nextBytes:buffer size into:buffer.
  3611         ].
  3612             s close.
  3612     ].
  3613             buffer := buffer asLowercase.
       
  3614             (#('st' 'cls') includes:suffix) ifTrue:[
       
  3615                 #(
       
  3616                         ('from squeak'        'smalltalk source (Squeak)')
       
  3617                         ('from dolphin'       'smalltalk source (Dolphin)')
       
  3618                         ('from visualworks'   'smalltalk source (VisualWorks)')
       
  3619                         ('categoriesforclass' 'smalltalk source (Dolphin)')
       
  3620                         ('methodsfor!!'        'smalltalk source (Dolphin, ST/V or V''age)')
       
  3621                         ('subclass:'          'smalltalk source')
       
  3622                         ('methodsfor:'        'smalltalk source')
       
  3623                  ) pairsDo:[:pattern :what | 
       
  3624                     (buffer findString:pattern) ~~ 0 ifTrue:[
       
  3625                         ^ what
       
  3626                     ]
       
  3627                 ].
       
  3628             ].
       
  3629 
       
  3630             (buffer findString:'methodsfor:') ~~ 0 ifTrue:[
       
  3631                 ^ 'smalltalk changes / method source'
       
  3632             ].
       
  3633 
       
  3634             (suffix = 'rc') ifTrue:[
       
  3635                 (buffer findString:'st/x startup') ~~ 0 ifTrue:[
       
  3636                     ^ 'smalltalk startup script'
       
  3637                 ].
       
  3638             ].
       
  3639 
       
  3640             (suffix = 'htm' or:[suffix = 'html']) ifTrue:[
       
  3641                 (idx := buffer findString:'<h') ~~ 0 ifTrue:[
       
  3642                     ((buffer continuesWith:'<head' startingAt:idx)
       
  3643                     or:[(buffer continuesWith:'<html' startingAt:idx)
       
  3644                     or:[(buffer continuesWith:'<h1' startingAt:idx)
       
  3645                     or:[(buffer continuesWith:'<h2' startingAt:idx)
       
  3646                     or:[(buffer continuesWith:'<h3' startingAt:idx)
       
  3647                     or:[(buffer continuesWith:'<h4' startingAt:idx)
       
  3648                     or:[(buffer continuesWith:'<h5' startingAt:idx)
       
  3649                     or:[(buffer continuesWith:'<h6' startingAt:idx)]]]]]]])
       
  3650                     ifTrue:[
       
  3651                         ^ 'HTML document text'
       
  3652                     ]
       
  3653                 ].
       
  3654             ].
       
  3655         
       
  3656             (suffix = 'ps') ifTrue:[
       
  3657                 (buffer findString:'%!!ps-adobe') ~~ 0 ifTrue:[
       
  3658                     ^ 'PostScript document'
       
  3659                 ].
       
  3660             ].
       
  3661 
       
  3662             (baseNm = 'makefile') ifTrue:[
       
  3663                 (buffer startsWith:'#') ifTrue:[
       
  3664                     ^ 'make rules'
       
  3665                 ]
       
  3666             ]
       
  3667         ]
       
  3668     ].
       
  3669 
       
  3670     ^ 'file'
  3613     ^ 'file'
  3671 
  3614 
  3672     "
  3615     "
  3673      'Makefile' asFilename fileType 
  3616      'Makefile' asFilename fileType 
  3674      '.' asFilename fileType     
  3617      '.' asFilename fileType     
  4439      This could be less accurate than mimeTypeOfContents, but avoids
  4382      This could be less accurate than mimeTypeOfContents, but avoids
  4440      reading the file (is therefore much faster).
  4383      reading the file (is therefore much faster).
  4441      Also it works with non-existing files.
  4384      Also it works with non-existing files.
  4442      Returns nil for directories and other non-regular files."
  4385      Returns nil for directories and other non-regular files."
  4443 
  4386 
  4444     ^ MIMETypes mimeTypeForFilename:(self name)
  4387     "/ kludge to avoid making libview a prereq. of libbasic
       
  4388     (Smalltalk at:#MIMETypes) notNil ifTrue:[
       
  4389         ^ (Smalltalk at:#MIMETypes) mimeTypeForFilename:(self name)
       
  4390     ].
       
  4391     ^ nil
  4445 
  4392 
  4446     "
  4393     "
  4447      'Makefile' asFilename mimeTypeFromName     
  4394      'Makefile' asFilename mimeTypeFromName     
  4448      '.' asFilename mimeTypeFromName            
  4395      '.' asFilename mimeTypeFromName            
  4449      '/dev/null' asFilename mimeTypeFromName   
  4396      '/dev/null' asFilename mimeTypeFromName   
  4484     ] do:[
  4431     ] do:[
  4485         size := s nextBytes:buffer size into:buffer.
  4432         size := s nextBytes:buffer size into:buffer.
  4486     ].
  4433     ].
  4487     s close.
  4434     s close.
  4488 
  4435 
  4489     ^ MIMETypes mimeTypeOfData:buffer
  4436     "/ kludge to avoid making libview a prereq. of libbasic
  4490 
  4437     (Smalltalk at:#MIMETypes) notNil ifTrue:[
  4491 "/    lcBuffer := buffer asLowercase.
  4438         ^ (Smalltalk at:#MIMETypes) mimeTypeOfData:buffer
  4492 "/
  4439     ].
  4493 "/    (idx := lcBuffer findString:'mimetype:') ~~ 0 ifTrue:[
  4440     ^ nil
  4494 "/        idx := idx + 'mimetype:' size.
       
  4495 "/        idx := lcBuffer indexOfNonSeparatorStartingAt:idx.
       
  4496 "/        idx2 := lcBuffer indexOfSeparatorStartingAt:idx.
       
  4497 "/        idx2 > idx ifTrue:[
       
  4498 "/            ^ lcBuffer copyFrom:idx to:idx2-1
       
  4499 "/        ].
       
  4500 "/    ].
       
  4501 "/
       
  4502 "/    #(
       
  4503 "/        ( 'lnk' #[16r4C 16r00 16r00 16r00 16r01 16r14 16r02 16r00 16r00 16r00 16r00 16r00 16rC0 16r00 16r00 16r00 16r00 16r00 16r00 16r46] 
       
  4504 "/                #'application/x-ms-shortcut' )
       
  4505 "/        ( 'top' 'WALTOP' 
       
  4506 "/                #'application/x-waltop-digital-notepad' )
       
  4507 "/     ) triplesDo:[:suffixMatch :pattern :what |
       
  4508 "/        |patternString|
       
  4509 "/
       
  4510 "/        (suffixMatch isNil or:[suffixMatch match:self suffix ignoreCase:true]) ifTrue:[
       
  4511 "/            patternString := pattern asString.
       
  4512 "/            (buffer startsWith:patternString) ifTrue:[
       
  4513 "/                ^ what
       
  4514 "/            ]
       
  4515 "/        ]
       
  4516 "/    ].
       
  4517 "/
       
  4518 "/    #(
       
  4519 "/            ('<body:'                   #'text/html')
       
  4520 "/            ('%!!ps-adobe'               #'application/postscript')
       
  4521 "/            ('%PDF-'                    #'application/pdf')
       
  4522 "/            ('#!! /bin/sh'               #'application/x-sh')
       
  4523 "/            ('#!!/bin/sh'                #'application/x-sh')
       
  4524 "/            "/ ('#!! /bin/bash'              'application/x-bash')
       
  4525 "/            "/ ('#!!/bin/bash'               'application/x-bash')
       
  4526 "/            ('<?xml version='           #'text/xml')
       
  4527 "/        
       
  4528 "/            ('from dolphin'             #'application/x-smalltalk-source')
       
  4529 "/            ('from visualworks'         #'application/x-smalltalk-source')
       
  4530 "/            ('categoriesforclass'       #'application/x-smalltalk-source')
       
  4531 "/            ('methodsfor!!'              #'application/x-smalltalk-source')
       
  4532 "/            ('subclass:'                #'application/x-smalltalk-source')
       
  4533 "/            ('methodsfor:'              #'application/x-smalltalk-source')
       
  4534 "/            ('interchangeversion:'      #'application/x-smalltalk-source-sif')
       
  4535 "/            ('subclass:'                #'application/x-smalltalk-source')
       
  4536 "/            ('methodsfor:'              #'application/x-smalltalk-source')
       
  4537 "/
       
  4538 "/     ) pairsDo:[:pattern :what | 
       
  4539 "/        (lcBuffer findString:pattern) ~~ 0 ifTrue:[
       
  4540 "/            ^ what
       
  4541 "/        ]
       
  4542 "/    ].
       
  4543 "/
       
  4544 "/    (idx := lcBuffer findString:'<h') ~~ 0 ifTrue:[
       
  4545 "/        ((lcBuffer continuesWith:'<head' startingAt:idx)
       
  4546 "/        or:[(lcBuffer continuesWith:'<html' startingAt:idx)
       
  4547 "/        or:[(lcBuffer continuesWith:'<h1' startingAt:idx)
       
  4548 "/        or:[(lcBuffer continuesWith:'<h2' startingAt:idx)
       
  4549 "/        or:[(lcBuffer continuesWith:'<h3' startingAt:idx)
       
  4550 "/        or:[(lcBuffer continuesWith:'<h4' startingAt:idx)
       
  4551 "/        or:[(lcBuffer continuesWith:'<h5' startingAt:idx)
       
  4552 "/        or:[(lcBuffer continuesWith:'<h6' startingAt:idx)]]]]]]])
       
  4553 "/        ifTrue:[
       
  4554 "/            ^ #'text/html'
       
  4555 "/        ]
       
  4556 "/    ].
       
  4557 "/
       
  4558 "/    [size ~~ 0 and:[(buffer at:size) isPrintable]] whileTrue:[size := size - 1].
       
  4559 "/
       
  4560 "/    size == 0 ifTrue:[
       
  4561 "/        ^ #'text/plain'
       
  4562 "/    ].
       
  4563 "/    ^ nil
       
  4564 
  4441 
  4565     "
  4442     "
  4566      'Makefile' asFilename mimeTypeOfContents     
  4443      'Makefile' asFilename mimeTypeOfContents     
  4567      '.' asFilename mimeTypeOfContents            
  4444      '.' asFilename mimeTypeOfContents            
  4568      '/dev/null' asFilename mimeTypeOfContents  
  4445      '/dev/null' asFilename mimeTypeOfContents  
  6166 ! !
  6043 ! !
  6167 
  6044 
  6168 !Filename class methodsFor:'documentation'!
  6045 !Filename class methodsFor:'documentation'!
  6169 
  6046 
  6170 version
  6047 version
  6171     ^ '$Header: /cvs/stx/stx/libbasic/Filename.st,v 1.422 2014-07-03 13:36:07 stefan Exp $'
  6048     ^ '$Header: /cvs/stx/stx/libbasic/Filename.st,v 1.423 2014-07-10 19:51:47 cg Exp $'
  6172 !
  6049 !
  6173 
  6050 
  6174 version_CVS
  6051 version_CVS
  6175     ^ '$Header: /cvs/stx/stx/libbasic/Filename.st,v 1.422 2014-07-03 13:36:07 stefan Exp $'
  6052     ^ '$Header: /cvs/stx/stx/libbasic/Filename.st,v 1.423 2014-07-10 19:51:47 cg Exp $'
  6176 ! !
  6053 ! !
  6177 
  6054 
  6178 
  6055 
  6179 Filename initialize!
  6056 Filename initialize!