[squeak-dev] The Trunk: Collections-ul.444.mcz

commits at source.squeak.org commits at source.squeak.org
Sat Jun 18 08:48:41 UTC 2011


Levente Uzonyi uploaded a new version of Collections to project The Trunk:
http://source.squeak.org/trunk/Collections-ul.444.mcz

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

Name: Collections-ul.444
Author: ul
Time: 17 June 2011, 4:30:54.178 pm
UUID: ffecd66a-0b9a-3f4e-a6cd-f324f81d3e30
Ancestors: Collections-cmm.443

- Don't send #forgetDoIts, because it's not needed anymore.
- Use #repeat instead of [ true ] whileTrue and friends.
- Use #displayProgressFrom:to:during: instead of #displayProgressAt:from:to:during:.

=============== Diff against Collections-cmm.443 ===============

Item was changed:
  ----- Method: Base64MimeConverter>>nextValue (in category 'conversion') -----
  nextValue
  	"The next six bits of data char from the mimeStream, or nil.  Skip all other chars"
  	| raw num |
  	[raw := mimeStream next.
  	raw ifNil: [^ nil].	"end of stream"
  	raw == $= ifTrue: [^ nil].
  	num := FromCharTable at: raw asciiValue + 1.
  	num ifNotNil: [^ num].
  	"else ignore space, return, tab, ..."
+ 	] repeat!
- 	true] whileTrue.!

Item was changed:
  ----- Method: Collection>>do:displayingProgress:every: (in category 'enumerating') -----
  do: aBlock displayingProgress: aStringOrBlock every: msecs
  	"Enumerate aBlock displaying progress information. 
  	If the argument is a string, use a static label for the process. 
  	If the argument is a block, evaluate it with the element to retrieve the label.
  	The msecs argument ensures that updates happen at most every msecs.
  	Example:
  		Smalltalk allClasses 
  			do:[:aClass| (Delay forMilliseconds: 1) wait]
  			displayingProgress:[:aClass| 'Processing ', aClass name]
  			every: 0.
  		Smalltalk allClasses 
  			do:[:aClass| (Delay forMilliseconds: 1) wait]
  			displayingProgress:[:aClass| 'Processing ', aClass name]
  			every: 100.
  	"
  	| size labelBlock count oldLabel lastUpdate |
  	labelBlock := aStringOrBlock isString 
  		ifTrue:[[:item| aStringOrBlock]] 
  		ifFalse:[aStringOrBlock].
  	oldLabel := nil.
  	count := lastUpdate := 0.
  	size := self size.
