[Pkg] The Trunk: Kernel-ar.350.mcz
commits at source.squeak.org
commits at source.squeak.org
Thu Dec 31 13:08:29 UTC 2009
Andreas Raab uploaded a new version of Kernel to project The Trunk:
http://source.squeak.org/trunk/Kernel-ar.350.mcz
==================== Summary ====================
Name: Kernel-ar.350
Author: ar
Time: 29 December 2009, 4:35:59 am
UUID: d0cb0117-72d6-384e-8065-adcb9229b9ea
Ancestors: Kernel-ar.349
Shipping NanoTraits part 2: Commit Kernel package back after NanoTraits install.
=============== Diff against Kernel-ar.349 ===============
Item was added:
+ ----- Method: Behavior>>storeLiteral:on: (in category 'printing') -----
+ storeLiteral: aCodeLiteral on: aStream
+ "Store aCodeLiteral on aStream, changing an Association to ##GlobalName
+ or ###MetaclassSoleInstanceName format if appropriate"
+ | key value |
+ (aCodeLiteral isVariableBinding)
+ ifFalse:
+ [aCodeLiteral storeOn: aStream.
+ ^self].
+ key := aCodeLiteral key.
+ (key isNil and: [(value := aCodeLiteral value) isMemberOf: Metaclass])
+ ifTrue:
+ [aStream nextPutAll: '###'; nextPutAll: value soleInstance name.
+ ^self].
+ (key isSymbol and: [(self bindingOf: key) notNil])
+ ifTrue:
+ [aStream nextPutAll: '##'; nextPutAll: key.
+ ^self].
+ aCodeLiteral storeOn: aStream!
Item was added:
+ ----- Method: Behavior>>clearSendCaches (in category 'send caches') -----
+ clearSendCaches
+ LocalSends current clearOut: self!
Item was added:
+ ----- Method: ClassDescription>>zapOrganization (in category 'organization') -----
+ zapOrganization
+ "Remove the organization of this class by message categories.
+ This is typically done to save space in small systems. Classes and methods
+ created or filed in subsequently will, nonetheless, be organized"
+
+ self organization: nil.
+ self isClassSide ifFalse: [self classSide zapOrganization]!
Item was added:
+ ----- Method: Behavior>>removeSelectorSilently: (in category 'adding/removing methods') -----
+ removeSelectorSilently: selector
+ "Remove selector without sending system change notifications"
+
+ ^ SystemChangeNotifier uniqueInstance doSilently: [self removeSelector: selector].!
Item was added:
+ ----- Method: Behavior>>selectors (in category 'accessing method dictionary') -----
+ selectors
+ "Answer a collection of all the message selectors specified in the receiver's
+ method dictionary."
+
+ ^ self methodDict keys!
Item was added:
+ ----- Method: Behavior>>compileAll (in category 'compiling') -----
+ compileAll
+ ^ self compileAllFrom: self!
Item was added:
+ ----- Method: Behavior>>selfSentSelectorsFromSelectors: (in category 'traits') -----
+ selfSentSelectorsFromSelectors: interestingSelectors
+ | result |
+ result := IdentitySet new.
+ interestingSelectors collect:
+ [:sel |
+ | m info |
+ m := self compiledMethodAt: sel ifAbsent: [].
+ m ifNotNil:
+ [info := (SendInfo on: m) collectSends.
+ info selfSentSelectors do: [:sentSelector | result add: sentSelector]]].
+ ^result!
Item was added:
+ ----- Method: ClassDescription>>classComment:stamp: (in category 'fileIn/Out') -----
+ 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:
+ [SystemChangeNotifier uniqueInstance classCommented: self.
+ ^ self organization classComment: aString stamp: aStamp].
+
+ oldCommentRemoteStr := self organization commentRemoteStr.
+ (aString size = 0) & (oldCommentRemoteStr == nil) ifTrue: [^ self 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 organization classComment: (RemoteString newString: aString onFileNumber: 2) stamp: aStamp.
+ SystemChangeNotifier uniqueInstance classCommented: self.
+ !
Item was added:
+ ----- Method: Behavior>>firstPrecodeCommentFor: (in category 'accessing method dictionary') -----
+ firstPrecodeCommentFor: selector
+ "If there is a comment in the source code at the given selector that preceeds the body of the method, return it here, else return nil"
+
+ | parser source tree |
+ "Behavior firstPrecodeCommentFor: #firstPrecodeCommentFor:"
+ (#(Comment Definition Hierarchy) includes: selector)
+ ifTrue:
+ ["Not really a selector"
+ ^ nil].
+ source := self sourceCodeAt: selector asSymbol ifAbsent: [^ nil].
+ parser := self parserClass new.
+ tree :=
+ parser
+ parse: (ReadStream on: source)
+ class: self
+ noPattern: false
+ context: nil
+ notifying: nil
+ ifFail: [^ nil].
+ ^ (tree comment ifNil: [^ nil]) first!
Item was added:
+ ----- Method: Behavior>>updateMethodDictionarySelector: (in category 'traits') -----
+ updateMethodDictionarySelector: aSymbol
+ "A method with selector aSymbol in myself or my traitComposition has been changed.
+ Do the appropriate update to my methodDict (remove or update method) and
+ return all affected selectors of me so that my useres get notified."
+
+ | modifiedSelectors descriptions |
+ modifiedSelectors := IdentitySet new.
+ descriptions := self hasTraitComposition
+ ifTrue: [ self traitComposition methodDescriptionsForSelector: aSymbol ]
+ ifFalse: [ #() ].
+ descriptions do: [:methodDescription | | effectiveMethod selector |
+ selector := methodDescription selector.
+ (self includesLocalSelector: selector) ifFalse: [
+ methodDescription isEmpty
+ ifTrue: [
+ self removeTraitSelector: selector.
+ modifiedSelectors add: selector]
+ ifFalse: [
+ effectiveMethod := methodDescription effectiveMethod.
+ (self compiledMethodAt: selector ifAbsent: [nil]) ~~ effectiveMethod ifTrue: [
+ self addTraitSelector: selector withMethod: effectiveMethod.
+ modifiedSelectors add: selector]]]].
+ ^modifiedSelectors!
Item was added:
+ ----- Method: Behavior>>traitOrClassOfSelector: (in category 'traits') -----
+ traitOrClassOfSelector: aSymbol
+ "Return the trait or the class which originally defines the method aSymbol
+ or return self if locally defined or if it is a conflict marker method.
+ This is primarly used by Debugger to determin the behavior in which a recompiled
+ method should be put. If a conflict method is recompiled it should be put into
+ the class, thus return self. Also see TraitComposition>>traitProvidingSelector:"
+
+ ((self includesLocalSelector: aSymbol) or: [
+ self hasTraitComposition not]) ifTrue: [^self].
+ ^(self traitComposition traitProvidingSelector: aSymbol) ifNil: [self]!
Item was added:
+ ----- Method: ClassDescription>>isInstanceSide (in category 'accessing parallel hierarchy') -----
+ isInstanceSide
+ ^self isClassSide not!
Item was added:
+ ----- Method: ClassDescription>>storeOn: (in category 'printing') -----
+ storeOn: aStream
+ "Classes and Metaclasses have global names."
+
+ aStream nextPutAll: self name!
Item was added:
+ ----- Method: Behavior>>deregisterLocalSelector: (in category 'accessing method dictionary') -----
+ deregisterLocalSelector: aSymbol
+ self basicLocalSelectors notNil ifTrue: [
+ self basicLocalSelectors remove: aSymbol ifAbsent: []]!
Item was added:
+ ----- Method: Behavior>>registerLocalSelector: (in category 'accessing method dictionary') -----
+ registerLocalSelector: aSymbol
+ self basicLocalSelectors notNil ifTrue: [
+ self basicLocalSelectors add: aSymbol]!
Item was added:
+ ----- Method: ClassDescription>>compile:classified:withStamp:notifying: (in category 'compiling') -----
+ compile: text classified: category withStamp: changeStamp notifying: requestor
+ ^ self compile: text classified: category withStamp: changeStamp notifying: requestor logSource: self acceptsLoggingOfCompilation!
Item was added:
+ ----- Method: ClassDescription>>methodsFor:priorSource:inFile: (in category 'fileIn/Out') -----
+ methodsFor: aString priorSource: sourcePosition inFile: fileIndex
+ "Prior source pointer ignored when filing in."
+ ^ self methodsFor: aString!
Item was added:
+ ----- Method: Behavior>>firstCommentAt: (in category 'accessing method dictionary') -----
+ firstCommentAt: selector
+ "Answer a string representing the first comment in the method associated with selector. Return an empty string if the relevant source file is not available, or if the method's source code does not contain a comment. Not smart enough to bypass quotes in string constants, but does map doubled quote into a single quote."
+
+ |someComments|
+ someComments := self commentsAt: selector.
+ ^someComments isEmpty ifTrue: [''] ifFalse: [someComments first]
+
+
+ "Behavior firstCommentAt: #firstCommentAt:"!
Item was added:
+ ----- Method: Behavior>>basicAddTraitSelector:withMethod: (in category 'traits') -----
+ basicAddTraitSelector: aSymbol withMethod: aCompiledMethod
+ "Add aMethod with selector aSymbol to my
+ methodDict. aMethod must not be defined locally.
+ Note that I am overridden by ClassDescription
+ to do a recompilation of the method if it has supersends."
+
+ self assert: [(self includesLocalSelector: aSymbol) not].
+ self ensureLocalSelectors.
+ self basicAddSelector: aSymbol withMethod: aCompiledMethod.!
Item was added:
+ ----- Method: ClassDescription>>putClassCommentToCondensedChangesFile: (in category 'fileIn/Out') -----
+ putClassCommentToCondensedChangesFile: aFileStream
+ "Called when condensing changes. If the receiver has a class comment, and if that class comment does not reside in the .sources file, then write it to the given filestream, with the resulting RemoteString being reachable from the source file #2. Note that any existing backpointer into the .sources file is lost by this process -- a situation that maybe should be fixed someday."
+
+ | header aStamp aCommentRemoteStr |
+ self isMeta ifTrue: [^ self]. "bulletproofing only"
+ ((aCommentRemoteStr := self organization commentRemoteStr) isNil or:
+ [aCommentRemoteStr sourceFileNumber == 1]) ifTrue: [^ self].
+
+ aFileStream cr; nextPut: $!!.
+ header := String streamContents: [:strm | strm nextPutAll: self name;
+ nextPutAll: ' commentStamp: '.
+ (aStamp := self organization commentStamp ifNil: ['<historical>']) storeOn: strm.
+ strm nextPutAll: ' prior: 0'].
+ aFileStream nextChunkPut: header.
+ aFileStream cr.
+ self organization classComment: (RemoteString newString: self organization classComment onFileNumber: 2 toFile: aFileStream) stamp: aStamp!
Item was added:
+ ----- Method: Behavior>>includesSelector: (in category 'testing method dictionary') -----
+ includesSelector: aSymbol
+ "Answer whether the message whose selector is the argument is in the
+ method dictionary of the receiver's class."
+
+ ^ self methodDict includesKey: aSymbol!
Item was added:
+ ----- Method: ClassDescription>>printCategoryChunk:withStamp:on: (in category 'fileIn/Out') -----
+ printCategoryChunk: categoryName withStamp: changeStamp on: aFileStream
+ ^ self printCategoryChunk: categoryName on: aFileStream withStamp: changeStamp
+ priorMethod: nil!
Item was added:
+ ----- Method: Behavior>>binding (in category 'compiling') -----
+ binding
+ ^ nil -> self!
Item was added:
+ ----- Method: Behavior>>removeFromComposition: (in category 'traits') -----
+ removeFromComposition: aTrait
+ self setTraitComposition: (self traitComposition copy
+ removeFromComposition: aTrait)!
Item was added:
+ ----- Method: Class>>category: (in category 'organization') -----
+ category: aString
+ "Categorize the receiver under the system category, aString, removing it from
+ any previous categorization."
+
+ | oldCategory |
+ oldCategory := self basicCategory.
+ aString isString
+ ifTrue: [
+ self basicCategory: aString asSymbol.
+ SystemOrganization classify: self name under: self basicCategory ]
+ ifFalse: [self errorCategoryName].
+ SystemChangeNotifier uniqueInstance
+ class: self recategorizedFrom: oldCategory to: self basicCategory!
Item was added:
+ ----- Method: ClassDescription>>fileOutMethod: (in category 'fileIn/Out') -----
+ fileOutMethod: selector
+ "Write source code of a single method on a file. Make up a name for the file."
+ self fileOutMethod: selector asHtml: false!
Item was added:
+ ----- Method: Behavior>>compress (in category 'accessing method dictionary') -----
+ compress
+ "Compact the method dictionary of the receiver."
+
+ self methodDict rehash!
Item was added:
+ ----- Method: ClassDescription>>whichCategoryIncludesSelector: (in category 'organization') -----
+ whichCategoryIncludesSelector: aSelector
+ "Answer the category of the argument, aSelector, in the organization of
+ the receiver, or answer nil if the receiver does not inlcude this selector."
+
+ (self includesSelector: aSelector)
+ ifTrue: [^ self organization categoryOfElement: aSelector]
+ ifFalse: [^nil]!
Item was added:
+ ----- Method: Behavior>>thoroughWhichSelectorsReferTo:special:byte: (in category 'testing method dictionary') -----
+ thoroughWhichSelectorsReferTo: literal special: specialFlag byte: specialByte
+ "Answer a set of selectors whose methods access the argument as a
+ literal. Dives into the compact literal notation, making it slow but
+ thorough "
+
+ | who |
+ who := IdentitySet new.
+ self selectorsAndMethodsDo:
+ [:sel :method |
+ ((method hasLiteralThorough: literal) or: [specialFlag and: [method scanFor: specialByte]])
+ ifTrue:
+ [((literal isVariableBinding) not
+ or: [method literals allButLast includes: literal])
+ ifTrue: [who add: sel]]].
+ ^ who!
Item was added:
+ ----- Method: Behavior>>addSelectorSilently:withMethod: (in category 'adding/removing methods') -----
+ addSelectorSilently: selector withMethod: compiledMethod
+ self methodDictAddSelectorSilently: selector withMethod: compiledMethod.
+ self registerLocalSelector: selector!
Item was added:
+ ----- Method: ClassDescription>>compileSilently:classified:notifying: (in category 'compiling') -----
+ compileSilently: code classified: category notifying: requestor
+ "Compile the code and classify the resulting method in the given category, leaving no trail in the system log, nor in any change set, nor in the 'recent submissions' list. This should only be used when you know for sure that the compilation will succeed."
+
+ ^ SystemChangeNotifier uniqueInstance
+ doSilently: [self compile: code classified: category withStamp: nil notifying: requestor logSource: false].!
Item was added:
+ ----- Method: ClassDescription>>methodReferencesInCategory: (in category 'organization') -----
+ methodReferencesInCategory: aCategoryName
+ ^(self organization listAtCategoryNamed: aCategoryName)
+ collect: [:ea | MethodReference new
+ setClassSymbol: self theNonMetaClass name
+ classIsMeta: self isMeta
+ methodSymbol: ea
+ stringVersion: '']
+ !
Item was added:
+ ----- Method: Behavior>>removeAlias:of: (in category 'traits') -----
+ removeAlias: aSymbol of: aTrait
+ self setTraitComposition: (
+ self traitComposition copyWithoutAlias: aSymbol of: aTrait)!
Item was added:
+ ----- Method: ClassDescription>>printOnStream: (in category 'printing') -----
+ printOnStream: aStream
+ aStream print: self name!
Item was added:
+ ----- Method: ClassDescription>>compile:classified:notifying: (in category 'compiling') -----
+ compile: text classified: category notifying: requestor
+ | stamp |
+ stamp := self acceptsLoggingOfCompilation ifTrue: [Utilities changeStamp] ifFalse: [nil].
+ ^ self compile: text classified: category
+ withStamp: stamp notifying: requestor!
Item was added:
+ ----- Method: ClassDescription>>methodsFor:stamp: (in category 'fileIn/Out') -----
+ methodsFor: categoryName stamp: changeStamp
+ ^ self methodsFor: categoryName stamp: (Utilities fixStamp: changeStamp) prior: 0!
Item was added:
+ ----- Method: ClassDescription>>fileOutCategory: (in category 'fileIn/Out') -----
+ fileOutCategory: catName
+ ^ self fileOutCategory: catName asHtml: false!
Item was added:
+ ----- Method: Behavior>>compiledMethodAt:ifAbsent: (in category 'accessing method dictionary') -----
+ compiledMethodAt: selector ifAbsent: aBlock
+ "Answer the compiled method associated with the argument, selector (a Symbol), a message selector in the receiver's method dictionary. If the selector is not in the dictionary, return the value of aBlock"
+
+ ^ self methodDict at: selector ifAbsent: [aBlock value]!
Item was added:
+ ----- Method: ClassDescription>>copyAllCategoriesFrom: (in category 'copying') -----
+ copyAllCategoriesFrom: aClass
+ "Specify that the categories of messages for the receiver include all of
+ those found in the class, aClass. Install each of the messages found in
+ these categories into the method dictionary of the receiver, classified
+ under the appropriate categories."
+
+ aClass organization categories do: [:cat | self copyCategory: cat from: aClass]!
Item was added:
+ Object subclass: #Behavior
+ instanceVariableNames: 'superclass methodDict format'
+ classVariableNames: 'ObsoleteSubclasses'
+ poolDictionaries: ''
+ category: 'Kernel-Classes'!
+
+ !Behavior commentStamp: 'al 12/8/2005 20:44' prior: 0!
+ My instances describe the behavior of other objects. I provide the minimum state necessary for compiling methods, and creating and running instances. Most objects are created as instances of the more fully supported subclass, Class, but I am a good starting point for providing instance-specific behavior (as in Metaclass).!
Item was added:
+ ----- Method: Behavior>>crossReference (in category 'user interface') -----
+ crossReference
+ "Answer an Array of arrays of size 2 whose first element is a message selector in the receiver's method dictionary and whose second element is a set of all message selectors in the method dictionary whose methods send a message with that selector. Subclasses are not included."
+
+ ^self selectors asArray sort collect: [:x | Array
+ with: (String with: Character cr), x
+ with: (self whichSelectorsReferTo: x)]
+
+ "Point crossReference."!
Item was added:
+ ----- Method: Metaclass>>noteNewBaseTraitCompositionApplied: (in category 'composition') -----
+ noteNewBaseTraitCompositionApplied: aTraitComposition
+ "The argument is the new trait composition of my base trait - add
+ the new traits or remove non existing traits on my class side composition.
+ (Each class trait in my composition has its base trait on the instance side
+ of the composition - manually added traits to the class side are always
+ base traits.)"
+
+ | newComposition traitsFromInstanceSide |
+ traitsFromInstanceSide := self traitComposition traits
+ select: [:each | each isClassTrait]
+ thenCollect: [:each | each baseTrait].
+
+ newComposition := self traitComposition copyTraitExpression.
+ (traitsFromInstanceSide copyWithoutAll: aTraitComposition traits) do: [:each |
+ newComposition removeFromComposition: each classTrait].
+ (aTraitComposition traits copyWithoutAll: traitsFromInstanceSide) do: [:each |
+ newComposition add: (each classTrait)].
+
+ self setTraitComposition: newComposition!
Item was added:
+ ----- Method: Behavior>>literalScannedAs:notifying: (in category 'printing') -----
+ literalScannedAs: scannedLiteral notifying: requestor
+ "Postprocesses a literal scanned by Scanner scanToken (esp. xLitQuote).
+ If scannedLiteral is not an association, answer it.
+ Else, if it is of the form:
+ nil->#NameOfMetaclass
+ answer nil->theMetaclass, if any has that name, else report an error.
+ Else, if it is of the form:
+ #NameOfGlobalVariable->anythiEng
+ answer the global, class, or pool association with that nameE, if any, else
+ add it to Undeclared a answer the new Association."
+
+ | key value |
+ (scannedLiteral isVariableBinding)
+ ifFalse: [^ scannedLiteral].
+ key := scannedLiteral key.
+ value := scannedLiteral value.
+ key isNil
+ ifTrue: "###<metaclass soleInstance name>"
+ [(self bindingOf: value) ifNotNil:[:assoc|
+ (assoc value isKindOf: Behavior)
+ ifTrue: [^ nil->assoc value class]].
+ requestor notify: 'No such metaclass'.
+ ^false].
+ (key isSymbol)
+ ifTrue: "##<global var name>"
+ [(self bindingOf: key) ifNotNil:[:assoc | ^assoc].
+ Undeclared at: key put: nil.
+ ^Undeclared bindingOf: key].
+ requestor notify: '## must be followed by a non-local variable name'.
+ ^false
+
+ " Form literalScannedAs: 14 notifying: nil 14
+ Form literalScannedAs: #OneBitForm notiEfying: nil OneBitForm
+ Form literalScannedAs: ##OneBitForm notifying: nil OneBitForm->a Form
+ Form literalScannedAs: ##Form notifying: nil Form->Form
+ Form literalScannedAs: ###Form notifying: nil nilE->Form class
+ "!
Item was added:
+ ----- Method: ClassDescription>>reformatAll (in category 'compiling') -----
+ reformatAll
+ "Reformat all methods in this class.
+ Leaves old code accessible to version browsing"
+ self selectorsDo: [:sel | self reformatMethodAt: sel]!
Item was added:
+ ----- Method: Behavior>>setTraitComposition: (in category 'traits') -----
+ setTraitComposition: aTraitComposition
+ | oldComposition |
+ (self hasTraitComposition not and: [aTraitComposition isEmpty]) ifTrue: [^self].
+ aTraitComposition assertValidUser: self.
+
+ oldComposition := self traitComposition.
+ self traitComposition: aTraitComposition.
+ self applyChangesOfNewTraitCompositionReplacing: oldComposition.
+
+ oldComposition traits do: [:each | each removeUser: self].
+ aTraitComposition traits do: [:each | each addUser: self]!
Item was added:
+ ----- Method: Behavior>>requirements (in category 'send caches') -----
+ requirements
+ ^ self requiredSelectorsCache
+ ifNil: [#()]
+ ifNotNil: [:rsc | rsc requirements]!
Item was added:
+ ----- Method: Behavior>>defaultNameStemForInstances (in category 'printing') -----
+ defaultNameStemForInstances
+ "Answer a basis for external names for default instances of the receiver.
+ For classees, the class-name itself is a good one."
+
+ ^ self name!
Item was added:
+ ----- Method: ClassDescription>>moveChangesTo: (in category 'fileIn/Out') -----
+ moveChangesTo: newFile
+ "Used in the process of condensing changes, this message requests that
+ the source code of all methods of the receiver that have been changed
+ should be moved to newFile."
+
+ | changes |
+ changes := self methodDict keys select: [:sel |
+ (self compiledMethodAt: sel) fileIndex > 1 and: [
+ (self includesLocalSelector: sel) or: [
+ (self compiledMethodAt: sel) sendsToSuper]]].
+ self
+ fileOutChangedMessages: changes
+ on: newFile
+ moveSource: true
+ toFile: 2!
Item was added:
+ ----- Method: Behavior>>recompile: (in category 'compiling') -----
+ recompile: selector
+ "Compile the method associated with selector in the receiver's method dictionary."
+ ^self recompile: selector from: self!
Item was added:
+ ----- Method: Behavior>>selectorsDo: (in category 'accessing method dictionary') -----
+ selectorsDo: selectorBlock
+ "Evaluate selectorBlock for all the message selectors in my method dictionary."
+
+ ^ self methodDict keysDo: selectorBlock!
Item was added:
+ ----- Method: Behavior>>isAliasSelector: (in category 'testing method dictionary') -----
+ isAliasSelector: aSymbol
+ "Return true if the selector aSymbol is an alias defined
+ in my or in another composition somewhere deeper in
+ the tree of traits compositions."
+
+ ^(self includesLocalSelector: aSymbol) not
+ and: [self hasTraitComposition]
+ and: [self traitComposition isAliasSelector: aSymbol]!
Item was added:
+ ----- Method: Behavior>>hasMethods (in category 'testing method dictionary') -----
+ hasMethods
+ "Answer whether the receiver has any methods in its method dictionary."
+
+ ^ self methodDict size > 0!
Item was added:
+ ----- Method: Metaclass>>assertConsistantCompositionsForNew: (in category 'composition') -----
+ assertConsistantCompositionsForNew: aTraitComposition
+ "Applying or modifying a trait composition on the class side
+ of a behavior has some restrictions."
+
+ | baseTraits notAddable message |
+ baseTraits := aTraitComposition traits select: [:each | each isBaseTrait].
+ baseTraits isEmpty ifFalse: [
+ notAddable := (baseTraits reject: [:each | each classSide methodDict isEmpty]).
+ notAddable isEmpty ifFalse: [
+ message := String streamContents: [:stream |
+ stream nextPutAll: 'You can not add the base trait(s)'; cr.
+ notAddable
+ do: [:each | stream nextPutAll: each name]
+ separatedBy: [ stream nextPutAll: ', '].
+ stream cr; nextPutAll: 'to this composition because it/they define(s) methods on the class side.'].
+ ^TraitCompositionException signal: message]].
+
+ (self instanceSide traitComposition traits asSet =
+ (aTraitComposition traits
+ select: [:each | each isClassTrait]
+ thenCollect: [:each | each baseTrait]) asSet) ifFalse: [
+ ^TraitCompositionException signal: 'You can not add or remove class side traits on
+ the class side of a composition. (But you can specify aliases or exclusions
+ for existing traits or add a trait which does not have any methods on the class side.)']!
Item was added:
+ ----- Method: ClassDescription>>methodsFor: (in category 'fileIn/Out') -----
+ methodsFor: categoryName
+ "Answer a ClassCategoryReader for compiling the messages in the category, categoryName, of the receiver."
+
+ ^ ClassCategoryReader new setClass: self category: categoryName asSymbol
+
+ "(False methodsFor: 'logical operations') inspect"!
Item was added:
+ ----- Method: Behavior>>whichSelectorsReferTo:special:byte: (in category 'testing method dictionary') -----
+ whichSelectorsReferTo: literal special: specialFlag byte: specialByte
+ "Answer a set of selectors whose methods access the argument as a literal."
+
+ | who |
+ who := IdentitySet new.
+ self selectorsAndMethodsDo:
+ [:sel :method |
+ ((method hasLiteral: literal) or: [specialFlag and: [method scanFor: specialByte]])
+ ifTrue:
+ [((literal isVariableBinding) not
+ or: [method literals allButLast includes: literal])
+ ifTrue: [who add: sel]]].
+ ^ who!
Item was added:
+ ----- Method: Behavior>>longPrintOn: (in category 'printing') -----
+ longPrintOn: aStream
+ "Append to the argument, aStream, the names and values of all of the receiver's instance variables. But, not useful for a class with a method dictionary."
+
+ aStream nextPutAll: '<<too complex to show>>'; cr.!
Item was added:
+ ----- Method: Behavior>>isLocalAliasSelector: (in category 'testing method dictionary') -----
+ isLocalAliasSelector: aSymbol
+ "Return true if the selector aSymbol is an alias defined
+ in my trait composition."
+
+ ^(self includesLocalSelector: aSymbol) not
+ and: [self hasTraitComposition]
+ and: [self traitComposition isLocalAliasSelector: aSymbol]!
Item was added:
+ ----- Method: Behavior>>notifyUsersOfChangedSelector: (in category 'traits') -----
+ notifyUsersOfChangedSelector: aSelector
+ self notifyUsersOfChangedSelectors: (Array with: aSelector)!
Item was added:
+ ----- Method: Behavior>>basicAddSelector:withMethod: (in category 'adding/removing methods') -----
+ basicAddSelector: selector withMethod: compiledMethod
+ "Add the message selector with the corresponding compiled method to the
+ receiver's method dictionary.
+ Do this without sending system change notifications"
+
+ | oldMethodOrNil |
+ oldMethodOrNil := self lookupSelector: selector.
+ self methodDict at: selector put: compiledMethod.
+ compiledMethod methodClass: self.
+ compiledMethod selector: selector.
+
+ "Now flush Squeak's method cache, either by selector or by method"
+ oldMethodOrNil == nil ifFalse: [oldMethodOrNil flushCache].
+ selector flushCache.!
Item was added:
+ ----- Method: ClassDescription>>reformatMethodAt: (in category 'compiling') -----
+ reformatMethodAt: selector
+ | newCodeString method |
+ newCodeString := self prettyPrinterClass
+ format: (self sourceCodeAt: selector)
+ in: self
+ notifying: nil
+ decorated: false.
+ method := self compiledMethodAt: selector.
+ method
+ putSource: newCodeString
+ fromParseNode: nil
+ class: self
+ category: (self organization categoryOfElement: selector)
+ inFile: 2
+ priorMethod: method
+ !
Item was added:
+ ----- Method: ClassDescription>>copyMethodDictionaryFrom: (in category 'copying') -----
+ copyMethodDictionaryFrom: donorClass
+ "Copy the method dictionary of the donor class over to the receiver"
+
+ self methodDict: donorClass copyOfMethodDictionary.
+ self organization: donorClass organization deepCopy.!
Item was added:
+ ----- Method: Behavior>>obsolete (in category 'initialization') -----
+ obsolete
+ "Invalidate and recycle local methods,
+ e.g., zap the method dictionary if can be done safely."
+ self canZapMethodDictionary
+ ifTrue: [self methodDict: self emptyMethodDictionary].
+ self hasTraitComposition ifTrue: [
+ self traitComposition traits do: [:each |
+ each removeUser: self]]!
Item was added:
+ ----- Method: ClassDescription>>printOn: (in category 'printing') -----
+ printOn: aStream
+ aStream nextPutAll: self name!
Item was added:
+ ----- Method: ClassDescription>>comment (in category 'accessing comment') -----
+ comment
+ "Answer the receiver's comment. (If missing, supply a template) "
+ | aString |
+ aString := self instanceSide organization classComment.
+ aString isEmpty ifFalse: [^ aString].
+ ^self classCommentBlank!
Item was added:
+ ----- Method: Behavior>>methodHeaderFor: (in category 'accessing method dictionary') -----
+ methodHeaderFor: selector
+ "Answer the string corresponding to the method header for the given selector"
+
+ | sourceString parser |
+ sourceString := self ultimateSourceCodeAt: selector ifAbsent: [self standardMethodHeaderFor: selector].
+ (parser := self parserClass new) parseSelector: sourceString.
+ ^ sourceString asString copyFrom: 1 to: (parser endOfLastToken min: sourceString size)
+
+ "Behavior methodHeaderFor: #methodHeaderFor: "
+ !
Item was added:
+ ----- Method: ClassDescription>>fileOutCategory:asHtml: (in category 'fileIn/Out') -----
+ fileOutCategory: catName asHtml: useHtml
+ "FileOut the named category, possibly in Html format."
+ | internalStream |
+ internalStream := WriteStream on: (String new: 1000).
+ internalStream header; timeStamp.
+ self fileOutCategory: catName on: internalStream moveSource: false toFile: 0.
+ internalStream trailer.
+
+ FileStream writeSourceCodeFrom: internalStream baseName: (self name , '-' , catName) isSt: true useHtml: useHtml.!
Item was added:
+ ----- Method: ClassDescription>>errorCategoryName (in category 'private') -----
+ errorCategoryName
+ self error: 'Category name must be a String'!
Item was added:
+ ----- Method: Behavior>>copy (in category 'copying') -----
+ copy
+ "Answer a copy of the receiver without a list of subclasses."
+
+ | myCopy |
+ myCopy := self shallowCopy.
+ ^myCopy methodDictionary: self copyOfMethodDictionary!
Item was added:
+ ----- Method: ClassDescription>>copyAll:from: (in category 'copying') -----
+ copyAll: selArray from: class
+ "Install all the methods found in the method dictionary of the second
+ argument, class, as the receiver's methods. Classify the messages under
+ -As yet not classified-."
+
+ self copyAll: selArray
+ from: class
+ classified: nil!
Item was added:
+ ----- Method: ClassDescription>>fileOutOrganizationOn: (in category 'fileIn/Out') -----
+ fileOutOrganizationOn: aFileStream
+ "File a description of the receiver's organization on aFileStream."
+
+ aFileStream cr; nextPut: $!!.
+ aFileStream nextChunkPut: self name, ' reorganize'; cr.
+ aFileStream nextChunkPut: self organization printString; cr!
Item was added:
+ ClassDescription subclass: #Class
+ instanceVariableNames: 'subclasses name classPool sharedPools environment category traitComposition localSelectors'
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'Kernel-Classes'!
+
+ !Class commentStamp: '<historical>' prior: 0!
+ I add a number of facilities to those in ClassDescription:
+ A set of all my subclasses (defined in ClassDescription, but only used here and below)
+ A name by which I can be found in a SystemDictionary
+ A classPool for class variables shared between this class and its metaclass
+ A list of sharedPools which probably should be supplanted by some better mechanism.
+
+ My instances describe the representation and behavior of objects. I add more comprehensive programming support facilities to the basic attributes of Behavior and the descriptive facilities of ClassDescription.
+
+ The slot 'subclasses' is a redundant structure. It is never used during execution, but is used by the development system to simplify or speed certain operations. !
Item was added:
+ ----- Method: Behavior>>implementsVocabulary: (in category 'testing method dictionary') -----
+ implementsVocabulary: aVocabulary
+ "Answer whether instances of the receiver respond to the messages in aVocabulary."
+
+ (aVocabulary isKindOf: FullVocabulary orOf: ScreenedVocabulary) ifTrue: [^ true].
+ ^ self fullyImplementsVocabulary: aVocabulary!
Item was added:
+ ----- Method: Behavior>>parseScope (in category 'newcompiler') -----
+ parseScope
+
+ ^ Smalltalk at: #ClassScope ifPresent: [:class | class new class: self]!
Item was added:
+ ----- Method: ClassDescription>>addSelectorSilently:withMethod: (in category 'accessing method dictionary') -----
+ addSelectorSilently: selector withMethod: compiledMethod
+ super addSelectorSilently: selector withMethod: compiledMethod.
+ self instanceSide noteAddedSelector: selector meta: self isMeta.!
Item was added:
Item was added:
+ ----- Method: Behavior>>selectorsAndMethodsDo: (in category 'accessing method dictionary') -----
+ selectorsAndMethodsDo: aBlock
+ "Evaluate selectorBlock for all the message selectors in my method dictionary."
+
+ ^ self methodDict keysAndValuesDo: aBlock!
Item was added:
+ ----- Method: Behavior>>hasRequiredSelectors (in category 'send caches') -----
+ hasRequiredSelectors
+ ^ self requiredSelectors notEmpty!
Item was added:
+ Behavior subclass: #ClassDescription
+ instanceVariableNames: 'instanceVariables organization'
+ classVariableNames: 'TraitImpl'
+ poolDictionaries: ''
+ category: 'Kernel-Classes'!
+
+ !ClassDescription commentStamp: '<historical>' prior: 0!
+ I add a number of facilities to basic Behaviors:
+ Named instance variables
+ Category organization for methods
+ The notion of a name of this class (implemented as subclass responsibility)
+ The maintenance of a ChangeSet, and logging changes on a file
+ Most of the mechanism for fileOut.
+
+ I am an abstract class, in particular, my facilities are intended for inheritance by two subclasses, Class and Metaclass.
+
+ The slots 'organization' and 'methodDict' should ONLY be accessed by message in order for things to work during ImageSegment>>discoverActiveClasses (q.v.).!
Item was added:
+ ----- Method: Behavior>>methodDictAddSelectorSilently:withMethod: (in category 'adding/removing methods') -----
+ methodDictAddSelectorSilently: selector withMethod: compiledMethod
+ self basicAddSelector: selector withMethod: compiledMethod!
Item was added:
+ ----- Method: Behavior>>purgeLocalSelectors (in category 'traits') -----
+ purgeLocalSelectors
+ self basicLocalSelectors: nil!
Item was added:
+ ----- Method: Behavior>>traitsProvidingSelector: (in category 'traits') -----
+ traitsProvidingSelector: aSymbol
+ | result |
+ result := OrderedCollection new.
+ self hasTraitComposition ifFalse: [^result].
+ (self traitComposition methodDescriptionsForSelector: aSymbol)
+ do: [:methodDescription | methodDescription selector = aSymbol ifTrue: [
+ result addAll: (methodDescription locatedMethods
+ collect: [:each | each location])]].
+ ^result!
Item was added:
+ ----- Method: ClassDescription>>noteAddedSelector:meta: (in category 'accessing method dictionary') -----
+ noteAddedSelector: aSelector meta: isMeta
+ "A hook allowing some classes to react to adding of certain selectors"!
Item was added:
+ ----- Method: Behavior>>methodDictionary: (in category 'accessing method dictionary') -----
+ methodDictionary: aDictionary
+ self methodDict: aDictionary!
Item was added:
+ ----- Method: ClassDescription>>compile:classified: (in category 'compiling') -----
+ compile: code classified: heading
+ "Compile the argument, code, as source code in the context of the
+ receiver and install the result in the receiver's method dictionary under
+ the classification indicated by the second argument, heading. nil is to be
+ notified if an error occurs. The argument code is either a string or an
+ object that converts to a string or a PositionableStream on an object that
+ converts to a string."
+
+ ^self
+ compile: code
+ classified: heading
+ notifying: nil!
Item was added:
+ ----- Method: Behavior>>superRequirements (in category 'send caches') -----
+ superRequirements
+ ^ self requiredSelectorsCache superRequirements!
Item was added:
+ ----- Method: Behavior>>applyChangesOfNewTraitCompositionReplacing: (in category 'traits') -----
+ applyChangesOfNewTraitCompositionReplacing: oldComposition
+ | changedSelectors |
+ changedSelectors := self traitComposition
+ changedSelectorsComparedTo: oldComposition.
+ changedSelectors isEmpty ifFalse: [
+ self noteChangedSelectors: changedSelectors].
+ self traitComposition isEmpty ifTrue: [
+ self purgeLocalSelectors].
+ ^changedSelectors!
Item was added:
+ ----- Method: Behavior>>changeRecordsAt: (in category 'accessing method dictionary') -----
+ changeRecordsAt: selector
+ "Return a list of ChangeRecords for all versions of the method at selector. Source code can be retrieved by sending string to any one. Return nil if the method is absent."
+
+ "(Pen changeRecordsAt: #go:) collect: [:cRec | cRec string]"
+ ^ChangeSet
+ scanVersionsOf: (self compiledMethodAt: selector ifAbsent: [^ nil])
+ class: self meta: self isMeta
+ category: (self whichCategoryIncludesSelector: selector)
+ selector: selector.!
Item was added:
+ ----- Method: Behavior>>sourceCodeTemplate (in category 'compiling') -----
+ sourceCodeTemplate
+ "Answer an expression to be edited and evaluated in order to define
+ methods in this class or trait."
+
+ ^'message selector and argument names
+ "comment stating purpose of message"
+
+ | temporary variable names |
+ statements'!
Item was added:
+ ----- Method: Behavior>>isProvidedSelector: (in category 'testing method dictionary') -----
+ isProvidedSelector: selector
+ ^ ProvidedSelectors current isSelector: selector providedIn: self
+ !
Item was added:
+ ----- Method: Behavior>>addSelector:withMethod:notifying: (in category 'adding/removing methods') -----
+ addSelector: selector withMethod: compiledMethod notifying: requestor
+ ^ self addSelectorSilently: selector withMethod: compiledMethod!
Item was added:
+ ----- Method: ClassDescription>>wantsRecompilationProgressReported (in category 'compiling') -----
+ wantsRecompilationProgressReported
+ "Answer whether the receiver would like progress of its recompilation reported interactively to the user."
+
+ ^ true!
Item was added:
+ ----- Method: ClassDescription>>methodsFor:stamp:prior: (in category 'fileIn/Out') -----
+ methodsFor: categoryName stamp: changeStamp prior: indexAndOffset
+ "Prior source link ignored when filing in."
+ ^ ClassCategoryReader new setClass: self
+ category: categoryName asSymbol
+ changeStamp: changeStamp
+
+ "Most importantly, return the new ClassCategoryReader, so a fileIn will let it seize control. So method will be placed in the proper category. See the transfer of control where ReadWriteStream fileIn calls scanFrom:"!
Item was added:
+ ----- Method: ClassDescription>>compileSilently:classified: (in category 'compiling') -----
+ compileSilently: code classified: category
+ "Compile the code and classify the resulting method in the given category, leaving no trail in the system log, nor in any change set, nor in the 'recent submissions' list. This should only be used when you know for sure that the compilation will succeed."
+
+ ^ self compileSilently: code classified: category notifying: nil.!
Item was added:
+ ----- Method: ClassDescription>>compile:notifying: (in category 'compiling') -----
+ compile: code notifying: requestor
+ "Refer to the comment in Behavior|compile:notifying:."
+
+ ^self compile: code
+ classified: ClassOrganizer default
+ notifying: requestor!
Item was added:
+ ----- Method: ClassDescription>>reorganize (in category 'organization') -----
+ 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 organization!
Item was added:
+ ----- Method: ClassDescription>>addAndClassifySelector:withMethod:inProtocol:notifying: (in category 'accessing method dictionary') -----
+ addAndClassifySelector: selector withMethod: compiledMethod inProtocol: category notifying: requestor
+ | priorMethodOrNil |
+ priorMethodOrNil := self compiledMethodAt: selector ifAbsent: [nil].
+ self addSelectorSilently: selector withMethod: compiledMethod.
+ SystemChangeNotifier uniqueInstance
+ doSilently: [self organization classify: selector under: category].
+ priorMethodOrNil isNil
+ ifTrue: [SystemChangeNotifier uniqueInstance methodAdded: compiledMethod selector: selector inProtocol: category class: self requestor: requestor]
+ ifFalse: [SystemChangeNotifier uniqueInstance methodChangedFrom: priorMethodOrNil to: compiledMethod selector: selector inClass: self requestor: requestor].!
Item was added:
+ ----- Method: Class>>category (in category 'organization') -----
+ category
+ "Answer the system organization category for the receiver. First check whether the
+ category name stored in the ivar is still correct and only if this fails look it up
+ (latter is much more expensive)"
+
+ | result |
+ self basicCategory ifNotNil: [ :symbol |
+ ((SystemOrganization listAtCategoryNamed: symbol) includes: self name)
+ ifTrue: [ ^symbol ] ].
+ self basicCategory: (result := SystemOrganization categoryOfElement: self name).
+ ^result!
Item was added:
+ ----- Method: ClassDescription>>isMeta (in category 'accessing parallel hierarchy') -----
+ isMeta
+ ^self isClassSide!
Item was added:
+ ----- Method: Behavior>>localSelectors (in category 'adding/removing methods') -----
+ localSelectors
+ "Return a set of selectors defined locally.
+ The instance variable is lazily initialized. If it is nil then there
+ are no non-local selectors"
+
+ ^ self basicLocalSelectors isNil
+ ifTrue: [self selectors]
+ ifFalse: [self basicLocalSelectors].!
Item was added:
+ ----- Method: Behavior>>environment (in category 'naming') -----
+ environment
+ "Return the environment in which the receiver is visible"
+ ^Smalltalk!
Item was added:
+ ----- Method: Behavior>>notifyUsersOfChangedSelectors: (in category 'traits') -----
+ notifyUsersOfChangedSelectors: aCollection!
Item was added:
+ ----- Method: Behavior>>evaluatorClass (in category 'compiling') -----
+ evaluatorClass
+ "Answer an evaluator class appropriate for evaluating expressions in the
+ context of this class."
+
+ ^Compiler!
Item was added:
+ ----- Method: Behavior>>canZapMethodDictionary (in category 'testing') -----
+ canZapMethodDictionary
+ "Return true if it is safe to zap the method dictionary on #obsolete"
+ ^true!
Item was added:
+ ----- Method: Behavior>>includesLocalSelector: (in category 'testing method dictionary') -----
+ includesLocalSelector: aSymbol
+ ^self basicLocalSelectors isNil
+ ifTrue: [self includesSelector: aSymbol]
+ ifFalse: [self localSelectors includes: aSymbol]!
Item was added:
+ ----- Method: ClassDescription>>removeCategory: (in category 'accessing method dictionary') -----
+ removeCategory: aString
+ "Remove each of the messages categorized under aString in the method
+ dictionary of the receiver. Then remove the category aString."
+ | categoryName |
+ categoryName := aString asSymbol.
+ (self organization listAtCategoryNamed: categoryName) do:
+ [:sel | self removeSelector: sel].
+ self organization removeCategory: categoryName!
Item was added:
+ ----- Method: Behavior>>spaceUsed (in category 'private') -----
+ spaceUsed
+ "Answer a rough estimate of number of bytes used by this class and its metaclass. Does not include space used by class variables."
+
+ | space |
+ space := 0.
+ self selectorsDo: [:sel | | method |
+ space := space + 16. "dict and org'n space"
+ method := self compiledMethodAt: sel.
+ space := space + (method size + 6 "hdr + avg pad").
+ method literals do: [:lit |
+ (lit isMemberOf: Array) ifTrue: [space := space + ((lit size + 1) * 4)].
+ (lit isMemberOf: Float) ifTrue: [space := space + 12].
+ (lit isMemberOf: ByteString) ifTrue: [space := space + (lit size + 6)].
+ (lit isMemberOf: LargeNegativeInteger) ifTrue: [space := space + ((lit size + 1) * 4)].
+ (lit isMemberOf: LargePositiveInteger) ifTrue: [space := space + ((lit size + 1) * 4)]]].
+ ^ space!
Item was added:
+ ----- Method: Behavior>>removeTraitSelector: (in category 'traits') -----
+ removeTraitSelector: aSymbol
+ self assert: [(self includesLocalSelector: aSymbol) not].
+ self basicRemoveSelector: aSymbol!
Item was added:
+ ----- Method: Behavior>>recompileNonResidentMethod:atSelector:from: (in category 'compiling') -----
+ recompileNonResidentMethod: method atSelector: selector from: oldClass
+ "Recompile the method supplied in the context of this class."
+
+ | trailer methodNode |
+ trailer := method trailer.
+ methodNode := self compilerClass new
+ compile: (method getSourceFor: selector in: oldClass)
+ in: self
+ notifying: nil
+ ifFail: ["We're in deep doo-doo if this fails (syntax error).
+ Presumably the user will correct something and proceed,
+ thus installing the result in this methodDict. We must
+ retrieve that new method, and restore the original (or remove)
+ and then return the method we retrieved."
+ ^ self error: 'see comment'].
+ selector == methodNode selector ifFalse: [self error: 'selector changed!!'].
+ ^ methodNode generate: trailer
+ !
Item was added:
+ ----- Method: Behavior>>decompilerClass (in category 'compiling') -----
+ decompilerClass
+ "Answer a decompiler class appropriate for compiled methods of this class."
+
+ ^ self compilerClass decompilerClass!
Item was added:
+ ----- Method: Behavior>>standardMethodHeaderFor: (in category 'accessing method dictionary') -----
+ standardMethodHeaderFor: aSelector
+ | args |
+ args := (1 to: aSelector numArgs) collect:[:i| 'arg', i printString].
+ args size = 0 ifTrue:[^aSelector asString].
+ args size = 1 ifTrue:[^aSelector,' arg1'].
+ ^String streamContents:[:s|
+ (aSelector findTokens:':') with: args do:[:tok :arg|
+ s nextPutAll: tok; nextPutAll:': '; nextPutAll: arg; nextPutAll:' '.
+ ].
+ ].
+ !
Item was added:
+ ----- Method: Behavior>>sourceMethodAt:ifAbsent: (in category 'accessing method dictionary') -----
+ sourceMethodAt: selector ifAbsent: aBlock
+ "Answer the paragraph corresponding to the source code for the
+ argument."
+
+ ^ (self sourceCodeAt: selector ifAbsent: [^ aBlock value]) asText makeSelectorBoldIn: self!
Item was added:
+ ----- Method: ClassDescription>>hasComment (in category 'accessing comment') -----
+ hasComment
+ "return whether this class truly has a comment other than the default"
+ | org |
+ org := self instanceSide organization.
+ ^org classComment isEmptyOrNil not!
Item was added:
+ ----- Method: ClassDescription>>wantsChangeSetLogging (in category 'compiling') -----
+ wantsChangeSetLogging
+ "Answer whether code submitted for the receiver should be remembered by the changeSet mechanism. 7/12/96 sw"
+
+ ^ true!
Item was added:
+ ----- Method: Behavior>>decompile: (in category 'compiling') -----
+ decompile: selector
+ "Find the compiled code associated with the argument, selector, as a
+ message selector in the receiver's method dictionary and decompile it.
+ Answer the resulting source code as a string. Create an error notification
+ if the selector is not in the receiver's method dictionary."
+
+ ^self decompilerClass new decompile: selector in: self!
Item was added:
+ ----- Method: ClassDescription>>copyCategory:from:classified: (in category 'copying') -----
+ copyCategory: cat from: aClass classified: newCat
+ "Specify that one of the categories of messages for the receiver is the
+ third argument, newCat. Copy each message found in the category cat in
+ class aClass into this new category."
+
+ self copyAll: (aClass organization listAtCategoryNamed: cat)
+ from: aClass
+ classified: newCat!
Item was added:
+ ClassDescription subclass: #Metaclass
+ instanceVariableNames: 'thisClass traitComposition localSelectors'
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'Kernel-Classes'!
+
+ !Metaclass commentStamp: '<historical>' prior: 0!
+ My instances add instance-specific behavior to various class-describing objects in the system. This typically includes messages for initializing class variables and instance creation messages particular to a class. There is only one instance of a particular Metaclass, namely the class which is being described. A Metaclass shares the class variables of its instance.
+
+ [Subtle] In general, the superclass hierarchy for metaclasses parallels that for classes. Thus,
+ Integer superclass == Number, and
+ Integer class superclass == Number class.
+ However there is a singularity at Object. Here the class hierarchy terminates, but the metaclass hierarchy must wrap around to Class, since ALL metaclasses are subclasses of Class. Thus,
+ Object superclass == nil, and
+ Object class superclass == Class.
+
+ [Subtle detail] A class is know by name to an environment. Typically this is the SystemDictionary named Smalltalk. If we ever make lightweight classes that are not in Smalltalk, they must be in some environment. Specifically, the code that sets 'wasPresent' in name:inEnvironment:subclassOf:instanceVariableNames:variable:words:pointers:classVariableNames:poolDictionaries:category:comment:changed: must continue to work.!
Item was added:
+ ----- Method: Behavior>>recompile:from: (in category 'compiling') -----
+ recompile: selector from: oldClass
+ "Compile the method associated with selector in the receiver's method dictionary."
+ "ar 7/10/1999: Use oldClass compiledMethodAt: not self compiledMethodAt:"
+ | method trailer methodNode |
+ method := oldClass compiledMethodAt: selector.
+ trailer := method trailer.
+ methodNode := self compilerClass new
+ compile: (oldClass sourceCodeAt: selector)
+ in: self
+ notifying: nil
+ ifFail: [^ self]. "Assume OK after proceed from SyntaxError"
+ selector == methodNode selector ifFalse: [self error: 'selector changed!!'].
+ self basicAddSelector: selector withMethod: (methodNode generate: trailer).
+ !
Item was added:
+ ----- Method: Behavior>>compileAllFrom: (in category 'compiling') -----
+ compileAllFrom: oldClass
+ "Compile all the methods in the receiver's method dictionary.
+ This validates sourceCode and variable references and forces
+ all methods to use the current bytecode set"
+ "ar 7/10/1999: Use oldClass selectors not self selectors"
+
+ oldClass selectorsDo: [:sel | self recompile: sel from: oldClass].!
Item was added:
+ ----- Method: Behavior>>prettyPrinterClass (in category 'printing') -----
+ prettyPrinterClass
+ ^self compilerClass!
Item was added:
+ ----- Method: Behavior>>compile:notifying: (in category 'compiling') -----
+ compile: code notifying: requestor
+ "Compile the argument, code, as source code in the context of the
+ receiver and insEtall the result in the receiver's method dictionary. The
+ second argument, requestor, is to be notified if an error occurs. The
+ argument code is either a string or an object that converts to a string or
+ a PositionableStream. This method also saves the source code."
+
+ | methodAndNode |
+ methodAndNode := self
+ compile: code "a Text"
+ classified: nil
+ notifying: requestor
+ trailer: self defaultMethodTrailer
+ ifFail: [^nil].
+ methodAndNode method putSource: code fromParseNode: methodAndNode node inFile: 2
+ withPreamble: [:f | f cr; nextPut: $!!; nextChunkPut: 'Behavior method'; cr].
+ self addSelector: methodAndNode selector withMethod: methodAndNode method notifying: requestor.
+ ^ methodAndNode selector!
Item was added:
+ ----- Method: ClassDescription>>compile:classified:withStamp:notifying:logSource: (in category 'compiling') -----
+ compile: text classified: category withStamp: changeStamp notifying: requestor logSource: logSource
+ | methodAndNode |
+ methodAndNode := self compile: text asString classified: category notifying: requestor
+ trailer: self defaultMethodTrailer ifFail: [^nil].
+ logSource ifTrue: [
+ self logMethodSource: text forMethodWithNode: methodAndNode
+ inCategory: category withStamp: changeStamp notifying: requestor.
+ ].
+ self addAndClassifySelector: methodAndNode selector withMethod: methodAndNode
+ method inProtocol: category notifying: requestor.
+ self instanceSide noteCompilationOf: methodAndNode selector meta: self isClassSide.
+ ^ methodAndNode selector!
Item was added:
+ ----- Method: Behavior>>parserClass (in category 'compiling') -----
+ parserClass
+ "Answer a parser class to use for parsing method headers."
+
+ ^self compilerClass parserClass!
Item was added:
+ ----- Method: Behavior>>compile:classified:notifying:trailer:ifFail: (in category 'compiling') -----
+ compile: code classified: category notifying: requestor trailer: bytes ifFail: failBlock
+ "Compile code without logging the source in the changes file"
+
+ | methodNode |
+ methodNode := self compilerClass new
+ compile: code
+ in: self
+ classified: category
+ notifying: requestor
+ ifFail: failBlock.
+ ^ CompiledMethodWithNode generateMethodFromNode: methodNode trailer: bytes.!
Item was added:
+ ----- Method: ClassDescription>>noteRecategorizedSelectors:oldComposition: (in category 'organization updating') -----
+ noteRecategorizedSelectors: aCollection oldComposition: aTraitComposition
+
+ aCollection do: [:each | | oldCategory newCategory |
+ oldCategory := self organization categoryOfElement: each.
+ newCategory := (self traitComposition methodDescriptionForSelector: each) effectiveMethodCategory.
+ self noteRecategorizedSelector: each from: oldCategory to: newCategory]!
Item was added:
+ ----- Method: Behavior>>emptyMethodDictionary (in category 'initialization') -----
+ emptyMethodDictionary
+
+ ^ MethodDictionary new!
Item was added:
+ ----- Method: ClassDescription>>applyChangesOfNewTraitCompositionReplacing: (in category 'organization updating') -----
+ applyChangesOfNewTraitCompositionReplacing: oldComposition
+ | changedSelectors |
+ changedSelectors := super applyChangesOfNewTraitCompositionReplacing: oldComposition.
+ self noteRecategorizedSelectors: changedSelectors oldComposition: oldComposition.
+ ^ changedSelectors.!
Item was added:
+ ----- Method: ClassDescription>>printMethodChunk:withPreamble:on:moveSource:toFile: (in category 'fileIn/Out') -----
+ printMethodChunk: selector withPreamble: doPreamble on: outStream
+ moveSource: moveSource toFile: fileIndex
+ "Copy the source code for the method associated with selector onto the fileStream. If moveSource true, then also set the source code pointer of the method."
+ | preamble method oldPos newPos sourceFile endPos |
+ doPreamble
+ ifTrue: [preamble := self name , ' methodsFor: ' ,
+ (self organization categoryOfElement: selector) asString printString]
+ ifFalse: [preamble := ''].
+ method := self methodDict at: selector ifAbsent:
+ [outStream nextPutAll: selector; cr.
+ outStream tab; nextPutAll: '** ERROR!! THIS SCRIPT IS MISSING ** ' translated; cr; cr.
+ outStream nextPutAll: ' '.
+ ^ outStream].
+
+ ((method fileIndex = 0
+ or: [(SourceFiles at: method fileIndex) == nil])
+ or: [(oldPos := method filePosition) = 0])
+ ifTrue:
+ ["The source code is not accessible. We must decompile..."
+ preamble size > 0 ifTrue: [outStream cr; nextPut: $!!; nextChunkPut: preamble; cr].
+ outStream nextChunkPut: method decompileString]
+ ifFalse:
+ [sourceFile := SourceFiles at: method fileIndex.
+ preamble size > 0
+ ifTrue: "Copy the preamble"
+ [outStream copyPreamble: preamble from: sourceFile at: oldPos]
+ ifFalse:
+ [sourceFile position: oldPos].
+ "Copy the method chunk"
+ newPos := outStream position.
+ outStream copyMethodChunkFrom: sourceFile.
+ sourceFile skipSeparators. "The following chunk may have ]style["
+ sourceFile peek == $] ifTrue: [
+ outStream cr; copyMethodChunkFrom: sourceFile].
+ moveSource ifTrue: "Set the new method source pointer"
+ [endPos := outStream position.
+ method checkOKToAdd: endPos - newPos at: newPos.
+ method setSourcePosition: newPos inFile: fileIndex]].
+ preamble size > 0 ifTrue: [outStream nextChunkPut: ' '].
+ ^ outStream cr!
Item was added:
+ ----- Method: ClassDescription>>comment: (in category 'accessing comment') -----
+ comment: aStringOrText
+ "Set the receiver's comment to be the argument, aStringOrText."
+
+ self instanceSide classComment: aStringOrText.!
Item was added:
+ ----- Method: Behavior>>compile: (in category 'compiling') -----
+ compile: code
+ "Compile the argument, code, as source code in the context of the
+ receiver. Create an error notification if the code can not be compiled.
+ The argument is either a string or an object that converts to a string or a
+ PositionableStream on an object that converts to a string."
+
+ ^self compile: code notifying: nil!
Item was added:
+ ----- Method: ClassDescription>>notifyOfRecategorizedSelector:from:to: (in category 'organization updating') -----
+ notifyOfRecategorizedSelector: element from: oldCategory to: newCategory
+ SystemChangeNotifier uniqueInstance selector: element recategorizedFrom: oldCategory to: newCategory inClass: self!
Item was added:
+ ----- Method: ClassDescription>>addSelector:withMethod:notifying: (in category 'accessing method dictionary') -----
+ addSelector: selector withMethod: compiledMethod notifying: requestor
+ | priorMethodOrNil |
+ priorMethodOrNil := self compiledMethodAt: selector ifAbsent: [nil].
+ self addSelectorSilently: selector withMethod: compiledMethod.
+ priorMethodOrNil isNil
+ ifTrue: [SystemChangeNotifier uniqueInstance methodAdded: compiledMethod selector: selector inClass: self requestor: requestor]
+ ifFalse: [SystemChangeNotifier uniqueInstance methodChangedFrom: priorMethodOrNil to: compiledMethod selector: selector inClass: self requestor: requestor].!
Item was added:
+ ----- Method: Behavior>>formalParametersAt: (in category 'accessing method dictionary') -----
+ formalParametersAt: aSelector
+ "Return the names of the arguments used in this method."
+
+ | source |
+ source := self sourceCodeAt: aSelector ifAbsent: [^ #()]. "for now"
+ ^(self parserClass new) parseParameterNames: source!
Item was added:
+ ----- Method: Behavior>>formalHeaderPartsFor: (in category 'accessing method dictionary') -----
+ "popeye" formalHeaderPartsFor: "olive oil" aSelector
+ "RELAX!! The warning you may have just seen about possibly having a bad source file does not apply here, because this method *intends* to have its source code start with a comment.
+ This method returns a collection giving the parts in the formal declaration for aSelector. This parse is in support of schemes in which adjutant properties of a method can be declared via special comments secreted in the formal header
+ The result will have
+ 3 elements for a simple, argumentless selector.
+ 5 elements for a single-argument selector
+ 9 elements for a two-argument selector
+ 13 elements for a three-argument, selector
+ etc...
+
+ The syntactic elements are:
+
+ 1 comment preceding initial selector fragment
+
+ 2 first selector fragment
+ 3 comment following first selector fragment (nil if selector has no arguments)
+
+ ---------------------- (ends here for, e.g., #copy)
+
+ 4 first formal argument
+ 5 comment following first formal argument (nil if selector has only one argument)
+
+ ---------------------- (ends here for, e.g., #copyFrom:)
+
+ 6 second keyword
+ 7 comment following second keyword
+ 8 second formal argument
+ 9 comment following second formal argument (nil if selector has only two arguments)
+
+ ---------------------- (ends here for, e.g., #copyFrom:to:)
+
+ Any nil element signifies an absent comment.
+ NOTE: The comment following the final formal argument is *not* successfully retrieved by this method in its current form, though it can be obtained, if needed, by other means (e.g. calling #firstPrecodeCommentFor:). Thus, the *final* element in the structure returned by this method is always going to be nil."
+
+ ^ Scanner new scanMessageParts: (self methodHeaderFor: aSelector)
+
+ "
+ Behavior class formalHeaderPartsFor: #formalHeaderPartsFor:
+ "
+
+
+ !
Item was added:
+ ----- Method: ClassDescription>>doneCompiling (in category 'compiling') -----
+ doneCompiling
+ "A ClassBuilder has finished the compilation of the receiver.
+ This message is a notification for a class that needs to do some
+ cleanup / reinitialization after it has been recompiled."!
Item was added:
+ ----- Method: ClassDescription>>classComment: (in category 'fileIn/Out') -----
+ classComment: aString
+ "Store the comment, aString or Text or RemoteString, associated with the class we are orgainzing. Empty string gets stored only if had a non-empty one before."
+ ^ self classComment: aString stamp: '<historical>'!
Item was added:
+ ----- Method: Behavior>>compressedSourceCodeAt: (in category 'accessing method dictionary') -----
+ compressedSourceCodeAt: selector
+ "(Paragraph compressedSourceCodeAt: #displayLines:affectedRectangle:) size 721 1921
+ Paragraph selectors inject: 0 into: [:tot :sel | tot + (Paragraph compressedSourceCodeAt: sel) size] 13606 31450"
+ | rawText parse |
+ rawText := (self sourceCodeAt: selector) asString.
+ parse := self compilerClass new parse: rawText in: self notifying: nil.
+ ^ rawText compressWithTable:
+ ((selector keywords ,
+ parse tempNames ,
+ self instVarNames ,
+ #(self super ifTrue: ifFalse:) ,
+ ((0 to: 7) collect:
+ [:i | String streamContents:
+ [:s | s cr. i timesRepeat: [s tab]]]) ,
+ (self compiledMethodAt: selector) literalStrings)
+ asSortedCollection: [:a :b | a size > b size])!
Item was added:
+ ----- Method: Behavior>>copyOfMethodDictionary (in category 'copying') -----
+ copyOfMethodDictionary
+ "Return a copy of the receiver's method dictionary"
+
+ ^ self methodDict copy!
Item was added:
+ ----- Method: Behavior>>addExclusionOf:to: (in category 'traits') -----
+ addExclusionOf: aSymbol to: aTrait
+ self setTraitComposition: (
+ self traitComposition copyWithExclusionOf: aSymbol to: aTrait)!
Item was added:
+ ----- Method: Behavior>>fullyImplementsVocabulary: (in category 'testing method dictionary') -----
+ fullyImplementsVocabulary: aVocabulary
+ "Answer whether instances of the receiver respond to all the messages in aVocabulary"
+
+ (aVocabulary encompassesAPriori: self) ifTrue: [^ true].
+ aVocabulary allSelectorsInVocabulary do:
+ [:aSelector | (self canUnderstand: aSelector) ifFalse: [^ false]].
+ ^ true!
Item was added:
+ ----- Method: ClassDescription>>copy:from:classified: (in category 'copying') -----
+ copy: sel from: class classified: cat
+ "Install the method associated with the first arugment, sel, a message
+ selector, found in the method dictionary of the second argument, class,
+ as one of the receiver's methods. Classify the message under the third
+ argument, cat."
+
+ | code category |
+ "Useful when modifying an existing class"
+ code := class sourceMethodAt: sel.
+ code == nil
+ ifFalse:
+ [cat == nil
+ ifTrue: [category := class organization categoryOfElement: sel]
+ ifFalse: [category := cat].
+ (self methodDict includesKey: sel)
+ ifTrue: [code asString = (self sourceMethodAt: sel) asString
+ ifFalse: [self error: self name
+ , ' '
+ , sel
+ , ' will be redefined if you proceed.']].
+ self compile: code classified: category]!
Item was added:
+ ----- Method: ClassDescription>>copyCategory:from: (in category 'copying') -----
+ copyCategory: cat from: class
+ "Specify that one of the categories of messages for the receiver is cat, as
+ found in the class, class. Copy each message found in this category."
+
+ self copyCategory: cat
+ from: class
+ classified: cat!
Item was added:
+ ----- Method: ClassDescription>>printCategoryChunk:on:priorMethod: (in category 'fileIn/Out') -----
+ printCategoryChunk: category on: aFileStream priorMethod: priorMethod
+ ^ self printCategoryChunk: category on: aFileStream
+ withStamp: Utilities changeStamp priorMethod: priorMethod!
Item was added:
+ ----- Method: ClassDescription>>fileOutOn: (in category 'fileIn/Out') -----
+ fileOutOn: aFileStream
+ "File a description of the receiver on aFileStream."
+
+ self fileOutOn: aFileStream
+ moveSource: false
+ toFile: 0!
Item was added:
+ ----- Method: Behavior>>addSelector:withMethod: (in category 'adding/removing methods') -----
+ addSelector: selector withMethod: compiledMethod
+ ^ self addSelector: selector withMethod: compiledMethod notifying: nil!
Item was added:
+ ----- Method: ClassDescription>>copyAll:from:classified: (in category 'copying') -----
+ copyAll: selArray from: class classified: cat
+ "Install all the methods found in the method dictionary of the second
+ argument, class, as the receiver's methods. Classify the messages under
+ the third argument, cat."
+
+ selArray do:
+ [:s | self copy: s
+ from: class
+ classified: cat]!
Item was added:
+ ----- Method: ClassDescription>>commentStamp:prior: (in category 'fileIn/Out') -----
+ commentStamp: changeStamp prior: indexAndOffset
+ "Prior source link ignored when filing in."
+
+ ^ ClassCommentReader new setClass: self
+ category: #Comment
+ changeStamp: changeStamp!
Item was added:
+ ----- Method: Behavior>>traitTransformations (in category 'traits') -----
+ traitTransformations
+ ^ self traitComposition transformations !
Item was added:
+ ----- Method: ClassDescription>>printCategoryChunk:on:withStamp:priorMethod: (in category 'fileIn/Out') -----
+ printCategoryChunk: category on: aFileStream withStamp: changeStamp priorMethod: priorMethod
+ "Print a method category preamble. This must have a category name.
+ It may have an author/date stamp, and it may have a prior source link.
+ If it has a prior source link, it MUST have a stamp, even if it is empty."
+
+ "The current design is that changeStamps and prior source links are preserved in the changes file. All fileOuts include changeStamps. Condensing sources, however, eliminates all stamps (and links, natch)."
+
+ aFileStream cr; command: 'H3'; nextPut: $!!.
+ aFileStream nextChunkPut: (String streamContents:
+ [:strm |
+ strm nextPutAll: self name; nextPutAll: ' methodsFor: '; print: category asString.
+ (changeStamp ~~ nil and:
+ [changeStamp size > 0 or: [priorMethod ~~ nil]]) ifTrue:
+ [strm nextPutAll: ' stamp: '; print: changeStamp].
+ priorMethod ~~ nil ifTrue:
+ [strm nextPutAll: ' prior: '; print: priorMethod sourcePointer]]).
+ aFileStream command: '/H3'.!
Item was added:
+ ----- Method: Behavior>>withAllSuperclasses (in category 'accessing class hierarchy') -----
+ withAllSuperclasses
+ "Answer an OrderedCollection of the receiver and the receiver's
+ superclasses. The first element is the receiver,
+ followed by its superclass; the last element is Object."
+
+ | temp |
+ temp := self allSuperclasses.
+ temp addFirst: self.
+ ^ temp!
Item was added:
+ ----- Method: Behavior>>sourceCodeAt: (in category 'accessing method dictionary') -----
+ sourceCodeAt: selector
+
+ ^ (self methodDict at: selector) getSourceFor: selector in: self!
Item was added:
+ ----- Method: ClassDescription>>isClassSide (in category 'accessing parallel hierarchy') -----
+ isClassSide
+ ^self == self classSide!
Item was added:
+ ----- Method: ClassDescription>>fileOutMethod:asHtml: (in category 'fileIn/Out') -----
+ fileOutMethod: selector asHtml: useHtml
+ "Write source code of a single method on a file in .st or .html format"
+
+ | internalStream |
+ (selector == #Comment) ifTrue: [^ self inform: 'Sorry, cannot file out class comment in isolation.'].
+ (self includesSelector: selector) ifFalse: [^ self error: 'Selector ', selector asString, ' not found'].
+ internalStream := WriteStream on: (String new: 1000).
+ internalStream header; timeStamp.
+ self printMethodChunk: selector withPreamble: true
+ on: internalStream moveSource: false toFile: 0.
+
+ FileStream writeSourceCodeFrom: internalStream baseName: (self name , '-' , (selector copyReplaceAll: ':' with: '')) isSt: true useHtml: useHtml.
+ !
Item was added:
+ ----- Method: Behavior>>methodDictionary (in category 'accessing method dictionary') -----
+ methodDictionary
+ "Convenience"
+ ^self methodDict!
Item was added:
+ ----- Method: ClassDescription>>copy:from: (in category 'copying') -----
+ copy: sel from: class
+ "Install the method associated with the first argument, sel, a message
+ selector, found in the method dictionary of the second argument, class,
+ as one of the receiver's methods. Classify the message under -As yet not
+ classified-."
+
+ self copy: sel
+ from: class
+ classified: nil!
Item was added:
+ ----- Method: Behavior>>whichSelectorsReferTo: (in category 'testing method dictionary') -----
+ whichSelectorsReferTo: literal
+ "Answer a Set of selectors whose methods access the argument as a
+ literal."
+
+ | special byte |
+ special := self environment hasSpecialSelector: literal ifTrueSetByte: [:b |
+ byte := b].
+ ^self whichSelectorsReferTo: literal special: special byte: byte
+
+ "Rectangle whichSelectorsReferTo: #+."!
Item was added:
+ ----- Method: ClassDescription>>commentStamp: (in category 'fileIn/Out') -----
+ commentStamp: changeStamp
+ self organization commentStamp: changeStamp.
+ ^ self commentStamp: changeStamp prior: 0!
Item was added:
+ ----- Method: ClassDescription>>commentFollows (in category 'fileIn/Out') -----
+ commentFollows
+ "Answer a ClassCommentReader who will scan in the comment."
+
+ ^ ClassCommentReader new setClass: self category: #Comment
+
+ "False commentFollows inspect"!
Item was added:
+ ----- Method: Behavior>>sourceMethodAt: (in category 'accessing method dictionary') -----
+ sourceMethodAt: selector
+ "Answer the paragraph corresponding to the source code for the
+ argument."
+
+ ^(self sourceCodeAt: selector) asText makeSelectorBoldIn: self!
Item was added:
+ ----- Method: Behavior>>sendCaches: (in category 'send caches') -----
+ sendCaches: aSendCaches
+ ^ self explicitRequirement!
Item was added:
+ ----- Method: ClassDescription>>noteRecategorizedSelector:from:to: (in category 'organization updating') -----
+ noteRecategorizedSelector: aSymbol from: oldCategoryOrNil to: newCategoryOrNil
+ | changedCategories |
+ changedCategories := self updateOrganizationSelector: aSymbol oldCategory: oldCategoryOrNil newCategory: newCategoryOrNil.
+ changedCategories do: [:each |
+ (self organization isEmptyCategoryNamed: each) ifTrue: [self organization removeCategory: each]]!
Item was added:
+ ----- Method: Behavior>>>> (in category 'accessing method dictionary') -----
+ >> selector
+ "Answer the compiled method associated with the argument, selector (a
+ Symbol), a message selector in the receiver's method dictionary. If the
+ selector is not in the dictionary, create an error notification."
+
+ ^self compiledMethodAt: selector
+ !
Item was added:
+ ----- Method: Behavior>>isDisabledSelector: (in category 'testing method dictionary') -----
+ isDisabledSelector: selector
+ ^ self classAndMethodFor: selector do: [:c :m | m isDisabled] ifAbsent: [false]!
Item was added:
+ ----- Method: Behavior>>deepCopy (in category 'copying') -----
+ deepCopy
+ "Classes should only be shallowCopied or made anew."
+
+ ^ self shallowCopy!
Item was added:
+ ----- Method: Behavior>>compiledMethodAt: (in category 'accessing method dictionary') -----
+ compiledMethodAt: selector
+ "Answer the compiled method associated with the argument, selector (a
+ Symbol), a message selector in the receiver's method dictionary. If the
+ selector is not in the dictionary, create an error notification."
+
+ ^ self methodDict at: selector!
Item was added:
+ ----- Method: ClassDescription>>comment:stamp: (in category 'accessing comment') -----
+ comment: aStringOrText stamp: aStamp
+ "Set the receiver's comment to be the argument, aStringOrText."
+
+ self instanceSide classComment: aStringOrText stamp: aStamp.!
Item was added:
+ ----- Method: Behavior>>defaultMethodTrailer (in category 'compiling') -----
+ defaultMethodTrailer
+ ^ CompiledMethodTrailer empty!
Item was added:
+ ----- Method: ClassDescription>>fileOutChangedMessages:on: (in category 'fileIn/Out') -----
+ fileOutChangedMessages: aSet on: aFileStream
+ "File a description of the messages of the receiver that have been
+ changed (i.e., are entered into the argument, aSet) onto aFileStream."
+
+ self fileOutChangedMessages: aSet
+ on: aFileStream
+ moveSource: false
+ toFile: 0!
Item was added:
+ ----- Method: ClassDescription>>methods (in category 'fileIn/Out') -----
+ methods
+ "Answer a ClassCategoryReader for compiling messages that are not classified, as in fileouts made with Smalltalk/V"
+
+ ^ ClassCategoryReader new setClass: self category: ClassOrganizer default!
Item was added:
+ ----- Method: ClassDescription>>fileOutOn:moveSource:toFile: (in category 'fileIn/Out') -----
+ fileOutOn: aFileStream moveSource: moveSource toFile: fileIndex
+ "File a description of the receiver on aFileStream. If the boolean
+ argument, moveSource, is true, then set the trailing bytes to the position
+ of aFileStream and to fileIndex in order to indicate where to find the
+ source code."
+
+ aFileStream command: 'H3'.
+ aFileStream nextChunkPut: self definition.
+ aFileStream command: '/H3'.
+
+ self organization
+ putCommentOnFile: aFileStream
+ numbered: fileIndex
+ moveSource: moveSource
+ forClass: self.
+ self organization categories do:
+ [:heading |
+ self fileOutCategory: heading
+ on: aFileStream
+ moveSource: moveSource
+ toFile: fileIndex]!
Item was added:
+ ----- Method: Behavior>>noteChangedSelectors: (in category 'traits') -----
+ noteChangedSelectors: aCollection
+ "Start update of my methodDict (after changes to traits in traitComposition
+ or after a local method was removed from my methodDict). The argument
+ is a collection of method selectors that may have been changed. Most of the time
+ aCollection only holds one selector. But when there are aliases involved
+ there may be several method changes that have to be propagated to users."
+
+ | affectedSelectors |
+ affectedSelectors := IdentitySet new.
+ aCollection do: [:selector |
+ affectedSelectors addAll: (self updateMethodDictionarySelector: selector)].
+ self notifyUsersOfChangedSelectors: affectedSelectors.
+ ^ affectedSelectors!
Item was added:
+ ----- Method: Behavior>>compilerClass (in category 'compiling') -----
+ compilerClass
+ "Answer a compiler class appropriate for source methods of this class."
+
+ ^Compiler!
Item was added:
+ ----- Method: ClassDescription>>printCategoryChunk:on: (in category 'fileIn/Out') -----
+ printCategoryChunk: categoryName on: aFileStream
+ ^ self printCategoryChunk: categoryName withStamp: '' on: aFileStream!
Item was added:
+ ----- Method: Behavior>>ensureLocalSelectors (in category 'traits') -----
+ ensureLocalSelectors
+ "Ensures that the instance variable localSelectors is effectively used to maintain
+ the set of local selectors.
+ This method must be called before any non-local selectors are added to the
+ method dictionary!!"
+
+ self basicLocalSelectors isNil
+ ifTrue: [self basicLocalSelectors: self selectors asSet]!
Item was added:
+ ----- Method: ClassDescription>>noteCompilationOf:meta: (in category 'compiling') -----
+ noteCompilationOf: aSelector meta: isMeta
+ "A hook allowing some classes to react to recompilation of certain selectors"!
Item was added:
+ ----- Method: Behavior>>addToComposition: (in category 'traits') -----
+ addToComposition: aTrait
+ self setTraitComposition: (self traitComposition copyTraitExpression
+ add: aTrait;
+ yourself)!
Item was added:
+ ----- Method: Behavior>>setRequiredStatusOf:to: (in category 'send caches') -----
+ setRequiredStatusOf: selector to: aBoolean
+ aBoolean
+ ifTrue: [self requiredSelectorsCache addRequirement: selector]
+ ifFalse: [self requiredSelectorsCache removeRequirement: selector].!
Item was added:
+ ----- Method: Behavior>>traitCompositionString (in category 'traits') -----
+ traitCompositionString
+ ^self hasTraitComposition
+ ifTrue: [self traitComposition asString]
+ ifFalse: ['{}']!
Item was added:
+ ----- Method: Behavior>>traitCompositionIncludes: (in category 'traits') -----
+ traitCompositionIncludes: aTrait
+ ^self == aTrait or:
+ [self hasTraitComposition and:
+ [self traitComposition allTraits includes: aTrait]]!
Item was added:
+ ----- Method: Behavior>>setTraitCompositionFrom: (in category 'traits') -----
+ setTraitCompositionFrom: aTraitExpression
+ ^ self setTraitComposition: aTraitExpression asTraitComposition!
Item was added:
+ ----- Method: Behavior>>sourceCodeAt:ifAbsent: (in category 'accessing method dictionary') -----
+ sourceCodeAt: selector ifAbsent: aBlock
+
+ ^ (self methodDict at: selector ifAbsent: [^ aBlock value]) getSourceFor: selector in: self!
Item was added:
+ ----- Method: ClassDescription>>acceptsLoggingOfCompilation (in category 'compiling') -----
+ acceptsLoggingOfCompilation
+ "weird name is so that it will come lexically before #compile, so that a clean build can make it through. 7/7/96 sw"
+
+ ^ true!
Item was added:
+ ----- Method: Behavior>>recompileChanges (in category 'compiling') -----
+ recompileChanges
+ "Compile all the methods that are in the changes file.
+ This validates sourceCode and variable references and forces
+ methods to use the current bytecode set"
+
+ self selectorsDo:
+ [:sel | (self compiledMethodAt: sel) fileIndex > 1 ifTrue:
+ [self recompile: sel from: self]]!
Item was added:
+ ----- Method: Behavior>>methodsDo: (in category 'accessing method dictionary') -----
+ methodsDo: aBlock
+ "Evaluate aBlock for all the compiled methods in my method dictionary."
+
+ ^ self methodDict valuesDo: aBlock!
More information about the Packages
mailing list