[squeak-dev] The Inbox: Environments-ul.84.mcz

commits at source.squeak.org commits at source.squeak.org
Thu Jul 14 14:12:08 UTC 2022


A new version of Environments was added to project The Inbox:
http://source.squeak.org/inbox/Environments-ul.84.mcz

==================== Summary ====================

Name: Environments-ul.84
Author: ul
Time: 31 March 2022, 9:44:33.789829 am
UUID: 8bddd87e-953c-485a-b76a-991fd4548c87
Ancestors: Environments-ct.83

- use Symboll class >> #lookup: instead of #hasInterned:ifTrue:
- just check whether baseName is an existing symbol in Environment >> #classOrTraitNamed: instead of interning it, because if it is not a symbol, it cannot be present as a key in declarations

=============== Diff against Environments-ct.83 ===============

Item was removed:
- (PackageInfo named: 'Environments') preamble: '"Fix ''Instances'' entry for Smalltalk Environment."
- | dict |
- dict := (Environment classPool at: ''Instances'').
- dict keys
- 	do: [ : eachName | (eachName isSymbol not ) ifTrue: [ dict at: eachName asSymbol put: (dict removeKey: eachName) ] ].
- 
- "Let Environment names be, consistently, Symbols."
- Environment allInstances do:
- 	[ : each | 
- 	each info 
- 		instVarNamed: ''name'' 
- 		put: (each name asSymbol) ]'!

Item was removed:
- SystemOrganization addCategory: #'Environments-Core'!
- SystemOrganization addCategory: #'Environments-Loading'!
- SystemOrganization addCategory: #'Environments-Policies'!
- SystemOrganization addCategory: #'Environments-Help'!
- SystemOrganization addCategory: #'Environments-Notifications'!

Item was removed:
- NamePolicy subclass: #AddPrefixNamePolicy
- 	instanceVariableNames: 'prefix'
- 	classVariableNames: ''
- 	poolDictionaries: ''
- 	category: 'Environments-Policies'!

Item was removed:
- ----- Method: AddPrefixNamePolicy class>>prefix: (in category 'instance creation') -----
- prefix: aString
- 	^ self basicNew initializeWithPrefix: aString!

Item was removed:
- ----- Method: AddPrefixNamePolicy>>initializeWithPrefix: (in category 'initialize-release') -----
- initializeWithPrefix: aString
- 	self initialize.
- 	prefix := aString!

Item was removed:
- ----- Method: AddPrefixNamePolicy>>name:do: (in category 'naming') -----
- name: aSymbol do: aBlock
- 	^ (aSymbol beginsWith: prefix) ifFalse: 
- 		[aBlock value: (prefix, aSymbol) asSymbol].
- 	!

Item was removed:
- Binding subclass: #Alias
- 	instanceVariableNames: 'source'
- 	classVariableNames: ''
- 	poolDictionaries: ''
- 	category: 'Environments-Core'!

Item was removed:
- ----- Method: Alias class>>key:source: (in category 'instance creation') -----
- key: aSymbol source: anAssociation
- 	^ self basicNew initializeWithKey: aSymbol source: anAssociation!

Item was removed:
- ----- Method: Alias>>asBinding: (in category 'converting') -----
- asBinding: aSymbol
- 	^ aSymbol = source key
- 		ifTrue: [source]
- 		ifFalse: [Alias key: aSymbol source: source]!

Item was removed:
- ----- Method: Alias>>initializeWithKey:source: (in category 'initialization') -----
- initializeWithKey: aSymbol source: anAssociation
- 	self initialize.
- 	key := aSymbol.
- 	source := anAssociation!

Item was removed:
- ----- Method: Alias>>isSpecialReadBinding (in category 'testing') -----
- isSpecialReadBinding
- 	^ true!

Item was removed:
- ----- Method: Alias>>isSpecialWriteBinding (in category 'testing') -----
- isSpecialWriteBinding
- 	^ true!

Item was removed:
- ----- Method: Alias>>literalEqual: (in category 'literals') -----
- literalEqual: other 
- 	"Two aliases are equal if they have the same source"
- 
- 	^ self species = other species and: [self source == other source]!

Item was removed:
- ----- Method: Alias>>source (in category 'accessing') -----
- source
- 	^ source!

Item was removed:
- ----- Method: Alias>>value (in category 'evaluating') -----
- value
- 	^ source value!

Item was removed:
- ----- Method: Alias>>value: (in category 'accessing') -----
- value: anObject
- 	source value: anObject!

Item was removed:
- NamePolicy subclass: #AllNamePolicy
- 	instanceVariableNames: ''
- 	classVariableNames: ''
- 	poolDictionaries: ''
- 	category: 'Environments-Policies'!

Item was removed:
- ----- Method: AllNamePolicy>>name:do: (in category 'naming') -----
- name: aSymbol do: aBlock
- 	^ aBlock value: aSymbol!

Item was removed:
- ----- Method: Association>>asBinding: (in category '*environments') -----
- asBinding: aSymbol
- 	^ aSymbol == key
- 		ifTrue: [self]
- 		ifFalse: [Alias key: aSymbol source: self]!

Item was removed:
- LookupKey subclass: #Binding
- 	instanceVariableNames: ''
- 	classVariableNames: ''
- 	poolDictionaries: ''
- 	category: 'Environments-Core'!

Item was removed:
- ----- Method: Binding class>>convertInstances (in category 'system management') -----
- convertInstances
- 	| new old |
- 	old := Binding allInstances.
- 	new := old collect: [:ea | ClassBinding key: ea key value: ea value].
- 	old elementsForwardIdentityTo: new.
- 	
- 	old := ReadOnlyVariableBinding allInstances.
- 	new := old collect: [:ea | ClassBinding key: ea key value: ea value].
- 	old elementsForwardIdentityTo: new.
- 	
- 	Environment allInstancesDo:
- 		[:env |
- 		#('contents' 'bindings' 'public' 'undeclared') do:
- 			[:var || dict |
- 			old := Array new writeStream.
- 			new := Array new writeStream.
- 			dict := env instVarNamed: var.
- 			dict associations do:
- 				[:binding |
- 				binding class == Association ifTrue:
- 					[old nextPut: binding.
- 					new nextPut: binding key => binding value]].
- 			old contents elementsForwardIdentityTo: new contents]]!

Item was removed:
- ----- Method: Binding>>analogousCodeTo: (in category 'comparing') -----
- analogousCodeTo: anObject
- 	"For MethodProperties comparison."
- 	^anObject isVariableBinding
- 	  and: [self key = anObject key
- 	  and: [self value = anObject value]]!

Item was removed:
- ----- Method: Binding>>canAssign (in category 'accessing') -----
- canAssign
- 	^ true!

Item was removed:
- ----- Method: Binding>>isSpecialReadBinding (in category 'testing') -----
- isSpecialReadBinding
- 	^ false!

Item was removed:
- ----- Method: Binding>>isSpecialWriteBinding (in category 'testing') -----
- isSpecialWriteBinding
- 	^ false!

Item was removed:
- ----- Method: Binding>>objectForDataStream: (in category 'objects from disk') -----
- objectForDataStream: refStrm
- 	"I am about to be written on an object file.  I am a global, so write a proxy that 
- 	will hook up with the same resource in the destination system."
- 
- 	| dp |
- 	dp := DiskProxy 
- 		global: #Smalltalk 
- 		selector: #associationOrUndeclaredAt: 
- 		args: (Array with: key).
- 	refStrm replace: self with: dp.
- 	^ dp!

