--- a/DoWhatIMeanSupport.st Wed Jul 06 12:19:04 2011 +0200
+++ b/DoWhatIMeanSupport.st Wed Jul 06 14:17:22 2011 +0200
@@ -87,7 +87,7 @@
interval := codeView selectedInterval.
interval isEmpty ifTrue:[
- interval := crsrPos to:crsrPos.
+ interval := crsrPos-1 to:crsrPos.
].
source := codeView contentsAsString string.
@@ -134,9 +134,6 @@
^ self.
].
].
- classOrNil isNil ifTrue:[
- ^ self.
- ].
checkedNode := node.
[checkedNode notNil] whileTrue:[
@@ -156,7 +153,7 @@
self information:'Node is neither variable nor message.'.
"Modified: / 04-07-2006 / 18:48:26 / fm"
- "Modified: / 03-07-2011 / 15:59:25 / cg"
+ "Modified: / 06-07-2011 / 13:56:39 / cg"
! !
!DoWhatIMeanSupport class methodsFor:'code completion-helpers'!
@@ -216,6 +213,228 @@
"Created: / 10-11-2006 / 14:00:53 / 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|
+
+ srchClass := self lookupClassForMessage:node inClass:classOrNil.
+ srchClass notNil ifTrue:[
+ bestSelectors := Parser findBest:30 selectorsFor:selector in:srchClass forCompletion:true.
+ ] ifFalse:[
+ codeView topView withCursor:(Cursor questionMark) do:[
+ bestSelectors := Parser findBest:30 selectorsFor:selector in:nil forCompletion:true.
+ ].
+ ].
+
+ (bestSelectors includes:selector) ifTrue:[
+ bestSelectors := bestSelectors select:[:sel | sel size > selector size].
+ ].
+ bestSelectors
+ ].
+
+ selector := node selector.
+ bestSelectors := findBest value:node value:selector.
+
+ parentNode := node parent.
+
+ "/ if its a unary message AND the parent is a keyword node, look for parent completion too.
+ (node selector isUnarySelector
+ and:[ parentNode notNil
+ and:[ parentNode isMessage
+ and:[ (selector2 := parentNode selector) isKeywordSelector ]]]) ifTrue:[
+ "/ srchClass2 := self lookupClassForMessage:parentNode inClass: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 isNil ifTrue:[
+ newCursorPosition := stop + newPart size.
+ ]
+ ]
+ ].
+
+ (nSelParts min:newParts size) downTo:1 do:[:idx |
+ |newPart oldPartialToken start stop|
+
+ newPart := newParts at:idx.
+ oldPartialToken := selectorParts at:idx.
+ start := oldPartialToken start.
+ stop := oldPartialToken stop.
+
+ (best endsWith:$:) ifTrue:[
+ (codeView characterAtCharacterPosition:stop+1) == $: ifFalse:[
+ newPart := newPart , ':'
+ ]
+ ] ifFalse:[
+ (codeView characterAtCharacterPosition:stop) == $: ifTrue:[
+ newPart := newPart , ':'
+ ] ifFalse:[
+ (codeView characterAtCharacterPosition:stop+1) isSeparator ifFalse:[
+ newPart := newPart , ' '
+ ]
+ ]
+"/ codeView replaceFromCharacterPosition:start to:stop with:(newPart , ':').
+"/ ] ifFalse:[
+"/ codeView replaceFromCharacterPosition:start to:stop with:newPart.
+ ].
+
+ codeView replaceFromCharacterPosition:start to:stop with:newPart.
+
+ oldLen := stop - start + 1.
+ newLen := newPart size.
+
+"/ codeView selectFromCharacterPosition:start+oldLen to:start+newLen-1.
+ newCursorPosition isNil ifTrue:[
+ newCursorPosition := stop + (newLen-oldLen).
+ ].
+ ].
+ codeView cursorToCharacterPosition:newCursorPosition.
+ codeView cursorRight. "/ avoid going to the next line !!
+ codeView dontReplaceSelectionOnInput.
+ ]
+ info:'Completion'.
+ ].
+
+ "Created: / 10-11-2006 / 13:18:27 / cg"
+ "Modified: / 16-02-2010 / 10:33:48 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 06-07-2011 / 13:59:12 / cg"
+!
+
codeCompletionForVariable:node inClass:classOrNil codeView:codeView
|nonMetaClass crsrPos nm
allVariables allDistances best nodeVal
@@ -536,11 +755,26 @@
] ifFalse:[
tree := RBParser
parseMethod:source
- onError: [:str :err ":nodesSoFar" |
- "Transcript showCR:'Parse-Error: ',str."
- ^ nil].
+ onError:
+ [:str :err ":nodesSoFar" |
+ "Transcript showCR:'Parse-Error: ',str."
+ nil
+ ].
- tree isNil ifTrue:[^ 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.
@@ -555,11 +789,11 @@
].
^ node
- "Modified: / 08-06-2010 / 13:20:30 / cg"
+ "Modified: / 06-07-2011 / 12:42:53 / cg"
!
findNodeForInterval:interval in:source allowErrors:allowErrors
- |tree "errCount" firstIntersectingNode|
+ |tree "errCount" firstIntersectingNode onErrorBlock nodeGenerationHook|
interval isEmpty ifTrue: [^ nil].
RBParser isNil ifTrue: [^ nil].
@@ -567,37 +801,53 @@
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: [: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]
+ onError: onErrorBlock
rememberNodes:true
- nodeGenerationCallback:[: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
- ].
- ].
- ].
+ nodeGenerationCallback:nodeGenerationHook.
"/ onError: [:str :err | errCount := (errCount?0) + 1. self halt.]
"/ proceedAfterError:true.
+ (tree isNil or:[firstIntersectingNode isNil]) ifTrue:[
+ "/ try as an expression
+ tree := RBParser
+ parseExpression:source
+ onError: onErrorBlock
+ rememberNodes:true
+ nodeGenerationCallback:nodeGenerationHook.
+ ].
+
tree notNil ifTrue:[
LastSource := source.
LastParseTree := tree.
@@ -607,7 +857,7 @@
^ self findNodeForInterval:interval inParseTree:tree.
- "Modified: / 27-04-2010 / 17:59:17 / cg"
+ "Modified: / 06-07-2011 / 13:56:06 / cg"
!
findNodeForInterval:interval inParseTree:parseTree
@@ -658,23 +908,31 @@
"Modified: / 20-11-2006 / 12:31:12 / cg"
!
-lookupClassForMessage:node inClass:classProvidingNamespace
+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:[
- ^ classProvidingNamespace
+ classProvidingNamespaceOrNil isNil ifTrue:[^ UndefinedObject].
+ ^ classProvidingNamespaceOrNil
].
nm = 'super' ifTrue:[
- ^ classProvidingNamespace superclass
+ classProvidingNamespaceOrNil isNil ifTrue:[^ Object].
+ ^ classProvidingNamespaceOrNil superclass
].
nm isUppercaseFirst ifTrue:[
"/ wouldn't it be better to simply 'evaluate' the variable ?
Error handle:[:ex |
] do:[
- nodeVal := Parser new evaluate:nm in:nil receiver:(classProvidingNamespace basicNew).
+ |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.
@@ -684,13 +942,11 @@
]
]
].
- receiver isLiteral ifTrue:[
- ^ receiver value class
- ].
+
receiver isMessage ifTrue:[
(receiver selector = 'new'
or:[ receiver selector = 'new:' ]) ifTrue:[
- receiverClass := self lookupClassForMessage:receiver inClass:classProvidingNamespace.
+ receiverClass := self lookupClassForMessage:receiver inClass:classProvidingNamespaceOrNil.
receiverClass notNil ifTrue:[
receiverClass isBehavior ifTrue:[
receiverClass isMeta ifTrue:[
@@ -703,6 +959,7 @@
^ nil
"Modified: / 24-08-2010 / 15:05:49 / sr"
+ "Modified: / 06-07-2011 / 14:15:55 / cg"
!
treeForCode:source allowErrors:allowErrors
@@ -1641,5 +1898,5 @@
!DoWhatIMeanSupport class methodsFor:'documentation'!
version_CVS
- ^ '$Header: /cvs/stx/stx/libwidg2/DoWhatIMeanSupport.st,v 1.80 2011-07-06 10:19:04 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libwidg2/DoWhatIMeanSupport.st,v 1.81 2011-07-06 12:17:22 cg Exp $'
! !