"{ Encoding: utf8 }"

"

 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' }"

"{ NameSpace: Smalltalk }"

Object subclass:#DoWhatIMeanSupport

	instanceVariableNames:'tree tokens languageOrNil classOrNil methodOrNil contextOrNil

		instanceOrNil codeView rememberedScopeNodes rememberedNodes

		codeAspect partialString partialStringInterval'

	classVariableNames:'LastSource LastParseTree LastScanTokens LastChoices

		LastCompletedSelectors Verbose'

	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

"

    Attention: this is currently being rewritten and refactored.

    Don't get mad at the ugly (and duplicate) code.

    Will cleanup when finished.

    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:'cleanup'!

lowSpaceCleanup

    LastSource := LastParseTree := LastScanTokens := nil.

    "Created: / 01-08-2018 / 22:31:39 / Claus Gittinger"

! !

!DoWhatIMeanSupport class methodsFor:'code completion'!

codeCompletionFor: aspect language: languageOrNil method:methodOrNil orClass:classOrNil context:contextOrNil codeView:codeView into:actionBlock

    "aspect is so-called code-aspect symbol saying what's edited - #method, #expression, #classDefinition...

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

    ^ self new

        codeCompletionFor: aspect

        language: languageOrNil

        method:methodOrNil orClass:classOrNil

        context:contextOrNil

        codeView:codeView into:actionBlock

    "Created: / 27-09-2013 / 10:19:29 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

codeCompletionForLanguage: languageOrNil class: 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."

    ^ self new

        codeCompletionForLanguage: languageOrNil 

        class:classOrNil 

        context:contextOrNil 

        codeView:codeView

    "Created: / 18-09-2013 / 13:34:21 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

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

codeCompletionForClass:classOrNil context:contextOrNil codeView:codeView

    <resource: #obsolete>

    "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

	codeCompletionForLanguage: nil class:classOrNil context:contextOrNil codeView:codeView

    "Modified: / 18-09-2013 / 13:34:57 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

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

    <resource: #obsolete>

    "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

    "utility"

    |tree node remember|

    interval isEmpty ifTrue: [^ nil].

    RBParser isNil ifTrue: [^ nil].

    source = LastSource ifTrue:[

        tree := LastParseTree.

    ] ifFalse:[

        remember := true.    

        LastSource := LastParseTree := nil.

        tree := RBParser

                parseMethod:source

                onError:

                    [:str :err ":nodesSoFar" |

                        "/ Transcript showCR:'Parse-Error: ',str.

                        nil

                    ].

        tree isNil ifTrue:[

            "/ try to parse as an expression

            tree := RBParser

                    parseExpression:source

                    onError:

                        [:str :err ":nodesSoFar" |

                            "Transcript showCR:'Parse-Error: ',str."

                            nil

                        ].

            tree isNil ifTrue:[

                "/ try to parse the selected text alone as expression

                remember := false.    

                tree := RBParser

                    parseExpression:(source copyFrom:interval start to:(interval stop min:source size))

                    onError:

                        [:str :err ":nodesSoFar" |

                            "Transcript showCR:'Parse-Error: ',str."

                            nil

                        ].         

                ^ tree

            ].

        ].

        remember ifTrue:[ 

            LastSource := source.

            LastParseTree := tree.

        ].

    ].

    Error handle:[:ex |

    ] do:[ 

        node := tree whichNodeIsContainedBy:interval.

    ].

    node isNil ifTrue: [

        node := tree bestNodeFor: interval.

        node isNil ifTrue: [

            node := self findNodeIn:tree forInterval:interval

        ].

    ].

    ^ node

    "Modified: / 06-07-2011 / 12:42:53 / cg"

!

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:aTree forInterval:anInterval

    "utility"

    |nodeFound wouldReturn|

    anInterval isEmpty ifTrue:[^nil].

    nodeFound := nil.

    aTree nodesDo:[:eachNode |

        (eachNode intersectsInterval:anInterval) ifTrue:[

            (nodeFound isNil or:[nodeFound == eachNode parent]) ifTrue:[

                nodeFound := eachNode

            ] ifFalse:[

                (nodeFound parent == eachNode parent

                and:[ eachNode start >= nodeFound start

                      and:[ eachNode stop <= nodeFound stop ] ]) ifTrue:[

                ] ifFalse:[

                    (nodeFound parent notNil

                    and:[nodeFound parent isCascade and:[eachNode parent isCascade]]) ifFalse:[^ nil]

                ]

            ]

        ] ifFalse:[

            nodeFound notNil ifTrue:[

                "/ already found one - beyond that one; leave

                wouldReturn notNil ifTrue:[wouldReturn := nodeFound].

            ]

        ].

    ].

"/ (wouldReturn notNil and:[wouldReturn ~~ node]) ifTrue:[self halt].

    ^ nodeFound

    "Modified: / 20-11-2006 / 12:31:12 / cg"

! !

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

    (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.

    (searchName size > 2 

        and:[ searchName first = $* 

        and:[ searchName last = $* ]]

    ) ifTrue:[

        isMatchString := false.

        searchName := searchName unquote:$*.

    ].

    searchName isEmpty ifTrue:[

        matches := Smalltalk allClassesForWhich:filterBlock.

        ^ InputCompletionResult bestName:searchName matchingNames:#()

    ].

    matches := OrderedCollection new.

    matchedNamesWithoutPrefix := Set new.

    ignCaseMatches := OrderedCollection new.

    others := OrderedCollection new.

    tryToMatch :=

        [:className :fullClassName|

            |addIt|

            isMatchString ifTrue:[

                addIt := searchName match:className

            ] ifFalse:[

                addIt := className includesString:searchName.

            ].

            addIt ifTrue:[

                matches add:(nsPrefix , fullClassName).

                matchedNamesWithoutPrefix add:className.

            ] ifFalse:[

                "/ try ignoring case

                isMatchString ifTrue:[

                    addIt := searchName match:className caseSensitive:false

                ] ifFalse:[

                    addIt := className includesString:lcSearchName caseSensitive:false.

                    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 longestCommonPrefixCaseSensitive:false ].

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