Squeak 4.6: PackageInfo-Base-nice.68.mcz

Chris Muller uploaded a new version of PackageInfo-Base to project Squeak 4.6:
http://source.squeak.org/squeak46/PackageInfo-Base-nice.68.mcz

==================== Summary ====================

Name: PackageInfo-Base-nice.68
Author: nice
Time: 17 December 2013, 11:49:21.474 pm
UUID: b6669527-9a35-4783-a64f-8f2af97e330b
Ancestors: PackageInfo-Base-fbs.67

No need to check if some class selectors are doIt because doIt are no longer installed in method dictionaries.

==================== Snapshot ====================

(PackageInfo named: 'PackageInfo-Base') preamble: '"below, add code to be run before the loading of this package"
PackageOrganizer default
        unregisterPackageNamed: ''PackageInfo'';
        unregisterPackageNamed: ''ToolBuilder'';
        unregisterPackageNamed: ''Morphic-TrueType'''!

SystemOrganization addCategory: #'PackageInfo-Base'!

----- Method: String>>escapeEntities (in category '*packageinfo-base') -----
escapeEntities
        ^ self species streamContents: [:s | self do: [:c | s nextPutAll: c escapeEntities]]
!

----- Method: Character>>escapeEntities (in category '*packageinfo-base') -----
escapeEntities
        #($< '&lt;' $> '&gt;' $& '&amp;') pairsDo:
                [:k :v |
                self = k ifTrue: [^ v]].
        ^ String with: self!

Object subclass: #PackageInfo
        instanceVariableNames: 'packageName methodCategoryPrefix preamble postscript preambleOfRemoval postscriptOfRemoval'
        classVariableNames: ''
        poolDictionaries: ''
        category: 'PackageInfo-Base'!
PackageInfo class
        instanceVariableNames: 'default'!

!PackageInfo commentStamp: 'bf 7/28/2012 14:11' prior: 0!
PackageInfo is used by the system to figure out which classes and methods belong to which package. By default, class categories and method categories are matched against my packageName, but subclasses could override this behavior.

For an interesting use of PackageInfo subclasses have a look at OMeta2. It presents the same code base as two different packages, one using decompiled code for bootstrapping, the other using the actual OMeta syntax.!
PackageInfo class
        instanceVariableNames: 'default'!

----- Method: PackageInfo class>>allPackages (in category 'packages access') -----
allPackages
        ^PackageOrganizer default packages!

----- Method: PackageInfo class>>default (in category 'compatibility') -----
default
        ^ self allPackages detect: [:ea | ea class = self] ifNone: [self new register]!

----- Method: PackageInfo class>>initialize (in category 'class initialization') -----
initialize
        self allSubclassesDo: [:ea | ea new register]!

----- Method: PackageInfo class>>named: (in category 'packages access') -----
named: aString
        ^ PackageOrganizer default packageNamed: aString ifAbsent: [(self new packageName: aString) register]!

----- Method: PackageInfo class>>registerPackage: (in category 'registration / unregistration') -----
registerPackage: aString
        "for compatibility with old fileOuts"
        ^ Smalltalk at: #FilePackageManager ifPresent: [:p | p registerPackage: aString]!

----- Method: PackageInfo class>>registerPackageName: (in category 'registration / unregistration') -----
registerPackageName: aString
        ^ PackageOrganizer default registerPackageNamed: aString!

----- Method: PackageInfo>>= (in category 'comparing') -----
= other
        ^ other species = self species and: [other packageName = self packageName]!

----- Method: PackageInfo>>actualMethodsDo: (in category 'enumerating') -----
actualMethodsDo: aBlock
        "Evaluate aBlock with the actual method objects in this package."
        | enum |
        self extensionMethods do:
                [:mr|
                aBlock value: mr compiledMethod].
        enum := [:behavior|
                        behavior organization categories do:
                                [:cat|
                                (self isForeignClassExtension: cat) ifFalse:
                                        [(behavior organization listAtCategoryNamed: cat) do:
                                                [:s|
                                                aBlock value: (behavior compiledMethodAt: s)]]]].
        self classes do:
                [:c| enum value: c; value: c classSide]
                !

----- Method: PackageInfo>>addCoreMethod: (in category 'modifying') -----
addCoreMethod: aMethodReference
        | category |
        category := self baseCategoryOfMethod: aMethodReference.
        aMethodReference actualClass organization
                classify: aMethodReference methodSymbol
                under: category
                suppressIfDefault: false!

----- Method: PackageInfo>>addExtensionMethod: (in category 'modifying') -----
addExtensionMethod: aMethodReference
        | category |
        category := self baseCategoryOfMethod: aMethodReference.
        aMethodReference actualClass organization
                classify: aMethodReference methodSymbol
                under: self methodCategoryPrefix, '-', category!

----- Method: PackageInfo>>addMethod: (in category 'modifying') -----
addMethod: aMethodReference
        (self includesClass: aMethodReference class)
                ifTrue: [self addCoreMethod: aMethodReference]
                ifFalse: [self addExtensionMethod: aMethodReference]!

----- Method: PackageInfo>>allOverriddenMethods (in category 'listing') -----
allOverriddenMethods
        "search classes and meta classes"
        ^ Array streamContents: [:stream |
                self allOverriddenMethodsDo: [:each | stream nextPut: each]]
!

----- Method: PackageInfo>>allOverriddenMethodsDo: (in category 'enumerating') -----
allOverriddenMethodsDo: aBlock
        "Evaluates aBlock with all the overridden methods in the system"
        ^ ProtoObject withAllSubclassesDo: [:class |
                self overriddenMethodsInClass: class do: aBlock]
!

----- Method: PackageInfo>>baseCategoryOfMethod: (in category 'modifying') -----
baseCategoryOfMethod: aMethodReference
        | oldCat oldPrefix tokens |
        oldCat := aMethodReference category.
        ({ 'as yet unclassified'. 'all' } includes: oldCat) ifTrue: [ oldCat := '' ].
        tokens := oldCat findTokens: '*-' keep: '*'.

        "Strip off any old prefixes"
        ((tokens at: 1 ifAbsent: [ '' ]) = '*') ifTrue: [
                [ ((tokens at: 1 ifAbsent: [ '' ]) = '*') ]
                        whileTrue: [ tokens removeFirst ].
                oldPrefix := tokens removeFirst asLowercase.
                [ (tokens at: 1 ifAbsent: [ '' ]) asLowercase = oldPrefix ]
                        whileTrue: [ tokens removeFirst ].
        ].

        tokens isEmpty ifTrue: [^ 'as yet unclassified'].
        ^ String streamContents:
                [ :s |
                tokens
                        do: [ :tok | s nextPutAll: tok ]
                        separatedBy: [ s nextPut: $- ]]!

----- Method: PackageInfo>>category:matches: (in category 'testing') -----
category: categoryName matches: prefix
        | prefixSize catSize |
        categoryName ifNil: [ ^false ].
        catSize := categoryName size.
        prefixSize := prefix size.
        catSize < prefixSize ifTrue: [ ^false ].
        (categoryName findString: prefix startingAt: 1 caseSensitive: false) = 1
                ifFalse: [ ^false ].
        ^(categoryName at: prefix size + 1 ifAbsent: [ ^true ]) = $-!

----- Method: PackageInfo>>categoryName (in category 'naming') -----
categoryName
        |category|
        category := self class category.
        ^ (category endsWith: '-Info')
                ifTrue: [category copyUpToLast: $-]
                ifFalse: [category]!

----- Method: PackageInfo>>changeRecordForOverriddenMethod: (in category 'testing') -----
changeRecordForOverriddenMethod: aMethodReference
        self changeRecordsForMethod: aMethodReference do: [:record |
                (self includesMethodCategory: record category
                        ofClass: aMethodReference actualClass)
                                ifTrue: [^record]].
        ^nil!

----- Method: PackageInfo>>changeRecordsForMethod:do: (in category 'enumerating') -----
changeRecordsForMethod: aMethodReference do: aBlock
        "Evaluate aBlock with one ChangeRecord per overriding package, followed by the latest non-override"
        | overridingPackages method position sourceFilesCopy |
        overridingPackages := Set new.
        method := aMethodReference compiledMethod.
        position := method filePosition.
        sourceFilesCopy := SourceFiles collect: [:x | x ifNotNil: [x readOnlyCopy]].
        [ | file prevPos prevFileIndex chunk stamp methodCategory methodPackage tokens |
        method fileIndex = 0 ifTrue: [^ nil].
        file := sourceFilesCopy at: method fileIndex.
        [position notNil & file notNil]
                whileTrue:
                [file position: (0 max: position-150).  "Skip back to before the preamble"
                [file position < (position-1)]  "then pick it up from the front"
                        whileTrue: [chunk := file nextChunk].

                "Preamble is likely a linked method preamble, if we're in
                        a changes file (not the sources file).  Try to parse it
                        for prior source position and file index"
                prevPos := nil.
                stamp := ''.
                (chunk findString: 'methodsFor:' startingAt: 1) > 0
                        ifTrue: [tokens := Scanner new scanTokens: chunk]
                        ifFalse: [tokens := Array new  "ie cant be back ref"].
                ((tokens size between: 7 and: 8)
                        and: [(tokens at: tokens size-5) = #methodsFor:])
                        ifTrue:
                                [(tokens at: tokens size-3) = #stamp:
                                ifTrue: ["New format gives change stamp and unified prior pointer"
                                                stamp := tokens at: tokens size-2.
                                                prevPos := tokens last.
                                                prevFileIndex := sourceFilesCopy fileIndexFromSourcePointer: prevPos.
                                                prevPos := sourceFilesCopy filePositionFromSourcePointer: prevPos]
                                ifFalse: ["Old format gives no stamp; prior pointer in two parts"
                                                prevPos := tokens at: tokens size-2.
                                                prevFileIndex := tokens last].
                                (prevPos = 0 or: [prevFileIndex = 0]) ifTrue: [prevPos := nil]].
                ((tokens size between: 5 and: 6)
                        and: [(tokens at: tokens size-3) = #methodsFor:])
                        ifTrue:
                                [(tokens at: tokens size-1) = #stamp:
                                ifTrue: ["New format gives change stamp and unified prior pointer"
                                                stamp := tokens at: tokens size]].
                methodCategory := tokens after: #methodsFor: ifAbsent: [ClassOrganizer default].
                methodPackage := PackageOrganizer default packageOfMethodCategory: methodCategory ofClass: aMethodReference actualClass ifNone: [#unknown].
                (overridingPackages includes: methodPackage)
                        ifFalse: [aBlock value: (ChangeRecord new
                                file: file position: position type: #method
                                class: aMethodReference classSymbol category: methodCategory
                                meta: aMethodReference classIsMeta stamp: stamp)].
                (self isOverrideCategory: methodCategory)
                        ifTrue: [overridingPackages add: methodPackage]
                        ifFalse: [(overridingPackages includes: methodPackage)
                                ifFalse: [^nil]].
                position := prevPos.
                prevPos notNil ifTrue:
                        [file := sourceFilesCopy at: prevFileIndex]].
                ^nil]
                        ensure: [sourceFilesCopy do: [:x | x ifNotNil: [x close]]]
        !

----- Method: PackageInfo>>classes (in category 'listing') -----
classes
        ^(self systemCategories gather:
                [:cat |
                (SystemOrganization listAtCategoryNamed: cat)
                        collect: [:className | Smalltalk at: className]])
                                sortBy: [:a :b | a className <= b className]!

----- Method: PackageInfo>>classesAndMetaClasses (in category 'listing') -----
classesAndMetaClasses
        "Return a Set with all classes and metaclasses belonging to this package"

        | baseClasses result |
        baseClasses := self classes.
        result := (Set new: baseClasses size * 2)
                addAll: baseClasses;
                yourself.
        baseClasses do: [ :c |
                result add: c classSide].
        ^result
!

----- Method: PackageInfo>>coreCategoriesForClass: (in category 'testing') -----
coreCategoriesForClass: aClass
        ^ aClass organization categories select: [:cat | (self isForeignClassExtension: cat) not]!

----- Method: PackageInfo>>coreMethods (in category 'listing') -----
coreMethods
        ^ self classesAndMetaClasses gather: [:class | self coreMethodsForClass: class]!

----- Method: PackageInfo>>coreMethodsForClass: (in category 'testing') -----
coreMethodsForClass: aClass
        ^ (aClass selectors difference:
                ((self foreignExtensionMethodsForClass: aClass) collect: [:r | r methodSymbol]))
                        asArray collect: [:sel | self referenceForMethod: sel ofClass: aClass]!

----- Method: PackageInfo>>extensionCategoriesForClass: (in category 'testing') -----
extensionCategoriesForClass: aClass
        ^ aClass organization categories select: [:cat | self isYourClassExtension: cat]!

----- Method: PackageInfo>>extensionClasses (in category 'listing') -----
extensionClasses
        ^ self externalBehaviors reject: [:classOrTrait | (self extensionCategoriesForClass: classOrTrait) isEmpty]!

----- Method: PackageInfo>>extensionMethods (in category 'listing') -----
extensionMethods
        ^ self externalBehaviors gather: [:classOrTrait | self extensionMethodsForClass: classOrTrait]!

----- Method: PackageInfo>>extensionMethodsForClass: (in category 'testing') -----
extensionMethodsForClass: aClass
        ^ (self extensionCategoriesForClass: aClass)
                gather: [:cat | self methodsInCategory: cat ofClass: aClass ]!

----- Method: PackageInfo>>extensionMethodsFromClasses: (in category 'testing') -----
extensionMethodsFromClasses: classes
        ^classes
                gather: [:class | self extensionMethodsForClass: class]!

----- Method: PackageInfo>>externalBehaviors (in category 'modifying') -----
externalBehaviors
        ^self externalClasses , self externalTraits!

----- Method: PackageInfo>>externalCallers (in category 'dependencies') -----
externalCallers
        ^ self
                externalRefsSelect: [:literal | literal isKindOf: Symbol]
                thenCollect: [:l | l].!

----- Method: PackageInfo>>externalClasses (in category 'dependencies') -----
externalClasses
        | myClasses |
        myClasses := self classesAndMetaClasses.
        ^ Array streamContents:
                [:s |
                ProtoObject withAllSubclassesDo:
                        [:class |
                        (myClasses includes: class) ifFalse: [s nextPut: class]]]!

----- Method: PackageInfo>>externalName (in category 'naming') -----
externalName
        ^ self packageName!

----- Method: PackageInfo>>externalRefsSelect:thenCollect: (in category 'dependencies') -----
externalRefsSelect: selBlock thenCollect: colBlock
        | pkgMethods dependents extMethods otherClasses otherMethods classNames |

        classNames := self classes collect: [:c | c name].
        extMethods := self extensionMethods collect: [:mr | mr methodSymbol].
        otherClasses := self externalClasses difference: self externalSubclasses.
        otherMethods :=  otherClasses gather: [:c | c selectors].
        pkgMethods := self methods asSet collect: [:mr | mr methodSymbol].
        pkgMethods removeAllFoundIn: otherMethods.

        dependents := Set new.
        otherClasses do: [:c |
                c selectorsAndMethodsDo:
                        [:sel :compiled |
                        | refs |
                        (extMethods includes: sel) ifFalse:
                                [refs := compiled literals select: selBlock thenCollect: colBlock.
                                refs do: [:ea |
                                        ((classNames includes: ea) or: [pkgMethods includes: ea])
                                                        ifTrue: [dependents add: (self referenceForMethod: sel ofClass: c) -> ea]]]]].
        ^ dependents!

----- Method: PackageInfo>>externalSubclasses (in category 'dependencies') -----
externalSubclasses
        | pkgClasses subClasses |
        pkgClasses := self classes.
        subClasses := Set new.
        pkgClasses do: [:c | subClasses addAll: (c allSubclasses)].
        ^ subClasses difference: pkgClasses
!

----- Method: PackageInfo>>externalTraits (in category 'modifying') -----
externalTraits
        ^ Array streamContents: [:s |
                | behaviors |
                behaviors := self classesAndMetaClasses.
                Smalltalk allTraits do: [:trait |
                        (behaviors includes: trait) ifFalse: [s nextPut: trait].
                        (behaviors includes: trait classSide) ifFalse: [s nextPut: trait classSide]]]. !

----- Method: PackageInfo>>externalUsers (in category 'dependencies') -----
externalUsers
        ^ self
                externalRefsSelect: [:literal | literal isVariableBinding]
                thenCollect: [:l | l key]!

----- Method: PackageInfo>>foreignClasses (in category 'listing') -----
foreignClasses
        | s |
        s := IdentitySet new.
        self foreignSystemCategories
                do: [:c | (SystemOrganization listAtCategoryNamed: c)
                                do: [:cl |
                                        | cls |
                                        cls := Smalltalk at: cl.
                                        s add: cls;
                                          add: cls class]].
        ^ s!

----- Method: PackageInfo>>foreignExtensionCategoriesForClass: (in category 'testing') -----
foreignExtensionCategoriesForClass: aClass
        ^ aClass organization categories select: [:cat | self isForeignClassExtension: cat]!

----- Method: PackageInfo>>foreignExtensionMethodsForClass: (in category 'testing') -----
foreignExtensionMethodsForClass: aClass
        ^ (self foreignExtensionCategoriesForClass: aClass)
                gather: [:cat | (aClass organization listAtCategoryNamed: cat)
                                                  collect: [:sel | self referenceForMethod: sel ofClass: aClass]]!

----- Method: PackageInfo>>foreignSystemCategories (in category 'listing') -----
foreignSystemCategories
        ^ SystemOrganization categories
                reject: [:cat | self includesSystemCategory: cat] !

----- Method: PackageInfo>>hasPostscript (in category 'preamble/postscript') -----
hasPostscript
        ^ self isScript: postscript not: self postscriptDefault!

----- Method: PackageInfo>>hasPostscriptOfRemoval (in category 'preamble/postscript') -----
hasPostscriptOfRemoval
        ^ self isScript: postscriptOfRemoval not: self postscriptOfRemovalDefault!

----- Method: PackageInfo>>hasPreamble (in category 'preamble/postscript') -----
hasPreamble
        ^ self isScript: preamble not: self preambleDefault!

----- Method: PackageInfo>>hasPreambleOfRemoval (in category 'preamble/postscript') -----
hasPreambleOfRemoval
        ^ self isScript: preambleOfRemoval not: self preambleOfRemovalDefault!

----- Method: PackageInfo>>hash (in category 'comparing') -----
hash
        ^ packageName hash!

----- Method: PackageInfo>>includesChangeRecord: (in category 'testing') -----
includesChangeRecord: aChangeRecord
        ^ aChangeRecord methodClass notNil and:
                [self
                        includesMethodCategory: aChangeRecord category
                        ofClass: aChangeRecord methodClass]!

----- Method: PackageInfo>>includesClass: (in category 'testing') -----
includesClass: aClass
        ^ self includesSystemCategory: aClass category!

----- Method: PackageInfo>>includesClassNamed: (in category 'testing') -----
includesClassNamed: aClassName
        ^ self includesSystemCategory: ((SystemOrganization categoryOfElement: aClassName) ifNil: [^false])!

----- Method: PackageInfo>>includesMethod:ofClass: (in category 'testing') -----
includesMethod: aSymbol ofClass: aClass
        aClass ifNil: [^ false].
        ^ self
                includesMethodCategory: ((aClass organization categoryOfElement: aSymbol)
                                                                                ifNil: [' '])
                ofClass: aClass!

----- Method: PackageInfo>>includesMethodCategory:ofClass: (in category 'testing') -----
includesMethodCategory: categoryName ofClass: aClass
        ^ (self isYourClassExtension: categoryName)
                or: [(self includesClass: aClass)
                                and: [(self isForeignClassExtension: categoryName) not]]!

----- Method: PackageInfo>>includesMethodCategory:ofClassNamed: (in category 'testing') -----
includesMethodCategory: categoryName ofClassNamed: aClass
        ^ (self isYourClassExtension: categoryName)
                or: [(self includesClassNamed: aClass)
                                and: [(self isForeignClassExtension: categoryName) not]]!

----- Method: PackageInfo>>includesMethodReference: (in category 'testing') -----
includesMethodReference: aMethodRef
        ^ self includesMethod: aMethodRef methodSymbol ofClass: aMethodRef actualClass!

----- Method: PackageInfo>>includesSystemCategory: (in category 'testing') -----
includesSystemCategory: categoryName
        ^ self category: categoryName matches: self systemCategoryPrefix!

----- Method: PackageInfo>>isForeignClassExtension: (in category 'testing') -----
isForeignClassExtension: categoryName
        ^ categoryName first = $* and: [(self isYourClassExtension: categoryName) not]!

----- Method: PackageInfo>>isOverrideCategory: (in category 'testing') -----
isOverrideCategory: aString
        ^ aString first = $* and: [aString endsWith: '-override']!

----- Method: PackageInfo>>isOverrideMethod: (in category 'testing') -----
isOverrideMethod: aMethodReference
        ^ self isOverrideCategory: aMethodReference category!

----- Method: PackageInfo>>isOverrideOfYourMethod: (in category 'testing') -----
isOverrideOfYourMethod: aMethodReference
        "Answers true if the argument overrides a method in this package"
        ^ (self isYourClassExtension: aMethodReference category) not and:
                [(self changeRecordForOverriddenMethod: aMethodReference) notNil]!

----- Method: PackageInfo>>isScript:not: (in category 'preamble/postscript') -----
isScript: script not: default
        ^ script notNil
                and: [ | contents |
                        contents := script contents asString withBlanksTrimmed.
                        contents notEmpty and: [contents ~= default and: [contents ~= 'nil']]]!

----- Method: PackageInfo>>isYourClassExtension: (in category 'testing') -----
isYourClassExtension: categoryName
        ^ categoryName notNil and: [self category: categoryName asLowercase matches: self methodCategoryPrefix]!

----- Method: PackageInfo>>linesOfCode (in category 'source code management') -----
linesOfCode
        "An approximate measure of lines of code.
        Includes comments, but excludes blank lines."
        ^self methods inject: 0 into: [:sum :each | sum + each compiledMethod linesOfCode]!

----- Method: PackageInfo>>methodCategoryPrefix (in category 'naming') -----
methodCategoryPrefix
        ^ methodCategoryPrefix ifNil: [methodCategoryPrefix := '*', self packageName asLowercase]!

----- Method: PackageInfo>>methods (in category 'listing') -----
methods
        ^ (self extensionMethods, self coreMethods) select: [:method |
                method isValid
                        and: [method isLocalSelector]]!

----- Method: PackageInfo>>methodsInCategory:ofClass: (in category 'testing') -----
methodsInCategory: aString ofClass: aClass
        ^Array streamContents: [:stream |
                self methodsInCategory: aString ofClass: aClass
                        do: [:each | stream nextPut: each]]
!

----- Method: PackageInfo>>methodsInCategory:ofClass:do: (in category 'enumerating') -----
methodsInCategory: aString ofClass: aClass do: aBlock
        ((aClass organization listAtCategoryNamed: aString) ifNil: [^self])
                do: [:sel | aBlock value: (self referenceForMethod: sel ofClass: aClass)]!

----- Method: PackageInfo>>name (in category 'naming') -----
name

^ self packageName!

----- Method: PackageInfo>>outsideClasses (in category 'testing') -----
outsideClasses
        ^ProtoObject withAllSubclasses asSet difference: self classesAndMetaClasses!

----- Method: PackageInfo>>overriddenMethods (in category 'listing') -----
overriddenMethods
        ^ Array streamContents: [:stream |
                self overriddenMethodsDo: [:each | stream nextPut: each]]
!

----- Method: PackageInfo>>overriddenMethodsDo: (in category 'enumerating') -----
overriddenMethodsDo: aBlock
        "Enumerates the methods the receiver contains which have been overridden by other packages"
        ^ self allOverriddenMethodsDo: [:ea |
                (self isOverrideOfYourMethod: ea)
                        ifTrue: [aBlock value: ea]]!

----- Method: PackageInfo>>overriddenMethodsInClass: (in category 'listing') -----
overriddenMethodsInClass: aClass
        ^Array streamContents: [:stream |
                self overriddenMethodsInClass: aClass
                        do: [:each | stream nextPut: each]]
!

----- Method: PackageInfo>>overriddenMethodsInClass:do: (in category 'enumerating') -----
overriddenMethodsInClass: aClass do: aBlock
        "Evaluates aBlock with the overridden methods in aClass"
        ^ self overrideCategoriesForClass: aClass do: [:cat |
                self methodsInCategory: cat ofClass: aClass do: aBlock]!

----- Method: PackageInfo>>overrideCategoriesForClass: (in category 'testing') -----
overrideCategoriesForClass: aClass
        ^Array streamContents: [:stream |
                self overrideCategoriesForClass: aClass
                        do: [:each | stream nextPut: each]]
!

----- Method: PackageInfo>>overrideCategoriesForClass:do: (in category 'enumerating') -----
overrideCategoriesForClass: aClass do: aBlock
        "Evaluates aBlock with all the *foo-override categories in aClass"
        ^ aClass organization categories do: [:cat |
                (self isOverrideCategory: cat) ifTrue: [aBlock value: cat]]!

----- Method: PackageInfo>>overrideMethods (in category 'listing') -----
overrideMethods
        ^ self extensionMethods select: [:ea | self isOverrideMethod: ea]!

----- Method: PackageInfo>>packageName (in category 'naming') -----
packageName
        ^ packageName ifNil: [packageName := self categoryName]!

----- Method: PackageInfo>>packageName: (in category 'naming') -----
packageName: aString
        packageName := aString!

----- Method: PackageInfo>>postscript (in category 'preamble/postscript') -----
postscript
        ^ postscript ifNil: [
                postscript := StringHolder new contents: self postscriptDefault]!

----- Method: PackageInfo>>postscript: (in category 'preamble/postscript') -----
postscript: aString

postscript := StringHolder new contents: aString!

----- Method: PackageInfo>>postscriptDefault (in category 'preamble/postscript') -----
postscriptDefault
        ^ '"below, add code to be run after the loading of this package"'!

----- Method: PackageInfo>>postscriptOfRemoval (in category 'preamble/postscript') -----
postscriptOfRemoval
        ^ postscriptOfRemoval ifNil: [
                postscriptOfRemoval := StringHolder new contents: self postscriptOfRemovalDefault]!

----- Method: PackageInfo>>postscriptOfRemoval: (in category 'preamble/postscript') -----
postscriptOfRemoval: aString

postscriptOfRemoval := StringHolder new contents: aString
!

----- Method: PackageInfo>>postscriptOfRemovalDefault (in category 'preamble/postscript') -----
postscriptOfRemovalDefault
        ^ '"below, add code to clean up after the unloading of this package"'!

----- Method: PackageInfo>>preamble (in category 'preamble/postscript') -----
preamble
        ^ preamble ifNil: [
                preamble := StringHolder new contents: self preambleDefault]!

----- Method: PackageInfo>>preamble: (in category 'preamble/postscript') -----
preamble: aString

preamble := StringHolder new contents: aString!

----- Method: PackageInfo>>preambleDefault (in category 'preamble/postscript') -----
preambleDefault
        ^ '"below, add code to be run before the loading of this package"'
!

----- Method: PackageInfo>>preambleOfRemoval (in category 'preamble/postscript') -----
preambleOfRemoval
        ^ preambleOfRemoval ifNil: [
                preambleOfRemoval := StringHolder new contents: self preambleOfRemovalDefault]!

----- Method: PackageInfo>>preambleOfRemoval: (in category 'preamble/postscript') -----
preambleOfRemoval: aString

preambleOfRemoval := StringHolder new contents: aString
!

----- Method: PackageInfo>>preambleOfRemovalDefault (in category 'preamble/postscript') -----
preambleOfRemovalDefault
        ^'"below, add code to prepare for the unloading of this package"'!

----- Method: PackageInfo>>printOn: (in category 'printing') -----
printOn: aStream
        super printOn: aStream.
        aStream
                nextPut: $(;
                nextPutAll: self packageName;
                nextPut: $)!

----- Method: PackageInfo>>referenceForMethod:ofClass: (in category 'testing') -----
referenceForMethod: aSymbol ofClass: aClass
        ^ MethodReference class: aClass selector: aSymbol!

----- Method: PackageInfo>>register (in category 'registering') -----
register
        PackageOrganizer default registerPackage: self!

----- Method: PackageInfo>>removeMethod: (in category 'modifying') -----
removeMethod: aMethodReference!

----- Method: PackageInfo>>selectors (in category 'listing') -----
selectors
        ^ self methods collect: [:ea | ea methodSymbol]!

----- Method: PackageInfo>>systemCategories (in category 'listing') -----
systemCategories
        ^ SystemOrganization categories select: [:cat | self includesSystemCategory: cat]!

----- Method: PackageInfo>>systemCategoryPrefix (in category 'naming') -----
systemCategoryPrefix
        ^ self packageName!

Object subclass: #PackageOrganizer
        instanceVariableNames: 'packages'
        classVariableNames: ''
        poolDictionaries: ''
        category: 'PackageInfo-Base'!
PackageOrganizer class
        instanceVariableNames: 'default'!
PackageOrganizer class
        instanceVariableNames: 'default'!

----- Method: PackageOrganizer class>>default (in category 'as yet unclassified') -----
default
        ^ default ifNil: [default := self new]!

----- Method: PackageOrganizer class>>new (in category 'as yet unclassified') -----
new
        ^ self basicNew initialize!

----- Method: PackageOrganizer>>flushObsoletePackages: (in category 'registering') -----
flushObsoletePackages: aBlock
        "Flush all packages considered obsolete by evaluating the argument block."

        packages keys do:[:key|
                (aBlock value: (packages at: key)) ifTrue:[packages removeKey: key].
        ].
        self changed: #packages; changed: #packageNames.!

----- Method: PackageOrganizer>>initialize (in category 'initializing') -----
initialize
        packages := Dictionary new!

----- Method: PackageOrganizer>>noPackageFound (in category 'searching') -----
noPackageFound
        self error: 'No package found'!

----- Method: PackageOrganizer>>packageNamed:ifAbsent: (in category 'searching') -----
packageNamed: aString ifAbsent: errorBlock
        ^ packages at: aString ifAbsent: errorBlock!

----- Method: PackageOrganizer>>packageNames (in category 'accessing') -----
packageNames
        ^ packages keys!

----- Method: PackageOrganizer>>packageOfClass: (in category 'searching') -----
packageOfClass: aClass
        ^ self packageOfClass: aClass ifNone: [self noPackageFound]!

----- Method: PackageOrganizer>>packageOfClass:ifNone: (in category 'searching') -----
packageOfClass: aClass ifNone: errorBlock
        ^ self packages detect: [:ea | ea includesClass: aClass] ifNone: errorBlock!

----- Method: PackageOrganizer>>packageOfMethod: (in category 'searching') -----
packageOfMethod: aMethodReference
        ^ self packageOfMethod: aMethodReference ifNone: [self noPackageFound]!

----- Method: PackageOrganizer>>packageOfMethod:ifNone: (in category 'searching') -----
packageOfMethod: aMethodReference ifNone: errorBlock
        ^ self packages detect: [:ea | ea includesMethodReference: aMethodReference] ifNone: errorBlock!

----- Method: PackageOrganizer>>packageOfMethodCategory:ofClass: (in category 'searching') -----
packageOfMethodCategory: categoryName ofClass: aClass
        ^self packageOfMethodCategory: categoryName ofClass: aClass ifNone: [ self noPackageFound ]
!

----- Method: PackageOrganizer>>packageOfMethodCategory:ofClass:ifNone: (in category 'searching') -----
packageOfMethodCategory: categoryName ofClass: aClass ifNone: errorBlock
        ^ self packages detect: [:ea | ea includesMethodCategory: categoryName ofClassNamed: aClass name] ifNone: errorBlock
       
       
!

----- Method: PackageOrganizer>>packageOfSystemCategory: (in category 'searching') -----
packageOfSystemCategory: aSystemCategory
        ^ self packageOfSystemCategory: aSystemCategory ifNone: [ self noPackageFound ]
!

----- Method: PackageOrganizer>>packageOfSystemCategory:ifNone: (in category 'searching') -----
packageOfSystemCategory: aSystemCategory ifNone: errorBlock
        ^ self packages detect: [:ea | ea includesSystemCategory: aSystemCategory] ifNone: errorBlock
!

----- Method: PackageOrganizer>>packages (in category 'accessing') -----
packages
        ^ packages values!

----- Method: PackageOrganizer>>registerPackage: (in category 'registering') -----
registerPackage: aPackageInfo
        packages at: aPackageInfo packageName put: aPackageInfo.
        self changed: #packages; changed: #packageNames.
!

----- Method: PackageOrganizer>>registerPackageNamed: (in category 'registering') -----
registerPackageNamed: aString
        ^ self registerPackage: (PackageInfo named: aString)!

----- Method: PackageOrganizer>>unregisterPackage: (in category 'registering') -----
unregisterPackage: aPackageInfo
        packages removeKey: aPackageInfo packageName ifAbsent: [].
        self changed: #packages; changed: #packageNames.
!

----- Method: PackageOrganizer>>unregisterPackageNamed: (in category 'registering') -----
unregisterPackageNamed: aString
        self unregisterPackage: (self packageNamed: aString ifAbsent: [^ self])!

Object subclass: #PackageServices
        instanceVariableNames: ''
        classVariableNames: 'ServiceClasses'
        poolDictionaries: ''
        category: 'PackageInfo-Base'!

----- Method: PackageServices class>>allServices (in category 'as yet unclassified') -----
allServices
        ^ ServiceClasses gather: [:ea | ea services]!

----- Method: PackageServices class>>initialize (in category 'as yet unclassified') -----
initialize
        ServiceClasses := Set new!

----- Method: PackageServices class>>register: (in category 'as yet unclassified') -----
register: aClass
        ServiceClasses add: aClass!

----- Method: PackageServices class>>unregister: (in category 'as yet unclassified') -----
unregister: aClass
        ServiceClasses remove: aClass!

----- Method: PositionableStream>>untilEnd:displayingProgress: (in category '*packageinfo-base') -----
untilEnd: aBlock displayingProgress: aString
        aString
                displayProgressFrom: 0 to: self size
                during:
                        [:bar |
                        [self atEnd] whileFalse:
                                [bar value: self position.
                                aBlock value]].!