"
 COPYRIGHT (c) 1992 by Claus Gittinger
	      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.
"

Object subclass:#Filename
	 instanceVariableNames:'nameString'
	 classVariableNames:'NextTempFilenameIndex'
	 poolDictionaries:''
	 category:'System-Support'!

Filename comment:'
COPYRIGHT (c) 1992 by Claus Gittinger
	     All Rights Reserved

$Header: /cvs/stx/stx/libbasic/Filename.st,v 1.25 1995-05-01 21:29:49 claus Exp $
'!

!Filename class methodsFor:'documentation'!

copyright
"
 COPYRIGHT (c) 1992 by Claus Gittinger
	      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.
"
!

version
"
$Header: /cvs/stx/stx/libbasic/Filename.st,v 1.25 1995-05-01 21:29:49 claus Exp $
"
!

documentation
"
    Filenames; originally added for ST-80 compatibility, is
    taking over functionality from other classes (FileDirectory).

    Instances of Filename do not nescessarily represent valid or existing
    files - i.e. it is possible (and useful) to have instances for non-existing
    files around. In other words: the name-string is not checked automatically
    for being correct or existing.
    Thus, it is possible to do queries such as:

	'/fee/foo/foe' asFilename exists     
	'/not_existing' asFilename isDirectory 
	'/foo/bar' asFilename isReadable 

    (all of the above examples will probably return false on your machine ;-).

    examples:

	'Makefile' asFilename readStream

	'newFile' asFilename writeStream

	Filename newTemporary writeStream
"
! !

!Filename class methodsFor:'instance creation'!

named:aString
    "return a filename for a directory named aString."

    ^ (self basicNew) setName:aString

    "
     Filename named:'/tmp/fooBar'
    "
!

currentDirectory
    "return a filename for the current directory"

    ^ self named:(FileDirectory currentDirectory pathName)

    "
     Filename currentDirectory 
    "
!

defaultDirectory
    "ST80 compatibility: same as currentDirectory"

    ^ self currentDirectory

    "
     Filename defaultDirectory 
    "
!

newTemporary
    "return a new unique filename - use this for temporary files.
     The filenames returned are '/tmp/stxtmp_xx_nn' where xx is our
     unix process id, and nn is a unique number, incremented with every
     call to this method."

    |pid nm|

    NextTempFilenameIndex isNil ifTrue:[
	NextTempFilenameIndex := 1.
    ].
    "
     the following has to be made OS independent ...
    "
    pid := OperatingSystem getProcessId printString.
    nm := '/tmp/stxtmp_' , pid , '_' , NextTempFilenameIndex printString.
    NextTempFilenameIndex := NextTempFilenameIndex + 1.
    ^ self named:nm

    "
     Filename newTemporary
     Filename newTemporary
    "
!

fromUser
    "show a box to enter a filename. Return a filename instance or
     nil (if cancel was pressed)."

    |name|

    name := FileSelectionBox requestFilename.
    name notNil ifTrue:[^ self named:name].
    ^ nil

    "
     Filename fromUser
    "
! !

!Filename class methodsFor:'queries'!

separator
    "return the file/directory separator.
     Usually, this is $/ for unix-like systems 
     and $\ for dos-like ones (there may be more in the future)."

     ^ OperatingSystem fileSeparator

     "
      Filename separator  
     "
!

