--- a/DoWhatIMeanSupport.st Wed Sep 13 18:20:48 2017 +0200
+++ b/DoWhatIMeanSupport.st Fri Sep 15 11:22:21 2017 +0200
@@ -2429,7 +2429,8 @@
"/ ]
"/ ]
]
- ].
+ ].
+
selectorsImplementedInClass notNil ifTrue:[
(parentSelector notNil and:[parentSelector includes:$:]) ifTrue:[
selectorsImplementedInClass := selectorsImplementedInClass reject:[:sel | sel isKeywordSelector].
@@ -2492,6 +2493,8 @@
].
].
+ "/ sort again: prefixes must always come before
+ self sortSelectors:allBest forSelector:selector lcSelector:lcSelector.
self sortUsefulSelectorsIn:allBest. "/cosmetics
(parentSelector notNil and:[parentSelector includes:$:]) ifTrue:[
@@ -2700,7 +2703,7 @@
"Created: / 10-11-2006 / 13:18:27 / cg"
"Modified: / 16-02-2010 / 10:33:48 / Jan Vrany <jan.vrany@fit.cvut.cz>"
- "Modified: / 08-04-2017 / 16:29:29 / cg"
+ "Modified: / 15-09-2017 / 11:07:13 / cg"
!
codeCompletionForMessageTo:node into:actionBlock
@@ -2709,7 +2712,7 @@
|knownClass suggestions selectorsImplementedInClass mostUseful editActions pos|
- (knownClass := self classOfNode:node) isNil ifTrue:[
+ (knownClass := self classOfNode:node) isEmptyOrNil ifTrue:[
self breakPoint:#cg.
"/ self classOfNode:node.
^ self
@@ -2777,7 +2780,7 @@
actionBlock value:suggestions value:editActions value:nil.
"Created: / 01-05-2016 / 17:01:21 / cg"
- "Modified: / 01-05-2016 / 18:54:03 / cg"
+ "Modified: / 15-09-2017 / 10:57:25 / cg"
!
codeCompletionForMethodSpec:node
@@ -3926,6 +3929,10 @@
!
findBest:node for:selector inClasses:srchClassesArg
+ "find the best suggestions for a partial selector in a given set of classes.
+ Notice: the returned collection is unsorted; it needs some postprocessing to
+ present the most reasonable items first"
+
|srchClasses bestSelectors
allMessagesSentToVariable classesImplementingAllMessages|
@@ -3989,6 +3996,7 @@
^ bestSelectors
"Modified: / 13-03-2017 / 18:07:28 / cg"
+ "Modified (comment): / 15-09-2017 / 11:00:01 / cg"
!
findNodeForInterval:interval in:source
@@ -5695,26 +5703,38 @@
^ setOfTypes
!
-addClassesOfExpression:expr inClass:classOrNil to:setOfTypes
+addClassesOfExpression:expr inClass:classOrNil to:setOfPossibleClasses
|cls exprVal varName varScope instVarClass classVarClass poolVarClass sym
- topNameSpace|
-
+ topNameSpace constraints|
+
+ (expr isVariable "and:[expr name = 'secondsOrNil']") ifTrue:[
+ "/ see if contained inside an isXXX ifTrue;
+ "/ then, we know a lot more...
+ expr parent notNil ifTrue:[
+ constraints := self extractConstraintsFor:expr inClass:classOrNil.
+ constraints notEmpty ifTrue:[
+ setOfPossibleClasses addAll:constraints.
+ ^ setOfPossibleClasses.
+ ].
+ ].
+ ].
+
expr isLiteral ifTrue:[
exprVal := expr value.
cls := exprVal class.
(exprVal isArray or:[ exprVal isByteArray or:[ exprVal isString ]]) ifTrue:[
exprVal isImmutable ifTrue:[
- setOfTypes add:cls mutableClass.
- ^ setOfTypes.
+ setOfPossibleClasses add:cls mutableClass.
+ ^ setOfPossibleClasses.
]
].
- setOfTypes add:cls.
- ^ setOfTypes.
+ setOfPossibleClasses add:cls.
+ ^ setOfPossibleClasses.
].
expr isBlock ifTrue:[
- setOfTypes add:Block.
- ^ setOfTypes.
+ setOfPossibleClasses add:Block.
+ ^ setOfPossibleClasses.
].
thisContext isRecursive ifTrue:[
@@ -5722,7 +5742,7 @@
count := 0.
thisContext withAllSendersDo:[:c | (c selector == thisContext selector) ifTrue:[count := count + 1 ]].
count > 10 ifTrue:[
- ^ setOfTypes
+ ^ setOfPossibleClasses
].
].
@@ -5731,21 +5751,21 @@
varName = 'self' ifTrue:[
instanceOrNil notNil ifTrue:[
- setOfTypes add:(instanceOrNil class).
+ setOfPossibleClasses add:(instanceOrNil class).
] ifFalse:[
- setOfTypes add:(classOrNil ? UndefinedObject).
+ setOfPossibleClasses add:(classOrNil ? UndefinedObject).
].
- ^ setOfTypes
+ ^ setOfPossibleClasses
].
varName = 'super' ifTrue:[
classOrNil isNil
- ifTrue:[setOfTypes add:Object]
- ifFalse:[setOfTypes add:classOrNil superclass].
- ^ setOfTypes.
+ ifTrue:[setOfPossibleClasses add:Object]
+ ifFalse:[setOfPossibleClasses add:classOrNil superclass].
+ ^ setOfPossibleClasses.
].
varName = 'thisContext' ifTrue:[
- setOfTypes add:Context.
- ^ setOfTypes
+ setOfPossibleClasses add:Context.
+ ^ setOfPossibleClasses
].
varScope := expr whoDefines: varName.
@@ -5755,15 +5775,15 @@
].
(varScope isBlock) ifTrue:[
- self addClassesOfBlockVarForWellknownBlocks:expr inScope:varScope to:setOfTypes.
- self addClassesFromAssignmentTo:varName in:varScope to:setOfTypes.
- self addClassesFromMessagesSentTo:expr in:varScope to:setOfTypes.
- ^ setOfTypes
+ self addClassesOfBlockVarForWellknownBlocks:expr inScope:varScope to:setOfPossibleClasses.
+ self addClassesFromAssignmentTo:varName in:varScope to:setOfPossibleClasses.
+ self addClassesFromMessagesSentTo:expr in:varScope to:setOfPossibleClasses.
+ ^ setOfPossibleClasses
].
(varScope isMethod) ifTrue:[
- self addClassesFromAssignmentTo:varName in:varScope to:setOfTypes.
- self addClassesFromMessagesSentTo:expr in:varScope to:setOfTypes.
- ^ setOfTypes
+ self addClassesFromAssignmentTo:varName in:varScope to:setOfPossibleClasses.
+ self addClassesFromMessagesSentTo:expr in:varScope to:setOfPossibleClasses.
+ ^ setOfPossibleClasses
].
].
@@ -5771,24 +5791,24 @@
"/ inst var
instVarClass := classOrNil whichClassDefinesInstVar:varName.
instVarClass notNil ifTrue:[
- setOfTypes addAll:(self classesOfInstVarNamed:varName inClass:instVarClass).
- ^ setOfTypes
+ setOfPossibleClasses addAll:(self classesOfInstVarNamed:varName inClass:instVarClass).
+ ^ setOfPossibleClasses
].
"/ class vars
classVarClass := classOrNil theNonMetaclass whichClassDefinesClassVar:varName.
classVarClass notNil ifTrue:[
"/ see what is currently there
- setOfTypes add:(classVarClass classVarAt:varName asSymbol) class.
- ^ setOfTypes
+ setOfPossibleClasses add:(classVarClass classVarAt:varName asSymbol) class.
+ ^ setOfPossibleClasses
].
varName isUppercaseFirst ifTrue:[
"/ private class
varName knownAsSymbol ifTrue:[
cls := classOrNil theNonMetaclass privateClassesAt:varName asSymbol.
cls notNil ifTrue:[
- setOfTypes add:(cls theMetaclass).
- ^ setOfTypes
+ setOfPossibleClasses add:(cls theMetaclass).
+ ^ setOfPossibleClasses
].
].
].
@@ -5796,8 +5816,8 @@
poolVarClass := classOrNil theNonMetaclass whichPoolDefinesPoolVar:varName.
poolVarClass notNil ifTrue:[
"/ see what is currently there
- setOfTypes add:(poolVarClass classVarAt:varName asSymbol) class.
- ^ setOfTypes
+ setOfPossibleClasses add:(poolVarClass classVarAt:varName asSymbol) class.
+ ^ setOfPossibleClasses
].
].
@@ -5809,28 +5829,28 @@
].
exprVal := topNameSpace at:sym.
exprVal notNil ifTrue:[
- setOfTypes add:(exprVal class).
+ setOfPossibleClasses add:(exprVal class).
].
].
].
- ^ setOfTypes
+ ^ setOfPossibleClasses
].
(exprVal := self valueOfNode:expr) notNil ifTrue:[
"/ knowing the value is always great!!
- setOfTypes add:exprVal class.
- ^ setOfTypes.
+ setOfPossibleClasses add:exprVal class.
+ ^ setOfPossibleClasses.
].
expr isMessage ifTrue:[
- self addClassesOfMessage:expr inClass:classOrNil to:setOfTypes.
- ^ setOfTypes
+ self addClassesOfMessage:expr inClass:classOrNil to:setOfPossibleClasses.
+ ^ setOfPossibleClasses
].
- ^ setOfTypes
-
- "Modified (comment): / 19-02-2017 / 14:03:29 / cg"
+ ^ setOfPossibleClasses
+
"Modified: / 24-02-2017 / 14:41:00 / stefan"
+ "Modified: / 15-09-2017 / 10:52:40 / cg"
!
addClassesOfInstVarNamed:varName inClass:aClass to:setOfTypes
@@ -6117,13 +6137,86 @@
When showing possible completions for a message,
it is a good idea to know what the kind receiver is."
- |dict|
-
- dict := IdentitySet new.
- self addClassesOfExpression:aNode inClass:classOrNil to:dict.
- ^ dict.
+ |setOfPossibleClasses|
+
+ setOfPossibleClasses := IdentitySet new.
+ self addClassesOfExpression:aNode inClass:classOrNil to:setOfPossibleClasses.
+ ^ setOfPossibleClasses.
"Modified: / 05-02-2017 / 12:40:16 / cg"
+ "Modified (format): / 15-09-2017 / 10:11:19 / cg"
+!
+
+extractConstraintsFor:expr inClass:dummyClassOrNil
+ "see if expr is contained inside an isXXX ifTrue:[...]
+ then, we know a lot more...
+ For example, to expand possible messages for XXX in:
+ foo isString ifTrue:[
+ f XXX
+ ].
+ we now have to care for instances for which isString returns true only"
+
+ |node parentNode possibleClasses allImplementors condition classesReturningTrue classesReturningFalse|
+
+ possibleClasses := Set new.
+
+ node := expr.
+ [
+ parentNode := node parent.
+ parentNode isNil ifTrue:[
+ "/ due to the partial parse (being right in the middle of a parse),
+ "/ the parent may be undefined (for example, if closing bracket of a block was not yet entered)
+ "/ then the parse stopped and we have the partial parent message in the rememberedNodes list.
+ "/ try there; if found, continue there. If not, well, we might be really at the top.
+ rememberedNodes do:[:eachPossibleParentNode |
+ eachPossibleParentNode stop notNil ifTrue:[
+ eachPossibleParentNode stop <= node start ifTrue:[
+ (parentNode isNil or:[parentNode stop < eachPossibleParentNode stop]) ifTrue:[
+ parentNode := eachPossibleParentNode
+ ].
+ ].
+ ].
+ ].
+ ].
+ parentNode notNil
+ ] whileTrue:[
+ (parentNode isMessage
+ and:[#(ifTrue:) includes:parentNode selector])
+ ifTrue:[
+ (condition := parentNode receiver) isMessage ifTrue:[
+ condition receiver isVariable ifTrue:[
+ condition receiver name = expr name ifTrue:[
+ "/ here, we have an if, sending some message to the same receiver variable
+ allImplementors := Smalltalk allImplementorsOf:condition selector.
+ classesReturningTrue :=
+ allImplementors select:[:cls |
+ |mthd tree searcher|
+
+ mthd := cls compiledMethodAt:condition selector.
+ searcher := ParseTreeSearcher isJustReturningTrue.
+ tree := RBParser
+ parseSearchMethod:(mthd source)
+ onError: [:str :pos | nil].
+
+ tree notNil
+ and:[ searcher executeTree:tree initialAnswer:false ].
+ ].
+
+ classesReturningTrue do:[:eachClass |
+ eachClass withAllSubclassesDo:[:eachSubClass |
+ possibleClasses add:eachSubClass
+ ].
+ ].
+ ^ possibleClasses.
+ ].
+ ].
+ ].
+ ].
+ node := parentNode.
+ ].
+ ^ possibleClasses
+
+ "Created: / 15-09-2017 / 10:16:20 / cg"
!
isNonDestructive:aMessageNode whenSentTo:receiverValue