The Trunk: ToolBuilder-Kernel-ul.39.mcz

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!