#DOCUMENTATION by cg
class: DoWhatIMeanSupport
comment/format in: #codeCompletionForVariable:inClass:codeView:
--- a/DoWhatIMeanSupport.st Thu Sep 22 15:05:19 2016 +0200
+++ b/DoWhatIMeanSupport.st Thu Sep 22 15:07:45 2016 +0200
@@ -5114,7 +5114,7 @@
globalFactor localFactor selectorOfMessageToNode tree implementors argIdx namesUsed kwPart|
classOrNil notNil ifTrue:[
- nonMetaClass := classOrNil theNonMetaclass.
+ nonMetaClass := classOrNil theNonMetaclass.
].
nm := node name.
@@ -5125,87 +5125,87 @@
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.
- ].
+ 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
- ]
+ 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)
- ]
- ].
+ [: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 :=
- [:eachNames :factor | |namesToAdd|
- namesToAdd := eachNames select:[:nameToAdd | nameToAdd ~= nm ].
- namesToAdd := namesToAdd reject:[:each | allVariables includes:each ].
- allVariables addAll:namesToAdd.
- allDistances addAll:(namesToAdd collect:(getDistanceComputeBlockWithWeight value:factor)).
- ].
+ [:eachNames :factor | |namesToAdd|
+ namesToAdd := eachNames 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.
+ globalFactor := 2. "/ favour globals
+ localFactor := 1.
] ifFalse:[
- globalFactor := 1. "/ favour locals
- localFactor := 2.
+ globalFactor := 1. "/ favour locals
+ localFactor := 2.
].
allVariables := OrderedCollection new.
@@ -5215,209 +5215,209 @@
((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).
- ].
- ].
- ]
+ "/ now that's 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|
-
- 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|
-
- 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:[
- |names|
-
- 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|
-
- 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).
+ classOrNil notNil ifTrue:[
+ "/ locals in the block/method
+ |names|
+
+ 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|
+
+ 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:[
+ |names|
+
+ 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|
+
+ 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]
- ].
+ 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
- ]
- ]
- ].
+ 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)].
- ].
+ allTheBest := allDistances select:[:entry | entry value >= (bestAssoc value * 0.5)].
+ allTheBest size > 15 ifTrue:[
+ allTheBest := allDistances select:[:entry | entry value >= (bestAssoc value * 0.8)].
+ ].
].
start := node start.
stop := node stop.
best := self askUserForCompletion:('Variable for "%1"' bindWith:node name)
- for:codeView at: start
- from:(allTheBest collect:[:assoc | assoc key]).
+ for:codeView at: start
+ from:(allTheBest collect:[:assoc | assoc key]).
best isNil ifTrue:[^ self].
"/ self showInfo:best.
@@ -5425,14 +5425,14 @@
oldVar := (codeView textFromCharacterPosition:start to:stop) asString string withoutSeparators.
codeView
- undoableDo:[ codeView replaceFromCharacterPosition:start to:stop with:best ]
- info:'Completion'.
+ 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
+ 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"