'From Squeak3.6alpha of ''17 March 2003'' [latest update: #5240] on 30 May 2003 at 1:54:11 pm'! !Behavior methodsFor: 'accessing instances and variables' stamp: 'tpr 5/30/2003 13:04'! allSharedPools "Answer a Set of the names of the pools (Dictionaries or SharedPool subclasses) that the receiver and the receiver's ancestors share." ^superclass allSharedPools! ! !Class methodsFor: 'pool variables' stamp: 'tpr 5/30/2003 13:04'! addSharedPool: aSharedPool "Add the argument, aSharedPool, as one of the receiver's shared pools. Create an error if the shared pool is already one of the pools. This method will work with shared pools that are plain Dictionaries or thenewer SharedPool subclasses" (self sharedPools includes: aSharedPool) ifTrue: [^self error: 'This is already in my shared pool list']. sharedPools == nil ifTrue: [sharedPools _ OrderedCollection with: aSharedPool] ifFalse: [sharedPools add: aSharedPool]! ! !Class methodsFor: 'fileIn/Out' stamp: 'tpr 5/30/2003 13:01'! fileOutPool: aPool onFileStream: aFileStream | aPoolName aValue | (aPool isKindOf: SharedPool class) ifTrue:[^self notify: 'we do not fileout SharedPool type shared pools for now']. aPoolName _ self environment keyAtIdentityValue: aPool. Transcript cr; show: aPoolName. aFileStream nextPutAll: 'Transcript show: ''' , aPoolName , '''; cr!!'; cr. aFileStream nextPutAll: 'Smalltalk at: #' , aPoolName , ' put: Dictionary new!!'; cr. aPool keys asSortedCollection do: [ :aKey | aValue _ aPool at: aKey. aFileStream nextPutAll: aPoolName , ' at: #''' , aKey asString , '''', ' put: '. (aValue isKindOf: Number) ifTrue: [aValue printOn: aFileStream] ifFalse: [aFileStream nextPutAll: '('. aValue printOn: aFileStream. aFileStream nextPutAll: ')']. aFileStream nextPutAll: '!!'; cr]. aFileStream cr! ! !ParagraphEditor methodsFor: 'explain' stamp: 'tpr 5/29/2003 18:19'! explainClass: symbol "Is symbol a class variable or a pool variable?" | class reply classes | (model respondsTo: #selectedClassOrMetaClass) ifFalse: [^ nil]. (class _ model selectedClassOrMetaClass) ifNil: [^ nil]. "no class is selected" (class isKindOf: Metaclass) ifTrue: [class _ class soleInstance]. classes _ (Array with: class) , class allSuperclasses. "class variables" reply _ classes detect: [:each | (each classVarNames detect: [:name | symbol = name] ifNone: []) ~~ nil] ifNone: []. reply == nil ifFalse: [^ '"is a class variable, defined in class ' , reply printString , '"\' withCRs , 'SystemNavigation new browseAllCallsOn: (' , reply printString , ' classPool associationAt: #' , symbol , ').']. "pool variables" classes do: [:each | (each sharedPools detect: [:pool | (pool includesKey: symbol) and: [reply _ pool. true]] ifNone: []) ~~ nil]. reply ifNil: [(Undeclared includesKey: symbol) ifTrue: [^ '"is an undeclared variable.' , '"\' withCRs , 'SystemNavigation browseAllCallsOn: (Undeclared associationAt: #' , symbol , ').']] ifNotNil: [classes _ WriteStream on: Array new. self systemNavigation allBehaviorsDo: [:each | (each sharedPools detect: [:pool | pool == reply] ifNone: []) ~~ nil ifTrue: [classes nextPut: each]]. "Perhaps not print whole list of classes if too long. (unlikely)" ^ '"is a pool variable from the pool ' , (Smalltalk keyAtIdentityValue: reply) asString , ', which is used by the following classes ' , classes contents printString , '"\' withCRs , 'SystemNavigation new browseAllCallsOn: (' , (Smalltalk keyAtIdentityValue: reply) asString , ' bindingOf: #' , symbol , ').']. ^ nil! ! !ParagraphEditor methodsFor: 'explain' stamp: 'tpr 5/29/2003 20:07'! explainGlobal: symbol "Is symbol a global variable?" | reply classes | reply _ Smalltalk at: symbol ifAbsent: [^nil]. (reply class == Dictionary or:[reply isKindOf: SharedPool class]) ifTrue: [classes _ Set new. self systemNavigation allBehaviorsDo: [:each | (each sharedPools detect: [:pool | pool == reply] ifNone: []) ~~ nil ifTrue: [classes add: each]]. classes _ classes printString. ^'"is a global variable. It is a pool which is used by the following classes ' , (classes allButFirst: 5) , '"']. (reply isKindOf: Behavior) ifTrue: [^'"is a global variable. ' , symbol , ' is a class in category ', reply category, '."', '\' withCRs, 'Browser newOnClass: ' , symbol , '.']. symbol == #Smalltalk ifTrue: [^'"is a global. Smalltalk is the only instance of SystemDictionary and holds all global variables."']. ^'"is a global variable. ' , symbol , ' is ' , reply printString , '"'! ! !SharedPool class methodsFor: 'name lookup' stamp: 'tpr 5/29/2003 18:12'! includesKey: aName "does this pool include aName" ^(self bindingOf: aName) notNil! ! !SystemDictionary methodsFor: 'retrieving' stamp: 'tpr 5/30/2003 12:29'! poolUsers "Answer a dictionary of pool name -> classes that refer to it. Also includes any globally know dictionaries (such as Smalltalk, Undeclared etc) which although not strictly accurate is potentially useful information " "Smalltalk poolUsers" | poolUsers pool refs | poolUsers _ Dictionary new. Smalltalk keys do: [:k |"yes, using isKindOf: is tacky but for reflective code like this it is very useful. If you really object you can:- a) go boil your head. b) provide a better answer. your choice." (((pool _ Smalltalk at: k) isKindOf: Dictionary) or: [pool isKindOf: SharedPool class]) ifTrue: [refs _ self systemNavigation allClasses select: [:c | c sharedPools identityIncludes: pool] thenCollect: [:c | c name]. refs add: (self systemNavigation allCallsOn: (Smalltalk associationAt: k)). poolUsers at: k put: refs]]. ^ poolUsers! !