Packages November 2008

packages@lists.squeakfoundation.org

2 participants
66 discussions

Rio: File-Kernel-kph.2.mcz
by squeak-dev-noreply＠lists.squeakfoundation.org 24 Nov '08

24 Nov '08

A new version of File-Kernel was added to project Rio: http://www.squeaksource.com/Rio/File-Kernel-kph.2.mcz ==================== Summary ==================== Name: File-Kernel-kph.2 Author: kph Time: 24 November 2008, 11:30:49 am UUID: 63a5fedf-3dd6-4141-afec-bfbafc465920 Ancestors: File-Kernel-kph.1 - rename FileDirStat to FileStat - support for using double dispatch to pick the write method for file transfers, local to remote, local to local, remote to local, or remote to remote. =============== Diff against File-Kernel-kph.1 =============== Item was added: + ----- Method: FileStat>>rio (in category 'as yet unclassified') ----- + rio + + ^ dir / self fileName! Item was added: + ----- Method: FileLocalExecutive>>copyLocalFile:toLocalFile: (in category 'as yet unclassified') ----- + copyLocalFile: aFile toLocalFile: bFile + + self class OSProcessOrNil ifNotNilDo: [ :osp | osp waitForCommand: 'cp "', aFile asVmPathName, '" "', bFile asVmPathName, '"'. ^ aFile]. + + (self primCopyFile: aFile asVmPathName to: bFile asVmPathName) = #failed ifTrue: [ ^ aFile copyTo: bFile ]. + + ^ aFile + + ! Item was added: + ----- Method: FileStat>>isValid (in category 'as yet unclassified') ----- + isValid + + ^ dir notNil! Item was added: + ----- Method: FileExecutive>>dir:mkpath:fromBase: (in category 'as yet unclassified') ----- + dir: aDir mkpath: aFileOrDir fromBase: aBaseDirectory + + | newFD | + + newFD := aBaseDirectory ifNil: [ aFileOrDir ] + ifNotNil: [ aDir / (aFileOrDir linearRelativeTo: aBaseDirectory) ]. + + aFileOrDir isDirectory ifTrue: [ ^ newFD mkpath ]. + aFileOrDir isFile ifTrue: [ ^ newFD parent mkpath ]. + + + ! Item was added: + ----- Method: FileStat>>isInvalid (in category 'as yet unclassified') ----- + isInvalid + + ^ dir isNil! Item was changed: FileExecutive subclass: #FileLocalExecutive + instanceVariableNames: 'rootString root defaultDirectory newRio' - instanceVariableNames: 'rootString root defaultDirectory' classVariableNames: 'Current Test' poolDictionaries: '' category: 'File-Kernel'! !FileLocalExecutive commentStamp: 'kph 4/17/2007 19:25' prior: 0! Introducing the idea that Rio's exist in the context of their 'physical container', we have the RioLocalFileSystem as the primary container which provides the file system interface, also known as the 'executive'. On unix there is one executive for the whole system. On dos there is one executive per volume. This approach also supports the notion of files within archives and files on remote servers. On startup, having a formal model of the host filesystem allows us to keep a current and previous instance introducing the possibility for migrating Rio's on startup when the image has been moved. For example C:/ could be replaced with /mnt/hda1 thus attempting to make images properly portable. (experimental idea) ! Item was added: + ----- Method: FileLocalExecutive>>copyFile:toLocalFile: (in category 'as yet unclassified') ----- + copyFile: aFile toLocalFile: bFile + + ^ self copyLocalFile: aFile toLocalFile: bFile + ! Item was added: + ----- Method: FileLocalExecutive>>copyFile:toRemoteFile: (in category 'as yet unclassified') ----- + copyFile: aFile toRemoteFile: bFile + + ^ bFile executive copyLocalFile: aFile toRemoteFile: bFile! Item was added: + ----- Method: FileStat>>creationTime (in category 'as yet unclassified') ----- + creationTime + + ^ self cTime! Item was added: + ----- Method: FileStat class>>in:array: (in category 'as yet unclassified') ----- + in: dirRio array: theArray + + ^ self new setDir: dirRio array: theArray! Item was added: + ----- Method: FileLocalExecutive>>toUrl: (in category 'executive actions') ----- + toUrl: aFD + + ^ FileUrl new initializeFromPathString: (aFD full value replacing: $\ with: $/)! Item was added: + ----- Method: FileExecutive>>dir:addAll:fromBase: (in category 'executive actions') ----- + dir: aDir addAll: someFD fromBase: aBaseDir + + someFD do: [ :each | self dir: aDir add: each fromBase: aBaseDir ]! Item was added: + ----- Method: FileStat>>mTime (in category 'as yet unclassified') ----- + mTime + + ^ TimeStamp fromSeconds: self mTimeInSeconds + + ! Item was added: + ----- Method: FileLocalExecutive>>dir:addFile: (in category 'executive actions') ----- + dir: aDir addFile: aFile + + ^ aFile executive copyFile: aFile toLocalFile: aDir / aFile fileName + + ! Item was added: + ----- Method: FileStat>>isDirectory (in category 'as yet unclassified') ----- + isDirectory + + ^(array at: 4)! Item was added: + ----- Method: FileStat>>cTime (in category 'as yet unclassified') ----- + cTime + + ^ TimeStamp fromSeconds: self cTimeInSeconds! Item was added: + ----- Method: FileStat>>fileName (in category 'as yet unclassified') ----- + fileName + + ^array at: 1! Item was added: + ----- Method: FileStat>>setDir:array: (in category 'as yet unclassified') ----- + setDir: aDir array: data + + dir := aDir. + array := data.! Item was added: + ----- Method: FileStat>>modificationTime (in category 'as yet unclassified') ----- + modificationTime + + ^ self mTime! Item was added: + ----- Method: FileStat>>invalidate (in category 'as yet unclassified') ----- + invalidate + + array := nil.! Item was added: + ----- Method: FileExecutive>>dir:add: (in category 'as yet unclassified') ----- + dir: aDir add: aFileOrDir + + aFileOrDir isFile ifTrue: [ self dir: aDir addFile: aFileOrDir ]. + + ! Item was changed: ----- Method: FileKernel>>setStatFromDir:andEntryArray: (in category 'accessing') ----- setStatFromDir: dir andEntryArray: a + stat := FileStat in: dir array: a - stat := FileDirStat in: dir array: a ! Item was added: + ----- Method: FileLocalExecutive>>primCopyFile:to: (in category 'executive actions') ----- + primCopyFile: srcName to: dstName + "Copied from VMMaker code. + This really ought to be a facility in file system. The major annoyance + here is that file types and permissions are not handled by current + Squeak code. + NOTE that this will clobber the destination file!!" + <primitive: 'primitiveFileCopyNamedTo' module:'FileCopyPlugin'> "primitiveExternalCall" + + ^ #failed! Item was added: + ----- Method: FileStat>>isFile (in category 'as yet unclassified') ----- + isFile + + ^self isDirectory not! Item was added: + Object subclass: #FileStat + instanceVariableNames: 'array dir' + classVariableNames: '' + poolDictionaries: '' + category: 'File-Kernel'! + + !FileStat commentStamp: 'kph 3/8/2007 02:52' prior: 0! + A RioDirEntry is a wrapper for the results of primLookup to be more user friendly. For example modification times are avalable as squeak DateAndTime instances. + ! Item was added: + ----- Method: FileStat>>fileSize (in category 'as yet unclassified') ----- + fileSize + + ^ array at: 5! Item was added: + ----- Method: FileStat>>dir (in category 'as yet unclassified') ----- + dir + + ^ dir! Item was added: + ----- Method: FileStat>>cTimeInSeconds (in category 'as yet unclassified') ----- + cTimeInSeconds + + ^ array at: 2! Item was added: + ----- Method: FileStat>>mTimeInSeconds (in category 'as yet unclassified') ----- + mTimeInSeconds + + ^ array at: 3! Item was added: + ----- Method: FileExecutive>>dir:add:fromBase: (in category 'as yet unclassified') ----- + dir: aDir add: aFileOrDir fromBase: aBaseDirectory + + | dir | + + dir := self dir: aDir mkpath: aFileOrDir fromBase: aBaseDirectory. + + self dir: dir add: aFileOrDir. + + ! Item was added: + ----- Method: FileExecutive class>>OSProcessOrNil (in category 'as yet unclassified') ----- + OSProcessOrNil + + "extra check is needed because OSProcess on windows does not support waitForCommand (yet)" + + | osp | + + osp := Smalltalk at: #OSProcess ifAbsent: [ ^ nil ]. + + ^ (osp thisOSProcess respondsTo: #waitForCommand:) ifTrue: [ osp ] ifFalse: [ nil ] + ! Item was removed: - Object subclass: #FileDirStat - instanceVariableNames: 'array dir' - classVariableNames: '' - poolDictionaries: '' - category: 'File-Kernel'! - - !FileDirStat commentStamp: 'kph 3/8/2007 02:52' prior: 0! - A RioDirEntry is a wrapper for the results of primLookup to be more user friendly. For example modification times are avalable as squeak DateAndTime instances. - ! Item was removed: - ----- Method: FileDirStat>>creationTime (in category 'as yet unclassified') ----- - creationTime - - ^ self cTime! Item was removed: - ----- Method: FileDirStat>>dir (in category 'as yet unclassified') ----- - dir - - ^ dir! Item was removed: - ----- Method: FileDirStat>>fileName (in category 'as yet unclassified') ----- - fileName - - ^array at: 1! Item was removed: - ----- Method: FileDirStat>>modificationTime (in category 'as yet unclassified') ----- - modificationTime - - ^ self mTime! Item was removed: - ----- Method: FileDirStat>>invalidate (in category 'as yet unclassified') ----- - invalidate - - array := nil.! Item was removed: - ----- Method: FileDirStat>>isFile (in category 'as yet unclassified') ----- - isFile - - ^self isDirectory not! Item was removed: - ----- Method: FileDirStat>>fileSize (in category 'as yet unclassified') ----- - fileSize - - ^ array at: 5! Item was removed: - ----- Method: FileDirStat>>cTimeInSeconds (in category 'as yet unclassified') ----- - cTimeInSeconds - - ^ array at: 2! Item was removed: - ----- Method: FileDirStat>>mTimeInSeconds (in category 'as yet unclassified') ----- - mTimeInSeconds - - ^ array at: 3! Item was removed: - ----- Method: FileDirStat>>rio (in category 'as yet unclassified') ----- - rio - - ^ dir / self fileName! Item was removed: - ----- Method: FileDirStat>>isValid (in category 'as yet unclassified') ----- - isValid - - ^ dir notNil! Item was removed: - ----- Method: FileDirStat class>>in:array: (in category 'as yet unclassified') ----- - in: dirRio array: theArray - - ^ self new setDir: dirRio array: theArray! Item was removed: - ----- Method: FileDirStat>>mTime (in category 'as yet unclassified') ----- - mTime - - ^ TimeStamp fromSeconds: self mTimeInSeconds - - ! Item was removed: - ----- Method: FileDirStat>>isDirectory (in category 'as yet unclassified') ----- - isDirectory - - ^(array at: 4)! Item was removed: - ----- Method: FileDirStat>>isInvalid (in category 'as yet unclassified') ----- - isInvalid - - ^ dir isNil! Item was removed: - ----- Method: FileDirStat>>cTime (in category 'as yet unclassified') ----- - cTime - - ^ TimeStamp fromSeconds: self cTimeInSeconds! Item was removed: - ----- Method: FileDirStat>>setDir:array: (in category 'as yet unclassified') ----- - setDir: aDir array: data - - dir := aDir. - array := data.!

1 0

Sake : Sake-Core-kph.67.mcz
by squeak-dev-noreply＠lists.squeakfoundation.org 23 Nov '08

23 Nov '08

A new version of Sake-Core was added to project Sake : http://www.squeaksource.com/Sake/Sake-Core-kph.67.mcz ==================== Summary ==================== Name: Sake-Core-kph.67 Author: kph Time: 23 November 2008, 5:59:14 pm UUID: afa45f22-7345-4f6d-943b-d9688b87553b Ancestors: Sake-Core-kph.66 fix =============== Diff against Sake-Core-kph.66 =============== Item was changed: ----- Method: SakeTask class>>dir: (in category 'as yet unclassified') ----- + dir: aDirectoryAble - dir: aRioable ^ self define: [ :task | + task target: aDirectoryAble asDirectory. - task target: aRioable asRio. task if: [ task target exists not ]. task action: [ task target mkpath ]. ] ! Item was changed: ----- Method: SakeTask>>privateRunRakeOrdering: (in category 'as yet unclassified') ----- privateRunRakeOrdering: setOfTasks "this is the way that Rake orders tasks, doesnt seem right to me" "we ensure that we obtain the task to run from the overall set of tasks" | priorTasks | self hasRun ifTrue: [ ^ result ]. hasRun := true. priorTasks := self dependsOn collect: [ :prior | setOfTasks like: (self taskFrom: prior) ]. priorTasks collect: [ :each | + each ifNotNil: [ each runLevel: runLevel. + each privateRunRakeOrdering: setOfTasks ]]. - each runLevel: runLevel. - each privateRunRakeOrdering: setOfTasks ]. (self isNeeded: priorTasks) ifTrue: [ self trace. self doAction: priorTasks. ^ result. ]. ^ false ! Item was changed: ----- Method: SakeTask class>>file: (in category 'as yet unclassified') ----- + file: aFileAble - file: aRioable ^ self define: [ :task | + task target: aFileAble asFile. - task target: aRioable asRio. task if: [ :prerequisites | task target exists not or: [ prerequisites anySatisfy: [ :each | each target mTime > self target mTime ]] ]. task action: [ task target ] ].!

1 0

SystemEditor: SystemEditor-Traits-mtf.16.mcz
by squeak-dev-noreply＠lists.squeakfoundation.org 19 Nov '08

19 Nov '08

