"

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

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

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

    |resources|

    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.

    ].

    resources := codeView application isNil 

                    ifTrue:[ codeView resources]

                    ifFalse:[ codeView application resources ].

    ^ Dialog

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

       fromList:allTheBest

       lines:10

       title:(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 split|

    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 findBest:30 selectorsFor:selector in:srchClass forCompletion:true.

        ] ifFalse:[

            codeView topView withCursor:(Cursor questionMark) do:[

                bestSelectors := Parser findBest:30 selectorsFor:selector in:nil forCompletion:true.

            ].

        ].

        (bestSelectors includes:selector) ifTrue:[

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

        ].

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

    split := [:list :splitHow |

        |part1 part2 all|

        part1 := list select:splitHow.

        part2 := list reject:splitHow.

        part1 isEmpty ifTrue:[

            all := part2.

        ] ifFalse:[

            part2 isEmpty ifTrue:[

                all := part1.

            ] ifFalse:[

                all := part1 , part2.

            ]

        ].

        all

    ].

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

    allBest := split value:allBest value:[:sel | selectorsSentInCode includes:sel].

    "/ the ones which are a prefix are moved towards the top of the list

    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.