PCFilename.st
author Claus Gittinger <cg@exept.de>
Wed, 14 Mar 2001 01:26:17 +0100
changeset 5826 2501b04853eb
parent 4374 0b2a18a8cf84
child 7062 44e3fe28aea0
permissions -rw-r--r--
*** empty log message ***

"
 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:libbasic' }"

Filename subclass:#PCFilename
	instanceVariableNames:''
	classVariableNames:'StandardSuffixTable'
	poolDictionaries:''
	category:'OS-Windows'
!

!PCFilename 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
"
    Filenames in Windows-NT / Win95.
"
! !

!PCFilename class methodsFor:'initialization'!

initStandardSuffixTable
    "since there is no 'file' command to extract the type,
     return a guess based upon the files suffix. The following
     table defines what is returned."

    StandardSuffixTable := Dictionary new.
    #(  
	'COM'   'executable'
	'DIR'   'directory'
	'EXE'   'executable'
	'LST'   'listing'
	'OBJ'   'object file'
	'TMP'   'temporary'
	'BAS'   'basic source'
	'C'     'c source'
	'COB'   'cobol source'
	'FOR'   'fortran source'
	'PAS'   'pascal source'
	'PL1'   'PL/1 source'
	'ST'    'smalltalk source'
	'STH'   'stc generated header'
	'DLL'   'dynamic link library'
    ) pairWiseDo:[:k :v |
	StandardSuffixTable at:k put:v
    ]

    "
     StandardSuffixTable := nil.
     self initStandardSuffixTable
    "

    "Modified: 16.10.1997 / 13:12:39 / cg"
! !

!PCFilename class methodsFor:'instance creation'!

newTemporaryIn:aDirectoryPrefix
    "return a new unique filename - use this for temporary files.
     redefined to always return an MSDOS 8+3 fileName,
     in case the tempFile is passed to an OLD dos utility.."

    |pid nr nameString|

    (self ~~ ConcreteClass) ifTrue:[
	^ ConcreteClass newTemporaryIn:aDirectoryPrefix
    ].

    "/ although the above allows things to be redefined in concrete classes,
    "/ the following should work on all systems ...

    NextTempFilenameIndex isNil ifTrue:[
	NextTempFilenameIndex := 1.
    ].

    pid := OperatingSystem getProcessId printString.
    pid := pid copyLast:(3 min:pid size).
    nr := NextTempFilenameIndex printString.
    nr := nr copyLast:(3 min:nr size).
    nameString := (self tempFileNameTemplate)
		  bindWith:pid 
		  with:nr.
    NextTempFilenameIndex := NextTempFilenameIndex + 1.

    (aDirectoryPrefix isNil or:[aDirectoryPrefix asString isEmpty]) ifFalse:[
	^ aDirectoryPrefix asFilename construct:nameString
    ].
    ^ self named:nameString

    "temp files in '/tmp':

     Filename newTemporary    
    "

    "temp files somewhere 
     (not recommended - use above since it can be controlled via shell variables):

     Filename newTemporaryIn:'/tmp'    
     Filename newTemporaryIn:'/tmp'  
     Filename newTemporaryIn:'/usr/tmp'    
     Filename newTemporaryIn:'/'  
    "

    "a local temp file:

     Filename newTemporaryIn:''         
     Filename newTemporaryIn:nil         
     Filename newTemporaryIn:'.'         
     Filename newTemporaryIn:('source' asFilename) 
    "

    "Modified: 7.9.1995 / 10:48:31 / claus"
    "Modified: 8.9.1997 / 00:28:33 / cg"
    "Created: 30.1.1998 / 11:49:33 / md"
    "Modified: 30.1.1998 / 11:52:06 / md"
    "Modified: 30.1.1998 / 12:09:18 / dq"
!

