class: DoWhatIMeanSupport
added: #codeCompletionForLiteralSymbol:element:considerAll:into:
changed: #tryCodeCompletionWithSource:nodeInterval:into:
"
COPYRIGHT (c) 2002 by eXept Software AG
All Rights Reserved
This software is furnished under a license and may be used
only in accordance with the terms of that license and with the
inclusion of the above copyright notice. This software may not
be provided or otherwise made available to, or used by, any
other person. No title to or ownership of the software is
hereby transferred.
"
"{ Package: 'stx:libwidg2' }"
Object subclass:#DoWhatIMeanSupport
instanceVariableNames:'tree tokens classOrNil methodOrNil contextOrNil instanceOrNil
codeView rememberedScopeNodes'
classVariableNames:'LastSource LastParseTree LastScanTokens LastChoices'
poolDictionaries:''
category:'System-Support'
!
Array variableSubclass:#InputCompletionResult
instanceVariableNames:''
classVariableNames:''
poolDictionaries:''
privateIn:DoWhatIMeanSupport
!
!DoWhatIMeanSupport class methodsFor:'documentation'!
copyright
"
COPYRIGHT (c) 2002 by eXept Software AG
All Rights Reserved
This software is furnished under a license and may be used
only in accordance with the terms of that license and with the
inclusion of the above copyright notice. This software may not
be provided or otherwise made available to, or used by, any
other person. No title to or ownership of the software is
hereby transferred.
"
!
documentation
"
Attention: this is currently being rewritten and refactored.
Don't get mad at the ugly (and duplicate) code.
Will cleanup when finished.
misc collected UI support (functional)
These used to be in the Smalltalk and SystemBrowser class;
however, they are only needed for programmers, and some of the stuff is useful in multiple
places.
Therefore it is:
1) not needed for standalone executables
2) published here to avoid multiple implementations
[author:]
Claus Gittinger (cg@exept.de)
"
! !
!DoWhatIMeanSupport class methodsFor:'code completion'!
codeCompletionForClass:classOrNil context:contextOrNil codeView:codeView
"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
codeCompletionForClass:classOrNil context:contextOrNil codeView:codeView
!
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'!
findNodeForInterval:interval in:source
^ self new findNodeForInterval:interval in:source
!
findNodeForInterval:interval in:source allowErrors:allowErrors
^ 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)."
^ self new
findNodeForInterval:interval in:source allowErrors:allowErrors mustBeMethod:mustBeMethod
!
findNodeForInterval:interval inParseTree:parseTree
^ self new findNodeForInterval:interval inParseTree:parseTree
!
findNodeIn:tree forInterval:interval
^ self new findNodeIn:tree forInterval:interval
! !
!DoWhatIMeanSupport class methodsFor:'input completion support'!
classCategoryCompletion:aPartialCategory inEnvironment:anEnvironment
"given a partial class category name, return an array consisting of
2 entries: 1st: the best (longest) match
2nd: collection consisting of matching categories"
|matches best lcName|
matches := IdentitySet new.
"/ search for exact match
anEnvironment allClassesDo:[:aClass |
|category|
category := aClass category.
(category notNil and:[category startsWith:aPartialCategory]) ifTrue:[
matches add:category
]
].
matches isEmpty ifTrue:[
"/ search for case-ignoring match
lcName := aPartialCategory asLowercase.
anEnvironment allClassesDo:[:aClass |
|category|
category := aClass category.
(category notNil and:[category asLowercase startsWith:lcName]) ifTrue:[
matches add:category
].
].
].
matches isEmpty ifTrue:[
^ Array with:aPartialCategory with:(Array with:aPartialCategory)
].
matches size == 1 ifTrue:[
^ Array with:matches first with:(matches asArray)
].
matches := matches asSortedCollection.
best := matches longestCommonPrefix.
^ Array with:best with:matches asArray
"
Smalltalk classCategoryCompletion:'Sys'
Smalltalk classCategoryCompletion:'System'
Smalltalk classCategoryCompletion:'System-BinaryStorage'
"
"Created: / 10-08-2006 / 13:06:45 / cg"
!
classNameEntryCompletionBlock
"this block can be used in a dialog to perform className completion"
^ self entryCompletionBlockFor:#'classnameCompletion:inEnvironment:'
"Modified: / 10-08-2006 / 13:22:02 / cg"
!
classnameCompletion:aPartialClassName filter:filterBlock inEnvironment:anEnvironment
"given a partial classname, return an array consisting of
2 entries: 1st: the best (longest) match
2nd: collection consisting of matching names"
|searchName matches matchedNamesWithoutPrefix ignCaseMatches best isMatchString cls nsPrefix
others lcSearchName tryToMatch idx words w1 w2 rslt bestMatch matchesForLongestPrefix|
aPartialClassName isEmpty ifTrue:[
matches := Smalltalk allClassesForWhich:filterBlock.
^ InputCompletionResult bestName:aPartialClassName matchingNames:#()
].
(words := aPartialClassName asCollectionOfWords) size > 1 ifTrue:[
w1 := words first.
w2 := words second.
rslt := self classnameCompletion:w1 filter:filterBlock inEnvironment:anEnvironment.
bestMatch := rslt first.
matches := rslt second.
('class' copyTo:(w2 size min:5)) = w2 ifTrue:[
matches := matches collect:[:m | m , ' class'].
bestMatch := bestMatch , ' class'.
].
^ InputCompletionResult bestName:bestMatch matchingNames:matches
].
(aPartialClassName startsWith:'Smalltalk::') ifTrue:[
nsPrefix := 'Smalltalk::'.
searchName := aPartialClassName withoutPrefix:'Smalltalk::'
] ifFalse:[
nsPrefix := ''.
searchName := aPartialClassName.
].
searchName := searchName asUppercaseFirst.
lcSearchName := searchName asLowercase.
isMatchString := searchName includesMatchCharacters.
matches := OrderedCollection new.
matchedNamesWithoutPrefix := Set new.
ignCaseMatches := OrderedCollection new.
others := OrderedCollection new.
tryToMatch :=
[:className :fullClassName|
|addIt|
isMatchString ifTrue:[
addIt := searchName match:className
] ifFalse:[
addIt := className startsWith:searchName.
].
addIt ifTrue:[
matches add:(nsPrefix , fullClassName).
matchedNamesWithoutPrefix add:className.
] ifFalse:[
"/ try ignoring case
isMatchString ifTrue:[
addIt := searchName match:className caseSensitive:false
] ifFalse:[
addIt := className asLowercase startsWith:lcSearchName.
addIt ifFalse:[
others add:className
]
].
addIt ifTrue:[
ignCaseMatches add:(nsPrefix , fullClassName).
matchedNamesWithoutPrefix add:className.
].
].
addIt
].
anEnvironment allClassesForWhich:filterBlock do:[:aClass |
|addIt fullClassName classNameWithoutPrefix|
aClass isMeta ifFalse:[
fullClassName := aClass name.
classNameWithoutPrefix := aClass nameWithoutPrefix.
addIt := tryToMatch value:fullClassName value:fullClassName.
addIt ifFalse:[
classNameWithoutPrefix ~~ fullClassName ifTrue:[
tryToMatch value:classNameWithoutPrefix value:fullClassName.
].
].
]
].
"/ matches isEmpty ifTrue:[
"/ matches := ignCaseMatches.
"/ ].
matches := matches , ignCaseMatches.
"/ matches isEmpty ifTrue:[
"/ matches := ignCaseMatches.
"/
"/"/ matches isEmpty ifTrue:[
"/"/ | nearBy |
"/"/ nearBy := SortedCollection new sortBlock:[:a :b | a key < b key].
"/"/ others do:[:className |
"/"/ |lcClassName dist cmpName|
"/"/
"/"/ lcClassName := className asLowercase.
"/"/ dist := lcClassName levenshteinTo:lcSearchName s:9 k:1 c:0 i:9 d:2.
"/"/
"/"/ cmpName := lcClassName copyTo:(lcSearchName size min:lcClassName size).
"/"/ dist := dist min:(cmpName levenshteinTo:lcSearchName s:9 k:1 c:0 i:9 d:2).
"/"/ cmpName := lcClassName copyTo:(lcSearchName size + 1 min:lcClassName size).
"/"/ dist := dist min:(cmpName levenshteinTo:lcSearchName s:9 k:1 c:0 i:9 d:2).
"/"/ dist < 4 ifTrue:[
"/"/ nearBy add:( dist -> (nsPrefix , className) ).
"/"/ ]
"/"/ ].
"/"/ matches := nearBy collect:[:eachPair | eachPair value].
"/"/ ].
"/ ].
matches isEmpty ifTrue:[
^ InputCompletionResult bestName:searchName matchingNames:(Array with:searchName)
].
matches size == 1 ifTrue:[
best := matches first.
^ InputCompletionResult bestName:best matchingNames:(matches asArray)
].
matches
sort:[:name1 :name2 |
"name1 comes before:name2 iff"
((name2 includes:$:) and:[(name1 includes:$:) not])
or:[ ((name1 includes:$:) == (name2 includes:$:))
and:[ (name1 size < name2 size)
or: [ name1 < name2 ]]
]
].
isMatchString ifTrue:[
best := searchName.
] ifFalse:[
matchesForLongestPrefix := matches select:[:m | m asLowercase startsWith:lcSearchName].
best := ignCaseMatches isEmpty
ifTrue:[ matchesForLongestPrefix longestCommonPrefix ]
ifFalse:[ matchesForLongestPrefix longestCommonPrefixCaseSensitive:false ].
best size < aPartialClassName size "best size == 0" ifTrue:[
best := matchedNamesWithoutPrefix longestCommonPrefix.
].
best size == 0 ifTrue:[
"if tried again, return next match"
idx := ((matches indexOf:aPartialClassName) + 1) \\ matches size.
idx ~~ 1 ifTrue:[
^ InputCompletionResult bestName:(matches at:idx) matchingNames:(matches asArray)
].
].
best size < aPartialClassName size ifTrue:[
best := aPartialClassName.
].
].
cls := anEnvironment classNamed:best.
(cls isBehavior and:[cls isNameSpace]) ifTrue:[
(matches conform:[:each | each = best
or:[each startsWith:(best , '::')]])
ifTrue:[
best := best , '::'
].
].
^ InputCompletionResult bestName:best matchingNames:matches asArray
"
Smalltalk classnameCompletion:'Arr'
Smalltalk classnameCompletion:'Arra'
Smalltalk classnameCompletion:'arra'
Smalltalk classnameCompletion:'*rray'
"
"Created: / 10-08-2006 / 13:01:08 / cg"
!
classnameCompletion:aPartialClassName inEnvironment:anEnvironment
"given a partial classname, return an array consisting of
2 entries: 1st: the best (longest) match
2nd: collection consisting of matching names"
^ self
classnameCompletion:aPartialClassName
filter:[:cls | true]
inEnvironment:anEnvironment
"
self classnameCompletion:'Arr' inEnvironment:Smalltalk
self classnameCompletion:'Arra' inEnvironment:Smalltalk
self classnameCompletion:'arra' inEnvironment:Smalltalk
self classnameCompletion:'*rray' inEnvironment:Smalltalk
"
"Created: / 24-11-1995 / 17:24:45 / cg"
"Modified: / 10-08-2006 / 13:01:30 / cg"
!
entryCompletionBlockFor:completionSelector
"this block can be used in a dialog to perform className completion"
^ [:contents :field |
|s what m|
s := contents withoutSpaces.
field topView withCursor:(Cursor questionMark) do:[
what := self perform:completionSelector with:s with:Smalltalk.
].
field contents:(what first).
(what at:2) size ~~ 1 ifTrue:[
UserPreferences current beepInEditor ifTrue:[
field device beep
]
]
].
"Created: / 10-08-2006 / 13:21:37 / cg"
!
globalNameCompletion:aPartialGlobalName inEnvironment:anEnvironment
"given a partial globalName, return an array consisting of
2 entries: 1st: the best (longest) match
2nd: collection consisting of matching names"
^ self globalNameCompletion:aPartialGlobalName inEnvironment:anEnvironment match:true
"
Smalltalk globalnameCompletion:'Arr'
Smalltalk globalnameCompletion:'Arra'
Smalltalk globalnameCompletion:'arra'
Smalltalk globalnameCompletion:'*rray'
"
"Created: / 10-08-2006 / 13:06:23 / cg"
!
globalNameCompletion:aPartialGlobalName inEnvironment:anEnvironment match:doMatch
"given a partial globalName, return an array consisting of
2 entries: 1st: the best (longest) match
2nd: collection consisting of matching names"
|searchName matches ignCaseMatches best isMatchString|
searchName := aPartialGlobalName.
searchName isEmpty ifTrue:[
^ Array with:searchName with:#()
].
(searchName at:1) isLowercase ifTrue:[
searchName := searchName copy asUppercaseFirst
].
isMatchString := doMatch and:[ searchName includesMatchCharacters ].
matches := OrderedCollection new.
ignCaseMatches := OrderedCollection new.
anEnvironment keysDo:[:aGlobalName |
| addIt|
isMatchString ifTrue:[
addIt := searchName match:aGlobalName
] ifFalse:[
addIt := aGlobalName startsWith:searchName
].
addIt ifTrue:[
matches add:aGlobalName
] ifFalse:[
"/ try ignoring case
isMatchString ifTrue:[
addIt := searchName match:aGlobalName caseSensitive:false
] ifFalse:[
addIt := aGlobalName asLowercase startsWith:searchName asLowercase
].
addIt ifTrue:[
ignCaseMatches add:aGlobalName
]
]
].
matches isEmpty ifTrue:[
matches := ignCaseMatches
].
matches isEmpty ifTrue:[
^ Array with:searchName with:(Array with:searchName)
].
matches size == 1 ifTrue:[
^ Array with:matches first with:(matches asArray)
].
matches := matches asSortedCollection.
isMatchString ifTrue:[
best := searchName.
] ifFalse:[
best := matches longestCommonPrefix.
].
^ Array with:best with:matches asArray
"
Smalltalk globalnameCompletion:'Arr'
Smalltalk globalnameCompletion:'Arra'
Smalltalk globalnameCompletion:'arra'
Smalltalk globalnameCompletion:'*rray'
"
"Created: / 10-08-2006 / 13:06:23 / cg"
!
methodProtocolCompletion:aPartialProtocolName inEnvironment:anEnvironment
"given a partial method protocol name, return an array consisting of
2 entries: 1st: the best (longest) match
2nd: collection consisting of matching protocols"
|matches best lcName|
matches := IdentitySet new.
"/ search for exact match
anEnvironment allMethodsWithSelectorDo:[:eachMethod :eachSelector |
|protocol|
protocol := eachMethod category.
(protocol notNil and:[protocol startsWith:aPartialProtocolName]) ifTrue:[
matches add:protocol
].
].
matches isEmpty ifTrue:[
"/ search for case-ignoring match
lcName := aPartialProtocolName asLowercase.
anEnvironment allMethodsWithSelectorDo:[:eachMethod :eachSelector |
|protocol|
protocol := eachMethod category.
(protocol notNil and:[protocol asLowercase startsWith:lcName]) ifTrue:[
matches add:protocol
].
].
].
matches isEmpty ifTrue:[
^ Array with:aPartialProtocolName with:(Array with:aPartialProtocolName)
].
matches size == 1 ifTrue:[
^ Array with:matches first with:(matches asArray)
].
matches := matches asSortedCollection.
best := matches longestCommonPrefix.
^ Array with:best with:matches asArray
"
Smalltalk methodProtocolCompletion:'doc'
Smalltalk methodProtocolCompletion:'docu'
Smalltalk methodProtocolCompletion:'documenta'
"
"Created: / 10-08-2006 / 13:05:27 / cg"
"Modified: / 16-03-2011 / 12:30:45 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
nameSpaceCompletion:aPartialClassName inEnvironment:anEnvironment
"given a partial name, return an array consisting of
2 entries: 1st: the best (longest) match
2nd: collection consisting of matching names"
^ self
classnameCompletion:aPartialClassName
filter:[:cls | cls isNameSpace]
inEnvironment:anEnvironment
"
DoWhatIMeanSupport nameSpaceCompletion:'To' inEnvironment:Smalltalk
"
"Created: / 10-08-2006 / 13:02:16 / cg"
!
packageCompletion:aPartialPackage inEnvironment:anEnvironment
"given a partial package name, return an array consisting of
2 entries: 1st: the best (longest) match
2nd: collection consisting of matching packages"
|matches best lcName|
matches := Smalltalk allProjectIDs
select:[:package | package startsWith:aPartialPackage].
matches isEmpty ifTrue:[
"/ search for case-ignoring match
lcName := aPartialPackage asLowercase.
anEnvironment allClassesDo:[:aClass |
|package|
package := aClass package.
(package notNil and:[package asLowercase startsWith:lcName]) ifTrue:[
matches add:package
].
].
].
matches isEmpty ifTrue:[
^ Array with:aPartialPackage with:(Array with:aPartialPackage)
].
matches size == 1 ifTrue:[
^ Array with:matches first with:(matches asArray)
].
matches := matches asSortedCollection.
best := matches longestCommonPrefix.
^ Array with:best with:matches asArray
"
DoWhatIMeanSupport packageCompletion:'stx:' inEnvironment:Smalltalk
DoWhatIMeanSupport packageCompletion:'stx:libw' inEnvironment:Smalltalk
"
"Created: / 10-08-2006 / 13:05:07 / cg"
!
packageNameEntryCompletionBlock
"this block can be used in a dialog to perform className completion"
^ self entryCompletionBlockFor:#'packageCompletion:inEnvironment:'
"Created: / 10-08-2006 / 13:22:31 / cg"
!
poolnameCompletion:aPartialClassName inEnvironment:anEnvironment
"given a partial poolname, return an array consisting of
2 entries: 1st: the best (longest) match
2nd: collection consisting of matching names"
^ self
classnameCompletion:aPartialClassName
filter:[:cls | cls isSharedPool]
inEnvironment:anEnvironment
"
self poolnameCompletion:'Win' inEnvironment:Smalltalk
self poolnameCompletion:'Z' inEnvironment:Smalltalk
self poolnameCompletion:'a' inEnvironment:Smalltalk
"
!
resourceCompletion:aPartialResourceName inEnvironment:anEnvironment match:doMatch ignoreCase:ignoreCase
"given a partial resource name, return an array consisting of
2 entries: 1st: the longest match
2nd: collection consisting of matching defined resources"
|matches best lcSym isMatch|
matches := IdentitySet new.
isMatch := doMatch and:[aPartialResourceName includesMatchCharacters].
anEnvironment allMethodsWithSelectorDo:[:eachMethod :eachSelector |
eachMethod hasResource ifTrue:[
eachMethod resources keysDo:[:eachResourceName |
(isMatch
ifTrue:[ (aPartialResourceName match:eachResourceName caseSensitive:ignoreCase not) ]
ifFalse:[ ignoreCase
ifTrue:[ (eachResourceName asLowercase startsWith:aPartialResourceName asLowercase) ]
ifFalse:[ (eachResourceName startsWith:aPartialResourceName) ] ]
) ifTrue:[
matches add:eachResourceName
].
].
].
].
(matches isEmpty and:[ignoreCase not]) ifTrue:[
"/ search for case-ignoring match
lcSym := aPartialResourceName asLowercase.
anEnvironment allMethodsWithSelectorDo:[:eachMethod :eachSelector |
eachMethod hasResource ifTrue:[
eachMethod resources keysDo:[:eachResourceName |
(isMatch
ifTrue:[ (aPartialResourceName match:eachResourceName caseSensitive:false) ]
ifFalse:[ (eachResourceName asLowercase startsWith:lcSym) ])
ifTrue:[
matches add:eachResourceName
].
].
].
].
].
matches isEmpty ifTrue:[
^ Array with:aPartialResourceName with:#()
].
matches size == 1 ifTrue:[
^ Array with:matches first with:(matches asArray)
].
matches := matches asSortedCollection.
best := matches longestCommonPrefix.
^ Array with:best with:matches asArray
"
DoWhatIMeanSupport resourceCompletion:'*debug*' inEnvironment:Smalltalk match:true ignoreCase:false
DoWhatIMeanSupport resourceCompletion:'context' inEnvironment:Smalltalk match:true ignoreCase:false
DoWhatIMeanSupport resourceCompletion:'key' inEnvironment:Smalltalk match:true ignoreCase:false
DoWhatIMeanSupport resourceCompletion:'cont' inEnvironment:Smalltalk match:true ignoreCase:false
"
"Created: / 06-07-2011 / 12:04:41 / cg"
!
selectorCompletion:aPartialSymbolName inEnvironment:anEnvironment
"given a partial selector, return an array consisting of
2 entries: 1st: the longest match
2nd: collection consisting of matching implemented selectors"
^ self selectorCompletion:aPartialSymbolName inEnvironment:anEnvironment match:false
!
selectorCompletion:aPartialSymbolName inEnvironment:anEnvironment match:doMatch
"given a partial selector, return an array consisting of
2 entries: 1st: the longest match
2nd: collection consisting of matching implemented selectors"
^ self
selectorCompletion:aPartialSymbolName
inEnvironment:anEnvironment
match:doMatch
ignoreCase:false
"
DoWhatIMeanSupport selectorCompletion:'inst*p' inEnvironment:Smalltalk match:true
DoWhatIMeanSupport selectorCompletion:'inst*pl' inEnvironment:Smalltalk match:true
DoWhatIMeanSupport selectorCompletion:'at:p' inEnvironment:Smalltalk match:true
DoWhatIMeanSupport selectorCompletion:'nextP' inEnvironment:Smalltalk match:true
DoWhatIMeanSupport selectorCompletion:'nextp' inEnvironment:Smalltalk match:true
"
"Modified: / 07-06-1996 / 08:44:33 / stefan"
"Modified: / 26-10-2010 / 20:30:27 / cg"
!
selectorCompletion:aPartialSymbolName inEnvironment:anEnvironment match:doMatch ignoreCase:ignoreCase
"given a partial selector, return an array consisting of
2 entries: 1st: the longest match
2nd: collection consisting of matching implemented selectors"
|matches best lcSym isMatch|
matches := IdentitySet new.
isMatch := doMatch and:[aPartialSymbolName includesMatchCharacters].
anEnvironment allMethodsWithSelectorDo:[:eachMethod :eachSelector |
(isMatch
ifTrue:[ (aPartialSymbolName match:eachSelector caseSensitive:ignoreCase not) ]
ifFalse:[ ignoreCase
ifTrue:[ (eachSelector asLowercase startsWith:aPartialSymbolName asLowercase) ]
ifFalse:[ (eachSelector startsWith:aPartialSymbolName) ] ])
ifTrue:[
matches add:eachSelector
].
].
(matches isEmpty and:[ignoreCase not]) ifTrue:[
"/ search for case-ignoring match
lcSym := aPartialSymbolName asLowercase.
anEnvironment allMethodsWithSelectorDo:[:eachMethod :eachSelector |
(isMatch
ifTrue:[ (aPartialSymbolName match:eachSelector caseSensitive:false) ]
ifFalse:[ (eachSelector asLowercase startsWith:lcSym) ])
ifTrue:[
matches add:eachSelector
].
].
].
matches isEmpty ifTrue:[
^ Array with:aPartialSymbolName with:#() "/ (Array with:aPartialSymbolName)
].
matches size == 1 ifTrue:[
^ Array with:matches first with:(matches asArray)
].
matches := matches asSortedCollection.
best := matches longestCommonPrefix.
^ Array with:best with:matches asArray
"
DoWhatIMeanSupport selectorCompletion:'inst*p' inEnvironment:Smalltalk match:true
DoWhatIMeanSupport selectorCompletion:'inst*pl' inEnvironment:Smalltalk match:true
DoWhatIMeanSupport selectorCompletion:'at:p' inEnvironment:Smalltalk match:true
DoWhatIMeanSupport selectorCompletion:'nextP' inEnvironment:Smalltalk match:true
DoWhatIMeanSupport selectorCompletion:'nextp' inEnvironment:Smalltalk match:true
"
"Modified: / 07-06-1996 / 08:44:33 / stefan"
"Created: / 26-10-2010 / 20:30:06 / cg"
! !
!DoWhatIMeanSupport class methodsFor:'rename support'!
goodRenameDefaultFor:oldName lastOld:lastOldName lastNew:lastNewName
"generate a reasonable default for a rename operation.
(used for rename category etc.)"
|prefix suffix lastNewSize lastOldSize left right inserted deleted tryAgain|
lastNewName isNil ifTrue:[ ^ nil].
lastNewSize := lastNewName size.
lastOldSize := lastOldName size.
(lastNewName endsWith:lastOldName) ifTrue:[
"last rename was
'foo' -> 'Xfoo'
then, a good default for
'bar' would be 'Xbar'
"
prefix := lastNewName copyTo:(lastNewSize - lastOldSize).
^ (prefix , oldName).
].
(lastOldName endsWith:lastNewName) ifTrue:[
"last rename was
'Xfoo' -> 'foo'
then, a good default for
'Xbar' would be 'bar'
"
prefix := lastOldName copyTo:(lastOldSize - lastNewSize).
(oldName startsWith:prefix) ifTrue:[
^ (oldName copyFrom:prefix size+1).
]
].
(lastOldName asLowercase = lastNewName asLowercase) ifTrue:[
(lastOldName first ~= lastNewName first) ifTrue:[
(lastOldName first isLowercase = oldName first isLowercase) ifTrue:[
"last rename was
'xfoo' -> 'Xfoo'
then, a good default for
'xbar' would be 'Xbar'
"
lastOldName first isLowercase ifTrue:[
^ oldName first asUppercase asString , (oldName copyFrom:2).
] ifFalse:[
^ oldName first asLowercase asString , (oldName copyFrom:2).
]
]
].
].
(lastOldName withoutSeparators = lastNewName) ifTrue:[
"last rename was
' foo ' -> 'foo'
then, a good default for
' bar ' would be 'bar'
"
^ oldName withoutSeparators.
].
(lastNewName startsWith:lastOldName) ifTrue:[
"last rename was
'foo' -> 'fooX'
then, a good default for
'bar' would be 'barX'
"
suffix := lastNewName copyLast:(lastNewSize - lastOldSize).
^ (oldName , suffix).
].
(lastOldName startsWith:lastNewName) ifTrue:[
"last rename was
'fooX' -> 'foo'
then, a good default for
'barX' would be 'bar'
"
suffix := lastOldName copyLast:(lastOldSize - lastNewSize).
(oldName endsWith:suffix) ifTrue:[
^ (oldName copyButLast:suffix size).
]
].
prefix := lastOldName commonPrefixWith:lastNewName.
suffix := lastOldName commonSuffixWith:lastNewName.
(prefix size > 0) ifTrue:[
(suffix size > 0) ifTrue:[
prefix := prefix copyTo:(((lastNewName size - suffix size) min:(lastOldName size - suffix size)) min:prefix size).
"last rename was
'fooR' -> 'fooXR'
then, a good default for
'barR' would be 'barXR'
"
left := lastOldName copyTo:prefix size.
right := lastOldName copyLast:suffix size.
lastNewSize > lastOldSize ifTrue:[
inserted := (lastNewName copyFrom:(left size + 1)) copyButLast:(right size).
inserted size > 0 ifTrue:[
(oldName startsWith:prefix) ifTrue:[
^ oldName copyWithAll:inserted insertedAfterIndex:prefix size
].
].
].
(oldName string endsWith:suffix string) ifTrue:[
deleted := (lastOldName string copyFrom:(prefix size + 1)) copyButLast:(suffix size).
(oldName size-suffix size-deleted size + 1) >= 1 ifTrue:[
((oldName copyFrom:oldName size-suffix size-deleted size + 1) copyTo:deleted size) = deleted ifTrue:[
"last rename was
'fooXR' -> 'fooR'
then, a good default for
'barXS' would be 'barS'
"
^ (oldName copyTo:oldName size-suffix size-deleted size) , suffix
]
]
]
].
(oldName endsWith:(lastOldName copyFrom:prefix size+1)) ifTrue:[
"last rename was
'fooX' -> 'fooY'
then, a good default for
'barX' would be 'barY'
"
left := oldName copyButLast:(lastOldName copyFrom:prefix size+1) size.
right := lastNewName copyFrom:prefix size+1.
^ left , right
]
].
suffix size > 0 ifTrue:[
|prefix2|
"last rename was:
'fooSUFF1' -> 'barSUFF1'
then, a good default for
'fooSUFF2' -> 'barSUFF2'
"
prefix := lastOldName copyTo:(lastOldName size - suffix size). "/ the foo
(oldName startsWith:prefix) ifTrue:[
prefix2 := lastNewName copyTo:(lastNewName size - suffix size). "/ the bar
^ prefix2,(oldName copyFrom:(prefix size+1)).
].
].
"/ was there something stripped at the end?
suffix := oldName commonSuffixWith:lastOldName.
[suffix size > 0] whileTrue:[
tryAgain := self
goodRenameDefaultFor:(oldName copyButLast:suffix size)
lastOld:(lastOldName copyButLast:suffix size)
lastNew:lastNewName.
tryAgain notNil ifTrue:[^ tryAgain].
suffix := suffix copyFrom:2.
].
^ nil
"
self goodRenameDefaultFor:'bar' lastOld:'foo' lastNew:'fooXX'
self goodRenameDefaultFor:'bar' lastOld:'foo' lastNew:'XXfoo'
self goodRenameDefaultFor:'barXX' lastOld:'fooXX' lastNew:'foo'
self goodRenameDefaultFor:'XXbar' lastOld:'XXfoo' lastNew:'foo'
self goodRenameDefaultFor:'barXX' lastOld:'fooXX' lastNew:'fooYY'
self goodRenameDefaultFor:'XXbar' lastOld:'XXfoo' lastNew:'foo'
self goodRenameDefaultFor:'bar2' lastOld:'foo1' lastNew:'foo01'
self goodRenameDefaultFor:'barXY' lastOld:'fooXY' lastNew:'fooY'
self goodRenameDefaultFor:'bar' lastOld:'foo' lastNew:'fXoo'
self goodRenameDefaultFor:'bar' lastOld:'foo' lastNew:'fXXXoo'
self goodRenameDefaultFor:'bar' lastOld:'foo' lastNew:'foXXXo'
self goodRenameDefaultFor:'bar001' lastOld:'foo001' lastNew:'foo002_001'
self goodRenameDefaultFor:'CoastCore-CSFoo' lastOld:'CoastCore-CSBar' lastNew:'Coast-Core-CSBar'
self goodRenameDefaultFor:'mti.odt2.level1HeadlineStyle'
lastOld:'mti.odt2.level1HeadlineMatchPattern'
lastNew:'Key_odt2_level1HeadlineMatchPattern'
"
"Modified: / 24-07-2011 / 11:06:03 / cg"
!
goodRenameDefaultForFile:oldName lastOld:lastOldName lastNew:lastNewName
"generate a reasonable default for a file rename operation.
(Try to rename multiple files in the new fileBrowser,
to see what this is doing)"
|prefix suffix t
lastOldWOSuffix lastNewWOSuffix oldWOSuffix lastOldRest oldRest lastNewRest
lastRemoved lastInserted default|
default := self goodRenameDefaultFor:oldName lastOld:lastOldName lastNew:lastNewName.
default notNil ifTrue:[ ^ default].
lastOldWOSuffix := lastOldName asFilename nameWithoutSuffix.
lastNewWOSuffix := lastNewName asFilename nameWithoutSuffix.
oldWOSuffix := oldName asFilename nameWithoutSuffix.
"/ suffix change ?
lastOldWOSuffix = lastNewWOSuffix ifTrue:[
lastOldName asFilename suffix ~= lastNewName asFilename suffix ifTrue:[
^ (oldName asFilename withSuffix:(lastNewName asFilename suffix)) pathName
].
].
default := self goodRenameDefaultFor:oldWOSuffix lastOld:lastOldWOSuffix lastNew:lastNewWOSuffix.
default notNil ifTrue:[
lastOldRest := lastOldName copyFrom:lastOldWOSuffix size + 1.
lastNewRest := lastNewName copyFrom:lastNewWOSuffix size + 1.
oldRest := oldName copyFrom:oldWOSuffix size + 1.
^ default , lastNewRest
].
prefix := lastOldWOSuffix commonPrefixWith:oldWOSuffix.
(lastNewWOSuffix startsWith:prefix) ifTrue:[
lastOldRest := lastOldWOSuffix copyFrom:prefix size + 1.
lastNewRest := lastNewWOSuffix copyFrom:prefix size + 1.
oldRest := oldWOSuffix copyFrom:prefix size + 1.
(lastNewRest endsWith:lastOldRest) ifTrue:[
t := lastNewRest copyButLast:lastOldRest size.
^ ((prefix , t , oldRest) asFilename withSuffix:oldName asFilename suffix) name
].
].
suffix := lastOldWOSuffix commonSuffixWith:lastNewWOSuffix.
suffix size > 0 ifTrue:[
"/ last change changed something at the beginning
prefix := oldWOSuffix commonPrefixWith:lastOldWOSuffix.
prefix size > 0 ifTrue:[
"/ this name starts with the same characters
lastRemoved := lastOldWOSuffix copyButLast:suffix size.
lastInserted := lastNewWOSuffix copyButLast:suffix size.
(lastRemoved startsWith:lastInserted) ifTrue:[
oldWOSuffix size >= lastInserted size ifTrue:[
^ (oldWOSuffix copyTo:lastInserted size) , (oldName copyFrom:lastRemoved size + 1)
]
].
^ lastInserted , (oldName copyFrom:lastRemoved size + 1)
].
].
^ nil
"Modified: / 07-11-2006 / 13:58:39 / cg"
! !
!DoWhatIMeanSupport class methodsFor:'typing distance'!
isKey:k1 nextTo:k2
"return true, if k1 and k2 are adjacent keys on the keyboard.
This is used to specially priorize plausible typing errors of adjacent keys.
CAVEAT: hard coded us- and german keyboards here."
^ self isKey:k1 nextTo:k2 onKeyboard:(self keyboard)
"
self isKey:$a nextTo:$a
self isKey:$a nextTo:$s
self isKey:$a nextTo:$q
self isKey:$a nextTo:$w
self isKey:$a nextTo:$z
self isKey:$a nextTo:$x
"
"Modified: / 16-01-2008 / 17:17:31 / cg"
!
isKey:k1 nextTo:k2 onKeyboard:keys
"return true, if k1 and k2 are adjacent keys on the keyboard defined by keys"
|row1 row2 col1 col2|
row1 := keys findFirst:[:eachRow | col1 := eachRow indexOf:k1. col1 ~~ 0].
row1 == 0 ifTrue:[^ false].
row2 := keys findFirst:[:eachRow | col2 := eachRow indexOf:k2. col2 ~~ 0].
row2 == 0 ifTrue:[^ false].
^ (row1-row2) abs <= 1 and:[(col1-col2) abs <= 1]
"
self isKey:$a nextTo:$q
self isKey:$a nextTo:$x
"
!
keyboard
"the keyboard layout (useful to figure out which keys are nearby a key,
to find possible typing errors)"
|lang|
lang := UserPreferences current language.
lang == #de ifTrue:[
^ #(
'1234567890-'
'*qwertzuiop'
'**asdfghjkl:'
'***yxcvbnm' ).
].
lang == #fr ifTrue:[
^ #(
'1234567890'
'*azertyuiop'
'**qsdfghjklm'
'***wxcvbn,' ).
].
^ #(
'1234567890-'
'*qwertyuiop'
'**asdfghjkl:'
'***zxcvbnm' ).
"
self keyboard
"
"Created: / 16-01-2008 / 17:17:13 / cg"
! !
!DoWhatIMeanSupport methodsFor:'code completion'!
codeCompletionForClass:classOrNilArg context:contextOrNil codeView:codeViewArg
"OBSOLETE; migrating to use the the new 'xxx: into:' protocol.
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 instanceOrNil
forceNewMessageSend classOfReceiver|
classOrNil := classOrNilArg.
codeView := codeViewArg.
crsrPos := codeView characterPositionOfCursor"-1".
char := codeView characterAtCharacterPosition:crsrPos.
"/ Transcript show:crsrPos; show:' '; showCR:char.
[crsrPos > 1 and:[char isSeparator or:['.' includes:char]]] whileTrue:[
crsrPos := crsrPos - 1.
char := codeView characterAtCharacterPosition:crsrPos.
].
interval := codeView selectedInterval.
"/ Transcript show:'iv: '; showCR:interval.
interval isEmpty ifTrue:[
interval := crsrPos"-1" to:crsrPos.
"/ Transcript show:'iv2: '; showCR:interval.
].
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.
"/ Transcript show:'nd1: '; showCR:node.
].
node isNil ifTrue:[
node := self findNodeForInterval:interval in:source allowErrors:true mustBeMethod:false.
"/ Transcript show:'nd2 try: '; showCR:node.
node isNil ifTrue:[
"/ Transcript showCR:'No parseNode found (syntax error before or in comment?)'.
self breakPoint:#cg.
"/ self information:'No parseNode found (syntax error before or in comment?)'.
^ self.
]
].
forceNewMessageSend := false.
"/ if there a separator between the variable's name and the cursor position...
(codeView characterBeforeCursor isSeparator
or:[ ')}]''' includes:codeView characterBeforeCursor ]
) ifTrue:[
(node isVariable
and:[ (parent := node parent) notNil
and:[ parent isMessage ]]
) ifTrue:[
"/ completion after a variable node...
parent isKeyword ifTrue:[
"/ and it is a keyword message, we complete the keyword message instead
node := parent.
] ifFalse:[
"/ otherwise, a unary message is probably intended to be sent to the variable.
"/ (however, no character is available to determine what is useful)
forceNewMessageSend := true.
].
] ifFalse:[
(node isUnary) ifTrue:[
"/ expanding <rcvr> foo |<- cursor here (i.e. a space after foo)
"/
forceNewMessageSend := true.
"/ "/ can we see what we get from foo?
"/ classOfReceiver := self
"/ classOfReceiver:node receiver
"/ inClass:classOrNil instance:instanceOrNil context:contextOrNil.
"/ classOfReceiver notNil ifTrue:[
"/ |mthd|
"/
"/ mthd := classOfReceiver lookupMethodFor:node selector.
"/ mthd notNil ifTrue:[
"/ self halt.
"/ (ParseTreeSearcher isDefinitelyGetterMethod:mthd) ifTrue:[
"/ forceNewMessageSend := true.
"/ ]
"/ ]
"/ ].
]
]
].
forceNewMessageSend ifTrue:[
"/ completion with nothing to start (right after a variable)
"/ see what the variable can understand and present the most useful stuff (very thin ice here)
classOfReceiver := self classOfNode:node.
classOfReceiver isNil ifTrue:[
"/ it does not make sense to offer anything, if we don't have any idea of what this
"/ will be...
Screen current beep.
] ifFalse:[
|superClass possible choice|
possible := classOfReceiver selectors.
superClass := classOfReceiver superclass.
[superClass notNil and:[(possible size + superClass selectors size) < 50]] whileTrue:[
possible := possible,superClass selectors.
superClass := superClass superclass.
].
possible := possible copy sort.
choice := self askUserForCompletion:('Message to "%1"' bindWith:node name) for:codeView from:possible.
choice isNil ifTrue:[
Screen current beep.
^ self
].
codeView
undoableDo:[
codeView insertStringAtCursor:choice
]
info:'Completion'.
].
^ self
].
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.
].
^ self "/ huh - strings or what?
].
checkedNode := node.
[checkedNode notNil] whileTrue:[
checkedNode isMessage ifTrue:[
"/ completion in a message-send
contextOrNil notNil ifTrue:[
"/ |rcvrNode idx rcvr val|
"/
"/ (rcvrNode := checkedNode receiver) isVariable ifTrue:[
"/ rcvrNode isSelf ifTrue:[
"/ classOrNil := contextOrNil receiver class.
"/ ] ifFalse:[
"/ (idx := contextOrNil argAndVarNames indexOf:rcvrNode name) ~~ 0 ifTrue:[
"/ val := contextOrNil argsAndVars at:idx.
"/ classOrNil := val class.
"/ ] ifFalse:[
"/ (idx := contextOrNil receiver class allInstVarNames indexOf:rcvrNode name) ~~ 0 ifTrue:[
"/ val := contextOrNil receiver instVarNamed:rcvrNode name.
"/ classOrNil := val class.
"/ ]
"/ ]
"/ ]
"/ ].
instanceOrNil := contextOrNil receiver
].
self
codeCompletionForMessage:checkedNode
inClass:classOrNil instance:instanceOrNil
context:contextOrNil codeView:codeView.
^ self
].
checkedNode isMethod ifTrue:[
"/ completion in a method's selector pattern
self codeCompletionForMethodSpec:checkedNode.
^ self.
].
checkedNode := checkedNode parent.
].
self information:'Node is neither variable nor message.'.
"Modified: / 04-07-2006 / 18:48:26 / fm"
"Modified: / 28-08-2013 / 17:15:25 / cg"
!
codeCompletionForMethod:methodOrNilArg orClass:classOrNilArg context:contextOrNilArg codeView:codeViewArg into:actionBlock
"provide code completion information by analyzing what the editing state is in codeViewArg
(cursor position, characters around cursor etc.) and calling back into actionBlock, passing
the info as argument. Te interface has been defined in that way (and tight coupling with internals
of the editor) because
1) the completer needs to know about the text around the cursor position
2) the edit operation for completion may be non-trivial
(although not yet fully implemented, non-local rewrite procedures may and will be added in the future
For example, in many situations, both a completion of a unary selector before the cursor,
or adding another keyword part after the cursor is posisble.
Thus, this provides a list of completions PLUS a list of edit operations (as per completion), to
perform the completion.
The caller has to open a dialog, providing the suggestions, and perform the corresponding edit operation.
An additional array containing a textual description for each suggestion is also provided, which could
be shown as info or appended to the suggestions (such as 'complete variable', 'complete keyword', etc.
ContextOrNil is the current context, if this is called from the debugger;
or nil, if called from the browser.
If nonNil, we can make better guesses, because we actually know what a variable's type is"
|crsrPos char interval source partialSource suggestions1 suggestions2 actions1 actions2 title1 title2|
methodOrNil := methodOrNilArg.
classOrNil := classOrNilArg.
codeView := codeViewArg.
contextOrNil := contextOrNilArg.
"/ 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 := crsrPos-1 to:crsrPos.
source := codeView contentsAsString string.
partialSource := source copyTo:crsrPos.
self
tryCodeCompletionWithSource:partialSource nodeInterval:interval
into:[:listOfSuggestions :listOfActions :titleWhenAsking |
suggestions1 := listOfSuggestions.
actions1 := listOfActions.
title1 := titleWhenAsking.
"/ suggestions1 size>100 ifTrue:[ self halt].
].
suggestions1 notEmptyOrNil ifTrue:[
actionBlock value:suggestions1 value:actions1 value:title1.
] ifFalse:[
self
tryCodeCompletionWithSource:source nodeInterval:interval
into:[:listOfSuggestions :listOfActions :titleWhenAsking |
suggestions2 := listOfSuggestions.
actions2 := listOfActions.
title2 := titleWhenAsking.
].
suggestions2 notEmptyOrNil ifTrue:[
actionBlock value:suggestions2 value:actions2 value:title2.
]
].
! !
!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 allBold } , (list copyWithout:lastChoice).
"/ ].
"/ ].
"/ choice := Tools::CodeCompletionMenu
"/ openFor:codeView
"/ at:position
"/ with:allTheBest.
"/ LastChoices isNil ifTrue:[
"/ LastChoices := Dictionary new.
"/ ].
"/ LastChoices at:what put:choice.
"/ ^ choice string
"Created: / 16-02-2010 / 10:09:57 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 28-08-2013 / 16:41: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"
!
classOfNode:aNode
"when showing possible completions for a message, it is a good idea to know what the reveiver
is."
| nm nodeVal receiverClass nodeSelector nodeReceiver|
aNode isLiteral ifTrue:[
^ aNode value class
].
aNode isVariable ifTrue:[
nm := aNode name.
nm = 'self' ifTrue:[
classOrNil isNil ifTrue:[^ UndefinedObject].
^ classOrNil
].
nm = 'super' ifTrue:[
classOrNil isNil ifTrue:[^ Object].
^ classOrNil superclass
].
nm isUppercaseFirst ifTrue:[
"/ simply 'evaluate' the variable (like in a browser's codeView)
"/ mhmh - will we catch workspace vars then?
Error handle:[:ex |
] do:[
nodeVal := Parser new evaluate:nm in:nil receiver:classOrNil.
].
nodeVal notNil ifTrue:[
^ nodeVal class
].
(classOrNil notNil and:[classOrNil theNonMetaclass classVarNames includes:aNode name]) ifTrue:[
nodeVal := classOrNil theNonMetaclass classVarAt:aNode name.
^ nodeVal class.
].
] ifFalse:[
contextOrNil notNil ifTrue:[
"/ a local in the context?
(contextOrNil argAndVarNames includes:nm) ifTrue:[
nodeVal := contextOrNil argsAndVars at:(contextOrNil argAndVarNames indexOf:nm).
nodeVal notNil ifTrue:[
^ nodeVal class
].
]
].
classOrNil notNil ifTrue:[
(classOrNil allInstVarNames includes:nm) ifTrue:[
instanceOrNil notNil ifTrue:[
^ (instanceOrNil instVarNamed:nm) class
].
"/ could look at existing instances here...
self breakPoint:#cg.
].
]
].
].
aNode isMessage ifTrue:[
nodeSelector := aNode selector.
nodeReceiver := aNode receiver.
"/ some hardwired knowlegde here
( #( #'new' #'basicNew' #'new:' #'basicNew:') includes: nodeSelector ) ifTrue:[
receiverClass := self classOfNode:nodeReceiver.
receiverClass notNil ifTrue:[
receiverClass isBehavior ifTrue:[
receiverClass isMeta ifTrue:[
^ receiverClass theNonMetaclass
]
]
].
].
classOrNil notNil ifTrue:[
(nodeReceiver isSelf and:[nodeSelector = #'class']) ifTrue:[
^ classOrNil class
].
].
(nodeSelector = #'size') ifTrue:[
^ SmallInteger
].
(#( isNil notNil not emptyOrNil notEmptyOrNil notEmpty isEmpty
= ~= == ~~
includes: contains:
and: or:
) includes:nodeSelector ) ifTrue:[
^ True "/ Boolean - not boolean; it does not contain the full protocol (would not find ifTrue:)
].
( #( + - * / // \\ ) includes:nodeSelector) ifTrue:[
"/ assume numeric
^ Number
].
( #( class theMetaclass theNonMetaClass ) includes:nodeSelector) ifTrue:[
"/ assume behavior
^ Class
].
].
^ nil
"Created: / 28-08-2013 / 16:34:53 / cg"
!
codeCompletionForLiteralSymbol:nodeOrNil element:tokenOrNil considerAll:considerAll into:actionBlock
"looking for all symbols is way too much and inprecise;
experiment: only present symbols which are used by the class,
and classes in that class category. We'll see..."
|sym possibleCompletions longest editAction start stop addSymbol
parentSelector parent symbolSelectorClass|
"/ Transcript show:'lit in '; show:methodOrNil; show:' / '; showCR:classOrNil.
start := (nodeOrNil ? tokenOrNil) start.
stop := (nodeOrNil ? tokenOrNil) stop.
(codeView characterAtCharacterPosition:stop) == $' ifTrue:[
^ self.
].
sym := (nodeOrNil ? tokenOrNil) value.
possibleCompletions := OrderedCollection new.
addSymbol :=
[:aSymbol |
(aSymbol startsWith:sym) ifTrue:[
(aSymbol = sym) ifFalse:[
possibleCompletions add:aSymbol
].
].
].
(nodeOrNil notNil
and:[ (parent := nodeOrNil parent) notNil
and:[ parent isMessage ]]) ifTrue:[
parentSelector := parent selector.
( #( perform: perform:ifNotUnderstood: ) includes: parentSelector) ifTrue:[
symbolSelectorClass := self classOfNode:parent receiver.
].
( #( #'onChangeSend:' ) includes: parentSelector) ifTrue:[
"/ assume that send-target will be self.
(methodOrNil notNil and:[ methodOrNil selector notNil and:[ methodOrNil selector isUnarySelector ]]) ifTrue:[
addSymbol value:(methodOrNil selector,'Changed').
].
symbolSelectorClass := classOrNil.
].
( #( #'onChangeSend:to:' ) includes: parentSelector) ifTrue:[
symbolSelectorClass := self classOfNode:parent arguments second.
].
symbolSelectorClass notNil ifTrue:[
symbolSelectorClass withAllSuperclassesDo:[:cls |
cls ~~ Object ifTrue:[
cls ~~ Model ifTrue:[
cls methodDictionary keysDo:addSymbol.
]
]
]
].
].
(considerAll or:[classOrNil isNil]) ifTrue:[
Symbol allInstancesDo:addSymbol.
] ifFalse:[
Smalltalk allClassesInCategory:classOrNil do:[:cls |
cls theNonMetaclass instAndClassMethodsDo:[:mthd |
mthd usedSymbols do:addSymbol
]
].
].
possibleCompletions sort.
longest := possibleCompletions longestCommonPrefix.
possibleCompletions remove:longest ifAbsent:[].
possibleCompletions addFirst: longest.
editAction :=
[:chosenIndex |
|chosen oldSym oldLen newLen|
chosen := possibleCompletions at:chosenIndex.
(codeView characterAtCharacterPosition:start) == $# ifTrue:[
start := start + 1.
].
(codeView characterAtCharacterPosition:start) == $' ifTrue:[
start := start + 1.
].
oldSym := (codeView textFromCharacterPosition:start to:stop) asString string withoutSeparators.
codeView
undoableDo:[
codeView replaceFromCharacterPosition:start to:stop with:chosen
]
info:'Completion'.
(chosen startsWith:oldSym) ifTrue:[
oldLen := stop - start + 1.
newLen := chosen size.
codeView selectFromCharacterPosition:start+oldLen to:start+newLen-1.
codeView dontReplaceSelectionOnInput
].
].
actionBlock value:possibleCompletions value:editAction value:'symbol'.
"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 selectorsSentInCode split editAction parentNodeClassIfKnown
otherMessagesToReceiver possibleClasses receiverNodeClassIfKnown|
"/ 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 classOfNode:node.
bestSelectors := Parser findBest:50 selectorsFor:selector in:srchClass forCompletion:true.
"/ ].
(bestSelectors includes:selector) ifTrue:[
bestSelectors := bestSelectors select:[:sel | sel size > selector size].
].
bestSelectors
].
selector := node selector.
parentNode := node parent.
"/ if there is already space before the cursor, and the parent node is not a message,
"/ do not attempty to complete the current message.
"/ If it is a message, we will look for parent-message completion also below (best2 stuff)
(codeView characterBeforeCursor ? $ ) isSeparator ifTrue:[
(parentNode notNil and:[ parentNode isMessage ]) ifFalse:[
^ self.
].
].
bestSelectors := findBest value:node receiver value:selector.
"/ if the receiver is a variable, we can look for other messages being sent to that variable in the current method
(tree notNil and:[ node receiver isVariable ])
ifTrue:[
otherMessagesToReceiver := tree allMessageNodes
select:[:eachMessageNode |
node receiver = eachMessageNode receiver
and:[ selector ~= eachMessageNode selector]]
thenCollect:[:eachNode | eachNode selector].
possibleClasses := Smalltalk allClassesForWhich:[:cls |
otherMessagesToReceiver conform:[:eachSelectorSent | cls canUnderstand:eachSelectorSent]].
possibleClasses := possibleClasses select:[:cls | cls isLoaded].
(possibleClasses notEmpty and:[possibleClasses size < 10]) ifTrue:[
bestSelectors := Set new.
possibleClasses do:[:eachClass |
|bestSelectorsForClass|
bestSelectorsForClass := Parser findBest:30 selectorsFor:selector in:eachClass forCompletion:true.
bestSelectors addAll:bestSelectorsForClass.
].
bestSelectors := bestSelectors asOrderedCollection
].
].
"/ if we are behind a keyword messages colon,
"/ only look for matching prefix selectors;
"/ also, a good completion is to insert an argument;
"/ the name of the variable from the implementation, as comment, and selected might be a good one!!
selector isKeyword ifTrue:[
codeView characterBeforeCursor == $: ifTrue:[
bestSelectors := bestSelectors select:[:sel | sel startsWith:selector].
bestSelectors isEmpty ifTrue:[
"/ nothing better around
|argIndex argNames impls|
argIndex := node selectorParts size.
argNames := Set new.
impls := Smalltalk allImplementorsOf:selector.
impls size < 10 ifTrue:[
impls do:[:eachImplClass |
|mthd argName|
mthd := (eachImplClass compiledMethodAt:selector).
argName := mthd methodArgNames at:argIndex.
argNames add:(argName,' in (' ,mthd mclass name allBold,' ',mthd methodDefinitionTemplate).
].
argNames notEmptyOrNil ifTrue: [
argNames := argNames asOrderedCollection sort.
actionBlock
value:argNames
value:[:selIndex |
]
value: 'argument name hint'.
^ self.
]
]
]
].
] ifFalse:[
"/ when completing a non-keyword AND the parent is a keyword message,
"/ only consider longer keyword messages or unary messages
(parentNode notNil and:[ parentNode isMessage and:[parentNode selector isKeywordSelector ]]) ifTrue:[
bestSelectors := bestSelectors select:[:sel | sel isUnarySelector ]
]
].
bestSelectors := bestSelectors asOrderedCollection sort:[:a :b | a size < b size].
(selector isUnarySelector
and:[ parentNode notNil
and:[ parentNode isMessage ]]) ifTrue:[
(selector2 := parentNode selector) isKeywordSelector ifTrue:[
"/ if its a unary message AND the parent is a keyword node, look for parent completion too.
"/ i.e. look if there is a longer keyword possible
selector2 := selector2,selector.
bestSelectors2 := findBest value:parentNode receiver value:selector2.
bestSelectors2 := bestSelectors2 select:[:sel | sel isKeywordSelector and:[ sel startsWith:selector2]].
bestSelectors2 := bestSelectors2 asOrderedCollection sort:[:a :b | a size < b size].
bestSelectors := bestSelectors reject:[:sel | bestSelectors2 includes:sel].
] ifFalse:[
|kwSels|
"/ if its a unary message AND the parent is a unary or binary node, try again, sending the partial message
"/ as a keyword to the parent node.
"/ this is the case when after "foo binOp bar if", which should include ifTrue: in the result.
"/ transform from
"/ foo == (shift if)
"/ nonKWsel-msg(parent)
"/ / \
"/ / \
"/ rcvr sel-unary(node)
"/ /
"/ /
"/ arg
"/
"/ into:
"/ (foo == shift) if
"/
"/ nonKWsel-msg(parent)
"/ / \
"/ / \
"/ rcvr sel-unary(node)
"/ /
"/ /
"/ arg
kwSels := findBest value:parentNode value:selector.
kwSels := kwSels select:[:sel | sel isKeywordSelector].
kwSels := kwSels asOrderedCollection sort:[:a :b | a size < b size].
bestSelectors := bestSelectors reject:[:sel | kwSels includes:sel].
"/ these need to go to bestSelectors (see editAction)
parentNodeClassIfKnown := self classOfNode:parentNode.
(parentNodeClassIfKnown notNil and:[ parentNodeClassIfKnown includesBehavior: Boolean ]) ifTrue:[
"/ this is so common, that it deserves a special case:
"/ if we complete an if after some boolean message e.g '(a == b) if'
"/ throw out the very unlikely ifNil, ifEmpty etc. messages (which are inherited by Object, but absolutely unrealistic)
bestSelectors := self
withoutSelectorsUnlikelyFor:parentNodeClassIfKnown
from:bestSelectors
forPartial:selector.
kwSels := self
withoutSelectorsUnlikelyFor:parentNodeClassIfKnown
from:kwSels
forPartial:selector.
"/ put keyword selectors in front, because they are very likely
bestSelectors := kwSels , bestSelectors.
] ifFalse:[
"/ put them at the end
bestSelectors := bestSelectors , kwSels.
].
]
].
(selector isUnarySelector
and:[ node isMessage ]) ifTrue:[
receiverNodeClassIfKnown := self classOfNode:node receiver.
(receiverNodeClassIfKnown notNil and:[ receiverNodeClassIfKnown includesBehavior: Boolean ]) ifTrue:[
"/ this is so common, that it deserves a special case:
"/ if we complete an if after some boolean message e.g '(a == b) if'
"/ throw out the very unlikely ifNil, ifEmpty etc. messages (which are inherited by Object, but absolutely unrealistic)
bestSelectors := self
withoutSelectorsUnlikelyFor:receiverNodeClassIfKnown
from:bestSelectors
forPartial:selector.
].
].
allBest := (bestSelectors ? #()) , (bestSelectors2 ? #()).
"/ if receiver is super, always include the method's own selector
node receiver isSuper ifTrue:[
(tree isMethod) ifTrue:[
|mSel|
mSel := tree selector.
mSel notNil ifTrue:[
(mSel startsWith:selector) ifTrue:[
"/ already the word before the cursor?
(mSel ~= selector) ifTrue:[
allBest remove:mSel ifAbsent:[].
allBest addFirst:mSel.
]
]
]
]
].
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 one's already sent in the code are moved to the top of the list.
allBest := split value:allBest value:[:sel | selectorsSentInCode includes:sel].
].
"/ the on'es 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 checkForArgumentTemplates|
checkForArgumentTemplates := false.
(selector isUnarySelector and:[best isKeywordSelector]) ifTrue:[ checkForArgumentTemplates := true ].
numArgs > nSelParts ifTrue:[
"/ new selector has more arguments; append them
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.
].
checkForArgumentTemplates := true.
].
"/ replace existing parts
(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.
checkForArgumentTemplates ifTrue:[
|extra hasSpace|
hasSpace := codeView characterAfterCursor isSeparator.
extra := hasSpace ifTrue:[''] ifFalse:[' '].
(
#(
'ifTrue:' 'ifFalse:' 'ifTrue:ifFalse:' 'ifFalse:ifTrue:' 'and:' 'or:'
) includes:best
) ifTrue:[
codeView insertStringAtCursor:('[]',extra).
codeView cursorLeft:1+extra size.
].
(
#(
'collect:' 'select:' 'reject:' 'do:'
) includes:best
) ifTrue:[
codeView insertStringAtCursor:('[:each | ]',extra).
codeView cursorLeft:1+extra size.
].
].
]
info:'Completion'.
].
].
actionBlock value:allBest value:editAction value:nil.
"Created: / 10-11-2006 / 13:18:27 / cg"
"Modified: / 16-02-2010 / 10:33:48 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 27-07-2013 / 16:34:10 / cg"
!
codeCompletionForMethodSpec:node
"completion in a method's selector pattern"
self
codeCompletionForMethodSpec:node
into:
[:suggestions :action :whatIsIt |
|chosen|
chosen := self askUserForCompletion:whatIsIt for:codeView at:node start from:suggestions.
action value:(suggestions indexOf:chosen)
].
"/ |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"
!
codeCompletionForMethodSpec:node into:actionBlock
"completion in a method's selector pattern"
|crsrPos crsrLine crsrCol
selectorSoFar matchingSelectors
selectors distances best rest
allExistingMethods nameBag namesByCount selectors1 selectors2
editAction argNames selectorsForVars|
"/ Transcript showCR:'m'.
crsrLine := codeView cursorLine.
crsrCol := codeView cursorCol.
crsrPos := codeView characterPositionOfCursor - 1.
node selector isUnarySelector ifTrue:[
"/ user has just begun to edit a selector.
"/ often, a good completion are the names of instVars for which no corresponding getter/setter exists
classOrNil notNil ifTrue:[
selectorsForVars := OrderedCollection new.
classOrNil instVarNames do:[:nm |
(nm startsWith:node selector) ifTrue:[
(classOrNil implements:nm asSymbol) ifFalse:[ selectorsForVars add:nm].
(classOrNil implements:(nm,':') asSymbol) ifFalse:[ selectorsForVars add:(nm,':')].
]
].
classOrNil isMeta ifTrue:[
classOrNil theNonMetaclass classVarNames do:[:nm |
|nmSel|
nmSel := nm asLowercaseFirst.
(nmSel startsWith:node selector) ifTrue:[
(classOrNil implements:nmSel asSymbol) ifFalse:[ selectorsForVars add:nmSel].
(classOrNil implements:(nmSel,':') asSymbol) ifFalse:[ selectorsForVars add:(nmSel,':')].
]
].
].
].
].
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.
selectorsForVars notNil ifTrue:[ selectors addAll:selectorsForVars ].
selectors := selectors sort:[:a :b | a size < b size].
selectors size > 100 ifTrue:[
selectors := selectors copyTo:100.
].
"/ 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]).
argNames := (namesByCount collect:[:a | a key]).
editAction :=
[:chosenIndex |
|chosenName|
chosenName := argNames at:chosenIndex.
codeView
undoableDo:[
(crsrPos+1) >= codeView contents size ifTrue:[
codeView paste:best.
] ifFalse:[
codeView insertString:chosenName atCharacterPosition:crsrPos+1.
].
codeView cursorToCharacterPosition:(crsrPos + chosenName size - 1).
]
info:'completion'.
].
actionBlock
value:argNames
value:editAction
value:'argument'.
^ self.
].
"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.
].
editAction :=
[:selectedCompletionIndex |
best := selectors at:selectedCompletionIndex.
rest := best copyFrom:selectorSoFar size + 1.
codeView
undoableDo:[
codeView insertString:rest atLine:crsrLine col:crsrCol.
]
info:'Completion'.
codeView cursorToCharacterPosition:(crsrPos+1 + rest size - 1).
codeView cursorRight. "/ kludge to make it visible
].
"/ best := self askUserForCompletion:'selector' for:codeView at:(node start) from:selectors.
actionBlock
value:selectors
value:editAction
value:'selector'.
].
].
"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 into:actionBlock
|nonMetaClass crsrPos nm parent
allVariables allDistances variablesAlreadyAdded nodeVal
char oldLen newLen
getDistanceComputeBlockWithWeight addWithFactorBlock names allTheBest bestAssoc
globalFactor localFactor selectorOfMessageToNode implementors argIdx namesUsed kwPart
editAction suggestions nameIsOK longerNames setOfNames|
"/ 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
]
].
"/ this is pure voodoo magic (tries to make a good spelling weight,
"/ by weighting the number of startsWith characters into the spelling distance...)
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].
names do:[:nameToAdd |
(nameToAdd ~= nm) ifTrue:[ "/ not again
(variablesAlreadyAdded includes:nameToAdd) ifFalse:[ "/ not again
variablesAlreadyAdded add:nameToAdd.
allVariables add:nameToAdd.
allDistances add:((getDistanceComputeBlockWithWeight value:factor) value:nameToAdd).
]
]
]
].
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 name 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:[
"/ locals in the block/method
names := OrderedCollection withAll:node allVariablesOnScope.
setOfNames := Set withAll:names.
rememberedScopeNodes notNil ifTrue:[
"/ notNil when a parseError occurred.
rememberedScopeNodes do:[:eachScope |
(eachScope isMethod or:[eachScope isBlock]) ifTrue:[
eachScope argumentNames do:[:eachName |
(setOfNames includes:eachName) ifFalse:[ names add:eachName. setOfNames add:eachName ]
]
] ifFalse:[
eachScope isSequence ifTrue:[
eachScope temporaryNames do:[:eachName |
(setOfNames includes:eachName) ifFalse:[ names add:eachName. setOfNames add:eachName ]
]
] ifFalse:[
]
].
"/ (setOfNames includesAll:(eachScope allDefinedVariables)) ifFalse:[ self halt].
].
rememberedScopeNodes do:[:eachScope |
eachScope variableNodesDo:[:var |
(setOfNames includes:var name) ifFalse:[
names add:var name. setOfNames add:var name
]
]
]
] ifFalse:[
"/ tree must be there
tree variableNodesDo:[:var |
(setOfNames includes:var name) ifFalse:[
names add:var name. setOfNames add:var name
]
]
].
addWithFactorBlock value:names value:(4 * localFactor).
classOrNil notNil ifTrue:[
"/ 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).
].
].
"/ magic:
"/ if the node to be expanded is the receiver in a message, look for the selector sent to it
"/ give names which respond to those messages a higher weight
selectorOfMessageToNode notNil ifTrue:[
|names responders nonResponders|
"/ responding to that messsage
"/ self halt.
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:$:) and:[ (Smalltalk at:nm) isBehavior not]
].
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).
classOrNil notNil ifTrue:[
"/ 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 ].
"/ only consider all globals, if the first char of the completed name is uppercase;
"/ otherwise, only consider names with a caseInsensitve prefix match
nm first isUppercase ifTrue:[
] ifFalse:[
names := names select:[:globalName | globalName asLowercase startsWith: nm].
].
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' 'true') 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.
nameIsOK ifTrue:[
"/ if the name already exists, only allow longer names, if there are
longerNames := allTheBest select:[:assoc | assoc key startsWith:nm].
longerNames notEmpty ifTrue:[
allTheBest := longerNames.
].
].
allTheBest size > 15 ifTrue:[
"/ remove all those which are below some threshold
0.4 to:0.8 by:0.1 do:[:delta |
"/ if still too many, remove more and more
allTheBest size > 15 ifTrue:[
allTheBest := allDistances select:[:entry | (entry key startsWith:nm) or:[ entry value >= (bestAssoc value * delta) ]].
]
].
].
suggestions := allTheBest collect:[:assoc | assoc key].
"/ finally, the trick is to bring them into a reasonable order...
"/ sort the prefix matchers by length, the others by spelling distance
"/ and bring the prefix-matchers towards the beginning
suggestions := ((suggestions select:[:s | s startsWith:nm]) sort:[:a :b | a size < b size ])
,
(suggestions reject:[:s | s startsWith:nm]).
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.
oldLen := stop - start + 1.
newLen := answer size.
codeView
undoableDo:[
codeView replaceFromCharacterPosition:start to:stop with:(answer).
(answer startsWith:oldVar) ifTrue:[
codeView selectFromCharacterPosition:start+oldLen to:start+newLen-1.
] ifFalse:[
codeView selectFromCharacterPosition:start to:start+newLen-1.
].
codeView dontReplaceSelectionOnInput
]
info:'Completion'.
].
actionBlock value:suggestions value:editAction value:nil.
"Created: / 10-11-2006 / 13:16:33 / cg"
"Modified: / 16-02-2010 / 10:13:13 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 30-07-2013 / 08:36:11 / 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)."
^ self
findNodeForInterval:interval in:source allowErrors:allowErrors
mustBeMethod:mustBeMethod mustBeExpression:false
!
findNodeForInterval:interval in:source allowErrors:allowErrors mustBeMethod:mustBeMethod mustBeExpression:mustBeExpression
"parse it as expression or method;
if mustBeMethod is true, do not try a regular expressions (as in a workspace);
if mustBeExpression is true, do not try method"
|intersectingNodes smallestIntersectingNode firstIntersectingNode
lastIntersectingNode onErrorBlock
nodeGenerationHook parserClass parser currentScopeNodes bestNode|
interval isEmpty ifTrue: [^ nil].
classOrNil notNil ifTrue:[
parserClass := classOrNil programmingLanguage parserClass.
"/ hack
parserClass == Parser ifTrue: [
parserClass := RBParser.
].
] ifFalse:[
parserClass := RBParser.
].
parserClass isNil ifTrue: [^ nil].
rememberedScopeNodes := nil.
"/ LastSource := nil.
source = LastSource ifTrue:[
tree := LastParseTree.
tokens := LastScanTokens.
] ifFalse:[
intersectingNodes := OrderedCollection new.
currentScopeNodes := IdentitySet new.
onErrorBlock :=
[:str :err :nodesSoFar |
|nodes|
allowErrors ifTrue:[
rememberedScopeNodes := currentScopeNodes.
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
].
self debuggingCodeFor:#cg is:[
Transcript show:'looking for: '; showCR:interval.
].
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 interpretation (especially: scope of variable) will be.
"/ therefore, we parse all, and return the found node at the end.
(node isMethod or:[node isBlock or:[node isSequence]]) ifTrue:[
currentScopeNodes add:node.
] ifFalse:[
self debuggingCodeFor:#cg is:[
Transcript show:node; show:' '; show:node start; show:'->'; showCR:node stop.
].
(node intersectsInterval:interval) ifTrue:[
self debuggingCodeFor:#cg is:[
Transcript showCR:'yes'.
].
intersectingNodes add:node.
firstIntersectingNode isNil ifTrue:[
firstIntersectingNode := lastIntersectingNode := smallestIntersectingNode := node
] ifFalse:[
|lenNode lenSmallest|
lenNode := (node stop - node start).
lenSmallest := (smallestIntersectingNode stop - smallestIntersectingNode start).
lenNode < lenSmallest ifTrue:[
smallestIntersectingNode := node.
].
node start > lastIntersectingNode start ifTrue:[
lastIntersectingNode := node.
].
].
].
].
].
"/ one of the big problems when using the RBParser here is
"/ that it behaves badly when a syntax error is encountered;
"/ for example, a node's parent is usually set AFTER the children are
"/ completely parsed (for example, a blockNode gets the parent-method only
"/ after parsing). Thus, when an error is encountered, we cannot walk
"/ the parent chain, and therefore will not see the outer locals/args of
"/ an inner scope (allVariablesOnScope returns only a partial set).
"/ A walkaround is to remember Method/Block nodes as created in the above node generation.
"/ The disadvantage of it is that we do not have correct scope information, until the nodes
"/ parent gets set eventually, this we might consider locals from sibling blocks.
"/ See rememberedScopeNodes handling above.
"/ Those other nodes are only remembered for failed parses;
"/ if the parse is ok, rememberedScopeNodes will be nil.
mustBeExpression ifFalse:[
tree := parserClass
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 := parserClass
parseExpression: source
setup:[:p |
parser := p.
p rememberNodes:true.
p rememberTokens:true.
p nodeGenerationCallback:nodeGenerationHook
]
onError: onErrorBlock.
parser notNil ifTrue:[ tokens := parser rememberedTokens ].
].
].
lastIntersectingNode notNil ifTrue:[
self debuggingCodeFor:#cg is:[
Transcript show:'last: '; showCR:lastIntersectingNode.
].
^ lastIntersectingNode
].
"/ firstIntersectingNode notNil ifTrue:[ ^ firstIntersectingNode ].
].
bestNode := self findNodeForInterval:interval inParseTree:tree.
self debuggingCodeFor:#cg is:[
Transcript show:'best: '; showCR:bestNode.
].
^ bestNode
"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"
!
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:[
"/ move tha last choice to the top of the list, if it is in.
(list includes: lastChoice) ifTrue:[
(list indexOf: lastChoice) < 10 ifTrue:[
list := {lastChoice allBold } , (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].
menu memorizeLastSelection:3 "sigh, not 1 because of heading!!".
idx := menu startUpWithHeading:'Choose ',what.
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].
].
choice := choice string.
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: / 28-08-2013 / 15:28:01 / 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"
!
tryCodeCompletionWithSource:source nodeInterval:interval into:actionBlock
"this is tried twice; first with the source copied up to the cursor position,
then with the full source.
Either one may give better results (for example, when completing
after a keyword selector, and the remaining code would lead to a syntactically
legal, but stupid message send to be parsed...
(which happens often after inserting)"
|node checkedNode characterPositionOfCursor characterBeforeCursor nodeIsInTemporaries|
characterPositionOfCursor := codeView characterPositionOfCursor.
"/ 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.
(methodOrNil notNil or:[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 mustBeExpression:true.
node isNil ifTrue:[
"/ Transcript showCR:'No parseNode found (syntax error before or in comment?)'.
self information:'No parseNode found (syntax error before or in comment?)'.
^ self.
].
].
(node isVariable
and:[ node parent notNil
and:[ node parent isMessage
and:[ node stop < (characterPositionOfCursor-1) ]]]) ifTrue:[
node := node parent.
].
characterBeforeCursor := codeView characterBeforeCursor.
characterBeforeCursor isNil ifTrue:[ "at begin of line" ^ self].
characterBeforeCursor == $. ifTrue:[ "at end of statement" ^ self].
node isVariable ifTrue:[
nodeIsInTemporaries :=
node parent notNil
and:[ node parent isSequence
and:[ node parent temporaries notEmptyOrNil
and:[ node stop <= node parent temporaries last stop ]]].
nodeIsInTemporaries ifFalse:[
"/ cursor must be right after the variable
characterPositionOfCursor == (node stop + 1) ifTrue:[
self codeCompletionForVariable:node into:actionBlock.
]
].
^ self.
].
node isLiteral ifTrue:[
"/ however, user may want to complete a symbol inside a literal array!!
node value isArray ifTrue:[
node token isLiteralArray ifTrue:[
|elementBeforeCursor|
elementBeforeCursor := node token value detect:[:anElementToken | characterPositionOfCursor == (anElementToken stop + 1)] ifNone:nil.
(elementBeforeCursor notNil and:[ elementBeforeCursor value isSymbol ]) ifTrue:[
self codeCompletionForLiteralSymbol:nil element:elementBeforeCursor considerAll:true into:actionBlock.
^ self.
].
].
].
"/ cursor must be right after the literal
characterPositionOfCursor == (node stop + 1) ifFalse:[
^ self
].
node value isSymbol ifTrue:[
self codeCompletionForLiteralSymbol:node element:nil considerAll:false into:actionBlock.
^ self.
].
"/ huh - completing strings, numbers or what?
(node parent notNil
and:[ node parent isMessage
and:[ node parent isKeyword ]])
ifFalse:[
^ self
].
"/ no, move up and try completing the outer keyword message (next arg)
node := node parent.
].
checkedNode := node.
[checkedNode notNil] whileTrue:[
(characterPositionOfCursor < (checkedNode stop ? source size)) ifTrue:[
self information:'Inside a message node'.
^ self.
].
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 codeCompletionForMethodSpec: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"
!
withoutSelectorsUnlikelyFor:aClass from:selectorsArg forPartial:partialSelector
|selectors|
selectors := (selectorsArg ? #()) asOrderedCollection.
self tracePoint:#cg message:aClass.
"/ using True, but actually meaning Boolean here
aClass == True ifTrue:[
selectors removeAllFoundIn:#(
'ifNil:' 'ifNotNil:' 'ifNil:ifNotNil:' 'ifNotNil:ifNil:' 'ifNotNilDo:'
'ifEmpty:' 'ifNotEmpty:' 'ifNotEmptyDo:' 'ifEmpty:ifNotEmpty:'
'ifEmpty:ifNotEmptyDo:' 'ifNotEmptyDo:ifEmpty:' 'ifEmptyDo:ifNotEmpty:'
).
(partialSelector startsWith:'is') ifFalse:[
"/ get rid of all isXXX selectors
selectors := selectors reject:[:sel | sel startsWith:'is'].
].
(partialSelector startsWith:'no') ifFalse:[
"/ get rid of all notXXX selectors
selectors := selectors reject:[:sel | sel startsWith:'no'].
].
].
(aClass inheritsFrom: ArithmeticValue) ifTrue:[
selectors removeAllFoundIn:#(
'ifNil:' 'ifNotNil:' 'ifNil:ifNotNil:' 'ifNotNil:ifNil:' 'ifNotNilDo:'
'ifEmpty:' 'ifNotEmpty:' 'ifNotEmptyDo:' 'ifEmpty:ifNotEmpty:'
'ifEmpty:ifNotEmptyDo:' 'ifNotEmptyDo:ifEmpty:' 'ifEmptyDo:ifNotEmpty:'
).
].
aClass notNil ifTrue:[
"/ actually: they are very likely, so move them to top
selectors := (selectors select:[:sel | aClass implements:sel])
,
(selectors reject:[:sel | aClass implements:sel])
].
^ selectors
! !
!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 instance:instanceOrNil context:contextOrNil codeView:codeView
|selector srchClass implClass
bestSelectors selector2 bestSelectors2 bestSelectorsFromRB allBest best info numArgs
newParts nSelParts oldLen newLen selectorParts
findBest parentNode selectorInBest selector2InBest2
parser selectorsSentInCode selectorsImplementedInClass split
varName rbTypes rbType tryParent parentIsKeywordMessage parentIsBinaryMessage rcvrClass|
RefactoryTyper notNil ifTrue:[
"/ refactory package also provides a (very limited) typer;
"/ ask it for its oppinion as well (temporary - will vanish, once we have a better typer)
(node receiver isVariable) ifTrue:[
varName := node receiver name.
varName isUppercaseFirst ifTrue:[
] ifFalse:[
tree := RBParser
parseMethod:codeView contents string
onError:[:aString :pos | nil].
tree notNil ifTrue:[
rbTypes := RefactoryTyper
classesFor: varName
in: tree
model: nil
ignoredSelectors:(Array with:node selector).
rbTypes size > 0 ifTrue:[
rbTypes size > 1 ifTrue:[
rbTypes remove:ProtoObject ifAbsent:[].
rbTypes remove:Autoload ifAbsent:[].
rbTypes remove:ObsoleteObject ifAbsent:[].
].
rbTypes size == 1 ifTrue:[
rbType := rbTypes first.
] ifFalse:[
rbType := Class commonSuperclassOf:rbTypes
].
(rbType notNil "and:[rbType ~= Object]") ifTrue:[
bestSelectorsFromRB := Parser findBest:30 selectorsFor:node selector in:rbType forCompletion:true.
].
]
]
]
].
].
classOrNil notNil ifTrue:[
parser := Parser parseMethod:codeView contents string in:classOrNil ignoreErrors:true ignoreWarnings:true.
selectorsSentInCode := parser messagesSent.
].
classOrNil notNil ifTrue:[
selectorsImplementedInClass := classOrNil selectors.
].
findBest := [:node :selector |
|srchClass bestSelectors bestPrefixes|
codeView topView withCursor:(Cursor questionMark) do:[
srchClass := self classOfNode:node receiver.
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.
parentIsKeywordMessage :=
(parentNode notNil
and:[ parentNode isMessage
and:[ parentNode selector isKeywordSelector]]).
parentIsBinaryMessage :=
(parentNode notNil
and:[ parentNode isMessage
and:[ parentNode selector isBinarySelector]]).
tryParent := false.
"/ if its a unary message AND the parent is a keyword node, look for parent completion too.
(node selector isUnarySelector and:[ parentIsKeywordMessage ]) ifTrue:[
tryParent := true.
] ifFalse:[
"/ if the parent is an instance creation message, take that as lookup class.
(node isMessage
and:[ node receiver isMessage
and:[ node receiver receiver isVariable
and:[ node receiver receiver name isUppercaseFirst
and:[ #(new new:) includes:(selector2 := node receiver selector) ]]]]) ifTrue:[
rcvrClass := Smalltalk classNamed:(node receiver receiver name).
"/ srchClass2 := self lookupClassForMessage:parentNode inClass:classOrNil.
bestSelectors := Parser findBest:30 selectorsFor:selector in:rcvrClass forCompletion:true.
] ifFalse:[
"/ also, if nothing was found
(bestSelectors isEmpty
and:[ parentNode notNil
and:[ parentNode isMessage ]]) ifTrue:[
"/ srchClass2 := self lookupClassForMessage:parentNode inClass:classOrNil.
"/ selector2 := parentNode selector.
"/ selector2 := selector2,selector.
bestSelectors := findBest value:parentNode value:selector.
]
]
].
tryParent ifTrue:[
selector2 := parentNode selector,selector.
bestSelectors2 := findBest value:parentNode value:selector2.
].
bestSelectorsFromRB notEmptyOrNil ifTrue:[
bestSelectors := bestSelectorsFromRB , (bestSelectors reject:[:sel | bestSelectorsFromRB includes:sel]).
].
"/ if the parent is a keyword selector, the child cannot
(parentIsKeywordMessage or:[parentIsBinaryMessage]) ifTrue:[
bestSelectors := bestSelectors reject:[:sel | sel isKeywordSelector]
].
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
].
selectorsImplementedInClass notNil ifTrue:[
"/ the ones implemented in the receiver class are moved to the top of the list.
allBest := split value:allBest value:[:sel | selectorsImplementedInClass includes:sel].
].
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:[
allBest remove:nil ifAbsent:[].
best := Dialog request:'Matching selectors:' initialAnswer:best list:allBest.
]."
allBest remove:nil ifAbsent:[].
best := self askUserForCompletion:('Selector for "%1"' bindWith: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 isKeywordSelector) ifTrue:[
(oldPartialToken value endsWith:$:) ifTrue:[
newPart := newPart , ':'
] ifFalse:[
(codeView characterAtCharacterPosition:stop+1) == $: ifFalse:[
newPart := newPart , ':'
]
]
] ifFalse:[
(codeView characterAtCharacterPosition:stop) == $: ifTrue:[
newPart := newPart , ':'
] ifFalse:[
(codeView characterAtCharacterPosition:stop+1) isSeparator ifFalse:[
(').' includes:(codeView characterAtCharacterPosition:stop+1)) 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.
"/ codeView selectFromCharacterPosition:start+oldLen to:start+newLen-1.
newCursorPosition isNil ifTrue:[
oldLen := stop - start + 1.
newLen := newPart size.
newCursorPosition := stop + (newLen-oldLen)
].
].
codeView cursorToCharacterPosition:newCursorPosition.
codeView cursorRight. "/ avoid going to the next line !!
((best endsWith:':') and:[numArgs == 1]) ifTrue:[
|impls impl|
"/ see if it expects a block argument (heuristic)
best := best asSymbol.
(node notNil
and:[classOrNil notNil
and:[node receiver isSelf]]) ifTrue:[
(impl := classOrNil whichClassImplements:best) isNil ifTrue:[
impls := #().
Screen current beep.
] ifFalse:[
impls := { impl }
]
] ifFalse:[
impls := Smalltalk allImplementorsOf:best.
].
(impls contains:[:cls |
|argName|
argName := ((cls compiledMethodAt:best) methodArgAndVarNames at:1) asLowercase.
(argName includesString:'block') or:[ (argName includesString:'action')]]
) ifTrue:[
codeView insertStringAtCursor:'['
].
].
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: / 28-08-2013 / 15:27:32 / cg"
!
codeCompletionForVariable:node inClass:classOrNil codeView:codeView
|parent 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.
].
].
((parent := node 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)
]
].
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 method's selector spec ?
((parent := node 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] 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
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 ].
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).
addWithFactorBlock value:#('true') value:(1 * localFactor).
addWithFactorBlock value:#('false') 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) count:[:entry | entry value]) > 20 ifTrue:[
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 "%1"' bindWith:node name) 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: / 28-08-2013 / 15:37:28 / cg"
! !
!DoWhatIMeanSupport::InputCompletionResult class methodsFor:'instance creation'!
bestName:bestNameArg matchingNames:matchingNamesArg
^ self with:bestNameArg with:matchingNamesArg
"
self bestName:123 matchingNames:345
"
! !
!DoWhatIMeanSupport::InputCompletionResult methodsFor:'accessing'!
bestName
^ self at:1
!
matchingNames
^ self at:2
! !
!DoWhatIMeanSupport class methodsFor:'documentation'!
version
^ '$Header: /cvs/stx/stx/libwidg2/DoWhatIMeanSupport.st,v 1.153 2013-09-09 16:14:19 cg Exp $'
!
version_CVS
^ '$Header: /cvs/stx/stx/libwidg2/DoWhatIMeanSupport.st,v 1.153 2013-09-09 16:14:19 cg Exp $'
! !