--- a/Tools__BreakpointService.st Sun Jan 12 23:30:25 2014 +0000
+++ b/Tools__BreakpointService.st Wed Apr 01 10:38:01 2015 +0100
@@ -85,8 +85,151 @@
!BreakpointService methodsFor:'accessing'!
+breakpointAtLine:line
+ "return the breakpoint at line (may be disabled) or nil, if there is none"
+
+ |pos|
+
+ breakpoints isNil ifTrue:[^ nil].
+
+ pos := textView characterPositionOfLine:line col:1.
+ ^ breakpoints
+ detect:[:each | each position = pos ]
+ ifNone:[
+ breakpoints
+ detect:[:each | each line == line and:[each position isNil ]]
+ ifNone:[ nil ]
+ ]
+
+ "Modified: / 17-06-2011 / 13:59:17 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified (format): / 05-07-2011 / 21:33:23 / cg"
+!
+
breakpoints
+ "/ Fixup breakpoint positions
+ self fixupBreakpointPositions.
^ breakpoints
+
+ "Modified: / 08-05-2014 / 14:02:25 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+removeAllBreakpoints
+ breakpoints := OrderedCollection new.
+ gutterView invalidate.
+!
+
+setOrToggleBreakpointAtLine:line
+ |pos bpnt prepareFullBreakSupport mClass ok|
+
+ "/ if true, setting a single breakpoint in a method will create
+ "/ a whole set of invisible (and disabled) breakpoints in that method,
+ "/ one for each line.
+ "/ These can later be enabled in the debugger
+ "/ (otherwise, the debugger's behavior is stupid, as it cannot recompile a method
+ "/ to set additional breakpoints).
+ "/ We accept the additional overhead, as we are in debug mode anyway.
+ "/ prepareFullBreakSupport := false.
+ prepareFullBreakSupport := true.
+
+ codeView method isNil ifTrue:[
+ ^ self
+ ].
+
+ textView reallyModified ifTrue:[
+ "/ leads to ugly behavior (method no longer found), if we allow
+ "/ this...
+ Dialog warn:'Please accept first (cannot set breakpoint while text is modified)'.
+ ^ self
+ ].
+
+ bpnt := self breakpointAtLine:line.
+ bpnt isNil ifTrue:[
+ "/ no breakpoint there - create a new one as required (i.e. recompile)
+ ok := (self canCreateOrToggleBreakpointAtLine:line).
+ ok ifFalse:[
+ (currentMethod isMethodWithBreakpoints and:[ prepareFullBreakSupport ]) ifFalse:[
+ codeView topView class == DebugView ifTrue:[
+ (Dialog
+ confirm:'Sorry, in an active method, I can only add new breakpoints in an already breakpointed method.
+(i.e. a method stopped at a method breakpoint or one which already has statement breakpoints)
+The reason is that the method needs to be recompiled for the breakpoint, which would not affect the method being currently executed.
+
+You can proceed to set the breakpoint, but it will only affect the next call into this method, not the current invocation.'
+ yesLabel:'Set Breakpoint for Next Call' noLabel:'Ok') ifTrue:[
+"/ self halt.
+ ok := true.
+ ]
+ ] ifFalse:[
+ Dialog warn:'Sorry, cannot add a new breakpoint here.'.
+ ].
+ ]
+ ].
+ ok ifTrue:[
+ prepareFullBreakSupport ifTrue:[
+ "/ add a (disabled) breakpoint for every source line. This
+ "/ allows for breakpoints to be enabled/disabled in the debugger...
+ 1 to:textView numberOfLines do:[:eachLine |
+ |oldBPnt eachPos otherBpnt|
+
+ oldBPnt := self breakpointAtLine:eachLine.
+ oldBPnt isNil ifTrue:[
+ eachPos := textView characterPositionOfLine:eachLine col:1.
+ breakpoints isNil ifTrue:[ breakpoints := OrderedCollection new].
+ breakpoints add:((otherBpnt := Breakpoint new method:codeView method) position:eachPos line:eachLine).
+ eachLine == line ifTrue:[
+ bpnt := otherBpnt.
+ ] ifFalse:[
+ otherBpnt beInvisible.
+ ]
+ ].
+ ].
+ ] ifFalse:[
+ pos := textView characterPositionOfLine:line col:1.
+ breakpoints add:((bpnt := Breakpoint new method:codeView method) position:pos line:line).
+ ].
+ Screen current shiftDown ifTrue:[
+ "/ trace
+ bpnt beTracepoint
+ ].
+ self assert: breakpoints notEmptyOrNil.
+
+ "/ recompile the method with breakpoints
+ self recompile.
+ ]
+ ] ifFalse:[
+ "/ breakpoint already there - just enable/disable
+ Screen current shiftDown ifTrue:[
+ bpnt toggleTracing
+ ] ifFalse:[
+ bpnt toggle.
+ ].
+ (mClass := currentMethod mclass) isNil ifTrue:[
+ "/ hack: ouch - was wrapped in the meantime;
+ "/ hurry up and update. Should be done elsewhere (in codeView)
+ self updateCurrentMethod.
+ currentMethod notNil ifTrue:[ mClass := currentMethod mclass ].
+ ].
+ bpnt method:currentMethod.
+ mClass notNil ifTrue:[
+ Smalltalk changed:#methodTrap with:(MethodTrapChangeNotificationParameter changeClass:mClass changeSelector:currentMethod selector).
+ ].
+ ].
+
+ (bpnt notNil and:[bpnt isReached not]) ifTrue:[
+ | app |
+
+ app := codeView application.
+ (app respondsTo: #showInfo:) ifTrue:[
+ app showInfo: 'Cannot set breakpoint here, try another line...'.
+ ].
+ "/ codeView flash.
+ ] ifFalse:[
+ gutterView redrawLine:line.
+ ].
+
+ "Created: / 17-06-2011 / 13:45:22 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 28-08-2013 / 14:45:36 / cg"
+ "Modified: / 21-02-2014 / 17:36:11 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!BreakpointService methodsFor:'change & update'!
@@ -115,23 +258,30 @@
"/ Transcript show:'update breakpoints for method: '; showCR:aMethod.
aMethod notNil ifTrue:[
- aMethod literalsDo:[:eachLiteral |
- (eachLiteral isKindOf:Breakpoint) ifTrue:[
- methodsBreakPoints isNil ifTrue:[
- methodsBreakPoints := OrderedCollection new.
- ].
- methodsBreakPoints add:eachLiteral copy.
+ aMethod breakpointsDo:[:eachLiteral |
+ methodsBreakPoints isNil ifTrue:[
+ methodsBreakPoints := OrderedCollection new.
].
+ methodsBreakPoints add:eachLiteral copy.
].
currentMethodClass := aMethod mclass.
] ifFalse:[
currentMethodClass := nil
].
breakpoints := methodsBreakPoints.
+ breakpoints notNil ifTrue:[
+ "/ Nil out breakpoint's position. It's invalid as soon as
+ "/ user edits the code. Instead, depend on line information.
+ "/ Breakpoint character positions are fixed up just before
+ "/ passing a breakpoints to the compiler, see
+ "/ #fixupBreakpointPositions
+ breakpoints do:[:each | each position: nil ].
+ ].
currentMethod := aMethod.
"Created: / 06-07-2011 / 15:24:09 / cg"
"Modified: / 06-07-2011 / 17:32:54 / jv"
+ "Modified: / 23-02-2015 / 14:48:03 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
updateCurrentMethod
@@ -143,9 +293,9 @@
(method notNil and:[method mclass isNil]) ifTrue:[
"/ hack: ouch - was wrapped in the meantime;
"/ hurry up and update. Should be done elsewhere (in codeView)
- realMethod := MethodWithBreakpoints allInstances detect:[:m | m originalMethod == method and:[m mclass notNil]] ifNone:nil.
+ realMethod := MethodWithBreakpoints allBreakpointedMethods detect:[:m | m originalMethod == method and:[m mclass notNil]] ifNone:nil.
realMethod isNil ifTrue:[
- realMethod := WrappedMethod allInstances detect:[:m | m originalMethod == method and:[m mclass notNil]] ifNone:nil.
+ realMethod := WrappedMethod allWrappedMethods detect:[:m | m originalMethod == method and:[m mclass notNil]] ifNone:nil.
].
].
realMethod ~~ currentMethod ifTrue:[
@@ -162,7 +312,7 @@
!BreakpointService methodsFor:'event handling'!
-buttonPress:button x:x y:y in:view
+buttonMultiPress:button x:x y:y in:view
|lineNr|
view == gutterView ifTrue:[
@@ -182,17 +332,75 @@
"Modified: / 19-09-2011 / 14:41:00 / cg"
!
+buttonPress:button x:x y:y in:view
+ |lineNr|
+
+ "now disabled: need a double click (like in other editors);
+ also this allows toggling breakpoints even if there are ther service-annotations"
+
+ view == gutterView ifTrue:[
+ button == 1 ifTrue:[
+ lineNr := textView yVisibleToLineNr:y.
+ FlyByHelp currentHelpListener notNil ifTrue:[
+ "/ show a message that a double click is now needed
+ FlyByHelp currentHelpListener initiateHelpFor:view at:x@y now:true
+ ].
+"/ lineNr notNil ifTrue:[ self setOrToggleBreakpointAtLine:lineNr ].
+ ^ false.
+ ].
+"/ button == 3 ifTrue:[
+"/ ^ true.
+"/ ]
+ ].
+ ^ false
+
+ "Created: / 17-06-2011 / 13:05:22 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 19-09-2011 / 14:41:00 / cg"
+ "Modified: / 03-12-2014 / 10:22:52 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+keyPress:key x:x y:y in: view
+ "Handles an event in given view (a subview of codeView).
+ If the method returns true, it has eaten the event and it will not be processed
+ by the view."
+
+ key == #Accept ifTrue:[
+ textView undoableDo:[
+ BreakpointQuery answer: self breakpoints do:[
+ textView accept.
+ ].
+ ].
+ ^ true
+ ].
+ ^ false
+
+ "Created: / 08-05-2014 / 10:42:56 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 08-05-2014 / 13:52:38 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
linesDeletedFrom: start to: end
+ | breakpointsToRemove |
breakpoints isEmptyOrNil ifTrue:[^self].
- self moveBreakpointsAfterLine: start - 1 by: (end - start + 1) negated
+
+ breakpointsToRemove := Set new.
+ start to: end do:[:line |
+ | breakpointToRemove |
+
+ breakpointToRemove := self breakpointAtLine: line.
+ breakpointToRemove notNil ifTrue:[ breakpointsToRemove add: breakpointToRemove ].
+ ].
+ breakpoints removeAll: breakpointsToRemove.
+ self moveBreakpointsAfterLine: end by: (end - start + 1) negated
"Created: / 06-07-2011 / 17:16:27 / jv"
+ "Modified: / 04-06-2014 / 17:56:56 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
linesInsertedFrom: start to: end
breakpoints isEmptyOrNil ifTrue:[^self].
+
self moveBreakpointsAfterLine: start - 1 by: (end - start + 1)
"Created: / 06-07-2011 / 17:16:36 / jv"
@@ -200,7 +408,7 @@
!BreakpointService methodsFor:'help'!
-flyByHelpText
+flyByHelpTextAtLine:ignoredLineNr
|topView|
(self canCreateOrToggleBreakpointAtLine:nil) ifFalse:[
@@ -213,7 +421,7 @@
^ 'Cannot add breakpoint when modified. Please accept first.'
].
- ^ 'Click to toggle breakpoint. Shift-Click to toggle tracepoint.'
+ ^ 'Double Click to toggle breakpoint. Shift-Double-Click to toggle tracepoint.'
"Created: / 27-01-2012 / 14:04:52 / cg"
! !
@@ -241,39 +449,35 @@
!BreakpointService methodsFor:'private'!
-breakpointAtLine:line
- |pos|
-
- breakpoints isNil ifTrue:[^ nil].
+fixupBreakpointPositions
+ breakpoints notEmptyOrNil ifTrue:[
+ breakpoints do:[:each |
+ | pos |
- pos := textView characterPositionOfLine:line col:1.
- ^ breakpoints
- detect:[:each | each position = pos ]
- ifNone:[
- breakpoints
- detect:[:each | each line == line and:[each position isNil ]]
- ifNone:[ nil ]
- ]
+ pos := textView characterPositionOfLine: each line col:1.
+ each position: pos.
+ ].
+ breakpoints := breakpoints select:[:b |b line >= 0].
+ ].
- "Modified: / 17-06-2011 / 13:59:17 / Jan Vrany <jan.vrany@fit.cvut.cz>"
- "Modified (format): / 05-07-2011 / 21:33:23 / cg"
+ "Created: / 08-05-2014 / 14:02:25 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
moveBreakpointsAfterLine:line by: delta
- |pos |
-
breakpoints do:[:bpnt|
bpnt line >= line ifTrue:[
- pos := textView characterPositionOfLine:bpnt line + delta col:1.
- bpnt position:pos line:(bpnt line + delta).
+ "/ Note that position will be fixed up in BreakpointService>>breakpoints
+ bpnt position:nil line:(bpnt line + delta).
]
].
+ breakpoints := breakpoints reject:[:bpnt | bpnt line <= 0].
"/gutterView redrawLinesFrom: line.
"Created: / 17-06-2011 / 13:45:22 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Created: / 06-07-2011 / 17:26:30 / jv"
"Modified: / 02-08-2012 / 09:27:10 / cg"
+ "Modified: / 08-05-2014 / 14:01:17 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
recompile
@@ -290,6 +494,7 @@
^self.
] ifFalse:[
"/ prepare to get reachable bpts
+ self fixupBreakpointPositions.
breakpoints do:[:bp | bp isReached:false].
class := oldMethod mclass.
@@ -350,13 +555,8 @@
].
].
- breakpoints := breakpoints
- select:[:bp |
-"/ bp isReached ifFalse:[
-"/ "/ Transcript show:'remove unreached:'; showCR:bp
-"/ ].
- bp isReached
- ].
+ breakpoints := breakpoints species new.
+ newMethod breakpointsDo:[ :each | breakpoints add: each ].
"/ must update breakpoints BEFORE the following, because it leads to a change
"/ notification, which may clear the breakpoints collection!!
@@ -373,111 +573,8 @@
]
"Created: / 05-07-2011 / 21:33:13 / cg"
- "Modified: / 18-07-2012 / 10:53:22 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 22-07-2013 / 16:00:13 / cg"
-!
-
-setOrToggleBreakpointAtLine:line
- |pos bpnt prepareFullBreakSupport mClass ok|
-
- "/ if true, setting a single breakpoint in a method will create
- "/ a whole set of invisible (and disabled) breakpoints in that method,
- "/ one for each line.
- "/ These can later be enabled in the debugger
- "/ (otherwise, the debugger's behavior is stupid, as it cannot recompile a method
- "/ to set additional breakpoints).
- "/ We accept the additional overhead, as we are in debug mode anyway.
- "/ prepareFullBreakSupport := false.
- prepareFullBreakSupport := true.
-
- codeView method isNil ifTrue:[
- ^ self
- ].
-
- textView reallyModified ifTrue:[
- "/ leads to ugly behavior (method no longer found), if we allow
- "/ this...
- Dialog warn:'Please accept first (cannot set breakpoint while text is modified)'.
- ^ self
- ].
-
- bpnt := self breakpointAtLine:line.
- bpnt isNil ifTrue:[
- "/ no breakpoint there - create a new one as required (i.e. recompile)
- ok := (self canCreateOrToggleBreakpointAtLine:line).
- ok ifFalse:[
- (currentMethod isMethodWithBreakpoints and:[ prepareFullBreakSupport ]) ifFalse:[
- codeView topView class == DebugView ifTrue:[
- (Dialog
- confirm:'Sorry, in an active method, I can only add new breakpoints in an already breakpointed method.
-(i.e. a method stopped at a method breakpoint or one which already has statement breakpoints)
-The reason is that the method needs to be recompiled for the breakpoint, which would not affect the method being currently executed.
-
-You can proceed to set the breakpoint, but it will only affect the next call into this method, not the current invocation.'
- yesLabel:'Set Breakpoint for Next Call' noLabel:'Ok') ifTrue:[
-self halt.
- ok := true.
- ]
- ] ifFalse:[
- Dialog warn:'Sorry, cannot add a new breakpoint here.'.
- ].
- ]
- ].
- ok ifTrue:[
- prepareFullBreakSupport ifTrue:[
- "/ add a (disabled) breakpoint for every source line. This
- "/ allows for breakpoints to be enabled/disabled in the debugger...
- 1 to:textView numberOfLines do:[:eachLine |
- |oldBPnt eachPos otherBpnt|
-
- oldBPnt := self breakpointAtLine:eachLine.
- oldBPnt isNil ifTrue:[
- eachPos := textView characterPositionOfLine:eachLine col:1.
- breakpoints isNil ifTrue:[ breakpoints := OrderedCollection new].
- breakpoints add:((otherBpnt := Breakpoint new) position:eachPos line:eachLine).
- eachLine == line ifTrue:[
- bpnt := otherBpnt.
- ] ifFalse:[
- otherBpnt beInvisible.
- ]
- ].
- ].
- ] ifFalse:[
- pos := textView characterPositionOfLine:line col:1.
- breakpoints add:((bpnt := Breakpoint new) position:pos line:line).
- ].
- Display shiftDown ifTrue:[
- "/ trace
- bpnt beTracepoint
- ].
- self assert: breakpoints notEmptyOrNil.
-
- "/ recompile the method with breakpoints
- self recompile.
- ]
- ] ifFalse:[
- "/ breakpoint already there - just enable/disable
- Display shiftDown ifTrue:[
- bpnt toggleTracing
- ] ifFalse:[
- bpnt toggle.
- ].
- (mClass := currentMethod mclass) isNil ifTrue:[
- "/ hack: ouch - was wrapped in the meantime;
- "/ hurry up and update. Should be done elsewhere (in codeView)
- self updateCurrentMethod.
- currentMethod notNil ifTrue:[ mClass := currentMethod mclass ].
- ].
- mClass notNil ifTrue:[
- Smalltalk changed:#methodTrap with:(MethodTrapChangeNotificationParameter changeClass:mClass changeSelector:currentMethod selector).
- ].
- ].
-
- gutterView redrawLine:line.
-
- "Created: / 17-06-2011 / 13:45:22 / Jan Vrany <jan.vrany@fit.cvut.cz>"
- "Modified: / 27-07-2011 / 13:27:55 / Jan Vrany <jan.vrany@fit.cvut.cz>"
- "Modified: / 28-08-2013 / 14:45:36 / cg"
+ "Modified: / 23-02-2015 / 14:49:04 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!BreakpointService methodsFor:'queries'!
@@ -599,14 +696,14 @@
!BreakpointService class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libtool/Tools__BreakpointService.st,v 1.42 2013-10-10 11:07:51 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/Tools__BreakpointService.st,v 1.60 2015-02-24 08:25:36 vrany Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libtool/Tools__BreakpointService.st,v 1.42 2013-10-10 11:07:51 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/Tools__BreakpointService.st,v 1.60 2015-02-24 08:25:36 vrany Exp $'
!
version_SVN
- ^ '$Id: Tools__BreakpointService.st,v 1.42 2013-10-10 11:07:51 cg Exp $'
+ ^ '$Id: Tools__BreakpointService.st,v 1.60 2015-02-24 08:25:36 vrany Exp $'
! !