[squeak-dev] The Trunk: Tools-ul.747.mcz

commits at source.squeak.org commits at source.squeak.org
Mon Mar 13 15:02:34 UTC 2017


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

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

Name: Tools-ul.747
Author: ul
Time: 13 March 2017, 3:33:00.598581 pm
UUID: 2541e928-0804-4d49-9ef5-0d94d5e54a50
Ancestors: Tools-cbc.746

- SortedCollection Whack-a-mole
- use the new #hasEntries method in FileList

=============== Diff against Tools-cbc.746 ===============

Item was changed:
  ----- Method: Browser>>addCategory (in category 'message category functions') -----
  addCategory
  	"Present a choice of categories or prompt for a new category name and add it before the current selection, or at the end if no current selection"
  	| labels reject lines newName oldCategory |
  	self okToChange ifFalse: [^ self].
  	self hasClassSelected ifFalse: [^ self].
  	labels := OrderedCollection new.
  	reject := Set new.
  	reject
  		addAll: self selectedClassOrMetaClass organization categories;
  		add: ClassOrganizer nullCategory;
  		add: ClassOrganizer default.
  	lines := OrderedCollection new.
  	self selectedClassOrMetaClass allSuperclasses do: [:cls | | cats |
  		cls = Object ifFalse: [
  			cats := cls organization categories reject:
  				 [:cat | reject includes: cat].
  			cats isEmpty ifFalse: [
  				lines add: labels size.
+ 				labels addAll: cats sort.
- 				labels addAll: cats asSortedCollection.
  				reject addAll: cats]]].
  	(newName := UIManager default
  		chooseFromOrAddTo: labels
  		lines: lines
  		title: 'Add Category') ifNil: [^ self].
  	newName isEmpty
  		ifTrue: [^ self]
  		ifFalse: [newName := newName asSymbol].
  	oldCategory := self selectedMessageCategoryName.
  	self classOrMetaClassOrganizer
  		addCategory: newName
  		before: (self hasMessageCategorySelected
  				ifFalse: [nil]
  				ifTrue: [self selectedMessageCategoryName]).
  	self changed: #messageCategoryList.
  	self selectMessageCategoryNamed: newName.
  	self changed: #messageCategoryList.
  !

Item was changed:
  ----- Method: Browser>>findMethod (in category 'class functions') -----
  findMethod
  	"Pop up a list of the current class's methods, and select the one chosen by the user"
  	| aClass selectors reply cat messageCatIndex messageIndex |
  	self classListIndex = 0 ifTrue: [^ self].
  	self okToChange ifFalse: [^ self].
  	aClass := self selectedClassOrMetaClass.
+ 	selectors := aClass selectors sorted.
- 	selectors := aClass selectors asSortedArray.
  	selectors isEmpty ifTrue: [self inform: aClass name, ' has no methods.'. ^ self].
  	reply := UIManager default 
  		chooseFrom: selectors
  		values: selectors
  		lines: #(1).
+ 	reply ifNil: [^ self].
- 	reply == nil ifTrue: [^ self].
  	cat := aClass whichCategoryIncludesSelector: reply.
  	messageCatIndex := self messageCategoryList indexOf: cat.
  	self messageCategoryListIndex: messageCatIndex.
  	messageIndex := (self messageList indexOf: reply).
  	self messageListIndex: messageIndex!

Item was changed:
  ----- Method: ChangeList class>>browseRecentLogOn: (in category 'public access') -----
  browseRecentLogOn: origChangesFile 
  	"figure out where the last snapshot or quit was, then browse the recent entries."
  
+ 	| end done block pos chunk changesFile position prevBlock |
- 	| end done block pos chunk changesFile positions prevBlock |
  	changesFile := origChangesFile readOnlyCopy.
