--- a/DebugView.st Sun Oct 09 22:55:02 2016 +0100
+++ b/DebugView.st Tue Oct 18 22:55:22 2016 +0100
@@ -1,5 +1,3 @@
-"{ Encoding: utf8 }"
-
"
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
@@ -2787,9 +2785,9 @@
].
aComponent == terminateButton ifTrue:[
Processor activeProcess isGUIProcess ifTrue:[
- s := 'Terminate the process (closes view and shuts down application)'
+ s := 'Terminate the process.\Attention: closes view and shuts down application.'
] ifFalse:[
- s := 'Terminate the process'
+ s := 'Terminate the process.\Attention: do not kill a system thread'
]
].
aComponent == continueButton ifTrue:[
@@ -3033,45 +3031,45 @@
|m|
withConfirmation ifTrue:[
- self checkIfCodeIsReallyModified ifTrue:[
- (self confirm:('Code modified - exit anyway ?'))
- ifFalse:[
- ^ self
- ]
- ]
+ self checkIfCodeIsReallyModified ifTrue:[
+ (self confirm:('Code was modified.\\Exit anyway ?'))
+ ifFalse:[
+ ^ self
+ ]
+ ]
].
self autoUpdateOff.
(m := contextView middleButtonMenu) notNil ifTrue:[m hide].
inspecting ifFalse:[
- "I am running on top of a process, abort or continue it"
-
- windowGroup notNil ifTrue:[
- windowGroup setProcess:nil.
- ].
- self uncacheMyself.
-
- "/
- "/ catch invalid return;
- "/ this happens, when my process has somehow died (quickterminate)
- "/ and I am a leftOver view, which gets terminated via the launchers
- "/ #destroy-window function.
- "/
- Context cannotReturnSignal handle:[:ex |
- 'DebugView [info]: OOPS - non regular debugView closing(1)' infoPrintCR.
- self uncacheMyself.
- Debugger newDebugger.
- ex return.
- ] do:[
- AbortOperationRequest isHandled ifTrue:[
- self doAbort.
- ] ifFalse:[
- self doContinue
- ]
- ].
- "/ We don't reach this point normally
- 'DebugView [info]: OOPS - non regular debugView closing(2)' infoPrintCR.
+ "I am running on top of a process, abort or continue it"
+
+ windowGroup notNil ifTrue:[
+ windowGroup setProcess:nil.
+ ].
+ self uncacheMyself.
+
+ "/
+ "/ catch invalid return;
+ "/ this happens, when my process has somehow died (quickterminate)
+ "/ and I am a leftOver view, which gets terminated via the launchers
+ "/ #destroy-window function.
+ "/
+ Context cannotReturnSignal handle:[:ex |
+ 'DebugView [info]: OOPS - non regular debugView closing(1)' infoPrintCR.
+ self uncacheMyself.
+ Debugger newDebugger.
+ ex return.
+ ] do:[
+ AbortOperationRequest isHandled ifTrue:[
+ self doAbort.
+ ] ifFalse:[
+ self doContinue
+ ]
+ ].
+ "/ We don't reach this point normally
+ 'DebugView [info]: OOPS - non regular debugView closing(2)' infoPrintCR.
].
Debugger newDebugger.
@@ -3242,19 +3240,21 @@
initializeButtons1In:bpanel
"creates the top button row, consisting of 'continue', 'abort', 'terminate'..."
- |separator|
-
+ |separator buttonWidth|
+
+ buttonWidth := 170.
+
bpanel horizontalLayout:#left.
bpanel verticalLayout:#centerMax.
bpanel verticalSpace:ViewSpacing // 2.
self initializeContinueButtonIn:bpanel.
- continueButton width:150.
+ continueButton width:buttonWidth.
"/ separator := View extent:(10 @ 5) in:bpanel.
"/ separator borderWidth:0; level:0.
self initializeAbortButtonIn:bpanel.
- abortButton width:150.
+ abortButton width:buttonWidth.
separator := View extent:(100 @ 5) in:bpanel.
separator borderWidth:0; level:0.
@@ -3269,9 +3269,9 @@
self initializeDefineButtonIn:bpanel.
(UserPreferences current allowSendMailFromDebugger and:[SendMailTool notNil]) ifTrue:[
- separator := View extent:(10 @ 5) in:bpanel.
- separator borderWidth:0; level:0.
- self initializeReportButtonIn:bpanel.
+ separator := View extent:(10 @ 5) in:bpanel.
+ separator borderWidth:0; level:0.
+ self initializeReportButtonIn:bpanel.
].
"Modified: / 17.11.2001 / 21:02:59 / cg"
!
@@ -3279,17 +3279,19 @@
initializeButtons2In:bpanel
"creates the second button row, consisting of 'next', 'step', 'return'..."
- |separator|
+ |separator buttonWidth|
+
+ buttonWidth := 130.
bpanel horizontalLayout:#left.
bpanel verticalLayout:#centerMax.
bpanel verticalSpace:ViewSpacing // 2.
self initializeNextButtonIn:bpanel.
- nextButton width:100.
+ nextButton width:buttonWidth.
self initializeStepButtonIn:bpanel.
- stepButton width:100.
+ stepButton width:buttonWidth.
"/ cg:
"/ I disabled the stepIn / stepOut buttons - for now.
@@ -3325,17 +3327,17 @@
"/ in:bpanel.
self initializeSendButtonIn:bpanel.
- sendButton width:100.
+ sendButton width:buttonWidth.
separator := View extent:(30 @ 5) in:bpanel.
separator borderWidth:0; level:0.
self initializeReturnButtonIn:bpanel.
- returnButton width:100.
+ returnButton width:buttonWidth.
self initializeRestartButtonIn:bpanel.
- restartButton width:100.
+ restartButton width:buttonWidth.
self initializeResendButtonIn:bpanel.
- resendButton width:100.
+ resendButton width:buttonWidth.
"Modified: / 18-06-2010 / 08:32:05 / cg"
!
@@ -4877,41 +4879,12 @@
from whatever the process is doing, but does not terminate it."
self checkIfCodeIsReallyModified ifTrue:[
- (self confirm:('Code modified - abort anyway ?'))
- ifFalse:[
- ^ self
- ]
- ].
-
- inspecting ifTrue:[
- inspectedProcess isDead ifTrue:[
- self showTerminated.
- ^ self
- ].
- (AbortOperationRequest isHandledIn:inspectedProcess suspendedContext) ifFalse:[
- self showError:'** the process does not handle the abort signal **'
- ] ifTrue:[
- self interruptProcessWith:[AbortOperationRequest raise].
- ].
- ^ self
- ].
-
- steppedContext := wrapperContext := nil.
- haveControl := false.
- exitAction := #abort.
-
- "exit private event-loop"
- catchBlock notNil ifTrue:[
- abortButton turnOff.
- catchBlock value.
-
- "/ not reached
- 'DebugView [warning]: abort failed' errorPrintCR.
- ].
-
- ^ self.
-
- "Modified: / 17.11.2001 / 22:53:22 / cg"
+ (self confirm:('Code was modified.\\Abort anyway ?'))
+ ifFalse:[
+ ^ self
+ ]
+ ].
+ ^ self doAbortWithoutConfirmation
!
doAbortAll
@@ -4957,6 +4930,42 @@
"Modified: / 17.11.2001 / 22:53:22 / cg"
!
+doAbortWithoutConfirmation
+ "abort - send Object>>abortSignal, which is usually caught
+ at save places (for example: in the event loop) and returns back
+ from whatever the process is doing, but does not terminate it."
+
+ inspecting ifTrue:[
+ inspectedProcess isDead ifTrue:[
+ self showTerminated.
+ ^ self
+ ].
+ (AbortOperationRequest isHandledIn:inspectedProcess suspendedContext) ifFalse:[
+ self showError:'** the process does not handle the abort signal **'
+ ] ifTrue:[
+ self interruptProcessWith:[AbortOperationRequest raise].
+ ].
+ ^ self
+ ].
+
+ steppedContext := wrapperContext := nil.
+ haveControl := false.
+ exitAction := #abort.
+
+ "exit private event-loop"
+ catchBlock notNil ifTrue:[
+ abortButton turnOff.
+ catchBlock value.
+
+ "/ not reached
+ 'DebugView [warning]: abort failed' errorPrintCR.
+ ].
+
+ ^ self.
+
+ "Modified: / 17.11.2001 / 22:53:22 / cg"
+!
+
doChangeProcessPriority
"ask for and change the process's priority"
@@ -5280,23 +5289,23 @@
inspecting ifTrue:[^ self].
self checkIfCodeIsReallyModified ifTrue:[
- (self confirm:('Code modified - step anyway ?'))
- ifFalse:[
- ^ self
- ]
+ (self confirm:('Code was modified.\\Step anyway ?'))
+ ifFalse:[
+ ^ self
+ ]
].
canContinue ifTrue:[
- steppedContext := wrapperContext := nil.
- haveControl := false.
- exitAction := #step.
-
- "exit private event-loop"
- catchBlock value.
-
- "/ not reached
- 'DebugView [warning]: send failed' errorPrintCR.
- sendButton turnOff.
+ steppedContext := wrapperContext := nil.
+ haveControl := false.
+ exitAction := #step.
+
+ "exit private event-loop"
+ catchBlock value.
+
+ "/ not reached
+ 'DebugView [warning]: send failed' errorPrintCR.
+ sendButton turnOff.
]
"Created: / 6.3.1997 / 21:09:36 / cg"
@@ -5510,70 +5519,70 @@
inspecting ifTrue:[^ self].
self checkIfCodeIsReallyModified ifTrue:[
- (self confirm:('Code modified - step anyway ?'))
- ifFalse:[
- ^ self
- ]
+ (self confirm:('Code was modified\\Step anyway ?'))
+ ifFalse:[
+ ^ self
+ ]
].
canContinue ifTrue:[
- selectedContext notNil ifTrue:[
- con := actualContext. "/ selectedContext.
- steppedContextLineno := actualContext lineNumber.
- ] ifFalse:[
- con := contextArray at:2.
- steppedContextLineno := con lineNumber.
- ].
-
- skipLineNr := lineNrOrNilOrMinus1.
-
- lineNrOrNilOrMinus1 == -1 ifTrue:[
- steppedContextLineno := skipLineNr := nil.
- ].
-
- (stepUntilEntering isNil and:[stepHow == #send]) ifTrue:[
- steppedContext := contextArray at:1.
- stepHow := #nextIn.
- ] ifFalse:[
- stepHow == #nextOut ifTrue:[
- steppedContext := con home.
- ] ifFalse:[
- steppedContext := con.
- ].
- ].
-
- wrapperContext := nil.
+ selectedContext notNil ifTrue:[
+ con := actualContext. "/ selectedContext.
+ steppedContextLineno := actualContext lineNumber.
+ ] ifFalse:[
+ con := contextArray at:2.
+ steppedContextLineno := con lineNumber.
+ ].
+
+ skipLineNr := lineNrOrNilOrMinus1.
+
+ lineNrOrNilOrMinus1 == -1 ifTrue:[
+ steppedContextLineno := skipLineNr := nil.
+ ].
+
+ (stepUntilEntering isNil and:[stepHow == #send]) ifTrue:[
+ steppedContext := contextArray at:1.
+ stepHow := #nextIn.
+ ] ifFalse:[
+ stepHow == #nextOut ifTrue:[
+ steppedContext := con home.
+ ] ifFalse:[
+ steppedContext := con.
+ ].
+ ].
+
+ wrapperContext := nil.
"/ ' step con:' print. (ObjectMemory addressOf:steppedContext) printHex. ' ' print. steppedContext printCR.
- "
- if we step in a wrapped method,
- prepare to skip the prolog ...
- "
-
- inWrap := false.
- method := con method.
- (method notNil
- and:[method isWrapped
- and:[method originalMethod ~~ method]]) ifTrue:[
- inWrap := true
- ].
-
- lineNrOrNilOrMinus1 == #return ifTrue:[
- Processor activeProcess forceInterruptOnReturnOf:con.
- ].
-
- con := nil.
- bigStep := true.
- haveControl := false.
- exitAction := #step.
-
- "exit private event-loop"
- catchBlock value.
-
- "/ not reached
- 'DebugView [warning]: step failed' errorPrintCR.
- stepButton turnOff. nextButton turnOff. sendButton turnOff.
+ "
+ if we step in a wrapped method,
+ prepare to skip the prolog ...
+ "
+
+ inWrap := false.
+ method := con method.
+ (method notNil
+ and:[method isWrapped
+ and:[method originalMethod ~~ method]]) ifTrue:[
+ inWrap := true
+ ].
+
+ lineNrOrNilOrMinus1 == #return ifTrue:[
+ Processor activeProcess forceInterruptOnReturnOf:con.
+ ].
+
+ con := nil.
+ bigStep := true.
+ haveControl := false.
+ exitAction := #step.
+
+ "exit private event-loop"
+ catchBlock value.
+
+ "/ not reached
+ 'DebugView [warning]: step failed' errorPrintCR.
+ stepButton turnOff. nextButton turnOff. sendButton turnOff.
]
"Modified: / 29.7.1998 / 21:50:16 / cg"
@@ -6688,21 +6697,22 @@
findNodeIn:tree forInterval:interval
<resource: #obsolete>
- |node|
-
-self obsoleteMethodWarning.
- node := nil.
- tree nodesDo:[:each |
- (each intersectsInterval:interval) ifTrue:[
- (node isNil or:[node == each parent]) ifTrue:[
- node := each
- ] ifFalse:[
- (node parent notNil
- and:[node parent isCascade and:[each parent isCascade]]) ifFalse:[^ nil]
- ]
- ]
- ].
- ^ node
+ self obsoleteMethodWarning.
+ ^ DoWhatIMeanSupport findNodeIn:tree forInterval:interval
+"/ |node|
+"/
+"/ node := nil.
+"/ tree nodesDo:[:each |
+"/ (each intersectsInterval:interval) ifTrue:[
+"/ (node isNil or:[node == each parent]) ifTrue:[
+"/ node := each
+"/ ] ifFalse:[
+"/ (node parent notNil
+"/ and:[node parent isCascade and:[each parent isCascade]]) ifFalse:[^ nil]
+"/ ]
+"/ ]
+"/ ].
+"/ ^ node
!
goodSkipUntilSelector
@@ -8261,6 +8271,8 @@
"/ self showError:ex description.
"/ ex proceed.
"/ ] do:[
+ device isNil ifTrue:[^ self].
+
device
dispatchModalWhile:[
Processor activeProcess state:#debug.
@@ -8769,9 +8781,9 @@
Redefined here, to answer true, if exclusice Debugger, which cannot handle popup boxes"
(exclusive or:[windowGroup isNil]) ifTrue:[
- ^ true
- ].
- ^ super confirm:aString.
+ ^ true
+ ].
+ ^ super confirm:(resources stringWithCRs:aString).
!
doShowSelection:lineNr
@@ -9297,11 +9309,12 @@
] ifFalse:[
UserPreferences current syntaxColoring ifTrue:[
implementorClass isNil ifTrue:[
+ |guessedHome|
(con isBlockContext
and:[con home isNil
- and:[con guessedHome notNil]])
+ and:[(guessedHome := con guessedHome) notNil]])
ifTrue:[
- implementorClass := con guessedHome mclass
+ implementorClass := guessedHome mclass
]
].
implementorClass notNil ifTrue:[
@@ -9375,6 +9388,7 @@
].
codeView
+ simulatedSelf:rec;
doItAction:
[:theCode |
evaluatorClass
@@ -9481,7 +9495,7 @@
printConditionOn:aStream
ignoredSendingClassAndSelectors notEmptyOrNil ifTrue:[
- aStream nextPutAll:(' if called from %1 » %2'
+ aStream nextPutAll:(' if called from %1 » %2'
bindWith:ignoredSendingClassAndSelectors first first
with:ignoredSendingClassAndSelectors first second).
^ self.