[squeak-dev] Squeak 4.5: PackageInfo-Base-nice.68.mczcommits at source.squeak.org commits at source.squeak.orgFri Jan 24 20:17:57 UTC 2014
Chris Muller uploaded a new version of PackageInfo-Base to project Squeak 4.5: http://source.squeak.org/squeak45/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 #($< '<' $> '>' $& '&') 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]].!
More information about the Squeak-dev mailing list |