"

 COPYRIGHT (c) 2002 by eXept Software AG

              All Rights Reserved

 This software is furnished under a license and may be used

 only in accordance with the terms of that license and with the

 inclusion of the above copyright notice.   This software may not

 be provided or otherwise made available to, or used by, any

 other person.  No title to or ownership of the software is

 hereby transferred.

"

"{ Package: 'stx:libwidg2' }"

Object subclass:#DoWhatIMeanSupport

	instanceVariableNames:''

	classVariableNames:''

	poolDictionaries:''

	category:'System-Support'

!

!DoWhatIMeanSupport class methodsFor:'documentation'!

copyright

"

 COPYRIGHT (c) 2002 by eXept Software AG

              All Rights Reserved

 This software is furnished under a license and may be used

 only in accordance with the terms of that license and with the

 inclusion of the above copyright notice.   This software may not

 be provided or otherwise made available to, or used by, any

 other person.  No title to or ownership of the software is

 hereby transferred.

"

!

documentation

"

    misc collected UI support (functional)

    This used to be in the Smalltalk class; however, it is only needed

    for programmers. Therefore not needed for standalone executables.

    [author:]

        Claus Gittinger (cg@exept.de)

    [instance variables:]

    [class variables:]

    [see also:]

"

! !

!DoWhatIMeanSupport class methodsFor:'input completion support'!

classCategoryCompletion:aPartialCategory in:anEnvironment

    "given a partial class category name, return an array consisting of

     2 entries: 1st: the best (longest) match

                2nd: collection consisting of matching categories"

    |matches best lcName|

    matches := IdentitySet new.

    "/ search for exact match

    anEnvironment allClassesDo:[:aClass |

        |category|

        category := aClass category.

        (category notNil and:[category startsWith:aPartialCategory]) ifTrue:[

            matches add:category

        ]

    ].

    matches isEmpty ifTrue:[

        "/ search for case-ignoring match

        lcName := aPartialCategory asLowercase.

        anEnvironment allClassesDo:[:aClass |

            |category|

            category := aClass category.

            (category notNil and:[category asLowercase startsWith:lcName]) ifTrue:[

                matches add:category

            ].

        ].

    ].

    matches isEmpty ifTrue:[

        ^ Array with:aPartialCategory with:(Array with:aPartialCategory)

    ].

    matches size == 1 ifTrue:[

        ^ Array with:matches first with:(matches asArray)

    ].

    matches := matches asSortedCollection.

    best := matches longestCommonPrefix.

    ^ Array with:best with:matches asArray

    "

     Smalltalk classCategoryCompletion:'Sys'    

     Smalltalk classCategoryCompletion:'System'              

     Smalltalk classCategoryCompletion:'System-BinaryStorage' 

    "

!

