Tools__BreakpointService.st
changeset 12902 724e09dfd9a2
parent 12855 ab87c94ed5ac
child 12906 58e97bbbf5a4
--- a/Tools__BreakpointService.st	Fri Jun 14 13:56:55 2013 +0200
+++ b/Tools__BreakpointService.st	Fri Jun 14 14:22:25 2013 +0200
@@ -224,7 +224,6 @@
                             silent:true
                             foldConstants:true
                             ifFail:[ Transcript showCR:'BreakpointService: failed to recompile for breakpoint' ].
-                newMethod originalMethod: oldMethod.
 
                 selector isNil ifTrue:[
                     "/ May happen as the selector is not stored in the method but
@@ -234,12 +233,21 @@
                     selector := compiler selector.
                 ].
 
-                (class primAddSelector: selector withMethod:newMethod) ifFalse:[
-                    oldMethod mclass:class.
-                    self breakPoint: #cg.
-                    self breakPoint: #jv.
-                    ^ self
+                oldMethod isWrapped ifTrue:[
+                    "/ update the wrapped method - do not install
+                    newMethod originalMethod: oldMethod originalMethod.
+                    oldMethod replaceOriginalMethodWith:newMethod.
+                ] ifFalse:[
+                    "/ install
+                    newMethod originalMethod: oldMethod.
+                    (class primAddSelector: selector withMethod:newMethod) ifFalse:[
+                        oldMethod mclass:class.
+                        self breakPoint: #cg.
+                        self breakPoint: #jv.
+                        ^ self
+                    ].
                 ].
+
                 codeView methodHolder value:newMethod.
                 oldMethod mclass isNil ifTrue:[
                     "/ although this is not strictly true, not doing this
@@ -251,7 +259,7 @@
                     Smalltalk changed:#methodTrap with:(MethodTrapChangeNotificationParameter changeClass:class changeSelector:selector).
                 ].
             ].
-"/ self halt.
+
             breakpoints := breakpoints
                             select:[:bp |
 "/                                bp isReached ifFalse:[ 
@@ -280,7 +288,7 @@
     pos := textView characterPositionOfLine:line col:1.
     bpnt := self breakpointAtLine:line.
     bpnt isNil ifTrue:[
-        (codeView topView class ~~ DebugView) ifTrue:[
+        (self canCreateOrToggleBreakpointAtLine:line) ifTrue:[
             breakpoints add:((bpnt := Breakpoint new) position:pos line:line).
             Display shiftDown ifTrue:[
                 "/ trace
@@ -303,6 +311,40 @@
     "Modified: / 02-08-2012 / 09:26:38 / cg"
 ! !
 
+!BreakpointService methodsFor:'queries'!
+
+canCreateOrToggleBreakpointAtLine:lineOrNilForAnywhere
+    |pos bpnt topView|
+
+    textView reallyModified ifTrue:[
+        ^ false
+    ].
+    "/ can always toggle existing breakpoints...
+    lineOrNilForAnywhere notNil ifTrue:[
+        pos := textView characterPositionOfLine:lineOrNilForAnywhere col:1.
+        bpnt := self breakpointAtLine:lineOrNilForAnywhere.
+        bpnt notNil ifTrue:[
+            ^ true.
+        ]
+    ].
+
+    ((topView := codeView topView) class == DebugView) ifTrue:[
+        "/ can only create new breakpoints in the debugger,
+        "/ iff we are in a wrapped method's prolog
+        topView selectedContextIsWrapped ifTrue:[
+            topView selectedContext lineNumber == 1 ifTrue:[
+                ^ true
+            ].
+        ].
+        ^ false.
+    ].
+    ^  true.
+!
+
+hasBreakpoints
+    ^ breakpoints notEmptyOrNil
+! !
+
 !BreakpointService methodsFor:'redrawing'!
 
 drawLine:lineNo in:view atX:x y:y width:w height:h from:startCol to:endColOrNil with:fg and:bg
@@ -337,14 +379,20 @@
     "Modified (format): / 05-07-2011 / 22:14:33 / cg"
 ! !
 
+!BreakpointService methodsFor:'testing'!
+
+isBreakpointService
+    ^ true
+! !
+
 !BreakpointService class methodsFor:'documentation'!
 
 version_CVS
-    ^ '$Header: /cvs/stx/stx/libtool/Tools__BreakpointService.st,v 1.19 2013-06-05 17:18:17 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/libtool/Tools__BreakpointService.st,v 1.20 2013-06-14 12:22:25 cg Exp $'
 
 !
 
 version_SVN
-    ^ '$Id: Tools__BreakpointService.st,v 1.19 2013-06-05 17:18:17 cg Exp $'
+    ^ '$Id: Tools__BreakpointService.st,v 1.20 2013-06-14 12:22:25 cg Exp $'
 ! !