[Pkg] The Trunk: System-nice.264.mcz

commits at source.squeak.org commits at source.squeak.org
Thu Feb 25 03:17:41 UTC 2010


Nicolas Cellier uploaded a new version of System to project The Trunk:
http://source.squeak.org/trunk/System-nice.264.mcz

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

Name: System-nice.264
Author: nice
Time: 25 February 2010, 4:17:20.451 am
UUID: 511443f0-dc62-aa46-b0f0-13fc70165e11
Ancestors: System-nice.263

Remove some outer temp assignments in blocks

=============== Diff against System-nice.263 ===============

Item was changed:
  ----- Method: Project>>writeFileNamed:fromDirectory:toServer: (in category 'file in/out') -----
  writeFileNamed: localFileName fromDirectory: localDirectory toServer: primaryServerDirectory
  
  	| local resp gifFileName f |
  
  	local := localDirectory oldFileNamed: localFileName.
  	resp := primaryServerDirectory upLoadProject: local named: localFileName resourceUrl: self resourceUrl retry: false.
  	local close.
  	resp == true ifFalse: [
  		"abandon resources that would've been stored with the project"
  		self resourceManager abandonResourcesThat:
  			[:loc| loc urlString beginsWith: self resourceUrl].
  		self error: 'the primary server of this project seems to be down (',
  							resp printString,')'. 
  		^ self
  	].
  
  	gifFileName := self name,'.gif'.
  	localDirectory deleteFileNamed: gifFileName ifAbsent: [].
  	local := localDirectory fileNamed: gifFileName.
  	thumbnail ifNil: [
  		(thumbnail := Form extent: 100 at 80) fillColor: Color orange
  	] ifNotNil: [
  		thumbnail unhibernate.
  	].
  	f := thumbnail colorReduced.  "minimize depth"
  	f depth > 8 ifTrue: [
  		f := thumbnail asFormOfDepth: 8
  	].
  	GIFReadWriter putForm: f onStream: local.
  	local close.
  
  	[local := StandardFileStream readOnlyFileNamed: (localDirectory fullNameFor: gifFileName).
  	(primaryServerDirectory isKindOf: FileDirectory)
  		ifTrue: [primaryServerDirectory deleteFileNamed: gifFileName ifAbsent: []].
+ 	primaryServerDirectory putFile: local named: gifFileName retry: false.
- 	resp := primaryServerDirectory putFile: local named: gifFileName retry: false.
  	] on: Error do: [:ex |].
  	local close.
  
  	primaryServerDirectory updateProjectInfoFor: self.
  	primaryServerDirectory sleep.	"if ftp, close the connection"
  !

Item was changed:
  ----- Method: SharedPool class>>bindingOf: (in category 'name lookup') -----
  bindingOf: varName
  	"Answer the binding of some variable resolved in the scope of the receiver"
  	| aSymbol binding |
  	aSymbol := varName asSymbol.
  
  	"First look in classVar dictionary."
  	binding := self classPool bindingOf: aSymbol.
  	binding ifNotNil:[^binding].
  
  	"Next look in shared pools."
  	self sharedPools do:[:pool | 
+ 		| poolBinding |
+ 		poolBinding := pool bindingOf: aSymbol.
+ 		poolBinding ifNotNil:[^poolBinding].
- 		binding := pool bindingOf: aSymbol.
- 		binding ifNotNil:[^binding].
  	].
  
  	"subclassing and environment are not preserved"
  	^nil!

Item was changed:
  ----- Method: SARInstaller>>fileIn (in category 'fileIn') -----
  fileIn
  	"File in to a change set named like my file"
+ 	directory readOnlyFileNamed: fileName do: [:stream |
+ 		| newCS |
+ 		newCS := self class withCurrentChangeSetNamed: fileName
+ 			do: [:cs | self fileInFrom: stream].
+ 		newCS isEmpty ifTrue: [ ChangeSet removeChangeSet: newCS ]]!
- 	| stream newCS |
- 	stream := directory readOnlyFileNamed: fileName.
- 	self class withCurrentChangeSetNamed: fileName
- 		do: [:cs | newCS := cs. self fileInFrom: stream].
- 	newCS isEmpty ifTrue: [ ChangeSet removeChangeSet: newCS ]!

Item was changed:
  ----- Method: SARInstaller>>fileInGenieDictionaryNamed: (in category 'client services') -----
  fileInGenieDictionaryNamed: memberName 
  	"This is to be used from preamble/postscript code to file in zip 
  	members as Genie gesture dictionaries.
  	Answers a dictionary."
  
  	| member object crDictionary stream |
  
  	crDictionary := Smalltalk at: #CRDictionary ifAbsent: [ ^self error: 'Genie not installed' ].
  	"don't know how to recursively load"
  
  	member := self memberNamed: memberName.
  	member ifNil: [ ^self errorNoSuchMember: memberName ].
  
  	stream := ReferenceStream on: member contentStream.
  
+ 	object := [ stream next ]
- 	[ object := stream next ]
  		on: Error do: 
  		[:ex |  stream close.
  		self inform: 'Error on loading: ' , ex description. ^ nil ].
  	stream close.
  
  	(object notNil and: [object name isEmptyOrNil])
  		ifTrue: [object := crDictionary name: object storedName].
  
  	self installed: member.
  
  	^ object
  !



More information about the Packages mailing list