Item was removed:
- ----- Method: Binding>>printOn: (in category 'printing') -----
- printOn: aStream
- 	key printOn: aStream.
- 	aStream nextPutAll: '=>'.
- 	self value printOn: aStream!

Item was removed:
- ----- Method: Binding>>source (in category 'accessing') -----
- source
- 	^ self!

Item was removed:
- Object subclass: #BindingPolicy
- 	instanceVariableNames: 'policy environment addSelector removeSelector'
- 	classVariableNames: ''
- 	poolDictionaries: ''
- 	category: 'Environments-Policies'!

Item was removed:
- ----- Method: BindingPolicy class>>environment:policy:addSelector:removeSelector: (in category 'instance creation') -----
- environment: anEnvironment policy: aNamePolicy addSelector: addSelector removeSelector: removeSelector
- 	^ self basicNew 
- 		initializeWithEnvironment: anEnvironment 
- 		policy: aNamePolicy 
- 		addSelector: addSelector
- 		removeSelector: removeSelector!

Item was removed:
- ----- Method: BindingPolicy>>binding:addedTo:notify: (in category 'events') -----
- binding: aBinding addedTo: anEnvironment notify: anObject
- 	environment == anEnvironment ifTrue: 
- 		[policy name: aBinding key do:
- 			[:name || binding |
- 			binding := aBinding asBinding: name.
- 			anObject perform: addSelector with: binding]].
- !

Item was removed:
- ----- Method: BindingPolicy>>binding:removedFrom:notify: (in category 'events') -----
- binding: aBinding removedFrom: anEnvironment notify: anObject
- 	environment == anEnvironment ifTrue: 
- 		[policy name: aBinding key do:
- 			[:name || binding |
- 			binding := aBinding asBinding: name.
- 			anObject perform: removeSelector with: binding]].
- !

Item was removed:
- ----- Method: BindingPolicy>>environment (in category 'accessing') -----
- environment
- 	^ environment!

Item was removed:
- ----- Method: BindingPolicy>>initializeWithEnvironment:policy:addSelector:removeSelector: (in category 'initialize-release') -----
- initializeWithEnvironment: anEnvironment 
- policy: aNamePolicy 
- addSelector: aSelector 
- removeSelector: rSelector
- 	self initialize.
- 	environment := anEnvironment.
- 	policy := aNamePolicy.
- 	addSelector := aSelector.
- 	removeSelector := rSelector!

Item was removed:
- ----- Method: BindingPolicy>>name:do: (in category 'private') -----
- name: aSymbol do: aBlock
- 	^ policy name: aSymbol do: aBlock!

Item was removed:
- ----- Method: BindingPolicy>>removeObserver: (in category 'initialize-release') -----
- removeObserver: anEnvironment
- 	environment removeObserver: anEnvironment !

Item was removed:
- Binding subclass: #ClassBinding
- 	instanceVariableNames: 'value'
- 	classVariableNames: ''
- 	poolDictionaries: ''
- 	category: 'Environments-Core'!

Item was removed:
- ----- Method: ClassBinding class>>key:value: (in category 'instance creation') -----
- key: key value: value
- 	^ self basicNew initializeWithKey: key value: value!

Item was removed:
- ----- Method: ClassBinding>>asBinding: (in category 'converting') -----
- asBinding: aSymbol
- 	^ aSymbol == key
- 		ifTrue: [self]
- 		ifFalse: [Alias key: aSymbol source: self]!

Item was removed:
- ----- Method: ClassBinding>>canAssign (in category 'accessing') -----
- canAssign
- 	^ false!

Item was removed:
- ----- Method: ClassBinding>>initializeWithKey:value: (in category 'initialize-release') -----
- initializeWithKey: kObject value: vObject
- 	self initialize.
- 	key := kObject.
- 	value := vObject.!

Item was removed:
- ----- Method: ClassBinding>>isSpecialWriteBinding (in category 'testing') -----
- isSpecialWriteBinding
- 	^ true!

Item was removed:
- ----- Method: ClassBinding>>literalEqual: (in category 'literals') -----
- literalEqual: other
- 	"Class bindings are equal when the bind the same class"
- 	
- 	^ self species = other species and: [self value = other value]!

Item was removed:
- ----- Method: ClassBinding>>value (in category 'evaluating') -----
- value
- 	^ value!

Item was removed:
- ----- Method: ClassBinding>>value: (in category 'accessing') -----
- value: anObject
- 	(AttemptToWriteReadOnlyGlobal signal: 'Cannot store into read-only bindings')
- 		ifTrue: [value := anObject]!

Item was removed:
- Notification subclass: #CurrentEnvironment
- 	instanceVariableNames: ''
- 	classVariableNames: ''
- 	poolDictionaries: ''
- 	category: 'Environments-Loading'!

Item was removed:
- Object subclass: #Environment
- 	instanceVariableNames: 'info declarations bindings undeclared policies observers'
- 	classVariableNames: 'Default Instances'
- 	poolDictionaries: ''
- 	category: 'Environments-Core'!
- 
- !Environment commentStamp: 'nice 9/29/2016 10:27' prior: 0!
- I am a context for compiling methods. I maintain the namespace of classes and global variables that are visible to the methods compiled within me.
- 
- I have the following instance variables:
- 
- info <EnvironmentInfo>
- Metadata about me and the code I contain.
- 
- declarations <IdentityDictionary>
- Bindings for class and other globals that have been declared inside me.
- 
- bindings <IdentityDictionary>
- Bindings for all the class and global variables visible from the compiler.
- It generally includes the declarations (see importSelf), plus other imports from other environments, including aliases.
- 
- policies      <Collection of: NamePolicy>
- The list of rules for importing and exporting bindings to other environments.
- 
- observers      <Collection of: Environment>
- These are the environments importing some bindings from self, and which should be notified whenever we add/remove/change some binding.
- !

Item was removed:
- ----- Method: Environment class>>cleanUp (in category 'class initialization') -----
- cleanUp
- 	self allInstancesDo:
- 		[:env | env purgeUndeclared]!

Item was removed:
- ----- Method: Environment class>>current (in category 'accessing') -----
- current
- 	^ CurrentEnvironment signal ifNil: [self default]!

Item was removed:
- ----- Method: Environment class>>default (in category 'accessing') -----
- default
- 	^ Default!

Item was removed:
- ----- Method: Environment class>>default: (in category 'accessing') -----
- default: anEnvironment
- 	Default := anEnvironment!

Item was removed:
- ----- Method: Environment class>>initialize (in category 'class initialization') -----
- initialize
- 	self install!

