[squeak-dev] The Inbox: Environments-tonyg.78.mcz

commits at source.squeak.org commits at source.squeak.org
Thu Mar 25 12:41:26 UTC 2021


Tony Garnock-Jones uploaded a new version of Environments to project The Inbox:
http://source.squeak.org/inbox/Environments-tonyg.78.mcz

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

Name: Environments-tonyg.78
Author: tonyg
Time: 25 March 2021, 1:41:26.338334 pm
UUID: 1f57f26d-c9da-4c95-adb3-3fd76774a64d
Ancestors: Environments-dtl.77

EXPERIMENTAL. Nested `Namespace`s, by introducing subclass Namespace of Environment, and placing Namespace instances as "globals" in their parent environment. See also Tools-tonyg.1033, which includes an experimental EnvironmentBrowser class.

=============== Diff against Environments-dtl.77 ===============

Item was changed:
+ SystemOrganization addCategory: #'Environments-Help'!
  SystemOrganization addCategory: #'Environments-Core'!
  SystemOrganization addCategory: #'Environments-Loading'!
- SystemOrganization addCategory: #'Environments-Policies'!
- SystemOrganization addCategory: #'Environments-Help'!
  SystemOrganization addCategory: #'Environments-Notifications'!
+ SystemOrganization addCategory: #'Environments-Policies'!
+ SystemOrganization addCategory: #'Environments-Namespaces'!

Item was added:
+ ----- Method: Environment class>>wellKnownInstances (in category 'as yet unclassified') -----
+ wellKnownInstances
+ 	^ Instances values sorted: [:a :b |
+ 		(a info name = #Smalltalk)
+ 			ifTrue: [true] ifFalse: [
+ 		(b info name = #Smalltalk)
+ 			ifTrue: [false] ifFalse: [
+ 		a info name <= b info name]]]!

Item was added:
+ ----- Method: Environment>>isNamespace (in category 'testing') -----
+ isNamespace
+ 	^ false!

Item was added:
+ ----- Method: Environment>>namespacePath (in category 'accessing') -----
+ namespacePath
+ 	^ Array with: self!

Item was added:
+ ----- Method: Environment>>namespaceTreeDo: (in category 'accessing') -----
+ namespaceTreeDo: aBlock
+ 	aBlock value: self.
+ 	self namespaces do: [:ns | ns namespaceTreeDo: aBlock].!

Item was added:
+ ----- Method: Environment>>namespaces (in category 'accessing') -----
+ namespaces
+ 	"Answer all Environments declared here whose parent is this Environment"
+ 	| nss |
+ 	nss := self select: [:item |
+ 		(item value isKindOf: Environment) and: [item value parent == self]].
+ 	nss := nss asArray collect: [:item | item value].
+ 	nss sort: [:a :b | (a name compare: b name) <= 2].
+ 	^ nss!

Item was added:
+ ----- Method: Environment>>parent (in category 'accessing') -----
+ parent
+ 	^ nil!

Item was added:
+ ----- Method: Environment>>rename: (in category 'accessing') -----
+ rename: newName
+ 	| wellKnown |
+ 	newName = info name ifTrue: [^ self].
+ 	(wellKnown := Instances includes: self) ifTrue: [
+ 		(Instances anySatisfy: [:e | newName = e info name])
+ 			ifTrue: [self error: 'Name collision: well-known Environment with name ', newName, ' already exists']].
+ 	wellKnown ifTrue: [Instances removeKey: info name].
+ 	info rename: newName.
+ 	wellKnown ifTrue: [Instances at: newName put: self].!

Item was added:
+ ----- Method: EnvironmentInfo>>rename: (in category 'private') -----
+ rename: newName
+ 	name := newName!

Item was added:
+ Environment subclass: #Namespace
+ 	instanceVariableNames: 'parent'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Environments-Namespaces'!

Item was added:
+ ----- Method: Namespace>>checkName:in: (in category 'namespace hierarchy') -----
+ checkName: name in: parent
+ 	(parent notNil and: [(parent at: name ifAbsent: [self]) ~~ self])
+ 		ifTrue: [self error: 'Name collision: proposed name ', name, ' in ', parent name, ' for namespace ', self name, ' is already taken'].!

Item was added:
+ ----- Method: Namespace>>doesNotUnderstand: (in category 'dynamic lookup') -----
+ doesNotUnderstand: aMessage
+ 	aMessage numArgs = 0 ifFalse: [^ super doesNotUnderstand: aMessage].
+ 	^ self valueOf: aMessage selector ifAbsent: [^ super doesNotUnderstand: aMessage]!

Item was added:
+ ----- Method: Namespace>>initialize (in category 'initialize-release') -----
+ initialize
+ 	super initialize.
+ 	self importSelf.
+ 	self import: Environment default.!

Item was added:
+ ----- Method: Namespace>>isNamespace (in category 'as yet unclassified') -----
+ isNamespace
+ 	^ true!

Item was added:
+ ----- Method: Namespace>>namespacePath (in category 'namespace hierarchy') -----
+ namespacePath
+ 	| e |
+ 	e := self.
+ 	^ (Array streamContents: [:w |
+ 		[e notNil and: [e isNamespace]] whileTrue: [
+ 			w nextPut: e.
+ 			e := e parent]]) reverseInPlace!

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

Item was added:
+ ----- Method: Namespace>>parent: (in category 'accessing') -----
+ parent: anEnvironment
+ 	| n |
+ 	parent == anEnvironment ifTrue: [^self].
+ 	n := info name asSymbol.
+ 	self checkName: n in: anEnvironment.
+ 	parent ifNotNil: [parent removeKey: n].
+ 	parent := anEnvironment.
+ 	parent ifNotNil: [parent at: n put: self].!

Item was added:
+ ----- Method: Namespace>>printOn: (in category 'printing') -----
+ printOn: aStream
+ 	self namespacePath do: [:n | aStream nextPutAll: n info name] separatedBy: [aStream space]!

Item was added:
+ ----- Method: Namespace>>rename: (in category 'accessing') -----
+ rename: newName
+ 	| p |
+ 	p := parent.
+ 	self checkName: newName in: p.
+ 	self parent: nil.
+ 	super rename: newName.
+ 	self parent: p.!

Item was added:
+ ----- Method: Namespace>>respondsTo: (in category 'dynamic lookup') -----
+ respondsTo: aSymbol
+ 	^ (super respondsTo: aSymbol) or: [self includesKey: aSymbol]!



More information about the Squeak-dev mailing list