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

commits at source.squeak.org commits at source.squeak.org
Thu Feb 4 19:16:46 UTC 2010


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

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

Name: Tools-nice.167
Author: nice
Time: 4 February 2010, 8:16:26.638 pm
UUID: f452acf8-6017-4cc4-b941-187522e12dd2
Ancestors: Tools-dtl.166

1) move some temp assignment outside blocks
2) remove some now useless fixTemps
3) add a pair of translated

=============== Diff against Tools-dtl.166 ===============

Item was changed:
  ----- Method: ChangeList class>>browseRecent:on: (in category 'public access') -----
  browseRecent: charCount on: origChangesFile 
  	"Opens a changeList on the end of the specified changes log file"
  	| changeList end changesFile |
  	changesFile := origChangesFile readOnlyCopy.
  	changesFile setConverterForCode.
  	end := changesFile size.
+ 	changeList := Cursor read
+ 		showWhile: [self new
- 	Cursor read
- 		showWhile: [changeList := self new
  						scanFile: changesFile
  						from: (0 max: end - charCount)
  						to: end].
  	changesFile close.
  	self
  		open: changeList
  		name: 'Recent changes'
  		multiSelect: true!

Item was changed:
  ----- Method: ChangeList>>selectNewMethods (in category 'menu actions') -----
  selectNewMethods
  	"Selects all method definitions for which there is no counterpart method in the current image"
- 
- 	
  	Cursor read showWhile: 
+ 		[ | change class |
+ 		1 to: changeList size do:
- 		[ | change class |1 to: changeList size do:
  			[:i | change := changeList at: i.
  			listSelections at: i put:
  				((change type = #method and:
  					[((class := change methodClass) isNil) or:
  						[(class includesSelector: change methodSelector) not]]))]].
  	self changed: #allSelections!

Item was changed:
  ----- Method: ChangeList class>>browseRecentLogOn:startingFrom: (in category 'public access') -----
  browseRecentLogOn: origChangesFile startingFrom: initialPos 
  	"Prompt with a menu of how far back to go when browsing a changes file."
  
  	| end banners positions pos chunk i changesFile |
  	changesFile := origChangesFile readOnlyCopy.
  	banners := OrderedCollection new.
  	positions := OrderedCollection new.
  	end := changesFile size.
  	changesFile setConverterForCode.
  	pos := initialPos.
  	[pos = 0
  		or: [banners size > 20]]
  		whileFalse: [changesFile position: pos.
  			chunk := changesFile nextChunk.
  			i := chunk indexOfSubCollection: 'priorSource: ' startingAt: 1.
  			i > 0
  				ifTrue: [positions addLast: pos.
  					banners
  						addLast: (chunk copyFrom: 5 to: i - 2).
  					pos := Number
  								readFrom: (chunk copyFrom: i + 13 to: chunk size)]
  				ifFalse: [pos := 0]].
  	changesFile close.
  	banners size == 0 ifTrue: [^ self inform: 
  'this image has never been saved
+ since changes were compressed' translated].
+ 	pos := UIManager default chooseFrom:  banners values: positions title: 'Browse as far back as...' translated.
+ 	pos ifNil: [^ self].
- since changes were compressed'].
- 	pos := UIManager default chooseFrom: banners values: positions
- 				title: 'Browse as far back as...'.
- 	pos == nil
- 		ifTrue: [^ self].
  	self browseRecent: end - pos on: origChangesFile!

Item was changed:
  ----- Method: ChangeList class>>browseStream: (in category 'public access') -----
  browseStream: changesFile
  	"Opens a changeList on a fileStream"
  	| changeList charCount |
  	changesFile readOnly.
  	changesFile setConverterForCode.
  	charCount := changesFile size.
  	charCount > 1000000 ifTrue:
  		[(self confirm: 'The file ', changesFile name , '
  is really long (' , charCount printString , ' characters).
  Would you prefer to view only the last million characters?')
  			ifTrue: [charCount := 1000000]].
  	"changesFile setEncoderForSourceCodeNamed: changesFile name."
+ 	changeList := Cursor read showWhile:
+ 		[self new
- 	Cursor read showWhile:
- 		[changeList := self new
  			scanFile: changesFile from: changesFile size-charCount to: changesFile size].
  	changesFile close.
  	self open: changeList name: changesFile localName , ' log' multiSelect: true!

Item was changed:
  ----- Method: ChangeList>>selectUnchangedMethods (in category 'menu actions') -----
  selectUnchangedMethods
  	"Selects all method definitions for which there is already a method in the current image, whose source is exactly the same.  9/18/96 sw"
- 	
  	Cursor read showWhile: 
+ 	[ | class change |
+ 	1 to: changeList size do:
- 	[ | class change |1 to: changeList size do:
  		[:i | change := changeList at: i.
  		listSelections at: i put:
  			((change type = #method and:
  				[(class := change methodClass) notNil]) and:
  					[(class includesSelector: change methodSelector) and:
  						[change string withBlanksCondensed = (class sourceCodeAt: change methodSelector) asString withBlanksCondensed ]])]].
  	self changed: #allSelections!

Item was changed:
  ----- Method: ChangeList>>selectConflicts: (in category 'menu actions') -----
  selectConflicts: changeSetOrList
  	"Selects all method definitions for which there is ALSO an entry in the specified changeSet or changList"
- 	| systemChanges |
  	Cursor read showWhile: 
+ 	[ | change class |
+ 	(changeSetOrList isKindOf: ChangeSet) ifTrue: [
- 	[ | change class |(changeSetOrList isKindOf: ChangeSet) ifTrue: [
  	1 to: changeList size do:
  		[:i | change := changeList at: i.
  		listSelections at: i put:
  			(change type = #method
  			and: [(class := change methodClass) notNil
  			and: [(changeSetOrList atSelector: change methodSelector
  						class: class) ~~ #none]])]]
  	ifFalse: ["a ChangeList"
  	1 to: changeList size do:
  		[:i | change := changeList at: i.
  		listSelections at: i put:
  			(change type = #method
  			and: [(class := change methodClass) notNil
  			and: [changeSetOrList list includes: (list at: i)]])]]
  	].
  	self changed: #allSelections!

Item was changed:
  ----- Method: ChangeList>>selectConflicts (in category 'menu actions') -----
  selectConflicts
  	"Selects all method definitions for which there is ALSO an entry in changes"
- 	
  	Cursor read showWhile: 
+ 	[ | change class |
+ 	1 to: changeList size do:
- 	[ | change class |1 to: changeList size do:
  		[:i | change := changeList at: i.
  		listSelections at: i put:
  			(change type = #method
  			and: [(class := change methodClass) notNil
  			and: [(ChangeSet current atSelector: change methodSelector
  						class: class) ~~ #none]])]].
  	self changed: #allSelections!

Item was changed:
  ----- Method: FileChooser>>setSuffixes: (in category 'initialization') -----
  setSuffixes: aList
  	self fileSelectionBlock:  [:entry :myPattern |
  			entry isDirectory
  				ifTrue:
  					[false]
  				ifFalse:
+ 					[aList includes: (FileDirectory extensionFor: entry name asLowercase)]]!
- 					[aList includes: (FileDirectory extensionFor: entry name asLowercase)]] fixTemps!

Item was changed:
  ----- Method: ChangeList>>selectAllConflicts (in category 'menu actions') -----
  selectAllConflicts
  	"Selects all method definitions in the receiver which are also in any existing change set in the system.  This makes no statement about whether the content of the methods differ, only whether there is a change represented."
- 
- 	
  	Cursor read showWhile: 
+ 		[ | aClass aChange |
+ 		1 to: changeList size do:
- 		[ | aClass aChange |1 to: changeList size do:
  			[:i | aChange := changeList at: i.
  			listSelections at: i put:
  				(aChange type = #method
  				and: [(aClass := aChange methodClass) notNil
  				and: [ChangesOrganizer doesAnyChangeSetHaveClass: aClass andSelector:  aChange methodSelector]])]].
  	self changed: #allSelections!

Item was changed:
  ----- Method: ChangeList>>browseCurrentVersionsOfSelections (in category 'menu actions') -----
  browseCurrentVersionsOfSelections
  	"Opens a message-list browser on the current in-memory versions of all methods that are currently seleted"
  	| aList |
  	aList := OrderedCollection new.
  	Cursor read showWhile: [
  		1 to: changeList size do: [:i |
  			(listSelections at: i) ifTrue: [
+ 				| aClass aChange |
- 				|  aClass aChange |
  				aChange := changeList at: i.
  				(aChange type = #method
  					and: [(aClass := aChange methodClass) notNil
  					and: [aClass includesSelector: aChange methodSelector]])
  						ifTrue: [
  							aList add: (
  								MethodReference new
  									setStandardClass: aClass  
  									methodSymbol: aChange methodSelector
  							)
  						]]]].
  
  	aList size == 0 ifTrue: [^ self inform: 'no selected methods have in-memory counterparts'].
  	MessageSet 
  		openMessageList: aList 
  		name: 'Current versions of selected methods in ', file localName!



More information about the Packages mailing list