[squeak-dev] The Trunk: Environments-pre.73.mcz

commits at source.squeak.org commits at source.squeak.org
Mon Dec 10 19:22:13 UTC 2018


Patrick Rein uploaded a new version of Environments to project The Trunk:
http://source.squeak.org/trunk/Environments-pre.73.mcz

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

Name: Environments-pre.73
Author: pre
Time: 10 December 2018, 8:22:12.052104 pm
UUID: 6aba9a17-992b-45d5-b0a6-c646e3cdb7ff
Ancestors: Environments-dtl.72

Recategorizes uncategorized messages in the Environments package.

=============== Diff against Environments-dtl.72 ===============

Item was changed:
+ ----- Method: AddPrefixNamePolicy class>>prefix: (in category 'instance creation') -----
- ----- Method: AddPrefixNamePolicy class>>prefix: (in category 'as yet unclassified') -----
  prefix: aString
  	^ self basicNew initializeWithPrefix: aString!

Item was changed:
+ ----- Method: AddPrefixNamePolicy>>initializeWithPrefix: (in category 'initialize-release') -----
- ----- Method: AddPrefixNamePolicy>>initializeWithPrefix: (in category 'as yet unclassified') -----
  initializeWithPrefix: aString
  	self initialize.
  	prefix := aString!

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

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

Item was changed:
+ ----- Method: AllNamePolicy>>name:do: (in category 'naming') -----
- ----- Method: AllNamePolicy>>name:do: (in category 'as yet unclassified') -----
  name: aSymbol do: aBlock
  	^ aBlock value: aSymbol!

Item was changed:
+ ----- Method: Binding class>>convertInstances (in category 'system management') -----
- ----- Method: Binding class>>convertInstances (in category 'as yet unclassified') -----
  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 changed:
+ ----- Method: Binding>>analogousCodeTo: (in category 'comparing') -----
- ----- Method: Binding>>analogousCodeTo: (in category 'as yet unclassified') -----
  analogousCodeTo: anObject
  	"For MethodProperties comparison."
  	^anObject isVariableBinding
  	  and: [self key = anObject key
  	  and: [self value = anObject value]]!

Item was changed:
+ ----- Method: Binding>>canAssign (in category 'accessing') -----
- ----- Method: Binding>>canAssign (in category 'as yet unclassified') -----
  canAssign
  	^ true!

Item was changed:
+ ----- Method: Binding>>isSpecialReadBinding (in category 'testing') -----
- ----- Method: Binding>>isSpecialReadBinding (in category 'as yet unclassified') -----
  isSpecialReadBinding
  	^ false!

Item was changed:
+ ----- Method: Binding>>isSpecialWriteBinding (in category 'testing') -----
- ----- Method: Binding>>isSpecialWriteBinding (in category 'as yet unclassified') -----
  isSpecialWriteBinding
  	^ false!

Item was changed:
+ ----- Method: Binding>>objectForDataStream: (in category 'objects from disk') -----
- ----- Method: Binding>>objectForDataStream: (in category 'as yet unclassified') -----
  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 changed:
+ ----- Method: Binding>>printOn: (in category 'printing') -----
- ----- Method: Binding>>printOn: (in category 'as yet unclassified') -----
  printOn: aStream
  	key printOn: aStream.
  	aStream nextPutAll: '=>'.
  	self value printOn: aStream!

Item was changed:
+ ----- Method: Binding>>source (in category 'accessing') -----
- ----- Method: Binding>>source (in category 'as yet unclassified') -----
  source
  	^ self!

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

Item was changed:
+ ----- Method: ClassBinding class>>key:value: (in category 'instance creation') -----
- ----- Method: ClassBinding class>>key:value: (in category 'as yet unclassified') -----
  key: key value: value
  	^ self basicNew initializeWithKey: key value: value!

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

Item was changed:
+ ----- Method: ClassBinding>>canAssign (in category 'accessing') -----
- ----- Method: ClassBinding>>canAssign (in category 'as yet unclassified') -----
  canAssign
  	^ false!

Item was changed:
+ ----- Method: ClassBinding>>initializeWithKey:value: (in category 'initialize-release') -----
- ----- Method: ClassBinding>>initializeWithKey:value: (in category 'as yet unclassified') -----
  initializeWithKey: kObject value: vObject
  	self initialize.
  	key := kObject.
  	value := vObject.!

Item was changed:
+ ----- Method: ClassBinding>>isSpecialWriteBinding (in category 'testing') -----
- ----- Method: ClassBinding>>isSpecialWriteBinding (in category 'as yet unclassified') -----
  isSpecialWriteBinding
  	^ true!

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

Item was changed:
+ ----- Method: ClassBinding>>value (in category 'evaluating') -----
- ----- Method: ClassBinding>>value (in category 'as yet unclassified') -----
  value
  	^ value!

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

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

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

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

Item was changed:
+ ----- Method: EnvironmentLoader>>fileIn:announcing: (in category 'fileIn/out') -----
- ----- Method: EnvironmentLoader>>fileIn:announcing: (in category 'as yet unclassified') -----
  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 changed:
