SystemOrganization addCategory: #'Namespaces-Core'! SystemOrganization addCategory: #'Namespaces-Tests'! !ClassDescription methodsFor: '*namespaces' stamp: 'lr 5/20/2010 13:27'! asNamespaceImport ^ ElementImport binding: self theNonMetaClass binding! ! !TraitDescription methodsFor: '*namespaces' stamp: 'lr 5/20/2010 13:27'! asNamespaceImport ^ ElementImport binding: self baseTrait binding! ! Object subclass: #Import instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Namespaces-Core'! Import subclass: #ElementImport instanceVariableNames: 'binding' classVariableNames: '' poolDictionaries: '' category: 'Namespaces-Core'! !ElementImport class methodsFor: 'instance creation' stamp: 'lr 5/20/2010 09:35'! binding: aBinding ^ self new initializeBinding: aBinding! ! !ElementImport methodsFor: 'querying' stamp: 'lr 5/20/2010 09:34'! bindingOf: aString ^ binding key = aString ifTrue: [ binding ]! ! !ElementImport methodsFor: 'initialization' stamp: 'lr 5/20/2010 09:34'! initializeBinding: aBinding binding := aBinding! ! Import subclass: #WildcardImport instanceVariableNames: 'namespace' classVariableNames: '' poolDictionaries: '' category: 'Namespaces-Core'! !WildcardImport class methodsFor: 'instance creation' stamp: 'lr 5/20/2010 09:24'! namespace: aNamespace ^ self new initializeNamespace: aNamespace! ! !WildcardImport methodsFor: 'querying' stamp: 'lr 5/20/2010 09:34'! bindingOf: aString ^ namespace associationAt: aString ifAbsent: [ nil ]! ! !WildcardImport methodsFor: 'initialization' stamp: 'lr 5/20/2010 09:46'! initializeNamespace: aNamespace namespace := aNamespace! ! Object subclass: #Namespace instanceVariableNames: 'bindings organization imports' classVariableNames: 'Current Default' poolDictionaries: '' category: 'Namespaces-Core'! !Namespace class methodsFor: 'accessing' stamp: ''! current ^ Current! ! !Namespace class methodsFor: 'accessing' stamp: ''! default ^ Default! ! !Namespace class methodsFor: 'initialization' stamp: 'lr 5/20/2010 09:33'! initialize Default := Current := self basicNew. Default instVarNamed: 'bindings' put: Smalltalk globals. Default instVarNamed: 'organization' put: SystemOrganizer new. Default instVarNamed: 'imports' put: #()! ! !Namespace methodsFor: 'querying' stamp: 'lr 5/20/2010 09:27'! allClasses ^ Array new: bindings size streamContents: [ :stream | self allClassesDo: [ :each | stream nextPut: each ] ]! ! !Namespace methodsFor: 'enumerating' stamp: 'lr 5/20/2010 09:26'! allClassesDo: aBlock self do: [ :each | each isBehavior ifTrue: [ aBlock value: each ] ]! ! !Namespace methodsFor: 'querying' stamp: 'lr 5/20/2010 09:27'! allTraits ^ Array new: bindings size streamContents: [ :stream | self allTraitsDo: [ :each | stream nextPut: each ] ]! ! !Namespace methodsFor: 'enumerating' stamp: 'lr 5/20/2010 09:26'! allTraitsDo: aBlock self do: [ :each | each isTrait ifTrue: [ aBlock value: each ] ]! ! !Namespace methodsFor: 'converting' stamp: 'lr 5/20/2010 13:27'! asNamespaceImport ^ WildcardImport namespace: self! ! !Namespace methodsFor: 'accessing-bindings' stamp: 'lr 5/20/2010 09:48'! associationAt: aString ^ bindings associationAt: aString! ! !Namespace methodsFor: 'accessing-bindings' stamp: 'lr 5/20/2010 09:48'! associationAt: aString ifAbsent: aBlock ^ bindings associationAt: aString ifAbsent: aBlock! ! !Namespace methodsFor: 'accessing-bindings' stamp: 'lr 5/20/2010 09:24'! at: aString ^ bindings at: aString! ! !Namespace methodsFor: 'accessing-bindings' stamp: 'lr 5/20/2010 09:25'! at: aString ifAbsent: aBlock ^ bindings at: aString ifAbsent: aBlock! ! !Namespace methodsFor: 'accessing-bindings' stamp: 'lr 5/20/2010 09:25'! at: aString ifAbsentPut: aBlock ^ bindings at: aString ifAbsentPut: aBlock! ! !Namespace methodsFor: 'accessing-bindings' stamp: 'lr 5/20/2010 09:25'! at: aString ifPresent: aBlock ^ bindings at: aString ifPresent: aBlock! ! !Namespace methodsFor: 'accessing-bindings' stamp: 'lr 5/20/2010 09:25'! at: aString put: anObject ^ bindings at: aString put: anObject! ! !Namespace methodsFor: 'querying' stamp: 'lr 5/20/2010 09:28'! bindingOf: aString | binding | binding := bindings bindingOf: aString. binding isNil ifFalse: [ ^ binding ]. imports do: [ :each | binding := each bindingOf: aString. binding isNil ifFalse: [ ^ binding ] ]. ^ nil! ! !Namespace methodsFor: 'enumerating' stamp: 'lr 5/20/2010 09:26'! do: aBlock bindings do: aBlock! ! !Namespace methodsFor: 'importing' stamp: 'lr 5/20/2010 13:27'! import: anObject imports := imports copyWith: anObject asNamespaceImport! ! !Namespace methodsFor: 'accessing' stamp: ''! imports ^ imports! ! !Namespace methodsFor: 'accessing-bindings' stamp: 'lr 5/20/2010 13:25'! includesKey: aString ^ bindings includesKey: aString! ! !Namespace methodsFor: 'initialization' stamp: ''! initialize super initialize. bindings := Dictionary new. organization := SystemOrganizer defaultList: #(). imports := #()! ! !Namespace methodsFor: 'accessing' stamp: ''! organization ^ organization! ! !Namespace methodsFor: 'accessing-bindings' stamp: 'lr 5/20/2010 09:25'! removeKey: aString ^ bindings removeKey: aString! ! !Namespace methodsFor: 'accessing-bindings' stamp: 'lr 5/20/2010 09:25'! removeKey: aString ifAbsent: anObject ^ bindings removeKey: aString ifAbsent: anObject! ! TestCase subclass: #NamespaceTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Namespaces-Tests'! !NamespaceTest methodsFor: 'testing' stamp: 'lr 5/20/2010 09:32'! testElementImport | namespace | namespace := Namespace new. namespace import: Object. self assert: namespace allClasses isEmpty. self assert: namespace allTraits isEmpty. self assert: (namespace bindingOf: Object name) = Object binding. self assert: (namespace bindingOf: True name) isNil! ! !NamespaceTest methodsFor: 'testing' stamp: 'lr 5/20/2010 09:29'! testEmptyNamespace | namespace | namespace := Namespace new. self assert: namespace allClasses isEmpty. self assert: namespace allTraits isEmpty! ! !NamespaceTest methodsFor: 'testing' stamp: 'lr 5/20/2010 09:28'! testHideImport | namespace | namespace := Namespace new. namespace import: Namespace default. namespace at: Object name put: 123. self assert: (namespace bindingOf: Object name) value = 123! ! !NamespaceTest methodsFor: 'testing' stamp: 'lr 5/20/2010 09:48'! testNestedImport | namespace1 namespace2 namespace3 | namespace1 := Namespace new. namespace1 import: Namespace default. namespace1 at: #ns1 put: 1. namespace2 := Namespace new. namespace2 import: namespace1. namespace2 at: #ns2 put: 2. namespace3 := Namespace new. namespace3 import: namespace2. self assert: (namespace1 bindingOf: #ns1) value = 1. self assert: (namespace2 bindingOf: #ns1) value = 1. self assert: (namespace3 bindingOf: #ns1) isNil. self assert: (namespace1 bindingOf: #ns2) isNil. self assert: (namespace2 bindingOf: #ns2) value = 2. self assert: (namespace3 bindingOf: #ns2) value = 2! ! !NamespaceTest methodsFor: 'testing' stamp: 'lr 5/20/2010 09:28'! testWildcardImport | namespace | namespace := Namespace new. namespace import: Namespace default. self assert: namespace allClasses isEmpty. self assert: namespace allTraits isEmpty. self assert: (namespace bindingOf: Object name) = Object binding! ! Namespace initialize!