"

 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)

    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 is 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:cls codeView:codeView

    |crsrPos char interval source node checkedNode|

    cls isNil ifTrue:[

        self information:'No class'.

        ^ self.

    ].

    interval := codeView selectedInterval.

    interval isEmpty ifTrue:[

        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 := crsrPos to:crsrPos.

    ].

    source := codeView contentsAsString string.

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

    [node isNil] whileTrue:[

        "/ expand to the left ...

        interval start > 1 ifFalse:[

            crsrPos := codeView characterPositionOfCursor.

            self information:'No parseNode found'.

            ^ self.

        ].

        interval start:(interval start - 1).

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

    ].

    node isVariable ifTrue:[

        self codeCompletionForVariable:node inClass:cls codeView:codeView.

        ^ self.

    ].

    checkedNode := node.

    [checkedNode notNil] whileTrue:[

        checkedNode isMessage ifTrue:[

            "/ completion in a message-send

            self codeCompletionForMessage:checkedNode inClass:cls codeView:codeView.

            ^ self

        ].

        checkedNode isMethod ifTrue:[

            "/ completion in a methods selector pattern

            self codeCompletionForMethod:checkedNode inClass:cls codeView:codeView.

            ^ self.

        ].

        checkedNode := checkedNode parent.

    ].

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

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

    "Modified: / 20-11-2006 / 12:30:59 / cg"

! !

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

askUserForCompletion:what for:codeView from:allTheBest

    allTheBest isEmpty ifTrue:[ ^ nil ].

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

    allTheBest size < 20 ifTrue:[

        |menu idx exitKey|

        menu := PopUpMenu labels:allTheBest.

        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

        ].

        ^ allTheBest at:idx.

    ] ifFalse:[

        ^ Dialog

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

           fromList:allTheBest

           lines:10

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

    ].

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

!