A new version of SystemEditor-Traits was added to project SystemEditor: http://www.squeaksource.com/SystemEditor/SystemEditor-Traits-mtf.16.mcz ==================== Summary ==================== Name: SystemEditor-Traits-mtf.16 Author: mtf Time: 19 November 2008, 2:24:39 pm UUID: 6f002f93-ad75-4909-b265-9876a0980938 Ancestors: SystemEditor-Traits-mtf.15 - For simplicity, treat TraitTransformations like an editor - Fixed the bug where traits updated SystemOrganization prior to commit time (in TraitEditor >> edBuild) - Fixed a typo in UserListDecorator - Fixed a typo in TraitCompositionEditor >> edDependentsDo =============== Diff against SystemEditor-Traits-mtf.15 =============== Item was added: + ----- Method: TraitCompositionEditor>>edBuild (in category 'building') ----- + edBuild + | result | + result := TraitComposition new. + transformations do: [:ea | result add: (ea edBuildIn: self system)]. + ^ result! Item was added: + ----- Method: TraitExclusion>>edBuildIn: (in category '*systemeditor-traits') ----- + edBuildIn: aSystemEditor + "Adapted from #copyTraitExpression" + + ^ (super edBuildIn: aSystemEditor) + exclusions: self exclusions deepCopy; + yourself! Item was added: + ----- Method: TraitTransformation>>edBuildIn: (in category '*systemeditor-traits') ----- + edBuildIn: aSystemEditor + "Adapted from #copyTraitExpression" + + ^self shallowCopy + subject: (self subject edBuildIn: aSystemEditor); + yourself! Item was changed: ----- Method: UserListDecorator>>subject (in category 'accessing') ----- subject + ^ subject ifNil: [subject := parent subject ifNotNil: [parent subject users]]! - ^ subject ifNil: [subject := self parent subject ifNotNil: [self parent subject users]]! Item was changed: ----- Method: UserListDecorator>>edBuild (in category 'building') ----- edBuild | result | result := self subject + ifNil: [IdentitySet new] - ifNil: [IdentityDictionary new] ifNotNil: [self subject users copy]. removals do: [:ea | result remove: ea product]. additions do: [:ea | result add: ea product]. ^ result! Item was changed: ----- Method: TraitCompositionEditor>>edDependentsDo: (in category 'building') ----- edDependentsDo: aBlock "Updates and enumerates the TraitEditors whose users list needs to be updated" | oldTraits editor | oldTraits := self subject ifNil: [IdentitySet new] ifNotNil: [self subject traits asIdentitySet]. self traitsOrEditorsDo: [:ea | ea edIsEditor + ifTrue: [ea addUser: parent. aBlock value: ea] - ifTrue: [ea addUser: self. aBlock value: ea] ifFalse: [oldTraits remove: ea ifAbsent: [editor := self system edEditorFor: ea. + editor addUser: parent. aBlock value: editor]]]. - editor addUser: self. aBlock value: editor]]]. oldTraits do: [:ea | editor := self system edEditorFor: ea. editor removeUser: self. aBlock value: editor]! Item was changed: ----- Method: TraitEditor>>edBuild (in category 'building') ----- edBuild + product := Trait basicNew. + product name: self name. + + "category and environment are not set here. + category will be lazily computed sometime after + SystemEditor >> edRecatogorize runs. (see Class >> category) + environment can be left nil, since it has a default value" - product := Trait - named: self name - uses: #() - category: self category. + "Create a temporary MethodDictionary to catch code written by SyntaxError dialogs. MethodDictionaryEditor will overwrite this. See MethodEditor>>compileFor:" - "Create a temporary MethodDictionary to catch code written by SyntaxError dialogs. MethodDictionaryEditor will overwrite this. See MethodEditor>>compileFor:" product methodDictionary: MethodDictionary new. product organization: self organization edBuild. self decoratorsDo: [:ea | ea edBuild]. product methodDictionary: (self methods buildFor: self). ^product! Item was changed: AbstractEditor subclass: #TraitCompositionEditor instanceVariableNames: 'subject transformations parent' classVariableNames: '' poolDictionaries: '' category: 'SystemEditor-Traits'! + !TraitCompositionEditor commentStamp: 'mtf 11/7/2008 09:13' prior: 0! - !TraitCompositionEditor commentStamp: 'mtf 10/20/2008 11:22' prior: 0! I store the new version of a TraitComposition. I don't use any kind of diff between the subject and product. For now at least, I don't use a TraitTransformationEditor, but use plain TraitTransforms which include TraitEditors + Unlike most editors, I am not modifiable. Transient instances of myself are built and combined, and only then is one of them given a subject and environment. This is how TraitDescriptions work, so, that is how I work! - Unlike most editors, I am not persistent. Transient instances of myself are usually built, and only then is my subject and environment set. This is how TraitDescriptions work, so, that is how I work! Item was changed: ----- Method: TraitCompositionDecorator>>edBuild (in category 'building') ----- edBuild editor product traitComposition: self traitComposition edBuild. + self traitComposition edApplyChanges.! - self traitComposition edApplyChanges. - self applyChangesOfNewTraitCompositionReplacing: self subject.! Item was added: + ----- Method: TraitDescription>>edBuildIn: (in category '*systemeditor-traits') ----- + edBuildIn: aSystemEditor + "Adapted from #copyTraitExpression" + + ^ self! Item was changed: ----- Method: TraitTransformation>>asTraitCompositionEditor (in category '*systemeditor-traits') ----- asTraitCompositionEditor + ^TraitCompositionEditor with: self! - ^TraitCompositionEditor with: (TraitTransformationEditor from: self)! Item was added: + ----- Method: TraitDescriptionEditor>>edBuildIn: (in category 'building') ----- + edBuildIn: aSystemEditor + ^ self product! Item was added: + ----- Method: TraitCompositionEditor>>edApplyChanges (in category 'building') ----- + edApplyChanges + "Change the method dictionary as appropriate" + self shouldBeImplemented. + true ifTrue: [^ self]. + TPureBehavior updateMethodDictionarySelector: self. + self applyChangesOfNewTraitCompositionReplacing: self subject.! Item was added: + ----- Method: TraitAlias>>edBuildIn: (in category '*systemeditor-traits') ----- + edBuildIn: aSystemEditor + "Adapted from #copyTraitExpression" + + ^ (super edBuildIn: aSystemEditor) + aliases: self aliases deepCopy; + yourself! Item was removed: - ----- Method: TraitTransformationEditor class>>from: (in category 'instance creation') ----- - from: aTraitTransformation - ^ self new from: aTraitTransformation! Item was removed: - AbstractEditor subclass: #TraitTransformationEditor - instanceVariableNames: 'transformation' - classVariableNames: '' - poolDictionaries: '' - category: 'SystemEditor-Traits'! - - !TraitTransformationEditor commentStamp: 'mtf 10/24/2008 21:43' prior: 0! - I am a minimal wrapper around a TraitTransformation to support building. I have no subject! Item was removed: - ----- Method: TComposingDescription>>asTraitCompositionEditor (in category '*systemeditor-traits') ----- - asTraitCompositionEditor - ^TraitCompositionEditor with: self! Item was removed: - ----- Method: TraitTransformationEditor>>from: (in category 'initialize-release') ----- - from: aTraitTransformation - transformation := aTraitTransformation copyTraitExpression! Item was removed: - ----- Method: TraitDescription>>asTraitCompositionEditor (in category '*systemeditor-traits') ----- - asTraitCompositionEditor - ^TraitCompositionEditor with: self!

1 0

SystemEditor: SystemEditor-Squeak-mtf.159.mcz
by squeak-dev-noreply＠lists.squeakfoundation.org 19 Nov '08

19 Nov '08

A new version of SystemEditor-Squeak was added to project SystemEditor: http://www.squeaksource.com/SystemEditor/SystemEditor-Squeak-mtf.159.mcz ==================== Summary ==================== Name: SystemEditor-Squeak-mtf.159 Author: mtf Time: 19 November 2008, 2:15:57 pm UUID: 684f4246-1fa1-4b3f-b756-944f3710a00b Ancestors: SystemEditor-Squeak-mtf.158 Noted how category and environment get set in edBuild =============== Diff against SystemEditor-Squeak-mtf.158 =============== Item was changed: ----- Method: ClassEditor>>edBuild (in category 'building') ----- edBuild | meta | meta := self class edBuild. product := subject ifNil: [meta new] ifNotNil: [meta adoptInstance: subject from: subject class]. product superclass: self edSuperclass; setFormat: self format; setName: self name; setInstVarNames: self instVarNames; classPoolFrom: self; instVarNamed: #sharedPools put: self sharedPools; organization: self organization edBuild. + + "category and environment are not set here. + category will be lazily computed sometime after + SystemEditor >> edRecatogorize runs. (see Class >> category) + environment can be left nil, since it has a default value" + + "Create a temporary MethodDictionary to catch code written by + SyntaxError dialogs. MethodDictionaryEditor will overwrite this. + See MethodEditor>>compileFor:" - "Create a temporary MethodDictionary to catch code written by SyntaxError dialogs. MethodDictionaryEditor will overwrite this. See MethodEditor>>compileFor:" product methodDictionary: MethodDictionary new. self decoratorsDo: [:ea | ea edBuildInto: product]. "Class methods should be compiled before instance methods, since #compilerClass may be among the class methods. Class methods should be compiled after installing class and pool variables" product class methodDictionary: (self class methods buildFor: self class). product methodDictionary: (self methods buildFor: self). ^product!

1 0

SystemEditor: SystemEditor-Squeak-mtf.158.mcz
by squeak-dev-noreply＠lists.squeakfoundation.org 18 Nov '08

18 Nov '08

A new version of SystemEditor-Squeak was added to project SystemEditor: http://www.squeaksource.com/SystemEditor/SystemEditor-Squeak-mtf.158.mcz ==================== Summary ==================== Name: SystemEditor-Squeak-mtf.158 Author: mtf Time: 18 November 2008, 12:13:32 pm UUID: 45181e22-2f02-4a80-a7da-f8c64b48d949 Ancestors: SystemEditor-Squeak-mtf.157 - oops. Forgot to add the compilerClass ivar. - slight simplification of ensuredCompilerClass =============== Diff against SystemEditor-Squeak-mtf.157 =============== Item was added: + ----- Method: PureBehaviorEditor>>edUltimateMethodAt: (in category 'editing') ----- + edUltimateMethodAt: aSelector + ^ self edUltimateMethodAt: aSelector ifAbsent: [self error: 'Method not found']! Item was changed: ClassDescriptionEditor subclass: #ClassEditor + instanceVariableNames: 'name classVarNames sharedPools category compilerClass' - instanceVariableNames: 'name classVarNames sharedPools category' classVariableNames: '' poolDictionaries: '' category: 'SystemEditor-Squeak'! Item was changed: ----- Method: ClassEditor>>ensuredCompilerClass (in category 'accessing') ----- ensuredCompilerClass "Answer my product's compilerClass, building it if necessary" | methodEditor method | compilerClass ifNotNil: [^ compilerClass]. "Normal case: the compiler is already in the system. Check to see if I have a newer version" self product compilerClass ifNotNil: [ compilerClass := self system classOrEditorFor: self product compilerClass. compilerClass edIsEditor ifTrue: [compilerClass := compilerClass product]. ^ compilerClass]. "If we get here, this package is presumably using a compiler that does not yet exist in the system. Evil evil hackery. Get the method editor, compile it in the context of the system editor, and run it to find the editor for the new compiler" + methodEditor := self class edUltimateMethodAt: #compilerClass. - methodEditor := self class edUltimateMethodAt: #compilerClass ifAbsent: [^ self subject - ifNil: [Compiler] - ifNotNil: [self subject compilerClass]]. method := methodEditor compileForClass: self using: Compiler new. compilerClass := (self new executeMethod: method) product. compilerClass ifNil: [self error: 'Unknown compiler']. ^ compilerClass!

1 0

SystemEditor: SystemEditor-Squeak-mtf.157.mcz
by squeak-dev-noreply＠lists.squeakfoundation.org 18 Nov '08

18 Nov '08

A new version of SystemEditor-Squeak was added to project SystemEditor: http://www.squeaksource.com/SystemEditor/SystemEditor-Squeak-mtf.157.mcz ==================== Summary ==================== Name: SystemEditor-Squeak-mtf.157 Author: mtf Time: 18 November 2008, 12:01:29 pm UUID: d99f6c77-0394-4435-bcba-39a0d3b5f952 Ancestors: SystemEditor-Squeak-mtf.156 remove some duplicate methods from MetaclassEditor =============== Diff against SystemEditor-Squeak-mtf.156 =============== Item was removed: - ----- Method: MetaclassEditor>>superclass: (in category 'editing') ----- - superclass: aClass - superEditor := self system edEditorFor: aClass! Item was removed: - ----- Method: MetaclassEditor>>edMethodAt:ifAbsent: (in category 'editing') ----- - edMethodAt: aSelector ifAbsent: aBlock - ^ self methods at: aSelector ifAbsent: aBlock! Item was removed: - ----- Method: MetaclassEditor>>removeInstVarName: (in category 'editing') ----- - removeInstVarName: aString - instVarNames ifNil: [instVarNames := self subject instVarNames]. - instVarNames := instVarNames copyWithout: aString! Item was removed: - ----- Method: MetaclassEditor>>rearrangeInstVarNames: (in category 'editing') ----- - rearrangeInstVarNames: associations - "The associations are name -> pos and cover the subset - of vars that should be moved. The old just fill in the holes." - - instVarNames := ClassEditor rearrangeVarNames: associations oldNames: instVarNames! Item was removed: - ----- Method: MetaclassEditor>>edMethodAt: (in category 'editing') ----- - edMethodAt: aSelector - ^ self methods at: aSelector!

1 0

SystemEditor: SystemEditor-Squeak-mtf.156.mcz
by squeak-dev-noreply＠lists.squeakfoundation.org 18 Nov '08

18 Nov '08

A new version of SystemEditor-Squeak was added to project SystemEditor: http://www.squeaksource.com/SystemEditor/SystemEditor-Squeak-mtf.156.mcz ==================== Summary ==================== Name: SystemEditor-Squeak-mtf.156 Author: mtf Time: 18 November 2008, 12:00:30 pm UUID: 382d9f0c-597d-4bfa-a96b-65519b370280 Ancestors: SystemEditor-Squeak-mtf.155 Greatly improved the smartness of finding the compiler for a given class. This should fix all loading problems in which the compiler changes during load. A good test would be to ensure that FFI and a dependent package can be loaded atomicly together =============== Diff against SystemEditor-Squeak-mtf.155 =============== Item was changed: ----- Method: MethodEditor>>compileFor: (in category 'building') ----- compileFor: aClassEditor + + ^ self + compileForClass: aClassEditor product + using: aClassEditor ensuredCompilerClass new! - [ - | node method | - node := aClassEditor product compilerClass new - compile: source - in: aClassEditor product - notifying: requestor - ifFail: nil. - node encoder requestor: self. - method := node generate: #(0 0 0 0). - (method respondsTo: #selector:) "set selector on 3.9 and above" - ifTrue: [method selector: node selector]. - ^ method - ] on: SyntaxErrorNotification do: [:ex | - "In 3.10, the class category needs to be set" - ex instVarNamed: #category put: aClassEditor category. - "Let the user fix and install the fixed code into the class's old or temporary MethodDictionary" - ex outer. - "Now fetch and use that code instead" - source := aClassEditor product sourceCodeAt: self selector ifAbsent: [^ nil]. - ^ aClassEditor product compiledMethodAt: self selector - ]! Item was added: + ----- Method: ClassDescriptionEditor>>lookupSelector: (in category 'debugging') ----- + lookupSelector: aSelector + ^ superclass lookupSelector: aSelector! Item was added: + ----- Method: PureBehaviorEditor>>edUltimateMethodAt:ifAbsent: (in category 'editing') ----- + edUltimateMethodAt: aSelector ifAbsent: aBlock + ^ self edMethodAt: aSelector ifAbsent: aBlock! Item was added: + ----- Method: RootMetaclassEditor>>edUltimateMethodAt:ifAbsent: (in category 'accessing') ----- + edUltimateMethodAt: aSelector ifAbsent: aBlock + ^ aBlock value! Item was added: + ----- Method: ClassEditor>>ensuredCompilerClass (in category 'accessing') ----- + ensuredCompilerClass + "Answer my product's compilerClass, building it if necessary" + + | methodEditor method | + compilerClass ifNotNil: [^ compilerClass]. + + "Normal case: the compiler is already in the system. Check to see if I have a newer version" + self product compilerClass ifNotNil: [ + compilerClass := self system classOrEditorFor: self product compilerClass. + compilerClass edIsEditor ifTrue: [compilerClass := compilerClass product]. + ^ compilerClass]. + + "If we get here, this package is presumably using a compiler that does not yet exist in the system. + Evil evil hackery. Get the method editor, compile it in the context of the system editor, + and run it to find the editor for the new compiler" + methodEditor := self class edUltimateMethodAt: #compilerClass ifAbsent: [^ self subject + ifNil: [Compiler] + ifNotNil: [self subject compilerClass]]. + method := methodEditor compileForClass: self using: Compiler new. + compilerClass := (self new executeMethod: method) product. + compilerClass ifNil: [self error: 'Unknown compiler']. + ^ compilerClass! Item was added: + ----- Method: ClassDescriptionEditor>>edUltimateMethodAt:ifAbsent: (in category 'accessing') ----- + edUltimateMethodAt: aSelector ifAbsent: aBlock + ^ self edMethodAt: aSelector ifAbsent: [ + self superclass edUltimateMethodAt: aSelector ifAbsent: aBlock]! Item was added: + ----- Method: MethodEditor>>compileForClass:using: (in category 'building') ----- + compileForClass: aClass using: aCompiler + [ + | node method | + node := aCompiler + compile: source + in: aClass + notifying: requestor + ifFail: nil. + node encoder requestor: self. + method := node generate: #(0 0 0 0). + (method respondsTo: #selector:) "set selector on 3.9 and above" + ifTrue: [method selector: node selector]. + ^ method + ] on: SyntaxErrorNotification do: [:ex | + "In 3.10, the class category needs to be set" + ex instVarNamed: #category put: aClass category. + "Let the user fix and install the fixed code into the class's old or temporary MethodDictionary" + ex outer. + "Now fetch and use that code instead" + source := aClass sourceCodeAt: self selector ifAbsent: [^ nil]. + ^ aClass compiledMethodAt: self selector + ]! Item was added: + ----- Method: MethodEditor>>source (in category 'accessing') ----- + source + ^ source! Item was added: + ----- Method: RootClassEditor>>edUltimateMethodAt:ifAbsent: (in category 'accessing') ----- + edUltimateMethodAt: aSelector ifAbsent: aBlock + ^ aBlock value! Item was added: + ----- Method: PureBehaviorEditor>>ensuredCompilerClass (in category 'accessing') ----- + ensuredCompilerClass + "Answer the compiler for my methods, building it if necessary" + + ^ self product compilerClass! Item was removed: - ----- Method: MetaclassEditor>>lookupSelector: (in category 'debugging') ----- - lookupSelector: aSelector - - "Override the implementation in Behavior to make ClassEditor - debuggable. The debugger calls this during simulated execution, - and since we override #includesSelector and #superclass to - reflect on the subject, we get incorrect method dispatch." - - | lookupClass dict | - lookupClass := self. - [lookupClass == nil] whileFalse: - [dict := lookupClass instVarAt: 2. - (dict includesKey: aSelector) - ifTrue: [^ dict at: aSelector]. - lookupClass := lookupClass instVarAt: 1]. - ^ nil!

