changed:
#codeCompletionForMessage:inClass:codeView:
#lookupClassForMessage:inClass:
"
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:''
classVariableNames:'LastSource LastParseTree 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
"
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 codeView:codeView
self codeCompletionForClass:classOrNil context:nil codeView:codeView
"Modified (format): / 03-07-2011 / 15:49:49 / cg"
!
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"
|crsrPos char interval source node checkedNode|
"/ 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 := codeView selectedInterval.
interval isEmpty ifTrue:[
interval := crsrPos-1 to:crsrPos.
].
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.
node := self findNodeForInterval:interval in:source allowErrors:true.
"/ [node isNil] whileTrue:[
"/ "/ expand to the left ...
"/ interval start > 1 ifFalse:[
"/ self information:'No parseNode found'.
"/ ^ self.
"/ ].
"/ interval start:(interval start - 1).
"/ node := self findNodeForInterval:interval in:source allowErrors:true.
"/ ].
node isNil ifTrue:[
Transcript showCR:'No parseNode found'.
self breakPoint:#cg.
self information:'No parseNode found'.
^ self.
].
(node isVariable
and:[ node parent notNil
and:[ node parent isMessage
and:[ node stop < (codeView characterPositionOfCursor-1) ]]]) ifTrue:[
node := node parent.
].
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.
].
].
checkedNode := node.
[checkedNode notNil] whileTrue:[
checkedNode isMessage ifTrue:[
"/ completion in a message-send
self codeCompletionForMessage:checkedNode inClass:classOrNil codeView:codeView.
^ self
].
checkedNode isMethod ifTrue:[
"/ completion in a method's selector pattern
self codeCompletionForMethod:checkedNode inClass:classOrNil codeView:codeView.
^ self.
].
checkedNode := checkedNode parent.
].
self information:'Node is neither variable nor message.'.
"Modified: / 04-07-2006 / 18:48:26 / fm"
"Modified: / 06-07-2011 / 13:56:39 / cg"
! !
!DoWhatIMeanSupport class 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. nil } , (list copyWithout:lastChoice).
].
].
choice := Tools::CodeCompletionMenu
openFor:codeView
at:position
with:allTheBest.
LastChoices isNil ifTrue:[
LastChoices := Dictionary new.
].
LastChoices at:what put:choice.
^ choice
"Created: / 16-02-2010 / 10:09:57 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified (format): / 08-07-2011 / 08:49: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"
!
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 codeView:codeView
|selector srchClass implClass
bestSelectors selector2 bestSelectors2 allBest best info numArgs
newParts nSelParts oldLen newLen selectorParts
findBest parentNode selectorInBest selector2InBest2
parser selectorsSentInCode split|
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 lookupClassForMessage:node inClass:classOrNil.
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.
"/ if its a unary message AND the parent is a keyword node, look for parent completion too.
(node selector isUnarySelector
and:[ parentNode notNil
and:[ parentNode isMessage
and:[ (selector2 := parentNode selector) isKeywordSelector ]]]) ifTrue:[
"/ srchClass2 := self lookupClassForMessage:parentNode inClass:classOrNil.
selector2 := selector2,selector.
bestSelectors2 := findBest value:parentNode value:selector2.
].
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
].
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:[
best := Dialog request:'Matching selectors:' initialAnswer:best list:allBest.
]."
best := self askUserForCompletion:'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 isNil ifTrue:[
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 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 isNil ifTrue:[
newCursorPosition := stop + (newLen-oldLen).
].
].
codeView cursorToCharacterPosition:newCursorPosition.
codeView cursorRight. "/ avoid going to the next line !!
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: / 17-07-2011 / 10:32:05 / cg"
!
codeCompletionForMethod:node inClass:classOrNil codeView:codeView
"completion in a methods selector pattern"
|crsrPos
selectorSoFar matchingSelectors
selectors distances best rest
allExistingMethods namesOfArguments
nameBag namesByCount|
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:[
matchingSelectors := Smalltalk allClasses
inject:(Set new)
into:[:theSet :eachClass |
|md|
(classOrNil notNil and:[classOrNil isMeta]) ifTrue:[
md := eachClass theMetaclass methodDictionary
] ifFalse:[
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:[
allExistingMethods := (Smalltalk allImplementorsOf:selectorSoFar asSymbol)
collect:[:cls | cls compiledMethodAt:selectorSoFar asSymbol].
namesOfArguments := allExistingMethods collect:[:eachMethod | eachMethod methodArgNames].
nameBag := Bag new.
namesOfArguments do:[:eachNameVector | nameBag add:(eachNameVector at:argNr)].
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:[
distances := selectors collect:[:each | each spellAgainst:selectorSoFar].
distances sortWith:selectors.
selectors reverse.
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
to:crsrPos
with:rest
]
info:'Completion'.
codeView cursorToCharacterPosition:(crsrPos + 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: / 06-07-2011 / 14:17:07 / cg"
!
codeCompletionForVariable:node inClass:classOrNil codeView:codeView
|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.
].
].
(node parent notNil and:[node parent isMessage]) ifTrue:[
node == node parent receiver ifTrue:[
selectorOfMessageToNode := node 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 methods selector spec ?
(node parent notNil
and:[node parent isMethod
and:[node 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:(node parent selector)
in:(Smalltalk allClasses)
ignoreCase:false.
"/ which argument is it
argIdx := node 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]) asSet.
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
node parent selector isKeyword ifTrue:[
kwPart := node parent selector keywords at:argIdx.
(classOrNil allInstVarNames includes:(kwPart copyWithoutLast: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).
] 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:(1.5 * globalFactor).
classOrNil superclass notNil ifTrue:[
addWithFactorBlock value:nonMetaClass superclass allClassVarNames value:(1 * 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 sharedPools do:[:poolName |
|pool names|
pool := Smalltalk at:poolName.
names := pool classVarNames.
addWithFactorBlock value:names value:(1.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).
].
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 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: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: / 05-07-2011 / 10:09:52 / 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
|tree "errCount" firstIntersectingNode onErrorBlock nodeGenerationHook|
interval isEmpty ifTrue: [^ nil].
RBParser isNil ifTrue: [^ nil].
source = LastSource ifTrue:[
tree := LastParseTree.
] ifFalse:[
onErrorBlock :=
[:str :err :nodesSoFar |
|nodes|
allowErrors ifTrue:[
firstIntersectingNode notNil ifTrue:[^ firstIntersectingNode].
nodes := nodesSoFar asOrderedCollection
collect:[:nd | nd whichNodeIntersects:interval]
thenSelect:[:nd | nd notNil ].
nodes size == 1 ifTrue:[
^ nodes first
].
].
nil
].
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 intepretation (especially: scope of variable) will be.
"/ therefore, we parse all, and return the found node at the end.
"//// ^ node.
firstIntersectingNode isNil ifTrue:[
(node intersectsInterval:interval) ifTrue:[
firstIntersectingNode := node
].
].
].
tree := RBParser
parseMethod:source
onError: onErrorBlock
rememberNodes:true
nodeGenerationCallback:nodeGenerationHook.
"/ onError: [:str :err | errCount := (errCount?0) + 1. self halt.]
"/ proceedAfterError:true.
(tree isNil or:[firstIntersectingNode isNil]) ifTrue:[
"/ try as an expression
tree := RBParser
parseExpression:source
onError: onErrorBlock
rememberNodes:true
nodeGenerationCallback:nodeGenerationHook.
].
tree notNil ifTrue:[
LastSource := source.
LastParseTree := tree.
].
^ firstIntersectingNode
].
^ self findNodeForInterval:interval inParseTree:tree.
"Modified: / 06-07-2011 / 13:56:06 / 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"
!
lookupClassForMessage:node inClass:classProvidingNamespaceOrNil
|receiver nm nodeVal receiverClass|
receiver := node receiver.
receiver isLiteral ifTrue:[
^ receiver value class
].
receiver isVariable ifTrue:[
nm := receiver name.
nm = 'self' ifTrue:[
classProvidingNamespaceOrNil isNil ifTrue:[^ UndefinedObject].
^ classProvidingNamespaceOrNil
].
nm = 'super' ifTrue:[
classProvidingNamespaceOrNil isNil ifTrue:[^ Object].
^ classProvidingNamespaceOrNil superclass
].
nm isUppercaseFirst ifTrue:[
"/ wouldn't it be better to simply 'evaluate' the variable ?
Error handle:[:ex |
] do:[
|dummyReceiver|
dummyReceiver := classProvidingNamespaceOrNil notNil ifTrue:[classProvidingNamespaceOrNil basicNew] ifFalse:[nil].
nodeVal := Parser new evaluate:nm in:nil receiver:dummyReceiver.
].
"/ (Smalltalk includesKey:nm asSymbol) ifTrue:[
"/ nodeVal := Smalltalk at:nm asSymbol.
"/ ].
nodeVal notNil ifTrue:[
^ nodeVal class
]
]
].
receiver isMessage ifTrue:[
(receiver selector = 'new'
or:[ receiver selector = 'new:' ]) ifTrue:[
receiverClass := self lookupClassForMessage:receiver inClass:classProvidingNamespaceOrNil.
receiverClass notNil ifTrue:[
receiverClass isBehavior ifTrue:[
receiverClass isMeta ifTrue:[
^ receiverClass theNonMetaclass
]
]
].
].
classProvidingNamespaceOrNil notNil ifTrue:[
(receiver receiver isSelf and:[receiver selector = 'class']) ifTrue:[
^ classProvidingNamespaceOrNil class
].
].
].
^ nil
"Modified: / 24-08-2010 / 15:05:49 / sr"
"Modified: / 17-07-2011 / 10:28:19 / 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:[
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: / 16-02-2010 / 09:38:41 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
treeForCode:source allowErrors:allowErrors
|tree|
source = LastSource ifTrue:[
tree := LastParseTree.
] ifFalse:[
tree := RBParser
parseMethod:source
onError: [:str :err :nodesSoFar :parser|
allowErrors ifTrue:[
^ parser currentMethodNode
].
^ nil
]
proceedAfterError:false
rememberNodes:true.
tree notNil ifTrue:[
LastSource := source.
LastParseTree := tree.
]
].
^ tree
"Modified: / 27-04-2010 / 17:57:37 / cg"
! !
!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 copyFrom:'Smalltalk::' size + 1
] 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|
"/ (className startsWith:'JavaScript') ifTrue:[self halt].
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 ignoreCase:true
] 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 longestCommonPrefixIgnoreCase:true ].
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
"
Smalltalk classnameCompletion:'Arr'
Smalltalk classnameCompletion:'Arra'
Smalltalk classnameCompletion:'arra'
Smalltalk classnameCompletion:'*rray'
"
"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 ignoreCase:true
] 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 := IdentitySet new.
"/ search for exact match
anEnvironment allClassesDo:[:aClass |
|package|
package := aClass package.
(package notNil and:[package startsWith:aPartialPackage]) ifTrue:[
matches add:package
]
].
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"
!
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 ignoreCase:ignoreCase) ]
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 ignoreCase:true) ]
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 ignoreCase:ignoreCase) ]
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 ignoreCase:true) ]
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|
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 copyWithoutLast: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)) copyWithoutLast:(right size).
inserted size > 0 ifTrue:[
(oldName startsWith:prefix) ifTrue:[
^ (oldName copyTo:prefix size) , inserted , (oldName copyFrom:prefix size + 1)
].
].
].
(oldName string endsWith:suffix string) ifTrue:[
deleted := (lastOldName string copyFrom:(prefix size + 1)) copyWithoutLast:(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 copyWithoutLast:(lastOldName copyFrom:prefix size+1) size.
right := lastNewName copyFrom:prefix size+1.
^ left , right
]
].
^ 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'
"
!
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 copyWithoutLast: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 copyWithoutLast:suffix size.
lastInserted := lastNewWOSuffix copyWithoutLast: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 (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::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_CVS
^ '$Header: /cvs/stx/stx/libwidg2/DoWhatIMeanSupport.st,v 1.84 2011-07-17 09:13:33 cg Exp $'
! !