--- a/extensions.st Wed Jul 06 14:29:17 2011 +0200
+++ b/extensions.st Wed Jul 06 14:41:30 2011 +0200
@@ -21,13 +21,24 @@
!Breakpoint methodsFor:'accessing'!
icon
+ "do not use abbreviations like bpnt or brp or similar;
+ when I do not know the exact name, I tend to search for implementors/senders
+ of '*break*' or '*disabled*'.
+ I will not find anything useful and have to single step if methods are named
+ cryptically."
- state == #enabled ifTrue:[^ToolbarIconLibrary brkp_obj].
- state == #disabled ifTrue:[^ToolbarIconLibrary brkpd_obj].
+ condition isNil ifTrue:[
+ state == #enabled ifTrue:[^ ToolbarIconLibrary breakpointRedEnabled16x16].
+ state == #disabled ifTrue:[^ ToolbarIconLibrary breakpointRedDisabled16x16].
+ ] ifFalse:[
+ state == #enabled ifTrue:[^ ToolbarIconLibrary breakpointBlueEnabled16x16].
+ state == #disabled ifTrue:[^ ToolbarIconLibrary breakpointBlueDisabled16x16].
+ ].
^nil
"Created: / 28-06-2011 / 08:29:12 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified (comment): / 06-07-2011 / 14:40:46 / cg"
! !
!ByteArray methodsFor:'inspecting'!
@@ -338,507 +349,6 @@
^ DictionaryInspectorView
! !
-!DoWhatIMeanSupport class methodsFor:'code completion-helpers'!
-
-askUserForCompletion:what for:codeView at:position from:allTheBest
- |list 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).
- ].
- ].
- 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>"
-! !
-
-!DoWhatIMeanSupport class methodsFor:'code completion-helpers'!
-
-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"
-! !
-
-!DoWhatIMeanSupport class methodsFor:'code completion-helpers'!
-
-codeCompletionForMessage:node inClass:cls codeView:codeView
- |selector srchClass implClass
- bestSelectors selector2 bestSelectors2 allBest best info numArgs
- newParts nSelParts oldLen newLen selectorParts
- findBest parentNode selectorInBest selector2InBest2
- parser selectorsSentInCode split|
-
- parser := Parser parseMethod:codeView contents string in:cls ignoreErrors:true ignoreWarnings:true.
- selectorsSentInCode := parser messagesSent.
-
- findBest := [:node :selector |
- |srchClass bestSelectors bestPrefixes|
-
- srchClass := self lookupClassForMessage:node inClass:cls.
-
- srchClass notNil ifTrue:[
- bestSelectors := Parser findBest:30 selectorsFor:selector in:srchClass forCompletion:true.
- ] ifFalse:[
- codeView topView withCursor:(Cursor questionMark) do:[
- 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:cls.
- 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
- ].
-
- "/ 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>"
-! !
-
-!DoWhatIMeanSupport class methodsFor:'code completion-helpers'!
-
-codeCompletionForMethod:node inClass:cls 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|
-
- cls 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>"
-! !
-
-!DoWhatIMeanSupport class methodsFor:'input completion support'!
-
-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>"
-! !
-
-!DoWhatIMeanSupport class methodsFor:'code completion-helpers'!
-
-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>"
-! !
-
!EditTextView methodsFor:'accessing-dimensions'!
absoluteXOfPosition:positionInText
@@ -1945,5 +1455,5 @@
!stx_libtool class methodsFor:'documentation'!
extensionsVersion_CVS
- ^ '$Header: /cvs/stx/stx/libtool/extensions.st,v 1.33 2011-07-05 12:08:04 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/extensions.st,v 1.34 2011-07-06 12:41:30 cg Exp $'
! !
\ No newline at end of file