+ ----- Method: EnvironmentLoader>>fileInChunkFrom: (in category 'fileIn/out') -----
- ----- Method: EnvironmentLoader>>fileInChunkFrom: (in category 'as yet unclassified') -----
  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 changed:
+ ----- Method: EnvironmentLoader>>initializeWithEnvironment: (in category 'initialize-release') -----
- ----- Method: EnvironmentLoader>>initializeWithEnvironment: (in category 'as yet unclassified') -----
  initializeWithEnvironment: anEnvironment
  	self initialize.
  	environment := anEnvironment!

Item was changed:
+ ----- Method: EnvironmentLoader>>logEnd: (in category 'private') -----
- ----- Method: EnvironmentLoader>>logEnd: (in category 'as yet unclassified') -----
  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 changed:
+ ----- Method: EnvironmentLoader>>logStart: (in category 'private') -----
- ----- Method: EnvironmentLoader>>logStart: (in category 'as yet unclassified') -----
  logStart: filename
  	Smalltalk logChange: '----Start fileIn of ' , filename , ' into ' , environment name , '----'!

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

Item was changed:
+ ----- Method: EnvironmentsAPIDocumentation class>>bookName (in category 'accessing') -----
- ----- Method: EnvironmentsAPIDocumentation class>>bookName (in category 'as yet unclassified') -----
  bookName
  	^'Reference'!

Item was changed:
+ ----- Method: EnvironmentsAPIDocumentation class>>packages (in category 'private') -----
- ----- Method: EnvironmentsAPIDocumentation class>>packages (in category 'as yet unclassified') -----
  packages
  	^#('Environments-Core' 'Environments-Loading' 'Environments-Policies')!

Item was changed:
+ ----- Method: ExplicitNamePolicy class>>aliases: (in category 'instance creation') -----
- ----- Method: ExplicitNamePolicy class>>aliases: (in category 'as yet unclassified') -----
  aliases: aCollection
  	^ self basicNew initializeWithAliases: aCollection!

Item was changed:
+ ----- Method: ExplicitNamePolicy class>>flattenSpec:into: (in category 'private') -----
- ----- Method: ExplicitNamePolicy class>>flattenSpec:into: (in category 'create') -----
  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 changed:
+ ----- Method: ExplicitNamePolicy class>>spec: (in category 'instance creation') -----
- ----- Method: ExplicitNamePolicy class>>spec: (in category 'create') -----
  spec: anObject
  	| aliases |
  	(anObject isKindOf: NamePolicy) ifTrue: [^ anObject].
  	aliases := IdentityDictionary new.
  	self flattenSpec: anObject into: aliases.
  	^ self aliases: aliases!

Item was changed:
+ ----- Method: ExplicitNamePolicy>>initializeWithAliases: (in category 'initialize-release') -----
- ----- Method: ExplicitNamePolicy>>initializeWithAliases: (in category 'as yet unclassified') -----
  initializeWithAliases: aCollection
  	self initialize.
  	aliases := IdentityDictionary withAll: aCollection!

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

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

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

Item was changed:
+ ----- Method: Global>>initializeWithKey:value: (in category 'initialize-release') -----
- ----- Method: Global>>initializeWithKey:value: (in category 'as yet unclassified') -----
  initializeWithKey: aSymbol value: anObject
  	self initialize.
  	key := aSymbol.
  	value := anObject!

Item was changed:
+ ----- Method: Global>>literalEqual: (in category 'comparing') -----
- ----- Method: Global>>literalEqual: (in category 'as yet unclassified') -----
  literalEqual: other
  	"Globals are only equal to themselves, since another global with the same
  	name could have a different value in the future."
  	
  	^ self == other!

Item was changed:
+ ----- Method: Global>>value (in category 'evaluating') -----
- ----- Method: Global>>value (in category 'as yet unclassified') -----
  value
  	^ value!

Item was changed:
+ ----- Method: Global>>value: (in category 'accessing') -----
- ----- Method: Global>>value: (in category 'as yet unclassified') -----
  value: anObject
  	value := anObject!

Item was changed:
+ ----- Method: NamePolicy>>name:do: (in category 'naming') -----
- ----- Method: NamePolicy>>name:do: (in category 'as yet unclassified') -----
  name: aSymbol do: aBlock
  	self subclassResponsibility!

Item was changed:
+ ----- Method: RemovePrefixNamePolicy class>>prefix: (in category 'instance creation') -----
- ----- Method: RemovePrefixNamePolicy class>>prefix: (in category 'as yet unclassified') -----
  prefix: aString
  	^ self basicNew initializeWithPrefix: aString!

Item was changed:
+ ----- Method: RemovePrefixNamePolicy>>initializeWithPrefix: (in category 'initialize-release') -----
- ----- Method: RemovePrefixNamePolicy>>initializeWithPrefix: (in category 'as yet unclassified') -----
  initializeWithPrefix: aString
  	self initialize.
  	prefix := aString!

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



More information about the Squeak-dev mailing list