[squeak-dev] The Trunk: ToolBuilder-Kernel-mt.125.mcz

Kjell Godo squeaklist at gmail.com
Mon Jul 15 14:59:05 UTC 2019


[_]— or how about


potentialNames select:[ :eachName | | first stillAMatch | first :=
stillAMatch := true .
  pattern inject:( 1 )into:[ :i :p |
    (( stillAMatch ifTrue:[
       ( eachName indexOfSubCollection:( p asString )startingAt: i
        )yourselfAfter:[ :i1 | stillAMatch := first ifTrue:[i =
i1]ifFalse:[i<i1] . first := false ]
       ifFalse:[ 0 ] ]
    ) ~= 0
    ) && stillAMatch
   ]

On Mon, Jul 15, 2019 at 06:55 Kjell Godo <squeaklist at gmail.com> wrote:

>
>
> On Mon, Jul 15, 2019 at 00:18 <commits at source.squeak.org> wrote:
>
>> Marcel Taeumel uploaded a new version of ToolBuilder-Kernel to project
>> The Trunk:
>> http://source.squeak.org/trunk/ToolBuilder-Kernel-mt.125.mcz
>>
>> ==================== Summary ====================
>>
>> Name: ToolBuilder-Kernel-mt.125
>> Author: mt
>> Time: 11 July 2019, 8:50:30.487838 am
>> UUID: 3f3a21f8-a141-734f-8aed-f0c21aff22b9
>> Ancestors: ToolBuilder-Kernel-mt.124
>>
>> Updates the search for class names using the new find-features feature on
>> strings. Find WeakIdentityKeyDictionary (in a small list of results) with
>> any of the following patterns:
>>
>> WKD
>> Weak*Dict*
>> WeakDict
>> WeakIdentityKeyDictionary
>>
>> =============== Diff against ToolBuilder-Kernel-mt.124 ===============
>>
>> Item was changed:
>>   ----- Method: UIManager>>classOrTraitFrom:pattern:label: (in category
>> 'system introspecting') -----
>>   classOrTraitFrom: environment pattern: pattern label: label
>> +       "Given a pattern and an environment, try to find a class or trait
>> using several strategies:
>> +               - EXACT: If there is a class or trait whose name exactly
>> given by pattern, return it.
>> +               - UPPER: If the pattern is upper-case only, find
>> camel-case letters with that sequence.
>> +               - WILD: Try the pattern as-is for regular wild-card
>> search.
>> +               - FEATURE: Split patterns at feature boundaries and
>> insert wild cards between.
>> +               - FUZZY: Split patterns at feature boundaries BUT treat
>> each feature as a full class name.
>> +       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.
>> -       "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"
>>
>> +       !!!! In any case, separator characters in the pattern are
>> ignored."
>> +
>> +       | toMatch potentialNames names selectedIndex |
>> +
>> +       "If there's a class or trait named as pattern, then return it."
>> +       (environment classOrTraitNamed: pattern) ifNotNil: [:classOrTrait
>> | ^ classOrTrait].
>> +
>> +       "Validate pattern."
>> -       | toMatch potentialNames names exactMatch lines
>> reducedIdentifiers selectedIndex |
>>         toMatch := pattern copyWithoutAll: Character separators.
>> +       toMatch := toMatch asLowercase copyWithout: $..
>>         toMatch ifEmpty: [ ^nil ].
>> +
>> +       "Fetch search space."
>> +       names := OrderedCollection new.
>> +       potentialNames := environment classAndTraitNames
>> asOrderedCollection.
>> +
>> +       "Try uppercase-only patterns for patterns such as 'WKD' to find
>> 'WeakIdentityKeyDictionary' etc."
>> +       names ifEmpty: [
>> +               (pattern allSatisfy: [:char | char isUppercase]) ifTrue: [
>> +                       potentialNames do: [:each |
>> +                               | patternStream |
>>
> +                               patternStream := pattern readStream.<—-[
>> [_]— you don’t
>
>
>
> really need to recreate this same patternStream for each [ :each ... ] do
> you ? ]
>
>>
>>
>
>> +                               each detect: [:char |
>> +                                       (patternStream atEnd not and:
>> [patternStream peek = char])
>> +                                               ifTrue: [
>> +                                                       patternStream
>> next.
>> +                                                       patternStream
>> atEnd
>> +                                                               ifTrue:
>> [names add: each. true "Match!!"]
>> +                                                               ifFalse:
>> [false "Not yet..."]]
>> +                                               ifFalse: [false "No
>> match..."] ] ifNone: [] ] ]].
>
>
> <——————-—-[ [_]— using KEGGenerators maybe it could be done like
>  [ | last eNGen |
>  ( pattern asCharacters lastDo:[ :p | last := true . p ] )ifNotNil:[
> :patternGen |
>       potentialNames select:[ :eachName | last := false .
>             ( patternGen shuffle:[ :p :c | (p=c)yourselfDo:[ :b | b
> ifTrue:[ eNGen next ] . last := b&&last ] ]
>                                    with:( eNGen := eachName asGenerator )
>                ) iterate . last
>             ]
>       ]”<——-[ [x]— >>lastDo: evaluates its input on last element p of
> pattern
>                       [x]— >>shuffle:with: does (p=c)<=>( patternGen next
> ) i think
>                       [x]— >>yourselfDo: returns its receiver r after
> doing( aBlock value:r )
>                       [_]— String>>asCharacters = String>>asCharacter<—-[
> is part
>                                of the singular is plural idea of you don’t
> have to separate
>                                singular from plural with KEGGenerators
> just do( obj asGen ) ] ]”
> ] value .”<—-[ [_]— move local vars last & eNGen up and delete this
> >>value ]”
>
> or
>
>  [ | last eNGen |
>  (
>  ( pattern asCharacters lastDo:[ :p | last := true . p ]
>  ) shuffle:[ :p :c | (p=c)yourselfDo:[ :b | b ifTrue:[ eNGen next ].
> last:=b&&last ] ] ]
>     with:( eNGen := KEGGenerator streamGenerator )
>  )ifNotNil:[ :shuffleGen |
>       potentialNames select:[ :eachName | last := false .
> eNGen genOn:eacName .
>             shuffleGen iterate . last
>             ]
>       ]”<——-[ [_]— this actually does not reAllocate any ..Generator in
> the loop ]”
> ] value .”<—-[ untested . not looked up . unpublished >>genOn: = >>on: i
> think ]”
>
>
>> +
>> +       "Try wildcard search for patterns such as 'Weak*Dict*' to find
>> 'WeakIdentityKeyDictionary' etc."
>> +       names ifEmpty: [
>> +               names := potentialNames select: [ :each | toMatch match:
>> each ]].
>> -       "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)
>> asOrderedCollection.
>> -       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."
>> -       names size = 0 ifTrue: [^ nil "nothing matches"].
>>
>> +       "Try feature-based search for patterns such as 'WeakDict' to find
>> 'WeakIdentityKeyDictionary' etc."
>> +       names ifEmpty: [
>> +               toMatch := pattern copyWithoutAll: '.*#'.
>> +               toMatch findFeatures in: [:features |
>> +                       "1) Insert wildcards between features and at the
>> end."
>> +                       toMatch := (features joinSeparatedBy: '*'), '*'.
>> +                       names := potentialNames select: [ :each | toMatch
>> match: each ].
>> +                       names ifEmpty: [
>> +                               "2) Insert wildcards before, between, and
>> after features."
>> +                               toMatch := '*', (features
>> joinSeparatedBy: '*'), '*'.
>> +                               names := potentialNames select: [ :each |
>> toMatch match: each ] ]] ].
>> +
>> +       "Try some fuzzy matching."
>> +       names addAll: (pattern suggestedTypeNames select: [ :each |
>> potentialNames includes: each ]).
>> +
>> +       "Still no match?"
>> +       names ifEmpty: [ ^ nil ].
>> +
>> +       "Let the user select if there's more than one possible match.
>> This may give surprising results."
>>         selectedIndex := names size = 1
>>                 ifTrue: [ 1 ]
>> +               ifFalse: [ self chooseFrom: names title: label ].
>> -               ifFalse: [
>> -                       exactMatch ifNotNil: [ names addFirst: exactMatch
>> ].
>> -                       self chooseFrom: names lines: lines title: label
>> ].
>>         selectedIndex = 0 ifTrue: [ ^nil ].
>>         ^environment at: (names at: selectedIndex) asSymbol!
>>
>>
>>
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://lists.squeakfoundation.org/pipermail/squeak-dev/attachments/20190715/767fb07a/attachment.html>


More information about the Squeak-dev mailing list