class: DebugView
class definition
added: #debuggerOnMainDisplayOnly
changed:
#enter:withMessage:mayProceed:
#new
classvar flag to force debuggers on main Display only
--- 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 $'
! !