+ 	'' displayProgressFrom: 0 to: size during:[:bar |
- 	'' displayProgressAt: Sensor cursorPoint from: 0 to: size during:[:bar |
  		self do:[:each| | newLabel |
  			"Special handling for first and last element"
  			(count = 0 or:[count+1 = size 
  				or:[(Time millisecondsSince: lastUpdate) >= msecs]]) ifTrue:[
  					bar value: count.
  					oldLabel = (newLabel := (labelBlock value: each) ifNil:[oldLabel]) ifFalse:[
  					ProgressNotification signal: '' extra: (oldLabel := newLabel).
  				].
  				lastUpdate := Time millisecondClockValue.
  			].
  			aBlock value: each.
  			count := count + 1.
  	]]!

Item was changed:
  ----- Method: Dictionary>>unreferencedKeys (in category 'removing') -----
  unreferencedKeys
  	"| uk | (Time millisecondsToRun: [uk := TextConstants unreferencedKeys]) -> uk"
  
  	^'Scanning for references . . .' 
+ 		displayProgressFrom: 0
- 		displayProgressAt: Sensor cursorPoint
- 		from: 0
  		to: Smalltalk classNames size * 2
  		during: 
  			[:bar | | currentClass n associations referencedAssociations |
  			currentClass := nil.
  			n := 0.
  			associations := self associations asIdentitySet.
  			referencedAssociations := IdentitySet new: associations size.
  			self systemNavigation allSelect:
  				[:m|
  				m methodClass ~~ currentClass ifTrue:
  					[currentClass := m methodClass.
  					 bar value: (n := n + 1)].
  				m literalsDo:
  					[:l|
  					(l isVariableBinding and: [associations includes: l]) ifTrue:
  						[referencedAssociations add: l]].
  				false].
  			((associations reject: [:assoc | referencedAssociations includes: assoc]) collect: [:assoc| assoc key]) asSet]!

Item was changed:
  ----- Method: PositionableStream>>fileInAnnouncing: (in category 'fileIn/Out') -----
  fileInAnnouncing: announcement 
  	"This is special for reading expressions from text that has been formatted 
  	with exclamation delimitors. The expressions are read and passed to the 
  	Compiler. Answer the result of compilation.  Put up a progress report with
       the given announcement as the title."
  
  	| val |
  	announcement 
+ 		displayProgressFrom: 0
- 		displayProgressAt: Sensor cursorPoint
- 		from: 0
  		to: self size
  		during: 
  			[:bar | 
  			[self atEnd] whileFalse: 
  					[bar value: self position.
  					self skipSeparators.
  					
  					[ | chunk |
  					val := (self peekFor: $!!) 
  								ifTrue: [(Compiler evaluate: self nextChunk logged: false) scanFrom: self]
  								ifFalse: 
  									[chunk := self nextChunk.
  									self checkForPreamble: chunk.
  									Compiler evaluate: chunk logged: true]] 
  							on: InMidstOfFileinNotification
  							do: [:ex | ex resume: true].
  					self skipStyleChunk].
  			self close].
  	"Note:  The main purpose of this banner is to flush the changes file."
  	SmalltalkImage current logChange: '----End fileIn of ' , self name , '----'.
  	self flag: #ThisMethodShouldNotBeThere.	"sd"
- 	Smalltalk forgetDoIts.
  	^val!

Item was changed:
  ----- Method: PositionableStream>>fileInFor:announcing: (in category 'fileIn/Out') -----
  fileInFor: client announcing: announcement
  	"This is special for reading expressions from text that has been formatted 
  	with exclamation delimitors. The expressions are read and passed to the 
  	Compiler. Answer the result of compilation.  Put up a progress report with
       the given announcement as the title.
  	Does NOT handle preambles or postscripts specially."
  	| val |
+ 	announcement
+ 		displayProgressFrom: 0
+ 		to: self size
- 	announcement displayProgressAt: Sensor cursorPoint
- 		from: 0 to: self size
  		during:
  		[:bar |
  		[self atEnd]
  			whileFalse: 
  				[bar value: self position.
  				self skipSeparators.
  				[ | chunk |
  				val := (self peekFor: $!!) ifTrue: [
  						(Compiler evaluate: self nextChunk for: client logged: false) scanFrom: self
  					] ifFalse: [
  						chunk := self nextChunk.
  						self checkForPreamble: chunk.
  						Compiler evaluate: chunk for: client logged: true ].
  				] on: InMidstOfFileinNotification
  				  do: [ :ex | ex resume: true].
  				self atEnd ifFalse: [ self skipStyleChunk ]].
  		self close].
  	"Note:  The main purpose of this banner is to flush the changes file."
  	SmalltalkImage current logChange: '----End fileIn of ' , self name , '----'.
- 	Smalltalk forgetDoIts.
  	^ val!

Item was changed:
  ----- Method: Transcripter>>confirm: (in category 'command line') -----
  confirm: queryString 
+ 
  	| choice |
+ 	[choice := self request: queryString , '
- 	[true]
- 		whileTrue: 
- 			[choice := self request: queryString , '
  Please type yes or no followed by return'.
+ 	choice first asUppercase = $Y ifTrue: [^ true].
+ 		choice first asUppercase = $N ifTrue: [^ false]] repeat!
- 			choice first asUppercase = $Y ifTrue: [^ true].
- 			choice first asUppercase = $N ifTrue: [^ false]]!

Item was changed:
  ----- Method: WeakArray class>>finalizationProcess (in category 'private') -----
  finalizationProcess
+ 
+ 	[ WeakFinalizationList initTestPair.
+ 	FinalizationSemaphore wait.
+ 	FinalizationLock critical:
+ 		[
+ 		WeakFinalizationList checkTestPair.
+ 		FinalizationDependents do:
+ 			[:weakDependent |
+ 			weakDependent ifNotNil:
+ 				[weakDependent finalizeValues]]]
+ 		ifError:
+ 		[:msg :rcvr | rcvr error: msg] ] repeat!
- 	[true] whileTrue:
- 		[ WeakFinalizationList initTestPair.
- 		FinalizationSemaphore wait.
- 		FinalizationLock critical:
- 			[
- 			WeakFinalizationList checkTestPair.
- 			FinalizationDependents do:
- 				[:weakDependent |
- 				weakDependent ifNotNil:
- 					[weakDependent finalizeValues]]]
- 			ifError:
- 			[:msg :rcvr | rcvr error: msg].
- 		].
- !

Item was changed:
  ----- Method: WideString class>>allMethodsWithEncodingTag: (in category 'enumeration') -----
  allMethodsWithEncodingTag: encodingTag
  	"Answer a SortedCollection of all the methods that implement the message 
  	aSelector."
  
  	| list adder num i |
  	list := Set new.
  	adder := [ :mrClass :mrSel |
  		list add: (
  			MethodReference new
  				setStandardClass: mrClass
  				methodSymbol: mrSel
  		)
  	].
  
  	num := CompiledMethod allInstances size.
  	i := 0.
+ 	'processing...' displayProgressFrom: 0 to: num during: [:bar |
- 	'processing...' displayProgressAt: Sensor cursorPoint from: 0 to: num during: [:bar |
  		SystemNavigation new allBehaviorsDo: [ :class |
  			class selectorsDo: [:s |
  				bar value: (i := i + 1).				
  				(self string: (class sourceCodeAt: s) asString hasEncoding: encodingTag) ifTrue: [
  					adder value: class value: s.
  				]
  			]
  		]
  	].
  
  	^ list.
  !

Item was changed:
  ----- Method: WideString class>>allMultiStringMethods (in category 'enumeration') -----
  allMultiStringMethods  
  	"Answer a SortedCollection of all the methods that implement the message 
  	aSelector."
  
  	| list adder num i |
  	list := Set new.
  	adder := [ :mrClass :mrSel |
  		list add: (
  			MethodReference new
  				setStandardClass: mrClass
  				methodSymbol: mrSel
  		)
  	].
  
  	num := CompiledMethod allInstances size.
  	i := 0.
+ 	'processing...' displayProgressFrom: 0 to: num during: [:bar |
- 	'processing...' displayProgressAt: Sensor cursorPoint from: 0 to: num during: [:bar |
  		SystemNavigation new allBehaviorsDo: [ :class |
  			class selectorsDo: [:s |
  				bar value: (i := i + 1).				
  				((class sourceCodeAt: s) asString isOctetString) ifFalse: [
  					adder value: class value: s.
  				]
  			]
  		]
  	].
  
  	^ list.
  !

Item was changed:
  ----- Method: WideString class>>allNonAsciiMethods (in category 'enumeration') -----
  allNonAsciiMethods  
  	"Answer a SortedCollection of all the methods that implement the message 
  	aSelector."
  
  	| list adder num i |
  	list := Set new.
  	adder := [ :mrClass :mrSel |
  		list add: (
  			MethodReference new
  				setStandardClass: mrClass
  				methodSymbol: mrSel
  		)
  	].
  
  	num := CompiledMethod allInstances size.
  	i := 0.
+ 	'processing...' displayProgressFrom: 0 to: num during: [:bar |
- 	'processing...' displayProgressAt: Sensor cursorPoint from: 0 to: num during: [:bar |
  		SystemNavigation new allBehaviorsDo: [ :class |
  			class selectorsDo: [:s |
  				bar value: (i := i + 1).				
  				((class sourceCodeAt: s) asString isAsciiString) ifFalse: [
  					adder value: class value: s.
  				]
  			]
  		]
  	].
  
  	^ list.
  !




More information about the Squeak-dev mailing list