1 0

Rio: File-Test-kph.1.mcz
by squeak-dev-noreply＠lists.squeakfoundation.org 13 Nov '08

13 Nov '08

A new version of File-Test was added to project Rio: http://www.squeaksource.com/Rio/File-Test-kph.1.mcz ==================== Summary ==================== Name: File-Test-kph.1 Author: kph Time: 13 November 2008, 2:20:08 am UUID: b46f3cbc-3de1-4fb3-9209-fac53df8bc56 Ancestors: First version of File version of Rio ==================== Snapshot ==================== SystemOrganization addCategory: #'File-Test'! FileLocalExecutive subclass: #FileVirtualTestFSUnix instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'File-Test'! ----- Method: FileVirtualTestFSUnix>>dirClass (in category 'as yet unclassified') ----- dirClass ^ Notification new tag: #dirClass; signal! ----- Method: FileVirtualTestFSUnix>>fileClass (in category 'as yet unclassified') ----- fileClass ^ Notification new tag: #fileClass; signal! ----- Method: FileVirtualTestFSUnix>>initialize (in category 'as yet unclassified') ----- initialize self initializeDefault! ----- Method: FileVirtualTestFSUnix>>primImagePath (in category 'as yet unclassified') ----- primImagePath ^ '/home/user/bob/squeak/this.image'! FileLocalDosExecutive subclass: #FileVirtualTestFSDos instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'File-Test'! ----- Method: FileVirtualTestFSDos>>dirClass (in category 'as yet unclassified') ----- dirClass ^ Notification new tag: #dirClass; signal! ----- Method: FileVirtualTestFSDos>>fileClass (in category 'as yet unclassified') ----- fileClass ^ Notification new tag: #fileClass; signal! ----- Method: FileVirtualTestFSDos>>initialize (in category 'as yet unclassified') ----- initialize self initializeDefault! ----- Method: FileVirtualTestFSDos>>primImagePath (in category 'as yet unclassified') ----- primImagePath ^ 'D:\User\Bob\Squeak\this.image'! TestCase subclass: #FileCaseInsensitiveTest instanceVariableNames: 'file' classVariableNames: '' poolDictionaries: '' category: 'File-Test'! ----- Method: FileCaseInsensitiveTest>>setUp (in category 'setup') ----- setUp ! ----- Method: FileCaseInsensitiveTest>>tearDown (in category 'setup') ----- tearDown ! ----- Method: FileCaseInsensitiveTest>>testSetOfFiles (in category 'tests') ----- testSetOfFiles file := Set new. file add: ( (File new: 'hello') executive: (FileLocalCaseInsensitiveExecutive new) ). self assert: file size = 1. file add: ((File new: 'heLLo') executive: (FileLocalCaseInsensitiveExecutive new) ). self assert: file size = 1! TestCase subclass: #FileDirTest instanceVariableNames: 'testDir subDir a b c destDir' classVariableNames: '' poolDictionaries: '' category: 'File-Test'! FileDirTest subclass: #FileArchiveTest instanceVariableNames: 'archive' classVariableNames: '' poolDictionaries: '' category: 'File-Test'! !FileArchiveTest commentStamp: 'kph 4/9/2007 02:59' prior: 0! How to work this archive thing? In theory, a file ref in an archive should handle copyTo: to actually do the extraction. How do you get a file ref in an archive? One option would be: 'myFile.zip' asRio zip entries Does this mean that on entering zip mode, our rio becomes the top level directory entry in a zipped filesystem? The filesystem implements select: so all other select dependent facilities should work. The mode adaptor could just override #executive, probably not sufficient. ---- aDirectory addTree: (anArchive := aFile zip) anArchive decompress => aDirectory addTree: anArchive anArchive decompressTo: aDirectory. aGzipFile decompressTo: aDirectory.! ----- Method: FileArchiveTest>>hmmm (in category 'as yet unclassified') ----- hmmm " aDirectory addTree: (anArchive := aFile zip) anArchive decompress => aDirectory addTree: anArchive anArchive decompressTo: aDirectory. aGzipFile decompressTo: aDirectory. "! ----- Method: FileArchiveTest>>makeArchive (in category 'fixtures') ----- makeArchive self makeDirectoriesAndFiles. (archive := destDir mkdir / 'test.zip') zip addTree: testDir; commit. ! ----- Method: FileArchiveTest>>testArchiveAccess (in category 'tests-archive') ----- testArchiveAccess | file | self makeArchive. file := archive zip / 'testing_file/f_1'. self assert: (file isFile). ! ----- Method: FileArchiveTest>>testArchiveContents (in category 'tests-archive') ----- testArchiveContents | all | self makeArchive. self assert: (archive zip entries asSet = (Set with: (File new: 'testing_file'))). all := archive zip all entries. self assert: (all asSet = { (File new: 'testing_file'). (File new: 'testing_file/t_a/f 1'). (File new: 'testing_file/t_a/t 1'). (File new: 'testing_file/t_a/t 2'). } asArray asOrderedCollection asSet). self assert: (all first isDirectory). self assert: (all second isFile). ! FileDirTest subclass: #FileDirFtpTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'File-Test'! ----- Method: FileDirFtpTest class>>shouldInheritSelectors (in category 'as yet unclassified') ----- shouldInheritSelectors ^ true! ----- Method: FileDirFtpTest>>initialize (in category 'as yet unclassified') ----- initialize testDir := 'ftp://squeak:viewpoints@squeak.warwick.st/testing_file' asDirectory. destDir := 'ftp://squeak:viewpoints@squeak.warwick.st/testing_file_dest' asDirectory.! ----- Method: FileDirTest class>>allStandardTests (in category 'as yet unclassified') ----- allStandardTests ^ super allStandardTests , (self suiteWithMethodCategoryMatching: 'tests*') ! ----- Method: FileDirTest class>>resources (in category 'as yet unclassified') ----- resources self new tearDown. ^ super resources! ----- Method: FileDirTest class>>usesNetwork (in category 'as yet unclassified') ----- usesNetwork ^ self allStandardTests! ----- Method: FileDirTest>>initialize (in category 'fixtures') ----- initialize testDir := Cwd / 'testing_file'. destDir := Cwd / 'testing_file_dest'.! ----- Method: FileDirTest>>makeDirectoriesAndFiles (in category 'fixtures') ----- makeDirectoriesAndFiles subDir := (testDir / 't_a') mkdir. a := (subDir / 'f 1') contents: 'test file'. "test dirname with space in it" b := (subDir / 't 1') mkdir. c := (subDir / 't 2') mkdir. ! ----- Method: FileDirTest>>setUp (in category 'fixtures') ----- setUp testDir mkdir! ----- Method: FileDirTest>>tearDown (in category 'fixtures') ----- tearDown testDir all delete. destDir all delete.! ----- Method: FileDirTest>>testAddTree (in category 'tests-directory copying') ----- testAddTree self makeDirectoriesAndFiles. destDir mkdir addTree: testDir. self assert: (destDir all entries size = 5). self assert: ((testDir / 't_a' / 'f 1') contents = 'test file'). self assert: ((destDir / 'testing_file'/ 't_a' / 'f 1') contents = 'test file').! ----- Method: FileDirTest>>testEntries (in category 'tests-select') ----- testEntries self makeDirectoriesAndFiles. self assert: subDir entries asSet = {a. b. c.} asSet. ! ----- Method: FileDirTest>>testMakingDirectory (in category 'tests-directory actions') ----- testMakingDirectory subDir := testDir / 't_a'. self deny: subDir isDirectory. subDir mkdir. self assert: subDir isDirectory! ----- Method: FileDirTest>>testMakingPath (in category 'tests-directory actions') ----- testMakingPath subDir := testDir / 't_a/t_b/t_c'. self deny: subDir isDirectory. self deny: subDir parent isDirectory. self deny: subDir parent parent isDirectory. subDir mkpath. self assert: subDir isDirectory. self assert: subDir parent isDirectory. self assert: subDir parent parent isDirectory! ----- Method: FileDirTest>>testRecursiveDirectories (in category 'tests-select') ----- testRecursiveDirectories | dirs | self testMakingPath. subDir := testDir / 't_a'. dirs := subDir directories. self assert: dirs first = (testDir / 't_a/t_b'). self assert: dirs size == 1. dirs := subDir all directories. self assert: dirs first = (testDir / 't_a/t_b'). self assert: dirs last = (testDir / 't_a/t_b/t_c'). self assert: dirs size == 2.! ----- Method: FileDirTest>>testRemovingDirectory (in category 'tests-directory actions') ----- testRemovingDirectory self testMakingDirectory. subDir rmdir. self deny: subDir isDirectory! ----- Method: FileDirTest>>testRemovingNonExistentDirectory (in category 'tests-directory actions') ----- testRemovingNonExistentDirectory subDir := testDir / 't_z'. self deny: subDir isDirectory. subDir rmdir. self deny: subDir isDirectory! TestCase subclass: #FileKernelTest instanceVariableNames: 'file testDir fileClass dir' classVariableNames: '' poolDictionaries: '' category: 'File-Test'! ----- Method: FileKernelTest class>>allStandardTests (in category 'as yet unclassified') ----- allStandardTests ^ super allStandardTests , (self suiteWithMethodCategoryMatching: 'tests*') ! ----- Method: FileKernelTest>>cleanTestDir (in category 'fixtures') ----- cleanTestDir testDir ifNotNilDo: [ :d | d all delete ].! ----- Method: FileKernelTest>>fox (in category 'fixtures') ----- fox ^ 'the quick brown fox jumped over the lazy dog' ! ----- Method: FileKernelTest>>hello (in category 'fixtures') ----- hello ^ fileClass new: 'hello.txt'! ----- Method: FileKernelTest>>helloV5 (in category 'fixtures') ----- helloV5 ^ fileClass new: 'hello.5.txt'! ----- Method: FileKernelTest>>rootIsDirectory (in category 'tests-standard') ----- rootIsDirectory dir := fileClass new: FileLocalExecutive current root value. self assert: (dir isRoot). self assert: (dir isDirectory). ! ----- Method: FileKernelTest>>setUp (in category 'fixtures') ----- setUp fileClass := FileKernel ! ----- Method: FileKernelTest>>tearDown (in category 'fixtures') ----- tearDown self cleanTestDir! ----- Method: FileKernelTest>>testIsDirectory (in category 'tests-standard') ----- testIsDirectory self assert: self thisImage parent isDirectory. self deny: self thisImage parent isFile! ----- Method: FileKernelTest>>testIsFile (in category 'tests-standard') ----- testIsFile self assert: self thisImage isFile. self deny: self thisImage isDirectory! ----- Method: FileKernelTest>>testNonEntity (in category 'tests-standard') ----- testNonEntity self deny: (self thisImage parent / '_blah_') isFile. self deny: (self thisImage parent / '_blah_') isDirectory! ----- Method: FileKernelTest>>testNonEntityInNonDirectory (in category 'tests-standard') ----- testNonEntityInNonDirectory self deny: (self thisImage parent / '_blah_' / '_blah_') isFile. self deny: (self thisImage parent / '_blah_' / '_blah_') isDirectory! ----- Method: FileKernelTest>>thisImage (in category 'fixtures') ----- thisImage ^ fileClass thisImage! ----- Method: FileKernelTest>>useTestDir (in category 'fixtures') ----- useTestDir ^ (testDir := Directory new: '_test_') all delete mkdir! ----- Method: FileKernelTest>>versions (in category 'tests-standard') ----- versions file := (self useTestDir / self helloV5) touch. self assert: (file versions asArray = #(5) ). file nextVersion touch nextVersion touch. self assert: (file versions asArray = #(5 6 7) ). self assert: (file latestVersion = '_test_/hello.7.txt').! FileKernelTest subclass: #FileTest instanceVariableNames: 'afile newFile' classVariableNames: '' poolDictionaries: '' category: 'File-Test'! FileTest subclass: #FileModeTests instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'File-Test'! FileModeTests subclass: #FileGzipTest instanceVariableNames: 'textFile textFileSize gzipFile gzipFileSize' classVariableNames: '' poolDictionaries: '' category: 'File-Test'! ----- Method: FileGzipTest>>newTextFile (in category 'fixtures') ----- newTextFile textFile := self useTestDir / 'InflateStream.st'. textFile delete writer: [ :out | InflateStream fileOutOn: out moveSource: false toFile: 0. ]. textFileSize := textFile size. ^ textFile! ----- Method: FileGzipTest>>testGzipWriteAndRead (in category 'tests') ----- testGzipWriteAndRead self assert: (self fox size = 44). file := (self useTestDir / 'zip.gz') gzip writer: [ :out | out << self fox ]. self assert: (file isFile & file fileSize = 62). "reading from a gzip file should honour the binary setting of the stream even though the actual on disk file is binary" self assert: ( file contents = self fox ). self assert: ( file contents size = 44 ). ! ----- Method: FileGzipTest>>testGzipWriteAndReadBinary (in category 'tests') ----- testGzipWriteAndReadBinary self assert: (self fox size = 44). rio := (self useTestDir / 'zip.gz') gzip beBinary writer: [ :out | out << self fox asByteArray ]. self assert: (rio isFile & rio fileSize = 62). self assert: ( rio beBinary contents = self fox asByteArray ). self assert: ( rio beBinary contents size = 44 ).! ----- Method: FileGzipTest>>testNewCompressDecompress (in category 'tests') ----- testNewCompressDecompress "self debug: #testOldCompressDecompress" | original | self newTextFile. textFile gzip compress. original := textFile rename ext: 'orig'. (textFile + '.gz') auto decompress. self assert: (textFile contents = original contents). ! ----- Method: FileGzipTest>>testOldCompressDecompress (in category 'tests') ----- testOldCompressDecompress "self debug: #testOldCompressDecompress" self newTextFile. GZipWriteStream compressFile: textFile full asString. textFile rename ext: 'orig'. GZipReadStream saveContents: (textFile + '.gz') full asString. self assert: (textFile contents = (textFile ext: 'orig') contents). ! ----- Method: FileModeTests class>>shouldInheritSelectors (in category 'as yet unclassified') ----- shouldInheritSelectors ^ false! ----- Method: FileModeTests>>testBinaryModes (in category 'binary mode') ----- testBinaryModes rio := self useTestDir / self hello. self deny: (rio binary == rio). self assert: (rio beBinary == rio). ! ----- Method: FileModeTests>>testGzipModes (in category 'binary mode') ----- testGzipModes rio := self useTestDir / self hello. self deny: (rio gzip == rio). ! ----- Method: FileModeTests>>testRenamingModeFullNameSet (in category 'renaming mode') ----- testRenamingModeFullNameSet rio := self useTestDir / self hello. rio touch. self assert: (rio isFile). newRio := rio rename fileName: 'goodbye.text'. self deny: (rio isFile). self assert: (newRio isFile).! ----- Method: FileModeTests>>testRenamingModes (in category 'renaming mode') ----- testRenamingModes rio := self useTestDir / self hello. self deny: (rio rename == rio). self assert: (rio beRenaming == rio). ! ----- Method: FileTest class>>compiledSize: (in category 'as yet unclassified') ----- compiledSize: categoryMatch " self compiledSize: 'Rio-Kernel'. (4881 + 5435) / (11471.0 + 7908.0). self compiledSize: 'Rio-Grande'. 5435 self compiledSize: 'Files-Directories'. 11471 self compiledSize: 'FileMan-Core'. 7098 " | total | total := 0. (SystemOrganization categoriesMatching: categoryMatch) do: [ :cat | (SystemOrganization listAtCategoryNamed: cat) do: [ :className | (Smalltalk at: className) in: [ :class | class methodsDo: [ :m | total := total + m size ]. class class methodsDo: [ :m | total := total + m size ]. ] ]. ]. ^ total! ----- Method: FileTest class>>shouldInheritSelectors (in category 'as yet unclassified') ----- shouldInheritSelectors ^ true! ----- Method: FileTest>>cwdAppendString (in category 'tests') ----- cwdAppendString rio := File new. newRio := rio / 'user'. self deny: newRio == rio. self assert: newRio asString = 'user'! ----- Method: FileTest>>equality (in category 'tests') ----- equality self assert: (File new: '/usr/bin/bob') = '/usr/bin/bob'. self assert: (File new: '/usr/bin/bob') = (File new: '/usr/bin/bob')! ----- Method: FileTest>>exists (in category 'tests') ----- exists self assert: self thisImage exists. self assert: self thisImage parent exists. self deny: (self thisImage / 'blah') exists! ----- Method: FileTest>>ftp (in category 'tests') ----- ftp file := File new: 'ftp://ftp.seasidehosting.st'. self assert: file class = Directory. self assert: file executive class = FileFtpExecutive.! ----- Method: FileTest>>full (in category 'tests') ----- full dir := Directory new. self assert: dir full = FileDirectory default pathName.! ----- Method: FileTest>>http (in category 'tests') ----- http file := File new: 'http://www.google.com'. self assert: file class = Directory. self assert: file executive class = FileHttpExecutive! ----- Method: FileTest>>rioClass (in category 'tests') ----- rioClass ^ File! ----- Method: FileTest>>setUp (in category 'fixtures') ----- setUp fileClass := File ! ----- Method: FileTest>>testDirCwd (in category 'tests') ----- testDirCwd dir := Directory new. self assert: dir asString = ''! ----- Method: FileTest>>testFileAppendString (in category 'tests') ----- testFileAppendString self testFileFromString. newFile := file / 'user'. self deny: newFile == file. self assert: newFile = '/home/user'! ----- Method: FileTest>>testFileExt (in category 'tests') ----- testFileExt file := File new: 'hello.haha.txt'. self assert: file ext = 'txt'! ----- Method: FileTest>>testFileFromFile (in category 'tests') ----- testFileFromFile self testFileFromString. newFile := File new: file. self assert: newFile = '/home'. self deny: newFile == file. self assert: newFile = file! ----- Method: FileTest>>testFileFromString (in category 'tests') ----- testFileFromString file := File new: '/home'. self assert: file = '/home'! ----- Method: FileTest>>testFileSetExt (in category 'tests') ----- testFileSetExt self testFileExt. file ext: 'bak'. self assert: file ext = 'bak'. self assert: file asString = 'hello.haha.bak'! ----- Method: FileTest>>testFull (in category 'tests') ----- testFull file := File new. self assert: file full = FileDirectory default pathName.! ----- Method: FileTest>>testLinearRelativeTo (in category 'tests') ----- testLinearRelativeTo file := '/hello/this/is/a/world/apart/from/here.txt' asFile linearRelativeTo: '/hello/this' asFile. self assert: (file = 'is/a/world/apart/from/here.txt').! ----- Method: FileTest>>testLinearRelativeToNot (in category 'tests') ----- testLinearRelativeToNot newFile := (file := '/a/b/c/d/e/f' asFile full) linearRelativeTo: '/no/relation/at/all' asFile. self assert: (newFile = file).! ----- Method: FileTest>>testRelativeTo (in category 'tests') ----- testRelativeTo self assert: (('/a/b/c/g/h/i' asFile relativeTo: '/a/b/c/d/e/f') = '../../../g/h/i'). self assert: (('/a/b/c' asFile relativeTo: '/a/b/c') = ''). self assert: (('/a/b/c/d' asFile relativeTo: '/a/b/c') = 'd'). ! ----- Method: FileTest>>testRioExtend (in category 'tests') ----- testRioExtend self testFileFromString. newFile := file + '.dir'. self deny: newFile == file. self assert: newFile = '/home.dir'! TestCase subclass: #FileKernelUseCases instanceVariableNames: 'rio newRio' classVariableNames: '' poolDictionaries: '' category: 'File-Test'! ----- Method: FileKernelUseCases>>changesName (in category 'uses-SmalltalkImage') ----- changesName rio := FileKernel thisImage base: nil version: nil ext: 'changes'. self assert: (rio asString beginsWith: (File thisImage asString allButLast: 5))! ----- Method: FileKernelUseCases>>imageName (in category 'uses-SmalltalkImage') ----- imageName rio := FileKernel thisImage. self assert: (rio asString endsWith: '.image')! TestCase subclass: #FileStreamsCopyTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'File-Test'! ----- Method: FileStreamsCopyTest>>fox (in category 'as yet unclassified') ----- fox ^ 'the quick brown fox jumped over the lazy dog' ! ----- Method: FileStreamsCopyTest>>testCopyStreams (in category 'as yet unclassified') ----- testCopyStreams | in | in := self fox readStream. self assert:(self fox = (String streamContents: [ :out | in copyTo: out. ]))! ----- Method: FileStreamsCopyTest>>testCopyStreamsBinary (in category 'as yet unclassified') ----- testCopyStreamsBinary | inData in | in := (inData := self fox asByteArray) readStream. self assert:(inData = (ByteArray streamContents: [ :out | in copyTo: out size: inData size withProgress: 'test binary copy'. ])) ! ----- Method: FileStreamsCopyTest>>testCopyStreamsProgressing (in category 'as yet unclassified') ----- testCopyStreamsProgressing | in | in := self fox readStream. self assert:(self fox = (String streamContents: [ :out | in copyTo: out size: self fox size withProgress: 'test'. ]))! TestCase subclass: #FileVirtualFSCommonTest instanceVariableNames: 'file fileClass dirClass' classVariableNames: '' poolDictionaries: '' category: 'File-Test'! ----- Method: FileVirtualFSCommonTest class>>allStandardTests (in category 'as yet unclassified') ----- allStandardTests ^ super allStandardTests , (self suiteWithMethodCategoryMatching: 'tests*') ! ----- Method: FileVirtualFSCommonTest class>>isAbstract (in category 'as yet unclassified') ----- isAbstract ^ self name = #FileVirtualFSCommonTest ! ----- Method: FileVirtualFSCommonTest class>>shouldInheritSelectors (in category 'as yet unclassified') ----- shouldInheritSelectors ^ true! ----- Method: FileVirtualFSCommonTest>>currentFileSystem (in category 'fixtures') ----- currentFileSystem ^ FileLocalExecutive current! ----- Method: FileVirtualFSCommonTest>>dirClass (in category 'as yet unclassified') ----- dirClass ^ dirClass! ----- Method: FileVirtualFSCommonTest>>fileClass (in category 'as yet unclassified') ----- fileClass ^ fileClass! ----- Method: FileVirtualFSCommonTest>>hello (in category 'fixtures') ----- hello ^ fileClass new: 'hello.txt'! ----- Method: FileVirtualFSCommonTest>>helloV5 (in category 'fixtures') ----- helloV5 ^ 'hello.5.txt' asFile! ----- Method: FileVirtualFSCommonTest>>isKernelTest (in category 'fixtures') ----- isKernelTest ^ fileClass == FileKernel! ----- Method: FileVirtualFSCommonTest>>runCaseWith: (in category 'as yet unclassified') ----- runCaseWith: aBlock aBlock on: Notification do: [ :ex | ex resume: (self perform: ex tag) ]! ----- Method: FileVirtualFSCommonTest>>stringConcatenation (in category 'tests-string behaviour') ----- stringConcatenation self assert: ('hello' , (File new: 'world') = 'helloworld').! ----- Method: FileVirtualFSCommonTest>>tearDown (in category 'fixtures') ----- tearDown FileLocalExecutive testEnd! ----- Method: FileVirtualFSCommonTest>>testBaseGet (in category 'tests-accessing') ----- testBaseGet self isKernelTest ifTrue: [ ^self ]. self assert: self hello base = 'hello'. self assert: self fullHello base = 'hello'. self assert: self helloV5 base = 'hello'.! ----- Method: FileVirtualFSCommonTest>>testBaseSet (in category 'tests-accessing') ----- testBaseSet self isKernelTest ifTrue: [ ^self ]. self assert: ((self hello base: 'bonjour') = 'bonjour.txt'). self assert: ((self fullHello base: 'bonjour') = (self tmp,'bonjour.txt')). self assert: ((self helloV5 base: 'bonjour') = 'bonjour.5.txt').! ----- Method: FileVirtualFSCommonTest>>testBaseVersionAndExtSet (in category 'tests-accessing') ----- testBaseVersionAndExtSet file := self hello base: 'bye' version: nil ext: nil. self assert: file = 'bye.txt'. file := self hello base: nil version: 1 ext: nil. self assert: file = 'hello.1.txt'. file := self hello base: nil version: nil ext: 'html'. self assert: file = 'hello.html'. file := self helloV5 base: 'bye' version: nil ext: nil. self assert: file = 'bye.5.txt'. file := self helloV5 base: nil version: 1 ext: nil. self assert: file = 'hello.1.txt'. file := self helloV5 base: nil version: nil ext: 'html'. self assert: file = 'hello.5.html'. ! ----- Method: FileVirtualFSCommonTest>>testDotFirst (in category 'tests-instanciation') ----- testDotFirst file := '.dotfirst' asFile. self assert: (file = '.dotfirst'). ^ file! ----- Method: FileVirtualFSCommonTest>>testDotLast (in category 'tests-instanciation') ----- testDotLast file := 'dotlast.' asFile. self assert: (file = 'dotlast.'). ^ file! ----- Method: FileVirtualFSCommonTest>>testExtGet (in category 'tests-accessing') ----- testExtGet self isKernelTest ifTrue: [ ^self ]. self assert: self hello ext = 'txt'. self assert: self fullHello ext = 'txt'. self assert: self helloV5 ext = 'txt'. ! ----- Method: FileVirtualFSCommonTest>>testExtSet (in category 'tests-accessing') ----- testExtSet self isKernelTest ifTrue: [ ^self ]. self assert: ((self hello ext: 'html') asString = 'hello.html'). self assert: ((self helloV5 ext: 'html') asString = 'hello.5.html'). self assert: ((self fullHello ext: 'html') asString = (self tmp,'hello.html')). ! ----- Method: FileVirtualFSCommonTest>>testFileNameGet (in category 'tests-accessing') ----- testFileNameGet self assert: self hello fileName = 'hello.txt'. self assert: self fullHello fileName = 'hello.txt'. self assert: self helloV5 fileName = 'hello.5.txt'! ----- Method: FileVirtualFSCommonTest>>testFileNameSet (in category 'tests-accessing') ----- testFileNameSet self isKernelTest ifTrue: [ ^self ]. self assert: ((self hello fileName: 'bonjour.text') = 'bonjour.text'). self assert: ((self fullHello fileName: 'bonjour.text') = (self tmp,'bonjour.text')). ! ----- Method: FileVirtualFSCommonTest>>testSplitToBaseVersionAndExt (in category 'tests-accessing') ----- testSplitToBaseVersionAndExt self hello splitToBaseVersionAndExt: [ :b :v :e | self assert: (b = 'hello'). self assert: (v = 0). self assert: (e = 'txt'). ]. self fullHello splitToBaseVersionAndExt: [ :b :v :e | self assert: (b = 'hello'). self assert: (v = 0). self assert: (e = 'txt'). ]. self helloV5 splitToBaseVersionAndExt: [ :b :v :e | self assert: (b = 'hello'). self assert: (v = 5). self assert: (e = 'txt'). ]. self testDotFirst splitToBaseVersionAndExt: [ :b :v :e | self assert: (b = '.dotfirst'). self assert: (v = 0). self assert: (e = ''). ]. self testDotLast splitToBaseVersionAndExt: [ :b :v :e | self assert: (b = 'dotlast.'). self assert: (v = 0). self assert: (e = ''). ].! ----- Method: FileVirtualFSCommonTest>>testVersionGet (in category 'tests-accessing') ----- testVersionGet self isKernelTest ifTrue: [ ^self ]. self assert: (self hello version = 0). self assert: (self fullHello version = 0). self assert: (self helloV5 version = 5).! ----- Method: FileVirtualFSCommonTest>>testVersionSet (in category 'tests-accessing') ----- testVersionSet self isKernelTest ifTrue: [ ^self ]. self assert: ((self hello version: 2) = 'hello.2.txt'). self assert: ((self fullHello version: 3) = (self tmp,'hello.3.txt')). self assert: ((self helloV5 version: 6) = 'hello.6.txt').! FileVirtualFSCommonTest subclass: #FileVirtualFSDosKernelTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'File-Test'! FileVirtualFSDosKernelTest subclass: #FileVirtualFSDosFileTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'File-Test'! ----- Method: FileVirtualFSDosFileTest>>setUp (in category 'fixture') ----- setUp fileClass := File. dirClass := Directory. FileLocalExecutive testFileSystem: FileVirtualTestFSDos new. ! ----- Method: FileVirtualFSDosFileTest>>testLinearRelativeTo (in category 'tests') ----- testLinearRelativeTo file := fileClass new: 'E:\hello\this\is\a\world\apart\from\here.txt'. file := file linearRelativeTo: (fileClass new: 'E:\hello\this'). self assert: (file = 'is\a\world\apart\from\here.txt'). ! ----- Method: FileVirtualFSDosFileTest>>testLinearRelativeToWrongFS (in category 'tests') ----- testLinearRelativeToWrongFS self should: [ (fileClass new: 'E:\hello\here.txt') linearRelativeTo: (theClass new: 'F:\hello')] raise: Error. ! ----- Method: FileVirtualFSDosFileTest>>testMkpathForNonExistentVolume (in category 'tests') ----- testMkpathForNonExistentVolume self flag: #toDo.! ----- Method: FileVirtualFSDosFileTest>>testSplit (in category 'tests') ----- testSplit "self assert: ('/aa/bb/cc' asFile split = #('' 'aa' 'bb' 'cc'))." self assert: ('aa/bb/cc' asFile split = #('aa' 'bb' 'cc')). self assert: ('' asFile split = #()). self assert: ('C:\aa\bb\cc' asFile split = #('C:\' 'aa' 'bb' 'cc')) . self assert: ('aa/bb/cc' asFile full split = #('D:\' 'User' 'Bob' 'Squeak' 'aa' 'bb' 'cc')).! ----- Method: FileVirtualFSDosFileTest>>tmp (in category 'fixture') ----- tmp ^ 'D:\tmp\'! ----- Method: FileVirtualFSDosKernelTest>>fullHello (in category 'fixture') ----- fullHello ^ fileClass new: 'D:\tmp\hello.txt'! ----- Method: FileVirtualFSDosKernelTest>>setUp (in category 'fixture') ----- setUp fileClass := dirClass := FileKernel. FileLocalExecutive testFileSystem: FileVirtualTestFSDos new. ! ----- Method: FileVirtualFSDosKernelTest>>testInstantiateDrive (in category 'tests') ----- testInstantiateDrive "instanciating on drive gives rio on the root directory for that volume" file := fileClass new: 'C:'. self assert: (file = 'C:\'). self assert: (file isRoot).! ----- Method: FileVirtualFSDosKernelTest>>testInstantiateRoot (in category 'tests') ----- testInstantiateRoot file := fileClass new: 'C:\'. self assert: (file = 'C:\'). self assert: (file isRoot).! ----- Method: FileVirtualFSDosKernelTest>>testParent (in category 'tests') ----- testParent "note that the parent of root is the file system 'executive' " self assert: ((fileClass new: 'C:\a\b') parent = 'C:\a'). self assert: ((fileClass new: 'C:\a') parent = 'C:\'). self assert: ((fileClass new: 'C:\') parent class = FileVirtualTestFSDos).! ----- Method: FileVirtualFSDosKernelTest>>testVerifyDefaultDirectory (in category 'tests') ----- testVerifyDefaultDirectory file := self currentFileSystem defaultDirectory. self assert: (file class = dirClass). self assert: file asString = 'D:\User\Bob\Squeak'.! ----- Method: FileVirtualFSDosKernelTest>>thisImage (in category 'tests') ----- thisImage | i | i := fileClass thisImage. self assert: (i = 'D:\User\Bob\Squeak\this.image'). ^ i ! FileVirtualFSCommonTest subclass: #FileVirtualFSUnixKernelTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'File-Test'! FileVirtualFSUnixKernelTest subclass: #FileVirtualFSUnixFileTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'File-Test'! ----- Method: FileVirtualFSUnixFileTest>>linearRelativeTo (in category 'tests') ----- linearRelativeTo rio := (File new: '/hello/this/is/a/world/apart/from/here.txt') linearRelativeTo: (File new: '/hello/this'). self assert: (rio = 'is/a/world/apart/from/here.txt').! ----- Method: FileVirtualFSUnixFileTest>>setUp (in category 'fixture') ----- setUp fileClass := File. dirClass := Directory. FileLocalExecutive testFileSystem: FileVirtualTestFSUnix new. ! ----- Method: FileVirtualFSUnixFileTest>>split (in category 'tests') ----- split self assert: ((fileClass new: '/aa/bb/cc') split = #('/' 'aa' 'bb' 'cc')). self assert: ((fileClass new: 'aa/bb/cc') split = #('aa' 'bb' 'cc')). self assert: ((fileClass new: '') split = #()). ! ----- Method: FileVirtualFSUnixFileTest>>tmp (in category 'fixture') ----- tmp ^ '/tmp/'! ----- Method: FileVirtualFSUnixKernelTest>>fullHello (in category 'fixture') ----- fullHello ^ fileClass new: '/tmp/hello.txt'! ----- Method: FileVirtualFSUnixKernelTest>>instantiateRoot (in category 'tests') ----- instantiateRoot file := fileClass new: '/'. self assert: (file = '/'). self assert: (file isRoot). ! ----- Method: FileVirtualFSUnixKernelTest>>parent (in category 'tests') ----- parent "note that the parent of root is the file system 'executive' " self assert: ((fileClass new: '/a/b') parent = '/a'). self assert: ((fileClass new: '/a') parent = '/'). self assert: ((fileClass new: '/') parent class = FileVirtualTestFSUnix).! ----- Method: FileVirtualFSUnixKernelTest>>root (in category 'tests') ----- root ! ----- Method: FileVirtualFSUnixKernelTest>>setUp (in category 'fixture') ----- setUp fileClass := dirClass := FileKernel. FileLocalExecutive testFileSystem: FileVirtualTestFSUnix new. ! ----- Method: FileVirtualFSUnixKernelTest>>thisImage (in category 'tests') ----- thisImage | i | i := fileClass thisImage. self assert: (i = '/home/user/bob/squeak/this.image'). ^ i ! ----- Method: FileVirtualFSUnixKernelTest>>verifyDefaultDirectory (in category 'tests') ----- verifyDefaultDirectory file := self currentFileSystem defaultDirectory. self assert: (file class = dirClass). self assert: file asString = '/home/user/bob/squeak'.!

