--- a/DoWhatIMeanSupport.st Thu Jun 06 19:10:28 2013 +0200
+++ b/DoWhatIMeanSupport.st Fri Jun 14 16:35:39 2013 +0200
@@ -12,8 +12,8 @@
"{ Package: 'stx:libwidg2' }"
Object subclass:#DoWhatIMeanSupport
- instanceVariableNames:''
- classVariableNames:'LastSource LastParseTree LastChoices'
+ instanceVariableNames:'tree tokens classOrNil methodOrNil codeView'
+ classVariableNames:'LastSource LastParseTree LastScanTokens LastChoices'
poolDictionaries:''
category:'System-Support'
!
@@ -70,1216 +70,52 @@
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-1 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.
- classOrNil notNil ifTrue:[
- node := self findNodeForInterval:interval in:source allowErrors:true mustBeMethod:true.
- ].
- node isNil ifTrue:[
- node := self findNodeForInterval:interval in:source allowErrors:true mustBeMethod:false.
- ].
-"/ [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.
- ].
- ].
-
- 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: / 16-09-2011 / 14:54:47 / cg"
+
+ ^ self new
+ codeCompletionForClass:classOrNil context:contextOrNil codeView:codeView
+!
+
+codeCompletionForMethod:methodOrNil orClass:classOrNil codeView:codeView into:actionBlock
+ self codeCompletionForMethod:methodOrNil orClass:classOrNil context:nil codeView:codeView into:actionBlock
+
+ "Modified (format): / 03-07-2011 / 15:49:49 / cg"
+!
+
+codeCompletionForMethod:methodOrNil orClass:classOrNil context:contextOrNil codeView:codeView into:actionBlock
+ "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'!
-askUserForCompletion:what for:codeView at:position from:allTheBest
- |list choice lastChoice|
-
- "/ cg: until the new stuff works,...
- ^ self old_askUserForCompletion:what for:codeView from:allTheBest.
-
- 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).
- ].
- ].
- choice := Tools::CodeCompletionMenu
- openFor:codeView
- at:position
- with:allTheBest.
- LastChoices isNil ifTrue:[
- LastChoices := Dictionary new.
- ].
- LastChoices at:what put:choice.
- ^ choice
-
- "Created: / 16-02-2010 / 10:09:57 / Jan Vrany <jan.vrany@fit.cvut.cz>"
- "Modified (format): / 08-07-2011 / 08:49:35 / cg"
-!
-
-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"
-!
-
-codeCompletionForLiteralSymbol:node inClass:classOrNil 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 at: node start 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
- ].
-
- "Modified: / 16-02-2010 / 10:15:05 / Jan Vrany <jan.vrany@fit.cvut.cz>"
- "Modified (format): / 03-07-2011 / 15:58:45 / cg"
-!
-
-codeCompletionForMessage:node inClass:classOrNil codeView:codeView
- |selector srchClass implClass
- bestSelectors selector2 bestSelectors2 allBest best info numArgs
- newParts nSelParts oldLen newLen selectorParts
- findBest parentNode selectorInBest selector2InBest2
- parser selectorsSentInCode split|
-
- classOrNil notNil ifTrue:[
- parser := Parser parseMethod:codeView contents string in:classOrNil ignoreErrors:true ignoreWarnings:true.
- selectorsSentInCode := parser messagesSent.
- ].
-
- findBest := [:node :selector |
- |srchClass bestSelectors bestPrefixes|
-
- codeView topView withCursor:(Cursor questionMark) do:[
- srchClass := self lookupClassForMessage:node inClass:classOrNil.
- srchClass notNil ifTrue:[
- bestSelectors := Parser findBest:30 selectorsFor:selector in:srchClass forCompletion:true.
- ] ifFalse:[
- 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:classOrNil.
- 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
- ].
-
- selectorsSentInCode notNil ifTrue:[
- "/ 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
- allBest := split value:allBest value:[:sel | sel notNil and:[sel startsWith:selector]].
-
- 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 := self askUserForCompletion:'selector' for:codeView at: node selectorParts first start from: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 := 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 := 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"
- "Modified: / 16-02-2010 / 10:33:48 / Jan Vrany <jan.vrany@fit.cvut.cz>"
- "Modified: / 21-07-2012 / 12:24:06 / cg"
-!
-
-codeCompletionForMethod:node inClass:classOrNil codeView:codeView
- "completion in a methods selector pattern"
-
- |crsrPos
- selectorSoFar matchingSelectors
- selectors distances best rest
- allExistingMethods nameBag namesByCount selectors1 selectors2|
-
- 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:[
- (classOrNil notNil and:[classOrNil isMeta]) ifTrue:[
- matchingSelectors := Smalltalk allClasses
- inject:(Set new)
- into:[:theSet :eachClass |
- |md|
-
- md := eachClass theMetaclass methodDictionary.
- theSet addAll:(md keys select:[:sel |sel startsWith:selectorSoFar]).
- theSet.
- ].
- "/ dont forget the stuff in the class-line
- Metaclass withAllSuperclassesDo:[:cls |
- matchingSelectors addAll:(cls methodDictionary keys select:[:sel |sel startsWith:selectorSoFar]).
- ].
- ] ifFalse:[
- matchingSelectors := Smalltalk allClasses
- inject:(Set new)
- into:[:theSet :eachClass |
- |md|
-
- 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:[
- selectorSoFar numArgs == 0 ifTrue:[ ^ self ].
-
- allExistingMethods := (Smalltalk allImplementorsOf:selectorSoFar asSymbol)
- collect:[:cls | cls compiledMethodAt:selectorSoFar asSymbol].
- nameBag := Bag new.
- allExistingMethods do:[:eachMethod | nameBag addAll:(eachMethod methodArgNames ? #())].
- namesByCount := nameBag valuesAndCounts sort:[:a :b | a value < b value].
- "/ take the one which occurs most often
- best := self askUserForCompletion:'argument' for:codeView at: node start 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:[
- "the ones implemented in superclasses are shown first"
- classOrNil notNil ifTrue:[
- selectors1 := selectors select:[:sel | classOrNil respondsTo:sel]. "/ in super
- selectors2 := selectors reject:[:sel | selectors1 includes:sel ]. "/ not in super
- ] ifFalse:[
- selectors1 := selectors
- ].
-
- distances := selectors1 collect:[:each | each spellAgainst:selectorSoFar].
- distances sortWith:selectors1.
- selectors1 reverse.
- selectors := selectors1.
-
- selectors2 notEmptyOrNil ifTrue:[
- distances := selectors2 collect:[:each | each spellAgainst:selectorSoFar].
- distances sortWith:selectors2.
- selectors2 reverse.
- selectors1 := selectors1 collect:[:sel | sel allBold].
- selectors := selectors1,selectors2.
- ].
-
- best := self askUserForCompletion:'selector' for:codeView at:(node start) from:selectors.
- best isNil ifTrue:[^ self].
-
- rest := best copyFrom:selectorSoFar size.
- codeView
- undoableDo:[
- codeView
- replaceFromCharacterPosition:crsrPos+1
- to:crsrPos+1
- with:rest
- ]
- info:'Completion'.
- codeView cursorToCharacterPosition:(crsrPos+1 + 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"
- "Modified: / 16-02-2010 / 10:13:56 / Jan Vrany <jan.vrany@fit.cvut.cz>"
- "Modified: / 01-06-2012 / 20:31:36 / 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] as:Set.
-
- 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 copyButLast: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).
-
- "/ pool variables
- classOrNil theNonMetaclass sharedPoolNames do:[:poolName |
- |pool names|
-
- pool := Smalltalk at:poolName.
- names := pool classVarNames.
- 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:(2.5 * globalFactor).
- addWithFactorBlock value:nonResponders value:(0.5 * 2.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:(2.0 * globalFactor).
- classOrNil superclass notNil ifTrue:[
- addWithFactorBlock value:nonMetaClass superclass allClassVarNames value:(2.0 * 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 sharedPoolNames do:[:poolName |
- |pool names|
-
- pool := Smalltalk at:poolName.
- names := pool classVarNames.
- addWithFactorBlock value:names value:(2.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).
- ].
-
- allDistances isEmpty ifTrue:[^ self].
- 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:[
- a value = b value ifTrue:[
- a key < b key
- ] ifFalse:[
- false
- ]
- ]
- ].
- allTheBest := allDistances select:[:entry | entry value >= (bestAssoc value * 0.5)].
- allTheBest size > 15 ifTrue:[
- allTheBest := allDistances select:[:entry | entry value >= (bestAssoc value * 0.8)].
- ].
-
- best := self askUserForCompletion:'variable' for:codeView at: node start from:(allTheBest collect:[:assoc | assoc key]).
- best isNil ifTrue:[^ self].
-
-"/ self showInfo:best.
-
- start := node start.
- stop := node stop.
- 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
- ].
-
- "Created: / 10-11-2006 / 13:16:33 / cg"
- "Modified: / 16-02-2010 / 10:13:13 / Jan Vrany <jan.vrany@fit.cvut.cz>"
- "Modified: / 22-08-2012 / 22:07:24 / cg"
-!
-
findNodeForInterval:interval in:source
- |tree node|
-
- interval isEmpty ifTrue: [^ nil].
- RBParser isNil ifTrue: [^ nil].
-
- source = LastSource ifTrue:[
- tree := LastParseTree.
- ] ifFalse:[
- 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:[
- ^ nil
- ].
- ].
-
- LastSource := source.
- LastParseTree := tree.
- ].
-
- 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"
+ ^ self new findNodeForInterval:interval in:source
!
findNodeForInterval:interval in:source allowErrors:allowErrors
- ^ self
- findNodeForInterval:interval in:source allowErrors:allowErrors
- mustBeMethod:false
-
- "Modified: / 16-09-2011 / 14:52:28 / cg"
+ ^ 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)."
- |tree "errCount" firstIntersectingNode onErrorBlock nodeGenerationHook|
-
- interval isEmpty ifTrue: [^ nil].
- RBParser isNil ifTrue: [^ nil].
- LastSource := nil.
- source = LastSource ifTrue:[
- tree := LastParseTree.
- ] ifFalse:[
- onErrorBlock :=
- [:str :err :nodesSoFar |
- |nodes|
-
- allowErrors ifTrue:[
- firstIntersectingNode notNil ifTrue:[^ firstIntersectingNode].
- nodes := nodesSoFar asOrderedCollection
- collect:[:nd | nd whichNodeIntersects:interval]
- thenSelect:[:nd | nd notNil ].
- nodes size == 1 ifTrue:[
- ^ nodes first
- ].
- ].
- nil
- ].
-
- nodeGenerationHook :=
- [:node |
- "/ we would like to return here as soon as the node has been created by the parser;
- "/ however, at that time, its parent(chain) is not yet created and so we might not know
- "/ what the semantic intepretation (especially: scope of variable) will be.
- "/ therefore, we parse all, and return the found node at the end.
- "//// ^ node.
- firstIntersectingNode isNil ifTrue:[
- (node intersectsInterval:interval) ifTrue:[
- firstIntersectingNode := node
- ].
- ].
- ].
-
- tree := RBParser
- parseMethod:source
- onError: onErrorBlock
- rememberNodes:true
- nodeGenerationCallback:nodeGenerationHook.
-"/ onError: [:str :err | errCount := (errCount?0) + 1. self halt.]
-"/ proceedAfterError:true.
-
- mustBeMethod ifTrue:[
- "/ only cache parsed methods
- tree notNil ifTrue:[
- LastSource := source.
- LastParseTree := tree.
- ].
- ] ifFalse:[
- (tree isNil or:[firstIntersectingNode isNil]) ifTrue:[
- "/ try as an expression
- tree := RBParser
- parseExpression:source
- onError: onErrorBlock
- rememberNodes:true
- nodeGenerationCallback:nodeGenerationHook.
- ].
- ].
- firstIntersectingNode notNil ifTrue:[ ^ firstIntersectingNode ].
- ].
-
- ^ self findNodeForInterval:interval inParseTree:tree.
-
- "Created: / 16-09-2011 / 14:52:08 / cg"
+ ^ self new
+ findNodeForInterval:interval in:source allowErrors:allowErrors mustBeMethod:mustBeMethod
!
findNodeForInterval:interval inParseTree:parseTree
- |node|
-
- interval isEmpty ifTrue: [^ nil].
- parseTree isNil ifTrue:[^ nil].
-
- node := parseTree whichNodeIsContainedBy:interval.
- node isNil ifTrue:[
- node := parseTree whichNodeIntersects:interval.
- node isNil ifTrue: [
- node := self findNodeIn:parseTree forInterval:interval
- ].
- ].
- ^ node
-
- "Modified: / 10-11-2006 / 13:13:58 / cg"
+ ^ self new findNodeForInterval:interval inParseTree:parseTree
!
findNodeIn:tree forInterval:interval
- |nodeFound wouldReturn|
-
- nodeFound := nil.
- tree nodesDo:[:eachNode |
- (eachNode intersectsInterval:interval) 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"
-!
-
-lookupClassForMessage:node inClass:classProvidingNamespaceOrNil
- |receiver nm nodeVal receiverClass|
-
- receiver := node receiver.
- receiver isLiteral ifTrue:[
- ^ receiver value class
- ].
- receiver isVariable ifTrue:[
- nm := receiver name.
- nm = 'self' ifTrue:[
- classProvidingNamespaceOrNil isNil ifTrue:[^ UndefinedObject].
- ^ classProvidingNamespaceOrNil
- ].
- nm = 'super' ifTrue:[
- classProvidingNamespaceOrNil isNil ifTrue:[^ Object].
- ^ classProvidingNamespaceOrNil superclass
- ].
- nm isUppercaseFirst ifTrue:[
- "/ wouldn't it be better to simply 'evaluate' the variable ?
- Error handle:[:ex |
- ] do:[
- |dummyReceiver|
-
- dummyReceiver := classProvidingNamespaceOrNil notNil ifTrue:[classProvidingNamespaceOrNil basicNew] ifFalse:[nil].
- nodeVal := Parser new evaluate:nm in:nil receiver:dummyReceiver.
- ].
-"/ (Smalltalk includesKey:nm asSymbol) ifTrue:[
-"/ nodeVal := Smalltalk at:nm asSymbol.
-"/ ].
- nodeVal notNil ifTrue:[
- ^ nodeVal class
- ]
- ]
- ].
-
- receiver isMessage ifTrue:[
- (receiver selector = 'new'
- or:[ receiver selector = 'new:' ]) ifTrue:[
- receiverClass := self lookupClassForMessage:receiver inClass:classProvidingNamespaceOrNil.
- receiverClass notNil ifTrue:[
- receiverClass isBehavior ifTrue:[
- receiverClass isMeta ifTrue:[
- ^ receiverClass theNonMetaclass
- ]
- ]
- ].
- ].
- classProvidingNamespaceOrNil notNil ifTrue:[
- (receiver receiver isSelf and:[receiver selector = 'class']) ifTrue:[
- ^ classProvidingNamespaceOrNil class
- ].
- ].
- ].
- ^ nil
-
- "Modified: / 24-08-2010 / 15:05:49 / sr"
- "Modified: / 17-07-2011 / 10:28:19 / cg"
-!
-
-old_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 includes: lastChoice) 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
- initialSelection:(list firstIfEmpty:nil)
- title:(resources string:'Code completion').
- choice isNil ifTrue:[^ nil].
- ].
-
- LastChoices isNil ifTrue:[
- LastChoices := Dictionary new.
- ].
- LastChoices at:what put:choice.
- ^ choice
-
- "Created: / 16-02-2010 / 09:38:41 / Jan Vrany <jan.vrany@fit.cvut.cz>"
- "Modified: / 21-07-2012 / 12:21:10 / cg"
-!
-
-treeForCode:source allowErrors:allowErrors
- |tree|
-
- source = LastSource ifTrue:[
- tree := LastParseTree.
- ] ifFalse:[
- tree := RBParser
- parseMethod:source
- onError: [:str :err :nodesSoFar :parserOrNil|
- allowErrors ifTrue:[
- "/ parserOrNil isNil if raised by the scanner
- parserOrNil notNil ifTrue:[
- ^ parserOrNil currentMethodNode
- ]
- ].
- ^ nil
- ]
- proceedAfterError:false
- rememberNodes:true.
-
- tree notNil ifTrue:[
- LastSource := source.
- LastParseTree := tree.
- ]
- ].
- ^ tree
-
- "Modified: / 13-01-2012 / 11:54:30 / cg"
+ ^ self new findNodeIn:tree forInterval:interval
! !
!DoWhatIMeanSupport class methodsFor:'input completion support'!
@@ -2260,6 +1096,2303 @@
"Created: / 16-01-2008 / 17:17:13 / cg"
! !
+!DoWhatIMeanSupport methodsFor:'code completion'!
+
+codeCompletionForClass:classOrNilArg context:contextOrNil codeView:codeViewArg
+ "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 parent checkedNode|
+
+ classOrNil := classOrNilArg.
+ codeView := codeViewArg.
+
+"/ 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-1 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.
+ classOrNil notNil ifTrue:[
+ node := self findNodeForInterval:interval in:source allowErrors:true mustBeMethod:true.
+ ].
+ node isNil ifTrue:[
+ node := self findNodeForInterval:interval in:source allowErrors:true mustBeMethod:false.
+ ].
+"/ [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:[ (parent := node parent) notNil
+ and:[ parent isMessage
+ and:[ node stop < (codeView characterPositionOfCursor-1) ]]]) ifTrue:[
+ 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.
+ ].
+ ].
+
+ 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: / 16-09-2011 / 14:54:47 / cg"
+! !
+
+!DoWhatIMeanSupport methodsFor:'code completion-helpers'!
+
+askUserForCompletion:what for:codeView at:position from:allTheBest
+ |list choice lastChoice|
+
+ "/ cg: until the new stuff works,...
+ ^ self old_askUserForCompletion:what for:codeView from:allTheBest.
+
+ 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).
+ ].
+ ].
+ choice := Tools::CodeCompletionMenu
+ openFor:codeView
+ at:position
+ with:allTheBest.
+ LastChoices isNil ifTrue:[
+ LastChoices := Dictionary new.
+ ].
+ LastChoices at:what put:choice.
+ ^ choice
+
+ "Created: / 16-02-2010 / 10:09:57 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified (format): / 08-07-2011 / 08:49:35 / cg"
+!
+
+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"
+!
+
+codeCompletionForLiteralSymbol:node into:actionBlock
+ |sym possibleCompletions best start stop oldLen newLen oldVar|
+
+Transcript show:'lit in '; show:methodOrNil; show:' / '; showCR:classOrNil.
+
+ 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:[
+ actionBlock value:possibleCompletions value:nil.
+ ^ self.
+ ].
+
+ actionBlock value:(Array with:best) value:nil.
+^ 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
+ ].
+
+ "Modified: / 16-02-2010 / 10:15:05 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified (format): / 03-07-2011 / 15:58:45 / cg"
+!
+
+codeCompletionForMessage:node into:actionBlock
+ |selector srchClass implClass
+ bestSelectors selector2 bestSelectors2 allBest best info numArgs
+ newParts nSelParts oldLen newLen selectorParts
+ findBest parentNode selectorInBest selector2InBest2
+ parser selectorsSentInCode split editAction|
+
+Transcript show:'msg in '; show:methodOrNil; show:' / '; showCR:classOrNil.
+
+"/ classOrNil notNil ifTrue:[
+"/ parser := Parser parseMethod:codeView contents string in:classOrNil ignoreErrors:true ignoreWarnings:true.
+"/ selectorsSentInCode := parser messagesSent.
+"/ ].
+
+ findBest := [:node :selector |
+ |srchClass bestSelectors bestPrefixes|
+
+ codeView topView withCursor:(Cursor questionMark) do:[
+ srchClass := self lookupClassForMessage:node inClass:classOrNil.
+ srchClass notNil ifTrue:[
+ bestSelectors := Parser findBest:30 selectorsFor:selector in:srchClass forCompletion:true.
+ ] ifFalse:[
+ 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:classOrNil.
+ 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
+ ].
+
+ selectorsSentInCode notNil ifTrue:[
+ "/ 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
+ allBest := split value:allBest value:[:sel | sel notNil and:[sel startsWith:selector]].
+
+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.
+].
+ editAction :=
+ [:index |
+ |best|
+
+ best := allBest at:index.
+
+ 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 := 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 := stop + (newLen-oldLen).
+ ].
+ codeView cursorToCharacterPosition:newCursorPosition.
+ codeView cursorRight. "/ avoid going to the next line !!
+ codeView dontReplaceSelectionOnInput.
+ ]
+ info:'Completion'.
+ ].
+ ].
+
+ actionBlock value:allBest value:editAction.
+
+ "Created: / 10-11-2006 / 13:18:27 / cg"
+ "Modified: / 16-02-2010 / 10:33:48 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 21-07-2012 / 12:24:06 / cg"
+!
+
+codeCompletionForMethod:node
+ "completion in a method's selector pattern"
+
+ |crsrPos
+ selectorSoFar matchingSelectors
+ selectors distances best rest
+ allExistingMethods nameBag namesByCount selectors1 selectors2|
+
+ 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:[
+ (classOrNil notNil and:[classOrNil isMeta]) ifTrue:[
+ matchingSelectors := Smalltalk allClasses
+ inject:(Set new)
+ into:[:theSet :eachClass |
+ |md|
+
+ md := eachClass theMetaclass methodDictionary.
+ theSet addAll:(md keys select:[:sel |sel startsWith:selectorSoFar]).
+ theSet.
+ ].
+ "/ dont forget the stuff in the class-line
+ Metaclass withAllSuperclassesDo:[:cls |
+ matchingSelectors addAll:(cls methodDictionary keys select:[:sel |sel startsWith:selectorSoFar]).
+ ].
+ ] ifFalse:[
+ matchingSelectors := Smalltalk allClasses
+ inject:(Set new)
+ into:[:theSet :eachClass |
+ |md|
+
+ 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:[
+ selectorSoFar numArgs == 0 ifTrue:[ ^ self ].
+
+ allExistingMethods := (Smalltalk allImplementorsOf:selectorSoFar asSymbol)
+ collect:[:cls | cls compiledMethodAt:selectorSoFar asSymbol].
+ nameBag := Bag new.
+ allExistingMethods do:[:eachMethod | nameBag addAll:(eachMethod methodArgNames ? #())].
+ namesByCount := nameBag valuesAndCounts sort:[:a :b | a value < b value].
+ "/ take the one which occurs most often
+ best := self askUserForCompletion:'argument' for:codeView at: node start 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:[
+ "the ones implemented in superclasses are shown first"
+ classOrNil notNil ifTrue:[
+ selectors1 := selectors select:[:sel | classOrNil respondsTo:sel]. "/ in super
+ selectors2 := selectors reject:[:sel | selectors1 includes:sel ]. "/ not in super
+ ] ifFalse:[
+ selectors1 := selectors
+ ].
+
+ distances := selectors1 collect:[:each | each spellAgainst:selectorSoFar].
+ distances sortWith:selectors1.
+ selectors1 reverse.
+ selectors := selectors1.
+
+ selectors2 notEmptyOrNil ifTrue:[
+ distances := selectors2 collect:[:each | each spellAgainst:selectorSoFar].
+ distances sortWith:selectors2.
+ selectors2 reverse.
+ selectors1 := selectors1 collect:[:sel | sel allBold].
+ selectors := selectors1,selectors2.
+ ].
+
+ best := self askUserForCompletion:'selector' for:codeView at:(node start) from:selectors.
+ best isNil ifTrue:[^ self].
+
+ rest := best copyFrom:selectorSoFar size.
+ codeView
+ undoableDo:[
+ codeView
+ replaceFromCharacterPosition:crsrPos+1
+ to:crsrPos+1
+ with:rest
+ ]
+ info:'Completion'.
+ codeView cursorToCharacterPosition:(crsrPos+1 + 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"
+ "Modified: / 16-02-2010 / 10:13:56 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 01-06-2012 / 20:31:36 / cg"
+!
+
+codeCompletionForMethod:node inClass:classOrNil codeView:codeView
+ "completion in a method's selector pattern"
+
+ |crsrPos
+ selectorSoFar matchingSelectors
+ selectors distances best rest
+ allExistingMethods nameBag namesByCount selectors1 selectors2|
+
+ 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:[
+ (classOrNil notNil and:[classOrNil isMeta]) ifTrue:[
+ matchingSelectors := Smalltalk allClasses
+ inject:(Set new)
+ into:[:theSet :eachClass |
+ |md|
+
+ md := eachClass theMetaclass methodDictionary.
+ theSet addAll:(md keys select:[:sel |sel startsWith:selectorSoFar]).
+ theSet.
+ ].
+ "/ dont forget the stuff in the class-line
+ Metaclass withAllSuperclassesDo:[:cls |
+ matchingSelectors addAll:(cls methodDictionary keys select:[:sel |sel startsWith:selectorSoFar]).
+ ].
+ ] ifFalse:[
+ matchingSelectors := Smalltalk allClasses
+ inject:(Set new)
+ into:[:theSet :eachClass |
+ |md|
+
+ 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:[
+ selectorSoFar numArgs == 0 ifTrue:[ ^ self ].
+
+ allExistingMethods := (Smalltalk allImplementorsOf:selectorSoFar asSymbol)
+ collect:[:cls | cls compiledMethodAt:selectorSoFar asSymbol].
+ nameBag := Bag new.
+ allExistingMethods do:[:eachMethod | nameBag addAll:(eachMethod methodArgNames ? #())].
+ namesByCount := nameBag valuesAndCounts sort:[:a :b | a value < b value].
+ "/ take the one which occurs most often
+ best := self askUserForCompletion:'argument' for:codeView at: node start 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:[
+ "the ones implemented in superclasses are shown first"
+ classOrNil notNil ifTrue:[
+ selectors1 := selectors select:[:sel | classOrNil respondsTo:sel]. "/ in super
+ selectors2 := selectors reject:[:sel | selectors1 includes:sel ]. "/ not in super
+ ] ifFalse:[
+ selectors1 := selectors
+ ].
+
+ distances := selectors1 collect:[:each | each spellAgainst:selectorSoFar].
+ distances sortWith:selectors1.
+ selectors1 reverse.
+ selectors := selectors1.
+
+ selectors2 notEmptyOrNil ifTrue:[
+ distances := selectors2 collect:[:each | each spellAgainst:selectorSoFar].
+ distances sortWith:selectors2.
+ selectors2 reverse.
+ selectors1 := selectors1 collect:[:sel | sel allBold].
+ selectors := selectors1,selectors2.
+ ].
+
+ best := self askUserForCompletion:'selector' for:codeView at:(node start) from:selectors.
+ best isNil ifTrue:[^ self].
+
+ rest := best copyFrom:selectorSoFar size.
+ codeView
+ undoableDo:[
+ codeView
+ replaceFromCharacterPosition:crsrPos+1
+ to:crsrPos+1
+ with:rest
+ ]
+ info:'Completion'.
+ codeView cursorToCharacterPosition:(crsrPos+1 + 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"
+ "Modified: / 16-02-2010 / 10:13:56 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 01-06-2012 / 20:31:36 / cg"
+!
+
+codeCompletionForMethod:node inClass:classOrNil codeView:codeView into:actionBlock
+ "completion in a method's selector pattern"
+
+ |crsrPos
+ selectorSoFar matchingSelectors
+ selectors distances best rest
+ allExistingMethods nameBag namesByCount selectors1 selectors2|
+
+Transcript showCR:'m'.
+ 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:[
+ (classOrNil notNil and:[classOrNil isMeta]) ifTrue:[
+ matchingSelectors := Smalltalk allClasses
+ inject:(Set new)
+ into:[:theSet :eachClass |
+ |md|
+
+ md := eachClass theMetaclass methodDictionary.
+ theSet addAll:(md keys select:[:sel |sel startsWith:selectorSoFar]).
+ theSet.
+ ].
+ "/ dont forget the stuff in the class-line
+ Metaclass withAllSuperclassesDo:[:cls |
+ matchingSelectors addAll:(cls methodDictionary keys select:[:sel |sel startsWith:selectorSoFar]).
+ ].
+ ] ifFalse:[
+ matchingSelectors := Smalltalk allClasses
+ inject:(Set new)
+ into:[:theSet :eachClass |
+ |md|
+
+ 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:[
+ selectorSoFar numArgs == 0 ifTrue:[ ^ self ].
+
+ allExistingMethods := (Smalltalk allImplementorsOf:selectorSoFar asSymbol)
+ collect:[:cls | cls compiledMethodAt:selectorSoFar asSymbol].
+ nameBag := Bag new.
+ allExistingMethods do:[:eachMethod | nameBag addAll:(eachMethod methodArgNames ? #())].
+ namesByCount := nameBag valuesAndCounts sort:[:a :b | a value < b value].
+ "/ take the one which occurs most often
+ "/ best := self askUserForCompletion:'argument' for:codeView at: node start from:(namesByCount collect:[:a | a key]).
+ actionBlock value:(namesByCount collect:[:a | a key]) value:nil.
+ ^ self.
+
+ 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:[
+ "the ones implemented in superclasses are shown first"
+ classOrNil notNil ifTrue:[
+ selectors1 := selectors select:[:sel | classOrNil respondsTo:sel]. "/ in super
+ selectors2 := selectors reject:[:sel | selectors1 includes:sel ]. "/ not in super
+ ] ifFalse:[
+ selectors1 := selectors
+ ].
+
+ distances := selectors1 collect:[:each | each spellAgainst:selectorSoFar].
+ distances sortWith:selectors1.
+ selectors1 reverse.
+ selectors := selectors1.
+
+ selectors2 notEmptyOrNil ifTrue:[
+ distances := selectors2 collect:[:each | each spellAgainst:selectorSoFar].
+ distances sortWith:selectors2.
+ selectors2 reverse.
+ selectors1 := selectors1 collect:[:sel | sel allBold].
+ selectors := selectors1,selectors2.
+ ].
+
+ "/ best := self askUserForCompletion:'selector' for:codeView at:(node start) from:selectors.
+ best := actionBlock value:selectors value:nil.
+ best isNil ifTrue:[^ self].
+
+ rest := best copyFrom:selectorSoFar size.
+ codeView
+ undoableDo:[
+ codeView
+ replaceFromCharacterPosition:crsrPos+1
+ to:crsrPos+1
+ with:rest
+ ]
+ info:'Completion'.
+ codeView cursorToCharacterPosition:(crsrPos+1 + 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"
+ "Modified: / 16-02-2010 / 10:13:56 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 01-06-2012 / 20:31:36 / cg"
+!
+
+codeCompletionForMethod:node into:actionBlock
+ "completion in a method's selector pattern"
+
+ |crsrPos
+ selectorSoFar matchingSelectors
+ selectors distances best rest
+ allExistingMethods nameBag namesByCount selectors1 selectors2|
+
+Transcript showCR:'m'.
+ 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:[
+ (classOrNil notNil and:[classOrNil isMeta]) ifTrue:[
+ matchingSelectors := Smalltalk allClasses
+ inject:(Set new)
+ into:[:theSet :eachClass |
+ |md|
+
+ md := eachClass theMetaclass methodDictionary.
+ theSet addAll:(md keys select:[:sel |sel startsWith:selectorSoFar]).
+ theSet.
+ ].
+ "/ dont forget the stuff in the class-line
+ Metaclass withAllSuperclassesDo:[:cls |
+ matchingSelectors addAll:(cls methodDictionary keys select:[:sel |sel startsWith:selectorSoFar]).
+ ].
+ ] ifFalse:[
+ matchingSelectors := Smalltalk allClasses
+ inject:(Set new)
+ into:[:theSet :eachClass |
+ |md|
+
+ 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:[
+ selectorSoFar numArgs == 0 ifTrue:[ ^ self ].
+
+ allExistingMethods := (Smalltalk allImplementorsOf:selectorSoFar asSymbol)
+ collect:[:cls | cls compiledMethodAt:selectorSoFar asSymbol].
+ nameBag := Bag new.
+ allExistingMethods do:[:eachMethod | nameBag addAll:(eachMethod methodArgNames ? #())].
+ namesByCount := nameBag valuesAndCounts sort:[:a :b | a value < b value].
+ "/ take the one which occurs most often
+ "/ best := self askUserForCompletion:'argument' for:codeView at: node start from:(namesByCount collect:[:a | a key]).
+ actionBlock value:(namesByCount collect:[:a | a key]) value:nil.
+ ^ self.
+
+ 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:[
+ "the ones implemented in superclasses are shown first"
+ classOrNil notNil ifTrue:[
+ selectors1 := selectors select:[:sel | classOrNil respondsTo:sel]. "/ in super
+ selectors2 := selectors reject:[:sel | selectors1 includes:sel ]. "/ not in super
+ ] ifFalse:[
+ selectors1 := selectors
+ ].
+
+ distances := selectors1 collect:[:each | each spellAgainst:selectorSoFar].
+ distances sortWith:selectors1.
+ selectors1 reverse.
+ selectors := selectors1.
+
+ selectors2 notEmptyOrNil ifTrue:[
+ distances := selectors2 collect:[:each | each spellAgainst:selectorSoFar].
+ distances sortWith:selectors2.
+ selectors2 reverse.
+ selectors1 := selectors1 collect:[:sel | sel allBold].
+ selectors := selectors1,selectors2.
+ ].
+
+ "/ best := self askUserForCompletion:'selector' for:codeView at:(node start) from:selectors.
+ best := actionBlock value:selectors value:nil.
+ best isNil ifTrue:[^ self].
+
+ rest := best copyFrom:selectorSoFar size.
+ codeView
+ undoableDo:[
+ codeView
+ replaceFromCharacterPosition:crsrPos+1
+ to:crsrPos+1
+ with:rest
+ ]
+ info:'Completion'.
+ codeView cursorToCharacterPosition:(crsrPos+1 + 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"
+ "Modified: / 16-02-2010 / 10:13:56 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 01-06-2012 / 20:31:36 / cg"
+!
+
+codeCompletionForMethod:methodOrNilArg orClass:classOrNilArg context:contextOrNil codeView:codeViewArg into:actionBlock
+ "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|
+
+ methodOrNil := methodOrNilArg.
+ classOrNil := classOrNilArg.
+ codeView := codeViewArg.
+
+"/ 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-1 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.
+ classOrNil notNil ifTrue:[
+ node := self findNodeForInterval:interval in:source allowErrors:true mustBeMethod:true.
+ ].
+ node isNil ifTrue:[
+ node := self findNodeForInterval:interval in:source allowErrors:true mustBeMethod:false.
+ ].
+"/ [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 into:actionBlock.
+ ^ self.
+ ].
+ node isLiteral ifTrue:[
+ node value isSymbol ifTrue:[
+ self codeCompletionForLiteralSymbol:node into:actionBlock.
+ ^ self.
+ ].
+ ].
+
+ checkedNode := node.
+ [checkedNode notNil] whileTrue:[
+ checkedNode isMessage ifTrue:[
+ "/ completion in a message-send
+ self codeCompletionForMessage:checkedNode into:actionBlock.
+ ^ self
+ ].
+ checkedNode isMethod ifTrue:[
+ "/ completion in a method's selector pattern
+ self codeCompletionForMethod:checkedNode into:actionBlock.
+ ^ self.
+ ].
+ checkedNode := checkedNode parent.
+ ].
+
+ self information:'Node is neither variable nor message.'.
+
+ "Modified: / 04-07-2006 / 18:48:26 / fm"
+ "Modified: / 16-09-2011 / 14:54:47 / cg"
+!
+
+codeCompletionForVariable:node into:actionBlock
+ |nonMetaClass crsrPos nm parent
+ allVariables allDistances variablesAlreadyAdded nodeVal
+ char oldLen newLen
+ getDistanceComputeBlockWithWeight addWithFactorBlock names allTheBest bestAssoc
+ globalFactor localFactor selectorOfMessageToNode tree implementors argIdx namesUsed kwPart
+ editAction suggestions nameIsOK|
+
+Transcript show:'var in '; show:methodOrNil; show:' / '; showCR:classOrNil.
+ 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:[
+ nm knownAsSymbol 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'
+ ].
+ editAction :=
+ [:answer |
+ codeView
+ undoableDo:[
+ codeView insertString:answer atCharacterPosition:crsrPos.
+ codeView cursorToCharacterPosition:crsrPos+answer size.
+ ]
+ info:'completion'.
+ ].
+ actionBlock value:(methods collect:[:each | each selector]) value:editAction.
+ ^ self.
+ ].
+ ].
+ ].
+
+ parent := node parent.
+ (parent notNil and:[parent isMessage]) ifTrue:[
+ node == parent receiver ifTrue:[
+ selectorOfMessageToNode := 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)
+ ]
+ ].
+
+ nameIsOK := false.
+ addWithFactorBlock :=
+ [:names :factor | |namesToAdd|
+ (names includes:nm) ifTrue:[nameIsOK := true].
+ namesToAdd := names reject:[:nameToAdd | (nameToAdd = nm)].
+ namesToAdd := namesToAdd reject:[:each | variablesAlreadyAdded includes:each ].
+ variablesAlreadyAdded addAll:namesToAdd.
+ 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.
+ ].
+
+ variablesAlreadyAdded := Set new.
+ allVariables := OrderedCollection new.
+ allDistances := OrderedCollection new.
+
+ "/ are we in the method's selector spec ?
+ (parent notNil
+ and:[parent isMethod
+ and:[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:(parent selector)
+ in:(Smalltalk allClasses)
+ ignoreCase:false.
+ "/ which argument is it
+ argIdx := 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].
+
+ 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
+ parent selector isKeyword ifTrue:[
+ kwPart := parent selector keywords at:argIdx.
+ (classOrNil allInstVarNames includes:(kwPart copyButLast: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 ] as:OrderedCollection.
+ 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).
+
+ "/ pool variables
+ classOrNil theNonMetaclass sharedPoolNames do:[:poolName |
+ |pool names|
+
+ pool := Smalltalk at:poolName.
+ names := pool classVarNames.
+ 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:(2.5 * globalFactor).
+ addWithFactorBlock value:nonResponders value:(0.5 * 2.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:(2.0 * globalFactor).
+ classOrNil superclass notNil ifTrue:[
+ addWithFactorBlock value:nonMetaClass superclass allClassVarNames value:(2.0 * 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 sharedPoolNames do:[:poolName |
+ |pool names|
+
+ pool := Smalltalk at:poolName.
+ names := pool classVarNames.
+ addWithFactorBlock value:names value:(2.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).
+ ].
+
+ allDistances isEmpty ifTrue:[^ self].
+
+ 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:[
+ a value = b value ifTrue:[
+ a key < b key
+ ] ifFalse:[
+ false
+ ]
+ ]
+ ].
+ allTheBest := allDistances select:[:entry | entry value >= (bestAssoc value * 0.5)].
+ nameIsOK ifTrue:[
+ allTheBest := allTheBest select:[:assoc | assoc key startsWith:nm].
+ ].
+
+ allTheBest size > 15 ifTrue:[
+ allTheBest := allDistances select:[:entry | entry value >= (bestAssoc value * 0.8)].
+ ].
+ suggestions := allTheBest collect:[:assoc | assoc key].
+
+ editAction :=
+ [:index |
+ |answer start stop oldVar|
+
+ answer := suggestions at:index.
+
+ start := node start.
+ stop := node stop.
+ oldVar := (codeView textFromCharacterPosition:start to:stop) asString string withoutSeparators.
+
+ codeView
+ undoableDo:[ codeView replaceFromCharacterPosition:start to:stop with:answer ]
+ info:'Completion'.
+
+ (answer startsWith:oldVar) ifTrue:[
+ oldLen := stop - start + 1.
+ newLen := answer size.
+ codeView selectFromCharacterPosition:start+oldLen to:start+newLen-1.
+ codeView dontReplaceSelectionOnInput
+ ].
+ ].
+
+ actionBlock value:suggestions value:editAction.
+
+ "Created: / 10-11-2006 / 13:16:33 / cg"
+ "Modified: / 16-02-2010 / 10:13:13 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 22-08-2012 / 22:07:24 / cg"
+!
+
+findNodeForInterval:interval in:source
+ |tree node|
+
+ interval isEmpty ifTrue: [^ nil].
+ RBParser isNil ifTrue: [^ nil].
+
+ source = LastSource ifTrue:[
+ tree := LastParseTree.
+ ] ifFalse:[
+ 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:[
+ ^ nil
+ ].
+ ].
+
+ LastSource := source.
+ LastParseTree := tree.
+ ].
+
+ 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
+ findNodeForInterval:interval in:source allowErrors:allowErrors
+ mustBeMethod:false
+
+ "Modified: / 16-09-2011 / 14:52:28 / cg"
+!
+
+findNodeForInterval:interval in:source allowErrors:allowErrors mustBeMethod:mustBeMethod
+ "if mustBeMethod is true, do not try a regular expression (as in a workspace)."
+
+ |"errCount" intersectingNodes smallestIntersectingNode firstIntersectingNode onErrorBlock nodeGenerationHook parser|
+
+ interval isEmpty ifTrue: [^ nil].
+ RBParser isNil ifTrue: [^ nil].
+
+ "/ LastSource := nil.
+ source = LastSource ifTrue:[
+ tree := LastParseTree.
+ tokens := LastScanTokens.
+ ] ifFalse:[
+ intersectingNodes := OrderedCollection new.
+
+ onErrorBlock :=
+ [:str :err :nodesSoFar |
+ |nodes|
+
+ allowErrors ifTrue:[
+ firstIntersectingNode notNil ifTrue:[^ firstIntersectingNode].
+ nodesSoFar notNil ifTrue:[
+ nodes := nodesSoFar asOrderedCollection
+ collect:[:nd | nd whichNodeIntersects:interval]
+ thenSelect:[:nd | nd notNil ].
+ nodes size == 1 ifTrue:[
+ ^ nodes first
+ ].
+ ]
+ ].
+ nil
+ ].
+
+ nodeGenerationHook :=
+ [:node |
+ "/ we would like to return here as soon as the node has been created by the parser;
+ "/ however, at that time, its parent(chain) is not yet created and so we might not know
+ "/ what the semantic intepretation (especially: scope of variable) will be.
+ "/ therefore, we parse all, and return the found node at the end.
+ "//// ^ node.
+"/ self halt.
+ (node intersectsInterval:interval) ifTrue:[
+ intersectingNodes add:node.
+ firstIntersectingNode isNil ifTrue:[
+ firstIntersectingNode := smallestIntersectingNode := node
+ ] ifFalse:[
+ |lenNode lenSmallest|
+
+ lenNode := (node stop - node start).
+ lenSmallest := (smallestIntersectingNode stop - smallestIntersectingNode start).
+ lenNode < lenSmallest ifTrue:[
+ smallestIntersectingNode := node.
+ ]
+ ].
+ ].
+ ].
+
+ tree := RBParser
+ parseMethod: source
+ setup:[:p |
+ parser := p.
+ p rememberNodes:true.
+ p rememberTokens:true.
+ p nodeGenerationCallback:nodeGenerationHook
+ ]
+ onError: onErrorBlock.
+ parser notNil ifTrue:[ tokens := parser rememberedTokens ].
+
+ mustBeMethod ifTrue:[
+ "/ only cache parsed methods
+ tree notNil ifTrue:[
+ LastSource := source.
+ LastParseTree := tree.
+ LastScanTokens := tokens.
+ ].
+ ] ifFalse:[
+ (tree isNil or:[firstIntersectingNode isNil]) ifTrue:[
+ "/ try as an expression
+ tree := RBParser
+ parseExpression: source
+ setup:[:p |
+ parser := p.
+ p rememberNodes:true.
+ p rememberTokens:true.
+ p nodeGenerationCallback:nodeGenerationHook
+ ]
+ onError: onErrorBlock.
+ tokens := parser rememberedTokens.
+ ].
+ ].
+"/ self halt.
+ firstIntersectingNode notNil ifTrue:[ ^ firstIntersectingNode ].
+ ].
+
+ ^ self findNodeForInterval:interval inParseTree:tree.
+
+ "Created: / 16-09-2011 / 14:52:08 / cg"
+!
+
+findNodeForInterval:interval inParseTree:parseTree
+ |node|
+
+ interval isEmpty ifTrue: [^ nil].
+ parseTree isNil ifTrue:[^ nil].
+
+ node := parseTree whichNodeIsContainedBy:interval.
+ node isNil ifTrue:[
+ node := parseTree whichNodeIntersects:interval.
+ node isNil ifTrue: [
+ node := self findNodeIn:parseTree forInterval:interval
+ ].
+ ].
+ ^ node
+
+ "Modified: / 10-11-2006 / 13:13:58 / cg"
+!
+
+findNodeIn:tree forInterval:interval
+ |nodeFound wouldReturn|
+
+ nodeFound := nil.
+ tree nodesDo:[:eachNode |
+ (eachNode intersectsInterval:interval) 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"
+!
+
+lookupClassForMessage:node inClass:classProvidingNamespaceOrNil
+ |receiver nm nodeVal receiverClass|
+
+ receiver := node receiver.
+ receiver isLiteral ifTrue:[
+ ^ receiver value class
+ ].
+ receiver isVariable ifTrue:[
+ nm := receiver name.
+ nm = 'self' ifTrue:[
+ classProvidingNamespaceOrNil isNil ifTrue:[^ UndefinedObject].
+ ^ classProvidingNamespaceOrNil
+ ].
+ nm = 'super' ifTrue:[
+ classProvidingNamespaceOrNil isNil ifTrue:[^ Object].
+ ^ classProvidingNamespaceOrNil superclass
+ ].
+ nm isUppercaseFirst ifTrue:[
+ "/ wouldn't it be better to simply 'evaluate' the variable ?
+ Error handle:[:ex |
+ ] do:[
+ |dummyReceiver|
+
+ dummyReceiver := classProvidingNamespaceOrNil notNil ifTrue:[classProvidingNamespaceOrNil basicNew] ifFalse:[nil].
+ nodeVal := Parser new evaluate:nm in:nil receiver:dummyReceiver.
+ ].
+"/ (Smalltalk includesKey:nm asSymbol) ifTrue:[
+"/ nodeVal := Smalltalk at:nm asSymbol.
+"/ ].
+ nodeVal notNil ifTrue:[
+ ^ nodeVal class
+ ]
+ ]
+ ].
+
+ receiver isMessage ifTrue:[
+ (receiver selector = 'new'
+ or:[ receiver selector = 'new:' ]) ifTrue:[
+ receiverClass := self lookupClassForMessage:receiver inClass:classProvidingNamespaceOrNil.
+ receiverClass notNil ifTrue:[
+ receiverClass isBehavior ifTrue:[
+ receiverClass isMeta ifTrue:[
+ ^ receiverClass theNonMetaclass
+ ]
+ ]
+ ].
+ ].
+ classProvidingNamespaceOrNil notNil ifTrue:[
+ (receiver receiver isSelf and:[receiver selector = 'class']) ifTrue:[
+ ^ classProvidingNamespaceOrNil class
+ ].
+ ].
+ ].
+ ^ nil
+
+ "Modified: / 24-08-2010 / 15:05:49 / sr"
+ "Modified: / 17-07-2011 / 10:28:19 / cg"
+!
+
+old_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 includes: lastChoice) 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
+ initialSelection:(list firstIfEmpty:nil)
+ title:(resources string:'Code completion').
+ choice isNil ifTrue:[^ nil].
+ ].
+
+ LastChoices isNil ifTrue:[
+ LastChoices := Dictionary new.
+ ].
+ LastChoices at:what put:choice.
+ ^ choice
+
+ "Created: / 16-02-2010 / 09:38:41 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 21-07-2012 / 12:21:10 / cg"
+!
+
+treeForCode:source allowErrors:allowErrors
+ |tree|
+
+ source = LastSource ifTrue:[
+ tree := LastParseTree.
+ ] ifFalse:[
+ tree := RBParser
+ parseMethod:source
+ onError: [:str :err :nodesSoFar :parserOrNil|
+ allowErrors ifTrue:[
+ "/ parserOrNil isNil if raised by the scanner
+ parserOrNil notNil ifTrue:[
+ ^ parserOrNil currentMethodNode
+ ]
+ ].
+ ^ nil
+ ]
+ proceedAfterError:false
+ rememberNodes:true.
+
+ tree notNil ifTrue:[
+ LastSource := source.
+ LastParseTree := tree.
+ ]
+ ].
+ ^ tree
+
+ "Modified: / 13-01-2012 / 11:54:30 / cg"
+! !
+
+!DoWhatIMeanSupport methodsFor:'code completion-helpers-old'!
+
+codeCompletionForLiteralSymbol:node inClass:classOrNil 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 at: node start 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
+ ].
+
+ "Modified: / 16-02-2010 / 10:15:05 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified (format): / 03-07-2011 / 15:58:45 / cg"
+!
+
+codeCompletionForMessage:node inClass:classOrNil codeView:codeView
+ |selector srchClass implClass
+ bestSelectors selector2 bestSelectors2 allBest best info numArgs
+ newParts nSelParts oldLen newLen selectorParts
+ findBest parentNode selectorInBest selector2InBest2
+ parser selectorsSentInCode split|
+
+ classOrNil notNil ifTrue:[
+ parser := Parser parseMethod:codeView contents string in:classOrNil ignoreErrors:true ignoreWarnings:true.
+ selectorsSentInCode := parser messagesSent.
+ ].
+
+ findBest := [:node :selector |
+ |srchClass bestSelectors bestPrefixes|
+
+ codeView topView withCursor:(Cursor questionMark) do:[
+ srchClass := self lookupClassForMessage:node inClass:classOrNil.
+ srchClass notNil ifTrue:[
+ bestSelectors := Parser findBest:30 selectorsFor:selector in:srchClass forCompletion:true.
+ ] ifFalse:[
+ 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:classOrNil.
+ 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
+ ].
+
+ selectorsSentInCode notNil ifTrue:[
+ "/ 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
+ allBest := split value:allBest value:[:sel | sel notNil and:[sel startsWith:selector]].
+
+ 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 := self askUserForCompletion:'selector' for:codeView at: node selectorParts first start from: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 := 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 := 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"
+ "Modified: / 16-02-2010 / 10:33:48 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 21-07-2012 / 12:24:06 / 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] as:Set.
+
+ 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 copyButLast: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).
+
+ "/ pool variables
+ classOrNil theNonMetaclass sharedPoolNames do:[:poolName |
+ |pool names|
+
+ pool := Smalltalk at:poolName.
+ names := pool classVarNames.
+ 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:(2.5 * globalFactor).
+ addWithFactorBlock value:nonResponders value:(0.5 * 2.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:(2.0 * globalFactor).
+ classOrNil superclass notNil ifTrue:[
+ addWithFactorBlock value:nonMetaClass superclass allClassVarNames value:(2.0 * 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 sharedPoolNames do:[:poolName |
+ |pool names|
+
+ pool := Smalltalk at:poolName.
+ names := pool classVarNames.
+ addWithFactorBlock value:names value:(2.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).
+ ].
+
+ allDistances isEmpty ifTrue:[^ self].
+ 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:[
+ a value = b value ifTrue:[
+ a key < b key
+ ] ifFalse:[
+ false
+ ]
+ ]
+ ].
+ allTheBest := allDistances select:[:entry | entry value >= (bestAssoc value * 0.5)].
+ allTheBest size > 15 ifTrue:[
+ allTheBest := allDistances select:[:entry | entry value >= (bestAssoc value * 0.8)].
+ ].
+
+ best := self askUserForCompletion:'variable' for:codeView at: node start from:(allTheBest collect:[:assoc | assoc key]).
+ best isNil ifTrue:[^ self].
+
+"/ self showInfo:best.
+
+ start := node start.
+ stop := node stop.
+ 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
+ ].
+
+ "Created: / 10-11-2006 / 13:16:33 / cg"
+ "Modified: / 16-02-2010 / 10:13:13 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 22-08-2012 / 22:07:24 / cg"
+! !
+
!DoWhatIMeanSupport::InputCompletionResult class methodsFor:'instance creation'!
bestName:bestNameArg matchingNames:matchingNamesArg
@@ -2283,6 +3416,6 @@
!DoWhatIMeanSupport class methodsFor:'documentation'!
version_CVS
- ^ '$Header: /cvs/stx/stx/libwidg2/DoWhatIMeanSupport.st,v 1.100 2013-05-07 15:28:31 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libwidg2/DoWhatIMeanSupport.st,v 1.101 2013-06-14 14:35:39 cg Exp $'
! !