[Pkg] The Trunk: Tools-nice.447.mcz

commits at source.squeak.org commits at source.squeak.org
Sun Feb 24 17:32:56 UTC 2013


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

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

Name: Tools-nice.447
Author: nice
Time: 24 February 2013, 6:32:05.033 pm
UUID: c213012a-b66a-4d1e-99cc-a707e054efc9
Ancestors: Tools-fbs.446

Diminish excessive usage of ReadWriteStream

=============== Diff against Tools-fbs.446 ===============

Item was changed:
  ----- Method: CodeHolder>>annotationForSelector:ofClass: (in category 'annotation') -----
  annotationForSelector: aSelector ofClass: aClass 
  	"Provide a line of content for an annotation pane, representing  
  	information about the given selector and class"
  	| separator aStream requestList |
  	aSelector == #Comment
  		ifTrue: [^ self annotationForClassCommentFor: aClass].
  	aSelector == #Definition
  		ifTrue: [^ self annotationForClassDefinitionFor: aClass].
  	aSelector == #Hierarchy
  		ifTrue: [^ self annotationForHierarchyFor: aClass].
+ 	aStream := (String new: 512) writeStream.
- 	aStream := ReadWriteStream on: ''.
  	requestList := self annotationRequests.
  	separator := requestList size > 1
  				ifTrue: [self annotationSeparator]
  				ifFalse: [''].
  	requestList
  		do: [:aRequest | | aString sendersCount aComment aCategory implementorsCount aList stamp | 
  			aRequest == #firstComment
  				ifTrue: [aComment := aClass firstCommentAt: aSelector.
  					aComment isEmptyOrNil
  						ifFalse: [aStream nextPutAll: aComment , separator]].
  			aRequest == #masterComment
  				ifTrue: [aComment := aClass supermostPrecodeCommentFor: aSelector.
  					aComment isEmptyOrNil
  						ifFalse: [aStream nextPutAll: aComment , separator]].
  			aRequest == #documentation
  				ifTrue: [aComment := aClass precodeCommentOrInheritedCommentFor: aSelector.
  					aComment isEmptyOrNil
  						ifFalse: [aStream nextPutAll: aComment , separator]].
  			aRequest == #timeStamp
  				ifTrue: [stamp := self timeStamp.
  					aStream
  						nextPutAll: (stamp size > 0
  								ifTrue: [stamp , separator]
  								ifFalse: ['no timeStamp' , separator])].
  			aRequest == #messageCategory
  				ifTrue: [aCategory := aClass organization categoryOfElement: aSelector.
  					aCategory
  						ifNotNil: ["woud be nil for a method no longer present,  
  							e.g. in a recent-submissions browser"
  							aStream nextPutAll: aCategory , separator]].
  			aRequest == #sendersCount
  				ifTrue: [sendersCount := (self systemNavigation allCallsOn: aSelector) size.
  					sendersCount := sendersCount = 1
  								ifTrue: ['1 sender']
  								ifFalse: [sendersCount printString , ' senders'].
  					aStream nextPutAll: sendersCount , separator].
  			aRequest == #implementorsCount
  				ifTrue: [implementorsCount := self systemNavigation numberOfImplementorsOf: aSelector.
  					implementorsCount := implementorsCount = 1
  								ifTrue: ['1 implementor']
  								ifFalse: [implementorsCount printString , ' implementors'].
  					aStream nextPutAll: implementorsCount , separator].
  			aRequest == #priorVersionsCount
  				ifTrue: [self
  						addPriorVersionsCountForSelector: aSelector
  						ofClass: aClass
  						to: aStream].
  			aRequest == #priorTimeStamp
  				ifTrue: [stamp := VersionsBrowser
  								timeStampFor: aSelector
  								class: aClass
  								reverseOrdinal: 2.
  					stamp
  						ifNotNil: [aStream nextPutAll: 'prior time stamp: ' , stamp , separator]].
  			aRequest == #recentChangeSet
  				ifTrue: [aString := ChangesOrganizer mostRecentChangeSetWithChangeForClass: aClass selector: aSelector.
  					aString size > 0
  						ifTrue: [aStream nextPutAll: aString , separator]].
  			aRequest == #allChangeSets
  				ifTrue: [aList := ChangesOrganizer allChangeSetsWithClass: aClass selector: aSelector.
  					aList size > 0
  						ifTrue: [aList size = 1
  								ifTrue: [aStream nextPutAll: 'only in change set ']
  								ifFalse: [aStream nextPutAll: 'in change sets: '].
  							aList
  								do: [:aChangeSet | aStream nextPutAll: aChangeSet name , ' ']]
  						ifFalse: [aStream nextPutAll: 'in no change set'].
  					aStream nextPutAll: separator]].
  	^ aStream contents!

Item was changed:
  ----- Method: TimeProfileBrowser>>runBlock:pollingEvery: (in category 'private') -----
  runBlock: aBlock pollingEvery: pollPeriod 
+ 	| list result |
- 	| stream list result |
  	block := MessageSend 
  				receiver: self
  				selector: #runBlock:pollingEvery:
  				arguments: { 
  						aBlock.
  						pollPeriod}.	"so we can re-run it"
  	tally := MessageTally new.
  	tally
  		reportOtherProcesses: false;
  		maxClassNameSize: 1000;
  		maxClassPlusSelectorSize: 1000;
  		maxTabs: 100.
  	result := tally spyEvery: pollPeriod on: aBlock.
+ 	list := OrderedCollection withAll: (String streamContents: [ :s | tally report: s]) lines.
- 	stream := ReadWriteStream 
- 				with: (String streamContents: [ :s | 
- 					tally report: s]).
- 	stream reset.
- 	list := OrderedCollection new.
- 	[stream atEnd] whileFalse: [list add: stream nextLine].
  	self initializeMessageList: list.
  	self changed: #messageList.
  	self changed: #messageListIndex.
  	^result!

Item was changed:
  ----- Method: TimeProfileBrowser>>runProcess:forMilliseconds:pollingEvery: (in category 'private') -----
  runProcess: aProcess forMilliseconds: msecDuration pollingEvery: pollPeriod 
+ 	| list result |
- 	| stream list result |
  	block := MessageSend 
  				receiver: self
  				selector: #runProcess:forMilliseconds:pollingEvery: 
  				arguments: { 
  						aProcess.
  						msecDuration.
  						pollPeriod}.	"so we can re-run it"
  	tally := MessageTally new.
  	tally
  		reportOtherProcesses: false;
  		maxClassNameSize: 1000;
  		maxClassPlusSelectorSize: 1000;
  		maxTabs: 100.
  	result := tally 
  				spyEvery: pollPeriod
  				onProcess: aProcess
  				forMilliseconds: msecDuration.
+ 	list := OrderedCollection withAll: (String streamContents: [ :s | tally report: s]) lines.
- 	stream := ReadWriteStream 
- 				with: (String streamContents: [ :s | 
- 							tally report: s]).
- 	stream reset.
- 	list := OrderedCollection new.
- 	[stream atEnd] whileFalse: [list add: stream nextLine].
  	self initializeMessageList: list.
  	self changed: #messageList.
  	self changed: #messageListIndex.
  	^result!



More information about the Packages mailing list