Packages December 2009

packages@lists.squeakfoundation.org

1 participants
1032 discussions

The Trunk: Traits-ar.266.mcz
by commits＠source.squeak.org 31 Dec '09

31 Dec '09

Andreas Raab uploaded a new version of Traits to project The Trunk: http://source.squeak.org/trunk/Traits-ar.266.mcz ==================== Summary ==================== Name: Traits-ar.266 Author: ar Time: 30 December 2009, 3:31:24 am UUID: c7cb8d8d-6e4b-9e48-92e4-7f5276214983 Ancestors: Traits-ar.265 Also remove Trait class>>initialize. =============== Diff against Traits-ar.264 =============== Item was changed: ----- Method: ClassDescription>>traitComposition: (in category '*Traits-NanoKernel') ----- traitComposition: aTraitComposition "Install my trait composition" + aTraitComposition isEmptyOrNil ifTrue:[ - aTraitComposition isEmpty ifTrue:[ self organization isTraitOrganizer ifTrue:[self organization: (ClassOrganizer newFrom: self organization)]. ] ifFalse:[ self organization isTraitOrganizer ifFalse:[self organization: (TraitOrganizer newFrom: self organization)]. self organization traitComposition: aTraitComposition. ]. ! Item was removed: - ----- Method: TraitDescription>>traitComposition (in category 'accessing') ----- - traitComposition - ^traitComposition ifNil:[traitComposition := TraitComposition new] - ! Item was removed: - ----- Method: TraitDescription>>traitComposition: (in category 'accessing') ----- - traitComposition: aTraitComposition - super traitComposition: aTraitComposition. - traitComposition := aTraitComposition. - ! Item was removed: - ----- Method: Trait class>>initialize (in category 'class initialization') ----- - initialize - "Push traitsComposition down into organizer" - Smalltalk allClassesAndTraits do:[:aClass| - aClass traitComposition: aClass traitComposition. - aClass classSide traitComposition: aClass classSide traitComposition. - ].!

1 0

The Trunk: Traits-ar.264.mcz
by commits＠source.squeak.org 31 Dec '09

31 Dec '09

Andreas Raab uploaded a new version of Traits to project The Trunk: http://source.squeak.org/trunk/Traits-ar.264.mcz ==================== Summary ==================== Name: Traits-ar.264 Author: ar Time: 30 December 2009, 3:03:01 am UUID: d97a55ef-c640-a34e-8e45-5d0883cf1488 Ancestors: Traits-ar.263 Push traitsComposition into TraitOrganizer. =============== Diff against Traits-ar.263 =============== Item was added: + ----- Method: Trait class>>initialize (in category 'class initialization') ----- + initialize + "Push traitsComposition down into organizer" + Smalltalk allClassesAndTraits do:[:aClass| + aClass traitComposition: aClass traitComposition. + aClass classSide traitComposition: aClass classSide traitComposition. + ].!

1 0

The Trunk: Traits-ar.264.mcz
by commits＠source.squeak.org 31 Dec '09

31 Dec '09

1 0

The Trunk: Traits-ar.264.mcz
by commits＠source.squeak.org 31 Dec '09

31 Dec '09

1 0

The Trunk: Kernel-ar.353.mcz
by commits＠source.squeak.org 31 Dec '09

31 Dec '09

Andreas Raab uploaded a new version of Kernel to project The Trunk: http://source.squeak.org/trunk/Kernel-ar.353.mcz ==================== Summary ==================== Name: Kernel-ar.353 Author: ar Time: 30 December 2009, 2:59:15 am UUID: 6854a358-f04b-c04c-9584-10181b0c5523 Ancestors: Kernel-ar.352 Prepare to push the trait composition into TraitOrganizer to avoid duplication in three places (Class, Metaclass, TraitDescription). =============== Diff against Kernel-ar.352 =============== Item was changed: ----- 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 hasTraitComposition ifFalse:[ + self organization: nil. + self isClassSide ifFalse: [self classSide zapOrganization] + ].! - self organization: nil. - self isClassSide ifFalse: [self classSide zapOrganization]! Item was changed: ----- 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].! - ifTrue: [self methodDict: self emptyMethodDictionary]. - self hasTraitComposition ifTrue: [ - self traitComposition traits do: [:each | - each removeUser: self]]! Item was changed: ----- Method: Class>>traitComposition: (in category 'accessing') ----- traitComposition: aTraitComposition + super traitComposition: aTraitComposition. traitComposition := aTraitComposition! Item was changed: ----- Method: ClassDescription>>obsolete (in category 'initialize-release') ----- obsolete "Make the receiver obsolete." + self hasTraitComposition ifTrue: [ + self traitComposition traits do: [:each | + each removeUser: self]]. superclass removeSubclass: self. self organization: nil. super obsolete.! Item was changed: ----- Method: Metaclass>>traitComposition: (in category 'accessing') ----- traitComposition: aTraitComposition + super traitComposition: aTraitComposition. traitComposition := aTraitComposition!

1 0

The Trunk: Kernel-ar.353.mcz
by commits＠source.squeak.org 31 Dec '09

31 Dec '09

1 0

The Trunk: Kernel-ar.353.mcz
by commits＠source.squeak.org 31 Dec '09

31 Dec '09

1 0

The Trunk: Traits-ar.263.mcz
by commits＠source.squeak.org 31 Dec '09

31 Dec '09

