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: #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! !

!ElementImport methodsFor: 'printing' stamp: 'lr 5/20/2010 13:38'!
printOn: aStream
	(binding value notNil and: [ binding value isBehavior or: [ binding value isTrait ] ])
		ifTrue: [ aStream nextPutAll: binding value environment name; nextPut: $. ].
	aStream nextPutAll: binding key! !

Object subclass: #Namespace
	instanceVariableNames: 'name bindings organization imports'
	classVariableNames: 'Current Default'
	poolDictionaries: ''
	category: 'Namespaces-Core'!

!Namespace class methodsFor: 'accessing' stamp: ''!
current
	^ Current! !

!Namespace class methodsFor: 'accessing' stamp: 'lr 5/20/2010 13:33'!
default
	"Answer the default namespace, that is the space where all the Smalltalk-80 stuff is found."

	^ Default! !

!Namespace class methodsFor: 'initialization' stamp: 'lr 5/20/2010 13:32'!
initialize
	Default := Current := self named: #Smalltalk.
	Default instVarNamed: 'bindings' put: Smalltalk globals.
	Default instVarNamed: 'organization' put: Smalltalk organization.
	Default instVarNamed: 'imports' put: #()! !

!Namespace class methodsFor: 'instance creation' stamp: 'lr 5/20/2010 13:31'!
named: aSymbol
	^ self basicNew initializeNamed: aSymbol! !

!Namespace class methodsFor: 'instance creation' stamp: 'lr 5/20/2010 13:31'!
new
	self error: 'Instantiate new namespaces with #named:'! !

!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: 'lr 5/20/2010 13:29'!
imports
	"Answer an ordered collection of imports of the receiving namespace."
	
	^ imports! !

!Namespace methodsFor: 'accessing-bindings' stamp: 'lr 5/20/2010 13:25'!
includesKey: aString
	^ bindings includesKey: aString! !

!Namespace methodsFor: 'initialization' stamp: 'lr 5/20/2010 13:31'!
initializeNamed: aSymbol
	name := aSymbol.
	bindings := Dictionary new.
	organization := SystemOrganizer defaultList: #().
	imports := #()! !

!Namespace methodsFor: 'accessing' stamp: 'lr 5/20/2010 13:29'!
name
	"Answer the name of the receiving namespace."
	
	^ name! !

!Namespace methodsFor: 'accessing' stamp: 'lr 5/20/2010 13:29'!
organization
	"Answer the organization of the receiving namespace."

	^ organization! !

!Namespace methodsFor: 'printing' stamp: 'lr 5/20/2010 13:32'!
printOn: aStream
	super printOn: aStream.
	aStream nextPutAll: ' named: '; print: self name! !

!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! !

Object 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! !

!WildcardImport methodsFor: 'printing' stamp: 'lr 5/20/2010 13:37'!
printOn: aStream
	aStream nextPutAll: namespace name; nextPutAll: '.*'! !

TestCase subclass: #NamespaceTest
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Namespaces-Tests'!

!NamespaceTest class methodsFor: 'accessing' stamp: 'lr 5/20/2010 13:39'!
packageNamesUnderTest
	^ #('Namespaces')! !

!NamespaceTest methodsFor: 'testing' stamp: 'lr 5/20/2010 13:37'!
testElementImport
	| namespace |
	namespace := Namespace named: 'Test'.
	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 13:38'!
testEmptyNamespace
	| namespace |
	namespace := Namespace named: 'Test'.
	self assert: namespace name = 'Test'.
	self assert: namespace allClasses isEmpty.
	self assert: namespace allTraits isEmpty! !

!NamespaceTest methodsFor: 'testing' stamp: 'lr 5/20/2010 13:39'!
testHideImport
	| namespace |
	namespace := Namespace named: 'Test'.
	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 13:39'!
testNestedImport
	| namespace1 namespace2 namespace3 |
	namespace1 := Namespace named: 'Test1'.
	namespace1 import: Namespace default.
	namespace1 at: #ns1 put: 1.
	
	namespace2 := Namespace named: 'Test2'.
	namespace2 import: namespace1.
	namespace2 at: #ns2 put: 2.
	
	namespace3 := Namespace named: 'Test3'.
	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 13:39'!
testWildcardImport
	| namespace |
	namespace := Namespace named: 'Test'.
	namespace import: Namespace default.
	self assert: namespace allClasses isEmpty.
	self assert: namespace allTraits isEmpty.
	self assert: (namespace bindingOf: Object name) = Object binding! !
Namespace initialize!