parentDirectoryName 
    "return the name used for the parent directory.
     This is '..' for unix and dos-like systems. 
     (there may be more in the future."

     ^ OperatingSystem parentDirectoryName

     "
      Filename parentDirectoryName  
     "
!

isCaseSensitive
    "return true, if filenames are case sensitive.
     We ask the OS about this, to be independent here."

    ^ OperatingSystem caseSensitiveFilenames
!

defaultClass
    "ST-80 compatibility:
     in ST-80, different subclasses of FIlename are used for different
     OperatingSYstems; defaultClass is supposed to return an appropriate class.
     Since in ST/X, there is (currently) only one Filename class, return it here."

    ^ self
!

localNameStringFrom:aString
    "ST-80 compatibility.
     what does this do ? (used in FileNavigator-goody)"

    (aString startsWith:'/') ifTrue:[
	^ aString copyFrom:2
    ].
    ^ aString
!

volumes
    "ST-80 compatibility.
     what does this do ? (used in FileNavigator-goody)"

    ^ '/'
! !

!Filename methodsFor:'instance creation'!

constructString:subname
    "taking the receiver as a directory name, construct a new
     filenames string for an entry within this directory (i.e. for a file
     or a subdirectory in that directory)."

    |sepString|

    sepString := self class separator asString.
    nameString = sepString ifTrue:[
	"I am the root"
	^ sepString  , subname
    ].
    ^ nameString , sepString , subname

    "
     '/tmp' asFilename constructString:'foo'   
     '/' asFilename constructString:'foo'         
     '/usr/tmp' asFilename constructString:'foo'
     '/foo/bar' asFilename constructString:'baz' 
    "
!

construct:subname
    "taking the receiver as a directory name, construct a new
     filename for an entry within this directory (i.e. for a file
     or a subdirectory in that directory)."

    ^ (self constructString:subname) asFilename

    "
     '/tmp' asFilename construct:'foo'    
     '/' asFilename construct:'foo'         
     '/usr/tmp' asFilename construct:'foo'
     '/foo/bar' asFilename construct:'baz' 
    "
! !

!Filename methodsFor:'misc'!

, aString
    "this allows filenames to understand how names are concatenated.
     Returns a string consisting of the receivers name, concatenated
     by aString. Notice this is NOT the same as construct:, which inserts
     a directory delimiter and returns a new fileName instance."

    ^ (nameString , aString asString)

    "
     'Makefile' asFilename , '.bak' 
     'Makefile' asFilename construct:'.bak' 
    "
! !

!Filename methodsFor:'comparing'!

hash
    "return an integer useful as a hash-key"

    ^ nameString hash
!

= aFilename
    "return true, if the argument represents the same filename"

    |str|

    self species == aFilename species ifTrue:[
	str := aFilename asString.
	self class isCaseSensitive ifTrue:[
	    ^ nameString = str
	].
	^ nameString sameAs:str
    ].
    ^ false
! !

!Filename methodsFor:'converting'!

asString
    "return the receiver converted to a string"

    ^ nameString
!

asFilename
    "return the receiver converted to a filename."

    "Thats pretty easy here :-)"
    ^ self
!

asAbsoluteFilename
    "return the receiver converted to a filename with
     an absolute pathname."

    ^ self pathName asFilename
!

makeLegalFilename 
    "convert the receveivers name to be a legal filename.
     The implementation may change in the future to be more
     OS specific."

    "
     actually, in Unix spaces are allowed - but it makes life
     so hard; therefore, replace them by underscores ...
    "
    nameString replaceAll:(Character space) by:$_.
    "
     need more - especially on SYS5.3 type systems, 
     we may want to contract the fileName to 14 characters.
    "
    ^ self

    "
     'hello world' asFilename makeLegalFilename 
    "
! !

!Filename methodsFor:'private accessing'!

setName:aString
    "set the filename"

    nameString := aString
! !

!Filename methodsFor:'queries'!

separator
    "return the directory-separator character (or string)"

    ^ self class separator
!

directoryName
    "return the directory name part of the file/directory.
     - thats the name of the directory where the file/dir represented by
       the receiver is contained in."

    ^ OperatingSystem directoryNameOf:nameString "/ (self pathName)

    "
     '/foo/bar/' asFilename directoryName    
     '/foo/bar' asFilename directoryName    
     '.' asFilename directoryName        
     '..' asFilename directoryName       
     '../..' asFilename directoryName     
    "
!

directory
    "return the directory name part of the file/directory.
     - thats a filename for the directory where the file/dir represented by
       the receiver is contained in."

    ^ self directoryName asFilename

    "
     '/foo/bar' asFilename directory
     '.' asFilename directory        
     '..' asFilename directory       
     '../..' asFilename directory     
    "
!

directoryContents
    "return the contents of the directory as a collection of strings"

    ^ (FileDirectory directoryNamed:self asString) contents

    "
     '.' asFilename directoryContents
    "
!

tail
    "the files name without directory prefix. For ST-80 compatiblity."

    ^ self baseName
!

baseName
    "return my baseName
     - thats the file/directory name without leading parent-dirs."

    ^ OperatingSystem baseNameOf:nameString "/ (self pathName) 

    "
     '/foo/bar' asFilename baseName  
     '.' asFilename baseName          
     '..' asFilename baseName         
     '../..' asFilename baseName        
     '../../libbasic' asFilename baseName        
     '../../libpr' asFilename baseName        
    "
!

pathName
    "return the full pathname of the file represented by the receiver."

    |parentName sep|

    sep := self class separator.
    (nameString startsWith:sep) ifTrue:[
	parentName := self class parentDirectoryName.
	(nameString endsWith:parentName) ifFalse:[
	    (nameString endsWith:parentName , sep asString) ifFalse:[
		^ nameString
	    ]
	]
    ].
    ^ (FileDirectory directoryNamed:nameString) pathName

    "
     '/foo/bar' asFilename pathName
     '.' asFilename pathName 
     '../..' asFilename pathName 
    "
!

isAbsolute
    "return true, if the receiver represents an absolute pathname
     (in contrast to one relative to the current directory)."

    ^ (nameString startsWith:self class separator)

    "
     '/foo/bar' asFilename isAbsolute   
     '..' asFilename isAbsolute         
     '..' asAbsoluteFilename isAbsolute         
     'source/SBrowser.st' asFilename isAbsolute  
    "
!

isRelative
    "return true, if this name is interpreted relative to some
     directory (opposite of absolute)"

    ^ self isAbsolute not
!

isDirectory
    "return true, if the receiver represents an existing,
     readable directories pathname."

    ^ OperatingSystem isDirectory:nameString

    "
     '/foo/bar' asFilename isDirectory
     '/tmp' asFilename isDirectory
     'Makefile' asFilename isDirectory   
    "
!

exists
    "return true, if such a file exists."

    ^ OperatingSystem isValidPath:nameString

    "
     '/foo/bar' asFilename exists 
     '/tmp' asFilename exists  
     'Makefile' asFilename exists   
    "
!

isReadable
    "return true, if such a file exists and is readable."

    ^ OperatingSystem isReadable:nameString

    "
     '/foo/bar' asFilename isReadable   
     '/tmp' asFilename isReadable      
     'Makefile' asFilename isReadable   
    "
!

canBeWritten
    "same as isWritable - for ST-80 compatibility"

    ^ self isWritable

    "
     '/foo/bar' asFilename canBeWritten 
     '/tmp' asFilename canBeWritten   
     'Makefile' asFilename canBeWritten   
    "
!

isWritable
    "return true, if such a file exists and is writable."

    ^ OperatingSystem isWritable:nameString

    "
     '/foo/bar' asFilename isWritable 
     '/tmp' asFilename isWritable   
     'Makefile' asFilename isWritable   
    "
!

isExecutable
    "return true, if such a file exists and is executable (by Unix's definition).
     For directories, true is returned if the directory can be entered.
     See isExecutableProgram for a related check."

    ^ OperatingSystem isExecutable:nameString

    "
     '/foo/bar' asFilename isExecutable 
     '/tmp' asFilename isExecutable   
     'Makefile' asFilename isExecutable   
     '/bin/ls' asFilename isExecutable   
    "
!

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

    ^ (OperatingSystem isExecutable:nameString)
      and:[(OperatingSystem isDirectory:nameString) not]

    "
     '/tmp' asFilename isExecutable         
     '/bin/ls' asFilename isExecutable       
     '/tmp' asFilename isExecutableProgram   
     '/bin/ls' asFilename isExecutableProgram    
    "
!

filesMatching:aPattern
    ^ self directoryContents select:[:name | aPattern match:name]

    "
     Filename currentDirectory filesMatching:'M*' 
    "
!

filenameCompletion
    "try to complete the filename. This method has both a side effect,
     and a return value:
	 it returns a collection of matching filename strings,
	 and sets (as side effect) the receivers filename to the longest common
	 match. 
     (i.e. if the size of the returned collection is exactly 1,
      the completion has succeeded and the receivers name has been changed to
      that. 
      If the returned collection is empty, nothing matched and the receivers
      names is unchanged.
      If the size of the returned collection is greater than one, the receivers
      filename-string has been set to the longest common filename-prefix)"

    |dir name matching matchLen try allMatching sep parent prefix|

    sep := self class separator asString.
    parent := self class parentDirectoryName.

    dir := self directory.
    prefix := parent , sep.
    (nameString endsWith:sep) ifTrue:[
	name := ''
    ] ifFalse:[
	name := self baseName.
    ].
    [name startsWith:prefix] whileTrue:[
	self halt.
	dir := dir directory.
	name := name copyFrom:(prefix size + 1)
    ].

    dir := dir asString.
    name = parent ifTrue:[
	^ dir asFilename filenameCompletion
    ].

    matching := OrderedCollection new.
    (FileDirectory directoryNamed:dir) do:[:fileName |
	((fileName ~= '.') and:[fileName ~= parent]) ifTrue:[
	    (fileName startsWith:name) ifTrue:[
		matching add:fileName
	    ]
	]
    ].
    "
     if there is only one, change my name ...
    "
    matching size == 1 ifTrue:[
	dir = sep ifTrue:[
	   dir := ''
	].
	nameString := dir , sep , matching first.
	matching first = name ifTrue:[
	    self isDirectory ifTrue:[
		nameString := nameString , self class separator asString
	    ]
	]
    ] ifFalse:[
	matching size > 1 ifTrue:[
	    "
	     find the longest common prefix
	    "
	    matchLen := name size.
	    matchLen > matching first size ifTrue:[
		try := name.
		allMatching := false
	    ] ifFalse:[
		try := matching first copyTo:matchLen.
		allMatching := true.
	    ].

	    [allMatching] whileTrue:[
		matching do:[:aName |
		    (aName startsWith:try) ifFalse:[
			allMatching := false
		    ]
		].
		allMatching ifTrue:[
		    matchLen <  matching first size ifTrue:[
			matchLen := matchLen + 1.
			try := matching first copyTo:matchLen.
		    ] ifFalse:[
			allMatching := false
		    ]
		] ifFalse:[
		    try := matching first copyTo:matchLen - 1.
		]
	    ].
	    "
	     and set my name to the last full match
	    "
	    dir = sep ifTrue:[
	       dir := ''
	    ].
	    nameString := dir , sep , try
	]
    ].
    "
     return the match-set, so caller can decide what to do
     (i.e. show the matches, output a warning etc ...)
    "
    ^ matching

    "
     'Make' asFilename filenameCompletion;yourself 
     'Makef' asFilename filenameCompletion;yourself 
     '/u' asFilename filenameCompletion 
     '../../libpr' asFilename filenameCompletion 
    "
! !

!Filename methodsFor:'file queries'!

info
    "return the files info; that is a collection of file attributes,
     (actually a dictionary) where the keys are #type, #uid, #gid, #size etc.
    The actual amount and detail returned may depend on the OS used."

    ^ OperatingSystem infoOf:nameString

    "
     Filename currentDirectory info
     'Make.proto' asFilename info
    "
!

dates
    "return the files modification and access times as an object (currently a dictionary)
     that responds to the at: message with arguments #modified, #accessed or #statusChanged."

    |info dates|

    info := OperatingSystem infoOf:nameString.
    info isNil ifTrue:[
	info := OperatingSystem linkInfoOf:nameString.
	info isNil ifTrue:[
	    ^ nil
	]
    ].
    dates := IdentityDictionary new.
    dates at:#modified put:(info at:#modified).
    dates at:#accessed put:(info at:#accessed).
    dates at:#statusChanged put:(info at:#statusChanged).
    ^ dates

    "
     Filename currentDirectory dates
     '../regression' asFilename dates
    "
!

fileSize
    "return the size of the file in bytes"

    |info|

    info := self info.
    info isNil ifTrue:[^ nil].
    ^ info at:#size
!

fileType
    "this returns a string describing the type of contents of
     the file. This is done using the unix 'file' command,
     (which usually is configurable by /etc/magic).
     On non-unix systems, this may return an empty string, not knowning
     about the contents."

    |stream typeString|

    typeString := ''.
    stream := PipeStream readingFrom:('file ' , self pathName).
    stream notNil ifTrue:[
	typeString := stream contents asString.
	stream close.
	typeString := typeString copyFrom:(typeString indexOf:$:) + 1.
	typeString := typeString withoutSeparators
    ] ifFalse:[
	"
	 could add some fallback code here, for systems, where no
	 file command is avaliable ...
	 ... or at least analyze directory info.
	"
    ].
    ^ typeString

    "
     'Makefile' asFilename fileType 
     '.' asFilename fileType     
     '/dev/null' asFilename fileType        
     'smalltalk.rc' asFilename fileType    
     'bitmaps/SBrowser.xbm' asFilename fileType    
    "
! !

!Filename methodsFor:'file operations'!

delete
    "remove the file - same as remove, for ST-80 compatibility"

    ^ self remove
!

remove
    "remove the file - the argument must be convertable to a String.
     Return true if sucessfull, false if not."

    ^ OperatingSystem removeFile:nameString

    "
     (FileStream newFileNamed:'foo') close.
     'foo' asFilename remove
    "
!

renameTo:newName
    "rename the file - the argument must be convertable to a String.
     Return true if sucessfull, false if not."

    ^ OperatingSystem renameFile:nameString to:(newName asString)

    "
     '/tmp/foo' asFilename renameTo:'/tmp/bar'
    "
!

copyTo:newName
    "copy the file - the argument must be convertable to a filename"

    |inStream outStream buffer bufferSize count|

    bufferSize := 8 * 1024.
    buffer := ByteArray new:bufferSize.
    inStream := self readStream.
    outStream := newName asFilename writeStream.
    (inStream isNil or:[outStream isNil]) ifTrue:[
	^ self error:'file copy failed'
    ].

    [inStream atEnd] whileFalse:[
	count := inStream nextBytes:bufferSize into:buffer.
	outStream nextPutBytes:count from:buffer.
    ].
    outStream close.
    inStream close.

    "
     'Makefile' asFilename copyTo:'Makefile.foo'
     'smalltalk' asFilename copyTo:'/dev/null'
    "
!

moveTo:newName
    "copy the file represented by the receiver, then delete it.
     This is different to renaming in case of cross device moves."

    self copyTo:newName.
    self remove
!

makeDirectory
    "create a directory with the receivers name"

    OperatingSystem createDirectory:nameString
!

addAccessRights:aCollection
    "add the access rights as specified in aCollection for the file represented
     by the receiver. The argument must be a collection of symbols,
     such as #readUser, #writeGroup etc."

    |access|

    access := OperatingSystem accessModeOf:nameString.
    aCollection do:[:accessSymbol |
	access := access bitOr:(OperatingSystem accessMaskFor:accessSymbol).
    ].
    OperatingSystem changeAccessModeOf:nameString to:access

    "
     'foo' asFilename writeStream close.
     'foo' asFilename addAccessRights:#(readUser readGroup readOthers).
     'foo' asFilename addAccessRights:#(writeUser writeGroup writeOthers).
     'foo' asFilename addAccessRights:#(executeUser executeGroup executeOthers).
    "
!

removeAccessRights:aCollection
    "remove the access rights as specified in aCollection for the file represented
     by the receiver. The argument must be a collection of symbols,
     such as #readUser, #writeGroup etc."

    |access|

    access := OperatingSystem accessModeOf:nameString.
    aCollection do:[:accessSymbol |
	access := access bitAnd:(OperatingSystem accessMaskFor:accessSymbol) bitInvert.
    ].
    OperatingSystem changeAccessModeOf:nameString to:access

    "
     'foo' asFilename writeStream close.
     'foo' asFilename removeAccessRights:#(readUser readGroup readOthers).
     'foo' asFilename removeAccessRights:#(writeUser writeGroup writeOthers).
     'foo' asFilename removeAccessRights:#(executeUser executeGroup executeOthers).
    "
!

makeReadableForAll
    "make the file readable for all - you must have permission to do so."

    self addAccessRights:#(readUser readGroup readOthers)
!

makeReadable
    "make the file readable for  the owner - you must have permission to do so."

    self addAccessRights:#(readUser)
!

makeWritable
    "make the file writableable for all - you must have permission to do so."

    self addAccessRights:#(writeUser)
!

makeWritableForAll
    "make the file writable for all - you must have permission to do so."

    self addAccessRights:#(writeUser writeGroup writeOthers)
!

makeUnwritable
    "make the file unwritable for all - you must have permission to do so."

    self removeAccessRights:#(writeUser writeGroup writeOthers)
! !

!Filename methodsFor:'file utilities'!

fileIn
    "load smalltalk code from the file"

    ^ self readStream fileIn
!

edit
    "start an editView on the file represented by the receiver"

    EditTextView openOn:self asString

    "
     'smalltalk.rc' asFilename edit
    "
!

contentsOfEntireFile
    "return the contents of the file as a string"

    |s contents|

    s := self readStream.
    [
	contents := s contents
    ] valueNowOrOnUnwindDo:[s close].
    ^ contents
! !

!Filename methodsFor:'file access'!

newReadWriteStream
    "return a stream for read/write the file represented by the receiver.
     If the file does not already exist, it is created."

    ^ FileStream newFileNamed:nameString
!

readWriteStream
    "return a stream for read/write the file represented by the receiver.
     If the file does not already exist, nil is returned."

    ^ FileStream oldFileNamed:nameString
!

readStream
    "return a stream for reading from the file represented by the receiver.
     If the file does not already exist, nil is returned."

    ^ FileStream readonlyFileNamed:nameString

    "
     '/tmp/foo' asFilename readStream 
    "
!

writeStream
    "return a stream for writing to the file represented by the receiver.
     If the file does not already exist, it is created."

    ^ FileStream newFileForWritingNamed:nameString

    "
     '/tmp/foo' asFilename writeStream 
    "
!

appendingWriteStream
    "return a stream for appending to the file represented by the receiver.
     If the file does not already exist, it is created."

    ^ FileStream appendingOldFileNamed:nameString 
! !

!Filename methodsFor:'printing & storing'!

storeOn:aStream
    "append a printed representation of the receiver to aStream,
     which allows reconstructing it via readFrom:"

    aStream nextPut:$(.
    nameString storeOn:aStream.
    aStream nextPutAll:' asFilename)'
!

printOn:aStream
    "append a printed representation of the receiver to aStream."

    aStream nextPutAll:'FileName('''.
    nameString printOn:aStream.
    aStream nextPutAll:''')'
! !