"

 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

	classVariableNames:'LastSource LastParseTree LastScanTokens LastChoices'

	poolDictionaries:''

	category:'System-Support'

!

Array variableSubclass:#InputCompletionResult

	instanceVariableNames:''

	classVariableNames:''

	poolDictionaries:''

	privateIn:DoWhatIMeanSupport

!

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

    These used to be in the Smalltalk and SystemBrowser class; 

    however, they are only needed for programmers, and some of the stuff is useful in multiple

    places. 

    Therefore it is:

        1) not needed for standalone executables

        2) published here to avoid multiple implementations

    [author:]

        Claus Gittinger (cg@exept.de)

"

! !

!DoWhatIMeanSupport class methodsFor:'code completion'!

codeCompletionForClass:classOrNil codeView:codeView

    self codeCompletionForClass:classOrNil context:nil codeView:codeView

    "Modified (format): / 03-07-2011 / 15:49:49 / cg"

!

codeCompletionForClass:classOrNil context:contextOrNil codeView:codeView

    "contextOrNil is the current context, if this is called from the debugger;

     nil, if called from the browser.

     If nonNil, we can make better guesses, because we actually know what a variable's type is.

     This is not yet done, sigh"

    ^ self new 

        codeCompletionForClass:classOrNil context:contextOrNil codeView:codeView

!

codeCompletionForMethod:methodOrNil orClass:classOrNil context:contextOrNil codeView:codeView into:actionBlock

    "contextOrNil is the current context, if this is called from the debugger;

     nil, if called from the browser.

     If nonNil, we can make better guesses, because we actually know what a variable's type is.

     This is not yet done, sigh"

    ^ self new

        codeCompletionForMethod:methodOrNil orClass:classOrNil 

        context:contextOrNil 

        codeView:codeView into:actionBlock

! !

!DoWhatIMeanSupport class methodsFor:'code completion-helpers'!

findNodeForInterval:interval in:source

    ^ self new findNodeForInterval:interval in:source

!

findNodeForInterval:interval in:source allowErrors:allowErrors

    ^ self new findNodeForInterval:interval in:source allowErrors:allowErrors

!

findNodeForInterval:interval in:source allowErrors:allowErrors mustBeMethod:mustBeMethod

    "if mustBeMethod is true, do not try a regular expression (as in a workspace)."

    ^ self new

        findNodeForInterval:interval in:source allowErrors:allowErrors mustBeMethod:mustBeMethod

!

findNodeForInterval:interval inParseTree:parseTree

    ^ self new findNodeForInterval:interval inParseTree:parseTree

!

findNodeIn:tree forInterval:interval

    ^ self new findNodeIn:tree forInterval:interval

! !

!DoWhatIMeanSupport class methodsFor:'input completion support'!

classCategoryCompletion:aPartialCategory inEnvironment: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' 

    "

    "Created: / 10-08-2006 / 13:06:45 / cg"

!

classNameEntryCompletionBlock

    "this block can be used in a dialog to perform className completion"

    ^ self entryCompletionBlockFor:#'classnameCompletion:inEnvironment:'

    "Modified: / 10-08-2006 / 13:22:02 / cg"

!