Item was removed:
- ----- Method: Environment class>>install (in category 'class initialization') -----
- install
- 	| smalltalk env |
- 	self environment class == self ifTrue:
- 		[Transcript 
- 			cr; 
- 			show: 'Can''t install environments; they''re already installed'.
- 		^ self].
- 
- 	smalltalk := Smalltalk globals.
- 	env := self basicNew initializeWithSystemDictionary: smalltalk.
- 	Default := env.
- 	Instances ifNil: [Instances := IdentityDictionary new].
- 	Instances at: env info name put: env.
- 	(smalltalk at: #Undeclared) becomeForward: (env at: #Undeclared).
- 	smalltalk becomeForward: env.
- 	Smalltalk garbageCollect.!

Item was removed:
- ----- Method: Environment class>>named: (in category 'instance creation') -----
- named: aSymbol
- 	| symbol |
- 	symbol := aSymbol asSymbol.
- 	^ Instances 
- 		at: symbol
- 		ifAbsentPut: [ self withName: symbol ]!

Item was removed:
- ----- Method: Environment class>>uninstall (in category 'class initialization') -----
- uninstall
- 	| globals sysdict |
- 	self environment class == self ifFalse: 
- 		[Transcript 
- 			cr; 
- 			show: 'Can''t uninstall environments; they''re not currently installed'.
- 		^ self].
- 	
- 	globals := Smalltalk globals declarations.
- 	sysdict := SystemDictionary new: globals size.
- 	globals do: [:ea | sysdict add: ea].
- 	Smalltalk globals becomeForward: sysdict.!

Item was removed:
- ----- Method: Environment class>>withName: (in category 'instance creation') -----
- withName: aString
- 	^ self basicNew initializeWithName: aString!

Item was removed:
- ----- Method: Environment>>addAllBindings (in category 'updating') -----
- addAllBindings
- 	declarations associationsDo:
- 		[:ea | self binding: ea addedTo: self]!

Item was removed:
- ----- Method: Environment>>addObserver: (in category 'observing') -----
- addObserver: anObject
- 	observers add: anObject!

Item was removed:
- ----- Method: Environment>>allClasses (in category 'classes and traits') -----
- allClasses
- 	^ Array streamContents:
- 		[:out |
- 		self allClassesDo:
- 			[:class |
- 			out nextPut: class]]!

Item was removed:
- ----- Method: Environment>>allClassesAndTraits (in category 'classes and traits') -----
- allClassesAndTraits
- 	^ Array streamContents:
- 		[:out | self allClassesAndTraitsDo:
- 			[:value | out nextPut: value]]!

Item was removed:
- ----- Method: Environment>>allClassesAndTraitsDo: (in category 'classes and traits') -----
- allClassesAndTraitsDo: aBlock
- 	declarations keysAndValuesDo:
- 		[:key :value |
- 		((value isBehavior) and: [key == value name]) ifTrue:
- 			[aBlock value: value]]!

Item was removed:
- ----- Method: Environment>>allClassesDo: (in category 'classes and traits') -----
- allClassesDo: aBlock
- 	self allClassesAndTraitsDo:
- 		[:value |
- 		 value isTrait ifFalse:
- 			[aBlock value: value]]!

Item was removed:
- ----- Method: Environment>>allTraits (in category 'classes and traits') -----
- allTraits
- 	^ Array streamContents:
- 		[:out |
- 		self allTraitsDo: 
- 			[:value | out nextPut: value]]	!

Item was removed:
- ----- Method: Environment>>allTraitsDo: (in category 'classes and traits') -----
- allTraitsDo: aBlock
- 	self allClassesAndTraitsDo:
- 		[:value |
- 		value isTrait ifTrue:
- 			[aBlock value: value]]!

Item was removed:
- ----- Method: Environment>>associationAt: (in category 'emulating') -----
- associationAt: aSymbol
- 	"Senders of this should probably be using #bindingOf:"
- 	
- 	self flag: #review.
- 	^ declarations associationAt: aSymbol!

Item was removed:
- ----- Method: Environment>>associationAt:ifAbsent: (in category 'emulating') -----
- associationAt: aSymbol ifAbsent: aBlock
- 	"Senders of this should probably be using #bindingOf:"
- 	
- 	self flag: #review.
- 	^ declarations associationAt: aSymbol ifAbsent: aBlock!

Item was removed:
- ----- Method: Environment>>associationOrUndeclaredAt: (in category 'emulating') -----
- associationOrUndeclaredAt: key
- 	^ bindings associationAt: key ifAbsent:
- 		[undeclared at: key put: nil.
- 		undeclared associationAt: key]
- 	!

Item was removed:
- ----- Method: Environment>>associationsDo: (in category 'emulating') -----
- associationsDo: aBlock
- 	"Evaluate aBlock for each of the receiver's elements (key/value associations)."
- 
- 	declarations associationsDo: aBlock!

Item was removed:
- ----- Method: Environment>>at: (in category 'emulating') -----
- at: aSymbol
- 	^ declarations at: aSymbol!

Item was removed:
- ----- Method: Environment>>at:ifAbsent: (in category 'emulating') -----
- at: aSymbol ifAbsent: aBlock
- 	^ declarations at: aSymbol ifAbsent: aBlock!

Item was removed:
- ----- Method: Environment>>at:ifAbsentPut: (in category 'emulating') -----
- at: aSymbol ifAbsentPut: aBlock 
- 	^self at: aSymbol ifAbsent: [
-                 self at: aSymbol put: aBlock value ]!

Item was removed:
- ----- Method: Environment>>at:ifPresent: (in category 'emulating') -----
- at: aSymbol ifPresent: aBlock
- 	^ declarations at: aSymbol ifPresent: aBlock!

Item was removed:
- ----- Method: Environment>>at:ifPresent:ifAbsent: (in category 'emulating') -----
- at: aSymbol ifPresent: presentBlock ifAbsent: absentBlock
- 	^ declarations
- 		at: aSymbol
- 		ifPresent: presentBlock
- 		ifAbsent: absentBlock.!

Item was removed:
- ----- Method: Environment>>at:ifPresentAndInMemory: (in category 'emulating') -----
- at: key ifPresentAndInMemory: aBlock
- 	^ declarations
- 		at: key
- 		ifPresent: 
- 			[:v |
- 			v isInMemory ifTrue:
- 				[aBlock value: v]]!

Item was removed:
- ----- Method: Environment>>at:put: (in category 'emulating') -----
- at: aSymbol put: anObject
- 	^ self bind: aSymbol to: anObject!

Item was removed:
- ----- Method: Environment>>beCurrentDuring: (in category 'evaluating') -----
- beCurrentDuring: aBlock
- 	"Evaluate aBlock with me as the current dynamic Environment"
- 	^ aBlock on: CurrentEnvironment do: [:e | e resume: self]!

Item was removed:
- ----- Method: Environment>>bind:to: (in category 'binding') -----
- bind: aSymbol to: anObject
- 	| binding newBinding |
- 	newBinding := aSymbol => anObject.
- 	
- 	binding := declarations associationAt: aSymbol ifAbsent: [nil].
- 	binding ifNotNil: 
- 		[binding class == newBinding class
- 			ifTrue: [binding value: anObject]
- 			ifFalse: [binding becomeForward: newBinding].
- 		^anObject].
- 	
- 	binding := undeclared associationAt: aSymbol ifAbsent: [nil].
- 	binding
- 	        ifNil: [binding := newBinding]
- 	        ifNotNil: 
- 			[undeclared removeKey: aSymbol.
- 			binding class == newBinding class
- 				ifTrue: [binding value: anObject]
- 				ifFalse: [binding becomeForward: newBinding]].
- 			
- 	declarations add: binding.
- 	self binding: binding addedTo: self.
- 	^anObject
- !

Item was removed:
- ----- Method: Environment>>binding:addedTo: (in category 'updating') -----
- binding: aBinding addedTo: anEnvironment
- 	policies do:
- 		[:ea | ea binding: aBinding addedTo: anEnvironment notify: self]!

Item was removed:
- ----- Method: Environment>>binding:removedFrom: (in category 'updating') -----
- binding: aBinding removedFrom: anEnvironment
- 	policies do:
- 		[:ea | ea binding: aBinding removedFrom: anEnvironment notify: self]!

Item was removed:
- ----- Method: Environment>>bindingOf: (in category 'binding') -----
- bindingOf: aSymbol
- 	^ self bindingOf: aSymbol ifAbsent: nil!

Item was removed:
- ----- Method: Environment>>bindingOf:ifAbsent: (in category 'binding') -----
- bindingOf: aSymbol ifAbsent: aBlock
- 	^ bindings bindingOf: aSymbol ifAbsent: aBlock!

Item was removed:
- ----- Method: Environment>>classAndTraitNames (in category 'classes and traits') -----
- classAndTraitNames
- 	| names |
- 	names := Array streamContents:
- 		[:out |
- 		self allClassesAndTraitsDo:
- 			[:value |
- 			out nextPut: value name]].
- 	names sort.
- 	^ names!

Item was removed:
- ----- Method: Environment>>classNamed: (in category 'classes and traits') -----
- classNamed: aString
- 	^ self classOrTraitNamed: aString!

Item was removed:
- ----- Method: Environment>>classNames (in category 'classes and traits') -----
- classNames
- 	^ (self allClasses collect: [:ea | ea name]) sort!

Item was removed:
- ----- Method: Environment>>classOrTraitNamed: (in category 'classes and traits') -----
- classOrTraitNamed: aString 
- 	"aString is either a class or trait name or a class or trait name followed by ' class' or 'classTrait' respectively.
- 	Answer the class or metaclass it names."
- 
- 	| meta baseName |
- 	(aString endsWith: ' class')
- 		ifTrue: [meta := true.
- 				baseName := aString copyFrom: 1 to: aString size - 6]
- 		ifFalse: [
- 			(aString endsWith: ' classTrait')
- 				ifTrue: [
- 					meta := true.
- 					baseName := aString copyFrom: 1 to: aString size - 11]
- 				ifFalse: [
- 					meta := false.
- 					baseName := aString]].
- 
- 	^declarations at: baseName asSymbol ifPresent:
- 		[ :global |
-  		global isBehavior ifTrue:
- 			[ meta
- 				ifFalse: [ global ]
- 				ifTrue: [ global classSide ]]]!

Item was removed:
- ----- Method: Environment>>collect: (in category 'emulating') -----
- collect: aBlock
- 	^ declarations collect: aBlock!

Item was removed:
- ----- Method: Environment>>declarationOf: (in category 'binding') -----
- declarationOf: aSymbol
- 	^ declarations bindingOf: aSymbol!

Item was removed:
- ----- Method: Environment>>declarations (in category 'declaring') -----
- declarations
- 	^ Array streamContents:
- 		[:out | declarations associationsDo:
- 			[:ea | out nextPut: ea]]!

Item was removed:
- ----- Method: Environment>>destroy (in category 'initialize-release') -----
- destroy
- 	
- 	self allClasses do: [:ea | ea removeFromSystem].
- 	declarations keys do: [:ea | self unbind: ea].
- 	policies do: [:ea | ea removeObserver: self].
- 	observers do: [:ea | ea stopObserving: self].!

Item was removed:
- ----- Method: Environment>>do: (in category 'emulating') -----
- do: aBlock 
- 	"Evaluate aBlock for each of the receiver's values."
- 
- 	self valuesDo: aBlock!

Item was removed:
- ----- Method: Environment>>environment (in category 'emulating') -----
- environment
- 	^ self!

Item was removed:
- ----- Method: Environment>>errorKeyNotFound: (in category 'private') -----
- errorKeyNotFound: key
- 	"Signal KeyNotFound error"
- 	^(KeyNotFound key: key) signal!

Item was removed:
- ----- Method: Environment>>export: (in category 'configuring') -----
- export: spec
- 	| policy |
- 	policy := BindingPolicy 
- 		environment: self
- 		policy: (ExplicitNamePolicy spec: spec) 
- 		addSelector: #notifyObserversOfBindingAdded:
- 		removeSelector: #notifyObserversOfBindingRemoved:.
- 	policies := policies copyWith: policy!

Item was removed:
- ----- Method: Environment>>exportAddingPrefix: (in category 'configuring') -----
- exportAddingPrefix: aString
- 	| policy |
- 	policy := BindingPolicy 
- 		environment: self
- 		policy: (AddPrefixNamePolicy prefix: aString) 
- 		addSelector: #notifyObserversOfBindingAdded:
- 		removeSelector: #notifyObserversOfBindingRemoved:.
- 	policies := policies copyWith: policy!

Item was removed:
- ----- Method: Environment>>exportRemovingPrefix: (in category 'configuring') -----
- exportRemovingPrefix: aString
- 	| policy |
- 	policy := BindingPolicy 
- 		environment: self
- 		policy: (RemovePrefixNamePolicy prefix: aString)
- 		addSelector: #notifyObserversOfBindingAdded:
- 		removeSelector: #notifyObserversOfBindingRemoved:.
- 	policies := policies copyWith: policy!

Item was removed:
- ----- Method: Environment>>exportSelf (in category 'configuring') -----
- exportSelf
- 	| policy |
- 	policy := BindingPolicy
- 		environment: self 
- 		policy: (AllNamePolicy new)
- 		addSelector: #notifyObserversOfBindingAdded:
- 		removeSelector: #notifyObserversOfBindingRemoved:.
- 	policies := policies copyWith: policy!

Item was removed:
- ----- Method: Environment>>fileIn:announcing: (in category 'operations') -----
- fileIn: aStream announcing: aString
- 	(EnvironmentLoader for: self) 
- 		fileIn: aStream 
- 		announcing: aString
- !

Item was removed:
- ----- Method: Environment>>flushClassNameCache (in category 'classes and traits') -----
- flushClassNameCache
- 	"We don't have one"!

Item was removed:
- ----- Method: Environment>>forgetClass:logged: (in category 'classes and traits') -----
- forgetClass: aClass logged: aBool
- 	(self hasBindingOf: aClass name) ifFalse: [ ^ self ].
- 	aBool ifTrue: 
- 		[SystemChangeNotifier uniqueInstance 
- 			classRemoved: aClass fromCategory: aClass category].
- 	self organization removeElement: aClass name.
- 	Smalltalk removeFromStartUpList: aClass.
- 	Smalltalk removeFromShutDownList: aClass.
- 	self unbind: aClass name!

Item was removed:
- ----- Method: Environment>>from:import: (in category 'configuring') -----
- from: anEnvironment import: spec 
- 	| policy |
- 	policy := BindingPolicy 
- 		environment: anEnvironment
- 		policy: (ExplicitNamePolicy spec: spec)
- 		addSelector: #showBinding:
- 		removeSelector: #hideBinding:.
- 	policies := policies copyWith: policy.
- 	anEnvironment addObserver: self.
- 	anEnvironment addAllBindings.!

Item was removed:
- ----- Method: Environment>>hasBindingOf: (in category 'binding') -----
- hasBindingOf: aSymbol
- 	^ declarations includesKey: aSymbol!

Item was removed:
- ----- Method: Environment>>hasClassNamed: (in category 'classes and traits') -----
- hasClassNamed: aString
- 	Symbol hasInterned: aString ifTrue:
- 		[:symbol | 
- 		^ (declarations at: symbol ifAbsent: [nil])
- 			isKindOf: Class].
- 	^ false.!

Item was removed:
- ----- Method: Environment>>hideBinding: (in category 'binding') -----
- hideBinding: aBinding
- 	(bindings bindingOf: aBinding key) == aBinding ifFalse: [^ self].
- 	self undeclare: aBinding key from: bindings!

Item was removed:
- ----- Method: Environment>>import: (in category 'configuring') -----
- import: anEnvironment
- 	| policy |
- 	policy := BindingPolicy 
- 		environment: anEnvironment 
- 		policy: AllNamePolicy new
- 		addSelector: #showBinding:
- 		removeSelector: #hideBinding:.
- 	policies := policies copyWith: policy.
- 	anEnvironment addObserver: self.
- 	anEnvironment addAllBindings.!

Item was removed:
- ----- Method: Environment>>import:addingPrefix: (in category 'configuring') -----
- import: anEnvironment addingPrefix: aString 
- 	
- 	| import |
- 	import := BindingPolicy
- 		environment: anEnvironment
- 		policy: (AddPrefixNamePolicy prefix: aString)
- 		addSelector: #showBinding:
- 		removeSelector: #hideBinding:.
- 	policies := policies copyWith: import.
- 	anEnvironment addObserver: self.
- 	anEnvironment addAllBindings.!

Item was removed:
- ----- Method: Environment>>import:removingPrefix: (in category 'configuring') -----
- import: anEnvironment removingPrefix: aString 
- 	
- 	| import |
- 	import := BindingPolicy
- 		environment: anEnvironment
- 		policy: (RemovePrefixNamePolicy prefix: aString)
- 		addSelector: #showBinding:
- 		removeSelector: #hideBinding:.
- 	policies := policies copyWith: import.
- 	anEnvironment addObserver: self.
- 	anEnvironment addAllBindings.!

Item was removed:
- ----- Method: Environment>>importSelf (in category 'configuring') -----
- importSelf
- 	| policy |
- 	policy := BindingPolicy
- 		environment: self
- 		policy: AllNamePolicy new
- 		addSelector: #showBinding:
- 		removeSelector: #hideBinding:.
- 	policies := policies copyWith: policy.
- 	
- 	declarations associationsDo:
- 		[:ea | (bindings includesKey: ea key) ifFalse:
- 			[bindings add: ea]]!

Item was removed:
- ----- Method: Environment>>includes: (in category 'emulating') -----
- includes: value
- 	^ declarations includes: value!

Item was removed:
- ----- Method: Environment>>includesKey: (in category 'emulating') -----
- includesKey: key
- 	^ declarations includesKey: key!

Item was removed:
- ----- Method: Environment>>info (in category 'accessing') -----
- info
- 	^ info!

Item was removed:
- ----- Method: Environment>>initialize (in category 'initialize-release') -----
- initialize
- 	declarations := IdentityDictionary new.
- 	bindings := IdentityDictionary new. 
- 	undeclared := WeakIdentityDictionary new.
- 	policies := Array new. 
- 	observers := IdentitySet new.!

Item was removed:
- ----- Method: Environment>>initializeWithName: (in category 'initialize-release') -----
- initializeWithName: aString
- 	| smalltalk |
- 	self initialize.
- 	info := EnvironmentInfo name: aString.
- 	info organization environment: self.
- 	smalltalk := SmalltalkImage basicNew.
- 	smalltalk globals: self.
- 	declarations at: #Smalltalk put: smalltalk.
- 	declarations at: #Undeclared put: undeclared.!

Item was removed:
- ----- Method: Environment>>initializeWithSystemDictionary: (in category 'initialize-release') -----
- initializeWithSystemDictionary: old
- 	
- 	self initialize.
- 	info := EnvironmentInfo 
- 		name: 'Smalltalk'
- 		organization: old organization
- 		packages: PackageOrganizer default.
- 	info organization environment: self.
- 	old associationsDo: [:assc | declarations add: assc].
- 	(old at: #Undeclared) associationsDo: [:assc | undeclared add: assc].
- 	(declarations at: #Smalltalk) instVarNamed: 'globals' put: self.
- 	declarations at: #Undeclared put: undeclared.!

Item was removed:
- ----- Method: Environment>>isUndeclared: (in category 'declaring') -----
- isUndeclared: aSymbol
- 	^ undeclared includesKey: aSymbol!

Item was removed:
- ----- Method: Environment>>keyAtIdentityValue: (in category 'emulating') -----
- keyAtIdentityValue: anObject
- 	^ declarations keyAtIdentityValue: anObject.!

Item was removed:
- ----- Method: Environment>>keyAtIdentityValue:ifAbsent: (in category 'emulating') -----
- keyAtIdentityValue: anObject ifAbsent: aBlock
- 	^ declarations keyAtIdentityValue: anObject ifAbsent: aBlock!

Item was removed:
- ----- Method: Environment>>keyAtValue: (in category 'emulating') -----
- keyAtValue: anObject
- 	^ self keyAtIdentityValue: anObject!

Item was removed:
- ----- Method: Environment>>keys (in category 'emulating') -----
- keys
- 	^ declarations keys!

Item was removed:
- ----- Method: Environment>>keysAndValuesDo: (in category 'emulating') -----
- keysAndValuesDo: aBlock
- 	^self associationsDo: [:assoc |
- 		aBlock value: assoc key value: assoc value].!

Item was removed:
- ----- Method: Environment>>keysDo: (in category 'emulating') -----
- keysDo: aBlock 
- 	"Evaluate aBlock for each of the receiver's keys."
- 
- 	declarations keysDo: aBlock!

Item was removed:
- ----- Method: Environment>>notifyObserversOfBindingAdded: (in category 'updating') -----
- notifyObserversOfBindingAdded: aBinding
- 	observers do: [:ea | ea binding: aBinding addedTo: self]!

Item was removed:
- ----- Method: Environment>>notifyObserversOfBindingRemoved: (in category 'updating') -----
- notifyObserversOfBindingRemoved: aBinding
- 	observers do: [:ea | ea binding: aBinding removedFrom: self]!

Item was removed:
- ----- Method: Environment>>objectForDataStream: (in category 'emulating') -----
- objectForDataStream: refStrm
- 	| dp |
- 	"I am about to be written on an object file.  Write a reference to Smalltalk instead."
- 
- 	dp := DiskProxy global: #Smalltalk selector: #globals args: #().
- 	refStrm replace: self with: dp.
- 	^ dp!

Item was removed:
- ----- Method: Environment>>organization (in category 'accessing') -----
- organization
- 	^ info organization!

Item was removed:
- ----- Method: Environment>>poolUsers (in category 'emulating') -----
- poolUsers
- 	"Answer a dictionary of pool name -> classes that refer to it.
- 	Also includes any globally know dictionaries (such as
- 	Smalltalk, Undeclared etc) which although not strictly
- 	accurate is potentially useful information"
- 	"Smalltalk poolUsers"
- 	| poolUsers |
- 	poolUsers := Dictionary new.
- 	self keys
- 		do: [:k | "yes, using isKindOf: is tacky but for reflective code like
- 			this it is very useful. If you really object you can:-
- 			a) go boil your head.
- 			b) provide a better answer.
- 			your choice."
- 			| pool refs |
- 			(((pool := self at: k) isKindOf: Dictionary)
- 					or: [pool isKindOf: SharedPool class])
- 				ifTrue: [refs := (self systemNavigation allClasses
- 								select: [:c | c sharedPools identityIncludes: pool]
- 								thenCollect: [:c | c name]) asOrderedCollection.
- 					refs
- 						add: (self systemNavigation
- 								allCallsOn: (self associationAt: k)).
- 					poolUsers at: k put: refs]].
- 	^ poolUsers!

Item was removed:
- ----- Method: Environment>>printOn: (in category 'printing') -----
- printOn: aStream
- 	aStream nextPutAll: info name!

Item was removed:
- ----- Method: Environment>>purgeUndeclared (in category 'declaring') -----
- purgeUndeclared
- 	undeclared removeUnreferencedKeys!

Item was removed:
- ----- Method: Environment>>recompileAll (in category 'operations') -----
- recompileAll	
- 	self allClassesAndTraits 
- 		do: [:classOrTrait | classOrTrait compileAll] 
- 		displayingProgress:[:classOrTrait| 'Recompiling ', classOrTrait]
- 
- 
- !

Item was removed:
- ----- Method: Environment>>remove:from:readdAfter: (in category 'private') -----
- remove: binding from: aDictionary readdAfter: aBlock
- 
- 	aDictionary
- 		removeKey: binding key
- 		ifAbsent: [ ^aBlock value ].
- 	^aBlock ensure: [ aDictionary add: binding ]!

Item was removed:
- ----- Method: Environment>>removeClassNamed: (in category 'classes and traits') -----
- removeClassNamed: aString
- 	declarations 
- 		at: aString asSymbol 
- 		ifPresent: [:class | class removeFromSystem]
- 		ifAbsent: 
- 			[Transcript cr; show: 'Removal of class named ', aString, 
- 			' ignored because ', aString, ' does not exist.']!

Item was removed:
- ----- Method: Environment>>removeKey: (in category 'emulating') -----
- removeKey: key 
- 	"Remove key from the receiver.
- 	If key is not in the receiver, notify an error."
- 	self flag: #review.
- 	^ self removeKey: key ifAbsent: [self errorKeyNotFound: key].!

Item was removed:
- ----- Method: Environment>>removeKey:ifAbsent: (in category 'emulating') -----
- removeKey: aSymbol ifAbsent: aBlock
- 	| binding oldValue |
- 	self flag: #review.
- 
- 	(declarations includesKey: aSymbol) ifFalse: [^aBlock value].
- 	binding := (declarations associationAt: aSymbol).
- 	oldValue := binding value. "Store the old value before the binding might be destroyed by a binding policy via #binding:removeFrom:"
- 	declarations removeKey: aSymbol.
- 	self
- 		binding: binding
- 		removedFrom: self.
- 	^ oldValue!

Item was removed:
- ----- Method: Environment>>removeObserver: (in category 'observing') -----
- removeObserver: anObject
- 	observers remove: anObject ifAbsent: []!

Item was removed:
- ----- Method: Environment>>renameClass:as: (in category 'classes and traits') -----
- renameClass: aClass as: newName 
- 	^self renameClass: aClass from: aClass name to: newName!

Item was removed:
- ----- Method: Environment>>renameClass:from: (in category 'classes and traits') -----
- renameClass: aClass from: oldName
- 	^self renameClass: aClass from: oldName to: aClass name!

Item was removed:
- ----- Method: Environment>>renameClass:from:to: (in category 'classes and traits') -----
- renameClass: aClass from: oldName to: newName
- 	"Rename the class, aClass, to have the title newName."
- 
- 	| oldBinding newBinding category |
- 	category := self organization categoryOfElement: oldName.
- 	self organization classify: newName under: category suppressIfDefault: true.
- 	self organization removeElement: oldName.
- 	
- 	oldBinding := self declarationOf: oldName.
- 	declarations removeKey: oldName.
- 	self binding: oldBinding removedFrom: self.
- 	" re-route now undeclared oldBinding "
- 	oldBinding value: aClass.
- 
- 	newBinding := newName => aClass.
- 	aClass updateMethodBindingsTo: newBinding.
- 	declarations add: newBinding. 
- 	self binding: newBinding addedTo: self.
- 	
- 	Smalltalk renamedClass: aClass from: oldName to: newName.
- 	SystemChangeNotifier uniqueInstance 
- 		classRenamed: aClass 
- 		from: oldName 
- 		to: newName 
- 		inCategory: category!

Item was removed:
- ----- Method: Environment>>renameClassNamed:as: (in category 'classes and traits') -----
- renameClassNamed: oldName as: newName
- 	declarations
- 		at: oldName
- 		ifPresent: [:class | class rename: newName]
- 		ifAbsent:
- 			[Transcript cr; show: 'Class-rename for ', oldName, 
- 			' ignored because ', oldName, ' does not exist.']!

Item was removed:
- ----- Method: Environment>>rootClasses (in category 'accessing') -----
- rootClasses
- 	"return a collection of classes which have a nil superclass"
- 	^ (self select: [:each | each isBehavior and: [each superclass isNil]]) asOrderedCollection.!

Item was removed:
- ----- Method: Environment>>scopeFor:from:envtAndPathIfFound: (in category 'emulating') -----
- scopeFor: aSymbol from: lower envtAndPathIfFound: aBlock
- 	^ (declarations includesKey: aSymbol)
- 		ifTrue: [aBlock value: self value: String new]
- 		!

Item was removed:
- ----- Method: Environment>>select: (in category 'emulating') -----
- select: aBlock
- 	^ declarations select: aBlock!

Item was removed:
- ----- Method: Environment>>showBinding: (in category 'binding') -----
- showBinding: aBinding
- 	| binding |
- 	binding := undeclared associationAt: aBinding key ifAbsent: [nil].
- 	binding ifNotNil:
- 		[undeclared removeKey: binding key.
- 		binding becomeForward: aBinding].
- 	
- 	binding := bindings associationAt: aBinding key ifAbsent: [nil].
- 	binding ifNotNil:
- 		[binding == aBinding ifTrue: [^self].
- 		bindings removeKey: binding key].
- 	
- 	bindings add: aBinding.!

Item was removed:
- ----- Method: Environment>>stopObserving: (in category 'observing') -----
- stopObserving: anEnvironment
- 	policies := policies reject: [:ea | ea environment == anEnvironment].!

Item was removed:
- ----- Method: Environment>>storeDataOn: (in category 'emulating') -----
- storeDataOn: aDataStream
- 	"I don't get stored.  Use a DiskProxy"
- 
- 	self error: 'use a DiskProxy to store me'!

Item was removed:
- ----- Method: Environment>>traitNames (in category 'classes and traits') -----
- traitNames
- 	^ self allTraits collect: [:ea | ea name]!

Item was removed:
- ----- Method: Environment>>unbind: (in category 'binding') -----
- unbind: aSymbol
- 	| binding |
- 	binding := declarations bindingOf: aSymbol ifAbsent: [^ self].
- 	undeclared declare: aSymbol from: declarations.
- 	declarations removeKey: aSymbol ifAbsent: [  ].
- 	[ undeclared at: aSymbol put: nil ]
- 		on: AttemptToWriteReadOnlyGlobal
- 		do: [ :n | n resume: true ].
- 	self binding: binding removedFrom: self!

Item was removed:
- ----- Method: Environment>>undeclare: (in category 'declaring') -----
- undeclare: aSymbol
- 	^ (undeclared bindingOf: aSymbol) ifNil:
- 		[undeclared add: aSymbol => nil]!

Item was removed:
- ----- Method: Environment>>undeclare:from: (in category 'declaring') -----
- undeclare: aSymbol from: aNamespace
- 	| binding |
- 	binding := self undeclare: aSymbol.
- 	(aNamespace bindingOf: aSymbol) ifNotNil:
- 		[:old |
- 		aNamespace removeKey: aSymbol.
- 		old becomeForward: binding].
- 	^ binding!

Item was removed:
- ----- Method: Environment>>undeclared (in category 'accessing') -----
- undeclared
- 	^ undeclared!

Item was removed:
- ----- Method: Environment>>valueOf: (in category 'binding') -----
- valueOf: aSymbol
- 	^ self valueOf: aSymbol ifAbsent: nil!

Item was removed:
- ----- Method: Environment>>valueOf:ifAbsent: (in category 'binding') -----
- valueOf: aSymbol ifAbsent: aBlock
- 	^ (self bindingOf: aSymbol ifAbsent: [^ aBlock value]) value!

Item was removed:
- ----- Method: Environment>>valuesDo: (in category 'emulating') -----
- valuesDo: aBlock 
- 	"Evaluate aBlock for each of the receiver's values."
- 
- 	declarations valuesDo: aBlock!

Item was removed:
- ----- Method: Environment>>veryDeepCopyWith: (in category 'emulating') -----
- veryDeepCopyWith: aCopier
- 	^ self!

Item was removed:
- Object subclass: #EnvironmentInfo
- 	instanceVariableNames: 'name organization packages'
- 	classVariableNames: ''
- 	poolDictionaries: ''
- 	category: 'Environments-Core'!

Item was removed:
- ----- Method: EnvironmentInfo class>>name: (in category 'create') -----
- name: aString
- 	^ self 
- 		name: aString
- 		organization: (SystemOrganizer defaultList: Array new)
- 		packages: PackageOrganizer new.
- 	!

Item was removed:
- ----- Method: EnvironmentInfo class>>name:organization:packages: (in category 'create') -----
- name: aString organization: aSystemOrganizer packages: aPackageOrganizer
- 	^ self basicNew 
- 		initializeWithName: aString 
- 		organization: aSystemOrganizer
- 		packages: aPackageOrganizer!

Item was removed:
- ----- Method: EnvironmentInfo>>initializeWithName:organization:packages: (in category 'initializing') -----
- initializeWithName: aString organization: aSystemOrganizer packages: aPackageOrganizer
- 	self initialize.
- 	name := aString asSymbol.
- 	organization := aSystemOrganizer.
- 	packages := aPackageOrganizer.!

Item was removed:
- ----- Method: EnvironmentInfo>>name (in category 'access') -----
- name
- 	^ name!

Item was removed:
- ----- Method: EnvironmentInfo>>organization (in category 'access') -----
- organization
- 	^ organization!

Item was removed:
- ----- Method: EnvironmentInfo>>packages (in category 'access') -----
- packages
- 	^ packages!

Item was removed:
- ----- Method: EnvironmentInfo>>printOn: (in category 'printing') -----
- printOn: aStream
- 	aStream nextPutAll: name.
- 	aStream nextPutAll: 'Info'!

Item was removed:
- Object subclass: #EnvironmentLoader
- 	instanceVariableNames: 'environment'
- 	classVariableNames: ''
- 	poolDictionaries: ''
- 	category: 'Environments-Loading'!

Item was removed:
- ----- Method: EnvironmentLoader class>>for: (in category 'as yet unclassified') -----
- for: anEnvironment
- 	^ self basicNew initializeWithEnvironment: anEnvironment!

Item was removed:
- ----- Method: EnvironmentLoader>>evaluate: (in category 'private') -----
- evaluate: chunk
- 	^ [Compiler evaluate: chunk environment: environment]
- 		on: CurrentEnvironment
- 		do: [:req | req resume: environment]!

Item was removed:
- ----- Method: EnvironmentLoader>>evaluate:logged: (in category 'private') -----
- evaluate: chunk logged: aBoolean
- 	^ [Compiler evaluate: chunk environment: environment logged: aBoolean]
- 		on: CurrentEnvironment
- 		do: [:req | req resume: environment]!

Item was removed:
- ----- Method: EnvironmentLoader>>fileIn:announcing: (in category 'fileIn/out') -----
- fileIn: aStream announcing: aString
- 	| val |
- 	self logStart: aStream name.
- 	aString displayProgressFrom: 0 to: aStream size during: 
- 		[:bar | 
- 		[aStream atEnd] whileFalse:
- 			[bar value: aStream position.
- 			aStream skipSeparators.
- 			[val := self fileInChunkFrom: aStream]
- 				on: InMidstOfFileinNotification
- 				do: [:ex | ex resume: true].
- 			aStream skipStyleChunk].
- 		aStream close].	
- 	self logEnd: aStream name.
- 	^ val!

Item was removed:
- ----- Method: EnvironmentLoader>>fileInChunkFrom: (in category 'fileIn/out') -----
- fileInChunkFrom: aStream
- 	| chunk |
- 	^ (aStream peekFor: $!!)
- 		ifTrue: [ 
- 			| reader |
- 			chunk := aStream nextChunk.
- 			reader := self evaluate: chunk logged: false.
- 			reader scanFrom: aStream environment: environment]
- 		ifFalse: [ 
- 			chunk := aStream nextChunk.
- 			aStream checkForPreamble: chunk.
- 			self evaluate: chunk logged: true ]!

Item was removed:
- ----- Method: EnvironmentLoader>>initializeWithEnvironment: (in category 'initialize-release') -----
- initializeWithEnvironment: anEnvironment
- 	self initialize.
- 	environment := anEnvironment!

Item was removed:
- ----- Method: EnvironmentLoader>>logEnd: (in category 'private') -----
- logEnd: filename
- 	"Note:  The main purpose of this banner is to flush the changes file."
- 	Smalltalk logChange: '----End fileIn of ' , filename , ' into ', environment name, '----'	!

Item was removed:
- ----- Method: EnvironmentLoader>>logStart: (in category 'private') -----
- logStart: filename
- 	Smalltalk logChange: '----Start fileIn of ' , filename , ' into ' , environment name , '----'!

Item was removed:
- Notification subclass: #EnvironmentRequest
- 	instanceVariableNames: ''
- 	classVariableNames: ''
- 	poolDictionaries: ''
- 	category: 'Environments-Notifications'!
- 
- !EnvironmentRequest commentStamp: 'jr 1/15/2017 00:34' prior: 0!
- I represent a request for an Environment that is not necessarily the CurrentEnvironment, but any Environment available in the system.
- 
- Instance Variables
- !

Item was removed:
- ----- Method: EnvironmentRequest>>defaultAction (in category 'exceptionDescription') -----
- defaultAction
- 	| all environment |
- 	all := Environment allInstances.
- 	environment := UIManager default
- 		chooseFrom: (all collect: [:ea | ea printString])
- 		values: all.
- 	^ environment!

Item was removed:
- EnvironmentsHelp subclass: #EnvironmentsAPIDocumentation
- 	instanceVariableNames: ''
- 	classVariableNames: ''
- 	poolDictionaries: ''
- 	category: 'Environments-Help'!

Item was removed:
- ----- Method: EnvironmentsAPIDocumentation class>>asHelpTopic (in category 'converting') -----
- asHelpTopic
- 
- 	^ (HelpTopic named: self bookName)
- 		subtopics: (self packages collect: [:pkgName | PackageAPIHelpTopic new packageName: pkgName]);
- 		yourself!

Item was removed:
- ----- Method: EnvironmentsAPIDocumentation class>>bookName (in category 'accessing') -----
- bookName
- 	^'Reference'!

Item was removed:
- ----- Method: EnvironmentsAPIDocumentation class>>packages (in category 'private') -----
- packages
- 	^#('Environments-Core' 'Environments-Loading' 'Environments-Policies')!

Item was removed:
- CustomHelp subclass: #EnvironmentsHelp
- 	instanceVariableNames: ''
- 	classVariableNames: ''
- 	poolDictionaries: ''
- 	category: 'Environments-Help'!

Item was removed:
- ----- Method: EnvironmentsHelp class>>bookName (in category 'accessing') -----
- bookName
- 
- 	^ 'Environments'!

Item was removed:
- ----- Method: EnvironmentsHelp class>>introduction (in category 'pages') -----
- introduction
- 	"This method was automatically generated. Edit it using:"
- 	"EnvironmentsHelp edit: #introduction"
- 	^(HelpTopic
- 		title: 'Introduction'
- 		contents: 
- 'An Environment is an object that implements a policy for binding names to objects during compilation.
- 
- The simplest and most common use for environments is to allow two classes with the same name to peacefully co-exist.
- 
- See:
- http://wiki.squeak.org/squeak/6218
- http://wiki.squeak.org/squeak/6219
- http://wiki.squeak.org/squeak/6220!!' readStream nextChunkText)
- 			key: #introduction!

Item was removed:
- ----- Method: EnvironmentsHelp class>>pages (in category 'accessing') -----
- pages
- 
- 	^ #(introduction)!

Item was removed:
- NamePolicy subclass: #ExplicitNamePolicy
- 	instanceVariableNames: 'aliases'
- 	classVariableNames: ''
- 	poolDictionaries: ''
- 	category: 'Environments-Policies'!

Item was removed:
- ----- Method: ExplicitNamePolicy class>>aliases: (in category 'instance creation') -----
- aliases: aCollection
- 	^ self basicNew initializeWithAliases: aCollection!

Item was removed:
- ----- Method: ExplicitNamePolicy class>>flattenSpec:into: (in category 'private') -----
- flattenSpec: anObject into: names
- 	anObject isSymbol ifTrue:
- 		[^ names at: anObject put: anObject].
- 	anObject isVariableBinding ifTrue:
- 		[^ names add: anObject].
- 	anObject isDictionary ifTrue:
- 		[^ names addAll: anObject].
- 	anObject do:
- 		[:ea | self flattenSpec: ea into: names]!

Item was removed:
- ----- Method: ExplicitNamePolicy class>>spec: (in category 'instance creation') -----
- spec: anObject
- 	| aliases |
- 	(anObject isKindOf: NamePolicy) ifTrue: [^ anObject].
- 	aliases := IdentityDictionary new.
- 	self flattenSpec: anObject into: aliases.
- 	^ self aliases: aliases!

Item was removed:
- ----- Method: ExplicitNamePolicy>>initializeWithAliases: (in category 'initialize-release') -----
- initializeWithAliases: aCollection
- 	self initialize.
- 	aliases := IdentityDictionary withAll: aCollection!

Item was removed:
- ----- Method: ExplicitNamePolicy>>name:do: (in category 'naming') -----
- name: aSymbol do: aBlock
- 	^ aBlock value: (aliases at: aSymbol ifAbsent: [^ nil])!

Item was removed:
- Binding subclass: #Global
- 	instanceVariableNames: 'value'
- 	classVariableNames: ''
- 	poolDictionaries: ''
- 	category: 'Environments-Core'!

Item was removed:
- ----- Method: Global class>>key:value: (in category 'instance creation') -----
- key: aSymbol value: anObject
- 	^ self basicNew initializeWithKey: aSymbol value: anObject!

Item was removed:
- ----- Method: Global>>asBinding: (in category 'converting') -----
- asBinding: aSymbol
- 	^ aSymbol == key
- 		ifTrue: [self]
- 		ifFalse: [Alias key: aSymbol source: self]!

Item was removed:
- ----- Method: Global>>initializeWithKey:value: (in category 'initialize-release') -----
- initializeWithKey: aSymbol value: anObject
- 	self initialize.
- 	key := aSymbol.
- 	value := anObject!

Item was removed:
- ----- Method: Global>>value (in category 'evaluating') -----
- value
- 	^ value!

Item was removed:
- ----- Method: Global>>value: (in category 'accessing') -----
- value: anObject
- 	value := anObject!

Item was removed:
- Object subclass: #NamePolicy
- 	instanceVariableNames: ''
- 	classVariableNames: ''
- 	poolDictionaries: ''
- 	category: 'Environments-Policies'!

Item was removed:
- ----- Method: NamePolicy>>name:do: (in category 'naming') -----
- name: aSymbol do: aBlock
- 	self subclassResponsibility!

Item was removed:
- ----- Method: ReadOnlyVariableBinding>>asBinding: (in category '*environments') -----
- asBinding: aSymbol
- 	^ ClassBinding key: aSymbol value: value!

Item was removed:
- NamePolicy subclass: #RemovePrefixNamePolicy
- 	instanceVariableNames: 'prefix'
- 	classVariableNames: ''
- 	poolDictionaries: ''
- 	category: 'Environments-Policies'!

Item was removed:
- ----- Method: RemovePrefixNamePolicy class>>prefix: (in category 'instance creation') -----
- prefix: aString
- 	^ self basicNew initializeWithPrefix: aString!

Item was removed:
- ----- Method: RemovePrefixNamePolicy>>initializeWithPrefix: (in category 'initialize-release') -----
- initializeWithPrefix: aString
- 	self initialize.
- 	prefix := aString!

Item was removed:
- ----- Method: RemovePrefixNamePolicy>>name:do: (in category 'naming') -----
- name: aSymbol do: aBlock
- 	^ (aSymbol beginsWith: prefix) 
- 		ifTrue: [aBlock value: (aSymbol allButFirst: prefix size) asSymbol]!

Item was removed:
- ----- Method: Symbol>>=> (in category '*environments') -----
- => anObject
- 	
- 	^ anObject isBehavior
- 		ifTrue: [ClassBinding key: self value: anObject]
- 		ifFalse: [Global key: self value: anObject]!



More information about the Squeak-dev mailing list