hg/stx-libbasic: comparison Filename.st

equal deleted inserted replaced

-:f42da059311e
+:e9ae6bea98cd
 be provided or otherwise made available to, or used by, any
 other person.  No title to or ownership of the software is
 hereby transferred.
 "
-'From Smalltalk/X, Version:3.1.9 on 9-sep-1997 at 10:54:08 pm'                  !
+'From Smalltalk/X, Version:3.1.10 on 13-sep-1997 at 10:53:13 pm'                !
 Object subclass:#Filename
 	instanceVariableNames:'nameString'
 	classVariableNames:'NextTempFilenameIndex ConcreteClass'
 	poolDictionaries:''
 ^ ConcreteClass currentDirectory
 ].
 "/ fallBack - works on Unix & MSDOS (but not on VMS)
-^ self named:('.' asFilename pathName)
+^ self named:'.'
+"/ ^ self named:('.' asFilename pathName)
 "
 Filename currentDirectory
 "
 "Modified: 7.9.1995 / 10:48:31 / claus"
 "Modified: 8.9.1997 / 00:28:33 / cg"
 !
+rootDirectory
+"return a filename for the root directory"
+(self ~~ ConcreteClass) ifTrue:[
+^ ConcreteClass rootDirectory
+].
+"/ fallBack - works on Unix & MSDOS (but not on VMS)
+^ self named:(self separator asString)
+"
+Filename rootDirectory
+"
+"Modified: 8.9.1997 / 00:24:15 / cg"
+!
 tempDirectory
 "return the temp directory as a filename.
 If any of the environment variables STX_TMPDIR, ST_TMPDIR,
 TMPDIR or TEMPDIR is set, its value defines the name,
 otherwise, '/tmp' is used. (at least on unix ...).
 Since in ST/X, there is (currently) only one Filename class, return it here."
 ^ ConcreteClass
 "Modified: 8.9.1997 / 00:36:01 / cg"
+! !
+!Filename class methodsFor:'misc'!
+canonicalize:aPathString
+^ aPathString
+"Created: 13.9.1997 / 10:50:01 / cg"
 ! !
 !Filename class methodsFor:'queries'!
 components:aString
 !
 localNameStringFrom:aString
 "ST-80 compatibility.
 what does this do ? (used in FileNavigator-goody).
-GUESS: does it strip off the voulume-character on MSDOS systems ?"
+GUESS:
+	does it strip off any volume characters and make a path relative ?"
+|sep|
 (self ~~ ConcreteClass) ifTrue:[
 ^ ConcreteClass localNameStringFrom:aString
 ].