codeCompletionForMessage:node inClass:cls codeView:codeView

    |selector receiver nm srchClass implClass

     bestSelectors bestPrefixes best nodeVal info numArgs

     newParts nSelParts oldLen newLen selectorParts|

    selector := node selector.

    receiver := node receiver.

    receiver isVariable ifTrue:[

        nm := receiver name.

        nm = 'self' ifTrue:[

            srchClass := cls

        ].

        nm = 'super' ifTrue:[

            srchClass := cls superclass

        ].

        (Smalltalk includesKey:nm asSymbol) ifTrue:[

            nodeVal := Smalltalk at:nm asSymbol.

            nodeVal notNil ifTrue:[

                srchClass := nodeVal class

            ]

        ]

    ].

    receiver isLiteral ifTrue:[

        srchClass := receiver value class

    ].

    srchClass notNil ifTrue:[

        bestSelectors := Parser findBestSelectorsFor:selector in:srchClass.

        (bestSelectors includes:selector) ifTrue:[

            bestSelectors := bestSelectors select:[:sel | sel size > selector size].

        ].

        bestSelectors size > 0 ifTrue:[

            bestPrefixes := bestSelectors select:[:sel | sel asLowercase startsWith:selector asLowercase].

            bestPrefixes size > 0 ifTrue:[

                bestSelectors := bestPrefixes

            ].

            best := bestSelectors first.

            bestSelectors size > 1 ifTrue:[

                best = selector ifTrue:[

                    best := bestSelectors second.

                ].

                bestSelectors size < 20 ifTrue:[

                    |idx|

                    idx := (PopUpMenu labels:bestSelectors) startUp.

                    idx == 0 ifTrue:[ ^ self].

                    best := bestSelectors at:idx.

                ] ifFalse:[

                    best := Dialog request:'Matching selectors:' initialAnswer:best list:bestSelectors.

                    best size == 0 ifTrue:[^ self].

                ].

            ] ifFalse:[

                best := bestSelectors first.

            ].

            implClass := srchClass whichClassIncludesSelector:best.

        ].

    ] ifFalse:[

        "/ class not known

        codeView topView withCursor:(Cursor questionMark) do:[

            bestSelectors := Parser findBestSelectorsFor:selector.

        ].

        bestSelectors := bestSelectors select:[:sel | sel startsWith:selector].

        (bestSelectors includes:selector) ifTrue:[

            bestSelectors := bestSelectors select:[:sel | sel size > selector size].

        ].

        bestSelectors size > 0 ifTrue:[

            best := bestSelectors first.

            bestSelectors size > 1 ifTrue:[

                best = selector ifTrue:[

                    best := bestSelectors second.

                ].

                bestSelectors size < 20 ifTrue:[

                    |idx|

                    idx := (PopUpMenu labels:bestSelectors) startUp.

                    idx == 0 ifTrue:[ ^ self].

                    best := bestSelectors at:idx.

                ] ifFalse:[

                    best := Dialog request:'Matching selectors:' initialAnswer:best list:bestSelectors.

                    best size == 0 ifTrue:[^ self].

                ]

            ] ifFalse:[

                best := bestSelectors first.

            ].

            implClass := Smalltalk allClasses select:[:cls | (cls includesSelector:best) or:[cls class includesSelector:best]].

            implClass size == 1 ifTrue:[

                implClass := implClass first.

            ] ifFalse:[

                implClass := nil

            ]

        ].

    ].

    best notNil ifTrue:[

        info := best storeString.

        implClass notNil ifTrue:[

            info := implClass name , ' >> ' , info.

        ].

        self information:info.

        best ~= selector ifTrue:[

            numArgs := best numArgs.

            selectorParts := node selectorParts.

            nSelParts := selectorParts size.

            newParts := best asCollectionOfSubstringsSeparatedBy:$:.

            newParts := newParts select:[:part | part size > 0].

            codeView

                undoableDo:[

                    |stop|

                    numArgs > nSelParts ifTrue:[

                        stop := selectorParts last stop.

                        "/ append the rest ...

                        numArgs downTo:nSelParts+1 do:[:idx |

                            |newPart|

                            newPart := newParts at:idx.

                            (best endsWith:$:) ifTrue:[

                                newPart := newPart , ':'

                            ].

                            (codeView characterAtCharacterPosition:stop) == $: ifFalse:[

                                newPart := ':' , newPart.

                            ].

                            newPart := (codeView characterAtCharacterPosition:stop) asString , newPart.

                            codeView replaceFromCharacterPosition:stop to:stop with:newPart

                        ]

                    ].

                    nSelParts downTo:1 do:[:idx |

                        |newPart oldPartialToken start stop|

                        newPart := newParts at:idx.

                        oldPartialToken := selectorParts at:idx.

                        start := oldPartialToken start.

                        stop := oldPartialToken stop.

                        (best endsWith:$:) ifTrue:[

                            (codeView characterAtCharacterPosition:stop+1) == $: ifFalse:[

                                newPart := newPart , ':'

                            ]

                        ] ifFalse:[

                            (codeView characterAtCharacterPosition:stop) == $: ifTrue:[

                                newPart := newPart , ':'

                            ] ifFalse:[

                                (codeView characterAtCharacterPosition:stop+1) isSeparator ifFalse:[

                                    newPart := newPart , ' '

                                ]

                            ]

"/                            codeView replaceFromCharacterPosition:start to:stop with:(newPart , ':').

"/                        ] ifFalse:[

"/                            codeView replaceFromCharacterPosition:start to:stop with:newPart.

                        ].

                        codeView replaceFromCharacterPosition:start to:stop with:newPart.

                        oldLen := stop - start + 1.

                        newLen := newPart size.

                        codeView selectFromCharacterPosition:start+oldLen to:start+newLen-1.

                    ].

                    codeView dontReplaceSelectionOnInput.

                ]

            info:'completion'.

        ].

    ].

    "Created: / 10-11-2006 / 13:18:27 / cg"

!

