"
 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)


    [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).
        ]
    ].
    (lastOldName asLowercase = lastNewName asLowercase) ifTrue:[
        (lastOldName first ~= lastNewName first) ifTrue:[
            (lastOldName first isLowercase = oldName first isLowercase) ifTrue:[
                "last rename was 
                    'xfoo' -> 'Xfoo'
                 then, a good default for
                    'xbar' would be 'Xbar'
                "
                lastOldName first isLowercase ifTrue:[
                    ^ oldName first asUppercase asString , (oldName copyFrom:2).
                ] ifFalse:[
                    ^ oldName first asLowercase asString , (oldName copyFrom:2).
                ]
            ]
        ].
    ].
    (lastOldName withoutSeparators = lastNewName) ifTrue:[
        "last rename was 
            '  foo   ' -> 'foo'
         then, a good default for
            '  bar   ' would be 'bar'
        "
        ^ oldName withoutSeparators.
    ].
    (lastNewName startsWith:lastOldName) ifTrue:[
        "last rename was 
            'foo' -> 'fooX'
         then, a good default for
            'bar' would be 'barX'
        "
        suffix := lastNewName copyLast:(lastNewSize - lastOldSize).
        ^ (oldName , suffix).
    ].
    (lastOldName startsWith:lastNewName) ifTrue:[
        "last rename was 
            'fooX' -> 'foo'
         then, a good default for
            'barX' would be 'bar'
        "
        suffix := lastOldName copyLast:(lastOldSize - lastNewSize).
        (oldName endsWith:suffix) ifTrue:[
            ^ (oldName copyWithoutLast:suffix size).
        ]
    ].

    prefix := lastOldName commonPrefixWith:lastNewName.
    suffix := lastOldName commonSuffixWith:lastNewName.

    (prefix size > 0) ifTrue:[
        (suffix size > 0) ifTrue:[

            prefix := prefix copyTo:(((lastNewName size - suffix size) min:(lastOldName size - suffix size)) min:prefix size).

            "last rename was 
                'fooR' -> 'fooXR'
             then, a good default for
                'barR' would be 'barXR'
            "
            left := lastOldName copyTo:prefix size.
            right := lastOldName copyLast:suffix size.
            lastNewSize > lastOldSize ifTrue:[
                inserted := (lastNewName copyFrom:(left size + 1)) copyWithoutLast:(right size).
                inserted size > 0 ifTrue:[
                    ^ (oldName copyTo:prefix size) , inserted , (oldName copyFrom:prefix size + 1) 
                ].
            ].
            (oldName endsWith:suffix) ifTrue:[
                deleted := (lastOldName copyFrom:(prefix size + 1)) copyWithoutLast:(suffix size).
                ((oldName copyFrom:oldName size-suffix size-deleted size + 1) copyTo:deleted size) = deleted ifTrue:[
                    "last rename was 
                        'fooXR' -> 'fooR'
                     then, a good default for
                        'barXS' would be 'barS'
                    "
                    ^ (oldName copyTo:oldName size-suffix size-deleted size) , suffix
                ]
            ]
        ].

        (oldName endsWith:(lastOldName copyFrom:prefix size+1)) ifTrue:[
            "last rename was 
                'fooX' -> 'fooY'
             then, a good default for
                'barX' would be 'barY'
            "
            left := oldName copyWithoutLast:(lastOldName copyFrom:prefix size+1) size.
            right := lastNewName copyFrom:prefix size+1.
            ^ left , right
        ] 
    ].

    ^ nil

    "
     self goodRenameDefaultFor:'bar' lastOld:'foo' lastNew:'fooXX'
     self goodRenameDefaultFor:'bar' lastOld:'foo' lastNew:'XXfoo'

     self goodRenameDefaultFor:'barXX' lastOld:'fooXX' lastNew:'foo' 
     self goodRenameDefaultFor:'XXbar' lastOld:'XXfoo' lastNew:'foo'

     self goodRenameDefaultFor:'barXX' lastOld:'fooXX' lastNew:'fooYY' 
     self goodRenameDefaultFor:'XXbar' lastOld:'XXfoo' lastNew:'foo'  

     self goodRenameDefaultFor:'bar2' lastOld:'foo1' lastNew:'foo01'  
     self goodRenameDefaultFor:'barXY' lastOld:'fooXY' lastNew:'fooY'
     self goodRenameDefaultFor:'bar' lastOld:'foo' lastNew:'fXoo'            
     self goodRenameDefaultFor:'bar' lastOld:'foo' lastNew:'fXXXoo'          
     self goodRenameDefaultFor:'bar' lastOld:'foo' lastNew:'foXXXo'  

     self goodRenameDefaultFor:'bar001' lastOld:'foo001' lastNew:'foo002_001'  
     self goodRenameDefaultFor:'CoastCore-CSFoo' lastOld:'CoastCore-CSBar' lastNew:'Coast-Core-CSBar'  
    "
!

