# HG changeset patch
# User Claus Gittinger <cg@exept.de>
# Date 1407069723 -7200
# Node ID cecbcb8523d93707cf46a02d072af1b4cd6ec8c7
# Parent  31166504525da4e1ca4b19ac3a4f7e815db6dd99
class: DebugView
class definition
added: #debuggerOnMainDisplayOnly
changed:
        #enter:withMessage:mayProceed:
        #new

classvar flag to force debuggers on main Display only

diff -r 31166504525d -r cecbcb8523d9 DebugView.st
--- a/DebugView.st	Sun Aug 03 11:29:15 2014 +0200
+++ b/DebugView.st	Sun Aug 03 14:42:03 2014 +0200
@@ -38,7 +38,7 @@
 		DefaultDebuggerBackgroundColor InitialNChainShown IgnoredHalts
 		ShowThreadID LastIgnoreHaltNTimes LastIgnoreHaltDuration
 		LastExtent LastOrigin RememberedCallChain DebuggingDebugger3
-		NumberOfDebuggers'
+		NumberOfDebuggers DebuggerOnMainDisplayOnly'
 	poolDictionaries:''
 	category:'Interface-Debugger'
 !
@@ -189,6 +189,10 @@
 
 !DebugView class methodsFor:'defaults'!
 
+debuggerOnMainDisplayOnly
+    ^ DebuggerOnMainDisplayOnly ? true
+!
+
 defaultIcon
     "return the browsers default window icon"
 
@@ -502,6 +506,8 @@
 
     <context: #return>
 
+    |display|
+
     (NumberOfDebuggers ? 0) > self maxNumberOfDebuggers ifTrue:[
         NumberOfDebuggers := self allInstances count:[:d | d isOpen].
         NumberOfDebuggers > self maxNumberOfDebuggers ifTrue:[
@@ -513,28 +519,35 @@
         '==> enter1: (' print. aContext print. ')' printCR.
     ].
 
-    StepInterruptPending := nil.
-    ControlInterrupt handle:[:ex |
-        'DebugView [info]: breakpoint in debugger setup ignored [enter.]' infoPrintCR.
-        ('DebugView [info]: breakpoint on:' , ex suspendedContext printString) infoPrintCR.
-        ex proceed
-    ] do:[
-        |debugger|
-
-        "
-         well, it could be a stepping or sending debugger up there;
-         in this case, return to it. This happens, when a stepping process
-         runs into an error (for example, a halt). In this case, we want the
-         stepping debugger to come up again instead of a new one.
-        "
-        (debugger := self openDebuggerForActiveProcess) notNil ifTrue:[
-            debugger unstep.
-            debugger setLabelFor:aString in:Processor activeProcess.
-            debugger mayProceed:mayProceed.
-            ^ debugger enter:aContext select:nil.
-        ].
-    ].
-    ^ self enterUnconditional:aContext withMessage:aString mayProceed:mayProceed
+    display := (self debuggerOnMainDisplayOnly)
+                ifTrue:[ Display ]
+                ifFalse:[ Screen current ].
+
+    Screen currentScreenQuerySignal answer:display
+    do:[
+        StepInterruptPending := nil.
+        ControlInterrupt handle:[:ex |
+            'DebugView [info]: breakpoint in debugger setup ignored [enter.]' infoPrintCR.
+            ('DebugView [info]: breakpoint on:' , ex suspendedContext printString) infoPrintCR.
+            ex proceed
+        ] do:[
+            |debugger|
+
+            "
+             well, it could be a stepping or sending debugger up there;
+             in this case, return to it. This happens, when a stepping process
+             runs into an error (for example, a halt). In this case, we want the
+             stepping debugger to come up again instead of a new one.
+            "
+            (debugger := self openDebuggerForActiveProcess) notNil ifTrue:[
+                debugger unstep.
+                debugger setLabelFor:aString in:Processor activeProcess.
+                debugger mayProceed:mayProceed.
+                ^ debugger enter:aContext select:nil.
+            ].
+        ].
+        ^ self enterUnconditional:aContext withMessage:aString mayProceed:mayProceed
+    ].
 
     "Modified: / 06-11-2013 / 20:58:54 / cg"
 !
@@ -616,7 +629,7 @@
      Also, care for remote displays on which no debugger is wanted
      (ask with mayOpenDebugger) - if so, open on the default screen."
 
-    |debugger currentScreen debuggerDevice|
+    |debugger currentScreen debuggerScreen|
 
     currentScreen := Screen current.
 
@@ -627,7 +640,7 @@
         ].
         (currentScreen mayOpenDebugger) ifFalse:[
             "/ no debugger on that device - but on the main screen
-            currentScreen := Screen default.
+            currentScreen := Display ? Screen default.
         ].
     ].
 
@@ -657,20 +670,20 @@
         (debugger := CachedDebugger) notNil ifTrue:[
             CachedDebugger := nil.
         ] ifFalse:[
-            debuggerDevice := currentScreen.
-            debuggerDevice isNil ifTrue:[
+            debuggerScreen := currentScreen.
+            debuggerScreen isNil ifTrue:[
                 "/ use the default display
-                debuggerDevice := Screen default.
-            ].
-            (debuggerDevice isNil
-            or:[debuggerDevice isOpen not
+                debuggerScreen := Screen default.
+            ].
+            (debuggerScreen isNil
+            or:[debuggerScreen isOpen not
             "/ or:[debuggerDevice mayOpenDebugger not]
             ]) ifTrue:[
                 "/ no debugger
                 ^ nil.
             ].
 
-            Screen currentScreenQuerySignal answer:debuggerDevice
+            Screen currentScreenQuerySignal answer:debuggerScreen
             do:[
                 debugger := super new.
             ].
@@ -9426,15 +9439,15 @@
 !DebugView class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libtool/DebugView.st,v 1.664 2014-07-26 07:55:23 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/libtool/DebugView.st,v 1.665 2014-08-03 12:42:03 cg Exp $'
 !
 
 version_CVS
-    ^ '$Header: /cvs/stx/stx/libtool/DebugView.st,v 1.664 2014-07-26 07:55:23 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/libtool/DebugView.st,v 1.665 2014-08-03 12:42:03 cg Exp $'
 !
 
 version_SVN
-    ^ '$Id: DebugView.st,v 1.664 2014-07-26 07:55:23 cg Exp $'
+    ^ '$Id: DebugView.st,v 1.665 2014-08-03 12:42:03 cg Exp $'
 ! !