codeCompletionForMethod:node inClass:cls codeView:codeView

    "completion in a methods selector pattern"

    |crsrPos

     selectorSoFar matchingSelectors

     selectors distances best rest 

     allExistingMethods namesOfArguments 

     nameBag namesByCount|  

    crsrPos := codeView characterPositionOfCursor - 1.

    selectorSoFar := ''.

    node selectorParts doWithIndex:[:partToken :argNr|

        |part|

        part := partToken value.

        selectorSoFar := selectorSoFar , part.

        (crsrPos >= partToken start

        and:[crsrPos <= partToken stop]) ifTrue:[

            matchingSelectors := Smalltalk allClasses

                                    inject:(Set new)

                                    into:[:theSet :eachClass |

                                        |md|

                                        cls isMeta ifTrue:[

                                            md := eachClass theMetaclass methodDictionary

                                        ] ifFalse:[

                                            md := eachClass theNonMetaclass methodDictionary

                                        ].

                                        theSet addAll:(md keys select:[:sel |sel startsWith:selectorSoFar]).

                                        theSet.

                                    ].

            selectors := matchingSelectors asOrderedCollection.

            "/ if there is only one, and user has already entered it, he might want to complete the argument-name    

            (selectors size == 1 

            and:[selectors first = selectorSoFar]) ifTrue:[

                allExistingMethods := (Smalltalk allImplementorsOf:selectorSoFar asSymbol)

                                            collect:[:cls | cls compiledMethodAt:selectorSoFar asSymbol].

                namesOfArguments := allExistingMethods collect:[:eachMethod | eachMethod methodArgNames].

                nameBag := Bag new.

                namesOfArguments do:[:eachNameVector | nameBag add:(eachNameVector at:argNr)].

                namesByCount := nameBag valuesAndCounts sort:[:a :b | a value < b value].   

                "/ take the one which occurs most often     

                best := self askUserForCompletion:'argument' for:codeView from:(namesByCount collect:[:a | a key]).

                codeView

                    undoableDo:[

                        (crsrPos+1) >= codeView contents size ifTrue:[

                            codeView paste:best.

                        ] ifFalse:[

                            codeView insertString:best atCharacterPosition:crsrPos+1.

                        ]

                    ]

                    info:'completion'.

                codeView cursorToCharacterPosition:(crsrPos + best size - 1).    

            ] ifFalse:[

                distances := selectors collect:[:each | each spellAgainst:selectorSoFar].

                distances sortWith:selectors.

                selectors reverse.

                best := self askUserForCompletion:'selector' for:codeView from:selectors.

                best isNil ifTrue:[^ self].

                rest := best copyFrom:selectorSoFar size.

                codeView

                    undoableDo:[ 

                        codeView 

                            replaceFromCharacterPosition:crsrPos 

                            to:crsrPos 

                            with:rest 

                    ]

                    info:'completion'.

                codeView cursorToCharacterPosition:(crsrPos + rest size - 1).    

            ].

            codeView cursorRight. "/ kludge to make it visible   

        ].

    ].

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

    "Created: / 10-11-2006 / 13:46:44 / cg"

!

codeCompletionForVariable:node inClass:cls codeView:codeView

    |nonMetaClass crsrPos nm

     allVariables allDistances best nodeVal

     char start stop oldLen newLen oldVar

     getDistanceComputeBlockWithWeight addWithFactorBlock names allTheBest bestAssoc

     globalFactor localFactor selectorOfMessageToNode tree|

    nonMetaClass := cls 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:[

        nodeVal := cls nameSpace 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

        ]

    ].

    nm isUppercaseFirst ifTrue:[

        globalFactor := 2.

        localFactor := 1.

    ] ifFalse:[

        globalFactor := 1.

        localFactor := 2.

    ].

    getDistanceComputeBlockWithWeight :=

        [:weight |

            [:each |

                |dist factor|

                dist := each spellAgainst:nm.

                factor := 1.

                (each startsWith:nm) ifTrue:[

                    factor := 4 * nm size.

                ] ifFalse:[

                    (each asLowercase startsWith:nm asLowercase) ifTrue:[

                        factor := 3 * nm size.

                    ].

                ].

                dist := dist + (weight*factor).

                each -> (dist * weight)

             ]

        ].

    addWithFactorBlock :=