Squeak 4.5: Environments-cmm.51.mcz

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