goodRenameDefaultForFile:oldName lastOld:lastOldName lastNew:lastNewName
    "generate a reasonable default for a file rename operation.
     (Try to rename multiple files in the new fileBrowser, 
     to see what this is doing)"

    |prefix suffix t
     lastOldWOSuffix lastNewWOSuffix oldWOSuffix lastOldRest oldRest lastNewRest
     lastRemoved lastInserted default|

    default := self goodRenameDefaultFor:oldName lastOld:lastOldName lastNew:lastNewName.
    default notNil ifTrue:[ ^ default].

    lastOldWOSuffix := lastOldName asFilename withoutSuffix name.
    lastNewWOSuffix := lastNewName asFilename withoutSuffix name.
    oldWOSuffix := oldName asFilename withoutSuffix name.

    "/ suffix change ?
    lastOldWOSuffix = lastNewWOSuffix ifTrue:[
        lastOldName asFilename suffix ~= lastNewName asFilename suffix ifTrue:[
            ^ (oldName asFilename withSuffix:(lastNewName asFilename suffix)) pathName
        ].
    ].

    default := self goodRenameDefaultFor:oldWOSuffix lastOld:lastOldWOSuffix lastNew:lastNewWOSuffix.
    default notNil ifTrue:[ 
        lastOldRest := lastOldName copyFrom:lastOldWOSuffix size + 1.
        lastNewRest := lastNewName copyFrom:lastNewWOSuffix size + 1.
        oldRest := oldName copyFrom:oldWOSuffix size + 1.
        
        ^ default , lastNewRest
    ].

    prefix := lastOldWOSuffix commonPrefixWith:oldWOSuffix.
    (lastNewWOSuffix startsWith:prefix) ifTrue:[
        lastOldRest := lastOldWOSuffix copyFrom:prefix size + 1.
        lastNewRest := lastNewWOSuffix copyFrom:prefix size + 1.
        oldRest := oldWOSuffix copyFrom:prefix size + 1.

        (lastNewRest endsWith:lastOldRest) ifTrue:[
            t := lastNewRest copyWithoutLast:lastOldRest size.
            ^ ((prefix , t , oldRest) asFilename withSuffix:oldName asFilename suffix) name
        ].
    ].

    suffix := lastOldWOSuffix commonSuffixWith:lastNewWOSuffix.
    suffix size > 0 ifTrue:[
        "/ last change changed something at the beginning
        prefix := oldWOSuffix commonPrefixWith:lastOldWOSuffix.
        prefix size > 0 ifTrue:[
            "/ this name starts with the same characters
            lastRemoved := lastOldWOSuffix copyWithoutLast:suffix size.
            lastInserted := lastNewWOSuffix copyWithoutLast:suffix size.
            (lastRemoved startsWith:lastInserted) ifTrue:[
                oldWOSuffix size >= lastInserted size ifTrue:[
                    ^ (oldWOSuffix copyTo:lastInserted size) , (oldName copyFrom:lastRemoved size + 1)
                ]
            ].
            ^ lastInserted , (oldName copyFrom:lastRemoved size + 1)
        ].
    ].

    ^ nil
! !

!DoWhatIMeanSupport class methodsFor:'typing distance'!

isKey:k1 nextTo:k2
    "return true, if k1 and k2 are adjacent keys on the keybaord.
     CAVEAT: hard coded us-keyboard here."

    |keys|

    "/ for now: hardcoded US keyboard (should be language dependent)
    "/ (i.e. ask userPreferences ...)

    keys := #( 
               '1234567890-'
               '*qwertyuiop'
               '**asdfghjkl:'
               '***zxcvbnm' ).

    ^ self isKey:k1 nextTo:k2 onKeyboard:keys

    "
     self isKey:$a nextTo:$a 
     self isKey:$a nextTo:$s 
     self isKey:$a nextTo:$s 
     self isKey:$a nextTo:$q 
     self isKey:$a nextTo:$w 
     self isKey:$a nextTo:$z 
     self isKey:$a nextTo:$x 
    "
!

isKey:k1 nextTo:k2 onKeyboard:keys
    "return true, if k1 and k2 are adjacent keys on the keybaord.
     CAVEAT: hard coded us-keyboard here"

    |row1 row2 col1 col2|

    row1 := keys findFirst:[:row | row includes:k1].
    row1 == 0 ifTrue:[^ false].
    row2 := keys findFirst:[:row | row includes:k2].
    row2 == 0 ifTrue:[^ false].

    (row1-row2) abs <= 1 ifFalse:[^ false].

    col1 := (keys at:row1) indexOf:k1.
    col2 := (keys at:row2) indexOf:k2.

    ^ (col1-col2) abs <= 1

    "
     self isKey:$a nextTo:$x
    "
! !

!DoWhatIMeanSupport class methodsFor:'documentation'!

version
    ^ '$Header: /cvs/stx/stx/libwidg2/DoWhatIMeanSupport.st,v 1.15 2004-02-26 18:49:25 cg Exp $'
! !