This is another preparatory step that does not change the implementation
of the filesystem classes, but returns them when possible. I don't know why it's here, but this patch also renames File>>#directory to File>>#parent. I think I will leave a #directory method for compatibility though. --- kernel/Directory.st | 36 +++++---- kernel/File.st | 12 ++-- kernel/FileSegment.st | 19 +++-- kernel/PkgLoader.st | 136 +++++++++++++++++----------------- kernel/SysDict.st | 2 +- packages/browser/ClassHierBrow.st | 6 +- packages/httpd/FileServer.st | 2 +- packages/httpd/WikiServer.st | 2 +- packages/java/java_lang_Runtime.st | 6 +- packages/seaside/core/Seaside-GST.st | 2 +- packages/vfs/VFS.st | 6 +- packages/xml/parser/XML.st | 2 +- packages/xml/xsl/XSL.st | 2 +- scripts/Package.st | 60 ++++++++-------- tests/AnsiLoad.st | 4 +- 15 files changed, 153 insertions(+), 144 deletions(-) diff --git a/kernel/Directory.st b/kernel/Directory.st index 4372407..ec8890f 100644 --- a/kernel/Directory.st +++ b/kernel/Directory.st @@ -57,35 +57,35 @@ virtual one).'> "Answer the path to the user's home directory" <category: 'reading system defaults'> - ^Smalltalk getenv: 'HOME' + ^File name: (Smalltalk getenv: 'HOME') ] Directory class >> image [ "Answer the path to GNU Smalltalk's image file" <category: 'reading system defaults'> - ^ImageFilePath + ^File name: ImageFilePath ] Directory class >> module [ "Answer the path to GNU Smalltalk's dynamically loaded modules" <category: 'reading system defaults'> - ^ModulePath + ^File name: ModulePath ] Directory class >> libexec [ "Answer the path to GNU Smalltalk's auxiliary executables" <category: 'reading system defaults'> - ^LibexecPath + ^File name: LibexecPath ] Directory class >> systemKernel [ "Answer the path to the installed Smalltalk kernel source files." <category: 'reading system defaults'> - ^SystemKernelPath + ^File name: SystemKernelPath ] Directory class >> localKernel [ @@ -101,7 +101,7 @@ virtual one).'> Smalltalk are stored." <category: 'reading system defaults'> - ^UserFileBasePath + ^File name: UserFileBasePath ] Directory class >> temporary [ @@ -110,13 +110,13 @@ virtual one).'> <category: 'reading system defaults'> | d | - (d := Smalltalk getenv: 'TMPDIR') isNil ifFalse: [^d]. - (d := Smalltalk getenv: 'TEMP') isNil ifFalse: [^d]. + (d := Smalltalk getenv: 'TMPDIR') isNil ifFalse: [^File name: d]. + (d := Smalltalk getenv: 'TEMP') isNil ifFalse: [^File name: d]. (d := self home) isNil ifFalse: - [d := d , '/tmp'. - (File name: d) isDirectory ifTrue: [^d]]. - ^'/tmp' + [d := d / 'tmp'. + d isDirectory ifTrue: [^File name: d]]. + ^File name: '/tmp' ] Directory class >> kernel [ @@ -125,8 +125,8 @@ virtual one).'> <category: 'reading system defaults'> ^KernelFilePath isNil - ifTrue: [ SystemKernelPath ] - ifFalse: [ KernelFilePath ] + ifTrue: [ File name: SystemKernelPath ] + ifFalse: [ File name: KernelFilePath ] ] Directory class >> append: fileName to: directory [ @@ -169,6 +169,12 @@ virtual one).'> Directory class >> working [ "Answer the current working directory, not following symlinks." <category: 'file operations'> + ^File name: Directory workingName + ] + + Directory class >> workingName [ + "Answer the current working directory, not following symlinks." + <category: 'private'> <cCall: 'getCurDirName' returning: #stringOut args: #()> ] @@ -177,7 +183,7 @@ virtual one).'> "Change the current working directory to dirName." <category: 'file operations'> - self primWorking: dirName. + self primWorking: dirName asString. self checkError ] @@ -203,7 +209,7 @@ virtual one).'> <category: 'file operations'> | parent handler | - parent := File pathFor: dirName asString ifNone: [Directory working]. + parent := File pathFor: dirName asString ifNone: ['.']. handler := VFS.VFSHandler for: parent. handler createDir: (File stripPathFrom: dirName). ^File name: dirName diff --git a/kernel/File.st b/kernel/File.st index 730b485..3a59ea0 100644 --- a/kernel/File.st +++ b/kernel/File.st @@ -155,7 +155,7 @@ size and timestamps.'> path := OrderedCollection new. isAbsolute ifFalse: - [path addAll: (Directory working substrings: Directory pathSeparator)]. + [path addAll: (Directory workingName substrings: Directory pathSeparator)]. "A Windows path may contain both / and \ separators. Clean it up to allow easy parsing" @@ -186,8 +186,8 @@ size and timestamps.'> "Answer the relative path to destName when the current directory is srcName's directory." <category: 'file name management'> - ^self computePathFrom: (File fullNameFor: srcName) - to: (File fullNameFor: destName) + ^self computePathFrom: (File fullNameFor: srcName asString) + to: (File fullNameFor: destName asString) ] File class >> computePathFrom: srcName to: destName [ @@ -330,7 +330,7 @@ size and timestamps.'> "Answer the full path to the executable being run." <category: 'reading system defaults'> - ^ExecutableFileName + ^self path: ExecutableFileName ] File class >> image [ @@ -565,7 +565,7 @@ size and timestamps.'> ^File stripPathFrom: self name ] - directory [ + parent [ "Answer the Directory object for the receiver's path" <category: 'file name management'> @@ -709,7 +709,7 @@ size and timestamps.'> "Compute the relative path from the directory dirName to the receiver" <category: 'file operations'> - ^File computePathFrom: (File fullNameFor: dirName) , '/somefile' + ^File computePathFrom: (File fullNameFor: dirName asString) , '/somefile' to: vfsHandler realFileName ] diff --git a/kernel/FileSegment.st b/kernel/FileSegment.st index 5e3aa50..230f19d 100644 --- a/kernel/FileSegment.st +++ b/kernel/FileSegment.st @@ -45,11 +45,11 @@ Smalltalk-80 kernel; I am specific to the GNU Smalltalk implementation.'> support $(DESTDIR) and relocatable installation." <category: 'installing'> - | map startPath | + | map startPath startPathString | map := IdentityDictionary new. - startPath := Directory kernel. + startPath := Directory kernel asString. self allInstancesDo: [:each | each relocateFrom: startPath map: map]. - startPath = Directory systemKernel ifTrue: [KernelFilePath := nil]. + Directory kernel = Directory systemKernel ifTrue: [KernelFilePath := nil]. ] FileSegment class >> on: aFile startingAt: startPos for: sizeInteger [ @@ -116,16 +116,21 @@ Smalltalk-80 kernel; I am specific to the GNU Smalltalk implementation.'> identified by the receiver is stored" <category: 'basic'> - | result fileStream | - fileStream := FileStream open: self fileName mode: FileStream read. - ^[aBlock value: fileStream] ensure: [fileStream close] + ^self file withReadStreamDo: aBlock + ] + + file [ + "Answer the File object for the file containing the segment" + + <category: 'basic'> + ^Directory kernel / file ] fileName [ "Answer the name of the file containing the segment" <category: 'basic'> - ^Directory append: file to: Directory kernel + ^self file name ] filePos [ diff --git a/kernel/PkgLoader.st b/kernel/PkgLoader.st index 1bf5d17..1ef566d 100644 --- a/kernel/PkgLoader.st +++ b/kernel/PkgLoader.st @@ -261,7 +261,7 @@ XML.'> Namespace current: Kernel [ PackageGroup subclass: PackageDirectory [ - | packages fileName baseDirectories baseDirCache | + | packages file baseDirectories baseDirCache | <category: 'Language-Packaging'> <comment: 'I am not part of a standard Smalltalk system. I store internally the @@ -273,21 +273,26 @@ XML.'> self shouldNotImplement ] - PackageDirectory class >> on: aString baseDirectories: aBlock [ + PackageDirectory class >> on: aFile baseDirectories: aBlock [ <category: 'accessing'> ^(super new) - fileName: aString; + file: aFile; baseDirectories: aBlock ] + file [ + <category: 'accessing'> + ^file + ] + fileName [ <category: 'accessing'> - ^fileName + ^self file name ] - fileName: aString [ + file: aFile [ <category: 'accessing'> - fileName := aString + file := aFile ] baseDirectories: aBlock [ @@ -316,13 +321,12 @@ XML.'> Package objects along the way." <category: 'refreshing'> - | dir file allDirs | - file := File name: fileName. - dir := file directory. + | dir allDirs | + dir := self file parent. allDirs := Smalltalk imageLocal ifTrue: [{Directory image} , baseDirectories value] ifFalse: [baseDirectories value]. - ((file exists and: [file lastModifyTime > loadDate]) or: + ((self file exists and: [self file lastModifyTime > loadDate]) or: [(dir exists and: [dir lastModifyTime > loadDate]) or: [allDirs ~= baseDirCache]]) ifTrue: @@ -334,25 +338,24 @@ XML.'> refreshPackageList [ <category: 'refreshing'> - | file | baseDirCache isEmpty ifTrue: [^self]. - file := [FileStream open: fileName mode: FileStream read] on: Error - do: [:ex | ^self]. - - [[self parse: file] on: SystemExceptions.PackageNotAvailable - do: [:ex | ex resignalAs: PackageSkip new]] - ensure: [file close]. + self file exists ifFalse: [^self]. + self file withReadStreamDo: [ :fileStream | + [self parse: fileStream] + on: SystemExceptions.PackageNotAvailable + do: [:ex | ex resignalAs: PackageSkip new]]. + packages := packages reject: [:each | each isDisabled] ] refreshStarList: dir [ <category: 'refreshing'> dir exists ifFalse: [^self]. - dir namesMatching: '*.star' + dir filesMatching: '*.star' do: - [:starName | + [:starFile | | package | - package := Kernel.StarPackage fileName: starName. + package := Kernel.StarPackage file: starFile. packages at: package name put: package] ] @@ -391,7 +394,7 @@ XML.'> package notNil ifTrue: [package name isNil - ifTrue: [^self error: 'missing package name in ' , fileName]. + ifTrue: [^self error: 'missing package name in ' , self fileName]. [package baseDirectories: baseDirCache. packages at: package name put: package] @@ -454,9 +457,7 @@ XML.'> <category: 'accessing'> ^aCollection collect: - [:fileName | - | name | - name := self fullPathOf: fileName] + [:fileName | self fullPathOf: fileName] ] fullPathOf: fileName [ @@ -835,16 +836,16 @@ XML.'> Namespace current: Kernel [ PackageInfo subclass: StarPackage [ - | fileName loadedPackage | + | file loadedPackage | <category: 'Language-Packaging'> <comment: nil> - StarPackage class >> fileName: fileName [ + StarPackage class >> file: file [ <category: 'accessing'> ^(self new) - fileName: fileName; - name: (File stripPathFrom: (File stripExtensionFrom: fileName)); + file: file; + name: (File stripPathFrom: (File stripExtensionFrom: file name)); yourself ] @@ -965,17 +966,22 @@ PackageInfo subclass: StarPackage [ directory [ <category: 'accessing'> - ^fileName , '#uzip' + ^File name: self fileName, '#uzip' + ] + + file [ + <category: 'accessing'> + ^file ] fileName [ <category: 'accessing'> - ^fileName + ^self file name ] - fileName: aString [ + file: aFile [ <category: 'accessing'> - fileName := aString + file := aFile ] primFileIn [ @@ -987,9 +993,8 @@ PackageInfo subclass: StarPackage [ <category: 'accessing'> | file package | loadedPackage isNil ifFalse: [^loadedPackage]. - file := FileStream open: fileName , '#uzip/package.xml' - mode: FileStream read. - [package := Package parse: file] ensure: [file close]. + package := self file , '#uzip/package.xml' + withReadStreamDo: [ :fileStream | Package parse: fileStream]. package isNil ifTrue: [^self error: 'invalid disabled-package tag inside a star file']. package relativeDirectory: self relativeDirectory. @@ -1223,17 +1228,16 @@ XML.'> found that contains the file." <category: 'accessing'> - | name | baseDirectories do: - [:dir | - name := dir. + [:baseDir || dir file | + dir := baseDir. self relativeDirectory isNil - ifFalse: [name := Directory append: self relativeDirectory to: dir]. - name := Directory append: fileName to: name. - (File exists: name) ifTrue: [^name]]. + ifFalse: [dir := dir / self relativeDirectory]. + file := dir / fileName. + file exists ifTrue: [^file]]. "TODO: should put the name and baseDirectories into the exception." - "name printNl. baseDirectories printNl." + "fileName printNl. baseDirectories printNl." SystemExceptions.PackageNotAvailable signal: self name ] @@ -1243,10 +1247,10 @@ XML.'> <category: 'accessing'> self relativeDirectory isNil ifTrue: [^nil]. self baseDirectories do: - [:dir | - | name | - name := Directory append: self relativeDirectory to: dir. - (Directory exists: name) ifTrue: [^name]]. + [:baseDir || dir | + dir := baseDir / relativeDirectory. + dir exists ifTrue: [^dir]]. + SystemExceptions.PackageNotAvailable signal: self name ] @@ -1288,7 +1292,7 @@ XML.'> (CFunctionDescriptor isFunction: func) ifFalse: [^self error: 'C callout not available: ' , func]]]. loadedFiles := self fullPathsOf: self fileIns. - loadedFiles do: [:each | FileStream fileIn: each]. + loadedFiles do: [:each | each fileIn]. self name isNil ifFalse: [Smalltalk addFeature: self name]. self features do: [:each | Smalltalk addFeature: each]] ensure: @@ -1443,7 +1447,7 @@ into a Smalltalk image, correctly handling dependencies.'> ] PackageLoader class >> directoryFor: package [ - "Answer a complete path to the given package's files" + "Answer a Directory object to the given package's files" <category: 'accessing'> ^(self packageAt: package) directory @@ -1565,14 +1569,13 @@ into a Smalltalk image, correctly handling dependencies.'> ifTrue: [self flush. root := Kernel.PackageDirectories new. - root add: (Kernel.PackageDirectory on: self packageFileName - baseDirectories: - [ + root add: (Kernel.PackageDirectory on: self packageFile + baseDirectories: [ {Directory userBase. - Directory kernel , '/..'}]). - root add: (Kernel.PackageDirectory on: self userPackageFileName + Directory kernel / '..'}]). + root add: (Kernel.PackageDirectory on: self userPackageFile baseDirectories: [{Directory userBase}]). - root add: (Kernel.PackageDirectory on: self localPackageFileName + root add: (Kernel.PackageDirectory on: self localPackageFile baseDirectories: [#()])]. root refresh: loadDate. loadDate := Date dateAndTimeNow @@ -1620,19 +1623,19 @@ into a Smalltalk image, correctly handling dependencies.'> ^root includesKey: feature asString ] - PackageLoader class >> packageFileName [ + PackageLoader class >> packageFile [ <category: 'private - packages file'> - ^Directory kernel , '/../packages.xml' + ^Directory kernel / '../packages.xml' ] - PackageLoader class >> userPackageFileName [ + PackageLoader class >> userPackageFile [ <category: 'private - packages file'> - ^Directory userBase , '/packages.xml' + ^Directory userBase / 'packages.xml' ] - PackageLoader class >> localPackageFileName [ + PackageLoader class >> localPackageFile [ <category: 'private - packages file'> - ^Directory image , '/packages.xml' + ^Directory image / 'packages.xml' ] PackageLoader class >> rebuildPackageFile [ @@ -1643,15 +1646,10 @@ into a Smalltalk image, correctly handling dependencies.'> <category: 'private - packages file'> | file | self refresh. - file := FileStream open: Directory image , '/packages.xml' - mode: FileStream write. - - [file nextPutAll: '<!-- GNU Smalltalk packages description file -->'. - file - nl; - nl. - root printOn: file] - ensure: [file close] + Directory image / 'packages.xml' withWriteStreamDo: [ :file | + file nextPutAll: '<!-- GNU Smalltalk packages description file -->'. + file nl; nl. + root printOn: file] ] ] diff --git a/kernel/SysDict.st b/kernel/SysDict.st index f551120..fde805e 100644 --- a/kernel/SysDict.st +++ b/kernel/SysDict.st @@ -235,7 +235,7 @@ My instance also helps keep track of dependencies between objects.'> directory (non-local image) or not." <category: 'testing'> - ^(File pathFor: Directory kernel) ~= Directory image + ^Directory kernel parent ~= Directory image ] isSmalltalk [ diff --git a/packages/browser/ClassHierBrow.st b/packages/browser/ClassHierBrow.st index 51e85fb..37e8f6c 100644 --- a/packages/browser/ClassHierBrow.st +++ b/packages/browser/ClassHierBrow.st @@ -598,9 +598,9 @@ GuiData subclass: ClassHierarchyBrowser [ ["If the image directory is a subdirectory of the home directory, the default is the image directory. Else the default is the home directory" - fileoutDir := Directory image , '/'. - home := Directory home. - home = '.' ifTrue: [home := Directory working]. + fileoutDir := Directory image name , '/'. + home := Directory home name. + home = '.' ifTrue: [home := Directory working name]. home isEmpty ifFalse: [fileoutDir size < home size ifTrue: [^fileoutDir := home , '/']. diff --git a/packages/httpd/FileServer.st b/packages/httpd/FileServer.st index 22e2b94..6e5ba95 100644 --- a/packages/httpd/FileServer.st +++ b/packages/httpd/FileServer.st @@ -824,7 +824,7 @@ and DirectoryResponses.'> initialize [ <category: 'initialize-release'> - initialDirectory := File name: Directory working. + initialDirectory := Directory working. uploadAuthorizer := WebAuthorizer new. name := 'File' ] diff --git a/packages/httpd/WikiServer.st b/packages/httpd/WikiServer.st index 9046301..67de862 100644 --- a/packages/httpd/WikiServer.st +++ b/packages/httpd/WikiServer.st @@ -2297,7 +2297,7 @@ WebServer class extend [ initializeImages [ <category: 'examples'> (self at: 8080) handler addComponent: (FileWebServer named: 'images' - directory: Directory systemKernel , '/../net/httpd') + directory: Directory systemKernel / '../net/httpd') ] initializeWiki [ diff --git a/packages/java/java_lang_Runtime.st b/packages/java/java_lang_Runtime.st index 14ece64..97d10e7 100644 --- a/packages/java/java_lang_Runtime.st +++ b/packages/java/java_lang_Runtime.st @@ -142,7 +142,7 @@ java_lang_Runtime_insertSystemProperties_java_util_Properties: arg1 put value: 'java.vm.specification.vendor' value: 'Sun Microsystems Inc.'. put value: 'java.class.path' value: JavaClassFileReader classPath. - put value: 'java.home' value: Directory image. + put value: 'java.home' value: Directory image name. put value: 'os.name' value: os. put value: 'os.arch' value: cpu. put value: 'os.version' value: '1'. @@ -150,8 +150,8 @@ java_lang_Runtime_insertSystemProperties_java_util_Properties: arg1 put value: 'path.separator' value: ':'. put value: 'line.separator' value: (Character nl asString). put value: 'user.name' value: (Smalltalk getenv: 'USER'). - put value: 'user.home' value: (Smalltalk getenv: 'HOME'). - put value: 'user.dir' value: (Smalltalk getenv: 'HOME'). + put value: 'user.home' value: Directory home name. + put value: 'user.dir' value: Directory home name. put value: 'java.io.tmpdir' value: tmpDir. put value: 'java.tmpdir' value: tmpDir! ! diff --git a/packages/seaside/core/Seaside-GST.st b/packages/seaside/core/Seaside-GST.st index 5d04ee6..b49b110 100644 --- a/packages/seaside/core/Seaside-GST.st +++ b/packages/seaside/core/Seaside-GST.st @@ -612,7 +612,7 @@ Object subclass: WAGNUSmalltalkPlatform [ defaultDirectoryName [ <category: '*Seaside-Squeak-Core'> - ^Directory working + ^Directory working name ] platformString [ diff --git a/packages/vfs/VFS.st b/packages/vfs/VFS.st index 141ae2e..ac2600c 100644 --- a/packages/vfs/VFS.st +++ b/packages/vfs/VFS.st @@ -60,13 +60,13 @@ Commander and with GNOME VFS.'> <category: 'registering'> fileTypes := LookupTable new. - [self fileSystemsIn: Directory libexec , '/vfs'] on: Error + [self fileSystemsIn: Directory libexec / 'vfs'] on: Error do: [:ex | ex return]. - [self fileSystemsIn: Directory userBase , '/vfs'] on: Error + [self fileSystemsIn: Directory userBase / 'vfs'] on: Error do: [:ex | ex return]. Smalltalk imageLocal ifTrue: - [[self fileSystemsIn: Directory image , '/vfs'] on: Error + [[self fileSystemsIn: Directory image / 'vfs'] on: Error do: [:ex | ex return]]. ^fileTypes keys asSet ] diff --git a/packages/xml/parser/XML.st b/packages/xml/parser/XML.st index aee4368..ce9ccc4 100644 --- a/packages/xml/parser/XML.st +++ b/packages/xml/parser/XML.st @@ -2313,7 +2313,7 @@ Instance Variables: s := self fullSourceStack reverse detect: [:i | i uri notNil] ifNone: [nil]. ^s == nil ifTrue: - [NetClients.URL fromString: (Directory append: 'foo' to: Directory working)] + [NetClients.URL fromString: (Directory working / 'foo')] ifFalse: [s uri] ] diff --git a/packages/xml/xsl/XSL.st b/packages/xml/xsl/XSL.st index d6cfda6..f54b9f7 100644 --- a/packages/xml/xsl/XSL.st +++ b/packages/xml/xsl/XSL.st @@ -951,7 +951,7 @@ E. Acknowledgements (Non-Normative) readString: aString [ <category: 'loading'> | doc | - self initURI: 'file' name: (Directory append: 'xxx' to: Directory working). + self initURI: 'file' name: (Directory working / 'xxx') name. doc := XMLParser processDocumentString: aString beforeScanDo: [:parser | diff --git a/scripts/Package.st b/scripts/Package.st index f195839..1a9d04d 100644 --- a/scripts/Package.st +++ b/scripts/Package.st @@ -35,14 +35,14 @@ Package extend [ ] isStarPackageBody [ - ^'*.star#uzip' match: self baseDirectories first + ^'*.star#uzip' match: self baseDirectories first name ] starFileName [ | dir | self isStarPackageBody ifFalse: [ self halt ]. dir := self baseDirectories first. - ^dir copyFrom: 1 to: dir size - 5 ] + ^dir name allButLast: 5 ] runCommand: aCommand [ self isStarPackageBody @@ -54,7 +54,7 @@ Package extend [ Kernel.PackageDirectory subclass: StarPackageFile [ refreshStarList: dir [ | package | - package := Kernel.StarPackage fileName: self fileName. + package := Kernel.StarPackage file: self file. packages at: package name put: package loadedPackage ] @@ -66,9 +66,8 @@ Kernel.PackageDirectory subclass: PackageFile [ refreshPackageList [ | file | - file := FileStream open: fileName mode: FileStream read. - [ self parse: file ] - ensure: [ file close ]. + self file withReadStreamDo: [ :fileStream | + self parse: fileStream ] ] ] @@ -80,16 +79,17 @@ Kernel.PackageDirectories subclass: PackageFiles [ ] parse: fileName [ - | packageFile | + | file packageFile | + file := File name: fileName. packageFile := ('*.star' match: fileName) ifFalse: [ PackageFile - on: fileName - baseDirectories: [ self baseDirsFor: fileName ] ] + on: file + baseDirectories: [ self baseDirsFor: file ] ] ifTrue: [ StarPackageFile - on: fileName - baseDirectories: [ fileName, '#uzip' ] ]. + on: file + baseDirectories: [ {File name: fileName, '#uzip'} ] ]. packageFile refresh. ^packageFile @@ -99,23 +99,23 @@ Kernel.PackageDirectories subclass: PackageFiles [ self add: (self parse: fileName). ] - baseDirsFor: fileName [ - | file srcdirPath builddirPrefix | - file := File name: fileName. + baseDirsFor: file [ + | srcdirFile builddirPrefix | self srcdir isNil ifTrue: [ ^{ file path } ]. "See if the file is in srcdir or builddir. In any case, we want to look for files first in the builddir, and secondarily in srcdir." - srcdirPath := file pathFrom: srcdir. - builddirPrefix := (File name: Directory working) pathFrom: srcdir. - ^(srcdirPath startsWith: builddirPrefix, Directory pathSeparatorString) - ifFalse: [ + srcdirFile := file pathFrom: self srcdir. + builddirPrefix := Directory working pathFrom: self srcdir. + ^(srcdirFile startsWith: builddirPrefix, Directory pathSeparatorString) + ifFalse: [ { "file is in srcdir." - { File pathFor: srcdirPath. file path } ] + (File name: srcdirFile) parent. + file parent } ] ifTrue: [ { "file is in builddir." - file path. - Directory append: (File pathFor: fileName) to: self srcdir } ] + file parent. + (self srcdir / (file pathFrom: Directory working)) parent } ] ] filesDo: aBlock [ @@ -186,7 +186,7 @@ File extend [ emitMkdir [ | doThat | self exists ifTrue: [ ^self ]. - Command execute: [ self directory emitMkdir ]. + Command execute: [ self parent emitMkdir ]. ('mkdir %1' % { self }) displayNl. Command execute: [ Directory create: self name ]. ] @@ -309,7 +309,7 @@ Command subclass: PkgDist [ packages filesDo: [ :each | | destName autoconfName srcdir | destName := File stripPathFrom: each. - srcdir := srcdir / (File pathFor: each). + srcdir := self srcdir / (File pathFor: each). autoconfName := destName, '.in'. (srcdir includes: autoconfName) ifFalse: [ @@ -339,14 +339,14 @@ Command subclass: PkgDist [ dirs := files collect: [ :file | File pathFor: file ]. dirs := dirs asSet asOrderedCollection. + baseDir := self installDir. aPackage relativeDirectory isNil ifFalse: [ - dirs := dirs collect: [ :dir | aPackage relativeDirectory / dir ] ]. + baseDir := baseDir / aPackage relativeDirectory ]. - dirs do: [ :dir || destName | - (self installDir / dir name) emitMkdir ]. + dirs do: [ :dir | (baseDir / dir) emitMkdir ]. files do: [ :file || srcFile destName | - srcFile := File name: (aPackage fullPathOf: file). + srcFile := aPackage fullPathOf: file. self distribute: srcFile as: file in: aPackage relativeDirectory ] ] runOnStar: aPackage [ @@ -409,7 +409,7 @@ Command subclass: PkgInstall [ Smalltalk system: (pat % { gstLoad. File name: File image. - Directory name: Directory kernel. + Directory kernel. (self isOption: 'test') ifTrue: [ '--test' ] ifFalse: [ '' ]. packageList }) ] @@ -439,7 +439,7 @@ Command subclass: PkgInstall [ (baseDir / dir) emitMkdir ]. files do: [ :file || srcFile | - srcFile := File name: (aPackage fullPathOf: file). + srcFile := (aPackage fullPathOf: file). srcFile emitSymlink: (baseDir nameAt: file) ]. (self installDir / aPackage name, '.star') @@ -708,7 +708,7 @@ Except in uninstall and list files mode, gst-package requires write access to the GNU Smalltalk image directory, and merges the XML package files on the command line with that file. -The default target directory is ', Directory image, ' +The default target directory is ', Directory image name, ' '. [ diff --git a/tests/AnsiLoad.st b/tests/AnsiLoad.st index f511b47..a74bd5e 100644 --- a/tests/AnsiLoad.st +++ b/tests/AnsiLoad.st @@ -80,8 +80,8 @@ PackageLoader fileInPackage: #SUnit! | ps loaded | FileStream verbose: true. -Directory working indexOfSubCollection: 'tests' - ifAbsent: [ Directory working: Directory kernel, '/../tests' ]. +Directory working name indexOfSubCollection: 'tests' + ifAbsent: [ Directory working: Directory kernel / '../tests' ]. ps := Smalltalk at: #ProtocolSpec ifAbsent: [ nil ]. loaded := (ps respondsTo: #includesProtocolNamed:) -- 1.5.3.4.910.gc5122-dirty _______________________________________________ help-smalltalk mailing list [hidden email] http://lists.gnu.org/mailman/listinfo/help-smalltalk |
Free forum by Nabble | Edit this page |