[Pkg] The Trunk: ToolBuilder-Kernel-ul.39.mcz

[commits at source.squeak.org]

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

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

Name: ToolBuilder-Kernel-ul.39
Author: ul
Time: 12 December 2010, 11:18:16.463 pm
UUID: 68b3bc0b-91c7-8e4c-8ad1-1f9a1ae18f3a
Ancestors: ToolBuilder-Kernel-ar.38

- added UIManager >> #chooseClassOrTrait:from: as a common way to select a class or trait from an environment (SystemDictionary)

=============== Diff against ToolBuilder-Kernel-ar.38 ===============

Item was added:
+ ----- Method: UIManager>>chooseClassOrTrait (in category 'ui requests') -----
+ chooseClassOrTrait
+ 	"Let the user choose a Class or Trait"
+ 	
+ 	^self chooseClassOrTrait: 'Class name or fragment?'!

Item was added:
+ ----- Method: UIManager>>chooseClassOrTrait: (in category 'ui requests') -----
+ chooseClassOrTrait: label
+ 	"Let the user choose a Class or Trait"
+ 	
+ 	^self chooseClassOrTrait: label from: Smalltalk environment!

Item was added:
+ ----- Method: UIManager>>chooseClassOrTrait:from: (in category 'ui requests') -----
+ chooseClassOrTrait: label from: environment
+ 	"Let the user choose a Class or Trait."
+ 	
+ 	| pattern |
+ 	pattern := self request: label.
+ 	^Utilities classOrTraitFrom: environment pattern: pattern label: label
+ 	!

Item was added:
+ ----- Method: Utilities class>>classFromPattern:withCaption: (in category '*ToolBuilder-Kernel') -----
+ classFromPattern: pattern withCaption: aCaption
+ 	"If there is a class or trait whose name exactly given by pattern, return it.
+ 	If there is only one class or trait in the system whose name matches pattern, return it.
+ 	Otherwise, put up a menu offering the names of all classes that match pattern, and return the class chosen, else nil if nothing chosen.
+ 	This method ignores separator characters in the pattern"
+ 
+ 	^self classOrTraitFrom: Smalltalk environment pattern: pattern label: aCaption
+ "
+ 	self classFromPattern: 'CharRecog' withCaption: ''
+ 	self classFromPattern: 'rRecog' withCaption: ''
+ 	self classFromPattern: 'znak' withCaption: ''
+ 	self classFromPattern: 'orph' withCaption: ''
+ 	self classFromPattern: 'TCompil' withCaption: ''
+ "
+ !

Item was added:
+ ----- Method: Utilities class>>classOrTraitFrom:pattern:label: (in category '*ToolBuilder-Kernel') -----
+ classOrTraitFrom: environment pattern: pattern label: label
+ 	"If there is a class or trait whose name exactly given by pattern, return it.
+ 	If there is only one class or trait in the given environment whose name matches pattern, return it.
+ 	Otherwise, put up a menu offering the names of all classes that match pattern, and return the class chosen, else nil if nothing chosen.
+ 	This method ignores separator characters in the pattern"
+ 	
+ 	| toMatch potentialNames names exactMatch lines reducedIdentifiers selectedIndex |
+ 	toMatch := pattern copyWithoutAll: Character separators.
+ 	toMatch ifEmpty: [ ^nil ].
+ 	"If there's a class or trait named as pattern, then return it."
+ 	Symbol hasInterned: pattern ifTrue: [ :symbol |
+ 		environment at: symbol ifPresent: [ :maybeClassOrTrait |
+ 			((maybeClassOrTrait isKindOf: Class) or: [
+ 				maybeClassOrTrait isTrait ])
+ 					ifTrue: [ ^maybeClassOrTrait ] ] ].
+ 	"No exact match, look for potential matches."
+ 	toMatch := pattern asLowercase copyWithout: $..
+ 	potentialNames := environment classAndTraitNames.
+ 	names := pattern last = $. "This is some old hack, using String>>#match: may be better."
+ 		ifTrue: [ potentialNames select: [ :each | each asLowercase = toMatch ] ]
+ 		ifFalse: [
+ 			potentialNames select: [ :each |
+ 				each includesSubstring: toMatch caseSensitive: false ] ].
+ 	exactMatch := names detect: [ :each | each asLowercase = toMatch ] ifNone: [ nil ].
+ 	lines := OrderedCollection new.
+ 	exactMatch ifNotNil: [ lines add: 1 ].
+ 	"Also try some fuzzy matching."
+ 	reducedIdentifiers := pattern suggestedTypeNames select: [ :each |
+ 		potentialNames includes: each ].
+ 	reducedIdentifiers ifNotEmpty: [
+ 		names addAll: reducedIdentifiers.
+ 		lines add: 1 + names size + reducedIdentifiers size ].
+ 	"Let the user select if there's more than one possible match. This may give surprising results."
+ 	selectedIndex := names size = 1
+ 		ifTrue: [ 1 ]
+ 		ifFalse: [
+ 			exactMatch ifNotNil: [ names addFirst: exactMatch ].
+ 			UIManager default chooseFrom: names lines: lines title: label ].
+ 	selectedIndex = 0 ifTrue: [ ^nil ].
+ 	^environment at: (names at: selectedIndex) asSymbol!