[squeak-dev] Squeak 4.5: Environments-cmm.51.mcz

commits at source.squeak.org commits at source.squeak.org
Tue May 6 17:50:25 UTC 2014


Chris Muller uploaded a new version of Environments to project Squeak 4.5:
http://source.squeak.org/squeak45/Environments-cmm.51.mcz

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

Name: Environments-cmm.51
Author: cmm
Time: 2 May 2014, 2:56:46.177 pm
UUID: d6b12525-7eb7-4978-9368-fb484f30043b
Ancestors: Environments-cwp.50

- Environment preamble, repair your 'Instances' dictionary, make Environments consistently named with Symbols.
- EnvironmentInfo, ensure incoming Strings for your name are coerced to Symbols.

=============== Diff against Environments-ul.46 ===============

Item was added:
+ (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 changed:
  Object subclass: #BindingPolicy
+ 	instanceVariableNames: 'policy environment addSelector removeSelector'
- 	instanceVariableNames: 'namespace policy next environment addSelector removeSelector'
  	classVariableNames: ''
  	poolDictionaries: ''
  	category: 'Environments-Policies'!

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

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

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

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

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

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

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

Item was changed:
  ----- 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].!
- 	self allClasses do: [:ea | ea removeFromSystem]!

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

Item was changed:
  ----- Method: Environment>>forgetClass:logged: (in category 'classes and traits') -----
  forgetClass: aClass logged: aBool
+ 	(self hasBindingOf: aClass name) ifFalse: [ ^ self ].
- 	| binding |
- 	self flag: #review.
- 	"The class might not bound to its name"
- 	
  	aBool ifTrue: 
  		[SystemChangeNotifier uniqueInstance 
  			classRemoved: aClass fromCategory: aClass category].
+ 	self organization removeElement: aClass name.
+ 	Smalltalk removeFromStartUpList: aClass.
+ 	Smalltalk removeFromShutDownList: aClass.
+ 	self unbind: aClass name!
- 		
- 	binding := declarations bindingOf: aClass name.
- 	binding ifNotNil:
- 		[self organization removeElement: aClass name.
- 		Smalltalk removeFromStartUpList: aClass.
- 		Smalltalk removeFromShutDownList: aClass.
- 	
- 		undeclared declare: aClass name from: declarations.
- 		declarations removeKey: aClass name ifAbsent: [].
- 		[undeclared at: aClass name put: nil]
- 			on: AttemptToWriteReadOnlyGlobal
- 			do: [:n | n resume: true].
- 		self binding: binding removedFrom: self]
- !

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

Item was changed:
  ----- Method: Environment>>hideBinding: (in category 'binding') -----
  hideBinding: aBinding
+ 	self undeclare: aBinding key from: bindings!
- 	bindings removeKey: aBinding key!

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

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

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

Item was changed:
  ----- 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."
  
  	| binding category |
  	category := self organization categoryOfElement: oldName.
  	self organization classify: newName under: category suppressIfDefault: true.
  	self organization removeElement: oldName.
  	
+ 	binding := self declarationOf: oldName.
- 	binding := self associationAt: oldName.
  	declarations removeKey: oldName.
  	self binding: binding removedFrom: self.
  	
+ 	binding := newName => aClass.
- 	binding key: newName.
  	declarations add: binding. 
  	self binding: binding addedTo: self.
  	
  	Smalltalk renamedClass: aClass from: oldName to: newName.
  	SystemChangeNotifier uniqueInstance 
  		classRenamed: aClass 
  		from: oldName 
  		to: newName 
  		inCategory: category!

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

Item was added:
+ ----- 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 changed:
+ ----- Method: Environment>>undeclare: (in category 'declaring') -----
- ----- Method: Environment>>undeclare: (in category 'undeclared') -----
  undeclare: aSymbol
  	^ (undeclared bindingOf: aSymbol) ifNil:
  		[undeclared add: aSymbol => nil]!

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

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

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

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

Item was changed:
  ----- Method: EnvironmentLoader>>evaluate: (in category 'as yet unclassified') -----
  evaluate: chunk
  	^ [Compiler evaluate: chunk environment: environment]
+ 		on: CurrentEnvironment
- 		on: EnvironmentRequest
  		do: [:req | req resume: environment]!

Item was changed:
  ----- Method: EnvironmentLoader>>evaluate:logged: (in category 'as yet unclassified') -----
  evaluate: chunk logged: aBoolean
  	^ [Compiler evaluate: chunk environment: environment logged: aBoolean]
+ 		on: CurrentEnvironment
- 		on: EnvironmentRequest
  		do: [:req | req resume: environment]!

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



More information about the Squeak-dev mailing list