Andreas Raab uploaded a new version of Traits to project The Trunk: http://source.squeak.org/trunk/Traits-ar.263.mcz ==================== Summary ==================== Name: Traits-ar.263 Author: ar Time: 30 December 2009, 2:55:32 am UUID: 82cf76b0-2144-a34d-9067-f131dce10b15 Ancestors: Traits-ar.262 Prepare to push traitComposition into TraitOrganizer so that we don't need to duplicate it in three places (Class, Metaclass, TraitDescription). =============== Diff against Traits-ar.261 =============== Item was added: + ----- Method: ClassOrganizer>>traitComposition (in category '*Traits-Kernel') ----- + traitComposition + "Answer the receiver's trait composition" + ^#()! Item was changed: SystemOrganization addCategory: #'Traits-Composition'! SystemOrganization addCategory: #'Traits-Kernel'! SystemOrganization addCategory: #'Traits-Kernel-Traits'! - SystemOrganization addCategory: #'Traits-NanoKernel'! Item was added: + ----- Method: TraitOrganizer>>traitComposition (in category 'accessing') ----- + traitComposition + "Answer the receiver's trait composition" + ^traitComposition ifNil:[traitComposition := TraitComposition new]! Item was added: + ----- Method: TraitOrganizer>>traitComposition: (in category 'accessing') ----- + traitComposition: aTraitComposition + "Install the receiver's trait composition" + traitComposition := aTraitComposition.! Item was added: + ----- Method: ClassTrait>>isObsolete (in category 'testing') ----- + isObsolete + ^baseTrait == nil or:[baseTrait isObsolete]! Item was changed: ----- Method: ClassDescription>>traitComposition (in category '*Traits-NanoKernel') ----- traitComposition "Answer my trait composition" + ^self organization traitComposition! - ^#()! Item was changed: ----- Method: ClassDescription>>traitComposition: (in category '*Traits-NanoKernel') ----- traitComposition: aTraitComposition + "Install my trait composition" + aTraitComposition isEmpty ifTrue:[ + self organization isTraitOrganizer + ifTrue:[self organization: (ClassOrganizer newFrom: self organization)]. + ] ifFalse:[ + self organization isTraitOrganizer + ifFalse:[self organization: (TraitOrganizer newFrom: self organization)]. + self organization traitComposition: aTraitComposition. + ]. + ! - "Install my traits" - ^self subclassResponsibility! Item was added: + ----- Method: ClassOrganizer>>isTraitOrganizer (in category '*Traits-Kernel') ----- + isTraitOrganizer + "Answer true if this is a TraitOrganizer" + ^false! Item was changed: ----- Method: TraitDescription>>traitComposition: (in category 'accessing') ----- traitComposition: aTraitComposition + super traitComposition: aTraitComposition. traitComposition := aTraitComposition. ! Item was added: + ----- Method: TraitOrganizer>>isTraitOrganizer (in category 'testing') ----- + isTraitOrganizer + "Answer true if this is a TraitOrganizer" + ^true! Item was added: + ClassOrganizer subclass: #TraitOrganizer + instanceVariableNames: 'traitComposition' + classVariableNames: '' + poolDictionaries: '' + category: 'Traits-Kernel'! Item was removed: - ----- Method: NanoTraitComposition>>addTraitUser: (in category 'accessing') ----- - addTraitUser: aUser - self do:[:each| each addTraitUser: aUser]! Item was removed: - ----- Method: NanoTraitExclusion>>selectorsAndMethodsDo: (in category 'composition') ----- - selectorsAndMethodsDo: aBlock - "enumerates all selectors and methods in a trait composition" - ^subject selectorsAndMethodsDo:[:sel :meth| - (exclusions includes: sel) ifFalse:[aBlock value: sel value: meth]. - ].! Item was removed: - ----- Method: NanoTraitExclusion>>copyTraitExpression (in category 'composition') ----- - copyTraitExpression - "Copy all except the actual traits" - ^NanoTraitExclusion - with: subject - exclusions: exclusions asArray! Item was removed: - NanoTraitTransformation subclass: #NanoTraitExclusion - instanceVariableNames: 'exclusions' - classVariableNames: '' - poolDictionaries: '' - category: 'Traits-NanoKernel'! - - !NanoTraitExclusion commentStamp: '<historical>' prior: 0! - A trait transformation representing the exclusion (-) operator.! Item was removed: - ----- Method: NanoTrait>>fileOutOn:moveSource:toFile: (in category 'fileIn/Out') ----- - fileOutOn: aFileStream moveSource: moveSource toFile: fileIndex - super fileOutOn: aFileStream moveSource: moveSource toFile: fileIndex. - self classSide hasMethods ifTrue:[ - aFileStream cr; nextPutAll: '"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!!'; cr; cr. - self classSide - fileOutOn: aFileStream - moveSource: moveSource - toFile: fileIndex].! Item was removed: - ----- Method: NanoTrait>>baseTrait (in category 'accessing') ----- - baseTrait - ^self! Item was removed: - ----- Method: NanoTrait>>classDefinitions (in category 'monticello') ----- - classDefinitions - | definitions | - definitions := OrderedCollection with: self asClassDefinition. - (self hasClassTrait - and: [self classTrait hasTraitComposition] - and: [self classTrait traitComposition isEmpty not]) - ifTrue: [definitions add: self classTrait asMCDefinition]. - ^definitions asArray! Item was removed: - ----- Method: NanoClassTrait>>isClassTrait (in category 'testing') ----- - isClassTrait - ^true! Item was removed: - ----- Method: NanoTraitDescription>>traitComposition: (in category 'accessing') ----- - traitComposition: aTraitComposition - traitComposition := aTraitComposition. - ! Item was removed: - ----- Method: NanoTraitTransformation>>selectorsAndMethodsDo: (in category 'operations') ----- - selectorsAndMethodsDo: aBlock - "enumerates all selectors and methods in a trait composition" - ^self subclassResponsibility! Item was removed: - ----- Method: NanoClassTrait>>theMetaClass (in category 'accessing') ----- - theMetaClass - ^self! Item was removed: - ----- Method: NanoTraitTransformation>>copyTraitExpression (in category 'operations') ----- - copyTraitExpression - "Copy all except the actual traits" - ^self subclassResponsibility! Item was removed: - ----- Method: NanoTrait>>asClassDefinition (in category 'monticello') ----- - asClassDefinition - ^Smalltalk at: #MCTraitDefinition ifPresent:[:aClass| - aClass - name: self name - traitComposition: self traitCompositionString - category: self category - comment: self organization classComment asString - commentStamp: self organization commentStamp].! Item was removed: - ----- Method: NanoTraitDescription>>sharedPools (in category 'accessing') ----- - sharedPools - "Traits have no shared pools" - ^ Dictionary new! Item was removed: - ----- Method: NanoTraitDescription>>isClassTrait (in category 'testing') ----- - isClassTrait - ^false! Item was removed: - ----- Method: NanoClassTrait>>soleInstance (in category 'accessing') ----- - soleInstance - ^baseTrait! Item was removed: - ----- Method: NanoClassTrait>>definitionST80 (in category 'accessing') ----- - definitionST80 - ^String streamContents: [:stream | - stream nextPutAll: self name. - stream cr; tab; nextPutAll: 'uses: '; - nextPutAll: self traitComposition asString. - ].! Item was removed: - ----- Method: NanoTraitAlias>>initialize (in category 'initialize-release') ----- - initialize - super initialize. - aliases := #().! Item was removed: - ----- Method: NanoTraitComposition>>isAliasSelector: (in category 'operations') ----- - isAliasSelector: selector - "enumerates all selectors and methods in a trait composition" - ^self anySatisfy:[:any| any isAliasSelector: selector]! Item was removed: - ----- Method: NanoTrait class>>newTemplateIn: (in category 'public') ----- - newTemplateIn: categoryString - ^String streamContents: [:stream | - stream - nextPutAll: 'Trait named: #NameOfTrait'; - cr; tab; - nextPutAll: 'uses: {}'; - cr; tab; - nextPutAll: 'category: '; - nextPut: $'; - nextPutAll: categoryString; - nextPut: $' ]! Item was removed: - ----- Method: NanoTraitTransformation>>addTraitUser: (in category 'accessing') ----- - addTraitUser: aTrait - users := users copyWith: aTrait. - subject addTraitUser: aTrait. - ! Item was removed: - ----- Method: NanoTrait class>>newTraitNamed:uses:category: (in category 'public') ----- - newTraitNamed: aSymbol uses: aTraitCompositionOrCollection category: aString - "Creates a new trait." - | env | - env := self environment. - ^self - named: aSymbol - uses: aTraitCompositionOrCollection - category: aString - env: env! Item was removed: - ----- Method: NanoTrait class>>updateTraits: (in category 'installing') ----- - updateTraits: aCollection - "Convert all the traits in aCollection to NanoTraits. Used during installation." - "ClassDescription traitImpl: NanoTrait. - NanoTrait updateTraits:{ - TSequencedStreamTest. TGettableStreamTest. TReadStreamTest. - TStreamTest. TPuttableStreamTest. TWriteStreamTest - }" - | remain processed classes oldTrait classDef newTrait count instTraits classSelectors | - ClassDescription traitImpl == self ifFalse:[self error: 'What are you doing???']. - remain := (aCollection reject:[:tc| tc isKindOf: self]) asSet. - processed := Set new. - classes := Set new. - count := 0. - 'Converting ....' displayProgressAt: Sensor cursorPoint from: 1 to: remain size during:[:bar| - [remain isEmpty] whileFalse:[ - "Pick any trait whose traits are already converted" - oldTrait := remain detect:[:any| - any traitComposition traits allSatisfy:[:t| (Smalltalk at: t name) isKindOf: self]. - ] ifNone:[self error: 'Cannot convert cyclic traits']. - remain remove: oldTrait. - - bar value: (count := count +1). - ProgressNotification signal: '' extra: 'Converting ', oldTrait name. - - "Silently remove the old trait class and recreate it based on NanoTrait" - classDef := oldTrait definition. - Smalltalk removeKey: oldTrait name. - - "Create the NanoTrait from the same definition" - newTrait := Compiler evaluate: classDef. - - "Update comment" - oldTrait organization classComment ifNotEmpty:[ - newTrait classComment: oldTrait organization commentRemoteStr - stamp: oldTrait organization commentStamp. - ]. - - "Copy local methods to new trait" - oldTrait localSelectors do:[:sel| - newTrait - compile: (oldTrait sourceCodeAt: sel) - classified: (oldTrait organization categoryOfElement: sel) - withStamp: (oldTrait compiledMethodAt: sel) timeStamp - notifying: nil - ]. - oldTrait classSide localSelectors do:[:sel| - newTrait classSide - compile: (oldTrait classSide sourceCodeAt: sel) - classified: (oldTrait classSide organization categoryOfElement: sel) - withStamp: (oldTrait classSide compiledMethodAt: sel) timeStamp - notifying: nil - ]. - - newTrait selectors sort = oldTrait selectors sort - ifFalse:[self error: 'Something went VERY wrong']. - newTrait classSide selectors sort = oldTrait classSide selectors sort - ifFalse:[self error: 'Something went VERY wrong']. - - processed add: oldTrait. - classes addAll: (oldTrait users reject:[:aClass| aClass isObsolete]). - ]. - ]. - - classes := classes asArray select:[:cls| cls isKindOf: ClassDescription]. - 'Updating ....' displayProgressAt: Sensor cursorPoint from: 1 to: classes size during:[:bar| - "The traits are all converted, next update the classes" - classes keysAndValuesDo:[:index :aClass| - bar value: index. - ProgressNotification signal: '' extra: 'Updating ', aClass name. - - instTraits := Compiler evaluate: aClass traitComposition asString. - "Keep the local selectors from before" - localSelectors := aClass localSelectors. - classSelectors := aClass class localSelectors. - "Nuke the old traits composition" - aClass traitComposition: nil. - aClass class traitComposition: nil. - "Install the new one" - aClass uses: instTraits. - "Remove the old trait (now local) selectors" - (aClass selectors reject:[:sel| localSelectors includes: sel]) do:[:sel| - aClass removeSelectorSilently: sel. - (aClass includesSelector: sel) ifFalse:[self halt: 'Where is the code?']. - ]. - (aClass class selectors reject:[:sel| classSelectors includes: sel]) do:[:sel| - aClass class removeSelectorSilently: sel. - (aClass class includesSelector: sel) ifFalse:[self halt: 'Where is the code?']. - ]. - ]. - ]. - - "Finally, obsolete all the old traits" - processed do:[:trait| trait obsolete]. - ! Item was removed: - ----- Method: NanoTraitDescription>>@ (in category 'operations') ----- - @ anArrayOfAssociations - "Creates an alias" - ^ NanoTraitAlias with: self aliases: anArrayOfAssociations! Item was removed: - ----- Method: NanoTraitExclusion>>exclusions: (in category 'accessing') ----- - exclusions: aCollection - exclusions := Set withAll: aCollection! Item was removed: - ----- Method: NanoTraitDescription class>>conflict:with:with:with:with:with: (in category 'conflict methods') ----- - conflict: arg1 with: arg2 with: arg3 with: arg4 with: arg5 with: arg6 - "This method has a trait conflict" - ^self traitConflict! Item was removed: - ----- Method: NanoTraitComposition>>@ (in category 'converting') ----- - @ anArrayOfAssociations - "the modifier operators #@ and #- bind stronger than +. - Thus, #@ or #- sent to a sum will only affect the most right summand" - - self addLast: (self removeLast @ anArrayOfAssociations)! Item was removed: - ----- Method: NanoTraitDescription>>isTraitTransformation (in category 'testing') ----- - isTraitTransformation - "Polymorphic with TraitTransformation" - ^false! Item was removed: - ----- Method: NanoTraitExclusion>>- (in category 'converting') ----- - - anArrayOfSelectors - ^NanoTraitExclusion - with: subject - exclusions: (anArrayOfSelectors, exclusions asArray)! Item was removed: - ----- Method: NanoTraitDescription>>fileOut (in category 'fileIn/Out') ----- - fileOut - "Create a file whose name is the name of the receiver with '.st' as the - extension, and file a description of the receiver onto it." - ^ self fileOutAsHtml: false! Item was removed: - ----- Method: NanoClassTrait>>theNonMetaClass (in category 'accessing') ----- - theNonMetaClass - "Sent to a class or metaclass, always return the class" - ^baseTrait! Item was removed: - ----- Method: NanoTraitComposition>>isTraitTransformation (in category 'testing') ----- - isTraitTransformation - "Polymorphic with TraitTransformation" - ^false! Item was removed: - ----- Method: NanoTrait>>rename: (in category 'initialize') ----- - rename: aString - "The new name of the receiver is the argument, aString." - - | newName | - (newName := aString asSymbol) ~= self name - ifFalse: [^ self]. - (self environment includesKey: newName) - ifTrue: [^ self error: newName , ' already exists']. - (Undeclared includesKey: newName) - ifTrue: [self inform: 'There are references to, ' , aString printString , ' - from Undeclared. Check them after this change.']. - self environment renameClass: self as: newName. - name := newName! Item was removed: - ----- Method: NanoTraitExclusion>>@ (in category 'converting') ----- - @ anArrayOfAssociations - - NanoTraitCompositionException signal: 'Invalid trait exclusion. Aliases have to be specified before exclusions.' - ! Item was removed: - ----- Method: NanoTraitTransformation>>isAliasSelector: (in category 'testing') ----- - isAliasSelector: selector - ^subject isAliasSelector: selector! Item was removed: - ----- Method: NanoTrait>>obsolete (in category 'initialize') ----- - obsolete - self name: ('AnObsolete' , self name) asSymbol. - self class obsolete. - super obsolete! Item was removed: - ----- Method: NanoTraitExclusion>>includesSelector: (in category 'composition') ----- - includesSelector: selector - "Answers true if the receiver provides the selector" - ^(subject includesSelector: selector) and:[(exclusions includes: selector) not]! Item was removed: - ----- Method: NanoTraitTransformation>>allTraits (in category 'accessing') ----- - allTraits - ^subject allTraits! Item was removed: - ----- Method: NanoTraitComposition>>isLocalAliasSelector: (in category 'operations') ----- - isLocalAliasSelector: selector - "Return true if the selector aSymbol is an alias defined in the receiver." - ^self anySatisfy:[:any| any isTraitTransformation and:[any isLocalAliasSelector: selector]]! Item was removed: - ----- Method: NanoTraitTransformation>>removeTraitUser: (in category 'accessing') ----- - removeTraitUser: aTrait - users := users copyWithout: aTrait. - subject removeTraitUser: aTrait.! Item was removed: - ----- Method: NanoTraitDescription>>installTraitsFrom: (in category 'operations') ----- - installTraitsFrom: aTraitComposition - super installTraitsFrom: aTraitComposition. - self users do:[:each| each updateTraits].! Item was removed: - ----- Method: NanoTraitTransformation>>@ (in category 'converting') ----- - @ anArrayOfAssociations - ^self subclassResponsibility! Item was removed: - ----- Method: NanoTrait class>>named:uses:category: (in category 'public') ----- - named: aSymbol uses: aTraitCompositionOrCollection category: aString - "Dispatch through ClassDescription for alternative implementations" - ^ClassDescription newTraitNamed: aSymbol uses: aTraitCompositionOrCollection category: aString! Item was removed: - ----- Method: NanoTraitComposition>>includesTrait: (in category 'testing') ----- - includesTrait: aTrait - ^self anySatisfy:[:each| each includesTrait: aTrait]! Item was removed: - ----- Method: NanoTrait>>isBaseTrait (in category 'testing') ----- - isBaseTrait - ^true! Item was removed: - ----- Method: NanoTraitDescription>>addSelectorSilently:withMethod: (in category 'operations') ----- - addSelectorSilently: selector withMethod: compiledMethod - "Overridden to update the users of this trait" - super addSelectorSilently: selector withMethod: compiledMethod. - self users do:[:each| each updateTraits].! Item was removed: - ----- Method: NanoTrait class>>newTraitComposition (in category 'public') ----- - newTraitComposition - "Creates a new TraitComposition" - ^NanoTraitComposition new! Item was removed: - ----- Method: Trait class>>updateTraits: (in category 'class initialization') ----- - updateTraits: aCollection - "Convert all the traits in aCollection to NanoTraits. Used during installation." - "ClassDescription traitImpl: Trait. - Trait updateTraits:{ - TSequencedStreamTest. TGettableStreamTest. TReadStreamTest. - TStreamTest. TPuttableStreamTest. TWriteStreamTest - }" - | remain processed classes oldTrait classDef newTrait count instTraits classSelectors | - ClassDescription traitImpl == self ifFalse:[self error: 'What are you doing???']. - remain := (aCollection reject:[:tc| tc isKindOf: self]) asSet. - processed := Set new. - classes := Set new. - count := 0. - 'Converting ....' displayProgressAt: Sensor cursorPoint from: 1 to: remain size during:[:bar| - [remain isEmpty] whileFalse:[ - "Pick any trait whose traits are already converted" - oldTrait := remain detect:[:any| - any traitComposition traits allSatisfy:[:t| (Smalltalk at: t name) isKindOf: self]. - ] ifNone:[self error: 'Cannot convert cyclic traits']. - remain remove: oldTrait. - - bar value: (count := count +1). - ProgressNotification signal: '' extra: 'Converting ', oldTrait name. - - "Silently remove the old trait class and recreate it based on NanoTrait" - classDef := oldTrait definition. - Smalltalk removeKey: oldTrait name. - - "Create the NanoTrait from the same definition" - newTrait := Compiler evaluate: classDef. - - "Update comment" - oldTrait organization classComment ifNotEmpty:[ - newTrait classComment: oldTrait organization commentRemoteStr - stamp: oldTrait organization commentStamp. - ]. - - "Copy local methods to new trait" - oldTrait localSelectors do:[:sel| - newTrait - compile: (oldTrait sourceCodeAt: sel) - classified: (oldTrait organization categoryOfElement: sel) - withStamp: (oldTrait compiledMethodAt: sel) timeStamp - notifying: nil - ]. - oldTrait classSide localSelectors do:[:sel| - newTrait classSide - compile: (oldTrait classSide sourceCodeAt: sel) - classified: (oldTrait classSide organization categoryOfElement: sel) - withStamp: (oldTrait classSide compiledMethodAt: sel) timeStamp - notifying: nil - ]. - - newTrait selectors sort = oldTrait selectors sort - ifFalse:[self error: 'Something went VERY wrong']. - newTrait classSide selectors sort = oldTrait classSide selectors sort - ifFalse:[self error: 'Something went VERY wrong']. - - processed add: oldTrait. - classes addAll: (oldTrait users reject:[:aClass| aClass isObsolete]). - ]. - ]. - - classes := classes asArray select:[:cls| cls isKindOf: ClassDescription]. - 'Updating ....' displayProgressAt: Sensor cursorPoint from: 1 to: classes size during:[:bar| - "The traits are all converted, next update the classes" - classes keysAndValuesDo:[:index :aClass| - bar value: index. - ProgressNotification signal: '' extra: 'Updating ', aClass name. - - instTraits := Compiler evaluate: aClass traitComposition asString. - "Keep the local selectors from before" - localSelectors := aClass localSelectors. - classSelectors := aClass class localSelectors. - "Nuke the old traits composition" - aClass traitComposition: nil. - aClass class traitComposition: nil. - "Install the new one" - aClass uses: instTraits. - "Remove the old trait (now local) selectors" - (aClass selectors reject:[:sel| localSelectors includes: sel]) do:[:sel| - aClass removeSelectorSilently: sel. - (aClass includesSelector: sel) ifFalse:[self halt: 'Where is the code?']. - ]. - (aClass class selectors reject:[:sel| classSelectors includes: sel]) do:[:sel| - aClass class removeSelectorSilently: sel. - (aClass class includesSelector: sel) ifFalse:[self halt: 'Where is the code?']. - ]. - ]. - ]. - - "Finally, obsolete all the old traits" - processed do:[:trait| trait obsolete]. - ! Item was removed: - NanoTraitTransformation subclass: #NanoTraitAlias - instanceVariableNames: 'aliases' - classVariableNames: '' - poolDictionaries: '' - category: 'Traits-NanoKernel'! - - !NanoTraitAlias commentStamp: '<historical>' prior: 0! - A trait transformation representing the alias (->) operator.! Item was removed: - ----- Method: NanoTraitDescription class>>conflict:with: (in category 'conflict methods') ----- - conflict: arg1 with: arg2 - "This method has a trait conflict" - ^self traitConflict! Item was removed: - ----- Method: NanoTraitDescription>>fileOutAsHtml: (in category 'fileIn/Out') ----- - fileOutAsHtml: useHtml - "File a description of the receiver onto a new file whose base name is the name of the receiver." - - | internalStream | - internalStream := WriteStream on: (String new: 100). - internalStream header; timeStamp. - - self fileOutOn: internalStream moveSource: false toFile: 0. - internalStream trailer. - - FileStream writeSourceCodeFrom: internalStream baseName: self name isSt: true useHtml: useHtml. - ! Item was removed: - ----- Method: NanoTrait>>asTraitComposition (in category 'converting') ----- - asTraitComposition - "Convert me into a trait composition" - ^TraitComposition with: self! Item was removed: - ----- Method: NanoTrait class>>named:uses:category:env: (in category 'instance creation') ----- - named: aSymbol uses: aTraitComposition category: aString env: anEnvironment - | trait oldTrait systemCategory oldCategory | - systemCategory := aString asSymbol. - oldTrait := anEnvironment at: aSymbol ifAbsent: [nil]. - oldTrait ifNil:[ - trait := NanoClassTrait new new. - ] ifNotNil:[ - oldCategory := oldTrait category. - trait := oldTrait. - ]. - (trait isKindOf: NanoTrait) ifFalse: [ - ^self error: trait name , ' is not a Trait']. - trait - setName: aSymbol - andRegisterInCategory: systemCategory - environment: anEnvironment. - - trait uses: aTraitComposition. - - "... notify interested clients ..." - oldTrait ifNil:[ - SystemChangeNotifier uniqueInstance classAdded: trait inCategory: systemCategory. - ] ifNotNil:[ - systemCategory = oldCategory ifFalse:[ - SystemChangeNotifier uniqueInstance class: trait - recategorizedFrom: oldTrait category to: systemCategory]. - ]. - ^ trait! Item was removed: - ----- Method: NanoTraitTransformation>>traitsDo: (in category 'accessing') ----- - traitsDo: aBlock - ^subject traitsDo: aBlock! Item was removed: - ----- Method: NanoTraitAlias>>selectorsAndMethodsDo: (in category 'operations') ----- - selectorsAndMethodsDo: aBlock - "enumerates all selectors and methods in a trait composition" - subject selectorsAndMethodsDo:[:sel :meth| - aBlock value: sel value: meth. - ]. - aliases do:[:assoc| | method | - "Method can be nil during removals" - method := subject compiledMethodAt: assoc value ifAbsent:[nil]. - method ifNotNil:[aBlock value: assoc key value: method]. - ].! Item was removed: - ----- Method: NanoTraitTransformation>>isLocalAliasSelector: (in category 'testing') ----- - isLocalAliasSelector: selector - ^false! Item was removed: - ----- Method: NanoTraitDescription>>printHierarchy (in category 'printing') ----- - printHierarchy - "For hierarchy view in the browser; print the users of a trait" - ^String streamContents:[:s| self printUsersOf: self on: s level: 0].! Item was removed: - ----- Method: NanoTraitTransformation>>updateTraits (in category 'operations') ----- - updateTraits - "Recompute my users traits composition" - users do:[:each| each updateTraits].! Item was removed: - ----- Method: NanoClassTrait>>bindingOf: (in category 'compiling') ----- - bindingOf: varName - "Answer the binding of some variable resolved in the scope of the receiver" - ^baseTrait bindingOf: varName! Item was removed: - ----- Method: NanoTrait>>isObsolete (in category 'testing') ----- - isObsolete - "Return true if the receiver is obsolete." - ^(self environment at: name ifAbsent: [nil]) ~~ self! Item was removed: - ----- Method: NanoTraitDescription>>copy (in category 'copying') ----- - copy - self error: 'Traits cannot be trivially copied'! Item was removed: - ----- Method: NanoTraitTransformation>>asTraitTransform (in category 'converting') ----- - asTraitTransform - ^self! Item was removed: - ----- Method: NanoTraitTransformation>>includesTrait: (in category 'testing') ----- - includesTrait: aTrait - ^subject includesTrait: aTrait! Item was removed: - ----- Method: NanoTrait>>removeFromSystem: (in category 'initialize') ----- - removeFromSystem: logged - self environment forgetClass: self logged: logged. - self obsolete! Item was removed: - ----- Method: NanoTrait>>definition (in category 'initialize') ----- - definition - ^String streamContents: [:stream | - stream nextPutAll: 'Trait named: '; - store: self name. - stream cr; tab; nextPutAll: 'uses: '; - nextPutAll: self traitComposition asString. - stream cr; tab; nextPutAll: 'category: '; - store: self category asString].! Item was removed: - ----- Method: NanoClassTrait>>uses: (in category 'initialize') ----- - uses: aTraitComposition - | newTraits | - newTraits := aTraitComposition asTraitComposition. - newTraits traitsDo:[:t| - (t isBaseTrait and:[t classSide hasMethods]) - ifTrue:[self error: 'Cannot add: ', t]. - (t isClassTrait and:[(baseTrait includesTrait: t baseTrait) not]) - ifTrue:[self error: 'Cannot add: ', t]. - ]. - self installTraitsFrom: newTraits.! Item was removed: - ----- Method: NanoTraitTransformation>>trait (in category 'accessing') ----- - trait - ^subject trait! Item was removed: - ----- Method: NanoClassTrait>>classSide (in category 'accessing') ----- - classSide - ^self! Item was removed: - ----- Method: NanoTraitTransformation>>updateSelector:withTraitMethod:from: (in category 'operations') ----- - updateSelector: aSelector withTraitMethod: compiledMethod from: aTrait - "broadcasts the change of a selector to all users of a trait" - ^self subclassResponsibility! Item was removed: - ----- Method: NanoTraitDescription>>addUser: (in category 'accessing') ----- - addUser: aTrait - ^self addTraitUser: aTrait! Item was removed: - NanoTraitDescription subclass: #NanoClassTrait - instanceVariableNames: 'baseTrait' - classVariableNames: '' - poolDictionaries: '' - category: 'Traits-NanoKernel'! - - !NanoClassTrait commentStamp: '<historical>' prior: 0! - While every class has an associated metaclass, a trait can have an associated classtrait, an instance of me. To preserve metaclass compatibility, the associated classtrait (if there is one) is automatically applied to the metaclass, whenever a trait is applied to a class. Consequently, a trait with an associated classtrait can only be applied to classes, whereas a trait without a classtrait can be applied to both classes and metaclasses.! Item was removed: - NanoTraitDescription subclass: #NanoTrait - instanceVariableNames: 'name environment category' - classVariableNames: '' - poolDictionaries: '' - category: 'Traits-NanoKernel'! - - !NanoTrait commentStamp: '<historical>' prior: 0! - Each trait in the system is represented as an instance of me. Like Class, I concretize my superclass by providing instance variables for the name and the environment.! Item was removed: - ----- Method: NanoClassTrait>>isMeta (in category 'testing') ----- - isMeta - ^true! Item was removed: - ----- Method: NanoTraitComposition>>addUser: (in category 'accessing') ----- - addUser: aUser - ^self addTraitUser: aUser! Item was removed: - ----- Method: NanoTraitComposition>>traitCompositionString (in category 'operations') ----- - traitCompositionString - "Answer the trait composition string (used for class definitions)" - self size = 0 ifTrue:[^'{}']. - self size = 1 ifTrue:[^self first asString]. - ^String streamContents:[:s| - self do:[:each| s nextPutAll: each asString] separatedBy:[s nextPutAll: ' + ']. - ].! Item was removed: - ----- Method: NanoTraitDescription>>isBaseTrait (in category 'testing') ----- - isBaseTrait - ^false! Item was removed: - ----- Method: NanoTraitExclusion>>initialize (in category 'initialize') ----- - initialize - super initialize. - exclusions := Set new. - ! Item was removed: - ----- Method: NanoTraitDescription>>removeUser: (in category 'accessing') ----- - removeUser: aTrait - ^self removeTraitUser: aTrait! Item was removed: - ----- Method: NanoTraitAlias>>- (in category 'converting') ----- - - anArrayOfSelectors - ^NanoTraitExclusion - with: self - exclusions: anArrayOfSelectors! Item was removed: - ----- Method: NanoTraitDescription>>asTraitComposition (in category 'converting') ----- - asTraitComposition - ^NanoTraitComposition with: self! Item was removed: - ----- Method: NanoTraitAlias class>>with:aliases: (in category 'instance creation') ----- - with: aTraitComposition aliases: anArrayOfAssociations - self assertValidAliasDefinition: anArrayOfAssociations. - ^self new - subject: aTraitComposition; - initializeFrom: anArrayOfAssociations; - yourself! Item was removed: - ----- Method: NanoTrait>>isValidTraitName: (in category 'initialize') ----- - isValidTraitName: aSymbol - ^(aSymbol isEmptyOrNil - or: [aSymbol first isLetter not] - or: [aSymbol anySatisfy: [:character | character isAlphaNumeric not]]) not! Item was removed: - ----- Method: NanoTraitDescription>>isTrait (in category 'testing') ----- - isTrait - ^true! Item was removed: - ----- Method: NanoTrait>>removeFromSystem (in category 'initialize') ----- - removeFromSystem - self removeFromSystem: true! Item was removed: - ----- Method: NanoTraitComposition>>asTraitComposition (in category 'converting') ----- - asTraitComposition - ^self! Item was removed: - ----- Method: NanoTraitDescription class>>conflict: (in category 'conflict methods') ----- - conflict: arg1 - "This method has a trait conflict" - ^self traitConflict! Item was removed: - ----- Method: NanoTraitDescription>>printUsersOf:on:level: (in category 'printing') ----- - printUsersOf: aClass on: aStream level: indent - aStream crtab: indent. - aStream nextPutAll: aClass name. - aClass isTrait ifTrue:[ - aClass users do:[:each| self printUsersOf: aClass on: aStream level: indent+1]. - ]. - ! Item was removed: - ----- Method: NanoTraitDescription>>traitComposition (in category 'accessing') ----- - traitComposition - ^traitComposition ifNil:[traitComposition := NanoTraitComposition new] - ! Item was removed: - ----- Method: NanoClassTrait>>baseTrait (in category 'accessing') ----- - baseTrait - ^baseTrait! Item was removed: - ----- Method: NanoClassTrait>>definition (in category 'accessing') ----- - definition - ^String streamContents: [:stream | - stream nextPutAll: self name. - stream cr; tab; nextPutAll: 'uses: '; - nextPutAll: self traitComposition asString. - ].! Item was removed: - ----- Method: NanoTrait class>>allTraitsDo: (in category 'public') ----- - allTraitsDo: aBlock - "Evaluate aBlock with all the instance and class traits present in the system" - NanoClassTrait allInstances do: [:metaTrait| - aBlock value: metaTrait instanceSide. - aBlock value: metaTrait. - ].! Item was removed: - ----- Method: NanoTrait>>hasClassTrait (in category 'testing') ----- - hasClassTrait - ^true! Item was removed: - NanoTraitBehavior subclass: #NanoTraitDescription - instanceVariableNames: 'users traitComposition' - classVariableNames: '' - poolDictionaries: '' - category: 'Traits-NanoKernel'! - - !NanoTraitDescription commentStamp: 'ar 12/3/2009 23:42' prior: 0! - TraitDescription combines common behavior for both (instance) traits and (meta) class traits.! Item was removed: - ----- Method: NanoTraitTransformation>>initialize (in category 'initialize') ----- - initialize - super initialize. - users := #().! Item was removed: - ----- Method: NanoTraitAlias>>printOn: (in category 'operations') ----- - printOn: s - "Answer the trait composition string (used for class definitions)" - s nextPutAll: subject asString. - s nextPutAll: ' @ {'. - aliases do:[:assoc| s print: assoc] separatedBy:[s nextPutAll:'. ']. - s nextPutAll: '}'. - ! Item was removed: - ----- Method: NanoTraitAlias>>includesSelector: (in category 'operations') ----- - includesSelector: selector - "Answers true if the receiver provides the selector" - ^(subject includesSelector: selector) or:[aliases anySatisfy:[:assoc| assoc key == selector]]! Item was removed: - Error subclass: #NanoTraitCompositionException - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'Traits-NanoKernel'! - - !NanoTraitCompositionException commentStamp: '<historical>' prior: 0! - Signals invalid trait compositions.! Item was removed: - ----- Method: NanoTraitDescription class>>conflict:with:with:with:with:with:with:with: (in category 'conflict methods') ----- - conflict: arg1 with: arg2 with: arg3 with: arg4 with: arg5 with: arg6 with: arg7 with: arg8 - "This method has a trait conflict" - ^self traitConflict! Item was removed: - ----- Method: NanoTraitMethodState>>originalTraitMethod (in category 'accessing') ----- - originalTraitMethod - "The original method from the trait" - ^originalTraitMethod! Item was removed: - ----- Method: NanoTraitDescription>>classPool (in category 'accessing') ----- - classPool - "Traits have no class pool" - ^ Dictionary new! Item was removed: - ----- Method: NanoTrait>>setName:andRegisterInCategory:environment: (in category 'initialize') ----- - setName: aSymbol andRegisterInCategory: categorySymbol environment: aSystemDictionary - (self isValidTraitName: aSymbol) ifFalse: [self error:'Invalid trait name']. - - (self environment == aSystemDictionary - and: [self name = aSymbol - and: [self category = categorySymbol]]) ifTrue: [^self]. - - ((aSystemDictionary includes: aSymbol) and: [(aSystemDictionary at: aSymbol) ~~ self]) - ifTrue: [self error: 'The name ''' , aSymbol , ''' is already used']. - - (self environment notNil and: [self name notNil and: [self name ~= aSymbol]]) ifTrue: [ - self environment renameClass: self as: aSymbol]. - - self name: aSymbol. - self environment: aSystemDictionary. - self environment at: self name put: self. - self environment organization classify: self name under: categorySymbol. - ^ true! Item was removed: - ----- Method: NanoTraitAlias>>aliases: (in category 'accessing') ----- - aliases: aCollection - "Collection of associations where key is the - alias and value the original selector." - aliases := aCollection! Item was removed: - Object subclass: #NanoTraitTransformation - instanceVariableNames: 'subject users' - classVariableNames: '' - poolDictionaries: '' - category: 'Traits-NanoKernel'! - - !NanoTraitTransformation commentStamp: '<historical>' prior: 0! - A trait transformation is an instance of one of my concrete subclasses, TraitAlias or TraitExclusion. These represent a transformation of a trait, specified by the alias and exclusion operators. - - I define an instance variable named subject which holds the object that is transformed. Thus, an alias transformation has as its subject a trait, and a trait exclusion has as its subject either a trait alias or a trait. Each of the concrete transformation classes implement the method allSelectors according to the transformation it represents. - ! Item was removed: - ----- Method: NanoTraitAlias>>isLocalAliasSelector: (in category 'testing') ----- - isLocalAliasSelector: selector - ^(aliases anySatisfy:[:assoc| assoc key == selector])! Item was removed: - ----- Method: NanoTraitMethodState>>originalTraitOrClass (in category 'accessing') ----- - originalTraitOrClass - "The original trait for this method" - ^originalTraitMethod originalTraitOrClass! Item was removed: - ----- Method: NanoTrait class>>install (in category 'installing') ----- - install "NanoTrait install" - "Installs NanoTraits" - - "Force recompilation of basic classes to get traits aliasing right" - {Behavior. ClassDescription. Class. Metaclass} do:[:aClass| - aClass selectorsDo:[:sel| - aClass - compile: (aClass sourceCodeAt: sel) - classified: (aClass organization categoryOfElement: sel) - withStamp: (aClass compiledMethodAt: sel) timeStamp - notifying: nil]. - aClass setTraitCompositionFrom: {}]. - - ClassDescription traitImpl: self. "Create all new traits as NanoTraits" - self updateTraits: Smalltalk allTraits. "And convert everything to NanoTraits" - Smalltalk allClassesAndTraitsDo:[:aClass| - aClass traitComposition isEmpty - ifTrue:[aClass traitComposition: nil]. - aClass classSide traitComposition isEmpty - ifTrue:[aClass classSide traitComposition: nil]]. - - "TWriteStreamTest has the class traits reversed which which will be undone - by installation. Put it back in reverse order to keep MC happy." - (Smalltalk at: #TWriteStreamTest) classTrait - uses: - (Smalltalk at: #TSequencedStreamTest) classTrait + - (Smalltalk at: #TPuttableStreamTest) classTrait. - ! Item was removed: - ----- Method: NanoTraitDescription>>users: (in category 'accessing') ----- - users: aCollection - users := aCollection! Item was removed: - ----- Method: NanoTrait>>classTrait (in category 'accessing') ----- - classTrait - ^self class! Item was removed: - ----- Method: NanoTraitTransformation>>asTraitComposition (in category 'converting') ----- - asTraitComposition - ^NanoTraitComposition with: self! Item was removed: - ----- Method: NanoTrait>>category: (in category 'accessing') ----- - category: aString - "Categorize the receiver under the system category, aString, removing it from - any previous categorization." - - | oldCategory | - oldCategory := category. - aString isString - ifTrue: [ - category := aString asSymbol. - SystemOrganization classify: self name under: category ] - ifFalse: [self errorCategoryName]. - SystemChangeNotifier uniqueInstance - class: self recategorizedFrom: oldCategory to: category! Item was removed: - ----- Method: NanoTraitTransformation>>isTraitTransformation (in category 'testing') ----- - isTraitTransformation - "Polymorphic with Trait" - ^true! Item was removed: - ClassDescription subclass: #NanoTraitBehavior - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'Traits-NanoKernel'! - - !NanoTraitBehavior commentStamp: 'ar 12/29/2009 15:57' prior: 0! - Stub class for backward compatibility. Allows past extension methods in TraitBehavior to continue to work.! Item was removed: - ----- Method: NanoTraitComposition>>traits (in category 'accessing') ----- - traits - ^Array streamContents:[:s| self traitsDo:[:t| s nextPut: t]]! Item was removed: - ----- Method: NanoTrait>>name: (in category 'accessing') ----- - name: aSymbol - name := aSymbol! Item was removed: - ----- Method: NanoTraitAlias class>>assertValidAliasDefinition: (in category 'instance creation') ----- - assertValidAliasDefinition: anArrayOfAssociations - "Throw an exceptions if the alias definition is not valid. - It is expected to be a collection of associations and - the number of arguments of the alias selector has to - be the same as the original selector." - - ((anArrayOfAssociations isKindOf: Collection) and: [ - anArrayOfAssociations allSatisfy: [:each | - each isKindOf: Association]]) ifFalse: [ - self error: 'Invalid alias definition: Not a collection of associations.']. - - (anArrayOfAssociations allSatisfy: [:association | - (association key numArgs = association value numArgs and: [ - (association key numArgs = -1) not])]) ifFalse: [ - NanoTraitCompositionException signal: 'Invalid alias definition: Alias and original selector have to have the same number of arguments.']! Item was removed: - ----- Method: NanoTraitAlias>>copyTraitExpression (in category 'operations') ----- - copyTraitExpression - "Copy all except the actual traits" - ^NanoTraitAlias - with: subject - aliases: aliases! Item was removed: - ----- Method: NanoTrait>>environment (in category 'accessing') ----- - environment - ^environment! Item was removed: - ----- Method: NanoTraitDescription class>>conflict:with:with: (in category 'conflict methods') ----- - conflict: arg1 with: arg2 with: arg3 - "This method has a trait conflict" - ^self traitConflict! Item was removed: - AdditionalMethodState variableSubclass: #NanoTraitMethodState - instanceVariableNames: 'originalTraitMethod' - classVariableNames: '' - poolDictionaries: '' - category: 'Traits-NanoKernel'! - - !NanoTraitMethodState commentStamp: '<historical>' prior: 0! - Additional method state for trait provided methods.! Item was removed: - ----- Method: NanoTrait>>name (in category 'accessing') ----- - name - ^name! Item was removed: - ----- Method: NanoTraitDescription>>+ (in category 'operations') ----- - + aTrait - "Creates a composition with the receiver and aTrait" - aTrait traitsDo:[:t| self == t ifTrue:[NanoTraitCompositionException - signal: 'Trait ' , self asString, ' already in composition']]. - ^NanoTraitComposition withAll: {self}, aTrait asTraitComposition! Item was removed: - ----- Method: NanoClassTrait class>>new (in category 'instance creation') ----- - new - | newMeta | - newMeta := super new. - newMeta - superclass: NanoTrait - methodDictionary: MethodDictionary new - format: NanoTrait format. - ^newMeta! Item was removed: - ----- Method: NanoTraitMethodState>>methodHome (in category 'accessing') ----- - methodHome - "The behavior (trait/class) this method was originally defined in. - Derived from the originalTraitMethod if any." - ^originalTraitMethod ifNil:[super methodHome] ifNotNil:[:m| m methodHome]! Item was removed: - ----- Method: NanoTraitComposition>>+ (in category 'converting') ----- - + aTrait - self traitsDo:[:t| (t == aTrait trait) ifTrue:[^NanoTraitCompositionException - signal: 'Trait ' , aTrait trait asString, ' already in composition']]. - self addLast: aTrait. - ^self! Item was removed: - ----- Method: NanoTraitDescription>>notifyOfRecategorizedSelector:from:to: (in category 'operations') ----- - notifyOfRecategorizedSelector: element from: oldCategory to: newCategory - super notifyOfRecategorizedSelector: element from: oldCategory to: newCategory. - self users do:[:each| each classify: element under: newCategory from: oldCategory trait: self].! Item was removed: - ----- Method: NanoTrait>>category (in category 'accessing') ----- - 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 | - category ifNotNilDo: [ :symbol | - ((SystemOrganization listAtCategoryNamed: symbol) includes: self name) - ifTrue: [ ^symbol ] ]. - category := (result := SystemOrganization categoryOfElement: self name). - ^result! Item was removed: - ----- Method: NanoClassTrait>>instanceSide (in category 'accessing') ----- - instanceSide - ^self baseTrait! Item was removed: - ----- Method: NanoTraitDescription>>removeTraitUser: (in category 'accessing') ----- - removeTraitUser: aTrait - users := self users copyWithout: aTrait. - ! Item was removed: - ----- Method: NanoTraitDescription>>- (in category 'operations') ----- - - anArrayOfSelectors - "Creates an exclusion" - ^NanoTraitExclusion - with: self - exclusions: anArrayOfSelectors! Item was removed: - ----- Method: Trait class>>install (in category 'class initialization') ----- - install - "Trait install" - ClassDescription traitImpl: self. "Create all new traits as NanoTraits" - self updateTraits: Smalltalk allTraits. "And convert everything to NanoTraits" - "TWriteStreamTest has the class traits reversed which which will be undone - by installation. Put it back in reverse order to keep MC happy." - (Smalltalk at: #TWriteStreamTest) classTrait - uses: - (Smalltalk at: #TSequencedStreamTest) classTrait + - (Smalltalk at: #TPuttableStreamTest) classTrait. - Smalltalk allClassesAndTraits do:[:cls | | tc | - ((tc := cls traitComposition) isKindOf: TraitComposition) - ifFalse:[cls traitComposition: (TraitComposition withAll: tc)]. - ((tc := cls class traitComposition) isKindOf: TraitComposition) - ifFalse:[cls class traitComposition: (TraitComposition withAll: tc)]. - ].! Item was removed: - ----- Method: NanoTraitComposition>>allTraits (in category 'accessing') ----- - allTraits - ^self gather:[:each| each allTraits copyWith: each trait]! Item was removed: - ----- Method: NanoTraitAlias>>isAliasSelector: (in category 'testing') ----- - isAliasSelector: selector - ^(self isLocalAliasSelector: selector) or:[super isAliasSelector: selector]! Item was removed: - ----- Method: NanoTraitComposition>>removeTraitUser: (in category 'accessing') ----- - removeTraitUser: aUser - self do:[:each| each removeTraitUser: aUser]! Item was removed: - ----- Method: NanoTraitComposition>>- (in category 'converting') ----- - - anArray - "the modifier operators #@ and #- bind stronger than +. - Thus, #@ or #- sent to a sum will only affect the most right summand" - - self addLast: (self removeLast - anArray)! Item was removed: - ----- Method: NanoTrait class>>initialize (in category 'initialize') ----- - initialize - "Install NanoTraits" - self install. - ! Item was removed: - ----- Method: NanoClassTrait>>new (in category 'accessing') ----- - new - baseTrait ifNotNil:[self error: 'Already initialized']. - baseTrait := self basicNew initialize. - baseTrait - superclass: nil - methodDictionary: MethodDictionary new - format: Object format. - ^baseTrait! Item was removed: - ----- Method: NanoTraitDescription class>>conflict:with:with:with:with:with:with: (in category 'conflict methods') ----- - conflict: arg1 with: arg2 with: arg3 with: arg4 with: arg5 with: arg6 with: arg7 - "This method has a trait conflict" - ^self traitConflict! Item was removed: - ----- Method: NanoTraitComposition>>removeUser: (in category 'accessing') ----- - removeUser: aUser - ^self removeTraitUser: aUser! Item was removed: - ----- Method: NanoTraitAlias>>@ (in category 'converting') ----- - @ anArrayOfAssociations - ^NanoTraitAlias - with: subject - aliases: (anArrayOfAssociations, self aliases)! Item was removed: - ----- Method: NanoClassTrait>>updateTraitsFrom: (in category 'initialize') ----- - updateTraitsFrom: instanceTraits - "Update me from the given instance traits" - | map newTraits trait | - map := Dictionary new. - self traitComposition do:[:composed| map at: composed trait put: composed]. - newTraits := (instanceTraits collect:[:composed| - trait := composed trait classTrait. - map at: trait ifAbsent:[trait]] - ), (self traitComposition select:[:comp| comp trait isBaseTrait]). - - self installTraitsFrom: newTraits! Item was removed: - ----- Method: NanoClassTrait>>name (in category 'accessing') ----- - name - ^baseTrait name, ' classTrait'! Item was removed: - OrderedCollection subclass: #NanoTraitComposition - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'Traits-NanoKernel'! - - !NanoTraitComposition commentStamp: '<historical>' prior: 0! - A trait composition is a collection of Traits or TraitTransformations.! Item was removed: - ----- Method: NanoTraitComposition>>printOn: (in category 'converting') ----- - printOn: aStream - "Answer the trait composition string (used for class definitions)" - aStream nextPutAll: self traitCompositionString. - ! Item was removed: - ----- Method: NanoTraitTransformation>>+ (in category 'converting') ----- - + aTrait - "Just like ordered collection" - ^NanoTraitComposition withAll: {self. aTrait}! Item was removed: - ----- Method: NanoTraitAlias>>initializeFrom: (in category 'initialize-release') ----- - initializeFrom: anArrayOfAssociations - | newNames | - newNames := (anArrayOfAssociations collect: [:each | each key]) asIdentitySet. - newNames size < anArrayOfAssociations size ifTrue: [ - NanoTraitCompositionException signal: 'Cannot use the same alias name twice']. - anArrayOfAssociations do: [:each | - (newNames includes: each value) ifTrue: [ - NanoTraitCompositionException signal: 'Cannot define an alias for an alias']]. - aliases := anArrayOfAssociations. - ! Item was removed: - ----- Method: NanoTraitDescription>>traitsDo: (in category 'operations') ----- - traitsDo: aBlock - aBlock value: self.! Item was removed: - ----- Method: NanoTraitTransformation>>subject: (in category 'accessing') ----- - subject: aSubject - subject := aSubject.! Item was removed: - ----- Method: NanoTraitExclusion>>exclusions (in category 'accessing') ----- - exclusions - ^exclusions! Item was removed: - ----- Method: NanoTraitMethodState>>originalTraitMethod: (in category 'accessing') ----- - originalTraitMethod: aCompiledMethod - "The original method from the trait" - originalTraitMethod := aCompiledMethod! Item was removed: - ----- Method: NanoTrait>>bindingOf: (in category 'compiling') ----- - bindingOf: varName - "Answer the binding of some variable resolved in the scope of the receiver" - ^self environment bindingOf: varName asSymbol.! Item was removed: - ----- Method: NanoTraitExclusion>>printOn: (in category 'composition') ----- - printOn: aStream - "Answer the trait composition string (used for class definitions)" - aStream nextPutAll: subject asString. - aStream nextPutAll: ' - {'. - exclusions asArray sort do:[:exc| aStream store: exc] separatedBy:[aStream nextPutAll: '. ']. - aStream nextPutAll: '}'.! Item was removed: - ----- Method: NanoTraitDescription class>>conflict (in category 'conflict methods') ----- - conflict - "This method has a trait conflict" - ^self traitConflict! Item was removed: - ----- Method: NanoTraitComposition>>traitsDo: (in category 'accessing') ----- - traitsDo: aBlock - ^self do:[:each| each traitsDo: aBlock]! Item was removed: - ----- Method: NanoTraitDescription>>allClassVarNames (in category 'accessing') ----- - allClassVarNames - "Traits have no class var names" - ^#()! Item was removed: - ----- Method: NanoTraitDescription class>>conflict:with:with:with:with: (in category 'conflict methods') ----- - conflict: arg1 with: arg2 with: arg3 with: arg4 with: arg5 - "This method has a trait conflict" - ^self traitConflict! Item was removed: - ----- Method: NanoTraitTransformation>>- (in category 'converting') ----- - - anArrayOfSelectors - ^self subclassResponsibility! Item was removed: - ----- Method: NanoTrait>>environment: (in category 'accessing') ----- - environment: anObject - environment := anObject! Item was removed: - ----- Method: NanoTraitDescription>>includesTrait: (in category 'testing') ----- - includesTrait: aTrait - ^self == aTrait or:[super includesTrait: aTrait]! Item was removed: - ----- Method: NanoTraitDescription>>trait (in category 'accessing') ----- - trait - ^self! Item was removed: - ----- Method: NanoClassTrait>>asMCDefinition (in category 'monticello') ----- - asMCDefinition - ^Smalltalk at: #MCClassTraitDefinition ifPresent:[:aClass| - aClass - baseTraitName: self baseTrait name - classTraitComposition: self traitCompositionString - ].! Item was removed: - ----- Method: NanoTraitDescription class>>conflict:with:with:with: (in category 'conflict methods') ----- - conflict: arg1 with: arg2 with: arg3 with: arg4 - "This method has a trait conflict" - ^self traitConflict! Item was removed: - ----- Method: NanoTraitDescription>>copyTraitExpression (in category 'copying') ----- - copyTraitExpression - "Copy all except the actual traits" - ^self! Item was removed: - ----- Method: NanoTraitDescription>>users (in category 'accessing') ----- - users - ^users ifNil:[#()]! Item was removed: - ----- Method: NanoTraitComposition>>removeFromComposition: (in category 'compat') ----- - removeFromComposition: aTrait - "--- ignore ---"! Item was removed: - ----- Method: NanoTrait>>definitionST80 (in category 'initialize') ----- - definitionST80 - ^String streamContents: [:stream | - stream nextPutAll: 'Trait named: '; - store: self name. - stream cr; tab; nextPutAll: 'uses: '; - nextPutAll: self traitComposition asString. - stream cr; tab; nextPutAll: 'category: '; - store: self category asString].! Item was removed: - ----- Method: NanoTraitComposition>>selectorsAndMethodsDo: (in category 'operations') ----- - selectorsAndMethodsDo: aBlock - "enumerates all selectors and methods in a trait composition" - self do:[:each| each selectorsAndMethodsDo: aBlock].! Item was removed: - ----- Method: NanoTraitComposition>>copyTraitExpression (in category 'operations') ----- - copyTraitExpression - "Copy all except the actual traits" - ^self collect:[:each| each copyTraitExpression].! Item was removed: - ----- Method: Trait class>>initialize (in category 'class initialization') ----- - initialize - "Trait initialize" - self install.! Item was removed: - ----- Method: NanoTraitDescription>>addTraitUser: (in category 'accessing') ----- - addTraitUser: aTrait - users := self users copyWith: aTrait. - ! Item was removed: - ----- Method: NanoTraitExclusion class>>with:exclusions: (in category 'instance creation') ----- - with: aTraitComposition exclusions: anArrayOfSelectors - ^self new - subject: aTraitComposition; - exclusions: anArrayOfSelectors; - yourself - ! Item was removed: - ----- Method: NanoTraitAlias>>aliases (in category 'accessing') ----- - aliases - "Collection of associations where key is the - alias and value the original selector." - ^aliases!

1 0

The Trunk: Traits-ar.263.mcz
by commits＠source.squeak.org 31 Dec '09

31 Dec '09

1 0

The Trunk: Traits-ar.263.mcz
by commits＠source.squeak.org 31 Dec '09

31 Dec '09

1 0

← Newer
1
2
3
4
5
6
7
8
9
...
104
Older →

Jump to page:

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

Packages December 2009