1 0

Rio: File-Debug-kph.1.mcz
by squeak-dev-noreply＠lists.squeakfoundation.org 13 Nov '08

13 Nov '08

A new version of File-Debug was added to project Rio: http://www.squeaksource.com/Rio/File-Debug-kph.1.mcz ==================== Summary ==================== Name: File-Debug-kph.1 Author: kph Time: 13 November 2008, 2:19:30 am UUID: b92ead52-6b95-41e1-9146-68f52106ff73 Ancestors: First release of File version of Rio ==================== Snapshot ==================== SystemOrganization addCategory: #'File-Debug'! FTPClient subclass: #FTPClientDebug instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'File-Debug'! ----- Method: FTPClientDebug>>checkResponse:onError:onWarning: (in category 'as yet unclassified') ----- checkResponse: aResponse onError: errorBlock onWarning: warningBlock "Get the response from the server and check for errors. Invoke one of the blocks if an error or warning is encountered. See class comment for classification of error codes." self responseIsError ifTrue: [ Transcript show: aResponse; cr. errorBlock value: aResponse]. self responseIsWarning ifTrue: [ Transcript show: aResponse; cr. warningBlock value: aResponse]. ! ----- Method: FTPClientDebug>>fetchPendingResponse (in category 'as yet unclassified') ----- fetchPendingResponse | r | r := super fetchPendingResponse. Transcript show: self lastResponse ; cr. ^ r! ----- Method: FTPClientDebug>>sendCommand: (in category 'as yet unclassified') ----- sendCommand: aString Transcript show: aString; space. super sendCommand: aString!