classnameCompletion:aPartialClassName inEnvironment:anEnvironment

    "given a partial classname, return an array consisting of

     2 entries: 1st: the best (longest) match

                2nd: collection consisting of matching names"

    |searchName matches matchedNamesWithoutPrefix ignCaseMatches best isMatchString cls nsPrefix 

     others lcSearchName tryToMatch idx words w1 w2 rslt bestMatch|

    aPartialClassName isEmpty ifTrue:[

        ^ Array with:aPartialClassName with:#()

    ].

    (words := aPartialClassName asCollectionOfWords) size > 1 ifTrue:[

        w1 := words first.

        w2 := words second.

        rslt := self classnameCompletion:w1 inEnvironment:anEnvironment.

        bestMatch := rslt first.

        matches := rslt second.

        ('class' copyTo:w2 size) = w2 ifTrue:[

            matches := matches collect:[:m | m , ' class'].

            bestMatch := bestMatch , ' class'.

        ].

        ^ Array with:bestMatch with:matches

    ].

    (aPartialClassName startsWith:'Smalltalk::') ifTrue:[

        nsPrefix := 'Smalltalk::'.

        searchName := aPartialClassName copyFrom:'Smalltalk::' size + 1

    ] ifFalse:[

        nsPrefix := ''.

        searchName := aPartialClassName.

    ].

    (searchName at:1) isLowercase ifTrue:[

        searchName := searchName copy asUppercaseFirst

    ].

    lcSearchName := searchName asLowercase.

    isMatchString := searchName includesMatchCharacters.

    matches := OrderedCollection new.

    matchedNamesWithoutPrefix := Set new.

    ignCaseMatches := OrderedCollection new.

    others := OrderedCollection new.

    tryToMatch := [:className :fullClassName|

        |addIt lcClassName|

        isMatchString ifTrue:[

            addIt := searchName match:className

        ] ifFalse:[

            addIt := className startsWith:searchName.

        ].

        addIt ifTrue:[

            matches add:(nsPrefix , fullClassName).

            matchedNamesWithoutPrefix add:className.

        ] ifFalse:[

            "/ try ignoring case

            isMatchString ifTrue:[

                addIt := searchName match:className ignoreCase:true

            ] ifFalse:[

                lcClassName := className asLowercase.

                addIt := lcClassName startsWith:lcSearchName.

                addIt ifFalse:[

                    others add:className 

                ]

            ].

            addIt ifTrue:[

                ignCaseMatches add:(nsPrefix , fullClassName).

                matchedNamesWithoutPrefix add:className.

            ].

        ].

        addIt

    ].

    anEnvironment allClassesDo:[:aClass |

        |addIt fullClassName classNameWithoutPrefix|

        aClass isMeta ifFalse:[

            fullClassName := aClass name.

            classNameWithoutPrefix := aClass nameWithoutPrefix.

            addIt := tryToMatch value:fullClassName value:fullClassName.

            addIt ifFalse:[

                classNameWithoutPrefix ~~ fullClassName ifTrue:[

                    tryToMatch value:classNameWithoutPrefix value:fullClassName.

                ].

            ].

        ]

    ].

    matches isEmpty ifTrue:[

        matches := ignCaseMatches

    ].

"/    matches isEmpty ifTrue:[

"/        | nearBy |

"/        nearBy := SortedCollection new sortBlock:[:a :b | a key < b key].

"/        others do:[:className |

"/            |lcClassName dist cmpName|

"/

"/            lcClassName := className asLowercase.

"/            dist := lcClassName levenshteinTo:lcSearchName s:9 k:1 c:0 i:9 d:2.

"/

"/            cmpName := lcClassName copyTo:(lcSearchName size min:lcClassName size).

"/            dist := dist min:(cmpName levenshteinTo:lcSearchName s:9 k:1 c:0 i:9 d:2).

"/            cmpName := lcClassName copyTo:(lcSearchName size + 1 min:lcClassName size).

"/            dist := dist min:(cmpName levenshteinTo:lcSearchName s:9 k:1 c:0 i:9 d:2).

"/            dist < 4 ifTrue:[

"/                nearBy add:( dist -> (nsPrefix , className) ).

"/            ]

"/        ].

"/        matches := nearBy collect:[:eachPair | eachPair value].

