Status: Accepted Owner: stephane...@gmail.com New issue 3549 by stephane...@gmail.com: 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!