"

 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:'LastSource LastParseTree 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"

    |crsrPos char interval source node checkedNode|

"/    classOrNil isNil ifTrue:[

"/        self information:'No class'.

"/        ^ self.

"/    ].

    crsrPos := codeView characterPositionOfCursor-1.

    char := codeView characterAtCharacterPosition:crsrPos.

    [crsrPos > 1 and:[char isSeparator or:['.' includes:char]]] whileTrue:[

        crsrPos := crsrPos - 1.

        char := codeView characterAtCharacterPosition:crsrPos.

    ].

    interval := codeView selectedInterval.

    interval isEmpty ifTrue:[

        interval := crsrPos to:crsrPos.

    ].

    source := codeView contentsAsString string.

    source := source copyTo:crsrPos.

    "/ this is too naive and stupid; if there is a syntactic error,

    "/ we will not find a node for a long time (stepping back more and more,

    "/ until reaching the beginning). This leads to a thousand and more times reparsing

    "/ without any progress.

    "/ TODO: do it vice-versa, in that the parser does a callOut for every node generated

    "/ as it parses the code. Stop, when the interval is hit.

    "/ that will also work for syntactic incorrect source code.

    node := self findNodeForInterval:interval in:source allowErrors:true.   

"/    [node isNil] whileTrue:[

"/        "/ expand to the left ...

"/        interval start > 1 ifFalse:[

"/            self information:'No parseNode found'.

"/            ^ self.

"/        ].

"/        interval start:(interval start - 1).

"/        node := self findNodeForInterval:interval in:source allowErrors:true.

"/    ].

    node isNil ifTrue:[

        Transcript showCR:'No parseNode found'.

        self breakPoint:#cg.

        self information:'No parseNode found'.

        ^ self.

    ].

    (node isVariable

    and:[ node parent notNil

    and:[ node parent isMessage

    and:[ node stop < (codeView characterPositionOfCursor-1) ]]]) ifTrue:[

        node := node parent.

    ].

    node isVariable ifTrue:[

        self codeCompletionForVariable:node inClass:classOrNil codeView:codeView.

        ^ self.

    ].

    node isLiteral ifTrue:[

        node value isSymbol ifTrue:[

            self codeCompletionForLiteralSymbol:node inClass:classOrNil codeView:codeView.

            ^ self.

        ].

    ].

    classOrNil isNil ifTrue:[

        ^ self.

    ].

    checkedNode := node.

    [checkedNode notNil] whileTrue:[

        checkedNode isMessage ifTrue:[

            "/ completion in a message-send

            self codeCompletionForMessage:checkedNode inClass:classOrNil codeView:codeView.

            ^ self

        ].

        checkedNode isMethod ifTrue:[

            "/ completion in a method's selector pattern

            self codeCompletionForMethod:checkedNode inClass:classOrNil codeView:codeView.

            ^ self.

        ].

        checkedNode := checkedNode parent.

    ].

    self information:'Node is neither variable nor message.'.

    "Modified: / 04-07-2006 / 18:48:26 / fm"

    "Modified: / 03-07-2011 / 15:59:25 / cg"

! !

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