+ 	position := nil.
- 	positions := SortedCollection new.
  	end := changesFile size.
  	prevBlock := end.
  	block := end - 1024 max: 0.
  	done := false.
  	[done
+ 		or: [position notNil]]
- 		or: [positions size > 0]]
  		whileFalse: [changesFile position: block.
  			"ignore first fragment"
  			changesFile nextChunk.
  			[changesFile position < prevBlock]
  				whileTrue: [pos := changesFile position.
  					chunk := changesFile nextChunk.
  					((chunk indexOfSubCollection: '----' startingAt: 1) = 1) ifTrue: [
+ 						(#('----QUIT' '----SNAPSHOT') anySatisfy: [ :str |
- 						({ '----QUIT'. '----SNAPSHOT' } anySatisfy: [ :str |
  							chunk beginsWith: str ])
+ 								ifTrue: [position := pos]]].
- 								ifTrue: [positions add: pos]]].
  			block = 0
  				ifTrue: [done := true]
  				ifFalse: [prevBlock := block.
  					block := block - 1024 max: 0]].
  	changesFile close.
+ 	position 
+ 		ifNil: [self inform: 'File ' , changesFile name , ' does not appear to be a changes file']
+ 		ifNotNil: [self browseRecentLogOn: origChangesFile startingFrom: position]!
- 	positions isEmpty
- 		ifTrue: [self inform: 'File ' , changesFile name , ' does not appear to be a changes file']
- 		ifFalse: [self browseRecentLogOn: origChangesFile startingFrom: positions last]!

