--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/SmallSense__SmalltalkCompletionEngine.st Wed Jan 14 08:28:46 2015 +0000
@@ -0,0 +1,581 @@
+"
+stx:goodies/smallsense - A productivity plugin for Smalltalk/X IDE
+Copyright (C) 2013-2014 Jan Vrany
+
+This library is free software; you can redistribute it and/or
+modify it under the terms of the GNU Lesser General Public
+License as published by the Free Software Foundation; either
+version 2.1 of the License.
+
+This library is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+Lesser General Public License for more details.
+
+You should have received a copy of the GNU Lesser General Public
+License along with this library; if not, write to the Free Software
+Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+"
+"{ Package: 'stx:goodies/smallsense' }"
+
+"{ NameSpace: SmallSense }"
+
+CompletionEngine subclass:#SmalltalkCompletionEngine
+ instanceVariableNames:'collector'
+ classVariableNames:'Debug'
+ poolDictionaries:''
+ category:'SmallSense-Smalltalk'
+!
+
+!SmalltalkCompletionEngine class methodsFor:'documentation'!
+
+copyright
+"
+stx:goodies/smallsense - A productivity plugin for Smalltalk/X IDE
+Copyright (C) 2013-2014 Jan Vrany
+
+This library is free software; you can redistribute it and/or
+modify it under the terms of the GNU Lesser General Public
+License as published by the Free Software Foundation; either
+version 2.1 of the License.
+
+This library is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+Lesser General Public License for more details.
+
+You should have received a copy of the GNU Lesser General Public
+License along with this library; if not, write to the Free Software
+Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+"
+! !
+
+!SmalltalkCompletionEngine class methodsFor:'initialization'!
+
+initialize
+ "Invoked at system start or when the class is dynamically loaded."
+
+ "/ please change as required (and remove this comment)
+
+ Debug := false.
+
+ "Modified: / 22-01-2014 / 09:08:44 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
+!SmalltalkCompletionEngine class methodsFor:'accessing'!
+
+debug
+ ^ Debug
+
+ "Created: / 22-01-2014 / 09:08:14 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+debug: aBoolean
+ Debug := aBoolean .
+ "
+ self debug: true.
+ self debug: false.
+ "
+
+ "Created: / 22-01-2014 / 09:08:02 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified (comment): / 22-01-2014 / 19:42:53 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
+!SmalltalkCompletionEngine class methodsFor:'utilities'!
+
+resultSetFor: mode source: source class: class line: line column: col
+ | inferencer tree |
+
+ mode == #method ifTrue:[
+ inferencer := SmalltalkInferencer forClass: class methodSource: source asString.
+ inferencer parserClass: SmalltalkParser.
+ inferencer process.
+ ] ifFalse:[
+ self breakPoint: #jv.
+ ^nil.
+ inferencer := Parser for: (source asString readStream).
+ "JV@2011-06-13: HACK, use polymorphism"
+ tree := inferencer
+ parseExpressionWithSelf:nil
+ notifying:nil
+ ignoreErrors:false
+ ignoreWarnings:false
+ inNameSpace:nil.
+ inferencer tree: tree.
+ ].
+ ^ self new
+ completeAtLine:line
+ column:col
+ collector:inferencer
+
+ "Modified: / 07-04-2011 / 22:55:58 / Jakub <zelenja7@fel.cvut.cz>"
+ "Created: / 26-11-2011 / 17:53:22 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 02-09-2013 / 14:43:42 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified (format): / 02-10-2013 / 13:09:56 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
+!SmalltalkCompletionEngine methodsFor:'completion-helpers'!
+
+javaClassesDo: aBlock
+ | class loader loaders |
+
+ class := collector klass.
+ loaders := Set new.
+ loader := (class notNil and:[class isJavaClass]) ifTrue:[class classLoader] ifFalse:[JavaVM systemClassLoader].
+ [ loader notNil ] whileTrue:[
+ loaders add: loader.
+ loader := loader instVarNamed: #parent.
+ ].
+ loaders add: nil.
+
+ JavaVM registry allClassesDo:[:cls|
+ (cls isAnonymous not and:[(loaders includes: cls classLoader)]) ifTrue:[
+
+ aBlock value: cls.
+ ].
+ ].
+
+ "Created: / 04-10-2013 / 13:10:03 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 07-08-2014 / 13:03:33 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
+!SmalltalkCompletionEngine methodsFor:'completion-individual'!
+
+addClassVariables
+ | class |
+
+ class := collector klass theNonMetaclass.
+ class classVarNames do:[:nm|
+ result add:(VariablePO classVariable: nm in: class).
+ ].
+
+ "Created: / 24-07-2013 / 17:00:24 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 30-07-2013 / 23:32:21 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+addGlobalsStartingWith: prefix
+
+ | class namespace environment |
+ class := collector klass.
+ namespace := class nameSpace.
+ environment := context environment.
+ "nameSpace may return private class, sigh"
+ [ namespace isNameSpace ] whileFalse:[ namespace := namespace nameSpace ].
+
+ environment keysDo:[:name |
+ | value |
+
+ (self isGlobalKeyForClassVariable: name) ifFalse:[
+ value := environment at: name.
+ ((name startsWith: prefix) or:[(value isBehavior and:[(value nameWithoutPrefix startsWith: prefix) or:[value nameWithoutNameSpacePrefix startsWith: prefix]])]) ifTrue:[
+ (value notNil and:[value isBehavior]) ifTrue:[
+ "/ Check for aliases...
+ | clsnm |
+
+ clsnm := value name.
+ clsnm = name ifTrue:[
+ result add: (PO forClass: value)
+ ] ifFalse:[
+ result add: (PO forGlobalNamed: name)
+ ].
+ ] ifFalse:[
+ result add: (PO forGlobalNamed: name)
+ ].
+ ]
+ ].
+ ].
+
+ "Created: / 26-11-2011 / 17:29:10 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 24-07-2014 / 17:51:49 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+addJavaClassesInPackage: prefix
+ prefix isEmptyOrNil ifTrue:[
+ self javaClassesDo: [:cls |
+ result add: (ClassPO new klass: cls; showPrefix: true; yourself)
+ ].
+ ] ifFalse:[
+ self javaClassesDo: [:cls |
+ (cls binaryName startsWith: prefix) ifTrue:[
+ result add: (ClassPO new klass: cls; showPrefix: true; yourself)
+ ].
+ ].
+
+ ].
+
+ "Created: / 04-10-2013 / 13:09:14 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 20-10-2013 / 02:42:50 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+addMethodsForType: type
+ ^ self addMethodsForType: type stripOff: nil
+
+ "Created: / 26-11-2011 / 17:03:21 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 09-05-2014 / 12:51:36 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+addMethodsForType: type prefix: prefix stripOff: stripprefix
+
+ type isUnknownType ifFalse:[
+ self addMethodsForType:type stripOff: stripprefix.
+
+ "/ If the type is union of more than 6 types, then
+ "/ assume that the inferencer is likely wrong.
+ "/ then, if the prefix is at least 3 chars,
+ "/ also add methods with that prefix.
+
+ ((type classes size > 6) and:[ prefix size > 2 ]) ifTrue:[
+ self addMethodsStartingWith:prefix stripOff: stripprefix
+ ].
+ ] ifTrue:[
+ self addMethodsStartingWith:prefix stripOff: stripprefix
+ ].
+
+ "Created: / 08-04-2014 / 21:04:01 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 09-04-2014 / 09:31:40 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+addMethodsForType: type stripOff: stripprefix
+ | classes seen selector2classesMap |
+
+ selector2classesMap := Dictionary new.
+ classes := type classes.
+ "/ Hack for Boolean: ifTrue:iFalse: etc are not defined
+ "/ in Boolean ?!!?
+ (classes size == 1 and:[classes anElement == Boolean ]) ifTrue:[
+ classes := Array with: True with: False.
+ ].
+ classes size == 1 ifTrue:[
+ classes anElement == JavaPackage class ifTrue:[
+ "/ Special hack for JAVA: for pattern `JAVA java lang reflect`
+ "/ complete all Java classes in that package
+ | node |
+
+ node := result context node.
+ node isUnaryMessage ifTrue:[
+ | package |
+ "/ Compute package prefix...
+
+ package := node selector.
+ node := node receiver.
+ [ node isUnaryMessage ] whileTrue:[
+ package := node selector , '/' , package.
+ node := node receiver.
+ ].
+ self addJavaClassesInPackage: package.
+ ^ self.
+ ]
+ ]
+ ].
+
+ seen := Set new.
+ classes do: [:each |
+ | class selector2classMap |
+
+ class := each.
+ selector2classMap := Dictionary new.
+
+ "/ Now, special care for Java classes, sigh...
+ (class isMetaclass and:[class theNonMetaclass isJavaClass]) ifTrue:[
+ seen add: class.
+ class theNonMetaclass selectorsAndMethodsDo: [:selector :met |
+ met isStatic ifTrue:[
+ result add: (PO forClass: met mclass selector: selector)
+ ].
+ ].
+ ] ifFalse:[
+ [ class notNil and:[(seen includes: class) not]] whileTrue: [
+ class selectorsAndMethodsDo: [:selector :met |
+ met isSynthetic ifFalse:[
+ (stripprefix isNil or:[ selector size > stripprefix size and:[selector startsWith: stripprefix]]) ifTrue:[
+ selector2classMap at: selector put: class.
+ ].
+ ]
+ ].
+ class := class superclass.
+ ]
+ ].
+ selector2classMap keysAndValuesDo:[:selector :class |
+ | classes |
+
+ classes := selector2classesMap at: selector ifAbsentPut: [ Set new ].
+ classes add: class.
+ ]
+ ].
+
+ selector2classesMap keysAndValuesDo: [:selector :classes|
+ result add:(MethodPO forClasses: classes selector: selector prefix: stripprefix)
+ ]
+
+ "Created: / 08-04-2014 / 21:23:21 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 20-05-2014 / 10:47:37 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+addPools
+ | class |
+
+ class := collector klass theNonMetaclass.
+ class theNonMetaclass sharedPools do:[:pool|
+ pool theNonMetaclass classVarNames do:[:nm|
+ result add:(VariablePO classVariable: nm in: pool).
+ ]
+ ].
+
+ "Created: / 24-07-2013 / 16:59:34 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 30-07-2013 / 23:32:38 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+addVariablesFor: node
+
+ | n klass |
+
+ "Add Instance variables"
+ klass := collector klass.
+ [ klass notNil ] whileTrue:[
+ | usedInstVars |
+
+ usedInstVars := collector parser usedInstVars.
+ klass instVarNames do:[:nm |
+ | po |
+
+ po := VariablePO instanceVariable: nm in: klass.
+ "/ Raise relevance if the instvar is already used in the code...
+ (usedInstVars includes: nm) ifTrue:[
+ po relevance: (po relevance + 10).
+ ].
+
+ result add: po.
+ ].
+ "/ When on class side (i.e., in class method), do not complete
+ "/ instance variables of Class / ClassDescription / Behaviour
+ "/ as STC won't compile such code.
+ klass := (klass isMetaclass and:[klass superclass == Class])
+ ifTrue:[nil]
+ ifFalse:[klass superclass].
+ ].
+ "Add pseudo variables"
+ #(self super here thisContext) do:[:nm|
+ result add: (VariablePO new name: nm).
+ ].
+ "Add arguments"
+ collector parser methodArgs ? #() do:[:nm|
+ result add: (VariablePO argument: nm).
+ ].
+ "Add temporaries"
+ collector parser methodVars ? #() do:[:nm|
+ result add: (VariablePO variable: nm).
+ ].
+ "Add literals"
+ #(#true #false #nil ) do:[:nm|
+ result add: (SnippetPO new value: nm).
+ ].
+
+
+ n := node.
+ [ n notNil ] whileTrue:[
+ n isBlockNode ifTrue:[
+ n arguments ? #() do:[:barg|result add: (VariablePO variable: barg name)].
+ n variables ? #() do:[:bvar|result add: (VariablePO variable: bvar name)].
+ ].
+ n := n parent.
+ ]
+
+ "Created: / 31-07-2013 / 00:32:13 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 20-05-2014 / 10:09:05 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
+!SmalltalkCompletionEngine methodsFor:'completion-private'!
+
+complete
+ "Compute completion for `codeView`, taking all the information
+ from it. Returns a CompletionResult with computed completions"
+
+ | class |
+
+ codeView := context codeView.
+ class := codeView isCodeView2
+ ifTrue: [ codeView klass ]
+ ifFalse: [ codeView editedClass ].
+ class isNil ifTrue:[
+ class := UndefinedObject.
+ ].
+ ^ self complete: codeView codeAspect source: codeView contents string class: class line: codeView cursorLine column: codeView cursorCol
+
+ "Created: / 02-10-2013 / 13:32:30 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 22-05-2014 / 17:00:59 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+complete: mode source: source class: class line: lineNrArg column: colNrArg
+ | inferencer lineNr colNr |
+
+ mode == #method ifTrue:[
+ lineNr := lineNrArg.
+ colNr := colNrArg.
+ inferencer := SmalltalkInferencer forClass: class methodSource: source asString.
+ ] ifFalse:[
+ | line |
+
+ lineNr := 1.
+ colNr := colNrArg.
+ line := codeView list at: lineNrArg ifAbsent:[ nil ].
+ line isEmptyOrNil ifTrue:[ ^ nil ].
+ inferencer := SmalltalkInferencer forExpression: line.
+ ].
+ inferencer parserClass: SmalltalkParser.
+ inferencer process.
+
+ ^ self
+ completeAtLine:lineNr
+ column:colNr
+ collector:inferencer
+
+ "Created: / 02-10-2013 / 13:23:25 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 07-10-2013 / 13:43:33 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+completeAfter:node
+ "return collection of completion items after given node"
+
+ | type |
+
+ type := node inferedType.
+ type isUnknownType ifFalse:[
+ self addMethodsForType: node inferedType
+ ].
+
+ "Created: / 04-03-2011 / 15:45:28 / Jakub <zelenja7@fel.cvut.cz>"
+ "Modified: / 08-04-2011 / 10:55:09 / Jakub <zelenja7@fel.cvut.cz>"
+ "Created: / 26-11-2011 / 17:07:52 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 24-09-2013 / 02:15:57 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+completeAtLine:line column:col collector:coll
+ "find most possible codeCompletion object"
+
+ | nodeToPosition |
+
+ collector := coll.
+ (collector tree isNil or:[collector tree == #Error]) ifTrue:[
+ ^ nil
+ ].
+ nodeToPosition := SmalltalkParseNodeFinder new
+ findNodeIn: collector source tree: collector tree comments: collector parser commentPositions
+ line: line column: col.
+ context node: nodeToPosition key position: nodeToPosition value.
+
+ context isAfterNode ifTrue:[
+ self completeAfter:context node.
+ ] ifFalse:[
+ context isInNode ifTrue:[
+ self completeIn:context node.
+ ] ifFalse:[
+ context isBeforeNode ifTrue:[
+ self completeBefore:context node.
+ ]]].
+
+ result isEmpty ifTrue:[
+ nil "/Only to set breakpoint here
+ ].
+ ^result.
+
+ "Created: / 04-03-2011 / 13:01:14 / Jakub <zelenja7@fel.cvut.cz>"
+ "Modified: / 08-04-2011 / 10:52:59 / Jakub <zelenja7@fel.cvut.cz>"
+ "Created: / 26-11-2011 / 17:05:13 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 29-01-2014 / 10:36:20 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+completeBefore:node
+
+ self breakPoint: #jv. "Not yet implemented"
+
+ "Created: / 04-03-2011 / 15:45:28 / Jakub <zelenja7@fel.cvut.cz>"
+ "Modified: / 08-04-2011 / 10:55:09 / Jakub <zelenja7@fel.cvut.cz>"
+ "Created: / 26-11-2011 / 17:07:41 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+completeIn:node
+ "return collection which can be afterNode"
+
+ node isVariableNode ifTrue:[
+ self completeInVariableNode:node.
+ ^ self.
+ ].
+ node isMessage ifTrue:[
+ self completeInMessageNode:node.
+ ^ self
+ ].
+ self breakPoint:#jv.
+
+ "Created: / 07-03-2011 / 18:59:02 / Jakub <zelenja7@fel.cvut.cz>"
+ "Modified: / 08-04-2011 / 09:31:51 / Jakub <zelenja7@fel.cvut.cz>"
+ "Created: / 26-11-2011 / 17:07:29 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 08-04-2014 / 20:52:05 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+completeInMessageNode:node
+ | parent |
+
+
+ self addMethodsForType: node receiver inferedType prefix: node selector stripOff: nil.
+ parent := node parent.
+ parent isMessage ifTrue:[
+ self addMethodsForType: parent receiver inferedType prefix: node selector stripOff: parent selector.
+ ].
+
+ "Modified (format): / 08-04-2014 / 21:16:24 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+completeInVariableNode:node
+ node name first isUppercase ifTrue:[
+ self addGlobalsStartingWith:node name.
+ self addClassVariables.
+ self addPools.
+ ] ifFalse:[
+ self addVariablesFor:node
+ ]
+
+ "Modified: / 24-07-2014 / 19:11:20 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
+!SmalltalkCompletionEngine methodsFor:'queries'!
+
+isGlobalKeyForClassVariable: aString
+ | i |
+
+ i := 0.
+ [
+ i := aString indexOf: $: startingAt: i + 1.
+ i ~~ 0
+ ] whileTrue:[
+ aString size > i ifTrue:[
+ (aString at: i + 1) ~~ $: ifTrue:[
+ ^ true
+ ].
+ ].
+ i := i + 1.
+ ].
+ ^ false
+
+ "
+ SmalltalkCompletionEngine new isGlobalKeyForClassVariable: 'AAA'
+ SmalltalkCompletionEngine new isGlobalKeyForClassVariable: 'AAA:X'
+ SmalltalkCompletionEngine new isGlobalKeyForClassVariable: 'BB::CC::AA'
+ SmalltalkCompletionEngine new isGlobalKeyForClassVariable: 'BB::CC::AA:X'
+ "
+
+ "Created: / 09-04-2014 / 13:49:41 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
+!SmalltalkCompletionEngine class methodsFor:'documentation'!
+
+version_HG
+
+ ^ '$Changeset: <not expanded> $'
+!
+
+version_SVN
+ ^ '$Id$'
+! !
+
+
+SmalltalkCompletionEngine initialize!