diff -r 699f6a043e51 -r 9a51a38177e4 DoWhatIMeanSupport.st --- a/DoWhatIMeanSupport.st Thu Mar 27 15:11:21 2014 +0100 +++ b/DoWhatIMeanSupport.st Tue Apr 01 13:23:06 2014 +0200 @@ -2742,7 +2742,7 @@ "/ Transcript show:'var in '; show:methodOrNil; show:' / '; showCR:classOrNil. classOrNil notNil ifTrue:[ - nonMetaClass := classOrNil theNonMetaclass. + nonMetaClass := classOrNil theNonMetaclass. ]. nm := node name. @@ -2753,92 +2753,92 @@ 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 selectors menu exitKey idx| - - methods := nodeVal class methodDictionary values - select:[:m | |cat| - cat := m category asLowercase. - cat = 'instance creation' - ]. - selectors := methods collect:[:each | each selector]. - editAction := - [:answer | - |s| - s := answer isInteger ifTrue:[selectors at:answer] ifFalse:[answer]. - codeView - undoableDo:[ - codeView insertString:s atCharacterPosition:crsrPos. - codeView cursorToCharacterPosition:crsrPos+s size. - ] - info:'completion'. - ]. - actionBlock - value:selectors - value:editAction - value:nil. - ^ self. - ]. - ]. + 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 selectors menu exitKey idx| + + methods := nodeVal class methodDictionary values + select:[:m | |cat| + cat := m category asLowercase. + cat = 'instance creation' + ]. + selectors := methods collect:[:each | each selector]. + editAction := + [:answer | + |s| + s := answer isInteger ifTrue:[selectors at:answer] ifFalse:[answer]. + codeView + undoableDo:[ + codeView insertString:s atCharacterPosition:crsrPos. + codeView cursorToCharacterPosition:crsrPos+s size. + ] + info:'completion'. + ]. + actionBlock + value:selectors + value:editAction + value:nil. + ^ self. + ]. + ]. ]. parent := node parent. (parent notNil and:[parent isMessage]) ifTrue:[ - node == parent receiver ifTrue:[ - selectorOfMessageToNode := parent selector - ] + 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) - ] - ]. + [: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 := - [:eachNames :factor | - (eachNames includes:nm) ifTrue:[nameIsOK := true]. - eachNames 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). - ] - ] - ] - ]. + [:eachNames :factor | + (eachNames includes:nm) ifTrue:[nameIsOK := true]. + eachNames 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. + globalFactor := 2. "/ favour globals + localFactor := 1. ] ifFalse:[ - globalFactor := 1. "/ favour locals - localFactor := 2. + globalFactor := 1. "/ favour locals + localFactor := 2. ]. variablesAlreadyAdded := Set new. @@ -2849,239 +2849,239 @@ (parent notNil and:[parent isMethod and:[parent arguments includes:node]]) ifTrue:[ - "/ yes - - "/ 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). - ]. - ]. - "/ look for the variable names of any other method in that class - otherArgNames := Set new. - classOrNil methodDictionary keysAndValuesDo:[:sel :mthd | - |parseTree| - parseTree := mthd parseTree. - (parseTree notNil and:[parseTree arguments size > 0]) - ifFalse:nil - ifTrue:[ otherArgNames addAll:(parseTree arguments collect:[:each | each name])] ]. - addWithFactorBlock value:otherArgNames value:(1.5 * localFactor). - ]. - addWithFactorBlock value:(codeView previousReplacements collect:[:p | p value asString]) value:(1.3 * localFactor). + "/ yes - + "/ 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). + ]. + ]. + "/ look for the variable names of any other method in that class + otherArgNames := Set new. + classOrNil methodDictionary keysAndValuesDo:[:sel :mthd | + |parseTree| + parseTree := mthd parseTree. + (parseTree notNil and:[parseTree arguments size > 0]) + ifFalse:nil + ifTrue:[ otherArgNames addAll:(parseTree arguments collect:[:each | each name])] ]. + addWithFactorBlock value:otherArgNames value:(1.5 * localFactor). + ]. + addWithFactorBlock value:(codeView previousReplacements collect:[:p | p value asString]) value:(1.3 * localFactor). ] ifFalse:[ - "/ locals in the block/method - |names| - - 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:[ - |responders nonResponders| - - "/ responding to that messsage + "/ locals in the block/method + |names| + + 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:[ + |responders nonResponders| + + "/ responding to that messsage "/ self halt. - classOrNil notNil ifTrue:[ - "/ private classes - addWithFactorBlock value:(nonMetaClass privateClasses collect:[:cls | cls nameWithoutPrefix]) - value:(2.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:(3.0 * 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:(2.75 * globalFactor). - addWithFactorBlock value:nonResponders value:(0.5 * 1 * globalFactor). - ]. - - "/ namespace vars - classOrNil topNameSpace ~~ 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:(2.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 reject:[:nm | nm startsWith:'Undeclared:::' ]. - - 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:(2.75 * globalFactor). - - "/ class variables - addWithFactorBlock value:nonMetaClass classVarNames value:(3.0 * globalFactor). - classOrNil superclass notNil ifTrue:[ - addWithFactorBlock value:nonMetaClass superclass allClassVarNames value:(2.5 * globalFactor). - ]. - - "/ namespace vars - classOrNil topNameSpace ~~ Smalltalk ifTrue:[ - names := classOrNil topNameSpace keys. - names := names reject:[:nm | nm includes:$:]. - names := names select:[:nm | nm isUppercaseFirst ]. - addWithFactorBlock value:names value:(2.5 * 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 ]. - names := names reject:[:nm | nm includes:$:]. - addWithFactorBlock value:names value:(2.5 * globalFactor). - ]. - - "/ pool variables - classOrNil theNonMetaclass sharedPoolNames do:[:poolName | - |pool names| - - pool := Smalltalk at:poolName. - pool isNil ifTrue:[ - Transcript showCR:'non existent pool: ',poolName - ] ifFalse:[ - names := pool classVarNames. - addWithFactorBlock value:names value:(2.5 * globalFactor). - ] - ]. - ]. - - "/ globals - names := Smalltalk keys. - names := names select:[:nm | nm isUppercaseFirst ]. - names := names reject:[:nm | nm startsWith:'Undeclared:::' ]. - names := names reject:[:nm | (nm includes:$:) and:[ (nm includesString:'::') not]]. - - "/ 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). + classOrNil notNil ifTrue:[ + "/ private classes + addWithFactorBlock value:(nonMetaClass privateClasses collect:[:cls | cls nameWithoutPrefix]) + value:(2.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:(3.0 * 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:(2.75 * globalFactor). + addWithFactorBlock value:nonResponders value:(0.5 * 1 * globalFactor). + ]. + + "/ namespace vars + classOrNil topNameSpace ~~ 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:(2.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 reject:[:nm | nm startsWith:'Undeclared:::' ]. + + 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:(2.75 * globalFactor). + + "/ class variables + addWithFactorBlock value:nonMetaClass classVarNames value:(3.0 * globalFactor). + nonMetaClass superclass notNil ifTrue:[ + addWithFactorBlock value:nonMetaClass superclass allClassVarNames value:(2.5 * globalFactor). + ]. + + "/ namespace vars + classOrNil topNameSpace ~~ Smalltalk ifTrue:[ + names := classOrNil topNameSpace keys. + names := names reject:[:nm | nm includes:$:]. + names := names select:[:nm | nm isUppercaseFirst ]. + addWithFactorBlock value:names value:(2.5 * 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 ]. + names := names reject:[:nm | nm includes:$:]. + addWithFactorBlock value:names value:(2.5 * globalFactor). + ]. + + "/ pool variables + classOrNil theNonMetaclass sharedPoolNames do:[:poolName | + |pool names| + + pool := Smalltalk at:poolName. + pool isNil ifTrue:[ + Transcript showCR:'non existent pool: ',poolName + ] ifFalse:[ + names := pool classVarNames. + addWithFactorBlock value:names value:(2.5 * globalFactor). + ] + ]. + ]. + + "/ globals + names := Smalltalk keys. + names := names select:[:nm | nm isUppercaseFirst ]. + names := names reject:[:nm | nm startsWith:'Undeclared:::' ]. + names := names reject:[:nm | (nm includes:$:) and:[ (nm includesString:'::') not]]. + + "/ 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]. @@ -3099,48 +3099,48 @@ 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. 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. - ]. + "/ 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 or are a prefix - 0.4 to:0.9 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) ]]. - ] - ]. - allTheBest size > 15 ifTrue:[ - "/ remove all those which are below some threshold - 0.4 to:0.9 by:0.1 do:[:delta | - "/ if still too many, remove more and more - allTheBest size > 15 ifTrue:[ - allTheBest := allDistances select:[:entry | entry value >= (bestAssoc value * delta) ]. - ] - ]. - ]. + "/ remove all those which are below some threshold or are a prefix + 0.4 to:0.9 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) ]]. + ] + ]. + allTheBest size > 15 ifTrue:[ + "/ remove all those which are below some threshold + 0.4 to:0.9 by:0.1 do:[:delta | + "/ if still too many, remove more and more + allTheBest size > 15 ifTrue:[ + allTheBest := allDistances select:[:entry | entry value >= (bestAssoc value * delta) ]. + ] + ]. + ]. ]. suggestions := allTheBest collect:[:assoc | assoc key]. @@ -3148,48 +3148,48 @@ "/ 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]). + , + (suggestions reject:[:s | s startsWith:nm]). "/ if super is among them, add a full call to the completions (suggestions includes:'super') ifTrue:[ - (tree notNil - and:[ tree isMethod ]) ifTrue:[ - Error handle:[:ex | - Transcript showCR:'parse error in code completion ignored'. - ] do:[ - suggestions addFirst:('super ',(Parser methodSpecificationForSelector:tree selector argNames:(tree argumentNames)),'.'). - ] - ]. + (tree notNil + and:[ tree isMethod ]) ifTrue:[ + Error handle:[:ex | + Transcript showCR:'parse error in code completion ignored'. + ] do:[ + suggestions addFirst:('super ',(Parser methodSpecificationForSelector:tree selector argNames:(tree argumentNames)),'.'). + ] + ]. ]. 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'. - - ]. + [: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. @@ -4636,10 +4636,10 @@ !DoWhatIMeanSupport class methodsFor:'documentation'! version - ^ '$Header: /cvs/stx/stx/libwidg2/DoWhatIMeanSupport.st,v 1.206 2014-03-06 15:00:10 cg Exp $' + ^ '$Header: /cvs/stx/stx/libwidg2/DoWhatIMeanSupport.st,v 1.207 2014-04-01 11:23:06 cg Exp $' ! version_CVS - ^ '$Header: /cvs/stx/stx/libwidg2/DoWhatIMeanSupport.st,v 1.206 2014-03-06 15:00:10 cg Exp $' + ^ '$Header: /cvs/stx/stx/libwidg2/DoWhatIMeanSupport.st,v 1.207 2014-04-01 11:23:06 cg Exp $' ! !