-(aString startsWith:'/') ifTrue:[
+sep := self separator asString.
-^ aString copyFrom:2
+(aString startsWith:sep) ifTrue:[
+	^ aString copyFrom:sep size + 1
 ].
 ^ aString
 "Modified: 7.9.1995 / 10:44:56 / claus"
 "Modified: 8.9.1997 / 00:33:51 / cg"
 "
 actually, in Unix spaces are allowed - but it makes life
 so hard; therefore, replace them by underscores ...
 "
-nameString replaceAll:(Character space) by:$_.
+nameString replaceAll:(Character space) with:$_.
 "
 need more - especially on SYS5.3 type systems,
 we may want to contract the fileName to 14 characters.
 "
 ^ self
 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
+^ FileStream appendingOldFileNamed:(self osNameForFile)
 !
 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
+^ FileStream newFileNamed:(self osNameForFile)
 !
 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
+^ FileStream readonlyFileNamed:(self osNameForFile)
 "
 '/tmp/foo' asFilename readStream
 "
 !
 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 osName|
-access := OperatingSystem accessModeOf:nameString.
+osName := self osNameForFile.
+access := OperatingSystem accessModeOf:osName.
 aCollection do:[:accessSymbol |
 	access := access bitOr:(OperatingSystem accessMaskFor:accessSymbol).
 ].
-(OperatingSystem changeAccessModeOf:nameString to:access) ifFalse:[
+(OperatingSystem changeAccessModeOf:osName to:access) ifFalse:[
 	^ self accessDeniedError:self
 ]
 "
 'foo' asFilename writeStream close.
 makeDirectory
 "create a directory with the receivers name.
 Return true if successful, false if not."
-(OperatingSystem createDirectory:nameString) ifFalse:[
+(OperatingSystem createDirectory:(self osNameForDirectory)) ifFalse:[
 	(self exists and:[self isDirectory]) ifFalse:[
 	    ^ self fileCreationError:self
 	]
 ]
 recursiveMakeDirectory
 "create a directory with the receivers name and all required intermediate
 directories.
 Raise an error if not successful."
-(OperatingSystem recursiveCreateDirectory:nameString) ifFalse:[
+(OperatingSystem recursiveCreateDirectory:(self osNameForDirectory)) ifFalse:[
 	^ self fileCreationError:self
 ]
 "Created: 27.11.1995 / 23:36:40 / cg"
 !
 "remove the directory and all of its subfiles/subdirectories.
 Raise an error if not successful."
 |ok|
-ok := OperatingSystem recursiveRemoveDirectory:nameString.
+ok := OperatingSystem recursiveRemoveDirectory:(self osNameForDirectory).
 ok ifFalse:[
 	self removeError:self
 ].
 "
 |ok|
 self exists ifFalse:[ ^ self].
 self isDirectory ifTrue:[
-	ok := OperatingSystem removeDirectory:nameString
+	ok := OperatingSystem removeDirectory:(self osNameForFile)
 ] ifFalse:[
-	ok := OperatingSystem removeFile:nameString
+	ok := OperatingSystem removeFile:(self osNameForFile)
 ].
 ok ifFalse:[
 	self removeError:self
 ].
 "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.
 Raise an error if not successful."
-|access|
+|access osName|
-access := OperatingSystem accessModeOf:nameString.
+osName := self osNameForFile.
+access := OperatingSystem accessModeOf:osName.
 aCollection do:[:accessSymbol |
 	access := access bitAnd:(OperatingSystem accessMaskFor:accessSymbol) bitInvert.
 ].
-(OperatingSystem changeAccessModeOf:nameString to:access) ifFalse:[
+(OperatingSystem changeAccessModeOf:osName to:access) ifFalse:[
 	^ self accessDeniedError:self
 ].
 "
 'foo' asFilename writeStream close.
 renameTo:newName
 "rename the file - the argument must be convertable to a String.
 Raise an error if not successful."
-|ok|
+(OperatingSystem
+	renameFile:(self osNameForFile)
-ok := OperatingSystem renameFile:nameString to:(newName asString).
+	to:(newName asFilename osNameForFile)
-ok ifFalse:[
+) ifFalse:[
 	self exists ifFalse:[
 	    ^ self fileNotFoundError:self
 	].
 	^ self accessDeniedError:newName asFilename.
 ].
 truncateTo:newSize
 "change the files size.
 This may not be supported on all operating systems"
-(OperatingSystem truncateFile:nameString to:newSize) ifFalse:[
+(OperatingSystem truncateFile:(self osNameForFile) to:newSize) ifFalse:[
 	^ self reportError:'unsupported operation' with:self
 ]
 "
 |s|
 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 dates osName|
-info := OperatingSystem infoOf:nameString.
+osName := self osNameForFile.
+info := OperatingSystem infoOf:osName.
 info isNil ifTrue:[
-	info := OperatingSystem linkInfoOf:nameString.
+	info := OperatingSystem linkInfoOf:osName.
 	info isNil ifTrue:[
 	    ^ nil
 	]
 ].
 dates := IdentityDictionary new.
 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
+On non-unix systems, this may return simply 'file',
-about the contents.
+not knowning about the contents.
-Since the returned string differs among systems (and language settings),
+Warning:
-it is only useful for user-information; NOT as a tag to be used by a program."
+Since the returned string differs among systems (and language settings),
+it is only useful for user-information; NOT as a tag to be used by a program."
-|buffer s n typeString suffix idx baseNm|
+|buffer s n suffix idx baseNm|
 "/ since executing 'file' takes some time, do the most obvious
 "/ ones here.
 "/ (also useful for systems, which have no file command, such as NT)
 ^ 'directory'
 ].
 self isReadable ifFalse:[^ 'unreadable'].
 self fileSize == 0 ifTrue:[^ 'empty'].
-buffer := String new:2024.
+suffix := self suffix asLowercase.
-s := self readStream.
+baseNm := self withoutSuffix baseName asLowercase.
-s notNil ifTrue:[
-n := s nextBytes:buffer size into:buffer.
+((#('st' 'rc' 'chg' 'htm' 'html' 'ps') includes:suffix)
-s close.
+or:[#('makefile') includes:baseNm]) ifTrue:[
-true "n == buffer size" ifTrue:[
+buffer := String new:2024.
-((suffix := self suffix asLowercase) = 'st') ifTrue:[
+s := self readStream.
+s notNil ifTrue:[
+n := s nextBytes:buffer size into:buffer.
+s close.
+(suffix = 'st') ifTrue:[
 (buffer findString:'subclass:') ~~ 0 ifTrue:[
 ^ 'smalltalk source'
 ].
 (buffer findString:'methodsFor:') ~~ 0 ifTrue:[
 ^ 'smalltalk source'
 (suffix = 'rc') ifTrue:[
 (buffer findString:'ST/X startup') ~~ 0 ifTrue:[
 ^ 'smalltalk startup script'
 ].
 ].
 (suffix = 'htm' or:[suffix = 'html']) ifTrue:[
 (idx := buffer findString:'<H') ~~ 0 ifTrue:[
 ((buffer continuesWith:'<HEAD' startingAt:idx)
 or:[(buffer continuesWith:'<HTML' startingAt:idx)
 or:[(buffer continuesWith:'<H1' startingAt:idx)
 (buffer findString:'%!!PS-Adobe') ~~ 0 ifTrue:[
 ^ 'PostScript document'
 ].
 ].
-baseNm := self withoutSuffix baseName asLowercase.
 (baseNm = 'makefile') ifTrue:[
 (buffer startsWith:'#') ifTrue:[
 ^ 'make rules'
 ]
-]
+	    ]
 ]
 ].
 ^ 'file'
 !
 id
 "return the files/directories file-id (inode number)"
-^ OperatingSystem idOf:(self pathName)
+^ OperatingSystem idOf:(self osNameForFile)
 "
 Filename currentDirectory id
 "
 to either handle nil values,
 or (better) use one of isXXXX query methods. (Be prepared for DOS ...)
 (i.e. instead of:
 	someFilename type == #directory
 use
-	someFIlename isDirectory
+	someFilename isDirectory
 "
-^ OperatingSystem infoOf:nameString
+^ OperatingSystem infoOf:(self osNameForFile)
 "
 Filename currentDirectory info
 '/dev/null' asFilename info
 'Make.proto' asFilename info
 In addition to the normal entries, Unix returns an additional entry:
 	 path -> the target files pathname
 See the comment in #info for more details."
-^ OperatingSystem linkInfoOf:nameString
+^ OperatingSystem linkInfoOf:(self osNameForFile)
 "
 Filename currentDirectory linkInfo
 '/dev/null' asFilename linkInfo
 'Make.proto' asFilename linkInfo
 !
 type
 "return the symbolic type of the file"
-^ OperatingSystem typeOf:(self pathName)
+^ OperatingSystem typeOf:(self osNameForFile)
 "
 Filename currentDirectory type
 "
 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).
-See also: #withSuffix: (which is different, but often needed)"
+The argument may not specify an absolute path name.
+Please do not use this to create filenames with suffixes,
+since some systems require special naming conventions.
+See also: #withSuffix: (which is different, but often needed)."
 ^ self class named:(self constructString:subname)
 "
 '/tmp' asFilename construct:'foo'
 '/' asFilename construct:'foo'
 '/usr/tmp' asFilename construct:'foo'
 '/foo/bar' asFilename construct:'baz'
+Bad example; works on UNIX, but may not on others:
+'foo/bar.baz' construct:'.suff'
 "
 "Modified: 29.2.1996 / 20:55:06 / cg"
 !
-constructString:subname
+constructDirectory:subname
+"same as #construct: on most systems.
+(may allow different/relaxed name syntax of the argument on some systems)"
+^ self class named:(self constructDirectoryString:subname)
+!
+constructDirectoryString:subName
+"same as #constructString: on most systems.
+(may allow different/relaxed name syntax of the argument on some systems)"
+^ self constructString:subName
+!
+constructString:subName
 "taking the receiver as a directory name, construct a new
 filename-string for an entry within this directory
-(i.e. for a file or a subdirectory in that directory)."
+(i.e. for a file or a subdirectory in that directory).
+The argument may not specify an absolute path name."
 |sepString|
 sepString := self class separator asString.
 nameString = sepString ifTrue:[
 	"I am the root"
-	^ sepString  , subname
+	^ sepString  , subName asString
 ].
-^ nameString , sepString , subname asString
+^ nameString , sepString , subName asString
 "
 '/tmp' asFilename constructString:'foo'
 '/' asFilename constructString:'foo'
 '/usr/tmp' asFilename constructString:'foo'
 !
 exists
 "return true, if such a file exists."
-^ OperatingSystem isValidPath:nameString
+^ OperatingSystem isValidPath:(self osNameForFile)
 "
 '/foo/bar' asFilename exists
 '/tmp' asFilename exists
 'Makefile' asFilename exists
 isDirectory
 "return true, if the receiver represents an existing,
 readable directories pathname."
-^ OperatingSystem isDirectory:nameString
+^ OperatingSystem isDirectory:(self osNameForFile)
 "
 '/foo/bar' asFilename isDirectory
 '/tmp' asFilename isDirectory
 'Makefile' asFilename isDirectory
 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
+^ OperatingSystem isExecutable:(self osNameForFile)
 "
 '/foo/bar' asFilename isExecutable
 '/tmp' asFilename isExecutable
 'Makefile' 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)
+|osName|
-and:[(OperatingSystem isDirectory:nameString) not]
+osName := self osNameForFile.
+^ (OperatingSystem isExecutable:osName)
+and:[(OperatingSystem isDirectory:osName) not]
 "
 '/tmp' asFilename isExecutable
 '/bin/ls' asFilename isExecutable
 '/tmp' asFilename isExecutableProgram
 '/bin/ls' asFilename isExecutableProgram
 "
 !
+isExplicitRelative
+"return true, if this name is an explicit relative name
+(i.e. starts with './' or '../', to avoid path-prepending)"
+^ false
+!
+isHidden
+"return true, if the receiver represents a hidden file.
+The definitions of hidden files depends on the OS used;
+on UNIX, a name starting with a period is considered hidden;
+on MSDOS, the files hidden attribute is used.
+VMS has no concept of hidden files."
+^ false
+!
 isReadable
 "return true, if such a file exists and is readable."
-^ OperatingSystem isReadable:nameString
+^ OperatingSystem isReadable:(self osNameForFile)
 "
 '/foo/bar' asFilename isReadable
 '/tmp' asFilename isReadable
 'Makefile' asFilename isReadable
 isSymbolicLink
 "return true, if the file represented by the receiver is a symbolic
 link. Notice that not all OS's support symbolic links; those that do
 not will always return false."
-^ OperatingSystem isSymbolicLink:nameString
+^ OperatingSystem isSymbolicLink:(self osNameForFile)
 "
 'Make.proto' asFilename isSymbolicLink
 'Makefile' asFilename isSymbolicLink
 "
 !
 isWritable
 "return true, if such a file exists and is writable."
-^ OperatingSystem isWritable:nameString
+^ OperatingSystem isWritable:(self osNameForFile)
 "
 '/foo/bar' asFilename isWritable
 '/tmp' asFilename isWritable
 'Makefile' asFilename isWritable
 !Filename methodsFor:'queries-path & name'!
 baseName
 "return my baseName as a string.
 - 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."
-^ OperatingSystem baseNameOf:nameString "/ (self pathName)
+|len index sep endIdx|
+sep := self separator.
+len := nameString size.
+((len == 1) and:[(nameString at:1) == sep]) ifTrue:[
+^ nameString
+].
+endIdx := len.
+len > 1 ifTrue:[
+(nameString at:len) == sep ifTrue:[endIdx := endIdx - 1].
+].
+index := nameString lastIndexOf:sep startingAt:len-1.
+index == 0 ifTrue:[
+^ nameString copyTo:endIdx
+].
+^ nameString copyFrom:(index+1) to:endIdx
 "
 '/foo/bar' asFilename baseName
 '.' asFilename baseName
 '..' asFilename baseName
 '../../libbasic' asFilename baseName
 '../../libpr' asFilename baseName
 '../../libbasic/Object.st' asFilename baseName
 "
-"Modified: 9.9.1997 / 10:53:57 / cg"
+"Modified: 13.9.1997 / 09:32:49 / cg"
 !
 directory
 "return the directory name part of the file/directory as a new filename.
 - thats a filename for the directory where the file/dir represented by
 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."
-^ OperatingSystem directoryNameOf:nameString "/ (self pathName)
+|last index sep sepString p|
+sep := self separator.
+sepString := sep asString.
+(nameString = sepString) ifTrue:[
+"/
+"/ the trivial '/' case
+"/
+^ nameString
+].
+"/
+"/ strip off multiple leading slashes
+"/
+p := nameString.
+[p endsWith:sepString] whileTrue:[
+(p = sepString) ifTrue:[
+^ p
+].
+p := p copyWithoutLast:1
+].
+last := 1.
+[true] whileTrue:[
+index := p indexOf:sep startingAt:(last + 1).
+index == 0 ifTrue:[
+(last == 1) ifTrue:[
+(p startsWith:sepString) ifTrue:[
+^ sepString
+].
+^ '.'
+].
+^ p copyTo:(last - 1)
+].
+last := index.
+].
+"/ notreached
 "
 '/foo/bar/' asFilename directoryName
 '/foo/bar/' asFilename directory
 "return the full directory pathname part of the file/directory as a string.
 - thats the full pathname of the directory where the file/dir represented by
 the receiver is contained in.
 See also: #pathName, #directoryName, #directory and #baseName"
-^ OperatingSystem directoryNameOf:(self pathName)
+^ self pathName asFilename directoryName
 "
 '/foo/bar/' asFilename directoryPathName
 '/foo/bar' asFilename directoryPathName
 ^ ''
 "Modified: 8.9.1997 / 00:37:33 / cg"
 ! !
+!Filename methodsFor:'special accessing'!
+osName
+"special - return the OS's name for the receiver."
+self isDirectory ifTrue:[
+	^ self osNameForDirectory
+].
+^ self osNameForFile
+!
+osNameForDirectory
+"special - return the OS's name for the receiver to
+access it as a directory."
+^ nameString
+!
+osNameForFile
+"internal - return the OS's name for the receiver to
+access it as a file."
+^ nameString
+! !
 !Filename methodsFor:'suffixes'!
 hasSuffix:aSuffixString
 "return true if my suffix is the same as aString.
 This cares for systems, where case is ignored in filenames"
 "Modified: 7.9.1995 / 11:09:03 / claus"
 !
 withSuffix:aSuffix
-"return a new filename for the receivers name with a suffix.
+"return a new filename for the receivers name with a different suffix.
 If the name already has a suffix, the new suffix replacaes it;
 otherwise, the new suffix is simply appended to the name."
 ^ self class named:
 	(self withoutSuffix name
 withoutSuffix
 "return a new filename for the receivers name without the suffix.
 If the name has no suffix, the receiver is returned."
-|lastComponentsIndex idx|
+|nm idx|
-lastComponentsIndex := nameString lastIndexOf:(self class separator).
+nm := self baseName.
 idx := nameString lastIndexOf:(self class suffixSeparator).
-(idx == 0 or:[idx <= lastComponentsIndex]) ifTrue:[^ self].
+(idx == 0) ifTrue:[^ self].
 ^ self class named:(nameString copyTo:(idx - 1))
 "
 'abc.st' asFilename withoutSuffix
 ! !
 !Filename class methodsFor:'documentation'!
 version
-^ '$Header: /cvs/stx/stx/libbasic/Filename.st,v 1.97 1997-09-09 17:35:17 cg Exp $'
+^ '$Header: /cvs/stx/stx/libbasic/Filename.st,v 1.98 1997-09-15 20:37:49 cg Exp $'
 ! !
 Filename initialize!

changeset 2922	e9ae6bea98cd
parent 2911	9964e6839a8e
child 2939	b7cebf237308