Status: Accepted
Owner: [email protected]
New issue 3549 by [email protected]: ChooseClassOrTrait
http://code.google.com/p/pharo/issues/detail?id=3549
==================== 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!
