# HG changeset patch # User Claus Gittinger # Date 1402837546 -7200 # Node ID 763bb2f56f2fc4b46bae3216d0788e81a05fe52b # Parent 268012bb76c1daa07a9962d48d8c468cb8dcecca class: Tools::BreakpointService added: #removeAllBreakpoints category of: #breakpointAtLine: #breakpoints #setOrToggleBreakpointAtLine: diff -r 268012bb76c1 -r 763bb2f56f2f Tools__BreakpointService.st --- a/Tools__BreakpointService.st Sun Jun 15 14:03:36 2014 +0200 +++ b/Tools__BreakpointService.st Sun Jun 15 15:05:46 2014 +0200 @@ -83,6 +83,151 @@ "Created: / 22-07-2013 / 14:01:17 / cg" ! ! +!BreakpointService methodsFor:'accessing'! + +breakpointAtLine:line + |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 " + "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 " +! + +removeAllBreakpoints + breakpoints := OrderedCollection new. +! + +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). + ]. + 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 ]. + ]. + 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 " + "Modified: / 28-08-2013 / 14:45:36 / cg" + "Modified: / 21-02-2014 / 17:36:11 / Jan Vrany " +! ! + !BreakpointService methodsFor:'change & update'! update: aspect with: param from: sender @@ -273,32 +418,6 @@ !BreakpointService methodsFor:'private'! -breakpointAtLine:line - |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 " - "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 " -! - fixupBreakpointPositions breakpoints notEmptyOrNil ifTrue:[ breakpoints do:[:each | @@ -430,119 +549,6 @@ "Created: / 05-07-2011 / 21:33:13 / cg" "Modified: / 22-07-2013 / 16:00:13 / cg" "Modified: / 08-05-2014 / 14:03:06 / Jan Vrany " -! - -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). - ]. - 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 ]. - ]. - 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 " - "Modified: / 28-08-2013 / 14:45:36 / cg" - "Modified: / 21-02-2014 / 17:36:11 / Jan Vrany " ! ! !BreakpointService methodsFor:'queries'! @@ -664,14 +670,14 @@ !BreakpointService class methodsFor:'documentation'! version - ^ '$Header: /cvs/stx/stx/libtool/Tools__BreakpointService.st,v 1.50 2014-06-05 13:56:42 vrany Exp $' + ^ '$Header: /cvs/stx/stx/libtool/Tools__BreakpointService.st,v 1.51 2014-06-15 13:05:46 cg Exp $' ! version_CVS - ^ '$Header: /cvs/stx/stx/libtool/Tools__BreakpointService.st,v 1.50 2014-06-05 13:56:42 vrany Exp $' + ^ '$Header: /cvs/stx/stx/libtool/Tools__BreakpointService.st,v 1.51 2014-06-15 13:05:46 cg Exp $' ! version_SVN - ^ '$Id: Tools__BreakpointService.st,v 1.50 2014-06-05 13:56:42 vrany Exp $' + ^ '$Id: Tools__BreakpointService.st,v 1.51 2014-06-15 13:05:46 cg Exp $' ! !