class: DebugView
authorClaus Gittinger <cg@exept.de>
Sat, 24 Aug 2013 00:28:25 +0200
changeset 13360 f87b54dfc58a
parent 13359 969a96c3a4b6
child 13361 7eb8692dbc1b
class: DebugView class definition added: #doResend #exit_resend #initializeResendButtonIn: changed: #enter:select: #initializeButtons2In: #initializeButtonsIn:
DebugView.st
--- a/DebugView.st	Fri Aug 23 17:24:50 2013 +0200
+++ b/DebugView.st	Sat Aug 24 00:28:25 2013 +0200
@@ -29,7 +29,7 @@
 		isStoppedAtHaltOrBreakPoint exceptionInfoLabel methodCodeToggle
 		methodCodeToggleSelectionHolder
 		isStoppedAtBreakPointWithParameter breakPointParameter
-		hideSupportCode contextInfoLabel'
+		hideSupportCode contextInfoLabel resendButton'
 	classVariableNames:'CachedDebugger CachedExclusive OpenDebuggers MoreDebuggingDetail
 		DebuggingDebugger DebuggingDebugger2
 		DefaultDebuggerBackgroundColor InitialNChainShown IgnoredHalts
@@ -1851,6 +1851,7 @@
         (exitAction == #abortAll) ifTrue:[ self exit_abortAll. "does not return" ].
         (exitAction == #return) ifTrue:[ self exit_return. "does not return" ].
         (exitAction == #restart) ifTrue:[ self exit_restart. "does not return" ].
+        (exitAction == #resend) ifTrue:[ self exit_resend. "does not return" ].
         (exitAction == #quickTerminate) ifTrue:[ self exit_quickTerminate. "does not return" ].
         (exitAction == #terminate) ifTrue:[ self exit_terminate. "does not return" ].
         exitAction isBlock ifTrue:[
@@ -1996,6 +1997,26 @@
     "Modified: / 17.11.2001 / 23:20:07 / cg"
 !
 
+exit_resend
+    |con|
+
+    selectedContext notNil ifTrue:[
+        con := selectedContext.
+        self cacheMyself.
+        "
+         have to catch errors occuring in unwind-blocks
+        "
+        Error handle:[:ex |
+            'DebugView [info]: ignored error while unwinding: ' infoPrint.
+            ex description infoPrintCR.
+            ex proceed
+        ] do:[
+            con unwindThenResend.
+        ].
+        'DebugView [warning]: cannot resend selected context''s message' errorPrintCR
+    ]
+!
+
 exit_restart
     |con|
 
@@ -2883,6 +2904,8 @@
     returnButton width:100.
     self initializeRestartButtonIn:bpanel.
     restartButton width:100.
+    self initializeResendButtonIn:bpanel.
+    resendButton width:100.
 
     "Modified: / 18-06-2010 / 08:32:05 / cg"
 !
@@ -2906,6 +2929,7 @@
 
     self initializeReturnButtonIn:bpanel.
     self initializeRestartButtonIn:bpanel.
+    self initializeResendButtonIn:bpanel.
 
     separator := View extent:(10 @ 5) in:bpanel.
     separator borderWidth:0; level:0.
@@ -3084,6 +3108,17 @@
     "Created: / 17.11.2001 / 21:02:20 / cg"
 !
 
+initializeResendButtonIn:bpanel
+    ^ self.
+    resendButton := Button
+                label:(resources string:'Resend')
+                action:[
+                    resendButton turnOff.
+                    self doResend
+                ]
+                in:bpanel.
+!
+
 initializeRestartButtonIn:bpanel
     restartButton := Button
                 label:(resources string:'Restart')
@@ -4682,6 +4717,30 @@
     "Modified: / 20-09-2007 / 12:40:40 / cg"
 !
 
+doResend
+    "resend - the selected context is unwound and its message resent.
+     To be done after a cde change, to get nto the new method"
+
+    self checkIfCodeIsReallyModified ifTrue:[
+        (self confirm:('Code modified - resend anyway ?')) ifFalse:[
+            ^ self
+        ]
+    ].
+    inspecting ifTrue:[
+        ^ self showError:'** not avail in inspecting debugger **'
+    ].
+    steppedContext := wrapperContext := nil.
+    haveControl := false.
+    exitAction := #resend. "exit private event-loop"
+
+    catchBlock value.
+
+    "/ normally not reached
+
+    'DebugView [warning]: resend failed' errorPrintCR.
+    resendButton turnOff.
+!
+
 doRestart
     "restart - the selected context will be restarted"
 
@@ -8608,15 +8667,15 @@
 !DebugView class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libtool/DebugView.st,v 1.611 2013-08-22 20:50:21 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/libtool/DebugView.st,v 1.612 2013-08-23 22:28:25 cg Exp $'
 !
 
 version_CVS
-    ^ '$Header: /cvs/stx/stx/libtool/DebugView.st,v 1.611 2013-08-22 20:50:21 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/libtool/DebugView.st,v 1.612 2013-08-23 22:28:25 cg Exp $'
 !
 
 version_SVN
-    ^ '$Id: DebugView.st,v 1.611 2013-08-22 20:50:21 cg Exp $'
+    ^ '$Id: DebugView.st,v 1.612 2013-08-23 22:28:25 cg Exp $'
 ! !