Item was changed:
  ----- Method: ChangeSorter>>basicMessageList (in category 'message list') -----
  basicMessageList 
  
  	| probe newSelectors className |
  	currentClassName ifNil: [^ #()].
  	className := (self withoutItemAnnotation: currentClassName) .
  	probe := (className endsWith: ' class')
  		ifTrue: [className]
  		ifFalse: [className asSymbol].
  	newSelectors := myChangeSet selectorsInClass: probe.
  	(newSelectors includes: (self selectedMessageName)) 
  		ifFalse: [currentSelector := nil].
+ 	^ newSelectors sort
- 	^ newSelectors asSortedCollection
  !

Item was changed:
  ----- Method: ChangeSorter>>chooseCngSet (in category 'changeSet menu') -----
  chooseCngSet
  	"Present the user with an alphabetical list of change set names, and let her choose one"
  
  	| changeSetsSortedAlphabetically chosen |
  	self okToChange ifFalse: [^ self].
  
+ 	changeSetsSortedAlphabetically := self changeSetList sorted:
- 	changeSetsSortedAlphabetically := self changeSetList asSortedCollection:
  		[:a :b | a asLowercase withoutLeadingDigits < b asLowercase withoutLeadingDigits].
  
  	chosen := UIManager default chooseFrom: changeSetsSortedAlphabetically values: changeSetsSortedAlphabetically.
  	chosen ifNil: [^ self].
  	self showChangeSet: (ChangesOrganizer changeSetNamed: chosen)!

Item was changed:
  ----- Method: CodeHolder>>categoryFromUserWithPrompt:for: (in category 'categories') -----
  categoryFromUserWithPrompt: aPrompt for: aClass
  	"self new categoryFromUserWithPrompt: 'testing' for: SystemDictionary"
  
  	|  labels myCategories reject lines newName menuIndex | 
  	labels := OrderedCollection with: 'new...'.
+ 	labels addAll: (myCategories := aClass organization categories sorted:
- 	labels addAll: (myCategories := aClass organization categories asSortedCollection:
  		[:a :b | a asLowercase < b asLowercase]).
  	reject := myCategories asSet.
  	reject
  		add: ClassOrganizer nullCategory;
  		add: ClassOrganizer default.
  	lines := OrderedCollection with: 1 with: (myCategories size + 1).
  
  	aClass allSuperclasses do:
  		[:cls |
  			| cats |
  			cats := cls organization categories reject:
  				 [:cat | reject includes: cat].
  			cats isEmpty ifFalse:
  				[lines add: labels size.
+ 				labels addAll: (cats sort:
- 				labels addAll: (cats asSortedCollection:
  					[:a :b | a asLowercase < b asLowercase]).
  				reject addAll: cats]].
  
  	newName := (labels size = 1 or:
  		[menuIndex := (UIManager default chooseFrom: labels lines: lines title: aPrompt).
  		menuIndex = 0 ifTrue: [^ nil].
  		menuIndex = 1])
  			ifTrue:
  				[UIManager default request: 'Please type new category name'
  					initialAnswer: 'category name']
  			ifFalse: 
  				[labels at: menuIndex].
  	^ newName ifNotNil: [newName asSymbol]!

Item was changed:
  ----- Method: CompiledMethod>>blockExtentsToTempsMap (in category '*Tools-Debugger-support') -----
  blockExtentsToTempsMap
  	"If the receiver has been copied with temp names answer a
  	 map from blockExtent to temps map in the same format as
  	 BytecodeEncoder>>blockExtentsToTempNamesMap.  if the
  	 receiver has not been copied with temps answer nil."
  	^self holdsTempNames ifTrue:
+ 		[self mapFromBlockKeys: ((self startpcsToBlockExtents associations sort:
+ 										[:a1 :a2| a1 key < a2 key]) replace:
- 		[self mapFromBlockKeys: ((self startpcsToBlockExtents associations asSortedCollection:
- 										[:a1 :a2| a1 key < a2 key]) collect:
  									[:assoc| assoc value])
  			toSchematicTemps: self tempNamesString]!

Item was changed:
  ----- Method: DebuggerMethodMap>>rangeForPC:contextIsActiveContext: (in category 'source mapping') -----
  rangeForPC: contextsConcretePC contextIsActiveContext: contextIsActiveContext
  	"Answer the indices in the source code for the supplied pc.
  	 If the context is the actve context (is at the hot end of the stack)
  	 then its pc is the current pc.  But if the context isn't, because it is
  	 suspended sending a message, then its current pc is the previous pc."
  
  	| pc i end |
  	pc := self method abstractPCForConcretePC: (contextIsActiveContext
  													ifTrue: [contextsConcretePC]
  													ifFalse: [(self method pcPreviousTo: contextsConcretePC)
  																ifNotNil: [:prevpc| prevpc]
  																ifNil: [contextsConcretePC]]).
  	(self abstractSourceMap includesKey: pc) ifTrue:
  		[^self abstractSourceMap at: pc].
  	sortedSourceMap ifNil:
+ 		[sortedSourceMap := self abstractSourceMap associations
+ 			replace: [ :each | each copy ];
+ 			sort].
+ 	sortedSourceMap isEmpty ifTrue: [^1 to: 0].
- 		[sortedSourceMap := self abstractSourceMap.
- 		 sortedSourceMap := (sortedSourceMap keys collect: 
- 								[:key| key -> (sortedSourceMap at: key)]) asSortedCollection].
- 	(sortedSourceMap isNil or: [sortedSourceMap isEmpty]) ifTrue: [^1 to: 0].
  	i := sortedSourceMap findNearbyBinaryIndex: [:assoc| pc - assoc key].
  	i < 1 ifTrue: [^1 to: 0].
  	i > sortedSourceMap size ifTrue:
  		[end := sortedSourceMap inject: 0 into:
  			[:prev :this | prev max: this value last].
  		^end+1 to: end].
  	^(sortedSourceMap at: i) value
  
  	"| method source scanner map |
  	 method := DebuggerMethodMap compiledMethodAt: #rangeForPC:contextIsActiveContext:.
  	 source := method getSourceFromFile asString.
  	 scanner := InstructionStream on: method.
  	 map := method debuggerMap.
  	 Array streamContents:
  		[:ranges|
  		[scanner atEnd] whileFalse:
  			[| range |
  			 range := map rangeForPC: scanner pc contextIsActiveContext: true.
  			 ((map abstractSourceMap includesKey: scanner abstractPC)
  			  and: [range first ~= 0]) ifTrue:
  				[ranges nextPut: (source copyFrom: range first to: range last)].
  			scanner interpretNextInstructionFor: InstructionClient new]]"!

Item was changed:
  ----- Method: FileList>>deleteDirectory (in category 'volume list and pattern') -----
  deleteDirectory
  	"Remove the currently selected directory"
  	| localDirName |
+ 	directory hasEntries ifTrue:[^self inform:'Directory must be empty' translated].
- 	directory entries size = 0 ifFalse:[^self inform:'Directory must be empty' translated].
  	localDirName := directory localName.
  	(self confirm: ('Really delete {1}?' translated format: {localDirName})) ifFalse: [^ self].
  	self volumeListIndex: self volumeListIndex-1.
  	directory deleteDirectory: localDirName.
  	self updateFileList.!

Item was changed:
  ----- Method: FileList>>removeServer (in category 'server list') -----
  removeServer
  
  	| choice names |
  	self flag: #ViolateNonReferenceToOtherClasses.
+ 	names := ServerDirectory serverNames.
- 	names := ServerDirectory serverNames asSortedArray.
  	choice := UIManager default chooseFrom: names values: names.
  	choice == nil ifTrue: [^ self].
  	ServerDirectory removeServerNamed: choice!

Item was changed:
  ----- Method: InspectorBrowser>>msgList (in category 'messages') -----
  msgList
+ 
+ 	^msgList ifNil: [ msgList := object class selectors sort ]!
- 	msgList ifNotNil: [^ msgList].
- 	^ (msgList := object class selectors asSortedArray)!

Item was changed:
  ----- Method: MessageTrace>>getImplementorNamed: (in category 'private accessing') -----
  getImplementorNamed: selectorSymbol
  	 | allPossibilities |
  	allPossibilities := (((self selection compiledMethod messages 
  		select: [ :eachSelector | eachSelector beginsWith: selectorSymbol ])
  		copyWith: selectorSymbol)
+ 		select: [ :each | (Symbol lookup: each) notNil ])
+ 		asSet asOrderedCollection sort.
- 		select: [ :each | Symbol hasInterned: each ifTrue: [ :s | ] ])
- 		asSet asSortedCollection asOrderedCollection.
  	(allPossibilities includes: selectorSymbol) ifTrue:
  		[ allPossibilities addFirst: (allPossibilities remove: selectorSymbol) ].
  	^allPossibilities size > 1
  		ifTrue: 
  			[ | selectionIndex |
  			selectionIndex := (PopUpMenu labelArray: allPossibilities lines: #(1))
  				startUpWithCaption: 
  					'Browse implementors of
  					which message?'.
  			selectionIndex = 0 ifTrue: [ selectorSymbol ] ifFalse: [ allPossibilities at: selectionIndex ] ]
  		ifFalse: [ allPossibilities isEmpty
  			ifTrue: [ selectorSymbol ]
  			ifFalse: [ allPossibilities first ] ]
  !

Item was changed:
  ----- Method: StringHolder>>browseAllMessages (in category '*Tools') -----
  browseAllMessages
  	"Create and schedule a message set browser on all implementors of all the messages sent by the current method."
  
  	| aClass aName method filteredList |
  	(aName := self selectedMessageName) ifNotNil: [
  		method := (aClass := self selectedClassOrMetaClass) compiledMethodAt: aName.
  		filteredList := method messages reject: 
  			[:each | #(new initialize = ) includes: each].
+ 		self systemNavigation browseAllImplementorsOfList: filteredList sorted
- 		self systemNavigation browseAllImplementorsOfList: filteredList asSortedCollection
  			 title: 'All messages sent in ', aClass name, '.', aName]
  !

Item was changed:
  ----- Method: StringHolder>>browseUnusedMethods (in category '*Tools') -----
  browseUnusedMethods
  	| classes unsent messageList cls |
  	(cls := self selectedClass)
  		ifNil: [^ self].
  	classes := Array with: cls with: cls class.
  	unsent := Set new.
  	classes
  		do: [:c | unsent addAll: c selectors].
  	unsent := self systemNavigation allUnSentMessagesIn: unsent.
  	messageList := OrderedCollection new.
  	classes
  		do: [:c | (c selectors
+ 				select: [:s | unsent includes: s]) sort
- 				select: [:s | unsent includes: s]) asSortedCollection
  				do: [:sel | messageList add: c name , ' ' , sel]].
  	self systemNavigation browseMessageList: messageList name: 'Unsent Methods in ' , cls name!



More information about the Squeak-dev mailing list