"/    ].

    matches isEmpty ifTrue:[

        ^ Array with:searchName with:(Array with:searchName)

    ].

    matches size == 1 ifTrue:[

        best := matches first.

        ^ Array with:best with:(matches asArray)

    ].

    matches 

        sort:[:name1 :name2 |

            "name1 comes before:name2 iff"

            ((name2 includes:$:) and:[(name1 includes:$:) not])

            or:[ ((name1 includes:$:) == (name2 includes:$:))

                  and:[ (name1 size < name2 size) 

                        or: [ name1 < name2 ]]

               ]

        ].

    isMatchString ifTrue:[

        best := searchName.

    ] ifFalse:[

        best := matches longestCommonPrefix.

        best size == 0 ifTrue:[

            best := matchedNamesWithoutPrefix longestCommonPrefix.

        ].

        best size == 0 ifTrue:[

            "if tried again, return next match"

            idx := ((matches indexOf:aPartialClassName) + 1) \\ matches size.

            idx ~~ 1 ifTrue:[

                ^ Array with:(matches at:idx) with:(matches asArray)

            ].

        ].

        best size < aPartialClassName size ifTrue:[

            best := aPartialClassName.

        ].

    ].

    cls := anEnvironment classNamed:best.

    (cls isBehavior and:[cls isNameSpace]) ifTrue:[

        (matches conform:[:each | each = best

                                 or:[each startsWith:(best , '::')]])

        ifTrue:[

            best := best , '::'

        ].

    ].

    ^ Array with:best with:matches asArray

    "

     Smalltalk classnameCompletion:'Arr' 

     Smalltalk classnameCompletion:'Arra' 

     Smalltalk classnameCompletion:'arra' 

     Smalltalk classnameCompletion:'*rray' 

    "

    "Created: 24.11.1995 / 17:24:45 / cg"

    "Modified: 3.4.1997 / 18:25:01 / cg"

!

globalNameCompletion:aPartialGlobalName in:anEnvironment

    "given a partial globalName, return an array consisting of

     2 entries: 1st: the best (longest) match

                2nd: collection consisting of matching names"

    |searchName matches ignCaseMatches best isMatchString|

    searchName := aPartialGlobalName.

    searchName isEmpty ifTrue:[

        ^ Array with:searchName with:#()

    ].

    (searchName at:1) isLowercase ifTrue:[

        searchName := searchName copy asUppercaseFirst

    ].

    isMatchString := searchName includesMatchCharacters.

    matches := OrderedCollection new.

    ignCaseMatches := OrderedCollection new.

    anEnvironment keysDo:[:aGlobalName |

        | addIt|

        isMatchString ifTrue:[

            addIt := searchName match:aGlobalName

        ] ifFalse:[

            addIt := aGlobalName startsWith:searchName

        ].

        addIt ifTrue:[

            matches add:aGlobalName

        ] ifFalse:[

            "/ try ignoring case

            isMatchString ifTrue:[

                addIt := searchName match:aGlobalName ignoreCase:true

            ] ifFalse:[

                addIt := aGlobalName asLowercase startsWith:searchName asLowercase

            ].

            addIt ifTrue:[

                ignCaseMatches add:aGlobalName

            ]

        ]

    ].

    matches isEmpty ifTrue:[

        matches := ignCaseMatches

    ].

    matches isEmpty ifTrue:[

        ^ Array with:searchName with:(Array with:searchName)

    ].

    matches size == 1 ifTrue:[

        ^ Array with:matches first with:(matches asArray)

    ].

    matches := matches asSortedCollection.

    isMatchString ifTrue:[

        best := searchName.

    ] ifFalse:[

        best := matches longestCommonPrefix.

    ].

    ^ Array with:best with:matches asArray

    "

     Smalltalk globalnameCompletion:'Arr' 

     Smalltalk globalnameCompletion:'Arra' 

     Smalltalk globalnameCompletion:'arra' 

     Smalltalk globalnameCompletion:'*rray' 

    "

    "Created: 24.11.1995 / 17:24:45 / cg"

    "Modified: 3.4.1997 / 18:25:01 / cg"

!