askUserForCompletion:what for:codeView from:allTheBest

    |list resources choice lastChoice|

    allTheBest isEmpty ifTrue:[ ^ nil ].

    allTheBest size == 1 ifTrue:[ ^ allTheBest first ].

    list := allTheBest.

    LastChoices notNil ifTrue:[

        lastChoice := LastChoices at:what ifAbsent:nil.

        lastChoice notNil ifTrue:[

            list := {lastChoice. nil. } , (list copyWithout:lastChoice).

        ].

    ].

    list size < 30 ifTrue:[

        |menu idx exitKey|

        menu := PopUpMenu labels:list.

        menu hideOnKeyFilter:[:key | |hide|

                hide := ( #( CursorDown CursorUp Escape Return ) includes: key) not.

                hide ifTrue:[

                    exitKey := key.

                ].

                hide].

        idx := menu startUp.

        idx == 0 ifTrue:[

            exitKey notNil ifTrue:[

                codeView keyPress:exitKey x:0 y:0.

            ].

            ^ nil

        ].

        choice := list at:idx.

    ] ifFalse:[

        resources := codeView application isNil 

                        ifTrue:[ codeView resources]

                        ifFalse:[ codeView application resources ].

        choice := Dialog

           choose:(resources string:'Choose ',what)

           fromList:list

           lines:20

           title:(resources string:'Code completion').

        choice isNil ifTrue:[^ nil].

    ].

    LastChoices isNil ifTrue:[

        LastChoices := Dictionary new.

    ].

    LastChoices at:what put:choice.

    ^ choice

    "Created: / 10-11-2006 / 14:00:53 / cg"

!

codeCompletionForVariable:node inClass:classOrNil codeView:codeView

    |nonMetaClass crsrPos nm

     allVariables allDistances best nodeVal

     char start stop oldLen newLen oldVar

     getDistanceComputeBlockWithWeight addWithFactorBlock names allTheBest bestAssoc

     globalFactor localFactor selectorOfMessageToNode tree implementors argIdx namesUsed kwPart|

    classOrNil notNil ifTrue:[

        nonMetaClass := classOrNil theNonMetaclass.

    ].

    nm := node name.

    "/ if we are behind the variable and a space has already been entered,

    "/ the user is probably looking for a message selector.

    "/ If the variable represents a global, present its instance creation messages

    crsrPos := codeView characterPositionOfCursor.

    char := codeView characterAtCharacterPosition:crsrPos-1.

    char isSeparator ifTrue:[

        classOrNil isNil ifTrue:[

            nodeVal := Smalltalk at:nm asSymbol.

        ] ifFalse:[ 

            nodeVal := classOrNil topNameSpace at:nm asSymbol ifAbsent:[Smalltalk at:nm asSymbol].

        ].

        nodeVal isBehavior ifTrue:[

            |methods menu exitKey idx|

            methods := nodeVal class methodDictionary values

                            select:[:m | |cat|

                                cat := m category asLowercase.

                                cat = 'instance creation'

                            ].

            menu := PopUpMenu labels:(methods collect:[:each | each selector]).

            menu hideOnKeyFilter:[:key | |hide|

                    hide := ( #( CursorDown CursorUp Escape Return ) includes: key) not.

                    hide ifTrue:[

                        exitKey := key.

                    ].

                    hide].

            idx := menu startUp.

            idx == 0 ifTrue:[

                exitKey notNil ifTrue:[

                    codeView keyPress:exitKey x:0 y:0.

                ].

                ^ self

            ].

            best := (methods at:idx) selector.

            codeView

                undoableDo:[

                    codeView insertString:best atCharacterPosition:crsrPos.

                    codeView cursorToCharacterPosition:crsrPos+best size.

                ]

                info:'completion'.

            ^ self.

        ].

    ].

    (node parent notNil and:[node parent isMessage]) ifTrue:[

        node == node parent receiver ifTrue:[

            selectorOfMessageToNode := node parent selector

        ]

    ].

    getDistanceComputeBlockWithWeight :=

        [:weight |

            [:each |

                |dist factor|

                dist := each spellAgainst:nm.

                factor := 1.

                (each startsWith:nm) ifTrue:[

                    factor := 6 * nm size.

                ] ifFalse:[

                    (each asLowercase startsWith:nm asLowercase) ifTrue:[

                        factor := 4 * nm size.

                    ].

                ].

                dist := dist + (weight*factor).

                each -> (dist * weight)

             ]

        ].

    addWithFactorBlock :=

        [:names :factor | |namesToAdd|

            namesToAdd := names select:[:nameToAdd | nameToAdd ~= nm ].

            namesToAdd := namesToAdd reject:[:each | allVariables includes:each ].

            allVariables addAll:namesToAdd.

            allDistances addAll:(namesToAdd collect:(getDistanceComputeBlockWithWeight value:factor)).

        ].

    nm isUppercaseFirst ifTrue:[

        globalFactor := 2.    "/ favour globals

        localFactor := 1.

    ] ifFalse:[

        globalFactor := 1.    "/ favour locals

        localFactor := 2.

    ].

    allVariables := OrderedCollection new.

    allDistances := OrderedCollection new.

    "/ are we in the methods selector spec ?

    (node parent notNil 

    and:[node parent isMethod

    and:[node parent arguments includes:node]]) ifTrue:[

        "/ now thats cool: look how the naem of this argument is in other implementations

        "/ of this method, and take that as a basis of the selection

        implementors := SystemBrowser 

                            findImplementorsOf:(node parent selector) 

                            in:(Smalltalk allClasses)

                            ignoreCase:false.

        "/ which argument is it

        argIdx := node parent arguments indexOf:node.

        implementors size > 50 ifTrue:[

            implementors := implementors asOrderedCollection copyTo:50.

        ].

        namesUsed := (implementors 

                        collect:[:eachImplementor |

                            |parseTree|

                            parseTree := eachImplementor parseTree.

                            (parseTree notNil and:[parseTree arguments size > 0]) 

                                ifFalse:nil

                                ifTrue:[ (parseTree arguments at:argIdx) name] ]

                        thenSelect:[:a | a notNil]) asSet.  

        addWithFactorBlock value:namesUsed value:(2 * localFactor).

        classOrNil notNil ifTrue:[

            "/ also, look for the keyword before the argument, 

            "/ and see if there is such an instVar

            "/ if so, add it with -Arg

            node parent selector isKeyword ifTrue:[

                kwPart := node parent selector keywords at:argIdx.

                (classOrNil allInstVarNames includes:(kwPart copyWithoutLast:1)) ifTrue:[

                    addWithFactorBlock 

                        value:(classOrNil allInstVarNames collect:[:nm| nm,'Arg'])

                        value:(1 * localFactor).

                ].

            ].

        ]

    ] ifFalse:[

        classOrNil notNil ifTrue:[

            "/ locals in the block/method

            names := node allVariablesOnScope.

            "/ if there were no variables (due to a parse error)

            "/ do another parse and see what we have

            names isEmpty ifTrue:[

                tree := self treeForCode:(codeView contentsAsString string) allowErrors:true.

                "/ better if we already have a body (include locals then)

                "/ otherwise, only the arguments are considered

                tree notNil ifTrue:[

                    names := (tree body ? tree) allVariablesOnScope.

                ]

            ].

            addWithFactorBlock value:names value:(4 * localFactor).

            "/ instance variables

            addWithFactorBlock value:classOrNil instVarNames value:(3 * localFactor).

            "/ inherited instance variables

            classOrNil superclass notNil ifTrue:[

                addWithFactorBlock value:classOrNil superclass allInstVarNames value:(2.5 * localFactor).

            ].

        ].

        selectorOfMessageToNode notNil ifTrue:[

            |names responders nonResponders|

            "/ responding to that messsage

            classOrNil notNil ifTrue:[

                "/ private classes

                addWithFactorBlock value:(nonMetaClass privateClasses collect:[:cls | cls nameWithoutPrefix])

                                   value:(1.75 * globalFactor).

                "/ class variables

                names := nonMetaClass classVarNames.

                responders := names select:[:classVar | (nonMetaClass classVarAt:classVar) respondsTo:selectorOfMessageToNode].

                nonResponders := names reject:[:classVar | (nonMetaClass classVarAt:classVar) respondsTo:selectorOfMessageToNode].

                addWithFactorBlock value:responders value:(1.5 * globalFactor).

                addWithFactorBlock value:nonResponders value:(0.5 * 1.5 * globalFactor).

                "/ superclass var names

                nonMetaClass allSuperclassesDo:[:superClass |

                    names := superClass classVarNames.

                    responders := names select:[:classVar | (superClass classVarAt:classVar) respondsTo:selectorOfMessageToNode].

                    nonResponders := names reject:[:classVar | (superClass classVarAt:classVar) respondsTo:selectorOfMessageToNode].

                    addWithFactorBlock value:responders value:(1 * globalFactor).

                    addWithFactorBlock value:nonResponders value:(0.5 * 1 * globalFactor).

                ].

                "/ namespace vars

                classOrNil nameSpace ~~ Smalltalk ifTrue:[

                    names := classOrNil topNameSpace keys.

                    names := names reject:[:nm | nm includes:$:].

                    names := names select:[:nm | nm isUppercaseFirst ].

                    responders := names select:[:nsVar | |c| c := classOrNil topNameSpace at:nsVar. c isBehavior not or:[c isLoaded and:[c respondsTo:selectorOfMessageToNode]]].

                    nonResponders := names reject:[:nsVar | |c| c := classOrNil topNameSpace at:nsVar. c isBehavior not or:[c isLoaded and:[c respondsTo:selectorOfMessageToNode]]].

                    addWithFactorBlock value:responders value:(1.5 * globalFactor).

                    addWithFactorBlock value:nonResponders value:(0.5 * 1.5 * globalFactor).

                ].

            ].

            "/ globals

            names := Smalltalk keys.

            "/ names := names reject:[:nm | nm includes:$:].

            names := names select:[:nm | nm isUppercaseFirst ].

            responders := names select:[:glblVar | |c| c := Smalltalk at:glblVar. c isBehavior not or:[c isLoaded and:[c respondsTo:selectorOfMessageToNode]]].

            nonResponders := names reject:[:glblVar | |c| c := Smalltalk at:glblVar. c isBehavior not or:[c isLoaded and:[c respondsTo:selectorOfMessageToNode]]].

            addWithFactorBlock value:responders value:(1.5 * globalFactor).

            addWithFactorBlock value:nonResponders value:(0.5 * 1.5 * globalFactor).

        ] ifFalse:[

            classOrNil notNil ifTrue:[

                "/ private classes

                addWithFactorBlock value:(nonMetaClass privateClasses collect:[:cls | cls nameWithoutPrefix])

                                   value:(1.75 * globalFactor).

                "/ class variables

                addWithFactorBlock value:nonMetaClass classVarNames value:(1.5 * globalFactor).

                classOrNil superclass notNil ifTrue:[

                    addWithFactorBlock value:nonMetaClass superclass allClassVarNames value:(1 * globalFactor).

                ].

                "/ namespace vars

                classOrNil nameSpace ~~ Smalltalk ifTrue:[

                    names := classOrNil nameSpace isNameSpace ifTrue:[classOrNil nameSpace keys] ifFalse:[classOrNil nameSpace privateClasses collect:[:c | c nameWithoutPrefix]].

                    names := names select:[:nm | nm isUppercaseFirst ].

                    addWithFactorBlock value:names value:(1.5 * globalFactor).

                ].

                "/ pool variables

                classOrNil theNonMetaclass sharedPools do:[:poolName |

                    |pool names|

                    pool := Smalltalk at:poolName.

                    names := pool classVarNames.

                    addWithFactorBlock value:names value:(1.5 * globalFactor).

                ].

            ].

            "/ globals

            names := Smalltalk keys.

            names := names select:[:nm | nm isUppercaseFirst ].

            addWithFactorBlock value:names value:(1.5 * globalFactor).

        ].

        "/ pseudos - assuming that thisContext is seldom used.

        "/ also assuming, that nil is short so its usually typed in.

        addWithFactorBlock value:#('self') value:(2.5 * localFactor).

        addWithFactorBlock value:#('nil') value:(0.5 * localFactor).

        addWithFactorBlock value:#('super' 'false') value:(2 * localFactor).

        addWithFactorBlock value:#('thisContext') value:(1 * localFactor).

    ].

    bestAssoc := allDistances at:1.

    bestAssoc := allDistances inject:bestAssoc into:[:el :best | el value > best value

                                                           ifTrue:[el]

                                                           ifFalse:[best]

                                                    ].

    allDistances sort:[:a :b | 

                                a value > b value ifTrue:[

                                    true

                                ] ifFalse:[