"

 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'

	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

    self codeCompletionForClass:cls context:nil codeView:codeView

!

codeCompletionForClass:cls context:contextOrNil codeView:codeView

    "contextOrNil is the current context, if this is calledfrom the debugger;

     nil, if called from the browser.

     If nonNil, we can make better guesses, because we actually know what a variables type

     is. This is not yet done, sigh"

    |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

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

        ^ self.

    ].

    node isLiteral ifTrue:[

        node value isSymbol ifTrue:[

            self codeCompletionForLiteralSymbol: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"

!

codeCompletionForLiteralSymbol:node inClass:cls codeView:codeView

    |sym possibleCompletions best start stop oldLen newLen oldVar|

    sym := node value.

    possibleCompletions := OrderedCollection new.

    Symbol allInstancesDo:[:existingSym |

        (existingSym startsWith:sym) ifTrue:[

            (existingSym = sym) ifFalse:[

                possibleCompletions add:existingSym

            ].

        ].

    ].

    possibleCompletions sort.

    best := possibleCompletions longestCommonPrefix.

    (best = sym or:[(possibleCompletions includes:best) not]) ifTrue:[

        best := self askUserForCompletion:'symbol literal' for:codeView from:possibleCompletions.

        best isNil ifTrue:[^ self].

    ].

"/ self showInfo:best.

    start := node start.

    stop := node stop.

    (codeView characterAtCharacterPosition:start) == $# ifTrue:[

        start := start + 1.

    ].

    (codeView characterAtCharacterPosition:start) == $' ifTrue:[

        start := start + 1.

        stop := stop - 1.

    ].

    oldVar := (codeView textFromCharacterPosition:start to:stop) asString string withoutSeparators.

    codeView

        undoableDo:[ codeView replaceFromCharacterPosition:start to:stop with:best ]

        info:'completion'.

    (best startsWith:oldVar) ifTrue:[

        oldLen := stop - start + 1.

        newLen := best size.

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

        codeView dontReplaceSelectionOnInput

    ].

!

codeCompletionForMessage:node inClass:cls codeView:codeView

    |selector srchClass implClass 

     bestSelectors selector2 bestSelectors2 allBest best info numArgs

     newParts nSelParts oldLen newLen selectorParts 

     findBest parentNode selectorInBest selector2InBest2

     parser selectorsSentInCode allBest1 allBest2|

    parser := Parser parseMethod:codeView contents string in:cls ignoreErrors:true ignoreWarnings:true.

    selectorsSentInCode := parser messagesSent.

    findBest := [:node :selector |

        |srchClass bestSelectors bestPrefixes|

        srchClass := self lookupClassForMessage:node inClass:cls.

        srchClass notNil ifTrue:[

            bestSelectors := Parser findBestSelectorsFor:selector in:srchClass.

        ] ifFalse:[

            codeView topView withCursor:(Cursor questionMark) do:[

                bestSelectors := Parser findBestSelectorsFor:selector.

            ].

        ].

        (bestSelectors includes:selector) ifTrue:[

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

        ].

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

        bestPrefixes size > 0 ifTrue:[

            bestPrefixes

        ] ifFalse:[

            bestSelectors

        ]

    ].

    selector := node selector.

    bestSelectors := findBest value:node value:selector.

    parentNode := node parent.

    "/ if its a unary message AND the parent is a keyword node, look for parent completion too.

    (node selector isUnarySelector 

    and:[ parentNode notNil 

    and:[ parentNode isMessage 

    and:[ (selector2 := parentNode selector) isKeywordSelector ]]]) ifTrue:[

        "/ srchClass2 := self lookupClassForMessage:parentNode inClass:cls.

        selector2 := selector2,selector.

        bestSelectors2 := findBest value:parentNode value:selector2.

    ].

    bestSelectors2 isEmptyOrNil ifTrue:[

        allBest := bestSelectors.

    ] ifFalse:[

        bestSelectors isEmptyOrNil ifTrue:[

            allBest := bestSelectors2

        ] ifFalse:[

            selectorInBest := (bestSelectors contains:[:sel | sel asLowercase startsWith:selector asLowercase]).

            selector2InBest2 := (bestSelectors2 contains:[:sel | sel asLowercase startsWith:selector2 asLowercase]).

            (selectorInBest not and:[ selector2InBest2 ]) ifTrue:[

                "/ selector2 is more likely

                allBest := bestSelectors2

            ] ifFalse:[

                (selectorInBest and:[ selector2InBest2 not ]) ifTrue:[

                    "/ selector more likely

                    allBest := bestSelectors

                ] ifFalse:[

                    "/ assume same likelyness

                    allBest := bestSelectors isEmpty 

                                ifTrue:[ bestSelectors2 ]

                                ifFalse:[ bestSelectors , #(nil) , bestSelectors2 ].

                ]

            ].

        ].

    ].

    allBest isEmptyOrNil ifTrue:[ ^ self ].

    "/ the ones already sent in the code are moved to the top of the list.

    allBest1 := allBest select:[:sel | selectorsSentInCode includes:sel].

    allBest2 := allBest reject:[:sel | selectorsSentInCode includes:sel].

    allBest1 isEmpty ifTrue:[

        allBest := allBest2.

    ] ifFalse:[

        allBest2 isEmpty ifTrue:[

            allBest := allBest1.

        ] ifFalse:[

            allBest := allBest1 , #(nil), allBest2.

        ]

    ].

    best := allBest first.

    allBest size > 1 ifTrue:[

        allBest size < 20 ifTrue:[

            |idx|

            idx := (PopUpMenu labels:allBest) startUp.

            idx == 0 ifTrue:[ ^ self].

            best := allBest at:idx.

        ] ifFalse:[

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

            best isEmptyOrNil ifTrue:[^ self].

        ].

        best = '-' ifTrue:[^ self].

    ].

false ifTrue:[

    srchClass notNil ifTrue:[

        implClass := srchClass whichClassIncludesSelector:best.

    ] ifFalse:[

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

        implClass size == 1 ifTrue:[

            implClass := implClass first.

        ] ifFalse:[

            implClass := nil

        ]

    ].

    info := best storeString.

    implClass notNil ifTrue:[

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

    ].

    self information:info.

].

    best ~= selector ifTrue:[

        numArgs := best numArgs.

        (bestSelectors2 notEmptyOrNil and:[bestSelectors2 includes:best]) ifTrue:[

            selectorParts := parentNode selectorParts , node selectorParts.

        ] ifFalse:[

            selectorParts := node selectorParts.

        ].

        nSelParts := selectorParts size.

        newParts := best asCollectionOfSubstringsSeparatedBy:$:.

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

        codeView

            undoableDo:[

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

                        newCursorPosition isNil ifTrue:[

                            newCursorPosition := stop + newPart size.

                        ]

                    ]

                ].

                (nSelParts min:newParts size) 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.

                    newCursorPosition isNil ifTrue:[

                        newCursorPosition := stop + (newLen-oldLen).

                    ].

                ].

                codeView cursorToCharacterPosition:newCursorPosition.

                codeView cursorRight.  "/ avoid going to the next line !!

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