1 0

Rio: File-Base-kph.1.mcz
by squeak-dev-noreply＠lists.squeakfoundation.org 13 Nov '08

13 Nov '08

A new version of File-Base was added to project Rio: http://www.squeaksource.com/Rio/File-Base-kph.1.mcz ==================== Summary ==================== Name: File-Base-kph.1 Author: kph Time: 13 November 2008, 2:19:12 am UUID: 9bc2621c-c6b8-4507-bd65-9f007b8f77b4 Ancestors: First release of File version of Rio ==================== Snapshot ==================== SystemOrganization addCategory: #'File-Base'! ----- Method: InflateStream>>on: (in category '*file-base-override') ----- on: aCollectionOrStream aCollectionOrStream isStream ifTrue:[ aCollectionOrStream isBinary ifFalse: [ collection := String new ]. aCollectionOrStream binary. sourceStream := aCollectionOrStream. self getFirstBuffer] ifFalse:[source := aCollectionOrStream]. ^self on: source from: 1 to: source size.! ----- Method: InflateStream>>on:from:to: (in category '*file-base-override') ----- on: aCollection from: firstIndex to: lastIndex bitBuf := bitPos := 0. "The decompression buffer has a size of at 64k, since we may have distances up to 32k back and repetitions of at most 32k length forward" collection := (collection ifNil: [ aCollection ]) species new: 1 << 16. readLimit := 0. "Not yet initialized" position := 0. source := aCollection. sourceLimit := lastIndex. sourcePos := firstIndex-1. state := StateNewBlock.! ----- Method: ZipWriteStream>>close (in category '*file-base-override') ----- close self deflateBlock. self flushBlock: true. ^encoder close.! FileKernel subclass: #File instanceVariableNames: 'recursive rename adaptor binary' classVariableNames: '' poolDictionaries: '' category: 'File-Base'! !File commentStamp: 'test 11/6/2008 00:05' prior: 0! Thinking out loud: Rio is an experimental version of ruby's rio in smalltalk, so as to compare with other approaches such as Fileman. Rio is implemented on RioKernel, rather than as a utility layer on top of FileDirectory, the intention being to do away with FileDirectory!! I am wondering whether a lot of what happens in FileDirectory is absolutely necessary. So Rather than cover every eventuality, such as handling encodings of path strings (which is broken in most vms anyway) lets just try it without and see how far we get. We use tests to encapsulate what does work, and tests will highlight were we need an advance in architecture. For example for every basic example that I could think of '<example>' asVmPathString returns the same string as the original. Obviously it's not about basic examples. So our use of a string-like class to store the path we are using should be agnostic to the implementation of string/encoding used. We can sort this out later if necessary in the interface to primitives. In contrast to other approaches we define $/ as the standard delimieter for use within Squeak, translating for the underlying filesystem as needed. One reason for this being that Rio commonly uses $/ to assemble paths for readbility, and it doesnt really make sense to build $: delimited path with $/. The #executive covers the interaction with the actual file system, and there is an executive for file systems with case insensitive filnames. #rmdir does check for existence of the directory first (an improvement on legacy already!!) #select: turns out to implement most of the guts of the fs Rio. It provides the basis for even the simpleset #stat and complex queries such as "files older than" via the stat record that is passed to the userBlock. A beRecursive mode applies to all uses of #select: By convention a mode change instanciates a fresh Rio instance. This treats existing instances as immutable. Mode changes are also intended to be temporary so that copying a new rio from this rio does not copy the recursive setting. (this may change). A number of stats such as Rio>>#fileSize go via Rio>>#stat which searches for me in my parents directory!! This strikes me as a roundabout way of doing things. For multiple testing such as all the files newer than, #select: provides a much more efficient interface. Stat results are cached, and the cache is shared by all Rios pointing to that file. The cache may be refreshed for all users via #restat, and may be invalidated via #statIsNoLongerValid Given that a cached stat contains the fileName and the parent directory rio, this can be used to get quicker cached answers to #parent and #name without splitting the ipath every time. cwd is now available as a Class, enabling the readable form: Cwd / 'hello.txt' in code Cool Null support for the following has been removed. myFile := myFileRio ifFile reading. newRio := myFileRio ifFile renameTo: 'newname'. Rather than have #renameTo:overwriting: the following does the same job just as concisely. oldRio renameTo: (newRio delete). oldRio renameTo: (newRio forceNewFile). is equivalent also. Pondering whether to have a quiet, error suppressing mode, but perhaps that is what error handlers are for. Ruby Rio has the ability to tell the rio what the expected extension is, which it then takes into account when calculating the #basename then takes into account. So there is an #ext and an #extname, which gets kind of confusing. So if we simply define basename as the #fileName upto the last $., and the ext as the rest that should be enough. Implementing #delete. '\' asRio deleteTree may not be a good idea!! Do we need a guard. Ok, lets set it so that #delete wil do the job of deleteTree if the recursive flag is set. usage: aRio all rmdir - makes sense usage: aRio rmdir - makes sense if dir is empty. Function of 'force'NewFileNamed: is now handled by fileStream := aRio delete writer. fileStream := aRio forceNewFile writer. And the block case, instead of implementing three methods. aRio readUsing: [ :str | ]. aRio appendUsing: [ :str | ]. myRio := aRio delete write use: [ :str | str, 'hello'; cr ]. we use #use: which unlike #in: ensures the stream is closed for us aRio writer use: [ :str | ]. aRio writer use: [ :str | ]. FileStream #close to return the stream's rio (none of the existing senders of #close use the return value) this allows continuing with the rio after the cascade, or using the result in assigment. (myRio writer << 'a bit' << 'abit more') close isFile ifTrue: [ 'it s a file' ] myRio := ('test' asRio writer << 'a bit' << 'a bit more') close. myRio := 'test' asRio writer: [ :w | w,'hello';cr ]. myRio read contents. Rio is split into Rio and RioKernel, the latter being the minimal useful implementation for the KernelImage. Defined #reader: and #writer: to take a block. instead of aRio reader use: [ :str | ], you can write aRio reader: [ :inStream | ... ]. instead of aRio writer use: [ :str | ], you can write aRio writer: [ :outStream | ... ]. #appender: is also available and is equivalent to writer: [ :out | out setToAppend. out ... ]. aStream copyTo: bStream has been implemented to be a reusable bit of code, since the same basic pattern seems to be used all over the place in slightly different forms. So now, Rio-#compress, is simply a Rio set to binary mode copied using the generic stream copy to a Rio set with a gzip adaptor. I have moved Rio-compress to be implemented by the adaptor, this will allow different compression schemes to be supported. e.g. (Rio new: 'myFile.txt') gzip compress. Is handled by the GZip adaptor, there could be others. So how to do copying multiple files to a directory or archive: aDirectory copyTo: bDirectory. Could be done as aDirectory entries copyTo: bDirectory, but we havent got any methods on OrderedCollection to do that with, so it would have to be. bDirectory copyFrom: aDirectory all entries. That doesnt read correctly and it looks like you might be overwriting bDirectory. I think that "bDirectory addAll: aDirectory all entries" is fairly unambiguous. aFile copyTo: bDirectory makes sense but rather than overload #copyTo: with multiple behavours , lets keep it file to file only, and use bDirectory add: aFile as an equally unambigous version. To be useful when adding a tree of directory and files we need to know the base directory we are starting from, and all of the files as relative paths to that pase directory. The implementation of simpleRelativeTo: is brilliantly simple especially compared to the methods used in Archive-addTree: etc. The result is a quite simple and versatile, 1. aDirectory add: aFile , 2. aDirectory addAll: acollection - e.g. aDirectory addAll: (myOutput all filesMatching: #('*.image' '*.changes') ). 3. aDirectory addTree: aDirectory (and all of its contents). 4. The generic version of addTree: which can be used with a hand crafted collection of files, missing directories are created. aDirectory addAll: aCollection fromBase: aDirectory Moving the above Directory interface into an adaptor RioAdaptorDir, enabled this to be pluggable with other back ends, i.e. Archives which use the same interface. RioAdaptorArchive is a subclass of RioAdaptorDir, and it handles both Zip and Tar archive (tar not yet supported). Implemented and tested Win32 implementation, modelling Dos file Volumes as separate executives. Created a comprehensive platform independent test framework is needed to be able to verify all platform scenarious. Lazy initialialization of executive or not? Changed to not, on the basis that it is easier to debug if exploring a rio if you can see what the executive actually is rather than a nil. RioFtpFileSystem executive depends upon MCPasswordManager to look after passwords. ! File subclass: #Directory instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'File-Base'! !Directory commentStamp: 'kph 4/12/2007 07:44' prior: 0! Could mode mkdir and mkpath into this adaptor.! Directory subclass: #Cwd instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'File-Base'! ----- Method: Cwd class>>new: (in category 'public instanciation') ----- new: pathOrFile ^ Directory new: pathOrFile! ----- Method: Cwd>>newFrom: (in category 'as yet unclassified') ----- newFrom: pathOrFile ^ File executive: executive value: pathOrFile! ----- Method: Cwd>>printOn: (in category 'as yet unclassified') ----- printOn: str str , '(', self class name, ' new)' ! ----- Method: Cwd>>split (in category 'as yet unclassified') ----- split ^ Array new! ----- Method: Directory>>/ (in category 'directory/container actions') ----- / morePath ^ self newFrom: (self pathJoin: morePath)! ----- Method: Directory>>add: (in category 'directory/container actions') ----- add: aFile self validateIsDirectory. aFile validateIsFile. ^ aFile copyTo: self / aFile fileName ! ----- Method: Directory>>add:fromBase: (in category 'directory/container actions') ----- add: aFileOrDir fromBase: aBaseDirectory "I am a directory, add the file or create directory using aBaseDirectory as the base reference." | newRio | self validateIsDirectory. newRio := self / (aFileOrDir linearRelativeTo: aBaseDirectory). aFileOrDir isFile ifTrue: [ newRio parent ifAbsentDo: [ :newPath | newPath mkpath ]. ^ aFileOrDir copyTo: newRio ]. aFileOrDir isDirectory ifTrue: [ ^ newRio mkpath ]. ! ----- Method: Directory>>addAll: (in category 'directory/container actions') ----- addAll: aCollectionOfFiles aCollectionOfFiles do: [ :each | self add: each ]! ----- Method: Directory>>addAll:fromBase: (in category 'directory/container actions') ----- addAll: aCollection fromBase: aDirectory aCollection do: [ :each | self add: each fromBase: aDirectory ]! ----- Method: Directory>>addTree: (in category 'directory/container actions') ----- addTree: aDir | base newAddition | self validateIsContainer. aDir validateIsDirectory. newAddition := self add: aDir fromBase: (base := aDir parent). self addAll: (aDir all entries) fromBase: base. ^ newAddition ! ----- Method: Directory>>commit (in category 'directory/container actions') ----- commit ! ----- Method: Directory>>commit: (in category 'directory/container actions') ----- commit: monadicBlock monadicBlock value; self. self commit.! ----- Method: Directory>>validateIsContainer (in category 'directory/container actions') ----- validateIsContainer self validateIsDirectory ! Directory subclass: #FileArchive instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'File-Base'! ----- Method: FileArchive class>>on: (in category 'as yet unclassified') ----- on: aRio ^ self executive: (FileArchiveExecutive file: aRio) value: ''.! ----- Method: FileArchive>>add: (in category 'public') ----- add: aFile self validateIsContainer. aFile validateIsFile. self archive addFile: aFile full asString as: aFile fileName. ! ----- Method: FileArchive>>add:fromBase: (in category 'public') ----- add: aFileOrDir fromBase: aBaseDirectory "I am an archive, add the file or create directory using aBaseDirectory as the base reference." | localFileName | self validateIsContainer. localFileName := aFileOrDir linearRelativeTo: aBaseDirectory. aFileOrDir isFile ifTrue: [ self archive addFile: aFileOrDir value as: localFileName value. ]. aFileOrDir isDirectory ifTrue: [ self archive addDirectory: aFileOrDir value as: localFileName value. ]. ! ----- Method: FileArchive>>archive (in category 'accessing') ----- archive ^ executive archive! ----- Method: FileArchive>>comment: (in category 'public') ----- comment: aComment self archive zipFileComment: aComment! ----- Method: FileArchive>>commit (in category 'public') ----- commit "Catch attempts to overwrite existing zip file" (self archive canWriteToFileNamed: self asString) ifFalse: [ ^ self error: 'a member of this archive is using this file: ', self ]. self writer: [ :stream | self archive writeTo: stream. ].! ----- Method: FileArchive>>file (in category 'public') ----- file ^ executive file ! ----- Method: FileArchive>>setArchive: (in category 'accessing') ----- setArchive: anArchiveManager executive setArchive: anArchiveManager. ! ----- Method: FileArchive>>setRio: (in category 'accessing') ----- setRio: aFile super setRio: aFile. aFile executive: (FileArchiveExecutive file: aFile copy). aFile value: ''. "aFile executive root value."! ----- Method: FileArchive>>validExtensions (in category 'validation') ----- validExtensions ^ #('zip' 'mcz')! ----- Method: FileArchive>>validateIsContainer (in category 'validation') ----- validateIsContainer (self validExtensions includes: self file ext) ifFalse: [ ^self error: 'wrong extension for a zip archive' ]. ! ----- Method: FileArchive>>writeStream (in category 'public') ----- writeStream ^ self file writeStream! ----- Method: File class>>/ (in category 'as yet unclassified') ----- / a ^ Directory new: a ! ----- Method: File class>>canInstanciate: (in category 'as yet unclassified') ----- canInstanciate: any "we return false, because we do not support any specific protocol" ^ false! ----- Method: File class>>examples (in category 'documentation') ----- examples " (Rio new: '/usr/local') directories explore. recursive mode can be used very naturally. (Rio new: '/usr/local') all directories explore. (Rio new: '/usr/local') all files explore. (Rio new: '/usr/local') all select: [ :e | e modificationTime > ('1-1-05' asDate) ]. "! ----- Method: File class>>extensions (in category 'documentation') ----- extensions " StandardFileStream-#retryWithGC: execBlock until: testBlock forFileNamed: fullName trivial change allows fullName to be passed in as a rio, since the rio handles the equivalent of String-sameAs:. However rio's implementation of sameAs: can be adjusted according to the platform. _ Object-#isRio for testing _ String-#asRio for coercion _ FileStream close now returns the file i.e. the Rio that opened it. Stream in: [ :str | ] now includes an ensure close block, and returns the return value of that close. _ FileDirectory-#fullNameFor: adding asString allows a Rio to be passed in to many FileDirectory functions. "! ----- Method: File class>>instantiation (in category 'documentation') ----- instantiation " Rio has an instanciation scheme which provides many dimensions for specialisation, dividing responsibilities logically among the components involved. A path string can specify a specialised protocol which refers to a particular domain e.g. ftp remote host. The domain executive may in turn choose which class to represent the elements which it manages. The elements perform all primitive manipulations via the domain executive. Typical Instanciation Route: <aPathString> asRio. - gives an instance of Rio, via Rio new: aPathOrARio Rio #new: traverses its subclasses asking if any #canInstanciate: so as to allow specific subclasses to handle protocols, or any other encoded-in-path-string specialisations. As a fallback Rio handles the default case. The elected class, is sent #new in order to create an empty instance, which will be populated #from: <aPathString> The default behaviour of #new is to ask the #defaultExecutive, 'LocalFileSystemCurrent' to instanciate an instance that implements the appropriate behaviour for that domain via: #makeNewRioOfClass: <theClass>, the default be being <theClass>-#basicNew. "! ----- Method: File class>>lookInUsualPlacesFor: (in category 'as yet unclassified') ----- lookInUsualPlacesFor: fileName "Check the default directory, the imagePath, and the vmPath (and the vmPath's owner) for this file." ^({ File default. (File thisImage parent). (File new: SmalltalkImage current vmPath ). (File new: SmalltalkImage current vmPath ) parent. } collect: [ :dir | dir / fileName ]) detect: [ :file | file isFile ] ifNone: nil " self lookInUsualPlacesFor: 'SqueakV39.sources' " " self lookInUsualPlacesForB: '391.2.changes' "! ----- Method: File class>>mkTmpDir (in category 'as yet unclassified') ----- mkTmpDir ^ (self defaultExecutive getTempDirectory / DateAndTime now asString) mkdir! ----- Method: File class>>rioModesRenaming (in category 'documentation') ----- rioModesRenaming " !!Renaming Mode: When in renaming mode changes to the Rio filename are reflected in the filesystem. This allows rio to reuse all of its full featured filename accessors, for both renaming the Rio and also renaming files on disk. As with all modes, there is a persistent and a temporary form. persistent form: #setModeToRenaming, sets the current rio to renaming. temporary form: #rename, yields a new rio in renaming mode. "! ----- Method: File class>>rioStreams (in category 'documentation') ----- rioStreams " Using streams from a Rio rio := Rio new: 'myFile.txt'. contents := rio reader contents. - doesnt close the stream rio stream close. " ! ----- Method: File class>>setToEnd (in category 'as yet unclassified') ----- setToEnd! ----- Method: File class>>temporaryDirectory (in category 'as yet unclassified') ----- temporaryDirectory ^ self defaultExecutive getTempDirectory ! ----- Method: File class>>thisVm (in category 'as yet unclassified') ----- thisVm ^ self new: (self defaultExecutive primVmPath)! ----- Method: File class>>untrustedDirectory (in category 'as yet unclassified') ----- untrustedDirectory ^ self new: (SecurityManager default primUntrustedUserDirectory) ! ----- Method: File>>+ (in category 'public path') ----- + ext ^ self newFrom: (self value, ext)! ----- Method: File>>, (in category 'public file') ----- , aString "concat as a string" ^ self asString , aString ! ----- Method: File>>/ (in category 'public path') ----- / morePath ^ self error: 'This is a file not a directory'! ----- Method: File>><= (in category 'public file') ----- <= aRioOrString ^ self asString <= aRioOrString asString! ----- Method: File>>all (in category 'public modes') ----- all ^ self copy beRecursive! ----- Method: File>>append: (in category 'public file') ----- append: aStreamAble "aStreamable refers to implementers of << and hence putOn: And so would write out an array of strings" self writer: [ :out | out setToAppend << aStreamAble ] ! ----- Method: File>>appender: (in category 'public file') ----- appender: block self writer setToAppend use: block ! ----- Method: File>>archive (in category 'public modes') ----- archive ^ self zip! ----- Method: File>>asDirectory (in category 'public modes') ----- asDirectory ^ Directory newFrom: self! ----- Method: File>>asTask (in category 'public modes') ----- asTask ^ (Smalltalk at: #SakeTask) file: self! ----- Method: File>>auto (in category 'public modes') ----- auto self ext = 'gz' ifTrue: [ ^ self gzip ]. ^ self copy! ----- Method: File>>base (in category 'accessing fileName') ----- base ^ self splitToBaseVersionAndExt: [ :b :v :e | b ]! ----- Method: File>>base: (in category 'accessing fileName') ----- base: newName self base: newName version: nil ext: nil ! ----- Method: File>>basic (in category 'public modes') ----- basic ^ File newFrom: self! ----- Method: File>>basicWriter (in category 'public file') ----- basicWriter self statIsNowInvalid. ^ super basicWriter ! ----- Method: File>>beBinary (in category 'public modes') ----- beBinary binary := true! ----- Method: File>>beRecursive (in category 'public modes') ----- beRecursive recursive := true! ----- Method: File>>beRenaming (in category 'public modes') ----- beRenaming rename := true! ----- Method: File>>binary (in category 'public modes') ----- binary ^ self copy beBinary ! ----- Method: File>>cTime (in category 'accessing stat') ----- cTime ^self stat cTime! ----- Method: File>>contents (in category 'public file') ----- contents self reader: [ :str | ^ str upToEnd ]. ^ nil! ----- Method: File>>contents: (in category 'public file') ----- contents: aStreamAble "aStreamable refers to implementers of << and hence putOn: And so would write out an array of strings" self writer: [ :out | out << aStreamAble ].! ----- Method: File>>copyDescription (in category 'public file') ----- copyDescription ^ adaptor ifNil: [ 'Copying' ] ifNotNil: [ adaptor copyDescription ] ! ----- Method: File>>copyResultDescription (in category 'public file') ----- copyResultDescription ^ adaptor ifNil: [ '' ] ifNotNil: [ adaptor copyResultDescription ] ! ----- Method: File>>copyTo: (in category 'public file') ----- copyTo: aPathOrFile | outFile size | "we do a stat here, so that we have the fileSize". size := self fileSize. ^ (outFile := aPathOrFile asFile isBinary: self isBinary) writer: [ :out | self reader: [ :in | in copyTo: out size: size withProgress: (self copyDescription, ' ', self asString, ' ', outFile copyResultDescription) ]. ]. ! ----- Method: File>>creationTime (in category 'accessing stat') ----- creationTime ^self stat creationTime! ----- Method: File>>delete (in category 'public file') ----- delete executive delete: self! ----- Method: File>>directories (in category 'enumeration') ----- directories ^ self select: [:e | e isDirectory ]! ----- Method: File>>ext (in category 'accessing fileName') ----- ext ^ self splitToBaseVersionAndExt: [ :b :v :e | e ]! ----- Method: File>>ext: (in category 'accessing fileName') ----- ext: newExt self base: nil version: nil ext: newExt! ----- Method: File>>fileName: (in category 'accessing fileName') ----- fileName: newFileName self renamingWith: [ super fileName: newFileName ].! ----- Method: File>>fileSize (in category 'accessing stat') ----- fileSize ^ executive fileSize: self! ----- Method: File>>files (in category 'enumeration') ----- files ^ self select: [:e | e isFile ]! ----- Method: File>>filesMatching: (in category 'enumeration') ----- filesMatching: aos | matchStringsArray | matchStringsArray := aos isString ifTrue: [ Array with: aos ] ifFalse: [ aos ]. ^ self select: [:e | e isFile and: [ matchStringsArray anySatisfy: [ :m | m match: e name] ] ] ! ----- Method: File>>forceNewFile (in category 'public file') ----- forceNewFile self parent mkpath. ^ self delete! ----- Method: File>>from: (in category 'copying instanciation') ----- from: pathOrRio (pathOrRio isEmpty and: [ self class name ~= #Cwd ]) ifTrue: [ value := '']. (pathOrRio isKindOf: FileKernel) ifTrue: [ self setStat: pathOrRio getStat. pathOrRio isBinary ifTrue: [ self beBinary ]. ]. ^ self value: pathOrRio! ----- Method: File>>full: (in category 'public path') ----- full: aPathOrFile ^ self withRenaming: [ value := executive importPath: (aPathOrFile asFile linearRelativeTo: executive DefaultDirectory) asString. ] ! ----- Method: File>>getStat (in category 'private') ----- getStat ^ stat! ----- Method: File>>gzip (in category 'public modes') ----- gzip ^ FileGzip newFrom: self! ----- Method: File>>ifAbsentDo: (in category 'testing') ----- ifAbsentDo: aBlock ^ self exists not ifTrue: [ aBlock value: self ] ifFalse: [ self ]! ----- Method: File>>ifDirectoryDo: (in category 'testing') ----- ifDirectoryDo: aBlock ^ self isDirectory ifTrue: [ aBlock value: self ] ifFalse: [ self ]! ----- Method: File>>ifFileDo: (in category 'testing') ----- ifFileDo: aBlock ^ self isFile ifTrue: [ aBlock value: self ] ifFalse: [ self ]! ----- Method: File>>initialize (in category 'copying instanciation') ----- initialize value := ''. recursive := false.! ----- Method: File>>isBinary (in category 'accessing') ----- isBinary ^ binary ifNil: [ false ]! ----- Method: File>>isBinary: (in category 'accessing') ----- isBinary: bool binary := bool! ----- Method: File>>isRecursive (in category 'testing') ----- isRecursive ^ recursive! ----- Method: File>>isRenaming (in category 'testing') ----- isRenaming ^ rename == true! ----- Method: File>>linearRelativeTo: (in category 'public dir') ----- linearRelativeTo: aDirectoryOrFile | tmp | self = aDirectoryOrFile full ifTrue: [ ^ Directory new: '' ]. tmp := (self parent linearRelativeTo: aDirectoryOrFile) / self fileName. ^tmp ! ----- Method: File>>mTime (in category 'accessing stat') ----- mTime ^ self stat mTime! ----- Method: File>>mkdir (in category 'public dir') ----- mkdir "to avoid failing if already present, use: myFileRio ifAbsent mkdir" executive mkdir: self! ----- Method: File>>mkpath (in category 'public dir') ----- mkpath "this is like assureExistence" executive mkpath: self! ----- Method: File>>modificationTime (in category 'accessing stat') ----- modificationTime ^ self stat modificationTime! ----- Method: File>>name (in category 'accessing fileName') ----- name ^ self fileName! ----- Method: File>>os (in category 'public modes') ----- os ^ RioOSProcess new: self! ----- Method: File>>parent (in category 'public path') ----- parent ^ stat ifNotNil: [ stat dir ] ifNil: [ super parent ]! ----- Method: File>>parent: (in category 'public path') ----- parent: aPathOrRio ^ self full: ((self newFrom: aPathOrRio) / self fileName)! ----- Method: File>>readForm (in category 'adaptor') ----- readForm ^ ImageReadWriter formFromFileNamed: self asString ! ----- Method: File>>readStream (in category 'adaptor') ----- readStream | reader | reader := self basicReader ifNil: [ ^ nil ]. self isBinary ifTrue: [ reader binary ]. ^ reader! ----- Method: File>>reader (in category 'public file') ----- reader ^ self readStream! ----- Method: File>>reader: (in category 'public file') ----- reader: block self reader use: block! ----- Method: File>>recursively (in category 'public modes') ----- recursively ^ self copy beRecursive! ----- Method: File>>relativeTo: (in category 'public file') ----- relativeTo: aPathOrDirectory | source dest relativePath | dest := self full split. source := aPathOrDirectory asDirectory full split. [ (dest at:1 ifAbsent: true) = (source at:1 ifAbsent: false) ] whileTrue: [ dest := dest copyWithoutFirst. source := source copyWithoutFirst. ]. relativePath := String streamContents: [ :out | . source size timesRepeat: [ out nextPutAll: '../' ]. dest withIndexDo: [ :each :n | out nextPutAll: each. n = dest size ifFalse: [ out nextPut: $/ ] ]. ]. ^ self newFrom: relativePath ! ----- Method: File>>rename (in category 'public modes') ----- rename ^ self copy beRenaming ! ----- Method: File>>renameTo: (in category 'public file') ----- renameTo: rioable ^ executive rename: self to: rioable asFile! ----- Method: File>>renamingWith: (in category 'private') ----- renamingWith: aBlock ^ self isRenaming ifTrue: [ self copy renameTo: aBlock value ] ifFalse: [ aBlock value ] ! ----- Method: File>>restat (in category 'accessing') ----- restat "when we restat, we populate the existing stat instance, because more than one rio may be sharing it" | full | full := self full. full parent select: [ :e | e = full ifTrue: [ ^ stat copyFrom: e stat. ]. false. ]. ^ stat := nil. " (Rio new: '') myEntry. (Rio new: 'SqueakDebug.log') myEntry "! ----- Method: File>>rmdir (in category 'public dir') ----- rmdir "as a minor saftey precaution, the directory must be empty or we must be explicitly set in recursive mode (rmdir resets recursive mode). " self isDirectory ifFalse: [ ^self ]. self isRecursive ifTrue: [ recursive := false. self entries do: [:d | d beRecursive delete ] ]. executive deleteDirectory: self ! ----- Method: File>>setExecutive:value: (in category 'copying instanciation') ----- setExecutive: e value: pathOrRio super setExecutive: e value: pathOrRio. recursive := false ! ----- Method: File>>setFileTypeToObject (in category 'mac file types') ----- setFileTypeToObject "On the Macintosh, set the file type and creator of this file to be a Squeak object file. On other platforms, do nothing. Setting the file type allows Squeak object files to be sent as email attachments and launched by double-clicking. On other platforms, similar behavior is achieved by creating the file with the '.sqo' file name extension." self setMacType: 'SOBJ' creator: 'FAST'. ! ----- Method: File>>setFileTypeToSqueak (in category 'mac file types') ----- setFileTypeToSqueak self setMacType: 'STch' creator: 'FAST'. ! ----- Method: File>>setStat: (in category 'private') ----- setStat: s stat := s! ----- Method: File>>split (in category 'public modes') ----- split | parent | self value isEmpty ifTrue: [ ^ Array new ]. self splitToPathAndName: [ :p :n | parent := self newFrom: p. (parent = self) ifTrue: [ ^ Array with: self value ]. ^ parent split copyWith: n ] ! ----- Method: File>>statIsNowInvalid (in category 'accessing') ----- statIsNowInvalid "All rios copyied from this one, share a stat instance if it exists. Invalidating that instance means that this and all such derived rios, will refresh their stat when needed." stat ifNotNil: [ stat invalidate ]. ! ----- Method: File>>tar (in category 'public modes') ----- tar ^ (RioArchive on: self) setArchive: TarArchive new; yourself! ----- Method: File>>touch (in category 'public file') ----- touch executive touch: self! ----- Method: File>>version (in category 'accessing fileName') ----- version ^ self splitToBaseVersionAndExt: [ :b :v :e | v ]! ----- Method: File>>version: (in category 'accessing fileName') ----- version: newVersion self base: nil version: newVersion ext: nil ! ----- Method: File>>writeStream (in category 'adaptor') ----- writeStream | writer | writer := self basicWriter ifNil: [ ^ nil ]. self isBinary ifTrue: [ writer binary ]. ^ writer! ----- Method: File>>writer (in category 'public file') ----- writer ^ self writeStream! ----- Method: File>>writer: (in category 'public file') ----- writer: block self writer use: block ! ----- Method: File>>zip (in category 'public modes') ----- zip ^ (FileArchive on: self) setArchive: ZipArchive new; yourself! File subclass: #FileGzip instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'File-Base'! !FileGzip commentStamp: 'kph 3/16/2007 08:06' prior: 0! In using gzip rio expects that if you write text to the file you should read text from the file. The 3.9 implemementation of InflateStream blindly sets the readStream to binary. Although its output buffer is created using #species new: in an attempt to make the output in the correct form in practice this would always result in a ByteArray. A small fix to InflateStream #on:, checks the #binary setting before is is 'blindly set' and initializes the output collection to be a String is it is not binary. In #on:from:to: the collection is initialized to be a buffer being the same species as itself if set in #on: ! ----- Method: FileGzip class>>validExtensions (in category 'as yet unclassified') ----- validExtensions ^ #( 'gz' )! ----- Method: FileGzip>>basicReader (in category 'streams') ----- basicReader self validateIsFile. ^ GZipReadStream on: (super basicReader).! ----- Method: FileGzip>>compress (in category 'streams') ----- compress ^ self binary basic copyTo: (self + '.gz') gzip. ! ----- Method: FileGzip>>copyDescription (in category 'streams') ----- copyDescription ^ 'Decompressing'! ----- Method: FileGzip>>copyResultDescription (in category 'streams') ----- copyResultDescription ^ 'Compressed with gzip'! ----- Method: FileGzip>>decompress (in category 'streams') ----- decompress ^ self copyTo: ((File new: self asString) ext: '') ! ----- Method: FileGzip>>readStream (in category 'streams') ----- readStream | str | self validateGzip. str := super basicReader. self isBinary ifTrue: [ str binary ]. ^ self readerClass on: str. ! ----- Method: FileGzip>>readerClass (in category 'streams') ----- readerClass ^ GZipReadStream ! ----- Method: FileGzip>>validExtensions (in category 'streams') ----- validExtensions ^ #( 'gz' )! ----- Method: FileGzip>>validateGzip (in category 'validation & errors') ----- validateGzip (self validExtensions includes: self ext) ifFalse: [ ^self error: 'wrong extension for a gzip file' ]. ! ----- Method: FileGzip>>writeStream (in category 'streams') ----- writeStream | str | self validateGzip. str := self writerClass on: (super writeStream ifNil: [ ^ nil ]). self setFileTypeToObject. ^ str! ----- Method: FileGzip>>writerClass (in category 'streams') ----- writerClass ^ GZipWriteStream ! ----- Method: ZipEncoder>>close (in category '*file-base-override') ----- close self flush. ^encodedStream close.! ----- Method: FTPClient>>getFileSize: (in category '*file-base') ----- getFileSize: fileName self sendCommand: 'SIZE ' , fileName. self checkResponse. ^ (self lastResponse readStream upTo: $ ; upToEnd) asNumber! ----- Method: Stream>>use: (in category '*file-base') ----- use: aBlock "just like #in: except the stream will be closed" | ret | [ ret := aBlock value: self] ensure: [ self close]. ^ ret ! ----- Method: UndefinedObject>>use: (in category '*file-base') ----- use: aBlock "ifNil the block is entirely passed over" ^ self! ----- Method: GZipReadStream class>>saveContents: (in category '*file-base-override') ----- saveContents: fullFileName "Save the contents of a gzipped file" | zipped buffer unzipped newName | newName := fullFileName copyUpToLast: FileDirectory extensionDelimiter. unzipped := FileStream newFileNamed: newName. unzipped binary. zipped := GZipReadStream on: (FileStream readOnlyFileNamed: fullFileName) binary. buffer := ByteArray new: 50000. 'Extracting ' , fullFileName displayProgressAt: Sensor cursorPoint from: 0 to: zipped sourceStream size during: [:bar | [zipped atEnd] whileFalse: [bar value: zipped sourceStream position. unzipped nextPutAll: (zipped nextInto: buffer)]. zipped close. unzipped close]. ^ newName! FileLocalExecutive subclass: #FileArchiveExecutive instanceVariableNames: 'file archive members' classVariableNames: '' poolDictionaries: '' category: 'File-Base'! ----- Method: FileArchiveExecutive class>>file: (in category 'as yet unclassified') ----- file: aRio ^ (self new) setFile: aRio; yourself! ----- Method: FileArchiveExecutive>>archive (in category 'as yet unclassified') ----- archive ^ archive! ----- Method: FileArchiveExecutive>>file (in category 'as yet unclassified') ----- file ^ file ! ----- Method: FileArchiveExecutive>>fullFor: (in category 'as yet unclassified') ----- fullFor: aRio ^ aRio ! ----- Method: FileArchiveExecutive>>isDirectory: (in category 'as yet unclassified') ----- isDirectory: aRio | dir | dir := aRio value, '/'. ^ (archive members detect: [ :member | dir = member fileName ] ifNone: [ ^false ]) isDirectory! ----- Method: FileArchiveExecutive>>isFile: (in category 'as yet unclassified') ----- isFile: aRio ^ (self isDirectory: aRio) not! ----- Method: FileArchiveExecutive>>members (in category 'as yet unclassified') ----- members ^ members ifNil: [ file reader: [ :str | archive readFrom: str ]. members := archive members. ]! ----- Method: FileArchiveExecutive>>printId (in category 'as yet unclassified') ----- printId ^ self file asString! ----- Method: FileArchiveExecutive>>root (in category 'as yet unclassified') ----- root ^ self pathDelimiter ! ----- Method: FileArchiveExecutive>>setArchive: (in category 'as yet unclassified') ----- setArchive: anArchive archive := anArchive ! ----- Method: FileArchiveExecutive>>setFile: (in category 'as yet unclassified') ----- setFile: aRio file := aRio! ----- Method: FileArchiveExecutive>>startAt:recursively:select:into: (in category 'as yet unclassified') ----- startAt: rioOrString recursively: beRecursive select: selectBlock into: results "this unpleasent method repackages the flat archive as a hierarchical structure that can be recursively traversed like a normal directory." | membersBelow subDirs dir | membersBelow := self members. rioOrString isEmpty ifTrue: [ dir := ''. ] ifFalse: [ dir := rioOrString value. dir last ~= $/ ifTrue: [ dir := dir , '/' ]. membersBelow := membersBelow select: [ :member | (member fileName ~= dir) and: [member fileName beginsWith: dir] ]. ]. subDirs := membersBelow select: [ :member | | pathBelow entry | pathBelow := member fileName allButFirst: dir size. pathBelow last = $/ ifTrue: [ pathBelow := pathBelow allButLast ]. (pathBelow includes: $/) ifFalse: [ entry := member isDirectory ifTrue: [ self class makeNew: self class dirClass from: member fileName ] ifFalse: [ self class makeNew: self class fileClass from: member fileName ]. entry setStatFromDir: rioOrString andEntryArray: (Array with: pathBelow with: "member lastModTime" 0 with: "member lastModTime" 0 with: member isDirectory). (selectBlock value: entry) ifTrue: [ results add: entry ]. false ] ifTrue: [ true ]. ]. beRecursive ifTrue: [ subDirs do: [ :aDir | self startAt: aDir fileName recursively: beRecursive select: selectBlock into: results ]. ]. ^ results! FileArchiveExecutive subclass: #FileZipArchiveExecutive instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'File-Base'! FileExecutive subclass: #FileRemoteExecutive instanceVariableNames: 'url client' classVariableNames: '' poolDictionaries: '' category: 'File-Base'! FileRemoteExecutive subclass: #FileFtpExecutive instanceVariableNames: 'home isKeepAlive rw ftpClient' classVariableNames: '' poolDictionaries: '' category: 'File-Base'! ----- Method: FileFtpExecutive class>>canInstanciateFrom: (in category 'as yet unclassified') ----- canInstanciateFrom: aPathString ^ aPathString beginsWith: 'ftp:'! ----- Method: FileFtpExecutive>>FTPClient (in category 'as yet unclassified') ----- FTPClient ^ FTPClient"Debug"! ----- Method: FileFtpExecutive>>basicReader: (in category 'as yet unclassified') ----- basicReader: aRio ^ self ftpOpenForRead: aRio! ----- Method: FileFtpExecutive>>basicWriter: (in category 'as yet unclassified') ----- basicWriter: aRio ^ self ftpOpenForWrite: aRio! ----- Method: FileFtpExecutive>>closeAndDestroy: (in category 'wrap socket') ----- closeAndDestroy: timeout client closeDataSocket. client checkResponse. rw = #write ifTrue: [ client checkResponse ].! ----- Method: FileFtpExecutive>>createDirectory: (in category 'Rio-Grande') ----- createDirectory: aRio self ftpDo: [ :ftp | ftp makeDirectory: home, aRio asVmPathName. ]. aRio statIsNowInvalid.! ----- Method: FileFtpExecutive>>dataAvailable (in category 'wrap socket') ----- dataAvailable ^ client dataSocket dataAvailable! ----- Method: FileFtpExecutive>>delete: (in category 'Rio-Grande') ----- delete: aRio self ftpDo: [ :ftp | super delete: aRio ] ! ----- Method: FileFtpExecutive>>deleteDirectory: (in category 'Rio-Grande') ----- deleteDirectory: aRio self ftpDo: [ :ftp | ftp deleteDirectory: home, aRio asVmPathName. ]. aRio statIsNowInvalid.! ----- Method: FileFtpExecutive>>deleteFile: (in category 'Rio-Grande') ----- deleteFile: aRio self ftpDo: [ :ftp | (self isFile: aRio) ifTrue: [ ftp deleteFileNamed: home , aRio asVmPathName ] ]. aRio statIsNowInvalid.! ----- Method: FileFtpExecutive>>fileSize: (in category 'Rio-Grande') ----- fileSize: aRio ^ self ftpDo: [ :ftp | ftp getFileSize: home, aRio asVmPathName ] ! ----- Method: FileFtpExecutive>>ftpClient (in category 'as yet unclassified') ----- ftpClient client ifNotNil: [client isConnected ifTrue: [ ^ client ] ]. ^ client := self ftpOpenClient! ----- Method: FileFtpExecutive>>ftpDo: (in category 'as yet unclassified') ----- ftpDo: aBlock | tmp result | tmp := isKeepAlive. isKeepAlive := true. [ result := aBlock value: self ftpClient. ] ensure: [ (isKeepAlive := tmp) ifFalse: [ client ifNotNil: [ client quit ] ] ]. ^ result! ----- Method: FileFtpExecutive>>ftpDo:ifError: (in category 'as yet unclassified') ----- ftpDo: aBlock ifError: errBlock [ self ftpDo: aBlock. ] on: TelnetProtocolError do: errBlock ! ----- Method: FileFtpExecutive>>ftpGetDirectory: (in category 'Rio-Grande') ----- ftpGetDirectory: dirString "Return a stream with a listing of the current server directory. (Later -- Use a proxy server if one has been registered.)" | listing str ftpEntries | self ftpDo: [ :ftp | ftp changeDirectoryTo: dirString. listing := ftp getDirectory ]. str := ReadStream on: listing. (str respondsTo: #contentsOfEntireFile) ifFalse: [^ #()]. ftpEntries := str contentsOfEntireFile findTokens: String crlf. ^ ftpEntries collect:[:ftpEntry | self ftpParseEntry: ftpEntry ] thenSelect: [:entry | entry notNil]! ----- Method: FileFtpExecutive>>ftpKeepAliveDuring: (in category 'as yet unclassified') ----- ftpKeepAliveDuring: aBlock | tmp | tmp := isKeepAlive. isKeepAlive := true. aBlock ensure: [ isKeepAlive := tmp ] ! ----- Method: FileFtpExecutive>>ftpOpenClient (in category 'as yet unclassified') ----- ftpOpenClient | loginSuccessful what client | client := self FTPClient openOnHostNamed: self host. loginSuccessful := false. [loginSuccessful] whileFalse: [ [loginSuccessful := true. client loginUser: self user password: self password] on: LoginFailedException do: [:ex | what := UIManager default chooseFrom: #('enter password' 'give up') title: 'Would you like to try another password?'. what = 1 ifFalse: [self error: 'Login failed.'. ^nil] ifTrue: [ self password: nil ]. loginSuccessful := false]]. home := client pwd. ^client! ----- Method: FileFtpExecutive>>ftpOpenForRead: (in category 'as yet unclassified') ----- ftpOpenForRead: aRio self ftpClient openPassiveDataConnection. self ftpClient sendCommand: 'RETR ', home , aRio asVmPathName. [client checkResponse] on: TelnetProtocolError do: [:ex | client closeDataSocket. ex pass]. "we will wrap a socket for writing" rw := #read. ^ SocketStream on: self.! ----- Method: FileFtpExecutive>>ftpOpenForWrite: (in category 'as yet unclassified') ----- ftpOpenForWrite: aRio self ftpClient openPassiveDataConnection. self ftpClient sendCommand: 'STOR ', home , aRio asVmPathName. "we will wrap a socket for writing" rw := #write. ^ SocketStream on: self.! ----- Method: FileFtpExecutive>>ftpParseEntry: (in category 'as yet unclassified') ----- ftpParseEntry: ftpEntry | permissions rs dateInSeconds thisYear thisMonth unkown user group size month day time filename | thisYear := Date today year. thisMonth := Date today monthIndex. rs := ftpEntry readStream. permissions := rs upToSeparator. permissions size < 10 ifTrue: [ ^ nil ]. rs skipSeparators. unkown := rs upToSeparator. rs skipSeparators. user := rs upToSeparator. rs skipSeparators. group := rs upToSeparator. rs skipSeparators. size := rs upToSeparator. rs skipSeparators. month := rs upToSeparator. rs skipSeparators. "Fix for case that group is blank (relies on month being 3 chars)" (size size = 3 and: [ size asNumber = 0 ]) ifTrue: [ month := size. size := group. group := 'blank'. ]. day := rs upToSeparator. rs skipSeparators. time := rs upToSeparator. rs skipSeparators. filename := rs upToEnd. dateInSeconds := self secondsForDay: day month: month yearOrTime: time thisMonth: thisMonth thisYear: thisYear. ^Array with: filename "file name" with: dateInSeconds "creation date" with: dateInSeconds "modification time" with: ( (permissions first) = $d or: [permissions first =$l]) "is-a-directory flag" with: size asNumber "file size" ! ----- Method: FileFtpExecutive>>ftpParseEntryOld: (in category 'as yet unclassified') ----- ftpParseEntryOld: ftpEntry | tokens longy dateInSeconds thisYear thisMonth | thisYear := Date today year. thisMonth := Date today monthIndex. tokens := ftpEntry findTokens: ' '. tokens size = 8 ifTrue: [((tokens at: 6) size ~= 3 and: [(tokens at: 5) size = 3]) ifTrue: ["Fix for case that group is blank (relies on month being 3 chars)" tokens _ tokens copyReplaceFrom: 4 to: 3 with: {'blank'}]]. tokens size >= 9 ifFalse:[^nil]. ((tokens at: 6) size ~= 3 and: [(tokens at: 5) size = 3]) ifTrue: ["Fix for case that group is blank (relies on month being 3 chars)" tokens := tokens copyReplaceFrom: 4 to: 3 with: {'blank'}]. tokens size > 9 ifTrue: [longy := tokens at: 9. 10 to: tokens size do: [:i | longy := longy , ' ' , (tokens at: i)]. tokens at: 9 put: longy]. dateInSeconds := self secondsForDay: (tokens at: 7) month: (tokens at: 6) yearOrTime: (tokens at: 8) thisMonth: thisMonth thisYear: thisYear. ^Array with: (tokens last) "file name" with: dateInSeconds "creation date" with: dateInSeconds "modification time" with: ( (tokens first first) = $d or: [tokens first first =$l]) "is-a-directory flag" with: tokens fifth asNumber "file size" ! ----- Method: FileFtpExecutive>>in:select: (in category 'as yet unclassified') ----- in: aRio select: selectBlock ^ self ftpDo: [ :c | super in: aRio select: selectBlock ]! ----- Method: FileFtpExecutive>>initialize (in category 'as yet unclassified') ----- initialize isKeepAlive := false.! ----- Method: FileFtpExecutive>>isConnected (in category 'wrap socket') ----- isConnected ^ (client dataSocket ifNil: [ ^ false ]) isConnected! ----- Method: FileFtpExecutive>>isDirectory: (in category 'Rio-Grande') ----- isDirectory: aRio self ftpDo: [ :ftp | ftp changeDirectoryTo: home, aRio asVmPathName ] ifError: [ :ex | ^ false ]. ^ true.! ----- Method: FileFtpExecutive>>isFile: (in category 'Rio-Grande') ----- isFile: aRio self ftpDo: [ :ftp | ftp getFileSize: home, aRio asVmPathName ] ifError: [ :ex | ^ false ]. ^ true.! ----- Method: FileFtpExecutive>>isKeepAlive (in category 'as yet unclassified') ----- isKeepAlive ^ true! ----- Method: FileFtpExecutive>>isOtherEndClosed (in category 'wrap socket') ----- isOtherEndClosed ^ (client dataSocket ifNil: [ ^ true ]) isOtherEndClosed! ----- Method: FileFtpExecutive>>mkdir: (in category 'Rio-Grande') ----- mkdir: aRio self ftpDo: [ :ftp | super mkdir: aRio ] ! ----- Method: FileFtpExecutive>>mkpath: (in category 'Rio-Grande') ----- mkpath: aRio self ftpDo: [ :ftp | super mkpath: aRio ] ! ----- Method: FileFtpExecutive>>receiveAvailableDataInto:startingAt: (in category 'wrap socket') ----- receiveAvailableDataInto: inBuffer startingAt: n ^ client dataSocket receiveAvailableDataInto: inBuffer startingAt: n! ----- Method: FileFtpExecutive>>receiveDataSignallingTimeout:into:startingAt: (in category 'wrap socket') ----- receiveDataSignallingTimeout: timeout into: inBuffer startingAt: inNextToWrite ^ client dataSocket receiveDataSignallingTimeout: timeout into: inBuffer startingAt: inNextToWrite! ----- Method: FileFtpExecutive>>rename:to: (in category 'Rio-Grande') ----- rename: aRio to: bRio self ftpDo: [ :ftp | ftp renameFileNamed: home, aRio asVmPathName to: home, bRio asVmPathName ] ifError: [ aRio exists ifFalse:[ self error:'Attempt to rename a non-existent file or dir:' , aRio]. bRio exists ifTrue:[ self error: 'Failed to rename, ', bRio,' already exists.' ]. ]. aRio statIsNowInvalid. ^ bRio ! ----- Method: FileFtpExecutive>>rioClass (in category 'as yet unclassified') ----- rioClass ^ File! ----- Method: FileFtpExecutive>>secondsForDay:month:yearOrTime:thisMonth:thisYear: (in category 'as yet unclassified') ----- secondsForDay: dayToken month: monthToken yearOrTime: ytToken thisMonth: thisMonth thisYear: thisYear | ftpDay ftpMonth pickAYear jDateToday trialJulianDate | ftpDay := dayToken asNumber. ftpMonth := Date indexOfMonth: monthToken. (ytToken includes: $:) ifFalse: [ ^(Date newDay: ftpDay month: ftpMonth year: ytToken asNumber) asSeconds ]. jDateToday := Date today dayOfYear. trialJulianDate := (Date newDay: ftpDay month: ftpMonth year: thisYear) dayOfYear. "Date has no year if within six months (do we need to check the day, too?)" "Well it appear to be pickier than that... it isn't just 6 months or 6 months and the day of the month, put perhaps the julian date AND the time as well. I don't know what the precise standard is, but this seems to produce better results" pickAYear := (jDateToday - trialJulianDate) > 182 ifTrue: [ thisYear + 1 "his clock could be ahead of ours??" ] ifFalse: [ pickAYear := (trialJulianDate - jDateToday) > 182 ifTrue: [ thisYear - 1 ] ifFalse: [ thisYear ]. ]. ^(Date newDay: ftpDay month: ftpMonth year: pickAYear) asSeconds + (Time readFrom: (ReadStream on: ytToken)) asSeconds ! ----- Method: FileFtpExecutive>>sendData:count: (in category 'wrap socket') ----- sendData: outBuffer count: n client dataSocket sendData: outBuffer count: n! ----- Method: FileFtpExecutive>>startAt:recursively:select:into: (in category 'as yet unclassified') ----- startAt: rioOrString recursively: beRecursive select: selectBlock into: results "Return a collection of rio's selected by passing the directoryEntry array to the selectBlock. This can be called with startAt: aString, but if so beRecursive must be false. See primLookupEntryIn:index: for further details." | entry isDir | (self ftpGetDirectory: home, rioOrString asVmPathName) keysAndValuesDo: [ :index :entryArray | (entry := rioOrString / (entryArray at: 1)) setStatFromDir: rioOrString andEntryArray:entryArray. isDir := entryArray at: 4. isDir ifFalse: [ entry := entry asFile ]. (selectBlock value: entry) ifTrue: [ results add: entry ]. (beRecursive and: [ isDir ]) ifTrue: [ self startAt: entry recursively: beRecursive select: selectBlock into: results ]. ]. ^ results! ----- Method: FileFtpExecutive>>touch: (in category 'Rio-Grande') ----- touch: aRio self ftpDo: [ :dtp | ftp putFileStreamContents: (WriteStream with: String new) as: home , aRio asVmPathName ]! ----- Method: FileFtpExecutive>>user (in category 'as yet unclassified') ----- user ^ url username ifNil: [ 'ftp' ] ! FileRemoteExecutive subclass: #FileHttpExecutive instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'File-Base'! !FileHttpExecutive commentStamp: 'kph 11/10/2008 05:36' prior: 0! placeholder! ----- Method: FileHttpExecutive class>>canInstanciateFrom: (in category 'as yet unclassified') ----- canInstanciateFrom: aPathString ^ aPathString beginsWith: 'http:'! ----- Method: FileHttpExecutive>>password: (in category 'as yet unclassified') ----- password: passwordString | pwd | self user = 'ftp' ifTrue: [ ^ self ]. passwordString isEmpty ifTrue:[pwd := nil] ifFalse:[pwd := passwordString]. self MCPasswordManager default passwordAt: url asString user: self user put: pwd. ! ----- Method: FileRemoteExecutive class>>executiveForUrl: (in category 'as yet unclassified') ----- executiveForUrl: aUrl ^ self basicNew setUrl: aUrl; initialize! ----- Method: FileRemoteExecutive class>>makeNew:from: (in category 'as yet unclassified') ----- makeNew: aClass from: aString | exec path theUrl | theUrl := aString asUrl. path := String new writeStream. theUrl path do: [ :pathElem | path nextPut: $/. path nextPutAll: pathElem ]. theUrl path: #(). exec := self executiveForUrl: theUrl. ^ aClass executive: exec value: path contents.! ----- Method: FileRemoteExecutive>>host (in category 'as yet unclassified') ----- host ^ url authority! ----- Method: FileRemoteExecutive>>password (in category 'as yet unclassified') ----- password ^ url password ifNil: [ (self MCPasswordManager default queryPasswordAt: url asString user: (self user ifNil:[^'squeak'])) ] ! ----- Method: FileRemoteExecutive>>rootString (in category 'as yet unclassified') ----- rootString ^ '/'! ----- Method: FileRemoteExecutive>>setUrl: (in category 'as yet unclassified') ----- setUrl: aUrl url := aUrl. ! ----- Method: FileRemoteExecutive>>user (in category 'as yet unclassified') ----- user ^ url username ifNil: [ '' ] ! ----- Method: PositionableStream>>copyTo:size:withProgress: (in category '*file-base') ----- copyTo: out size: aSize withProgress: label | buffer barPos read first | self atEnd ifTrue: [ ^ self ]. first := self next. buffer := (first isCharacter ifTrue: [ String ] ifFalse: [ out binary. ByteArray ]) new: 50000. out nextPut: first. label asString displayProgressAt: Sensor cursorPoint from: (barPos := 0) to: (aSize) during: [:bar | [ self atEnd ] whileFalse: [ bar value: barPos. out nextPutAll: (read := self nextInto: buffer). barPos := barPos + read size ]. ].! ----- Method: PositionableStream>>setToAppend (in category '*file-base') ----- setToAppend ^ self setToEnd! ----- Method: PositionableStream>>upToSeparator (in category '*file-base') ----- upToSeparator "Answer a subcollection from the current access position to the occurrence (if any, but not inclusive) of anObject in the receiver. If anObject is not in the collection, answer the entire rest of the receiver." | newStream element | newStream := WriteStream on: (collection species new: 100). [self atEnd or: [(element := self next) isSeparator]] whileFalse: [newStream nextPut: element]. ^newStream contents!

1 0

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

Packages November 2008