'From Haver 6.0 [latest update: #5107] on 21 April 2022 at 10:55:27 pm'!
'Description I find various type of files at various places.
I can be used to find files for redistributing Haver or Cuis.'!
!provides: 'FileFinder' 1 22!
SystemOrganization addCategory: 'FileFinder'!
!moduleCreation: FileFinder!
Modules newEnvironment: #FileFinder!
!interfacesOf: FileFinder!
Modules environment: #FileFinder ::
interface: #SPI exporting: #(#LiveVMFileFinder #HaverImageFileFinder #CuisImageFileFinder #LiveCompressedSourceFileFinder #AbstractTypeSpecificFileFinder #ComplexFileFinder #ChangeSetFileFinder #PackageFileFinder #CuisChangesFileFinder #LiveImageFileFinder #LiveSourceFileFinder #AbstractFileFinder #HaverChangesFileFinder ) ::
interface: #API exporting: #(#HaverImageFileFinder #CuisImageFileFinder #LiveCompressedSourceFileFinder #ChangeSetFileFinder #ComplexFileFinder #HaverChangesFileFinder #CuisChangesFileFinder #LiveImageFileFinder #LiveSourceFileFinder #LiveVMFileFinder #PackageFileFinder ) ::
interface: #UTI aliasFor: #API!
!classDefinition: (Modules>>#FileFinder>>#AbstractFileFinder) category: 'FileFinder'!
ActiveModel subclass: #AbstractFileFinder
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'FileFinder'
inModule: #FileFinder!
!classDefinition: (Modules>>#FileFinder>>#AbstractFileFinder) class category: 'FileFinder'!
(Modules>>#FileFinder>>#AbstractFileFinder) class
instanceVariableNames: ''!
!classDefinition: (Modules>>#FileFinder>>#AbstractTypeSpecificFileFinder) category: 'FileFinder'!
(Modules>>#FileFinder>>#AbstractFileFinder) subclass: #AbstractTypeSpecificFileFinder
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'FileFinder'
inModule: #FileFinder!
!classDefinition: (Modules>>#FileFinder>>#AbstractTypeSpecificFileFinder) class category: 'FileFinder'!
(Modules>>#FileFinder>>#AbstractTypeSpecificFileFinder) class
instanceVariableNames: ''!
!classDefinition: (Modules>>#FileFinder>>#AbstractRootedFileFinder) category: 'FileFinder'!
(Modules>>#FileFinder>>#AbstractTypeSpecificFileFinder) subclass: #AbstractRootedFileFinder
instanceVariableNames: 'rootDirectories fileBundleConstructors'
classVariableNames: ''
poolDictionaries: ''
category: 'FileFinder'
inModule: #FileFinder!
!classDefinition: (Modules>>#FileFinder>>#AbstractRootedFileFinder) class category: 'FileFinder'!
(Modules>>#FileFinder>>#AbstractRootedFileFinder) class
instanceVariableNames: ''!
!classDefinition: (Modules>>#FileFinder>>#AbstractBaseNameFileFinder) category: 'FileFinder'!
(Modules>>#FileFinder>>#AbstractRootedFileFinder) subclass: #AbstractBaseNameFileFinder
instanceVariableNames: 'explicitUpdateNumber'
classVariableNames: ''
poolDictionaries: ''
category: 'FileFinder'
inModule: #FileFinder!
!classDefinition: (Modules>>#FileFinder>>#AbstractBaseNameFileFinder) class category: 'FileFinder'!
(Modules>>#FileFinder>>#AbstractBaseNameFileFinder) class
instanceVariableNames: ''!
!classDefinition: (Modules>>#FileFinder>>#AbstractChangesFileFinder) category: 'FileFinder'!
(Modules>>#FileFinder>>#AbstractBaseNameFileFinder) subclass: #AbstractChangesFileFinder
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'FileFinder'
inModule: #FileFinder!
!classDefinition: (Modules>>#FileFinder>>#AbstractChangesFileFinder) class category: 'FileFinder'!
(Modules>>#FileFinder>>#AbstractChangesFileFinder) class
instanceVariableNames: ''!
!classDefinition: (Modules>>#FileFinder>>#CuisChangesFileFinder) category: 'FileFinder'!
(Modules>>#FileFinder>>#AbstractChangesFileFinder) subclass: #CuisChangesFileFinder
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'FileFinder'
inModule: #FileFinder!
!classDefinition: (Modules>>#FileFinder>>#CuisChangesFileFinder) class category: 'FileFinder'!
(Modules>>#FileFinder>>#CuisChangesFileFinder) class
instanceVariableNames: ''!
!classDefinition: (Modules>>#FileFinder>>#HaverChangesFileFinder) category: 'FileFinder'!
(Modules>>#FileFinder>>#AbstractChangesFileFinder) subclass: #HaverChangesFileFinder
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'FileFinder'
inModule: #FileFinder!
!classDefinition: (Modules>>#FileFinder>>#HaverChangesFileFinder) class category: 'FileFinder'!
(Modules>>#FileFinder>>#HaverChangesFileFinder) class
instanceVariableNames: ''!
!classDefinition: (Modules>>#FileFinder>>#AbstractImageFileFinder) category: 'FileFinder'!
(Modules>>#FileFinder>>#AbstractBaseNameFileFinder) subclass: #AbstractImageFileFinder
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'FileFinder'
inModule: #FileFinder!
!classDefinition: (Modules>>#FileFinder>>#AbstractImageFileFinder) class category: 'FileFinder'!
(Modules>>#FileFinder>>#AbstractImageFileFinder) class
instanceVariableNames: ''!
!classDefinition: (Modules>>#FileFinder>>#CuisImageFileFinder) category: 'FileFinder'!
(Modules>>#FileFinder>>#AbstractImageFileFinder) subclass: #CuisImageFileFinder
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'FileFinder'
inModule: #FileFinder!
!classDefinition: (Modules>>#FileFinder>>#CuisImageFileFinder) class category: 'FileFinder'!
(Modules>>#FileFinder>>#CuisImageFileFinder) class
instanceVariableNames: ''!
!classDefinition: (Modules>>#FileFinder>>#HaverImageFileFinder) category: 'FileFinder'!
(Modules>>#FileFinder>>#AbstractImageFileFinder) subclass: #HaverImageFileFinder
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'FileFinder'
inModule: #FileFinder!
!classDefinition: (Modules>>#FileFinder>>#HaverImageFileFinder) class category: 'FileFinder'!
(Modules>>#FileFinder>>#HaverImageFileFinder) class
instanceVariableNames: ''!
!classDefinition: (Modules>>#FileFinder>>#ChangeSetFileFinder) category: 'FileFinder'!
(Modules>>#FileFinder>>#AbstractRootedFileFinder) subclass: #ChangeSetFileFinder
instanceVariableNames: 'distributionRootName'
classVariableNames: ''
poolDictionaries: ''
category: 'FileFinder'
inModule: #FileFinder!
!classDefinition: (Modules>>#FileFinder>>#ChangeSetFileFinder) class category: 'FileFinder'!
(Modules>>#FileFinder>>#ChangeSetFileFinder) class
instanceVariableNames: ''!
!classDefinition: (Modules>>#FileFinder>>#DocumentationFileFinder) category: 'FileFinder'!
(Modules>>#FileFinder>>#AbstractRootedFileFinder) subclass: #DocumentationFileFinder
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'FileFinder'
inModule: #FileFinder!
!classDefinition: (Modules>>#FileFinder>>#DocumentationFileFinder) class category: 'FileFinder'!
(Modules>>#FileFinder>>#DocumentationFileFinder) class
instanceVariableNames: ''!
!classDefinition: (Modules>>#FileFinder>>#LicenseFileFinder) category: 'FileFinder'!
(Modules>>#FileFinder>>#AbstractRootedFileFinder) subclass: #LicenseFileFinder
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'FileFinder'
inModule: #FileFinder!
!classDefinition: (Modules>>#FileFinder>>#LicenseFileFinder) class category: 'FileFinder'!
(Modules>>#FileFinder>>#LicenseFileFinder) class
instanceVariableNames: ''!
!classDefinition: (Modules>>#FileFinder>>#PackageFileFinder) category: 'FileFinder'!
(Modules>>#FileFinder>>#AbstractRootedFileFinder) subclass: #PackageFileFinder
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'FileFinder'
inModule: #FileFinder!
!classDefinition: (Modules>>#FileFinder>>#PackageFileFinder) class category: 'FileFinder'!
(Modules>>#FileFinder>>#PackageFileFinder) class
instanceVariableNames: ''!
!classDefinition: (Modules>>#FileFinder>>#TrueTypeFontFileFinder) category: 'FileFinder'!
(Modules>>#FileFinder>>#AbstractRootedFileFinder) subclass: #TrueTypeFontFileFinder
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'FileFinder'
inModule: #FileFinder!
!classDefinition: (Modules>>#FileFinder>>#TrueTypeFontFileFinder) class category: 'FileFinder'!
(Modules>>#FileFinder>>#TrueTypeFontFileFinder) class
instanceVariableNames: ''!
!classDefinition: (Modules>>#FileFinder>>#LiveImageFileFinder) category: 'FileFinder'!
(Modules>>#FileFinder>>#AbstractTypeSpecificFileFinder) subclass: #LiveImageFileFinder
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'FileFinder'
inModule: #FileFinder!
!classDefinition: (Modules>>#FileFinder>>#LiveImageFileFinder) class category: 'FileFinder'!
(Modules>>#FileFinder>>#LiveImageFileFinder) class
instanceVariableNames: ''!
!classDefinition: (Modules>>#FileFinder>>#LiveSourceFileFinder) category: 'FileFinder'!
(Modules>>#FileFinder>>#AbstractTypeSpecificFileFinder) subclass: #LiveSourceFileFinder
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'FileFinder'
inModule: #FileFinder!
!classDefinition: (Modules>>#FileFinder>>#LiveSourceFileFinder) class category: 'FileFinder'!
(Modules>>#FileFinder>>#LiveSourceFileFinder) class
instanceVariableNames: ''!
!classDefinition: (Modules>>#FileFinder>>#LiveCompressedSourceFileFinder) category: 'FileFinder'!
(Modules>>#FileFinder>>#LiveSourceFileFinder) subclass: #LiveCompressedSourceFileFinder
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'FileFinder'
inModule: #FileFinder!
!classDefinition: (Modules>>#FileFinder>>#LiveCompressedSourceFileFinder) class category: 'FileFinder'!
(Modules>>#FileFinder>>#LiveCompressedSourceFileFinder) class
instanceVariableNames: ''!
!classDefinition: (Modules>>#FileFinder>>#LiveVMFileFinder) category: 'FileFinder'!
(Modules>>#FileFinder>>#AbstractTypeSpecificFileFinder) subclass: #LiveVMFileFinder
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'FileFinder'
inModule: #FileFinder!
!classDefinition: (Modules>>#FileFinder>>#LiveVMFileFinder) class category: 'FileFinder'!
(Modules>>#FileFinder>>#LiveVMFileFinder) class
instanceVariableNames: ''!
!classDefinition: (Modules>>#FileFinder>>#ComplexFileFinder) category: 'FileFinder'!
(Modules>>#FileFinder>>#AbstractFileFinder) subclass: #ComplexFileFinder
instanceVariableNames: 'fileFinders haverImageFileFinder haverChangesFileFinder cuisImageFileFinder cuisChangesFileFinder packageFileFinder changeSetFileFinder compressedSourceFileFinder vmFileFinder trueTypeFontFileFinder licenseFileFinder cuisUpdatesFileFinder documentationFileFinder'
classVariableNames: ''
poolDictionaries: ''
category: 'FileFinder'
inModule: #FileFinder!
!classDefinition: (Modules>>#FileFinder>>#ComplexFileFinder) class category: 'FileFinder'!
(Modules>>#FileFinder>>#ComplexFileFinder) class
instanceVariableNames: ''!
!classDefinition: (Modules>>#FileFinder>>#AbstractFileDescription) category: 'FileFinder'!
Object subclass: #AbstractFileDescription
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'FileFinder'
inModule: #FileFinder!
!classDefinition: (Modules>>#FileFinder>>#AbstractFileDescription) class category: 'FileFinder'!
(Modules>>#FileFinder>>#AbstractFileDescription) class
instanceVariableNames: 'uniqueInstance'!
!classDefinition: (Modules>>#FileFinder>>#AbstractSourceCodeFile) category: 'FileFinder'!
(Modules>>#FileFinder>>#AbstractFileDescription) subclass: #AbstractSourceCodeFile
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'FileFinder'
inModule: #FileFinder!
!classDefinition: (Modules>>#FileFinder>>#AbstractSourceCodeFile) class category: 'FileFinder'!
(Modules>>#FileFinder>>#AbstractSourceCodeFile) class
instanceVariableNames: ''!
!classDefinition: (Modules>>#FileFinder>>#AbstractPackageDescription) category: 'FileFinder'!
(Modules>>#FileFinder>>#AbstractSourceCodeFile) subclass: #AbstractPackageDescription
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'FileFinder'
inModule: #FileFinder!
!classDefinition: (Modules>>#FileFinder>>#AbstractPackageDescription) class category: 'FileFinder'!
(Modules>>#FileFinder>>#AbstractPackageDescription) class
instanceVariableNames: ''!
!classDefinition: (Modules>>#FileFinder>>#CuisPackageDescription) category: 'FileFinder'!
(Modules>>#FileFinder>>#AbstractPackageDescription) subclass: #CuisPackageDescription
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'FileFinder'
inModule: #FileFinder!
!classDefinition: (Modules>>#FileFinder>>#CuisPackageDescription) class category: 'FileFinder'!
(Modules>>#FileFinder>>#CuisPackageDescription) class
instanceVariableNames: ''!
!classDefinition: (Modules>>#FileFinder>>#HaverPackageDescription) category: 'FileFinder'!
(Modules>>#FileFinder>>#AbstractPackageDescription) subclass: #HaverPackageDescription
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'FileFinder'
inModule: #FileFinder!
!classDefinition: (Modules>>#FileFinder>>#HaverPackageDescription) class category: 'FileFinder'!
(Modules>>#FileFinder>>#HaverPackageDescription) class
instanceVariableNames: ''!
!classDefinition: (Modules>>#FileFinder>>#ChangeSetDescription) category: 'FileFinder'!
(Modules>>#FileFinder>>#AbstractSourceCodeFile) subclass: #ChangeSetDescription
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'FileFinder'
inModule: #FileFinder!
!classDefinition: (Modules>>#FileFinder>>#ChangeSetDescription) class category: 'FileFinder'!
(Modules>>#FileFinder>>#ChangeSetDescription) class
instanceVariableNames: ''!
!classDefinition: (Modules>>#FileFinder>>#TrueTypeFontDescription) category: 'FileFinder'!
(Modules>>#FileFinder>>#AbstractSourceCodeFile) subclass: #TrueTypeFontDescription
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'FileFinder'
inModule: #FileFinder!
!classDefinition: (Modules>>#FileFinder>>#TrueTypeFontDescription) class category: 'FileFinder'!
(Modules>>#FileFinder>>#TrueTypeFontDescription) class
instanceVariableNames: ''!
!classDefinition: (Modules>>#FileFinder>>#AbstractVMPartDescription) category: 'FileFinder'!
(Modules>>#FileFinder>>#AbstractFileDescription) subclass: #AbstractVMPartDescription
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'FileFinder'
inModule: #FileFinder!
!classDefinition: (Modules>>#FileFinder>>#AbstractVMPartDescription) class category: 'FileFinder'!
(Modules>>#FileFinder>>#AbstractVMPartDescription) class
instanceVariableNames: ''!
!classDefinition: (Modules>>#FileFinder>>#VMDescription) category: 'FileFinder'!
(Modules>>#FileFinder>>#AbstractVMPartDescription) subclass: #VMDescription
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'FileFinder'
inModule: #FileFinder!
!classDefinition: (Modules>>#FileFinder>>#VMDescription) class category: 'FileFinder'!
(Modules>>#FileFinder>>#VMDescription) class
instanceVariableNames: ''!
!classDefinition: (Modules>>#FileFinder>>#VMSharedObjectDescription) category: 'FileFinder'!
(Modules>>#FileFinder>>#AbstractVMPartDescription) subclass: #VMSharedObjectDescription
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'FileFinder'
inModule: #FileFinder!
!classDefinition: (Modules>>#FileFinder>>#VMSharedObjectDescription) class category: 'FileFinder'!
(Modules>>#FileFinder>>#VMSharedObjectDescription) class
instanceVariableNames: ''!
!classDefinition: (Modules>>#FileFinder>>#DocumentationFileDescription) category: 'FileFinder'!
(Modules>>#FileFinder>>#AbstractFileDescription) subclass: #DocumentationFileDescription
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'FileFinder'
inModule: #FileFinder!
!classDefinition: (Modules>>#FileFinder>>#DocumentationFileDescription) class category: 'FileFinder'!
(Modules>>#FileFinder>>#DocumentationFileDescription) class
instanceVariableNames: ''!
!classDefinition: (Modules>>#FileFinder>>#ImageFileDescription) category: 'FileFinder'!
(Modules>>#FileFinder>>#AbstractFileDescription) subclass: #ImageFileDescription
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'FileFinder'
inModule: #FileFinder!
!classDefinition: (Modules>>#FileFinder>>#ImageFileDescription) class category: 'FileFinder'!
(Modules>>#FileFinder>>#ImageFileDescription) class
instanceVariableNames: ''!
!classDefinition: (Modules>>#FileFinder>>#SourceFileDescription) category: 'FileFinder'!
(Modules>>#FileFinder>>#AbstractFileDescription) subclass: #SourceFileDescription
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'FileFinder'
inModule: #FileFinder!
!classDefinition: (Modules>>#FileFinder>>#SourceFileDescription) class category: 'FileFinder'!
(Modules>>#FileFinder>>#SourceFileDescription) class
instanceVariableNames: ''!
!classDefinition: (Modules>>#FileFinder>>#TextFileDescription) category: 'FileFinder'!
(Modules>>#FileFinder>>#AbstractFileDescription) subclass: #TextFileDescription
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'FileFinder'
inModule: #FileFinder!
!classDefinition: (Modules>>#FileFinder>>#TextFileDescription) class category: 'FileFinder'!
(Modules>>#FileFinder>>#TextFileDescription) class
instanceVariableNames: ''!
!classDefinition: (Modules>>#FileFinder>>#LicenseFileDescription) category: 'FileFinder'!
(Modules>>#FileFinder>>#TextFileDescription) subclass: #LicenseFileDescription
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'FileFinder'
inModule: #FileFinder!
!classDefinition: (Modules>>#FileFinder>>#LicenseFileDescription) class category: 'FileFinder'!
(Modules>>#FileFinder>>#LicenseFileDescription) class
instanceVariableNames: ''!
!classDefinition: (Modules>>#FileFinder>>#FileBundle) category: 'FileFinder'!
Object subclass: #FileBundle
instanceVariableNames: 'sourceFilename distributionFilename description'
classVariableNames: ''
poolDictionaries: ''
category: 'FileFinder'
inModule: #FileFinder!
!classDefinition: (Modules>>#FileFinder>>#FileBundle) class category: 'FileFinder'!
(Modules>>#FileFinder>>#FileBundle) class
instanceVariableNames: ''!
!(Modules>>#FileFinder>>#AbstractFileFinder) commentStamp: '<historical>' prior: 0!
I am the abstract base class of all file finders.!
!(Modules>>#FileFinder>>#AbstractTypeSpecificFileFinder) commentStamp: '<historical>' prior: 0!
I am the abstract base class of all file finder models, that are specific for some types of files..!
!(Modules>>#FileFinder>>#AbstractChangesFileFinder) commentStamp: '<historical>' prior: 0!
I am the abstract base class of all change file finders.!
!(Modules>>#FileFinder>>#HaverChangesFileFinder) commentStamp: '<historical>' prior: 0!
I am a file finder that finds haver images in a directory.!
!(Modules>>#FileFinder>>#AbstractImageFileFinder) commentStamp: '<historical>' prior: 0!
I am the abstract base class of all image file finders.!
!(Modules>>#FileFinder>>#HaverImageFileFinder) commentStamp: '<historical>' prior: 0!
I am a file finder that finds haver images in a directory.!
!(Modules>>#FileFinder>>#DocumentationFileFinder) commentStamp: '<historical>' prior: 0!
I find all the documentation.
For the time being I only look for PDF files.!
!(Modules>>#FileFinder>>#PackageFileFinder) commentStamp: '<historical>' prior: 0!
I am a package finder. that finds various parts of files.
!
!(Modules>>#FileFinder>>#TrueTypeFontFileFinder) commentStamp: '<historical>' prior: 0!
I find all the true fonts to be distributed.!
!(Modules>>#FileFinder>>#LiveImageFileFinder) commentStamp: '<historical>' prior: 0!
I am a file-finder that finds the image file.!
!(Modules>>#FileFinder>>#LiveSourceFileFinder) commentStamp: '<historical>' prior: 0!
I find all the source files.!
!(Modules>>#FileFinder>>#LiveCompressedSourceFileFinder) commentStamp: '<historical>' prior: 0!
I find the compressed Cuis sources.!
!(Modules>>#FileFinder>>#LiveVMFileFinder) commentStamp: '<historical>' prior: 0!
I am a file finder model that finds parts of the virtual machine, e.g. its executable and shared objects.!
!(Modules>>#FileFinder>>#ComplexFileFinder) commentStamp: '<historical>' prior: 0!
I am a filfinder that provides an aggregated model that conssists of instances of the other type-specific file finder classes.!
!(Modules>>#FileFinder>>#FileBundle) commentStamp: '<historical>' prior: 0!
I am a data class that holds the found file- and distribution names.!
!(Modules>>#FileFinder>>#AbstractFileFinder) methodsFor: 'finding' stamp: 'KLG 4/10/2021 21:06:18'!
bundlesDo: aBlock
"Evaluate a block for each with a file bundel constructed from the files found."
self subclassResponsibility! !
!(Modules>>#FileFinder>>#AbstractFileFinder) methodsFor: 'finding' stamp: 'KLG 4/11/2021 17:12:37'!
filenames
"Answer all the files found"
| answer |
answer _ OrderedCollection new.
self bundlesDo: [ :bundle | answer add: bundle sourceFilename ].
^ answer! !
!(Modules>>#FileFinder>>#AbstractFileFinder) methodsFor: 'instance creation' stamp: 'KLG 4/10/2021 21:08:55'!
fileBundleClass
"Answer the file bundle class."
^ self class fileBundleClass! !
!(Modules>>#FileFinder>>#AbstractFileFinder) class methodsFor: 'instance creation' stamp: 'KLG 4/10/2021 21:07:55'!
fileBundleClass
"Answer the file bundle class."
^ FileBundle! !
!(Modules>>#FileFinder>>#AbstractTypeSpecificFileFinder) methodsFor: 'distribution' stamp: 'KLG 4/10/2021 12:21:14'!
distributionNameFor: aBaseName
"Answer a distribution name based on aBaseName"
^ self pathNameDelimiter join: { self distributionRootName. aBaseName }! !
!(Modules>>#FileFinder>>#AbstractTypeSpecificFileFinder) methodsFor: 'distribution' stamp: 'KLG 4/9/2021 21:34:52'!
distributionRootName
"Answer the name of the distribution root directory."
^ self class distributionRootName! !
!(Modules>>#FileFinder>>#AbstractTypeSpecificFileFinder) methodsFor: 'distribution' stamp: 'KLG 4/10/2021 12:21:38'!
pathNameDelimiter
"Answer the pathNameDlimter string"
^ FileIOAccessor default pathNameDelimiter asString! !
!(Modules>>#FileFinder>>#AbstractTypeSpecificFileFinder) class methodsFor: 'distribution' stamp: 'KLG 4/9/2021 21:37:37'!
distributionRootName
"Answer the name of the distribution root directory."
^ self subclassResponsibility! !
!(Modules>>#FileFinder>>#AbstractRootedFileFinder) methodsFor: 'accessing' stamp: 'KLG 4/11/2021 19:56:02'!
addRoot: aDirectoryEntryLike
"Answer a root (directory) to search for files."
self addRoot: aDirectoryEntryLike andFileBundleConstructor: self defaultFileBundleConstructor! !
!(Modules>>#FileFinder>>#AbstractRootedFileFinder) methodsFor: 'accessing' stamp: 'KLG 4/11/2021 20:55:45'!
addRoot: aDirectoryEntryLike andFileBundleConstructor: aFileBundleConstructor
"Answer a root (directory) to search for files."
rootDirectories add: (aDirectoryEntryLike isString
ifTrue: [ aDirectoryEntryLike asDirectoryEntry ]
ifFalse: [ aDirectoryEntryLike ]).
fileBundleConstructors add: aFileBundleConstructor.
self
changed: #roots;
changed: #filenames! !
!(Modules>>#FileFinder>>#AbstractRootedFileFinder) methodsFor: 'accessing' stamp: 'KLG 4/9/2021 13:30:28'!
roots
"Answer the root directories."
^ rootDirectories asArray ! !
!(Modules>>#FileFinder>>#AbstractRootedFileFinder) methodsFor: 'finding' stamp: 'KLG 4/14/2021 07:53:21'!
bundlesDo: aBlock
"Evaluate a block for each with a file bundel constructed from the files found."
rootDirectories with: fileBundleConstructors do: [ :rootEntry :constructor | | rootSize |
rootSize _ rootEntry pathComponents size.
rootEntry
allFilesDo: [ :fileEntry |
aBlock value:
(FileBundle perform: constructor ::
sourceFilename: fileEntry pathName
distributionFilename: (self distributionNameFor: fileEntry size: rootSize)) ]
matches: self fileEntryMatchBlock ].! !
!(Modules>>#FileFinder>>#AbstractRootedFileFinder) methodsFor: 'finding' stamp: 'KLG 4/21/2022 22:21:25'!
distributionNameFor: aFileEntry size: rootSize
"Answer the distribution name for aFileEntry."
| components |
^ self pathNameDelimiter
join:
{ self distributionRootName },
(self nicePathComponents: (
(components _ aFileEntry pathComponents)
copyFrom: (self rootSizeForDistributionName: rootSize)
to: components size))! !
!(Modules>>#FileFinder>>#AbstractRootedFileFinder) methodsFor: 'finding' stamp: 'KLG 4/9/2021 15:44:23'!
extensionToFind
"Answer the extenstion to look for."
^ self subclassResponsibility! !
!(Modules>>#FileFinder>>#AbstractRootedFileFinder) methodsFor: 'finding' stamp: 'KLG 4/11/2021 17:27:09'!
extensionsToFind
"Answer the extenstion to look for."
^ { self extensionToFind }! !
!(Modules>>#FileFinder>>#AbstractRootedFileFinder) methodsFor: 'finding' stamp: 'KLG 4/14/2021 07:54:24'!
fileEntryMatchBlock
"Answer a block that matches file entries by extension."
^ [ :fileEntry |
self extensionsToFind anySatisfy: [ :extension |
fileEntry extension = extension ] ]! !
!(Modules>>#FileFinder>>#AbstractRootedFileFinder) methodsFor: 'finding' stamp: 'KLG 4/12/2021 22:03:16'!
nicePathComponents: somePathComponents
"Create path components with a nicer names."
^ somePathComponents ! !
!(Modules>>#FileFinder>>#AbstractRootedFileFinder) methodsFor: 'finding' stamp: 'KLG 4/12/2021 22:22:29'!
rootSizeForDistributionName: aRootSize
"Answer the number root path components to consider in a directory found"
^ aRootSize + 1! !
!(Modules>>#FileFinder>>#AbstractRootedFileFinder) methodsFor: 'instance creation' stamp: 'KLG 4/11/2021 19:54:25'!
defaultFileBundleConstructor
"Answer the symboi to send to FileBundles found by me."
^ self class defaultFileBundleConstructor! !
!(Modules>>#FileFinder>>#AbstractRootedFileFinder) methodsFor: 'initialization' stamp: 'KLG 4/10/2021 21:50:44'!
initialize
"Initialize the file finder."
super initialize.
rootDirectories _ OrderedCollection new.
fileBundleConstructors _ OrderedCollection new! !
!(Modules>>#FileFinder>>#AbstractRootedFileFinder) class methodsFor: 'instance creation' stamp: 'KLG 4/11/2021 19:54:50'!
defaultFileBundleConstructor
"Answer the symboi to send to FileBundles found by me."
^ self subclassResponsibility! !
!(Modules>>#FileFinder>>#AbstractBaseNameFileFinder) methodsFor: 'finding' stamp: 'KLG 4/11/2021 18:48:51'!
baseName
"Answer the image base name."
^ self subclassResponsibility! !
!(Modules>>#FileFinder>>#AbstractBaseNameFileFinder) methodsFor: 'finding' stamp: 'KLG 4/11/2021 18:48:51'!
bundlesDo: aBlock
"Evaluate a block for each with a file bundel constructed from the files found."
| baseName |
baseName _ self baseName.
super bundlesDo: [ :fileBundle |
fileBundle sourceFilename asFileEntry baseName = baseName ifTrue: [
aBlock value: fileBundle ] ]! !
!(Modules>>#FileFinder>>#AbstractBaseNameFileFinder) methodsFor: 'finding' stamp: 'KLG 4/21/2022 22:13:50'!
explictCuisBaseName
"Answer an explicit Cuis base name.
This makes the normal Cuis image upgrade procedure possible
This method may answer nil, then we revert to base name of this image.."
^ Smalltalk cuisBaseNameForVersion: self explicitSystemVersion ! !
!(Modules>>#FileFinder>>#AbstractBaseNameFileFinder) methodsFor: 'explicit system version' stamp: 'KLG 4/15/2021 14:33:12'!
explicitSystemVersion
"Answer an explicit system version"
^ self explicitUpdateNumber
ifNotNil: [ :number | | currentSystemVersion |
SystemVersion
versionMajor: (currentSystemVersion _ SystemVersion current) versionMajor
versionMinor: currentSystemVersion versionMinor ::
highestUpdate: number ]
ifNil: [ SystemVersion current ]
! !
!(Modules>>#FileFinder>>#AbstractBaseNameFileFinder) methodsFor: 'explicit system version' stamp: 'KLG 4/15/2021 14:33:36'!
explicitUpdateNumber
"Answer an explict highest update number.
I may answer nil, in this case the current system version is used."
^ explicitUpdateNumber! !
!(Modules>>#FileFinder>>#AbstractBaseNameFileFinder) methodsFor: 'explicit system version' stamp: 'KLG 4/15/2021 14:34:46'!
explicitUpdateNumber: anInteger
"Set the explicit update number to use.."
explicitUpdateNumber _ anInteger! !
!(Modules>>#FileFinder>>#AbstractBaseNameFileFinder) class methodsFor: 'distribution' stamp: 'KLG 4/11/2021 20:43:02'!
distributionRootName
"Answer the root mname for the distribution file name."
^ 'Image'! !
!(Modules>>#FileFinder>>#AbstractChangesFileFinder) methodsFor: 'finding' stamp: 'KLG 4/11/2021 18:44:10'!
extensionToFind
"Answer the extenstion to look for."
^ 'changes'! !
!(Modules>>#FileFinder>>#AbstractChangesFileFinder) class methodsFor: 'instance creation' stamp: 'KLG 4/11/2021 19:57:55'!
defaultFileBundleConstructor
"Answer the symboi to send to FileBundles found by me."
^ #forSourceFile! !
!(Modules>>#FileFinder>>#CuisChangesFileFinder) methodsFor: 'finding' stamp: 'KLG 4/15/2021 14:35:12'!
baseName
"Answer the image base name."
^ self explictCuisBaseName ! !
!(Modules>>#FileFinder>>#HaverChangesFileFinder) methodsFor: 'finding' stamp: 'KLG 4/11/2021 18:50:34'!
baseName
"Answer the image base name."
^ Smalltalk haverBaseNameForCurrentVersion! !
!(Modules>>#FileFinder>>#AbstractImageFileFinder) methodsFor: 'finding' stamp: 'KLG 4/11/2021 18:02:40'!
extensionToFind
"Answer the extenstion to look for."
^ 'image'! !
!(Modules>>#FileFinder>>#AbstractImageFileFinder) class methodsFor: 'instance creation' stamp: 'KLG 4/11/2021 19:58:13'!
defaultFileBundleConstructor
"Answer the symboi to send to FileBundles found by me."
^ #forImage! !
!(Modules>>#FileFinder>>#CuisImageFileFinder) methodsFor: 'finding' stamp: 'KLG 4/15/2021 14:35:35'!
baseName
"Answer the image base name."
^ self explictCuisBaseName ! !
!(Modules>>#FileFinder>>#HaverImageFileFinder) methodsFor: 'finding' stamp: 'KLG 4/11/2021 18:48:51'!
baseName
"Answer the image base name."
^ Smalltalk haverBaseNameForCurrentVersion! !
!(Modules>>#FileFinder>>#ChangeSetFileFinder) methodsFor: 'finding' stamp: 'KLG 4/9/2021 19:02:48'!
extensionToFind
"Answer the extenstion to look for."
^ 'cs.st'! !
!(Modules>>#FileFinder>>#ChangeSetFileFinder) methodsFor: 'accessing' stamp: 'KLG 4/15/2021 21:37:16'!
distributionRootName
"Answer the root name in the distribution."
^ distributionRootName ifNil: [ super distributionRootName ]! !
!(Modules>>#FileFinder>>#ChangeSetFileFinder) methodsFor: 'accessing' stamp: 'KLG 4/15/2021 21:37:43'!
distributionRootName: aPathString
"set the root name in the distribution."
distributionRootName _ aPathString! !
!(Modules>>#FileFinder>>#ChangeSetFileFinder) class methodsFor: 'distribution' stamp: 'KLG 4/9/2021 21:39:02'!
distributionRootName
"Answer the name of the distribution root directory."
^ 'CoreChanges'! !
!(Modules>>#FileFinder>>#ChangeSetFileFinder) class methodsFor: 'instance creation' stamp: 'KLG 4/11/2021 19:58:46'!
defaultFileBundleConstructor
"Answer the symboi to send to FileBundles found by me."
^ #forChangeSet! !
!(Modules>>#FileFinder>>#DocumentationFileFinder) methodsFor: 'finding' stamp: 'KLG 4/28/2021 17:31:42'!
extensionToFind
"Answer the extenstion to look for."
^ 'pdf'! !
!(Modules>>#FileFinder>>#DocumentationFileFinder) methodsFor: 'finding' stamp: 'KLG 4/28/2021 17:16:50'!
fileEntryMatchBlock
"Answer a block that matches file entries by extension."
| superBlock |
superBlock _ super fileEntryMatchBlock.
^ [ :fileEntry |
superBlock value: fileEntry ::
ifTrue: [ fileEntry parent name ~= 'img' ]
ifFalse: [ false ] ]! !
!(Modules>>#FileFinder>>#DocumentationFileFinder) class methodsFor: 'as yet unclassified' stamp: 'KLG 4/28/2021 14:25:19'!
distributionRootName
"Answer the name of the distribution root directory."
^ 'Documentation'! !
!(Modules>>#FileFinder>>#DocumentationFileFinder) class methodsFor: 'instance creation' stamp: 'KLG 4/28/2021 14:36:45'!
defaultFileBundleConstructor
"Answer the constructor for documentation descriptions."
^ #forDocumentation! !
!(Modules>>#FileFinder>>#LicenseFileFinder) methodsFor: 'finding' stamp: 'KLG 4/14/2021 16:42:57'!
fileEntryMatchBlock
"Answer a block that matches file entries by extension."
^ [ :fileEntry |
(fileEntry name findString: 'License' startingAt: 1 caseSensitive: false)
~= 0 ]! !
!(Modules>>#FileFinder>>#LicenseFileFinder) class methodsFor: 'instance creation' stamp: 'KLG 4/14/2021 17:07:36'!
defaultFileBundleConstructor
"Answer the symboi to send to FileBundles found by me."
^ #forLicense! !
!(Modules>>#FileFinder>>#LicenseFileFinder) class methodsFor: 'distribution' stamp: 'KLG 4/14/2021 17:32:24'!
distributionRootName
"Answer the name of the distribution root directory.
Note: Will be used a decorative string in a text"
^ '...'! !
!(Modules>>#FileFinder>>#PackageFileFinder) methodsFor: 'finding' stamp: 'KLG 4/9/2021 16:16:57'!
extensionToFind
"Answer the extenstion to look for."
^ 'pck.st'! !
!(Modules>>#FileFinder>>#PackageFileFinder) methodsFor: 'finding' stamp: 'KLG 4/12/2021 23:02:07'!
nicePathComponents: somePathComponents
"Create path components with a nicer names."
somePathComponents first
caseOf: {
[ 'Public-HaverOnCuis' ] -> [ somePathComponents at: 1 put: 'Haver' ].
[ 'Cuis-Smalltalk' ] -> [ somePathComponents at: 1 put: 'Cuis' ] .
[ 'gitwork' ] -> [ somePathComponents at: 1 put: 'ThirdParty' ] }
otherwise: [ ].
^ somePathComponents
! !
!(Modules>>#FileFinder>>#PackageFileFinder) methodsFor: 'finding' stamp: 'KLG 4/12/2021 22:35:54'!
rootSizeForDistributionName: aRootSize
"Answer the number root path components to consider in a directory found"
^ aRootSize - 1! !
!(Modules>>#FileFinder>>#PackageFileFinder) methodsFor: 'defaults' stamp: 'KLG 4/21/2022 13:45:39'!
cuisDistributationDirectories
"Answer the cuis distribution directories."
^ 'Cuis-Smalltalk-Dev Cuis-Smalltalk-UI SVG EnhancedText Erudite StyledTextEditor Measures Calendars CodeExamples Games Morphic Cairo OSProcess Numerics GeographicInformationSystems Parsers Machine-Learning AMQP firmata VMMaker Learning-Cuis TheCuisBook'
findTokens: Character space! !
!(Modules>>#FileFinder>>#PackageFileFinder) methodsFor: 'defaults' stamp: 'KLG 9/23/2021 20:55:07'!
haverDistributationDirectories
"Answer the haver directories."
^ #('haver' 'environments' 'klg-packages')! !
!(Modules>>#FileFinder>>#PackageFileFinder) methodsFor: 'accessing' stamp: 'KLG 4/10/2021 22:01:11'!
cuisRoot: aCuisRootEntry andHaverRoot: aHaverRootEntry
"Set the directory entries to all known git repos."
rootDirectories _ OrderedCollection new.
fileBundleConstructors _ OrderedCollection new.
self cuisDistributationDirectories do: [ :entry |
aCuisRootEntry asDirectoryEntry / entry ifExists: [ :fullEntry |
fileBundleConstructors add: #forCuisPackage.
rootDirectories add: fullEntry ] ].
self haverDistributationDirectories do: [ :entry |
aHaverRootEntry asDirectoryEntry / entry ifExists: [ :fullEntry |
fileBundleConstructors add: #forHaverPackage.
rootDirectories add: fullEntry ] ].
self
changed: #roots;
changed: #filenames
! !
!(Modules>>#FileFinder>>#PackageFileFinder) class methodsFor: 'instance creation' stamp: 'KLG 4/11/2021 19:59:41'!
defaultFileBundleConstructor
"Answer the symboi to send to FileBundles found by me.
We default to haver packages."
^ #forHaverPackage! !
!(Modules>>#FileFinder>>#PackageFileFinder) class methodsFor: 'distribution' stamp: 'KLG 4/9/2021 21:39:32'!
distributionRootName
"Answer the name of the distribution root directory."
^ 'Packages'! !
!(Modules>>#FileFinder>>#TrueTypeFontFileFinder) methodsFor: 'finding' stamp: 'KLG 4/13/2021 21:57:01'!
extensionToFind
"Answer the extension for true type font files."
^ 'ttf'! !
!(Modules>>#FileFinder>>#TrueTypeFontFileFinder) class methodsFor: 'instance creation' stamp: 'KLG 4/13/2021 21:46:19'!
defaultFileBundleConstructor
"Answer the symboi to send to FileBundles found by me."
^ #forTrueTypeFont! !
!(Modules>>#FileFinder>>#TrueTypeFontFileFinder) class methodsFor: 'distribution' stamp: 'KLG 4/13/2021 21:47:01'!
distributionRootName
"Answer the name of the distribution root directory."
^ 'Image' ": We need it there"! !
!(Modules>>#FileFinder>>#LiveImageFileFinder) methodsFor: 'finding' stamp: 'KLG 4/8/2022 22:24:47'!
bundlesDo: aBlock
"Evaluate a block for each with a file bundle constructed from the files found."
| imageFileEntry |
aBlock value: (
FileBundle forImage
sourceFilename: (imageFileEntry _ Smalltalk imageName asFileEntry) pathName
distributionFilename: (self distributionNameFor: imageFileEntry name) )
! !
!(Modules>>#FileFinder>>#LiveImageFileFinder) class methodsFor: 'distribution' stamp: 'KLG 4/9/2021 21:39:53'!
distributionRootName
"Answer the name of the distribution root directory."
^ 'Image'! !
!(Modules>>#FileFinder>>#LiveSourceFileFinder) methodsFor: 'finding' stamp: 'KLG 4/8/2022 22:24:30'!
bundlesDo: aBlock
"Evaluate a block for each with a file bundle constructed from the files found."
SourceFiles do: [ :fileStream | | filename |
aBlock value:
(FileBundle forSourceFile
sourceFilename: (filename _ fileStream name)
distributionFilename: (self distributionNameFor: filename asFileEntry name)) ]! !
!(Modules>>#FileFinder>>#LiveSourceFileFinder) class methodsFor: 'distribution' stamp: 'KLG 4/9/2021 21:40:12'!
distributionRootName
"Answer the name of the distribution root directory."
^ 'Image'! !
!(Modules>>#FileFinder>>#LiveCompressedSourceFileFinder) methodsFor: 'finding' stamp: 'KLG 4/11/2021 18:42:41'!
bundlesDo: aBlock
"Evaluate a block for each with a file bundel constructed from the files found."
super bundlesDo: [ :fileBundle |
aBlock value: fileBundle.
"The first one is the compressed sources file"
^ self ]! !
!(Modules>>#FileFinder>>#LiveVMFileFinder) methodsFor: 'finding' stamp: 'KLG 4/10/2021 21:39:40'!
bundlesDo: aBlock
"Evaluate a block for each with a file bundel constructed from the files found."
| vmFileEntry |
aBlock value:
(FileBundle forVM
sourceFilename: (vmFileEntry _ Smalltalk vmFileName asFileEntry) pathName
distributionFilename: (self distributionNameFor: vmFileEntry name) ).
self fileEntriesWithExtension: self sharedObjectExtension :: do: [ :fileEntry |
aBlock value:
(FileBundle forVMSharedObject
sourceFilename: fileEntry pathName
distributionFilename: (self distributionNameFor: fileEntry name) ) ]! !
!(Modules>>#FileFinder>>#LiveVMFileFinder) methodsFor: 'finding' stamp: 'KLG 4/10/2021 10:31:39'!
fileEntriesWithExtension: anExtension
"Answer the files in the vm directory that have anExtension."
^ DirectoryEntry vmDirectory filesMatches: [ :fileEntry |
fileEntry extension = anExtension ]! !
!(Modules>>#FileFinder>>#LiveVMFileFinder) methodsFor: 'finding' stamp: 'KLG 4/26/2021 11:53:00'!
sharedObjectExtension
"Answer the extension for shared objects."
self flagHaver: 'TODO: Implement for other platforms..'.
^ Smalltalk platformName caseOf: {
[ 'unix' ] -> [ 'so' ].
[ 'Win32' ] -> [ 'dll' ] }! !
!(Modules>>#FileFinder>>#LiveVMFileFinder) class methodsFor: 'distribution' stamp: 'KLG 4/9/2021 21:40:25'!
distributionRootName
"Answer the name of the distribution root directory."
^ 'VM'! !
!(Modules>>#FileFinder>>#ComplexFileFinder) methodsFor: 'accessing' stamp: 'KLG 4/11/2021 20:36:36'!
changeSetFileFinder
"Answer the value of chnage ste filefinder"
^ changeSetFileFinder ifNil: [ changeSetFileFinder _ fileFinders add: self changeSetFileFinderClass new ]! !
!(Modules>>#FileFinder>>#ComplexFileFinder) methodsFor: 'accessing' stamp: 'KLG 4/11/2021 20:36:58'!
compressedSourceFileFinder
"Answer the source file finder."
^ compressedSourceFileFinder ifNil: [ compressedSourceFileFinder _ fileFinders add: self compressedSourceFileFinderClass new ]! !
!(Modules>>#FileFinder>>#ComplexFileFinder) methodsFor: 'accessing' stamp: 'KLG 4/11/2021 20:37:17'!
cuisChangesFileFinder
"Answer the value of cuisChangesFileFinder"
^ cuisChangesFileFinder ifNil: [ cuisChangesFileFinder _ fileFinders add: self cuisChangesFileFinderClass new ]! !
!(Modules>>#FileFinder>>#ComplexFileFinder) methodsFor: 'accessing' stamp: 'KLG 4/11/2021 20:37:36'!
cuisImageFileFinder
"Answer the value of cuisImageFileFinder"
^ cuisImageFileFinder ifNil: [ cuisImageFileFinder _ fileFinders add: self cuisImageFileFinderClass new ]! !
!(Modules>>#FileFinder>>#ComplexFileFinder) methodsFor: 'accessing' stamp: 'KLG 4/28/2021 19:39:04'!
cuisRoot: aCuisRootEntry andHaverRoot: aHaverRootEntry andEnvironmentsCoreChanges: aCoreChangesRoot
"Set the various root directories."
| cuisDevelopmentDirectory haverImageDirectory |
cuisDevelopmentDirectory _ aCuisRootEntry asDirectoryEntry / 'Cuis-Smalltalk-Dev'.
haverImageDirectory _ aHaverRootEntry asDirectoryEntry / 'image'.
self packageFileFinder cuisRoot: aCuisRootEntry andHaverRoot: aHaverRootEntry.
self changeSetFileFinder addRoot: aCoreChangesRoot.
self haverImageFileFinder addRoot: haverImageDirectory .
self haverChangesFileFinder addRoot: haverImageDirectory.
self cuisUpdatesFileFinder
addRoot: cuisDevelopmentDirectory;
distributionRootName: 'Image'.
self cuisImageFileFinder addRoot: cuisDevelopmentDirectory.
self cuisChangesFileFinder addRoot: cuisDevelopmentDirectory.
self trueTypeFontFileFinder addRoot: cuisDevelopmentDirectory .
self licenseFileFinder addRoot: aCuisRootEntry.
self documentationFileFinder
addRoot: aCuisRootEntry;
addRoot: aHaverRootEntry asDirectoryEntry / 'documentation'! !
!(Modules>>#FileFinder>>#ComplexFileFinder) methodsFor: 'accessing' stamp: 'KLG 4/15/2021 21:55:55'!
cuisUpdatesFileFinder
"Answer the value of cuisUpdatesFileFinder"
^ cuisUpdatesFileFinder ifNil: [ cuisUpdatesFileFinder _ fileFinders add: self changeSetFileFinderClass new ]! !
!(Modules>>#FileFinder>>#ComplexFileFinder) methodsFor: 'accessing' stamp: 'KLG 4/28/2021 14:33:17'!
documentationFileFinder
"Answer the documentation file finder instance."
^ documentationFileFinder ifNil: [ documentationFileFinder _ fileFinders add: self documentationFileFinderClass new ]! !
!(Modules>>#FileFinder>>#ComplexFileFinder) methodsFor: 'accessing' stamp: 'KLG 4/11/2021 19:46:24'!
fileFinders
"Answer the value of fileFinders"
^ fileFinders! !
!(Modules>>#FileFinder>>#ComplexFileFinder) methodsFor: 'accessing' stamp: 'KLG 4/15/2021 21:43:31'!
haverChangesFileFinder
"Answer the value of haverChangesFileFinder"
^ haverChangesFileFinder ifNil: [ haverChangesFileFinder _ fileFinders add: self changesFileFinderClass new ]! !
!(Modules>>#FileFinder>>#ComplexFileFinder) methodsFor: 'accessing' stamp: 'KLG 4/11/2021 20:38:02'!
haverImageFileFinder
"Answer the value of haverImageFileFinder"
^ haverImageFileFinder ifNil: [ haverImageFileFinder _ fileFinders add: self haverImageFileFinderClass new ]! !
!(Modules>>#FileFinder>>#ComplexFileFinder) methodsFor: 'accessing' stamp: 'KLG 4/14/2021 16:46:35'!
licenseFileFinder
"Answer the value the license file finder"
^ licenseFileFinder ifNil: [ licenseFileFinder _ fileFinders add: self licenseFileFinderClass new ]! !
!(Modules>>#FileFinder>>#ComplexFileFinder) methodsFor: 'accessing' stamp: 'KLG 4/11/2021 20:38:22'!
packageFileFinder
"Answer the value of packageFileFinder"
^ packageFileFinder ifNil: [ packageFileFinder _ fileFinders add: self packageFileFinderClass new ]! !
!(Modules>>#FileFinder>>#ComplexFileFinder) methodsFor: 'accessing' stamp: 'KLG 4/13/2021 21:49:04'!
trueTypeFontFileFinder
"Answer the value of trueTypeFontFileFinder"
^ trueTypeFontFileFinder ifNil: [ trueTypeFontFileFinder _ fileFinders add: self trueTypeFontFileFinderClass new ]! !
!(Modules>>#FileFinder>>#ComplexFileFinder) methodsFor: 'accessing' stamp: 'KLG 4/11/2021 20:38:40'!
vmFileFinder
"Answer the value of vmFileFinder"
^ vmFileFinder ifNil: [ vmFileFinder _ fileFinders add: self vmFileFinderClass new ]! !
!(Modules>>#FileFinder>>#ComplexFileFinder) methodsFor: 'instance creation' stamp: 'KLG 4/9/2021 18:55:32'!
changeSetFileFinderClass
"Answer the change set file finder class."
^ self class changeSetFileFinderClass
! !
!(Modules>>#FileFinder>>#ComplexFileFinder) methodsFor: 'instance creation' stamp: 'KLG 4/15/2021 21:43:31'!
changesFileFinderClass
"Answer the image file finder class for haver chnages."
^ self class changesFileFinderClass! !
!(Modules>>#FileFinder>>#ComplexFileFinder) methodsFor: 'instance creation' stamp: 'KLG 4/11/2021 19:32:01'!
compressedSourceFileFinderClass
"Answer the class for of the source file finder."
^ self class compressedSourceFileFinderClass! !
!(Modules>>#FileFinder>>#ComplexFileFinder) methodsFor: 'instance creation' stamp: 'KLG 4/11/2021 19:51:15'!
cuisChangesFileFinderClass
"Answer the changes file finder class for Cuis images."
^ self class cuisChangesFileFinderClass! !
!(Modules>>#FileFinder>>#ComplexFileFinder) methodsFor: 'instance creation' stamp: 'KLG 4/11/2021 19:36:41'!
cuisImageFileFinderClass
"Answer the image file finder class for Cuis images."
^ self class cuisImageFileFinderClass! !
!(Modules>>#FileFinder>>#ComplexFileFinder) methodsFor: 'instance creation' stamp: 'KLG 4/28/2021 14:33:17'!
documentationFileFinderClass
"Answer the documentation file finder class."
^ self class documentationFileFinderClass
! !
!(Modules>>#FileFinder>>#ComplexFileFinder) methodsFor: 'instance creation' stamp: 'KLG 4/11/2021 19:36:05'!
haverImageFileFinderClass
"Answer the image file finder class for haver images."
^ self class haverImageFileFinderClass! !
!(Modules>>#FileFinder>>#ComplexFileFinder) methodsFor: 'instance creation' stamp: 'KLG 4/14/2021 16:47:24'!
licenseFileFinderClass
"Answer the license file finder class."
^ self class licenseFileFinderClass
! !
!(Modules>>#FileFinder>>#ComplexFileFinder) methodsFor: 'instance creation' stamp: 'KLG 4/9/2021 11:43:37'!
packageFileFinderClass
"Answer the package file finder class."
^ self class packageFileFinderClass! !
!(Modules>>#FileFinder>>#ComplexFileFinder) methodsFor: 'instance creation' stamp: 'KLG 4/13/2021 21:49:42'!
trueTypeFontFileFinderClass
"Answer the true type font file finder class."
^ self class trueTypeFontFileFinderClass
! !
!(Modules>>#FileFinder>>#ComplexFileFinder) methodsFor: 'instance creation' stamp: 'KLG 4/9/2021 11:44:07'!
vmFileFinderClass
"Answer the VM file finder class."
^ self class vmFileFinderClass! !
!(Modules>>#FileFinder>>#ComplexFileFinder) methodsFor: 'finding' stamp: 'KLG 4/11/2021 19:29:20'!
bundlesDo: aBlock
"Evaluate a block for each with a file bundel constructed from the files found."
fileFinders do: [ :finder | finder bundlesDo: aBlock ]
! !
!(Modules>>#FileFinder>>#ComplexFileFinder) methodsFor: 'initialization' stamp: 'KLG 4/11/2021 20:49:54'!
initialize
"Initialize the collection of file findes."
super initialize.
fileFinders _ OrderedCollection new.
"Create the source and the VM filke finders"
self
compressedSourceFileFinder;
vmFileFinder ! !
!(Modules>>#FileFinder>>#ComplexFileFinder) class methodsFor: 'instance creation' stamp: 'KLG 4/9/2021 18:55:58'!
changeSetFileFinderClass
"Answer the change set file finder class."
^ ChangeSetFileFinder ! !
!(Modules>>#FileFinder>>#ComplexFileFinder) class methodsFor: 'instance creation' stamp: 'KLG 4/15/2021 21:43:31'!
changesFileFinderClass
"Answer the image file finder class. for Haver change files."
^ HaverChangesFileFinder ! !
!(Modules>>#FileFinder>>#ComplexFileFinder) class methodsFor: 'instance creation' stamp: 'KLG 4/11/2021 19:34:28'!
compressedSourceFileFinderClass
"Answer the class for of the source file finder."
^ LiveCompressedSourceFileFinder ! !
!(Modules>>#FileFinder>>#ComplexFileFinder) class methodsFor: 'instance creation' stamp: 'KLG 4/11/2021 19:44:40'!
cuisChangesFileFinderClass
"Answer the image file finder class. for Cuis change files."
^ CuisChangesFileFinder ! !
!(Modules>>#FileFinder>>#ComplexFileFinder) class methodsFor: 'instance creation' stamp: 'KLG 4/11/2021 19:44:50'!
cuisImageFileFinderClass
"Answer the image file finder class. for Cuis images"
^ CuisImageFileFinder ! !
!(Modules>>#FileFinder>>#ComplexFileFinder) class methodsFor: 'instance creation' stamp: 'KLG 4/28/2021 14:33:17'!
documentationFileFinderClass
"Answer the documentation file finder class."
^ DocumentationFileFinder! !
!(Modules>>#FileFinder>>#ComplexFileFinder) class methodsFor: 'instance creation' stamp: 'KLG 4/11/2021 19:45:01'!
haverImageFileFinderClass
"Answer the image file finder class. for Haver images"
^ HaverImageFileFinder ! !
!(Modules>>#FileFinder>>#ComplexFileFinder) class methodsFor: 'instance creation' stamp: 'KLG 4/14/2021 16:47:41'!
licenseFileFinderClass
"Answer the license file finder class."
^ LicenseFileFinder
! !
!(Modules>>#FileFinder>>#ComplexFileFinder) class methodsFor: 'instance creation' stamp: 'KLG 4/9/2021 11:25:10'!
packageFileFinderClass
"Answer the package file finder class."
^ PackageFileFinder! !
!(Modules>>#FileFinder>>#ComplexFileFinder) class methodsFor: 'instance creation' stamp: 'KLG 4/13/2021 21:50:03'!
trueTypeFontFileFinderClass
"Answer the true type font file finder class."
^ TrueTypeFontFileFinder
! !
!(Modules>>#FileFinder>>#ComplexFileFinder) class methodsFor: 'instance creation' stamp: 'KLG 4/11/2021 17:16:03'!
vmFileFinderClass
"Answer the VM file finder class."
^ LiveVMFileFinder ! !
!(Modules>>#FileFinder>>#AbstractFileDescription) methodsFor: 'testing' stamp: 'KLG 4/10/2021 20:50:01'!
isChangeSet
"Answer true if I describe a change set."
^ false! !
!(Modules>>#FileFinder>>#AbstractFileDescription) methodsFor: 'testing' stamp: 'KLG 4/10/2021 20:50:40'!
isCuisPackagePackage
"Answer true if I describe a package that belongs to Cuis."
^ false! !
!(Modules>>#FileFinder>>#AbstractFileDescription) methodsFor: 'testing' stamp: 'KLG 4/28/2021 14:27:13'!
isDocumentationFile
"Answer true if I describe a documentation file."
^ false! !
!(Modules>>#FileFinder>>#AbstractFileDescription) methodsFor: 'testing' stamp: 'KLG 4/10/2021 20:50:50'!
isHaverPackagePackage
"Answer true if I describe a package that belongs to Haver."
^ false! !
!(Modules>>#FileFinder>>#AbstractFileDescription) methodsFor: 'testing' stamp: 'KLG 4/10/2021 20:46:08'!
isImage
"Answer true if I describe an image file."
^ false! !
!(Modules>>#FileFinder>>#AbstractFileDescription) methodsFor: 'testing' stamp: 'KLG 4/14/2021 16:30:37'!
isLicenseFile
"Answer true if I describe a licensefile."
^ false! !
!(Modules>>#FileFinder>>#AbstractFileDescription) methodsFor: 'testing' stamp: 'KLG 4/10/2021 20:49:53'!
isPackage
"Answer true if I describe a package."
^ false! !
!(Modules>>#FileFinder>>#AbstractFileDescription) methodsFor: 'testing' stamp: 'KLG 4/10/2021 21:01:50'!
isSourceCodeFile
"Answer true if I describe a file that contains source code such as a change ste or a package."
^ false! !
!(Modules>>#FileFinder>>#AbstractFileDescription) methodsFor: 'testing' stamp: 'KLG 4/10/2021 20:51:39'!
isSourceFile
"Answer true if I describe the sources or the changes file."
^ false! !
!(Modules>>#FileFinder>>#AbstractFileDescription) methodsFor: 'testing' stamp: 'KLG 4/14/2021 16:28:12'!
isTextFile
"Answer true if I describe a text file."
^ false! !
!(Modules>>#FileFinder>>#AbstractFileDescription) methodsFor: 'testing' stamp: 'KLG 4/10/2021 20:47:58'!
isVM
"Answer true if I describe the virtual machine executable."
^ false! !
!(Modules>>#FileFinder>>#AbstractFileDescription) methodsFor: 'testing' stamp: 'KLG 4/10/2021 20:58:33'!
isVMPart
"Answer true if I describe a part of the virtual machine."
^ false! !
!(Modules>>#FileFinder>>#AbstractFileDescription) methodsFor: 'testing' stamp: 'KLG 4/10/2021 20:48:43'!
isVMSharedObject
"Answer true if I describe a shared object oif thevirtual machine."
^ false! !
!(Modules>>#FileFinder>>#AbstractFileDescription) class methodsFor: 'singleton' stamp: 'KLG 4/10/2021 21:13:46'!
uniqueInstance
"Answer my unique instance."
^ uniqueInstance ifNil: [ uniqueInstance _ self new ]! !
!(Modules>>#FileFinder>>#AbstractPackageDescription) methodsFor: 'testing' stamp: 'KLG 4/10/2021 20:56:22'!
isPackage
"Answer true if I describe a package."
^ true! !
!(Modules>>#FileFinder>>#CuisPackageDescription) methodsFor: 'testing' stamp: 'KLG 4/10/2021 20:57:49'!
isCuisPackagePackage
"Answer true if I describe a package that belongs to Cuis."
^ true! !
!(Modules>>#FileFinder>>#HaverPackageDescription) methodsFor: 'testing' stamp: 'KLG 4/10/2021 20:57:08'!
isHaverPackagePackage
"Answer true if I describe a package that belongs to Haver."
^ true! !
!(Modules>>#FileFinder>>#ChangeSetDescription) methodsFor: 'testing' stamp: 'KLG 4/10/2021 20:55:31'!
isChangeSet
"Answer true if I describe a change set."
^ true! !
!(Modules>>#FileFinder>>#AbstractVMPartDescription) methodsFor: 'testing' stamp: 'KLG 4/10/2021 20:59:17'!
isVMPart
"Answer true if I describe a part of the virtual machine."
^ true! !
!(Modules>>#FileFinder>>#VMDescription) methodsFor: 'testing' stamp: 'KLG 4/10/2021 20:53:59'!
isVM
"Answer true if I describe the virtual machine executable."
^ true! !
!(Modules>>#FileFinder>>#VMSharedObjectDescription) methodsFor: 'testing' stamp: 'KLG 4/10/2021 21:00:53'!
isVMSharedObject
"Answer true if I describe a shared object oif thevirtual machine."
^ true! !
!(Modules>>#FileFinder>>#DocumentationFileDescription) methodsFor: 'testing' stamp: 'KLG 4/28/2021 14:27:29'!
isDocumentationFile
"Answer true if I describe a documentation file."
^ true! !
!(Modules>>#FileFinder>>#ImageFileDescription) methodsFor: 'testing' stamp: 'KLG 4/10/2021 21:23:37'!
isImage
"Answer true if I describe an image file."
^ true! !
!(Modules>>#FileFinder>>#SourceFileDescription) methodsFor: 'testing' stamp: 'KLG 4/10/2021 20:52:58'!
isSourceFile
"Answer true if I describe the sources or the changes file."
^ true! !
!(Modules>>#FileFinder>>#TextFileDescription) methodsFor: 'testing' stamp: 'KLG 4/14/2021 16:28:32'!
isTextFile
"Answer true if I describe a text file."
^ true! !
!(Modules>>#FileFinder>>#LicenseFileDescription) methodsFor: 'testing' stamp: 'KLG 4/14/2021 17:30:06'!
isLicenseFile
"Answer true if I describe a licensefile."
^ true! !
!(Modules>>#FileFinder>>#FileBundle) methodsFor: 'accessing' stamp: 'KLG 4/10/2021 20:43:04'!
description
"Answer the value of description"
^ description! !
!(Modules>>#FileFinder>>#FileBundle) methodsFor: 'accessing' stamp: 'KLG 4/10/2021 20:43:04'!
description: anObject
"Set the value of description"
description _ anObject! !
!(Modules>>#FileFinder>>#FileBundle) methodsFor: 'accessing' stamp: 'KLG 4/10/2021 20:43:04'!
distributionFilename
"Answer the value of distributionFilename"
^ distributionFilename! !
!(Modules>>#FileFinder>>#FileBundle) methodsFor: 'accessing' stamp: 'KLG 4/10/2021 20:43:04'!
distributionFilename: anObject
"Set the value of distributionFilename"
distributionFilename _ anObject! !
!(Modules>>#FileFinder>>#FileBundle) methodsFor: 'accessing' stamp: 'KLG 4/10/2021 20:43:04'!
sourceFilename
"Answer the value of sourceFilename"
^ sourceFilename! !
!(Modules>>#FileFinder>>#FileBundle) methodsFor: 'accessing' stamp: 'KLG 4/10/2021 20:43:04'!
sourceFilename: anObject
"Set the value of sourceFilename"
sourceFilename _ anObject! !
!(Modules>>#FileFinder>>#FileBundle) methodsFor: 'accessing' stamp: 'KLG 4/10/2021 21:27:07'!
sourceFilename: aSourceFilename distributionFilename: aDistributionFilename
"Set both filenames."
self
sourceFilename: aSourceFilename;
distributionFilename: aDistributionFilename ! !
!(Modules>>#FileFinder>>#FileBundle) methodsFor: 'testing' stamp: 'KLG 4/11/2021 17:18:31'!
isChangeSet
"Answer true if I describe a change set."
^ self description isChangeSet ! !
!(Modules>>#FileFinder>>#FileBundle) methodsFor: 'testing' stamp: 'KLG 4/11/2021 17:18:53'!
isCuisPackagePackage
"Answer true if I describe a package that belongs to Cuis."
^ self description isCuisPackagePackage! !
!(Modules>>#FileFinder>>#FileBundle) methodsFor: 'testing' stamp: 'KLG 4/28/2021 14:28:20'!
isDocumentationFile
"Answer true if I describe a documentation file."
^ self description isDocumentationFile! !
!(Modules>>#FileFinder>>#FileBundle) methodsFor: 'testing' stamp: 'KLG 4/11/2021 17:19:58'!
isHaverPackagePackage
"Answer true if I describe a package that belongs to Haver."
^ self description isHaverPackagePackage! !
!(Modules>>#FileFinder>>#FileBundle) methodsFor: 'testing' stamp: 'KLG 4/11/2021 17:20:15'!
isImage
"Answer true if I describe an image file."
^ self description isImage! !
!(Modules>>#FileFinder>>#FileBundle) methodsFor: 'testing' stamp: 'KLG 4/14/2021 17:10:31'!
isLicenseFile
"Answer true if I describe a license file"
^ self description isLicenseFile! !
!(Modules>>#FileFinder>>#FileBundle) methodsFor: 'testing' stamp: 'KLG 4/11/2021 17:20:34'!
isPackage
"Answer true if I describe a package."
^ self description isPackage! !
!(Modules>>#FileFinder>>#FileBundle) methodsFor: 'testing' stamp: 'KLG 4/11/2021 17:20:55'!
isSourceCodeFile
"Answer true if I describe a file that contains source code such as a change ste or a package."
^ self description isSourceCodeFile! !
!(Modules>>#FileFinder>>#FileBundle) methodsFor: 'testing' stamp: 'KLG 4/11/2021 17:21:18'!
isSourceFile
"Answer true if I describe the sources or the changes file."
^ self description isSourceFile ! !
!(Modules>>#FileFinder>>#FileBundle) methodsFor: 'testing' stamp: 'KLG 4/11/2021 17:21:36'!
isVM
"Answer true if I describe the virtual machine executable."
^ self description isVM! !
!(Modules>>#FileFinder>>#FileBundle) methodsFor: 'testing' stamp: 'KLG 4/11/2021 17:21:56'!
isVMPart
"Answer true if I describe a part of the virtual machine."
^ self description isVMPart ! !
!(Modules>>#FileFinder>>#FileBundle) methodsFor: 'testing' stamp: 'KLG 4/11/2021 17:22:15'!
isVMSharedObject
"Answer true if I describe a shared object oif thevirtual machine."
^ self description isVMSharedObject ! !
!(Modules>>#FileFinder>>#FileBundle) class methodsFor: 'instance creation' stamp: 'KLG 4/10/2021 21:12:39'!
forChangeSet
"Answer a file bundle for a change set."
^ self new description: ChangeSetDescription uniqueInstance ! !
!(Modules>>#FileFinder>>#FileBundle) class methodsFor: 'instance creation' stamp: 'KLG 4/10/2021 21:18:12'!
forCuisPackage
"Answer a file bundle for a Cuis package."
^ self new description: CuisPackageDescription uniqueInstance ! !
!(Modules>>#FileFinder>>#FileBundle) class methodsFor: 'instance creation' stamp: 'KLG 4/28/2021 14:29:22'!
forDocumentation
"Answer a file bundle for documentation."
^ self new description: DocumentationFileDescription uniqueInstance ! !
!(Modules>>#FileFinder>>#FileBundle) class methodsFor: 'instance creation' stamp: 'KLG 4/10/2021 21:15:11'!
forHaverPackage
"Answer a file bundle for a haver package."
^ self new description: HaverPackageDescription uniqueInstance ! !
!(Modules>>#FileFinder>>#FileBundle) class methodsFor: 'instance creation' stamp: 'KLG 4/10/2021 21:25:10'!
forImage
"Answer a file bundle for a n image."
^ self new description: ImageFileDescription uniqueInstance ! !
!(Modules>>#FileFinder>>#FileBundle) class methodsFor: 'instance creation' stamp: 'KLG 4/14/2021 17:06:45'!
forLicense
"Answer a file bundle for a a license file font."
^ self new description: LicenseFileDescription uniqueInstance ! !
!(Modules>>#FileFinder>>#FileBundle) class methodsFor: 'instance creation' stamp: 'KLG 4/10/2021 21:22:52'!
forSourceFile
"Answer a file bundle for a source file."
^ self new description: SourceFileDescription uniqueInstance ! !
!(Modules>>#FileFinder>>#FileBundle) class methodsFor: 'instance creation' stamp: 'KLG 4/13/2021 21:45:09'!
forTrueTypeFont
"Answer a file bundle for a a truetype font."
^ self new description: TrueTypeFontDescription uniqueInstance ! !
!(Modules>>#FileFinder>>#FileBundle) class methodsFor: 'instance creation' stamp: 'KLG 4/10/2021 21:20:47'!
forVM
"Answer a file bundle for a VM executable."
^ self new description: VMDescription uniqueInstance ! !
!(Modules>>#FileFinder>>#FileBundle) class methodsFor: 'instance creation' stamp: 'KLG 4/10/2021 21:21:54'!
forVMSharedObject
"Answer a file bundle for a VM shared object."
^ self new description: VMSharedObjectDescription uniqueInstance ! !