class: Parser
authorClaus Gittinger <cg@exept.de>
Sun, 28 Jul 2013 12:02:14 +0200
changeset 3236 a18d2c543556
parent 3235 6385bfe15842
child 3237 a6b2f875bcc3
class: Parser changed: #findBest:selectorsFor:in:forCompletion: better code completion
Parser.st
--- a/Parser.st	Sat Jul 27 12:06:06 2013 +0200
+++ b/Parser.st	Sun Jul 28 12:02:14 2013 +0200
@@ -701,20 +701,20 @@
     block := [:sym :mthd|
         |similarity lcSym keepThis|
 
-        lcSym := sym asLowercase.
         (forCompletion and:[sym = aString]) ifFalse:[
+            lcSym := sym asLowercase.
             (info contains:[:i | i key == sym]) ifFalse:[
-                similarity := lcSelector spellAgainst:lcSym.   "/ 0..100
-                "/ similarity := similarity * (lcSym size).
+                "/ higher simililarity if string to complete starts with the selector
+                (forCompletion and:[lcSym startsWith:lcSelector]) ifTrue:[
+                    similarity := 100 * (1 + (lcSelector size / lcSym size)).
+                ] ifFalse:[
+                    similarity := lcSelector spellAgainst:lcSym.   "/ 0..100
+                    "/ similarity := similarity * (lcSym size).
+                ].
                 forCompletion ifTrue:[
-                    "/ higher simililarity if string to complete starts with the selector
-                    (lcSym startsWith:lcSelector) ifTrue:[
-                        "/ similarity := similarity + (lcSelector size * 10).
-                        similarity := similarity * (1 + (lcSelector size / lcSym size)).
-                        "/ higher simililarity for my own messages
-                        aClassOrNil == mthd mclass ifTrue:[
-                            similarity := similarity * 2.
-                        ].
+                    "/ higher simililarity for my own messages
+                    aClassOrNil == mthd mclass ifTrue:[
+                        similarity := similarity * 2.
                     ].
                 ].
 
@@ -752,18 +752,19 @@
             loadedClass := aClassOrNil autoload
         ].
         loadedClass withAllSuperclassesDo:[:cls |
+Transcript showCR:'try ',cls name.
             cls methodDictionary keysAndValuesDo:block.
             "/ cls class methodDictionary keysAndValuesDo:block.
         ].
-        loadedClass withAllSubclassesDo:[:cls |
-            cls methodDictionary keysAndValuesDo:block.
-            "/ cls class methodDictionary keysAndValuesDo:block.
-        ].
+"/        loadedClass withAllSubclassesDo:[:cls |
+"/            cls methodDictionary keysAndValuesDo:block.
+"/            "/ cls class methodDictionary keysAndValuesDo:block.
+"/        ].
     ].
 
     ^ info asOrderedCollection collect:[:a | a key]
 
-    "Modified: / 27-07-2013 / 10:28:44 / cg"
+    "Modified: / 27-07-2013 / 16:51:59 / cg"
 !
 
 findBestSelectorsFor:aString
@@ -7962,155 +7963,156 @@
      checkSharedPoolAction|
 
     checkSharedPoolAction :=
-	[:eachPoolName |
-	    |sharedPool|
-
-	    sharedPool := Smalltalk classNamed:eachPoolName.
-	    sharedPool isNil ifTrue:[
-		Transcript showCR:'No such pool: ' , eachPoolName.
-		"/ self warning:('No such pool: ' , eachPoolName).
-	    ] ifFalse:[
-		(sharedPool includesKey:varName) ifTrue:[
-		    parseForCode ifFalse:[self rememberGlobalUsed:(sharedPool name , ':' , varName)].
-		    ^ (VariableNode type:#PoolVariable class:sharedPool name:varName)
-			startPosition: tokenPosition endPosition: tokenPosition + varName size - 1
-		].
-	    ].
-	].
+        [:eachPoolName |
+            |sharedPool|
+
+            sharedPool := Smalltalk classNamed:eachPoolName.
+            sharedPool isNil ifTrue:[
+                Transcript showCR:'No such pool: ' , eachPoolName.
+                "/ self warning:('No such pool: ' , eachPoolName).
+            ] ifFalse:[
+                (sharedPool includesKey:varName) ifTrue:[
+                    parseForCode ifFalse:[self rememberGlobalUsed:(sharedPool name , ':' , varName)].
+                    ^ (VariableNode type:#PoolVariable class:sharedPool name:varName)
+                        startPosition: tokenPosition endPosition: tokenPosition + varName size - 1
+                ].
+            ].
+        ].
 
     "is it a block-arg or block-var ?"
     searchBlock := currentBlock.
     [searchBlock notNil] whileTrue:[
-	vars := searchBlock variables.
-	vars notNil ifTrue:[
-	    varIndex := vars findFirst:[:aBlockVar | aBlockVar name = varName].
-	    varIndex ~~ 0 ifTrue:[
-		^ (VariableNode type:#BlockVariable
-			       name:varName
-			      token:(vars at:varIndex)
-			      index:varIndex
-			      block:searchBlock
-			       from:currentBlock)
-		    startPosition: tokenPosition endPosition: tokenPosition + varName size - 1
-	    ].
-	].
-
-	args := searchBlock arguments.
-	args notNil ifTrue:[
-	    varIndex := args findFirst:[:aBlockArg | aBlockArg name = varName].
-	    varIndex ~~ 0 ifTrue:[
-		^ (VariableNode type:#BlockArg
-			       name:varName
-			      token:(args at:varIndex)
-			      index:varIndex
-			      block:searchBlock
-			       from:currentBlock)
-		    startPosition: tokenPosition endPosition: tokenPosition + varName size - 1
-	    ].
-
-	].
-
-	searchBlock := searchBlock home
+        vars := searchBlock variables.
+        vars notNil ifTrue:[
+            varIndex := vars findFirst:[:aBlockVar | aBlockVar name = varName].
+            varIndex ~~ 0 ifTrue:[
+                ^ (VariableNode type:#BlockVariable
+                               name:varName
+                              token:(vars at:varIndex)
+                              index:varIndex
+                              block:searchBlock
+                               from:currentBlock)
+                    startPosition: tokenPosition endPosition: tokenPosition + varName size - 1
+            ].
+        ].
+
+        args := searchBlock arguments.
+        args notNil ifTrue:[
+            varIndex := args findFirst:[:aBlockArg | aBlockArg name = varName].
+            varIndex ~~ 0 ifTrue:[
+                ^ (VariableNode type:#BlockArg
+                               name:varName
+                              token:(args at:varIndex)
+                              index:varIndex
+                              block:searchBlock
+                               from:currentBlock)
+                    startPosition: tokenPosition endPosition: tokenPosition + varName size - 1
+            ].
+
+        ].
+
+        searchBlock := searchBlock home
     ].
 
     "is it a method-variable ?"
     (node := self nodeForMethodVariable:varName) notNil
     ifTrue:[
-	^ node
+        ^ node
     ].
 
     "is it a method-argument ?"
     (node := self nodeForMethodArg:varName) notNil
     ifTrue:[
-	^ node
+        ^ node
     ].
 
     contextToEvaluateIn notNil ifTrue:[
-	|con varNames|
-
-	"/
-	"/ search names of the context.
-	"/
-	con := contextToEvaluateIn.
-	[con notNil] whileTrue:[
-	    varNames := con argAndVarNames.
-	    varNames size > 0 ifTrue:[
-		varIndex := varNames lastIndexOf:varName.
-		varIndex ~~ 0 ifTrue:[
-		    ^ (VariableNode type:#ContextVariable
-				   name:varName
-				context:con
-				  index:varIndex)
-			startPosition: tokenPosition endPosition: tokenPosition + varName size - 1
-		].
-	    ].
-	    con := con home.
-	].
+        |con varNames|
+
+        "/
+        "/ search names of the context.
+        "/
+        con := contextToEvaluateIn.
+        [con notNil] whileTrue:[
+            varNames := con argAndVarNames.
+            varNames size > 0 ifTrue:[
+                varIndex := varNames lastIndexOf:varName.
+                varIndex ~~ 0 ifTrue:[
+                    ^ (VariableNode 
+                            type:#ContextVariable
+                            name:varName
+                            context:con
+                            index:varIndex)
+                        startPosition: tokenPosition endPosition: tokenPosition + varName size - 1
+                ].
+            ].
+            con := con home.
+        ].
     ].
 
     classToCompileFor notNil ifTrue:[
-	"is it an instance-variable ?"
-
-	varIndex := (self classesInstVarNames) lastIndexOf:varName.
-	varIndex ~~ 0 ifTrue:[
-	    classToCompileFor isMeta ifTrue:[
-		classVarIndex := (self classesClassVarNames) lastIndexOf:varName.
-		classVarIndex ~~ 0 ifTrue:[
-
-		    "/ give a warning - that maybe a common error
-		    alreadyWarnedClassInstVarRefs isNil ifTrue:[
-			alreadyWarnedClassInstVarRefs := Set new
-		    ].
-		    (alreadyWarnedClassInstVarRefs includes:varName) ifFalse:[
-			self warning:('there is both a class variable and a class-instance variable named "%1" (in %2).\\Refering to the class-instance variable here.' withCRs
-					bindWith:varName with:(self whichClassIncludesClassVar:varName) name).
-			alreadyWarnedClassInstVarRefs add:varName.
-		    ].
-		].
-	    ].
-	    parseForCode ifFalse:[self rememberInstVarUsed:varName].
-	    ^ (VariableNode
-		    type:#InstanceVariable
-		    name:varName
-		    index:varIndex
-		    selfValue:selfValue)
-		    startPosition: tokenPosition endPosition: tokenPosition + varName size - 1
-	].
-
-	"/ see if there is a corresponding classVar (for the warning)
-	classVarIndex := (self classesClassVarNames) lastIndexOf:varName.
-
-	"/      "is it a class-instance-variable ?"
-	"/
-	"/ Notice:
-	"/ it is no longer allowed to fetch class-instance variables
-	"/ from instance methods ...
-	"/ (used to be in previous ST/X versions)
-	"/
-	varIndex := (self classesClassInstVarNames) lastIndexOf:varName.
-	varIndex ~~ 0 ifTrue:[
-	    aClass := self inWhichClassIsClassInstVar:varName.
-	    aClass notNil ifTrue:[
-		classToCompileFor isMeta ifFalse:[
-		    classVarIndex == 0 ifTrue:[
-			"/ there is no corresponding classVar;
-			"/ wants to access classInstVar ?
-			contextToEvaluateIn notNil ifTrue:[
-			    "/ allow it in a doIt ...
-
-			    ^ (VariableNode type:#ClassInstanceVariable
-					   name:varName
-					  index:varIndex
-				      selfClass:aClass)
-				startPosition: tokenPosition endPosition: tokenPosition + varName size - 1
-			].
-			self parseError:'access to class-inst-var from inst method is not allowed'.
-			^ #Error.
-		    ] ifFalse:[
-			"/ give a warning - that maybe a common error
-			self warning:('there is both a class variable and a class-instance variable named ''' , varName , '''.\\Refering to the class variable here (instMethods dont see classInstVars).') withCRs.
-		    ]
-		].
+        "is it an instance-variable ?"
+
+        varIndex := (self classesInstVarNames) lastIndexOf:varName.
+        varIndex ~~ 0 ifTrue:[
+            classToCompileFor isMeta ifTrue:[
+                classVarIndex := (self classesClassVarNames) lastIndexOf:varName.
+                classVarIndex ~~ 0 ifTrue:[
+
+                    "/ give a warning - that maybe a common error
+                    alreadyWarnedClassInstVarRefs isNil ifTrue:[
+                        alreadyWarnedClassInstVarRefs := Set new
+                    ].
+                    (alreadyWarnedClassInstVarRefs includes:varName) ifFalse:[
+                        self warning:('there is both a class variable and a class-instance variable named "%1" (in %2).\\Refering to the class-instance variable here.' withCRs
+                                        bindWith:varName with:(self whichClassIncludesClassVar:varName) name).
+                        alreadyWarnedClassInstVarRefs add:varName.
+                    ].
+                ].
+            ].
+            parseForCode ifFalse:[self rememberInstVarUsed:varName].
+            ^ (VariableNode
+                    type:#InstanceVariable
+                    name:varName
+                    index:varIndex
+                    selfValue:selfValue)
+                    startPosition: tokenPosition endPosition: tokenPosition + varName size - 1
+        ].
+
+        "/ see if there is a corresponding classVar (for the warning)
+        classVarIndex := (self classesClassVarNames) lastIndexOf:varName.
+
+        "/      "is it a class-instance-variable ?"
+        "/
+        "/ Notice:
+        "/ it is no longer allowed to fetch class-instance variables
+        "/ from instance methods ...
+        "/ (used to be in previous ST/X versions)
+        "/
+        varIndex := (self classesClassInstVarNames) lastIndexOf:varName.
+        varIndex ~~ 0 ifTrue:[
+            aClass := self inWhichClassIsClassInstVar:varName.
+            aClass notNil ifTrue:[
+                classToCompileFor isMeta ifFalse:[
+                    classVarIndex == 0 ifTrue:[
+                        "/ there is no corresponding classVar;
+                        "/ wants to access classInstVar ?
+                        contextToEvaluateIn notNil ifTrue:[
+                            "/ allow it in a doIt ...
+
+                            ^ (VariableNode type:#ClassInstanceVariable
+                                           name:varName
+                                          index:varIndex
+                                      selfClass:aClass)
+                                startPosition: tokenPosition endPosition: tokenPosition + varName size - 1
+                        ].
+                        self parseError:'access to class-inst-var from inst method is not allowed'.
+                        ^ #Error.
+                    ] ifFalse:[
+                        "/ give a warning - that maybe a common error
+                        self warning:('there is both a class variable and a class-instance variable named ''' , varName , '''.\\Refering to the class variable here (instMethods dont see classInstVars).') withCRs.
+                    ]
+                ].
 
 "/ OLD CODE:
 "/ self warning:'access to class-inst-var from inst method will soon be no longer supported'.
@@ -8121,108 +8123,109 @@
 "/                                  index:varIndex
 "/                              selfClass:aClass
 "/                ].
-	    ] ifFalse:[
-		"/ self halt:'oops - should not happen'.
-	    ]
-	].
-
-	"is it a class-variable ?"
-
-	varIndex := classVarIndex.
-	varIndex ~~ 0 ifTrue:[
-	    aClass := self inWhichClassIsClassVar:varName.
-	    aClass notNil ifTrue:[
-		parseForCode ifFalse:[self rememberClassVarUsed:varName].
-		^ (VariableNode type:#ClassVariable class:aClass name:varName)
-			startPosition: tokenPosition endPosition: tokenPosition + varName size - 1
-	    ].
-	    "/ self halt:'oops - should not happen'.
-	].
-
-	"is it a private-class ?"
-
-	aClass := self classToLookForClassVars.
-	aClass := aClass theNonMetaclass.
-	aClass isLoaded ifTrue:[
-	    (aClass privateClassesAt:varName) notNil ifTrue:[
-		parseForCode ifFalse:[self rememberGlobalUsed:(aClass name , '::' , varName)].
-		^ (VariableNode type:#PrivateClass class:aClass name:varName)
-		    startPosition: tokenPosition endPosition: tokenPosition + varName size - 1
-	    ].
-	].
-
-	" is it a pool-variable ?"
-	classToCompileFor theNonMetaclass realSharedPoolNames do:checkSharedPoolAction.
+            ] ifFalse:[
+                "/ self halt:'oops - should not happen'.
+            ]
+        ].
+
+        "is it a class-variable ?"
+
+        varIndex := classVarIndex.
+        varIndex ~~ 0 ifTrue:[
+            aClass := self inWhichClassIsClassVar:varName.
+            aClass notNil ifTrue:[
+                parseForCode ifFalse:[self rememberClassVarUsed:varName].
+                ^ (VariableNode type:#ClassVariable class:aClass name:varName)
+                        startPosition: tokenPosition endPosition: tokenPosition + varName size - 1
+            ].
+            "/ self halt:'oops - should not happen'.
+        ].
+
+        "is it a private-class ?"
+
+        aClass := self classToLookForClassVars.
+        aClass := aClass theNonMetaclass.
+        aClass isLoaded ifTrue:[
+            (aClass privateClassesAt:varName) notNil ifTrue:[
+                parseForCode ifFalse:[self rememberGlobalUsed:(aClass name , '::' , varName)].
+                ^ (VariableNode type:#PrivateClass class:aClass name:varName)
+                    startPosition: tokenPosition endPosition: tokenPosition + varName size - 1
+            ].
+        ].
+
+        " is it a pool-variable ?"
+        classToCompileFor theNonMetaclass realSharedPoolNames do:checkSharedPoolAction.
     ].
 
     (self isDoIt) ifTrue:[
-	moreSharedPools notNil ifTrue:[
-	    moreSharedPools do:checkSharedPoolAction.
-	].
+        moreSharedPools notNil ifTrue:[
+            moreSharedPools do:checkSharedPoolAction.
+        ].
     ].
 
     "is it in a namespace ?"
     space := self findNameSpaceWith:varName.
     space notNil ifTrue:[
-	space ~~ Smalltalk ifTrue:[
-	    parseForCode ifFalse:[self rememberGlobalUsed:(space name , '::' , varName)].
-	    space isNameSpace ifTrue:[
-		^ (VariableNode globalNamed:(space name , '::' , varName))
-			startPosition: tokenPosition endPosition: tokenPosition + varName size - 1
-	    ].
-	    ^ (VariableNode type:#PrivateClass class:space name:varName)
-		startPosition: tokenPosition endPosition: tokenPosition + varName size -1
-	].
-	parseForCode ifFalse:[self rememberGlobalUsed:varName].
-	^ (VariableNode globalNamed:varName) startPosition: tokenPosition endPosition: tokenPosition + varName size - 1
+        space ~~ Smalltalk ifTrue:[
+            parseForCode ifFalse:[self rememberGlobalUsed:(space name , '::' , varName)].
+            space isNameSpace ifTrue:[
+                ^ (VariableNode globalNamed:(space name , '::' , varName))
+                        startPosition: tokenPosition endPosition: tokenPosition + varName size - 1
+            ].
+            ^ (VariableNode type:#PrivateClass class:space name:varName)
+                startPosition: tokenPosition endPosition: tokenPosition + varName size -1
+        ].
+        parseForCode ifFalse:[self rememberGlobalUsed:varName].
+        ^ (VariableNode globalNamed:varName) startPosition: tokenPosition endPosition: tokenPosition + varName size - 1
     ].
 
     "is it a global-variable ?"
     tokenSymbol := varName asSymbolIfInterned.
     tokenSymbol notNil ifTrue:[
-	(Smalltalk includesKey:tokenSymbol) ifTrue:[
-	    parseForCode ifFalse:[self rememberGlobalUsed:varName].
-	    ^ (VariableNode globalNamed:tokenSymbol) startPosition: tokenPosition endPosition: tokenPosition + varName size - 1
-	]
+        (Smalltalk includesKey:tokenSymbol) ifTrue:[
+            parseForCode ifFalse:[self rememberGlobalUsed:varName].
+            ^ (VariableNode globalNamed:tokenSymbol) startPosition: tokenPosition endPosition: tokenPosition + varName size - 1
+        ]
     ].
 
     "is it a workspace variable ?"
     (requestor notNil and:[requestor isStream not]) ifTrue:[
-	"/ when parsing doits, this is done twice;
-	"/ first, for the parse, then as a block-code
-	"/ for the code.
-	"/ We only care for WorkspaceVars in doIts
-	(self isDoIt) ifTrue:[
-	    (Workspace notNil
-	    and:[(holder := Workspace workspaceVariableAt:varName) notNil])
-	    ifTrue:[
-		^ (VariableNode type:#WorkspaceVariable holder:holder name:varName)
-		    startPosition: tokenPosition endPosition: tokenPosition + varName size - 1
-	    ]
-	]
+        "/ when parsing doits, this is done twice;
+        "/ first, for the parse, then as a block-code
+        "/ for the code.
+        "/ We only care for WorkspaceVars in doIts
+        (self isDoIt) ifTrue:[
+            (Workspace notNil
+            and:[(holder := Workspace workspaceVariableAt:varName) notNil])
+            ifTrue:[
+                ^ (VariableNode type:#WorkspaceVariable holder:holder name:varName)
+                    startPosition: tokenPosition endPosition: tokenPosition + varName size - 1
+            ]
+        ]
     ].
     "is it a doIt variable ?"
 
 "/    (requestor notNil and:[requestor isStream not]) ifTrue:[
-	"/ when parsing doits, this is done twice;
-	"/ first, for the parse, then as a block-code
-	"/ for the code.
-	"/ We only care for WorkspaceVars in doIts
-
-	(self isDoIt) ifTrue:[
-	    (doItTemporaries notNil
-	    and:[(holder := doItTemporaries at:varName asSymbol ifAbsent:nil) notNil])
-	    ifTrue:[
-		^ (VariableNode type:#DoItTemporary holder:holder name:varName)
-		    startPosition: tokenPosition endPosition: tokenPosition + varName size - 1
-	    ]
-	].
+        "/ when parsing doits, this is done twice;
+        "/ first, for the parse, then as a block-code
+        "/ for the code.
+        "/ We only care for WorkspaceVars in doIts
+
+        (self isDoIt) ifTrue:[
+            (doItTemporaries notNil
+            and:[(holder := doItTemporaries at:varName asSymbol ifAbsent:nil) notNil])
+            ifTrue:[
+                ^ (VariableNode type:#DoItTemporary holder:holder name:varName)
+                    startPosition: tokenPosition endPosition: tokenPosition + varName size - 1
+            ]
+        ].
 "/    ].
     ^ #Error
 
     "Modified: / 18-01-2011 / 18:02:32 / cg"
     "Modified: / 25-08-2011 / 13:53:22 / Jan Vrany <jan.vrany@fit.cvut.cz>"
     "Modified: / 05-10-2011 / 15:25:20 / az"
+    "Modified (format): / 27-07-2013 / 17:37:53 / cg"
 ! !
 
 !Parser methodsFor:'parsing-primitives & pragmas'!
@@ -10878,11 +10881,11 @@
 !Parser class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libcomp/Parser.st,v 1.765 2013-07-27 08:45:37 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/libcomp/Parser.st,v 1.766 2013-07-28 10:02:14 cg Exp $'
 !
 
 version_CVS
-    ^ '$Header: /cvs/stx/stx/libcomp/Parser.st,v 1.765 2013-07-27 08:45:37 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/libcomp/Parser.st,v 1.766 2013-07-28 10:02:14 cg Exp $'
 !
 
 version_SVN