methodProtocolCompletion:aPartialProtocolName in:anEnvironment

    "given a partial method protocol name, return an array consisting of

     2 entries: 1st: the best (longest) match 

                2nd: collection consisting of matching protocols"

    |matches best lcName|

    matches := IdentitySet new.

    "/ search for exact match

    anEnvironment allClassesDo:[:aClass |

        aClass instAndClassSelectorsAndMethodsDo:[:aSelector :aMethod |

            |protocol|

            protocol := aMethod category.

            (protocol notNil and:[protocol startsWith:aPartialProtocolName]) ifTrue:[

                matches add:protocol

            ]

        ].

    ].

    matches isEmpty ifTrue:[

        "/ search for case-ignoring match

        lcName := aPartialProtocolName asLowercase.

        anEnvironment allClassesDo:[:aClass |

            aClass instAndClassSelectorsAndMethodsDo:[:aSelector :aMethod |

                |protocol|

                protocol := aMethod category.

                (protocol asLowercase startsWith:lcName) ifTrue:[

                    matches add:protocol

                ]

            ].

        ].

    ].

    matches isEmpty ifTrue:[

        ^ Array with:aPartialProtocolName with:(Array with:aPartialProtocolName)

    ].

    matches size == 1 ifTrue:[

        ^ Array with:matches first with:(matches asArray)

    ].

    matches := matches asSortedCollection.

    best := matches longestCommonPrefix.

    ^ Array with:best with:matches asArray

    "

     Smalltalk methodProtocolCompletion:'doc'

     Smalltalk methodProtocolCompletion:'docu' 

     Smalltalk methodProtocolCompletion:'documenta' 

    "

!

selectorCompletion:aPartialSymbolName inEnvironment:anEnvironment

    "given a partial selector, return an array consisting of

     2 entries: 1st: the longest match

                2nd: collection consisting of matching implemented selectors"

    |matches best lcSym|

    matches := IdentitySet new.

    "/ search for exact match

    anEnvironment allClassesDo:[:aClass |

        aClass instAndClassSelectorsAndMethodsDo:[:aSelector :aMethod |

            (aSelector startsWith:aPartialSymbolName) ifTrue:[

                matches add:aSelector

            ]

        ].

    ].

    matches isEmpty ifTrue:[

        "/ search for case-ignoring match

        lcSym := aPartialSymbolName asLowercase.

        anEnvironment allClassesDo:[:aClass |

            aClass instAndClassSelectorsAndMethodsDo:[:aSelector :aMethod |

                (aSelector asLowercase startsWith:lcSym) ifTrue:[

                    matches add:aSelector

                ]

            ].

        ].

    ].

    matches isEmpty ifTrue:[

        ^ Array with:aPartialSymbolName with:(Array with:aPartialSymbolName)

    ].

    matches size == 1 ifTrue:[

        ^ Array with:matches first with:(matches asArray)

    ].

    matches := matches asSortedCollection.

    best := matches longestCommonPrefix.

    ^ Array with:best with:matches asArray

    "

     Smalltalk selectorCompletion:'at:p'  

     Smalltalk selectorCompletion:'nextP' 

     Smalltalk selectorCompletion:'nextp' 

    "

    "Modified: / 7.6.1996 / 08:44:33 / stefan"

    "Modified: / 14.6.1998 / 15:54:03 / cg"

! !

!DoWhatIMeanSupport class methodsFor:'rename support'!

goodRenameDefaultFor:oldName lastOld:lastOldName lastNew:lastNewName

    "generate a reasonable default for a rename operation.

     (used for rename category etc.)"

    |prefix suffix lastNewSize lastOldSize left right inserted deleted|

    lastNewName isNil ifTrue:[ ^ nil].

    lastNewSize := lastNewName size.

    lastOldSize := lastOldName size.

    (lastNewName endsWith:lastOldName) ifTrue:[

        "last rename was 

            'foo' -> 'Xfoo'

         then, a good default for

            'bar' would be 'Xbar'

        "

        prefix := lastNewName copyTo:(lastNewSize - lastOldSize).

        ^ (prefix , oldName).

    ].

    (lastOldName endsWith:lastNewName) ifTrue:[

        "last rename was 

            'Xfoo' -> 'foo'

         then, a good default for

            'Xbar' would be 'bar'

        "

        prefix := lastOldName copyTo:(lastOldSize - lastNewSize).

        (oldName startsWith:prefix) ifTrue:[

            ^ (oldName copyFrom:prefix size+1).