rootDirectoryOnVolume:aVolumeName
    "return a filename for the root directory on some volume"

    ^ self named:(aVolumeName , '\')

    "
     Filename rootDirectoryOnVolume:'d:'
     Filename rootDirectoryOnVolume:'\\idefix\home'
    "

    "Modified: / 24.9.1998 / 19:06:15 / cg"
! !

!PCFilename class methodsFor:'queries'!

isBadCharacter:aCharacter
    "return true, if aCharacter is unallowed in a filename."

    ('<>:"/\|' includes:aCharacter) ifTrue:[^ true].
    ^ super isBadCharacter:aCharacter

    "Created: 8.9.1997 / 00:14:06 / cg"
!

isCaseSensitive
    "return true, if filenames are case sensitive."

    ^ false
!

separator
    "return the file/directory separator."

     ^ $\

     "
      Filename concreteClass separator  
     "

    "Modified: 8.9.1997 / 00:18:03 / cg"
!

tempFileNameTemplate
    "return a template for temporary files.
     This is expanded with the current processID and a sequenceNumber
     to generate a unique filename.
     Redefined for MSDOS 8+3 filenames"

    ^ 'st%1%2'

    "Created: 30.1.1998 / 12:09:18 / dq"
! !

!PCFilename methodsFor:'converting'!

makeLegalFilename 
    "convert the receivers name to be a legal filename.
     This removes/replaces invalid characters and/or compresses
     the name as required by Win95-WinNT."

    |srchStart|

    "/ there may be only one colon in the name
    "/ (and if present, it must be the second character)

    ((nameString size >= 2)
    and:[(nameString at:2) == $:]) ifTrue:[
        srchStart := 3.
    ] ifFalse:[
        srchStart := 1
    ].

    "/ replace colons by underscore
    "/ may need more to convert - time will show

    (nameString indexOfAny:#($: $ ) startingAt:srchStart) ~~ 0 ifTrue:[
        nameString := nameString copy.
        nameString replaceAny:#($: $ ) with:$_ from:srchStart to:(nameString size).
    ].
    ^ self

    "
     'hello world' asFilename makeLegalFilename 
     'hello:world' asFilename makeLegalFilename 
     'hello::world' asFilename makeLegalFilename 
     'c:hello::world' asFilename makeLegalFilename 
     '\\idefix' asFilename makeLegalFilename 
     '\\idefix\' asFilename makeLegalFilename 
    "

    "Modified: / 11.10.1998 / 01:40:47 / cg"
! !

!PCFilename methodsFor:'file operations'!

renameTo:newName
    "rename the file - the argument must be convertable to a String.
     Raise an error if not successful.
     Redefined to delete any existing target-file first."

    newName asFilename exists ifTrue:[
	newName asFilename delete
    ].

    ^ super renameTo:newName

    "
     '\tmp\foo' asFilename renameTo:'\tmp\bar'
    "

    "Modified: 20.1.1998 / 15:33:00 / md"
! !

!PCFilename methodsFor:'queries'!

baseName
    "return my baseName as a string.
     Redefined to care for volumes.
     - thats the file/directory name without leading parent-dirs.
     (i.e. '/usr/lib/st/file' asFilename baseName -> 'file'
       and '/usr/lib'         asFilename baseName -> lib).
     This method does not check if the path is valid

     See also: #pathName, #directoryName and #directoryPathName.
     Compatibility note: use #tail for ST-80 compatibility."

    |vol rest vsz|

    vol := self volume.
    (vsz := vol size) > 0 ifTrue:[
        vsz == 2 ifTrue:[
            "/ a drive character ...
            rest := nameString copyFrom:3.
        ] ifFalse:[
            rest := nameString copyFrom:vsz+1.
            rest size == 0 ifTrue:[
               ^ '\'
            ].
        ].
        ^ (self class named:rest) baseName.
    ].
    ^ super baseName

    "
     '\foo\bar' asFilename baseName  
     '.' asFilename baseName          
     '..' asFilename baseName         
     '..\..' asFilename baseName        
     '..\libbasic' asFilename baseName        
     '..\..\stx' asFilename baseName        
     '\' asFilename baseName            
     'c:\' asFilename baseName          
     'c:\home' asFilename baseName        
     '\\idefix' asFilename baseName        
     '\\idefix\home' asFilename baseName        
     '\\idefix\home\' asFilename baseName        
     '\\idefix\home\foo' asFilename baseName        
    "

    "Created: / 24.9.1998 / 13:33:16 / cg"
    "Modified: / 24.9.1998 / 19:09:06 / cg"
!

directoryName
    "return the directory name part of the file/directory as a string.
     - thats the name of the directory where the file/dir represented by
       the receiver is contained in.
     This method does not check if the path is valid.

     (i.e. '/usr/lib/st/file' asFilename directoryName -> '/usr/lib/st'
       and '/usr/lib' asFilename directoryName         -> /usr').

     (this is almost equivalent to #directory, but returns
      a string instead of a Filename instance).

     See also: #pathName, #directoryPathName and #baseName.
     Compatibility note: use #head for ST-80 compatibility."

    |nm|

    nm := super directoryName.
    (nm size == 2 and:[(nm at:2) == $:]) ifTrue:[
        ^ nm , '\'
    ].
    ^ nm

    "
     (PCFilename named:'c:\users') directoryName
     (PCFilename named:'c:\users') directory pathName   
     (PCFilename named:'c:\users') directory isRootDirectory  
    "
!

fileType
    "this returns a string describing the type of contents of
     the file. Here, the suffix is examined for a standard
     suffix and an appropriate string is returned.
     Poor MSDOS - no file command."

    |suff type info fmt|

    StandardSuffixTable isNil ifTrue:[
	self class initStandardSuffixTable
    ].

    suff := self suffix asUppercase.
    type := StandardSuffixTable at:suff ifAbsent:nil.
    type isNil ifTrue:[
	type := super fileType.
    ].
    ^ type

    "Created: 16.10.1997 / 13:07:24 / cg"
    "Modified: 16.10.1997 / 13:10:00 / cg"
!

isDirectory
    "return true, if I represent a root directory 
     (i.e. I have no parentDir).
     Redefined to care for volumeRoots."

    self isRootDirectory ifTrue:[^ true].
    ^super isDirectory.

    "Created: / 24.9.1998 / 14:04:31 / cg"
!

isExecutableProgram
    "return true, if such a file exists and is an executable program.
     (i.e. for directories, false is returned.)"

    |mySuffix|

    mySuffix := self suffix asLowercase.
    (mySuffix = 'exe' or:[mySuffix = 'com']) ifTrue:[
        ^ super isExecutableProgram
    ].
    ^ false

    "Created: / 16.10.1997 / 13:19:10 / cg"
    "Modified: / 9.9.1998 / 20:17:52 / cg"
!

isExplicitRelative
    "return true, if this name is an explicit relative name
     (i.e. starts with './' or '../', to avoid path-prepending)"

    (nameString startsWith:'.\') ifTrue:[
	^ true
    ].
    (nameString startsWith:'..\') ifTrue:[
	^ true
    ].
    ^ false
!

isRootDirectory
    "return true, if I represent a root directory 
     (i.e. I have no parentDir)"

    |sz nm i|

    nm := self pathName.
    sz := nm size.

    sz == 1 ifTrue:[
        (nm = '\') ifTrue:[
            "/ \ alone
            ^ true
        ]
    ].

    sz >= 2 ifTrue:[
        (nm at:2) == $: ifTrue:[
            sz == 2 ifTrue:[
                "/ <DRIVE-char>:
                ^ true
            ].
            sz == 3 ifTrue:[
                (nm at:3) == $\ ifTrue:[
                    "/ <DRIVE-char>:\
                    ^ true
                ]
            ]
        ].
    ].

    "/ \\<REMOTE-HOST>
    (((nm size > 3) 
    and:[(nm at:1) == $\]) 
    and:[(nm at:2) == $\]) ifTrue:[
        "/ something like \\hostname\
        i := nm indexOf:$\ startingAt:4.
        ((i == 0) or:[i == nameString size]) ifTrue:[
            "/ not really a root (its not readable)
            ^ true
        ].
        i ~~ 0 ifTrue:[
            "/ something like \\hostname\dirName
            i := nm indexOf:$\ startingAt:i+1.
            ((i == 0) or:[i == nameString size]) ifTrue:[
                "/ yeah - really a root 
                ^ true
            ].
        ]
    ].
    ^ super isRootDirectory

    "Created: / 21.9.1998 / 15:37:41 / cg"
    "Modified: / 24.9.1998 / 15:57:10 / cg"
!

isVolumeAbsolute
    "return true, if the receiver represents an absolute pathname
     on some disk volume."

    "/ <DRIVE-CHAR>:
    (((nameString size >= 3) 
    and:[(nameString at:2) == $:]) 
    and:[(nameString at:3) == $\]) ifTrue:[
        "/ something like x:\foo
        ^ true
    ].

    "/ \\REMOTE-HOST:
    (((nameString size >= 3) 
    and:[(nameString at:1) == $\]) 
    and:[(nameString at:2) == $\]) ifTrue:[
        "/ something like \\hostname
        ^ true
    ].
    ^ false

    "Created: / 7.9.1997 / 23:54:20 / cg"
    "Modified: / 9.9.1998 / 20:38:54 / cg"
!

localNameStringFrom:aString 
    "ST-80 compatibility.
     what does this do ? (used in FileNavigator-goody).
     GUESS: does it strip off the voulume-character and initial '\' ?"

    (aString at:2) == $: ifTrue:[
	(aString at:3) == $\ ifTrue:[
	    ^ aString copyFrom:4
	].
	^ aString copyFrom:3
    ]. 
    (aString at:1) == $\ ifTrue:[
	^ aString copyFrom:1
    ].
    ^ aString
!

localPathName
    "return the full pathname of the file represented by the receiver,
     but without any volume information.
     Only makes a difference on MSDOS & VMS systems."

    |vol vsz rest|

    vol := self volume.
    (vsz := vol size) > 0 ifTrue:[
        rest := nameString copyFrom:vsz + 1.
        rest size == 0 ifTrue:[
            ^ '\'
        ].
        (rest startsWith:$\) ifFalse:[
            ^ '\' , rest
        ].
        ^ rest
    ].
    ^ nameString

    "
     '\foo'         asFilename localPathName  
     '\foo\'        asFilename localPathName 
     '\foo\bar'     asFilename localPathName 
     '\foo\bar\'    asFilename localPathName 
     'c:'           asFilename localPathName 
     'c:\'          asFilename localPathName 
     'c:\foo'       asFilename localPathName 
     'c:\foo\'      asFilename localPathName 
     'c:\foo\bar'   asFilename localPathName  
     'c:\foo\bar\'  asFilename localPathName      
     '\\idefix'          asFilename localPathName    
     '\\idefix\home'     asFilename localPathName 
     '\\idefix\home\foo' asFilename localPathName 
     "

    "Modified: / 24.9.1998 / 19:09:53 / cg"
!

volume
    "return the disc volume part of the name or an empty string.
     This is only used with DOS filenames - on unix, an empty string is returned.
     A full path can be reconstructed from 
        aFilename volume , aFilename localPathName
    "

    |endIdx endIdx2|

    nameString size >= 2 ifTrue:[
        (nameString at:2) == $: ifTrue:[
            ^ nameString copyTo:2
        ].
        (nameString startsWith:'\\') ifTrue:[
            endIdx := nameString indexOf:$\ startingAt:3.
            endIdx == 0 ifTrue:[
                ^ nameString.
            ].
            endIdx2 := nameString indexOf:$\ startingAt:endIdx+1.
            endIdx2 == 0 ifTrue:[
                ^ nameString.
            ].
            ^ nameString copyFrom:1 to:endIdx2-1
        ].
    ].

    ^ ''

    "
     '\foo'         asFilename volume  
     '\foo\'        asFilename volume  
     '\foo\bar'     asFilename volume 
     '\foo\bar\'    asFilename volume  
     'c:'           asFilename volume  
     'c:\'          asFilename volume  
     'c:\foo'       asFilename volume  
     'c:\foo\'      asFilename volume  
     'c:\foo\bar'   asFilename volume  
     'c:\foo\bar\'  asFilename volume       
     'c:\foo\bar\'  asFilename localPathName   
     '\\idefix'          asFilename volume       
     '\\idefix\home'     asFilename volume   
     '\\idefix\home\foo' asFilename volume  
     '\\idefix\home\foo' asFilename localPathName  
     "

    "Modified: / 24.9.1998 / 19:04:27 / cg"
! !

!PCFilename methodsFor:'special accessing'!

osNameForDirectory
    "special - return the OS's name for the receiver to
     access it as a directory.
     Care remove trailing backSlashes here and to use the shortName
     if available"

    |n i shortName|

    ((n := nameString) endsWith:'\') ifTrue:[
        ((n size == 3) and:[(n at:2) == $:]) ifFalse:[
            n := n copyWithoutLast:1
        ]
    ].
"/    i := OperatingSystem infoOf:n.
"/    (i notNil and:[(shortName := i alternativeName) notNil]) ifTrue:[
"/        ^ shortName
"/    ].
    ^ n

    "Modified: / 20.1.1998 / 15:39:06 / md"
    "Modified: / 17.8.1998 / 10:04:01 / cg"
!

osNameForDirectoryContents
    "special - return the OS's name for the receiver to
     access it as a directory for reading the contents.
     Care to remove trailing backSlashes here"

    (nameString endsWith:'\') ifTrue:[
        ^ nameString copyWithoutLast:1
    ].
    ^ nameString

    "Modified: / 20.1.1998 / 15:39:06 / md"
    "Created: / 3.8.1998 / 21:37:46 / cg"
    "Modified: / 17.8.1998 / 10:04:22 / cg"
!

setName:aString
    "set the filename"

    nameString := aString copy replaceAll:$/ with:$\

    "Created: 22.1.1998 / 17:32:45 / md"
! !

!PCFilename class methodsFor:'documentation'!

version
    ^ '$Header: /cvs/stx/stx/libbasic/PCFilename.st,v 1.22 2001-03-14 00:26:17 cg Exp $'
! !