'From Squeak3.4 of 1 March 2003 [latest update: #5170] on 28 March 2003 at 3:35:10 pm'! "Change Set: KCP-0015-rmSmallInClassDescr Date: 28 March 2003 Author: stephane ducasse, alexandre bergel, and nathanael schaerli Replace all the Smalltalk by self environment in the class ClassDescription"! !ClassDescription methodsFor: 'accessing' stamp: 'sd 3/28/2003 15:32'! comment: aStringOrText "Set the receiver's comment to be the argument, aStringOrText." self theNonMetaClass classComment: aStringOrText. self environment changes commentClass: self. Utilities noteMethodSubmission: #Comment forClass: self theNonMetaClass! ! !ClassDescription methodsFor: 'accessing' stamp: 'sd 3/28/2003 15:32'! comment: aStringOrText stamp: aStamp "Set the receiver's comment to be the argument, aStringOrText." self theNonMetaClass classComment: aStringOrText stamp: aStamp. self environment changes commentClass: self theNonMetaClass. Utilities noteMethodSubmission: #Comment forClass: self theNonMetaClass! ! !ClassDescription methodsFor: 'instance variables' stamp: 'sd 3/28/2003 15:31'! allUnreferencedClassVariables "Answer a list of the names of all the receiver's unreferenced class vars, including those defined in superclasses" | aList | aList _ OrderedCollection new. self withAllSuperclasses reverseDo: [:aClass | aClass classVarNames do: [:var | (self environment allCallsOn: (aClass classPool associationAt: var)) size == 0 ifTrue: [aList add: var]]]. ^ aList! ! !ClassDescription methodsFor: 'instance variables' stamp: 'sd 3/28/2003 15:31'! browseClassVarRefs "Put up a menu offering all class variable names; if the user chooses one, open up a message-list browser on all methods that refer to the selected class variable" | lines labelStream vars allVars index owningClasses | lines _ OrderedCollection new. allVars _ OrderedCollection new. owningClasses _ OrderedCollection new. labelStream _ WriteStream on: (String new: 200). self withAllSuperclasses reverseDo: [:class | vars _ class classVarNames asSortedCollection. vars do: [:var | labelStream nextPutAll: var; cr. allVars add: var. owningClasses add: class]. vars isEmpty ifFalse: [lines add: allVars size]]. labelStream contents isEmpty ifTrue: [^1 beep]. "handle nil superclass better" labelStream skip: -1 "cut last CR". index _ (PopUpMenu labels: labelStream contents lines: lines) startUp. index = 0 ifTrue: [^ self]. self environment browseAllCallsOn: ((owningClasses at: index) classPool associationAt: (allVars at: index))! ! !ClassDescription methodsFor: 'method dictionary' stamp: 'sd 3/28/2003 15:32'! recoverFromMDFaultWithTrace "This method handles emthodDict faults to support, eg, discoverActiveClasses (qv)." self recoverFromMDFault. self environment at: #MDFaultDict ifPresent: [:faultDict | faultDict at: self name put: (String streamContents: [:strm | (thisContext stackOfSize: 20) do: [:item | strm print: item; cr]])] "Execute the following statement to induce MD fault tracing. This means that, not only will all active classes be recorded but, after a test run, MDFaultDict will contain, for every class used, a stack trace showing how it came to be used. This statement should be executed just prior to any such text, in order to clear the traces. Smalltalk at: #MDFaultDict put: Dictionary new. "! ! !ClassDescription methodsFor: 'method dictionary' stamp: 'sd 3/28/2003 15:32'! removeSelector: selector | priorMethod | "Remove the message whose selector is given from the method dictionary of the receiver, if it is there. Answer nil otherwise." (self methodDict includesKey: selector) ifFalse: [^ nil]. priorMethod _ self compiledMethodAt: selector. self environment changes removeSelector: selector class: self priorMethod: priorMethod lastMethodInfo: {priorMethod sourcePointer. (self whichCategoryIncludesSelector: selector)}. super removeSelector: selector. self organization removeElement: selector. self acceptsLoggingOfCompilation ifTrue: [self environment logChange: self name , ' removeSelector: #' , selector]! ! !ClassDescription methodsFor: 'compiling' stamp: 'sd 3/28/2003 15:32'! compile: code notifying: requestor trailer: bytes ifFail: failBlock elseSetSelectorAndNode: selAndNodeBlock "Intercept this message in order to remember system changes. 5/15/96 sw: modified so that if the class does not wish its methods logged in the changes file, then they also won't be accumulated in the current change set. 7/12/96 sw: use wantsChangeSetLogging to determine whether to put in change set" | methodNode selector newMethod priorMethodOrNil | methodNode _ self compilerClass new compile: code in: self notifying: requestor ifFail: failBlock. selector _ methodNode selector. selAndNodeBlock value: selector value: methodNode. requestor ifNotNil: ["Note this change for recent submissions list" Utilities noteMethodSubmission: selector forClass: self]. methodNode encoder requestor: requestor. "Why was this not preserved?" newMethod _ methodNode generate: bytes. priorMethodOrNil _ (self methodDict includesKey: selector) ifTrue: [self compiledMethodAt: selector] ifFalse: [nil]. self environment changes noteNewMethod: newMethod forClass: self selector: selector priorMethod: priorMethodOrNil. self addSelector: selector withMethod: newMethod. ^ newMethod! ! !ClassDescription methodsFor: 'fileIn/Out' stamp: 'sd 3/28/2003 15:32'! classComment: aString stamp: aStamp "Store the comment, aString or Text or RemoteString, associated with the class we are organizing. Empty string gets stored only if had a non-empty one before." | ptr header file oldCommentRemoteStr | (aString isKindOf: RemoteString) ifTrue: [self environment changes commentClass: self. ^ self organization classComment: aString stamp: aStamp]. oldCommentRemoteStr _ self organization commentRemoteStr. (aString size = 0) & (oldCommentRemoteStr == nil) ifTrue: [^ organization classComment: nil]. "never had a class comment, no need to write empty string out" ptr _ oldCommentRemoteStr ifNil: [0] ifNotNil: [oldCommentRemoteStr sourcePointer]. SourceFiles ifNotNil: [(file _ SourceFiles at: 2) ifNotNil: [file setToEnd; cr; nextPut: $!!. "directly" "Should be saying (file command: 'H3') for HTML, but ignoring it here" header _ String streamContents: [:strm | strm nextPutAll: self name; nextPutAll: ' commentStamp: '. aStamp storeOn: strm. strm nextPutAll: ' prior: '; nextPutAll: ptr printString]. file nextChunkPut: header]]. self environment changes commentClass: self. organization classComment: (RemoteString newString: aString onFileNumber: 2) stamp: aStamp ! ! !ClassDescription methodsFor: 'fileIn/Out' stamp: 'sd 3/28/2003 15:32'! reorganize "During fileIn, !!Rectangle reorganize!! allows Rectangle to seize control and treat the next chunk as its organization. See the transfer of control where ReadWriteStream fileIn calls scanFrom:" self environment changes reorganizeClass: self. ^self organization! ]style[(10 156 22 87)f1b,f1,f1LReadWriteStream fileIn;,f1! ! !ClassDescription methodsFor: 'accessing class hierarchy' stamp: 'sd 3/28/2003 15:32'! removeUninstantiatedSubclassesSilently "Remove the classes of any subclasses that have neither instances nor subclasses. Answer the number of bytes reclaimed" "Player removeUninstantiatedSubclassesSilently" | candidatesForRemoval oldFree | oldFree _ self environment garbageCollect. candidatesForRemoval _ self subclasses select: [:c | (c instanceCount = 0) and: [c subclasses size = 0]]. candidatesForRemoval do: [:c | c removeFromSystem]. ^ self environment garbageCollect - oldFree! !