'From Squeak3.4 of 1 March 2003 [latest update: #5170] on 28 March 2003 at 4:55:38 pm'! "Change Set: KCP-0021-browseAccessIn Date: 28 March 2003 Author: stephane ducasse, alexandre bergel, and nathanael schaerli introduce the methods browseAllStoreInto:from: and browseAllAccessesTo:from: into SystemNavigation and adapt all the senders of Behavior>>browseAllAccessesTo: and Behavior>>browseAllStoreInto:"! !ClassDescription methodsFor: 'instance variables' stamp: 'sd 3/28/2003 16:50'! browseInstVarDefs "Copied from browseInstVarRefs. Should be consolidated some day. 7/29/96 di 7/30/96 sw: did the consolidation" "Change to use SystemNavigation 27 March 2003 sd" self chooseInstVarThenDo: [:aVar | SystemNavigation new browseAllStoresInto: aVar from: self]! ! !ClassDescription methodsFor: 'instance variables' stamp: 'sd 3/28/2003 16:51'! browseInstVarRefs "1/16/96 sw: moved here from Browser so that it could be used from a variety of places. 7/30/96 sw: call chooseInstVarThenDo: to get the inst var choice" self chooseInstVarThenDo: [:aVar | SystemNavigation new browseAllAccessesTo: aVar from: self]! ! !Inspector methodsFor: 'menu commands' stamp: 'sd 3/28/2003 16:50'! defsOfSelection "Open a browser on all defining references to the selected instance variable, if that's what currently selected. " | aClass sel | self selectionUnmodifiable ifTrue: [^ self changed: #flash]. (aClass _ self object class) isVariable ifTrue: [^ self changed: #flash]. sel _ aClass allInstVarNames at: self selectionIndex - 2. SystemNavigation new browseAllStoresInto: sel from: aClass! ! !Inspector methodsFor: 'menu commands' stamp: 'sd 3/28/2003 16:51'! referencesToSelection "Open a browser on all references to the selected instance variable, if that's what currently selected. 1/25/96 sw" | aClass sel | self selectionUnmodifiable ifTrue: [^ self changed: #flash]. (aClass _ self object class) isVariable ifTrue: [^ self changed: #flash]. sel _ aClass allInstVarNames at: self selectionIndex - 2. SystemNavigation new browseAllAccessesTo: sel from: aClass! ! !MethodFinder methodsFor: 'initialize' stamp: 'sd 3/28/2003 16:51'! noteDangerous "Remember the methods with really bad side effects." Dangerous _ Set new. "Object accessing, testing, copying, dependent access, macpal, flagging" #(addInstanceVarNamed:withValue: haltIfNil copyAddedStateFrom: veryDeepCopy veryDeepCopyWith: veryDeepFixupWith: veryDeepInner: addDependent: evaluate:wheneverChangeIn: codeStrippedOut: playSoundNamed: isThisEverCalled isThisEverCalled: logEntry logExecution logExit) do: [:sel | Dangerous add: sel]. "Object error handling" #(cannotInterpret: caseError confirm: confirm:orCancel: doesNotUnderstand: error: halt halt: notify: notify:at: primitiveFailed shouldNotImplement subclassResponsibility tryToDefineVariableAccess:) do: [:sel | Dangerous add: sel]. "Object user interface" #(basicInspect beep inform: inspect inspectWithLabel: notYetImplemented inspectElement ) do: [:sel | Dangerous add: sel]. "Object system primitives" #(become: becomeForward: instVarAt:put: instVarNamed:put: nextInstance nextObject rootStubInImageSegment: someObject tryPrimitive:withArgs:) do: [:sel | Dangerous add: sel]. "Object private" #(errorImproperStore errorNonIntegerIndex errorNotIndexable errorSubscriptBounds: mustBeBoolean primitiveError: species storeAt:inTempFrame:) do: [:sel | Dangerous add: sel]. "Object, translation support" #(cCode: cCode:inSmalltalk: cCoerce:to: export: inline: returnTypeC: sharedCodeNamed:inCase: var:declareC:) do: [:sel | Dangerous add: sel]. "Object, objects from disk, finalization. And UndefinedObject" #(comeFullyUpOnReload: objectForDataStream: readDataFrom:size: rehash saveOnFile storeDataOn: actAsExecutor executor finalize retryWithGC:until: suspend) do: [:sel | Dangerous add: sel]. "No Restrictions: Boolean, False, True, " "Morph" #() do: [:sel | Dangerous add: sel]. "Behavior" #(obsolete confirmRemovalOf: copyOfMethodDictionary literalScannedAs:notifying: storeLiteral:on: addSubclass: removeSubclass: superclass: "creating method dictionary" addSelector:withMethod: compile: compile:notifying: compileAll compileAllFrom: compress decompile: defaultSelectorForMethod: methodDictionary: recompile:from: recompileChanges removeSelector: compressedSourceCodeAt: selectorAtMethod:setClass: allInstances allSubInstances inspectAllInstances inspectSubInstances thoroughWhichSelectorsReferTo:special:byte: "enumerating" allInstancesDo: allSubInstancesDo: allSubclassesDo: allSuperclassesDo: selectSubclasses: selectSuperclasses: subclassesDo: withAllSubclassesDo: "user interface" allCallsOn: browseAllCallsOn: "too slow->" crossReference removeUninstantiatedSubclassesSilently "too slow->" unreferencedInstanceVariables "private" becomeCompact becomeUncompact flushCache format:variable:words:pointers: format:variable:words:pointers:weak: printSubclassesOn:level: removeSelectorSimply:) do: [:sel | Dangerous add: sel]. "Others " #("no tangible result" do: associationsDo: "private" adaptToCollection:andSend: adaptToNumber:andSend: adaptToPoint:andSend: adaptToString:andSend: instVarAt:put: asDigitsToPower:do: combinations:atATimeDo: doWithIndex: pairsDo: permutationsDo: reverseDo: reverseWith:do: with:do: withIndexDo: asDigitsAt:in:do: combinationsAt:in:after:do: errorOutOfBounds permutationsStartingAt:do: fromUser) do: [:sel | Dangerous add: sel]. #( fileOutPrototype addSpareFields makeFileOutFile ) do: [:sel | Dangerous add: sel]. #(recompile:from: recompileAllFrom: recompileChanges asPrototypeWithFields: asPrototype addInstanceVarNamed:withValue: addInstanceVariable addClassVarName: removeClassVarName: findOrAddClassVarName: tryToDefineVariableAccess: instanceVariableNames: ) do: [:sel | Dangerous add: sel]. ! ! !SystemNavigation methodsFor: 'browse' stamp: 'sd 3/28/2003 16:44'! browseAllAccessesTo: instVarName from: aClass "Create and schedule a Message Set browser for all the receiver's methods or any methods of a subclass/superclass that refer to the instance variable name." "self new browseAllAccessesTo: 'contents' from: Collection." | coll | coll _ OrderedCollection new. Cursor wait showWhile: [ aClass withAllSubAndSuperclassesDo: [:class | (class whichSelectorsAccess: instVarName) do: [:sel | sel == #DoIt ifFalse: [ coll add: ( MethodReference new setStandardClass: class methodSymbol: sel ) ] ] ]. ]. ^ aClass environment browseMessageList: coll name: 'Accesses to ' , instVarName autoSelect: instVarName! ! !SystemNavigation methodsFor: 'browse' stamp: 'sd 3/28/2003 16:47'! browseAllStoresInto: instVarName from: aClass "Create and schedule a Message Set browser for all the receiver's methods or any methods of a subclass/superclass that refer to the instance variable name." "self new browseAllStoresInto: 'contents' from: Collection." | coll | coll _ OrderedCollection new. Cursor wait showWhile: [ aClass withAllSubAndSuperclassesDo: [:class | (class whichSelectorsStoreInto: instVarName) do: [:sel | sel == #DoIt ifFalse: [ coll add: ( MethodReference new setStandardClass: class methodSymbol: sel ) ] ] ]. ]. ^ aClass environment browseMessageList: coll name: 'Stores into ' , instVarName autoSelect: instVarName! !