classnameCompletion:aPartialClassName filter:filterBlock 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 matchesForLongestPrefix|

    aPartialClassName isEmpty ifTrue:[

        matches := Smalltalk allClassesForWhich:filterBlock.

        ^ InputCompletionResult bestName:aPartialClassName matchingNames:#()

    ].

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

        w1 := words first.

        w2 := words second.

        rslt := self classnameCompletion:w1 filter:filterBlock inEnvironment:anEnvironment.

        bestMatch := rslt first.

        matches := rslt second.

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

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

            bestMatch := bestMatch , ' class'.

        ].

        ^ InputCompletionResult bestName:bestMatch matchingNames:matches

    ].

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

        nsPrefix := 'Smalltalk::'.

        searchName := aPartialClassName withoutPrefix:'Smalltalk::'

    ] ifFalse:[

        nsPrefix := ''.

        searchName := aPartialClassName.

    ].

    searchName := searchName asUppercaseFirst.

    lcSearchName := searchName asLowercase.

    isMatchString := searchName includesMatchCharacters.

    matches := OrderedCollection new.

    matchedNamesWithoutPrefix := Set new.

    ignCaseMatches := OrderedCollection new.

    others := OrderedCollection new.

    tryToMatch := 

        [:className :fullClassName|

            |addIt|

"/ (className startsWith:'JavaScript') ifTrue:[self halt].

            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:[

                    addIt := className asLowercase startsWith:lcSearchName.

                    addIt ifFalse:[

                        others add:className 

                    ]

                ].

                addIt ifTrue:[

                    ignCaseMatches add:(nsPrefix , fullClassName).

                    matchedNamesWithoutPrefix add:className.

                ].

            ].

            addIt

        ].

    anEnvironment allClassesForWhich:filterBlock do:[: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 := matches , ignCaseMatches.

"/    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:[

        ^ InputCompletionResult bestName:searchName matchingNames:(Array with:searchName)

    ].                           

    matches size == 1 ifTrue:[

        best := matches first.

        ^ InputCompletionResult bestName:best matchingNames:(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:[

        matchesForLongestPrefix := matches select:[:m | m asLowercase startsWith:lcSearchName].

        best := ignCaseMatches isEmpty

                    ifTrue:[ matchesForLongestPrefix longestCommonPrefix ]

                    ifFalse:[ matchesForLongestPrefix longestCommonPrefixIgnoreCase:true ].

        best size < aPartialClassName size "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:[

                ^ InputCompletionResult bestName:(matches at:idx) matchingNames:(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 , '::'

        ].

    ].

    ^ InputCompletionResult bestName:best matchingNames:matches asArray

    "

     Smalltalk classnameCompletion:'Arr'    

     Smalltalk classnameCompletion:'Arra' 

     Smalltalk classnameCompletion:'arra'  

     Smalltalk classnameCompletion:'*rray' 

    "

    "Created: / 10-08-2006 / 13:01:08 / cg"

!

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"

    ^ self

        classnameCompletion:aPartialClassName 

        filter:[:cls | true] 

        inEnvironment:anEnvironment

    "

     self classnameCompletion:'Arr'   inEnvironment:Smalltalk

     self classnameCompletion:'Arra'  inEnvironment:Smalltalk

     self classnameCompletion:'arra'  inEnvironment:Smalltalk

     self classnameCompletion:'*rray' inEnvironment:Smalltalk

    "

    "Created: / 24-11-1995 / 17:24:45 / cg"

    "Modified: / 10-08-2006 / 13:01:30 / cg"

!

entryCompletionBlockFor:completionSelector

    "this block can be used in a dialog to perform className completion"

    ^ [:contents :field  |

          |s what m|

          s := contents withoutSpaces.

          field topView withCursor:(Cursor questionMark) do:[  

              what := self perform:completionSelector with:s with:Smalltalk.

          ].

          field contents:(what first).

          (what at:2) size ~~ 1 ifTrue:[

              UserPreferences current beepInEditor ifTrue:[                

                field device beep

              ]

          ]

      ].

    "Created: / 10-08-2006 / 13:21:37 / cg"

!

globalNameCompletion:aPartialGlobalName inEnvironment:anEnvironment

    "given a partial globalName, return an array consisting of

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

                2nd: collection consisting of matching names"

    ^ self globalNameCompletion:aPartialGlobalName inEnvironment:anEnvironment match:true

    "

     Smalltalk globalnameCompletion:'Arr' 

     Smalltalk globalnameCompletion:'Arra' 

     Smalltalk globalnameCompletion:'arra' 

     Smalltalk globalnameCompletion:'*rray' 

    "

    "Created: / 10-08-2006 / 13:06:23 / cg"

!

globalNameCompletion:aPartialGlobalName inEnvironment:anEnvironment match:doMatch

    "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 := doMatch and:[ 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: / 10-08-2006 / 13:06:23 / cg"

!