# HG changeset patch # User Claus Gittinger # Date 1424823982 -3600 # Node ID 764b28599a900c2dbf5f95c6952df0125dc03059 # Parent 8b43bca192e91ef5790af2922f33bae23d22c03e *** empty log message *** diff -r 8b43bca192e9 -r 764b28599a90 DebugView.st --- a/DebugView.st Tue Feb 24 19:23:38 2015 +0100 +++ b/DebugView.st Wed Feb 25 01:26:22 2015 +0100 @@ -1,6 +1,6 @@ " COPYRIGHT (c) 1989 by Claus Gittinger - All Rights Reserved + All Rights Reserved This software is furnished under a license and may be used only in accordance with the terms of that license and with the @@ -73,7 +73,7 @@ copyright " COPYRIGHT (c) 1989 by Claus Gittinger - All Rights Reserved + All Rights Reserved This software is furnished under a license and may be used only in accordance with the terms of that license and with the @@ -98,7 +98,7 @@ are available, which allow control of another processes execution (i.e. single-step, restart & return). The setup will be changed then, to have the debugger control the debuggee (i.e. two processes). - However, as it works as it is, and is reliable enough, + However, as it works as it is, and is reliable enough, why should we change it without a particular need...). Only the 'stopped' debugged process is affected; @@ -110,27 +110,27 @@ See additional information in 'doc/misc/debugger.doc'. Notice & Warning (attention when changing thingslike menus, window spec etc. here): - the DebugView class caches the last used debugger in a class variable, - and hides/shows this window without recreating one from scratch. This is done to make - the debugger come up faster when single stepping, or hopping from breakpoint to breakpoint. - - It may happen, that a malfunctioning debugger (for example, a halfway created/destroyed one) - is kept there. You will notice this, if a debugger comes up without showing any contents. - In this case, close (or destroy) the broken debugView, and execute - Debugger newDebugger - which removes the cached debugger and forces creation of a new one the next time. - This is a temporary workaround - the debugger should be fixed to avoid this situation. - - You must also flush the cached debugger, if you change the debugger's - initialization code (buttons, menu, etc.) or the debugger's class layout, - and you want the new code to become effective. + the DebugView class caches the last used debugger in a class variable, + and hides/shows this window without recreating one from scratch. This is done to make + the debugger come up faster when single stepping, or hopping from breakpoint to breakpoint. + + It may happen, that a malfunctioning debugger (for example, a halfway created/destroyed one) + is kept there. You will notice this, if a debugger comes up without showing any contents. + In this case, close (or destroy) the broken debugView, and execute + Debugger newDebugger + which removes the cached debugger and forces creation of a new one the next time. + This is a temporary workaround - the debugger should be fixed to avoid this situation. + + You must also flush the cached debugger, if you change the debugger's + initialization code (buttons, menu, etc.) or the debugger's class layout, + and you want the new code to become effective. [author:] - Claus Gittinger + Claus Gittinger [see also:] - Exception Signal - Process + Exception Signal + Process " ! ! @@ -181,7 +181,7 @@ OpenDebuggers := nil. (Debugger isBehavior and:[Debugger name = #DebugView]) ifTrue:[ - Debugger := self + Debugger := self ]. " @@ -252,11 +252,11 @@ IgnoredHalts isNil ifTrue:[^ nil]. IgnoredHalts do:[:ign | - (ign isForMethod:haltingMethod line:lineNrInHaltingMethod) - "/ (ign isHaltIgnoredInMethod:haltingMethod line:lineNrInHaltingMethod) - ifTrue:[ - ^ ign - ]. + (ign isForMethod:haltingMethod line:lineNrInHaltingMethod) + "/ (ign isHaltIgnoredInMethod:haltingMethod line:lineNrInHaltingMethod) + ifTrue:[ + ^ ign + ]. ]. ^ nil. ! @@ -266,77 +266,77 @@ ^ IgnoredHalts notEmptyOrNil ! -ignoreBreakpointWithParameter:parameterOrNil - forCount:countOrNil orTimeDuration:dTOrNil orUntilShiftKey:untilShiftKey - orReceiverClass:receiverClassOrNil orProcess:processOrNil +ignoreBreakpointWithParameter:parameterOrNil + forCount:countOrNil orTimeDuration:dTOrNil orUntilShiftKey:untilShiftKey + orReceiverClass:receiverClassOrNil orProcess:processOrNil "remember to ignore a breakpoint with a parameter (i.e. breakpoint:#cg) for some number of invocations or until some time has elapsed. With nil count and time arguments, such an ignored breakpoint is reactivated" - self - ignoreHaltOrBreakpoint:#halt - method:nil line:nil - parameter:parameterOrNil - forCount:countOrNil orTimeDuration:dTOrNil orUntilShiftKey:untilShiftKey - orReceiverClass:receiverClassOrNil orProcess:processOrNil - orIfCalledFromMethod:nil -! - -ignoreHaltIn:haltingMethod at:lineNrOfHalt - forCount:countOrNil orTimeDuration:dTOrNil orUntilShiftKey:untilShiftKey - orReceiverClass:receiverClassOrNil orProcess:processOrNil + self + ignoreHaltOrBreakpoint:#halt + method:nil line:nil + parameter:parameterOrNil + forCount:countOrNil orTimeDuration:dTOrNil orUntilShiftKey:untilShiftKey + orReceiverClass:receiverClassOrNil orProcess:processOrNil + orIfCalledFromMethod:nil +! + +ignoreHaltIn:haltingMethod at:lineNrOfHalt + forCount:countOrNil orTimeDuration:dTOrNil orUntilShiftKey:untilShiftKey + orReceiverClass:receiverClassOrNil orProcess:processOrNil "remember to ignore a halt in some method for some number of invocations or until some time has elapsed. With nil count and time arguments, such an ignored halt is reactivated" - self - ignoreHaltOrBreakpoint:#halt - method:haltingMethod line:lineNrOfHalt - parameter:nil - forCount:countOrNil orTimeDuration:dTOrNil orUntilShiftKey:untilShiftKey - orReceiverClass:receiverClassOrNil orProcess:processOrNil - orIfCalledFromMethod:nil -! - -ignoreHaltIn:haltingMethod at:lineNrOfHalt - forCount:countOrNil orTimeDuration:dTOrNil orUntilShiftKey:untilShiftKey - orReceiverClass:receiverClassOrNil orProcess:processOrNil - orIfCalledFromMethod:ifCalledForMethodOrNil + self + ignoreHaltOrBreakpoint:#halt + method:haltingMethod line:lineNrOfHalt + parameter:nil + forCount:countOrNil orTimeDuration:dTOrNil orUntilShiftKey:untilShiftKey + orReceiverClass:receiverClassOrNil orProcess:processOrNil + orIfCalledFromMethod:nil +! + +ignoreHaltIn:haltingMethod at:lineNrOfHalt + forCount:countOrNil orTimeDuration:dTOrNil orUntilShiftKey:untilShiftKey + orReceiverClass:receiverClassOrNil orProcess:processOrNil + orIfCalledFromMethod:ifCalledForMethodOrNil "remember to ignore a halt in some method for some number of invocations or until some time has elapsed. With nil count and time arguments, such an ignored halt is reactivated" - self - ignoreHaltOrBreakpoint:#halt - method:haltingMethod line:lineNrOfHalt - parameter:nil - forCount:countOrNil orTimeDuration:dTOrNil orUntilShiftKey:untilShiftKey - orReceiverClass:receiverClassOrNil orProcess:processOrNil - orIfCalledFromMethod:ifCalledForMethodOrNil -! - -ignoreHaltOrBreakpoint:type method:methodOrNil line:lineNrOfHaltOrNil parameter:parameterOrNil - forCount:countOrNil orTimeDuration:dTOrNil orUntilShiftKey:untilShiftKey - orReceiverClass:receiverClassOrNil orProcess:processOrNil + self + ignoreHaltOrBreakpoint:#halt + method:haltingMethod line:lineNrOfHalt + parameter:nil + forCount:countOrNil orTimeDuration:dTOrNil orUntilShiftKey:untilShiftKey + orReceiverClass:receiverClassOrNil orProcess:processOrNil + orIfCalledFromMethod:ifCalledForMethodOrNil +! + +ignoreHaltOrBreakpoint:type method:methodOrNil line:lineNrOfHaltOrNil parameter:parameterOrNil + forCount:countOrNil orTimeDuration:dTOrNil orUntilShiftKey:untilShiftKey + orReceiverClass:receiverClassOrNil orProcess:processOrNil "remember to ignore a breakpoint with a parameter (i.e. breakpoint:#cg) for some number of invocations or until some time has elapsed. With nil count and time arguments, such an ignored breakpoint is reactivated" ^ self - ignoreHaltOrBreakpoint:type method:methodOrNil line:lineNrOfHaltOrNil parameter:parameterOrNil - forCount:countOrNil orTimeDuration:dTOrNil orUntilShiftKey:untilShiftKey - orReceiverClass:receiverClassOrNil orProcess:processOrNil - orIfCalledFromMethod:nil -! - -ignoreHaltOrBreakpoint:type method:methodOrNil line:lineNrOfHaltOrNil parameter:parameterOrNil - forCount:countOrNil orTimeDuration:dTOrNil orUntilShiftKey:untilShiftKey - orReceiverClass:receiverClassOrNil orProcess:processOrNil - orIfCalledFromMethod:ifCalledFromMethodOrNil + ignoreHaltOrBreakpoint:type method:methodOrNil line:lineNrOfHaltOrNil parameter:parameterOrNil + forCount:countOrNil orTimeDuration:dTOrNil orUntilShiftKey:untilShiftKey + orReceiverClass:receiverClassOrNil orProcess:processOrNil + orIfCalledFromMethod:nil +! + +ignoreHaltOrBreakpoint:type method:methodOrNil line:lineNrOfHaltOrNil parameter:parameterOrNil + forCount:countOrNil orTimeDuration:dTOrNil orUntilShiftKey:untilShiftKey + orReceiverClass:receiverClassOrNil orProcess:processOrNil + orIfCalledFromMethod:ifCalledFromMethodOrNil "remember to ignore a breakpoint with a parameter (i.e. breakpoint:#cg) for some number of invocations or until some time has elapsed. @@ -345,65 +345,65 @@ |oldEntry ign| IgnoredHalts notNil ifTrue:[ - self removeInactiveIgnores. - type == #halt ifTrue:[ - oldEntry := IgnoredHalts - detect:[:ign | ign isForMethod:methodOrNil line:lineNrOfHaltOrNil] - ifNone:nil. - ] ifFalse:[ - oldEntry := IgnoredHalts - detect:[:ign | ign isForBreakpointWithParameter:parameterOrNil] - ifNone:nil. - ]. - oldEntry notNil ifTrue:[ - (processOrNil notNil or:[receiverClassOrNil notNil]) ifTrue:[ - receiverClassOrNil notNil ifTrue:[ - oldEntry ignoreForReceiverClass:receiverClassOrNil. - ]. - processOrNil notNil ifTrue:[ - oldEntry ignoreForProcess:processOrNil. - ]. - ^ self. - ]. - IgnoredHalts remove:oldEntry ifAbsent:[]. - ] - ]. - - (countOrNil notNil - or:[dTOrNil notNil + self removeInactiveIgnores. + type == #halt ifTrue:[ + oldEntry := IgnoredHalts + detect:[:ign | ign isForMethod:methodOrNil line:lineNrOfHaltOrNil] + ifNone:nil. + ] ifFalse:[ + oldEntry := IgnoredHalts + detect:[:ign | ign isForBreakpointWithParameter:parameterOrNil] + ifNone:nil. + ]. + oldEntry notNil ifTrue:[ + (processOrNil notNil or:[receiverClassOrNil notNil]) ifTrue:[ + receiverClassOrNil notNil ifTrue:[ + oldEntry ignoreForReceiverClass:receiverClassOrNil. + ]. + processOrNil notNil ifTrue:[ + oldEntry ignoreForProcess:processOrNil. + ]. + ^ self. + ]. + IgnoredHalts remove:oldEntry ifAbsent:[]. + ] + ]. + + (countOrNil notNil + or:[dTOrNil notNil or:[untilShiftKey == true or:[receiverClassOrNil notNil or:[processOrNil notNil or:[ifCalledFromMethodOrNil notNil]]]]] ) ifTrue:[ - IgnoredHalts isNil ifTrue:[ - IgnoredHalts := OrderedCollection new. - ]. - type == #halt ifTrue:[ - ign := IgnoredHalt new method:methodOrNil lineNumber:lineNrOfHaltOrNil. - ] ifFalse:[ - ign := IgnoredHalt new breakpointWithParameter:parameterOrNil. - ]. - - (countOrNil notNil and:[countOrNil > 0]) ifTrue:[ - ign ignoreCount:countOrNil. - ]. - (dTOrNil notNil) ifTrue:[ - ign ignoreEndTime:(Timestamp now + dTOrNil). - ]. - untilShiftKey == true ifTrue:[ - ign ignoreUntilShiftKeyPressed:true. - ]. - receiverClassOrNil notNil ifTrue:[ - ign ignoreForReceiverClass:receiverClassOrNil. - ]. - processOrNil notNil ifTrue:[ - ign ignoreForProcess:processOrNil. - ]. - ifCalledFromMethodOrNil notNil ifTrue:[ - ign ignoreIfCalledFromMethod:ifCalledFromMethodOrNil. - ]. - IgnoredHalts add:ign. + IgnoredHalts isNil ifTrue:[ + IgnoredHalts := OrderedCollection new. + ]. + type == #halt ifTrue:[ + ign := IgnoredHalt new method:methodOrNil lineNumber:lineNrOfHaltOrNil. + ] ifFalse:[ + ign := IgnoredHalt new breakpointWithParameter:parameterOrNil. + ]. + + (countOrNil notNil and:[countOrNil > 0]) ifTrue:[ + ign ignoreCount:countOrNil. + ]. + (dTOrNil notNil) ifTrue:[ + ign ignoreEndTime:(Timestamp now + dTOrNil). + ]. + untilShiftKey == true ifTrue:[ + ign ignoreUntilShiftKeyPressed:true. + ]. + receiverClassOrNil notNil ifTrue:[ + ign ignoreForReceiverClass:receiverClassOrNil. + ]. + processOrNil notNil ifTrue:[ + ign ignoreForProcess:processOrNil. + ]. + ifCalledFromMethodOrNil notNil ifTrue:[ + ign ignoreIfCalledFromMethod:ifCalledFromMethodOrNil. + ]. + IgnoredHalts add:ign. ]. Smalltalk changed:#ignoredHalts. @@ -417,16 +417,16 @@ "/ Transcript showCR:'halt/break in ',haltingMethod printString,' at ',lineNrInHaltingMethod printString. IgnoredHalts do:[:ign | - (ign isForBreakpointWithParameter:parameter) ifTrue:[ - Transcript show:'Debugger [info]: break ignored for ', parameter. - - modifyCount ifTrue:[ ign decrementIgnoreCount ]. - ign isHaltIgnored ifFalse:[ - Transcript showCR:'Debugger [info]: no longer ignore breakpoint for ', parameter. - IgnoredHalts remove:ign ifAbsent:[]. - ]. - ^ true. - ]. + (ign isForBreakpointWithParameter:parameter) ifTrue:[ + Transcript show:'Debugger [info]: break ignored for ', parameter. + + modifyCount ifTrue:[ ign decrementIgnoreCount ]. + ign isHaltIgnored ifFalse:[ + Transcript showCR:'Debugger [info]: no longer ignore breakpoint for ', parameter. + IgnoredHalts remove:ign ifAbsent:[]. + ]. + ^ true. + ]. ]. IgnoredHalts := (IgnoredHalts reject:[:ign | ign isActive not ]) asNilIfEmpty. @@ -443,17 +443,17 @@ "/ Transcript showCR:'halt/break in ',haltingMethod printString,' at ',lineNrInHaltingMethod printString. IgnoredHalts do:[:ign | - (ign isHaltIgnoredInMethod:haltingMethod line:lineNrInHaltingMethod context:aContext) ifTrue:[ - Transcript show:'Debugger [info]: halt/break ignored in ', haltingMethod whoString. - Transcript show:' ('; show:ign; showCR:')'. - - modifyCount ifTrue:[ ign decrementIgnoreCount ]. - ign isHaltIgnored ifFalse:[ - Transcript showCR:'Debugger [info]: no longer ignore halt in ', haltingMethod whoString. - IgnoredHalts remove:ign ifAbsent:[]. - ]. - ^ true. - ]. + (ign isHaltIgnoredInMethod:haltingMethod line:lineNrInHaltingMethod context:aContext) ifTrue:[ + Transcript show:'Debugger [info]: halt/break ignored in ', haltingMethod whoString. + Transcript show:' ('; show:ign; showCR:')'. + + modifyCount ifTrue:[ ign decrementIgnoreCount ]. + ign isHaltIgnored ifFalse:[ + Transcript showCR:'Debugger [info]: no longer ignore halt in ', haltingMethod whoString. + IgnoredHalts remove:ign ifAbsent:[]. + ]. + ^ true. + ]. ]. IgnoredHalts := (IgnoredHalts reject:[:ign | ign isActive not]) asNilIfEmpty. @@ -465,7 +465,7 @@ removeInactiveIgnores IgnoredHalts notNil ifTrue:[ - IgnoredHalts := IgnoredHalts select:[:i | i isActive]. + IgnoredHalts := IgnoredHalts select:[:i | i isActive]. ]. ! @@ -483,7 +483,7 @@ IgnoredHalts isNil ifTrue:[^ self]. IgnoredHalts := IgnoredHalts reject:[:ign | - (ign isForMethod:haltingMethod line:lineNrInHaltingMethod) + (ign isForMethod:haltingMethod line:lineNrInHaltingMethod) ]. ! ! @@ -495,9 +495,9 @@ ^ self - enter:thisContext sender - withMessage:'Debugger Entered' - mayProceed:true. + enter:thisContext sender + withMessage:'Debugger Entered' + mayProceed:true. ! enter:aContext withMessage:aString @@ -506,9 +506,9 @@ ^ self - enter:aContext - withMessage:aString - mayProceed:true + enter:aContext + withMessage:aString + mayProceed:true ! enter:aContext withMessage:aString mayProceed:mayProceed @@ -522,44 +522,44 @@ |display| (NumberOfDebuggers ? 0) > self maxNumberOfDebuggers ifTrue:[ - NumberOfDebuggers := self allInstances count:[:d | d isOpen]. - NumberOfDebuggers > self maxNumberOfDebuggers ifTrue:[ - MiniDebugger enter:aContext withMessage:'too many debuggers - looping?' mayProceed:true. - ]. + NumberOfDebuggers := self allInstances count:[:d | d isOpen]. + NumberOfDebuggers > self maxNumberOfDebuggers ifTrue:[ + MiniDebugger enter:aContext withMessage:'too many debuggers - looping?' mayProceed:true. + ]. ]. DebuggingDebugger == true ifTrue:[ - '==> enter1: (' print. aContext print. ')' printCR. + '==> enter1: (' print. aContext print. ')' printCR. ]. display := (self debuggerOnMainDisplayOnly) - ifTrue:[ Display ] - ifFalse:[ Screen current ]. + 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 + 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" @@ -572,9 +572,9 @@ sent from error- and halt messages." ^ self - enter:ex returnableSuspendedContext - withMessage:('[',ex originalSignal class name,']: ',ex descriptionForDebugger) - mayProceed:(ex mayProceed). + enter:ex returnableSuspendedContext + withMessage:('[',ex originalSignal class name,']: ',ex descriptionForDebugger) + mayProceed:(ex mayProceed). ! enterUnconditional:aContext withMessage:aString mayProceed:mayProceed @@ -590,27 +590,27 @@ "/ ignore halts & breakpoints while setting up the debugger "/ to avoid recursive debugging ... ControlInterrupt handle:[:ex | - 'DebugView [info]: breakpoint in debugger setup ignored [enterUncond.]' infoPrintCR. - ('DebugView [info]: breakpoint on:' , ex suspendedContext printString) infoPrintCR. - ex proceed + 'DebugView [info]: breakpoint in debugger setup ignored [enterUncond.]' infoPrintCR. + ('DebugView [info]: breakpoint on:' , ex suspendedContext printString) infoPrintCR. + ex proceed ] do:[ - aDebugger := self new. + aDebugger := self new. ]. aDebugger isNil ifTrue:[ - 'DebugView [error]: cannot open debugger' errorPrintCR. - 'DebugView [error]: Exception: ' errorPrint. aString errorPrintCR. - mayProceed ifTrue:[ - (Dialog confirm:'Error/Breakpoint caught.\\Press Continue or Abort.' withCRs - yesLabel:'Continue' noLabel:'Abort') - ifTrue:[ - ^ nil - ]. - ] ifFalse:[ - self information:'Error caught.\\Press OK to abort the operation.' withCRs. - ]. - AbortOperationRequest raise. - "not reached" + 'DebugView [error]: cannot open debugger' errorPrintCR. + 'DebugView [error]: Exception: ' errorPrint. aString errorPrintCR. + mayProceed ifTrue:[ + (Dialog confirm:'Error/Breakpoint caught.\\Press Continue or Abort.' withCRs + yesLabel:'Continue' noLabel:'Abort') + ifTrue:[ + ^ nil + ]. + ] ifFalse:[ + self information:'Error caught.\\Press OK to abort the operation.' withCRs. + ]. + AbortOperationRequest raise. + "not reached" ]. aDebugger mayProceed:mayProceed. @@ -619,7 +619,7 @@ ^ nil. " - nil halt + nil halt " "Modified: / 18.11.2001 / 00:29:23 / cg" @@ -631,9 +631,9 @@ ^ self - enter:(thisContext sender) - withMessage:message - mayProceed:true. + enter:(thisContext sender) + withMessage:message + mayProceed:true. ! new @@ -647,14 +647,14 @@ currentScreen := Screen current. currentScreen notNil ifTrue:[ - (currentScreen suppressDebugger) ifTrue:[ - "/ no debuggers with that device - show an alertBox which aborts... - ^ nil. - ]. - (currentScreen mayOpenDebugger) ifFalse:[ - "/ no debugger on that device - but on the main screen - currentScreen := Display ? Screen default. - ]. + (currentScreen suppressDebugger) ifTrue:[ + "/ no debuggers with that device - show an alertBox which aborts... + ^ nil. + ]. + (currentScreen mayOpenDebugger) ifFalse:[ + "/ no debugger on that device - but on the main screen + currentScreen := Display ? Screen default. + ]. ]. " @@ -663,46 +663,46 @@ (because otherwise we would not get any events here ... " Processor activeProcessIsSystemProcess ifTrue:[ - ((debugger := CachedExclusive) isNil - or:[debugger device ~~ currentScreen - or:[currentScreen isNil - or:[currentScreen isOpen not]]]) ifTrue:[ - debugger := self newExclusive - ]. - CachedExclusive := nil. + ((debugger := CachedExclusive) isNil + or:[debugger device ~~ currentScreen + or:[currentScreen isNil + or:[currentScreen isOpen not]]]) ifTrue:[ + debugger := self newExclusive + ]. + CachedExclusive := nil. ] ifFalse:[ - CachedDebugger notNil ifTrue:[ - (CachedDebugger device ~~ currentScreen - or:[currentScreen isNil - or:[currentScreen isOpen not - or:[CachedDebugger class ~~ self]]]) ifTrue:[ - CachedDebugger := nil - ] - ]. - - (debugger := CachedDebugger) notNil ifTrue:[ - CachedDebugger := nil. - ] ifFalse:[ - debuggerScreen := currentScreen. - debuggerScreen isNil ifTrue:[ - "/ use the default display - debuggerScreen := Screen default. - ]. - (debuggerScreen isNil - or:[debuggerScreen isOpen not - "/ or:[debuggerDevice mayOpenDebugger not] - ]) ifTrue:[ - "/ no debugger - ^ nil. - ]. - - Screen currentScreenQuerySignal answer:debuggerScreen - do:[ - debugger := super new. - ]. - debugger label:'Debugger'. - debugger icon:self defaultIcon. - ] + CachedDebugger notNil ifTrue:[ + (CachedDebugger device ~~ currentScreen + or:[currentScreen isNil + or:[currentScreen isOpen not + or:[CachedDebugger class ~~ self]]]) ifTrue:[ + CachedDebugger := nil + ] + ]. + + (debugger := CachedDebugger) notNil ifTrue:[ + CachedDebugger := nil. + ] ifFalse:[ + debuggerScreen := currentScreen. + debuggerScreen isNil ifTrue:[ + "/ use the default display + debuggerScreen := Screen default. + ]. + (debuggerScreen isNil + or:[debuggerScreen isOpen not + "/ or:[debuggerDevice mayOpenDebugger not] + ]) ifTrue:[ + "/ no debugger + ^ nil. + ]. + + Screen currentScreenQuerySignal answer:debuggerScreen + do:[ + debugger := super new. + ]. + debugger label:'Debugger'. + debugger icon:self defaultIcon. + ] ]. ^ debugger @@ -737,26 +737,26 @@ stepping debugger to come up again instead of a new one. " OpenDebuggers notNil ifTrue:[ - active := Processor activeProcess. - OpenDebuggers do:[:aDebugger | - |debuggersProcess| - - (aDebugger notNil and:[aDebugger ~~ 0]) ifTrue:[ - debuggersProcess := aDebugger inspectedProcess. - debuggersProcess == active ifTrue:[ - aDebugger device isOpen ifTrue:[ - DebuggingDebugger == true ifTrue:[ - 'reusing cached debugger' errorPrintCR. - ]. - aDebugger unstep. - ^ aDebugger. - ] - ]. - (debuggersProcess notNil and:[ debuggersProcess isDead ]) ifTrue:[ - aDebugger destroy. - ]. - ] - ] + active := Processor activeProcess. + OpenDebuggers do:[:aDebugger | + |debuggersProcess| + + (aDebugger notNil and:[aDebugger ~~ 0]) ifTrue:[ + debuggersProcess := aDebugger inspectedProcess. + debuggersProcess == active ifTrue:[ + aDebugger device isOpen ifTrue:[ + DebuggingDebugger == true ifTrue:[ + 'reusing cached debugger' errorPrintCR. + ]. + aDebugger unstep. + ^ aDebugger. + ] + ]. + (debuggersProcess notNil and:[ debuggersProcess isDead ]) ifTrue:[ + aDebugger destroy. + ]. + ] + ] ]. ^ nil @@ -772,15 +772,15 @@ aDebugger := super new. aDebugger icon:self defaultIcon. aProcess notNil ifTrue:[ - nm := aProcess name. - nm notNil ifTrue:[ - nm := (nm contractTo:17) , '-' , aProcess id printString - ] ifFalse:[ - nm := aProcess id printString - ]. - label := 'Debugger [' , nm , ']'. + nm := aProcess name. + nm notNil ifTrue:[ + nm := (nm contractTo:17) , '-' , aProcess id printString + ] ifFalse:[ + nm := aProcess id printString + ]. + label := 'Debugger [' , nm , ']'. ] ifFalse:[ - label := 'no process' + label := 'no process' ]. aDebugger label:label iconLabel:'Debugger'. aDebugger openOn:aProcess. @@ -806,168 +806,168 @@ - ^ + ^ #(Menu - ( - (MenuItem - enabled: canRemoveBreakpoint - label: 'Remove Breakpoint' - itemValue: removeBreakpoint - ) - (MenuItem - label: 'Remove all Breakpoints' - itemValue: removeAllBreakpoints - ) - (MenuItem - label: '-' - ) - (MenuItem - label: 'Ignore this Halt/BreakPoint' - submenu: - (Menu - ( - (MenuItem - enabled: isStoppedAtHaltOrBreakPointOrSelectedContextIsWrapped - label: 'Forever (Until Ignoring is Stopped)' - itemValue: ignoreHaltForever - ) - (MenuItem - enabled: isStoppedAtHaltOrBreakPointOrSelectedContextIsWrapped - label: 'For Some Time...' - itemValue: openIgnoreHaltUntilTimeElapsedDialog - ) - (MenuItem - enabled: isStoppedAtHaltOrBreakPointOrSelectedContextIsWrapped - label: 'For the Next N Times...' - itemValue: openIgnoreHaltNTimesDialog - ) - (MenuItem - enabled: isStoppedAtHaltOrBreakPointOrSelectedContextIsWrapped - label: 'Until Shift-Key is Pressed' - itemValue: ignoreHaltUntilShiftKeyIsPressed - ) - (MenuItem - label: '-' - ) - (MenuItem - enabled: isStoppedAtHaltOrBreakPointOrSelectedContextIsWrapped - label: 'In Current Process' - itemValue: ignoreHaltForCurrentProcess - ) - (MenuItem - enabled: isStoppedAtHaltOrBreakPointOrSelectedContextIsWrapped - label: 'For this Receiver Class' - itemValue: ignoreHaltForThisReceiverClass - ) - (MenuItem - enabled: isStoppedAtHaltOrBreakPointOrSelectedContextIsWrapped - label: 'If Called from Any Of' - submenuChannel: menuForIgnoreBreakpointIfCalledFromAnyOf - ) - ) - nil - nil - ) - ) - (MenuItem - enabled: isStoppedAtBreakPointWithParameter - label: 'Ignore all BreakPoints with this Parameter' - submenu: - (Menu - ( - (MenuItem - enabled: isStoppedAtBreakPointWithParameter - label: 'Forever (Reenable in BreakPoint-Browser)' - itemValue: ignoreBreakpointsWithThisParameterForever - ) - (MenuItem - enabled: isStoppedAtBreakPointWithParameter - label: 'For Some Time...' - itemValue: openIgnoreBreakpointsWithThisParameterUntilTimeElapsedDialog - ) - (MenuItem - enabled: isStoppedAtBreakPointWithParameter - label: 'For the Next N Times...' - itemValue: openIgnoreBreakpointsWithThisParameterNTimesDialog - ) - (MenuItem - enabled: isStoppedAtBreakPointWithParameter - label: 'Until Shift-Key is Pressed' - itemValue: ignoreBreakpointsWithThisParameterUntilShiftKeyIsPressed - ) - (MenuItem - label: '-' - ) - (MenuItem - enabled: isStoppedAtHaltOrBreakPointOrSelectedContextIsWrapped - label: 'In Current Process' - itemValue: ignoreAllHaltsForCurrentProcess - ) - (MenuItem - enabled: isStoppedAtHaltOrBreakPointOrSelectedContextIsWrapped - label: 'For this Receiver Class' - itemValue: ignoreAllHaltsForThisReceiverClass - ) - (MenuItem - enabled: isStoppedAtHaltOrBreakPointOrSelectedContextIsWrapped - label: 'If Called from Any Of' - submenuChannel: menuForIgnoreAllBreakpointsIfCalledFromAnyOf - ) - ) - nil - nil - ) - ) - (MenuItem - label: 'Ignore all Halts/BreakPoints' - submenu: - (Menu - ( - (MenuItem - label: 'Forever (Until Ignoring is Stopped)' - itemValue: ignoreAllHaltsForever - ) - (MenuItem - label: 'For Some Time...' - itemValue: openIgnoreAllHaltsUntilTimeElapsedDialog - ) - (MenuItem - label: 'Until Shift-Key is Pressed' - itemValue: ignoreAllHaltsUntilShiftKeyIsPressed - ) - ) - nil - nil - ) - ) - (MenuItem - enabled: hasHaltsToIgnore - label: 'Stop Ignoring' - itemValue: stopIgnoringHalts - ) - (MenuItem - label: '-' - ) - (MenuItem - enabled: canAddBreakpoint - label: 'Add Breakpoint' - itemValue: addBreakpoint - ) - (MenuItem - label: 'Manage Breakpoints' - itemValue: openBreakPointBrowser - ) - (MenuItem - label: '-' - ) - (MenuItem - label: 'Allow Halt in Debugger' - itemValue: allowBreakPointsInDebugger: - indication: allowBreakPointsInDebugger - ) - ) - nil - nil + ( + (MenuItem + enabled: canRemoveBreakpoint + label: 'Remove Breakpoint' + itemValue: removeBreakpoint + ) + (MenuItem + label: 'Remove all Breakpoints' + itemValue: removeAllBreakpoints + ) + (MenuItem + label: '-' + ) + (MenuItem + label: 'Ignore this Halt/BreakPoint' + submenu: + (Menu + ( + (MenuItem + enabled: isStoppedAtHaltOrBreakPointOrSelectedContextIsWrapped + label: 'Forever (Until Ignoring is Stopped)' + itemValue: ignoreHaltForever + ) + (MenuItem + enabled: isStoppedAtHaltOrBreakPointOrSelectedContextIsWrapped + label: 'For Some Time...' + itemValue: openIgnoreHaltUntilTimeElapsedDialog + ) + (MenuItem + enabled: isStoppedAtHaltOrBreakPointOrSelectedContextIsWrapped + label: 'For the Next N Times...' + itemValue: openIgnoreHaltNTimesDialog + ) + (MenuItem + enabled: isStoppedAtHaltOrBreakPointOrSelectedContextIsWrapped + label: 'Until Shift-Key is Pressed' + itemValue: ignoreHaltUntilShiftKeyIsPressed + ) + (MenuItem + label: '-' + ) + (MenuItem + enabled: isStoppedAtHaltOrBreakPointOrSelectedContextIsWrapped + label: 'In Current Process' + itemValue: ignoreHaltForCurrentProcess + ) + (MenuItem + enabled: isStoppedAtHaltOrBreakPointOrSelectedContextIsWrapped + label: 'For this Receiver Class' + itemValue: ignoreHaltForThisReceiverClass + ) + (MenuItem + enabled: isStoppedAtHaltOrBreakPointOrSelectedContextIsWrapped + label: 'If Called from Any Of' + submenuChannel: menuForIgnoreBreakpointIfCalledFromAnyOf + ) + ) + nil + nil + ) + ) + (MenuItem + enabled: isStoppedAtBreakPointWithParameter + label: 'Ignore all BreakPoints with this Parameter' + submenu: + (Menu + ( + (MenuItem + enabled: isStoppedAtBreakPointWithParameter + label: 'Forever (Reenable in BreakPoint-Browser)' + itemValue: ignoreBreakpointsWithThisParameterForever + ) + (MenuItem + enabled: isStoppedAtBreakPointWithParameter + label: 'For Some Time...' + itemValue: openIgnoreBreakpointsWithThisParameterUntilTimeElapsedDialog + ) + (MenuItem + enabled: isStoppedAtBreakPointWithParameter + label: 'For the Next N Times...' + itemValue: openIgnoreBreakpointsWithThisParameterNTimesDialog + ) + (MenuItem + enabled: isStoppedAtBreakPointWithParameter + label: 'Until Shift-Key is Pressed' + itemValue: ignoreBreakpointsWithThisParameterUntilShiftKeyIsPressed + ) + (MenuItem + label: '-' + ) + (MenuItem + enabled: isStoppedAtHaltOrBreakPointOrSelectedContextIsWrapped + label: 'In Current Process' + itemValue: ignoreAllHaltsForCurrentProcess + ) + (MenuItem + enabled: isStoppedAtHaltOrBreakPointOrSelectedContextIsWrapped + label: 'For this Receiver Class' + itemValue: ignoreAllHaltsForThisReceiverClass + ) + (MenuItem + enabled: isStoppedAtHaltOrBreakPointOrSelectedContextIsWrapped + label: 'If Called from Any Of' + submenuChannel: menuForIgnoreAllBreakpointsIfCalledFromAnyOf + ) + ) + nil + nil + ) + ) + (MenuItem + label: 'Ignore all Halts/BreakPoints' + submenu: + (Menu + ( + (MenuItem + label: 'Forever (Until Ignoring is Stopped)' + itemValue: ignoreAllHaltsForever + ) + (MenuItem + label: 'For Some Time...' + itemValue: openIgnoreAllHaltsUntilTimeElapsedDialog + ) + (MenuItem + label: 'Until Shift-Key is Pressed' + itemValue: ignoreAllHaltsUntilShiftKeyIsPressed + ) + ) + nil + nil + ) + ) + (MenuItem + enabled: hasHaltsToIgnore + label: 'Stop Ignoring' + itemValue: stopIgnoringHalts + ) + (MenuItem + label: '-' + ) + (MenuItem + enabled: canAddBreakpoint + label: 'Add Breakpoint' + itemValue: addBreakpoint + ) + (MenuItem + label: 'Manage Breakpoints' + itemValue: openBreakPointBrowser + ) + (MenuItem + label: '-' + ) + (MenuItem + label: 'Allow Halt in Debugger' + itemValue: allowBreakPointsInDebugger: + indication: allowBreakPointsInDebugger + ) + ) + nil + nil ) ! @@ -986,51 +986,51 @@ - ^ + ^ #(Menu - ( - (MenuItem - enabled: canBrowseImplementingClass - label: 'Browse Implementing Class' - itemValue: browseImplementingClass - ) - (MenuItem - enabled: canBrowseReceiversClass - label: 'Browse Receiver''s Class' - itemValue: browseReceiversClass - ) - (MenuItem - enabled: canBrowseProcessesApplication - label: 'Browse Application Class' - itemValue: browseProcessesApplication - ) - (MenuItem - label: '-' - ) - (MenuItem - enabled: canBrowseClassHierarchy - label: 'Browse Receiver''s Class Hierarchy' - itemValue: browseClassHierarchy - isVisible: false - ) - (MenuItem - enabled: canBrowseFullClassProtocol - label: 'Browse Receiver''s Full Protocol' - itemValue: browseFullClassProtocol - isVisible: false - ) - (MenuItem - label: '-' - isVisible: false - ) - (MenuItem - enabled: canInspectWidgetHierarchy - label: 'Inspect Widget Hierarchy' - itemValue: inspectWidgetHierarchy - ) - ) - nil - nil + ( + (MenuItem + enabled: canBrowseImplementingClass + label: 'Browse Implementing Class' + itemValue: browseImplementingClass + ) + (MenuItem + enabled: canBrowseReceiversClass + label: 'Browse Receiver''s Class' + itemValue: browseReceiversClass + ) + (MenuItem + enabled: canBrowseProcessesApplication + label: 'Browse Application Class' + itemValue: browseProcessesApplication + ) + (MenuItem + label: '-' + ) + (MenuItem + enabled: canBrowseClassHierarchy + label: 'Browse Receiver''s Class Hierarchy' + itemValue: browseClassHierarchy + isVisible: false + ) + (MenuItem + enabled: canBrowseFullClassProtocol + label: 'Browse Receiver''s Full Protocol' + itemValue: browseFullClassProtocol + isVisible: false + ) + (MenuItem + label: '-' + isVisible: false + ) + (MenuItem + enabled: canInspectWidgetHierarchy + label: 'Inspect Widget Hierarchy' + itemValue: inspectWidgetHierarchy + ) + ) + nil + nil ) ! @@ -1049,89 +1049,89 @@ - ^ + ^ #(Menu - ( - (MenuItem - enabled: canReturn - label: 'Return' - itemValue: doReturn - ) - (MenuItem - enabled: canRestart - label: 'Restart' - itemValue: doRestart - ) - (MenuItem - label: '-' - ) - (MenuItem - enabled: hasContextSelected - label: 'Inspect' - itemValue: inspectContext - ) - (MenuItem - label: 'Copy WalkBack Text' - itemValue: copyWalkbackText - ) - (MenuItem - label: 'Inspect Method' - itemValue: inspectContextsMethod - ) - (MenuItem - label: 'Bookmark Method in SystemBrowser' - itemValue: addBrowserBookmark - ) - (MenuItem - label: '-' - ) - (MenuItem - enabled: hasBlockContextSelected - label: 'Find Home Context in Caller Chain...' - itemValue: findHomeContext - ) - (MenuItem - enabled: hasContextSelected - label: 'Find Context with String in Source...' - itemValue: findContextWithStringInSource - ) - (MenuItem - enabled: hasContextSelected - label: 'Find Context with Value in Variable...' - itemValue: findContextWithValueInVariable - ) - (MenuItem - enabled: hasContextSelected - label: 'Find Next Exception Handler' - itemValue: findNextExceptionHandlerContext - ) - (MenuItem - enabled: hasContextSelected - label: 'Find Handler For...' - itemValue: findHandlerFor - ) - (MenuItem - label: 'Find Dialog Opener...' - itemValue: doGotoDialogOpener - ) - (MenuItem - label: 'Find Application Action Method...' - itemValue: doGotoApplicationActionMethod - ) - (MenuItem - label: '-' - ) - (MenuItem - label: 'Remember Callchain && Highlight on Next Entry' - itemValue: rememberCallchain - ) - (MenuItem - label: 'Clear Remembered Callchain' - itemValue: clearRememberedCallchain - ) - ) - nil - nil + ( + (MenuItem + enabled: canReturn + label: 'Return' + itemValue: doReturn + ) + (MenuItem + enabled: canRestart + label: 'Restart' + itemValue: doRestart + ) + (MenuItem + label: '-' + ) + (MenuItem + enabled: hasContextSelected + label: 'Inspect' + itemValue: inspectContext + ) + (MenuItem + label: 'Copy WalkBack Text' + itemValue: copyWalkbackText + ) + (MenuItem + label: 'Inspect Method' + itemValue: inspectContextsMethod + ) + (MenuItem + label: 'Bookmark Method in SystemBrowser' + itemValue: addBrowserBookmark + ) + (MenuItem + label: '-' + ) + (MenuItem + enabled: hasBlockContextSelected + label: 'Find Home Context in Caller Chain...' + itemValue: findHomeContext + ) + (MenuItem + enabled: hasContextSelected + label: 'Find Context with String in Source...' + itemValue: findContextWithStringInSource + ) + (MenuItem + enabled: hasContextSelected + label: 'Find Context with Value in Variable...' + itemValue: findContextWithValueInVariable + ) + (MenuItem + enabled: hasContextSelected + label: 'Find Next Exception Handler' + itemValue: findNextExceptionHandlerContext + ) + (MenuItem + enabled: hasContextSelected + label: 'Find Handler For...' + itemValue: findHandlerFor + ) + (MenuItem + label: 'Find Dialog Opener...' + itemValue: doGotoDialogOpener + ) + (MenuItem + label: 'Find Application Action Method...' + itemValue: doGotoApplicationActionMethod + ) + (MenuItem + label: '-' + ) + (MenuItem + label: 'Remember Callchain && Highlight on Next Entry' + itemValue: rememberCallchain + ) + (MenuItem + label: 'Clear Remembered Callchain' + itemValue: clearRememberedCallchain + ) + ) + nil + nil ) ! @@ -1150,39 +1150,39 @@ - ^ + ^ #(Menu - ( - (MenuItem - enabled: canSendEmail - label: 'Report a Bug via eMail...' - itemValue: doOpenReportMailApp - ) - (MenuItem - label: '-' - ) - (MenuItem - enabled: canCloseAllDebuggers - label: 'Close all Debuggers...' - itemValue: closeAllDebuggers - isVisible: isNotInspecting - ) - (MenuItem - label: '-' - ) - (MenuItem - label: 'Exit' - itemValue: closeRequest - isVisible: isInspecting - ) - (MenuItem - label: 'Close Debugger and Abort' - itemValue: closeRequest - isVisible: isNotInspecting - ) - ) - nil - nil + ( + (MenuItem + enabled: canSendEmail + label: 'Report a Bug via eMail...' + itemValue: doOpenReportMailApp + ) + (MenuItem + label: '-' + ) + (MenuItem + enabled: canCloseAllDebuggers + label: 'Close all Debuggers...' + itemValue: closeAllDebuggers + isVisible: isNotInspecting + ) + (MenuItem + label: '-' + ) + (MenuItem + label: 'Exit' + itemValue: closeRequest + isVisible: isInspecting + ) + (MenuItem + label: 'Close Debugger and Abort' + itemValue: closeRequest + isVisible: isNotInspecting + ) + ) + nil + nil ) ! @@ -1201,24 +1201,24 @@ - ^ + ^ #(Menu - ( - (MenuItem - label: 'Debugger''s Documentation' - itemValue: openHTMLDocument: - argument: 'tools/debugger/TOP.html' - ) - (MenuItem - label: '-' - ) - (MenuItem - label: 'About DebugView...' - itemValue: openAboutThisApplication - ) - ) - nil - nil + ( + (MenuItem + label: 'Debugger''s Documentation' + itemValue: openHTMLDocument: + argument: 'tools/debugger/TOP.html' + ) + (MenuItem + label: '-' + ) + (MenuItem + label: 'About DebugView...' + itemValue: openAboutThisApplication + ) + ) + nil + nil ) ! @@ -1237,45 +1237,45 @@ - ^ + ^ #(Menu - ( - (MenuItem - label: 'File' - submenuChannel: fileMenuSpec - ) - (MenuItem - label: 'View' - submenuChannel: viewMenuSpec - ) - (MenuItem - label: 'Process' - submenuChannel: processMenuSpec - ) - (MenuItem - label: 'Context' - submenuChannel: contextMenuSpec - ) - (MenuItem - label: 'Receiver' - submenuChannel: classMenuSpec - ) - (MenuItem - label: 'Selector' - submenuChannel: selectorMenuSpec - ) - (MenuItem - label: 'Breakpoint' - submenuChannel: breakPointMenuSpec - ) - (MenuItem - label: 'MENU_Help' - startGroup: conditionalRight - submenuChannel: helpMenuSpec - ) - ) - nil - nil + ( + (MenuItem + label: 'File' + submenuChannel: fileMenuSpec + ) + (MenuItem + label: 'View' + submenuChannel: viewMenuSpec + ) + (MenuItem + label: 'Process' + submenuChannel: processMenuSpec + ) + (MenuItem + label: 'Context' + submenuChannel: contextMenuSpec + ) + (MenuItem + label: 'Receiver' + submenuChannel: classMenuSpec + ) + (MenuItem + label: 'Selector' + submenuChannel: selectorMenuSpec + ) + (MenuItem + label: 'Breakpoint' + submenuChannel: breakPointMenuSpec + ) + (MenuItem + label: 'MENU_Help' + startGroup: conditionalRight + submenuChannel: helpMenuSpec + ) + ) + nil + nil ) ! @@ -1294,99 +1294,99 @@ - ^ + ^ #(Menu - ( - (MenuItem - label: 'Continue' - itemValue: doContinue - ) - (MenuItem - label: 'Next (Line-Step)' - itemValue: doNext - ) - (MenuItem - label: 'Step' - itemValue: doStep - ) - (MenuItem - label: '-' - ) - (MenuItem - label: 'After 5 Seconds' - submenu: - (Menu - ( - (MenuItem - label: 'Continue' - itemValue: doContinueAfterDelay - ) - (MenuItem - label: 'Next (Line-Step)' - itemValue: doNextAfterDelay - ) - (MenuItem - label: 'Step' - itemValue: doStepAfterDelay - ) - ) - nil - nil - ) - ) - (MenuItem - label: '-' - ) - (MenuItem - label: 'Skip to Cursor Line' - itemValue: skip - ) - (MenuItem - label: 'Step Out (Skip until Return)' - itemValue: skipForReturn - ) - (MenuItem - label: 'Skip until Entering...' - itemValue: skipUntilEntering - ) - (MenuItem - label: '-' - ) - (MenuItem - label: 'Abort' - itemValue: doAbort - ) - (MenuItem - enabled: abortAllIsHandled - label: 'Abort All' - itemValue: doAbortAll - ) - (MenuItem - label: '-' - ) - (MenuItem - label: 'Inspect' - itemValue: doInspectProcess - ) - (MenuItem - label: 'Change Priority...' - itemValue: doChangeProcessPriority - ) - (MenuItem - label: '-' - ) - (MenuItem - label: 'Terminate' - itemValue: doTerminate - ) - (MenuItem - label: 'Hard Terminate (Danger)' - itemValue: quickTerminate - isVisible: false - ) - ) - nil - nil + ( + (MenuItem + label: 'Continue' + itemValue: doContinue + ) + (MenuItem + label: 'Next (Line-Step)' + itemValue: doNext + ) + (MenuItem + label: 'Step' + itemValue: doStep + ) + (MenuItem + label: '-' + ) + (MenuItem + label: 'After 5 Seconds' + submenu: + (Menu + ( + (MenuItem + label: 'Continue' + itemValue: doContinueAfterDelay + ) + (MenuItem + label: 'Next (Line-Step)' + itemValue: doNextAfterDelay + ) + (MenuItem + label: 'Step' + itemValue: doStepAfterDelay + ) + ) + nil + nil + ) + ) + (MenuItem + label: '-' + ) + (MenuItem + label: 'Skip to Cursor Line' + itemValue: skip + ) + (MenuItem + label: 'Step Out (Skip until Return)' + itemValue: skipForReturn + ) + (MenuItem + label: 'Skip until Entering...' + itemValue: skipUntilEntering + ) + (MenuItem + label: '-' + ) + (MenuItem + label: 'Abort' + itemValue: doAbort + ) + (MenuItem + enabled: abortAllIsHandled + label: 'Abort All' + itemValue: doAbortAll + ) + (MenuItem + label: '-' + ) + (MenuItem + label: 'Inspect' + itemValue: doInspectProcess + ) + (MenuItem + label: 'Change Priority...' + itemValue: doChangeProcessPriority + ) + (MenuItem + label: '-' + ) + (MenuItem + label: 'Terminate' + itemValue: doTerminate + ) + (MenuItem + label: 'Hard Terminate (Danger)' + itemValue: quickTerminate + isVisible: false + ) + ) + nil + nil ) ! @@ -1405,28 +1405,28 @@ - ^ + ^ #(Menu - ( - (MenuItem - label: 'Browse Implementors...' - itemValue: browseImplementorsOf - ) - (MenuItem - label: 'Browse Senders...' - itemValue: browseSendersOf - ) - (MenuItem - label: '-' - ) - (MenuItem - enabled: canDefineMethod - label: 'Define Missing Method' - itemValue: doDefineMethod - ) - ) - nil - nil + ( + (MenuItem + label: 'Browse Implementors...' + itemValue: browseImplementorsOf + ) + (MenuItem + label: 'Browse Senders...' + itemValue: browseSendersOf + ) + (MenuItem + label: '-' + ) + (MenuItem + enabled: canDefineMethod + label: 'Define Missing Method' + itemValue: doDefineMethod + ) + ) + nil + nil ) ! @@ -1445,54 +1445,54 @@ - ^ + ^ #(Menu - ( - (MenuItem - enabled: canShowMore - label: 'Show More WalkBack' - itemValue: showMoreWalkback - ) - (MenuItem - enabled: canShowMore - label: 'Show Full WalkBack' - itemValue: showFullWalkback - ) - (MenuItem - label: '-' - ) - (MenuItem - label: 'Show Dense WalkBack' - itemValue: showingDenseWalkback: - hideMenuOnActivated: false - indication: showingDenseWalkback - ) - (MenuItem - enabled: notShowingDenseWalkbackHolder - label: 'Show Support Code (Implementation of Enumerations, Exceptions etc.)' - itemValue: showingSupportCode: - hideMenuOnActivated: false - indication: showingSupportCode - ) - (MenuItem - label: '-' - ) - (MenuItem - label: 'Raise Debugger when Entering' - itemValue: autoRaiseView: - hideMenuOnActivated: false - indication: autoRaiseView - ) - (MenuItem - label: '-' - ) - (MenuItem - label: 'Settings...' - itemValue: openSettingsDialog - ) - ) - nil - nil + ( + (MenuItem + enabled: canShowMore + label: 'Show More WalkBack' + itemValue: showMoreWalkback + ) + (MenuItem + enabled: canShowMore + label: 'Show Full WalkBack' + itemValue: showFullWalkback + ) + (MenuItem + label: '-' + ) + (MenuItem + label: 'Show Dense WalkBack' + itemValue: showingDenseWalkback: + hideMenuOnActivated: false + indication: showingDenseWalkback + ) + (MenuItem + enabled: notShowingDenseWalkbackHolder + label: 'Show Support Code (Implementation of Enumerations, Exceptions etc.)' + itemValue: showingSupportCode: + hideMenuOnActivated: false + indication: showingSupportCode + ) + (MenuItem + label: '-' + ) + (MenuItem + label: 'Raise Debugger when Entering' + itemValue: autoRaiseView: + hideMenuOnActivated: false + indication: autoRaiseView + ) + (MenuItem + label: '-' + ) + (MenuItem + label: 'Settings...' + itemValue: openSettingsDialog + ) + ) + nil + nil ) ! ! @@ -1512,9 +1512,9 @@ con := aContext. idx := 1. [(idx <= someContexts size) and:[con notNil]] whileTrue:[ - someContexts at:idx put:con. - con := con sender. - idx := idx + 1. + someContexts at:idx put:con. + con := con sender. + idx := idx + 1. ]. "/ search... idx := self interestingContextIndexIn:someContexts. @@ -1544,71 +1544,71 @@ "/ somewhere, at the bottom, there must be a raise ... "/ find the exception 1 to:5 do:[:i | - found isNil ifTrue:[ - con := aContextArray at:i ifAbsent:nil. - con notNil ifTrue:[ - sel := con selector ? ''. - (sel isSymbol - and:[ (sel startsWith:'raise') - and:[ ((rcvr := con receiver) isLazyValue not) - and:[ rcvr isExceptionCreator]]]) ifTrue:[ - offset := i. - found := con. - - "/ if this is a noHandler exception, - "/ skip forward to the erronous context - (rcvr isException) ifTrue:[ - rcvr creator == Signal noHandlerSignal ifTrue:[ - found := rcvr suspendedContext. - offset := aContextArray identityIndexOf:found. - ] - ]. - ]. - ]. - ]. + found isNil ifTrue:[ + con := aContextArray at:i ifAbsent:nil. + con notNil ifTrue:[ + sel := con selector ? ''. + (sel isSymbol + and:[ (sel startsWith:'raise') + and:[ ((rcvr := con receiver) isLazyValue not) + and:[ rcvr isExceptionCreator]]]) ifTrue:[ + offset := i. + found := con. + + "/ if this is a noHandler exception, + "/ skip forward to the erronous context + (rcvr isException) ifTrue:[ + rcvr creator == Signal noHandlerSignal ifTrue:[ + found := rcvr suspendedContext. + offset := aContextArray identityIndexOf:found. + ] + ]. + ]. + ]. + ]. ]. "/ Transcript showCR:con. "/ Transcript show:'1 '; showCR:found. found isNil ifTrue:[ - "/ this is a kludge, but convenient. - "/ show the place where the error (divisionByZero...) happend, - "/ not where the signal was raised. - con := (aContextArray at:1). - sel := con methodHome selector. + "/ this is a kludge, but convenient. + "/ show the place where the error (divisionByZero...) happend, + "/ not where the signal was raised. + con := (aContextArray at:1). + sel := con methodHome selector. "/ Transcript show:'2 '; showCR:con. - "/ typically a DivisionByZero - show caller of division - (sel == #// - or:[sel == #/ - or:[sel == #\\]]) ifTrue:[ - ^ 2 - ]. - - "/ show the place of the bad message; not where the Signal was raised... - (sel == #doesNotUnderstand:) ifTrue:[ - idx := 3. - nMax > 2 ifTrue:[ - sel := (aContextArray at:idx) selector ? ''. - sel == #doesNotUnderstand: ifTrue:[ - idx := 4 - ]. - nMax > idx ifTrue:[ - sel := (aContextArray at:idx) selector ? ''. - "/ show the place of the perfor-send; not where the Signal was raised... - ((sel == #perform:) - or:[sel startsWith:'perform:with']) ifTrue:[ - idx := idx + 1 - ]. - ] - ]. - ^ idx min:nMax - ]. - - "/ show the bad method; not where the Signal was raised... - (sel == #noByteCode) ifTrue:[ - ^ 2 - ]. + "/ typically a DivisionByZero - show caller of division + (sel == #// + or:[sel == #/ + or:[sel == #\\]]) ifTrue:[ + ^ 2 + ]. + + "/ show the place of the bad message; not where the Signal was raised... + (sel == #doesNotUnderstand:) ifTrue:[ + idx := 3. + nMax > 2 ifTrue:[ + sel := (aContextArray at:idx) selector ? ''. + sel == #doesNotUnderstand: ifTrue:[ + idx := 4 + ]. + nMax > idx ifTrue:[ + sel := (aContextArray at:idx) selector ? ''. + "/ show the place of the perfor-send; not where the Signal was raised... + ((sel == #perform:) + or:[sel startsWith:'perform:with']) ifTrue:[ + idx := idx + 1 + ]. + ] + ]. + ^ idx min:nMax + ]. + + "/ show the bad method; not where the Signal was raised... + (sel == #noByteCode) ifTrue:[ + ^ 2 + ]. "/ "/ show the place of the halt; not where the HaltSignal was raised... "/ ((sel == #halt) or:[sel == #halt:]) ifTrue:[ @@ -1632,10 +1632,10 @@ "/ ^ 2 "/ ]. - "/ show the place of signalInterrupt-call; not where the Signal was raised... - (sel == #signalInterrupt:) ifTrue:[ - ^ 2 - ]. + "/ show the place of signalInterrupt-call; not where the Signal was raised... + (sel == #signalInterrupt:) ifTrue:[ + ^ 2 + ]. "/ "/ show the place of error-call; not where the ErrorSignal was raised... "/ ((sel == #error) or:[sel == #error:]) ifTrue:[ @@ -1649,41 +1649,41 @@ "/ ^ 2 "/ ]. - "/ show the place of the bad index; not where the Signal was raised... - ( #(#notIndexed - #indexNotIntegerOrOutOfBounds: - #subscriptBoundsError: - #elementBoundsError: - "/ #subclassResponsibility - ) includes:sel) ifTrue:[ - idx := 2. - [ idx <= 3 - and:[ - sel := (aContextArray at:idx) selector. - #(#notIndexed - #indexNotIntegerOrOutOfBounds: - #subscriptBoundsError: - #elementBoundsError: ) includes:sel - ] - ] whileTrue:[ idx := idx + 1 ]. - sel := (aContextArray at:idx) selector. - (nMax > idx and:[ #(#basicAt: #basicAt:put: #at: #at:put: ) includes:sel]) - ifTrue:[ - sel := (aContextArray at:idx+1) selector. - (nMax > (idx+1) and:[ #(#basicAt: #basicAt:put: #at: #at:put: ) includes:sel]) - ifTrue:[ - sel := (aContextArray at:idx+2) selector. - (nMax > (idx+2) and:[ #(#basicAt: #basicAt:put: #at: #at:put: ) includes:sel]) - ifTrue:[ - ^ idx+3 - ]. - ^ idx+2 - ]. - ^ idx+1 - ]. - ^ idx - ]. - offset := 1. + "/ show the place of the bad index; not where the Signal was raised... + ( #(#notIndexed + #indexNotIntegerOrOutOfBounds: + #subscriptBoundsError: + #elementBoundsError: + "/ #subclassResponsibility + ) includes:sel) ifTrue:[ + idx := 2. + [ idx <= 3 + and:[ + sel := (aContextArray at:idx) selector. + #(#notIndexed + #indexNotIntegerOrOutOfBounds: + #subscriptBoundsError: + #elementBoundsError: ) includes:sel + ] + ] whileTrue:[ idx := idx + 1 ]. + sel := (aContextArray at:idx) selector. + (nMax > idx and:[ #(#basicAt: #basicAt:put: #at: #at:put: ) includes:sel]) + ifTrue:[ + sel := (aContextArray at:idx+1) selector. + (nMax > (idx+1) and:[ #(#basicAt: #basicAt:put: #at: #at:put: ) includes:sel]) + ifTrue:[ + sel := (aContextArray at:idx+2) selector. + (nMax > (idx+2) and:[ #(#basicAt: #basicAt:put: #at: #at:put: ) includes:sel]) + ifTrue:[ + ^ idx+3 + ]. + ^ idx+2 + ]. + ^ idx+1 + ]. + ^ idx + ]. + offset := 1. ]. "/ the above is all too hard-coded; @@ -1692,14 +1692,14 @@ con := aContextArray at:offset ifAbsent:nil. "/ Transcript show:'2 '; showCR:con. [ - con notNil - and:[ (methodHome := con methodHome) notNil - and:[ (method := methodHome method) notNil - and:[ method shouldBeSkippedInDebuggersWalkBack ]]] + con notNil + and:[ (methodHome := con methodHome) notNil + and:[ (method := methodHome method) notNil + and:[ method shouldBeSkippedInDebuggersWalkBack ]]] ] whileTrue:[ "/ Transcript showCR:con methodHome method. - offset := offset + 1. - con := aContextArray at:offset ifAbsent:nil. + offset := offset + 1. + con := aContextArray at:offset ifAbsent:nil. ]. methodHome := nil. "/ help GC @@ -1710,14 +1710,14 @@ prev := nil. rcvr := con receiver. [ - rcvr isLazyValue not and:[(rcvr isExceptionHandler) or:[(rcvr isException)]] + rcvr isLazyValue not and:[(rcvr isExceptionHandler) or:[(rcvr isException)]] ] whileTrue:[ - prev := con. - nMax > offset ifFalse:[^ offset]. - - offset := offset + 1. - con := aContextArray at:offset. - rcvr := con receiver. + prev := con. + nMax > offset ifFalse:[^ offset]. + + offset := offset + 1. + con := aContextArray at:offset. + rcvr := con receiver. ]. " @@ -1726,37 +1726,37 @@ "/ Transcript show:'3 '; showCR:con. (con selector == #retry:coercing:) ifTrue:[ - "/ show the operation which failed to coerce, not the coerce - ^ offset + 1 + "/ show the operation which failed to coerce, not the coerce + ^ offset + 1 ]. " if the sender-method of the raise is one of object's error methods ... " ( #( halt halt: - error error: - doesNotUnderstand: - subclassResponsibility - primitiveFailed) includes:con selector) + error error: + doesNotUnderstand: + subclassResponsibility + primitiveFailed) includes:con selector) ifTrue:[ - con selector == #doesNotUnderstand: ifTrue:[ - " - one more up, to get to the originating context - " - con := aContextArray at:(offset + 1). - con isNil ifTrue:[^ offset]. - offset := offset + 1. - ]. - con := aContextArray at:(offset + 1). - con isNil ifTrue:[^ offset]. - offset := offset + 1. + con selector == #doesNotUnderstand: ifTrue:[ + " + one more up, to get to the originating context + " + con := aContextArray at:(offset + 1). + con isNil ifTrue:[^ offset]. + offset := offset + 1. + ]. + con := aContextArray at:(offset + 1). + con isNil ifTrue:[^ offset]. + offset := offset + 1. ] ifFalse:[ - " - ok, got the raise - if its a BreakPoint, look for the sender - " - (prev notNil and:[prev receiver == BreakPointInterrupt]) ifTrue:[ - offset := offset + 1 - ]. + " + ok, got the raise - if its a BreakPoint, look for the sender + " + (prev notNil and:[prev receiver == BreakPointInterrupt]) ifTrue:[ + offset := offset + 1 + ]. ]. ^ offset @@ -1779,7 +1779,7 @@ verboseBacktraceHolder verboseBacktraceHolder isNil ifTrue:[ - verboseBacktraceHolder := ValueHolder with:false + verboseBacktraceHolder := ValueHolder with:false ]. ^ verboseBacktraceHolder ! ! @@ -1791,30 +1791,30 @@ m := contextView middleButtonMenu. m notNil ifTrue:[ - self updateMenuItems. - - (inspecting or:[AbortOperationRequest isHandled]) ifTrue:[ - abortButton enable. - m enable:#doAbort. - ] ifFalse:[ - abortButton disable. - m disable:#doAbort. - ]. - exclusive ifTrue:[ - terminateButton disable. - m disable:#doTerminate. - ] ifFalse:[ - terminateButton enable. - m enable:#doTerminate. - ] + self updateMenuItems. + + (inspecting or:[AbortOperationRequest isHandled]) ifTrue:[ + abortButton enable. + m enable:#doAbort. + ] ifFalse:[ + abortButton disable. + m disable:#doAbort. + ]. + exclusive ifTrue:[ + terminateButton disable. + m disable:#doTerminate. + ] ifFalse:[ + terminateButton enable. + m enable:#doTerminate. + ] ]. mayProceed == false ifTrue:[ - continueButton disable. - m notNil ifTrue:[m disable:#doContinue]. + continueButton disable. + m notNil ifTrue:[m disable:#doContinue]. ] ifFalse:[ - continueButton enable. - m notNil ifTrue:[m enable:#doContinue] + continueButton enable. + m notNil ifTrue:[m enable:#doContinue] ]. "Created: / 16.11.2001 / 17:40:51 / cg" @@ -1826,8 +1826,8 @@ ^ self - enter:thisContext sender - select: nil. + enter:thisContext sender + select: nil. "Modified: / 28-08-2012 / 21:13:48 / Jan Vrany " ! @@ -1841,46 +1841,46 @@ |con m enteredByInterrupt sel iAmNew foundNoByteCodeContext foundExitContext c| DebuggingDebugger == true ifTrue:[ - '==> enter2: (' print. aContext print. - ') select: ' print. initialSelectionOrNil printCR. + '==> enter2: (' print. aContext print. + ') select: ' print. initialSelectionOrNil printCR. ]. thisContext isRecursive ifTrue:[ - "/ care for the special case, were the Debugger was autoloaded. - "/ in this case, thisContext IS recursive, but thats no error - "/ condition. - foundNoByteCodeContext := false. - foundExitContext := false. - - c := thisContext findNextContextWithSelector:#enter:withMessage:mayProceed: or:#noByteCode or:#exit_unwindThenDo:. - [ - foundNoByteCodeContext not - and:[ foundExitContext not - and:[c notNil - and:[c selector ~~ #enter:withMessage:mayProceed: - ]]]] - whileTrue:[ - c selector == #exit_unwindThenDo: ifTrue:[ - foundExitContext := true - ]. - c selector == #noByteCode ifTrue:[ - foundNoByteCodeContext := true - ]. - c := c findNextContextWithSelector:#enter:withMessage:mayProceed: or:#noByteCode or:#exit_unwindThenDo:. - ]. - - (foundNoByteCodeContext not - and:[ foundExitContext not]) ifFalse:[ - ('DebugView [warning]: reentered') errorPrintCR. - - ^ MiniDebugger - enter:aContext - withMessage:'DebugView [error]: recursive error (in debugger)' - mayProceed:mayProceed. - ]. - foundExitContext ifTrue:[ - 'DebugView [error]: recursive error (in debugger) ignored' printCR. - ^ self. - ]. + "/ care for the special case, were the Debugger was autoloaded. + "/ in this case, thisContext IS recursive, but thats no error + "/ condition. + foundNoByteCodeContext := false. + foundExitContext := false. + + c := thisContext findNextContextWithSelector:#enter:withMessage:mayProceed: or:#noByteCode or:#exit_unwindThenDo:. + [ + foundNoByteCodeContext not + and:[ foundExitContext not + and:[c notNil + and:[c selector ~~ #enter:withMessage:mayProceed: + ]]]] + whileTrue:[ + c selector == #exit_unwindThenDo: ifTrue:[ + foundExitContext := true + ]. + c selector == #noByteCode ifTrue:[ + foundNoByteCodeContext := true + ]. + c := c findNextContextWithSelector:#enter:withMessage:mayProceed: or:#noByteCode or:#exit_unwindThenDo:. + ]. + + (foundNoByteCodeContext not + and:[ foundExitContext not]) ifFalse:[ + ('DebugView [warning]: reentered') errorPrintCR. + + ^ MiniDebugger + enter:aContext + withMessage:'DebugView [error]: recursive error (in debugger)' + mayProceed:mayProceed. + ]. + foundExitContext ifTrue:[ + 'DebugView [error]: recursive error (in debugger) ignored' printCR. + ^ self. + ]. ]. "/'entering: ' print. aContext printCR. @@ -1888,7 +1888,7 @@ thisContext sender fixAllLineNumbers. "/ _CONTEXTLINENOS(s) (self isHaltToBeIgnored) ifTrue:[ - ^ self. + ^ self. ]. "/ "/ does not work yet - but we should ignore any breakpoints while stepping "/ (stepping and:[steppedContext notNil]) ifTrue:[ @@ -1918,50 +1918,50 @@ "/ but not for multi-user development, where the debugger is entered often. "/ What is a good solution to this dilemma ? Screen allScreens do:[:aScreen | - aScreen ungrabPointer. - aScreen ungrabKeyboard. + aScreen ungrabPointer. + aScreen ungrabKeyboard. ]. ("inspectedProcess suspendedContext isNil or:["inspectedProcess isSystemProcess"]") ifTrue:[ - terminateButton disable. + terminateButton disable. ] ifFalse:[ - terminateButton enable. - abortButton enable. + terminateButton enable. + abortButton enable. ]. iAmNew ifFalse:[ - "/ not the first time - disable buttons & menus - "/ from the previous life - self turnOffAllButtons. - - m := contextView middleButtonMenu. - m notNil ifTrue:[ - m disableAll:#(showMore "skip skipForReturn" inspectContext). - ]. - self showingDenseWalkback:(self verboseBacktraceHolder value not). + "/ not the first time - disable buttons & menus + "/ from the previous life + self turnOffAllButtons. + + m := contextView middleButtonMenu. + m notNil ifTrue:[ + m disableAll:#(showMore "skip skipForReturn" inspectContext). + ]. + self showingDenseWalkback:(self verboseBacktraceHolder value not). ]. self iconLabel:'Debugger'. windowGroup isNil ifTrue:[ - self windowGroup: WindowGroup new. - windowGroup addTopView:self. + self windowGroup: WindowGroup new. + windowGroup addTopView:self. ]. exclusive ifFalse:[ - "/ create a (modal) windowGroup for myself - - windowGroup setModal:true. + "/ create a (modal) windowGroup for myself + + windowGroup setModal:true. ] ifTrue:[ - "/ create a windowGroup with a synchronous sensor for me - - windowGroup beSynchronous. + "/ create a windowGroup with a synchronous sensor for me + + windowGroup beSynchronous. ]. windowGroup setProcess:Processor activeProcess. IsDebuggingQuery answer:true do:[ - " - get the walkback list; clear inspectors if we did not come here by single stepping) - " + " + get the walkback list; clear inspectors if we did not come here by single stepping) + " "/Transcript show:'0 '; showCR:aContext. "/Transcript show:'0 '; showCR:thisContext sender. "/Transcript show:'0 '; showCR:thisContext sender sender. @@ -1975,28 +1975,28 @@ "/Transcript show:'0 '; showCR:thisContext sender sender sender sender sender sender sender sender sender sender. "/Transcript show:'0 '; showCR:thisContext sender sender sender sender sender sender sender sender sender sender sender. "/Transcript showCR:initialSelectionOrNil. - self setContext:aContext releaseInspectors:(exitAction ~~ #step). - "/'after setContext; first is ' print. - "/(contextArray at:1 ifAbsent:nil) printCR. - self setInitialSelectionOnEntry:initialSelectionOrNil context:aContext. - - self updateButtonsAndMenuItemsForContext:aContext. - - " - If this is a new debugger, do a realize. - Otherwise, its probably better to do a map, which shows the - view at the previous position, without a need for the user to set the - position again - " - iAmNew ifTrue:[ - self realize. - ] ifFalse:[ - self remap. - ]. - self setForegroundWindow. - - exclusive ifTrue:[ - self showError:' + self setContext:aContext releaseInspectors:(exitAction ~~ #step). + "/'after setContext; first is ' print. + "/(contextArray at:1 ifAbsent:nil) printCR. + self setInitialSelectionOnEntry:initialSelectionOrNil context:aContext. + + self updateButtonsAndMenuItemsForContext:aContext. + + " + If this is a new debugger, do a realize. + Otherwise, its probably better to do a map, which shows the + view at the previous position, without a need for the user to set the + position again + " + iAmNew ifTrue:[ + self realize. + ] ifFalse:[ + self remap. + ]. + self setForegroundWindow. + + exclusive ifTrue:[ + self showError:' Debugging system process `' , (inspectedProcess nameOrId) printString , '''. This is a modal debugger - all event processing is stopped.. @@ -2004,28 +2004,28 @@ open any other tools while this debugger is active. Also, there is no event processing (redraw) for other views.' - ]. - - self autoRaiseView ifTrue:[ - "/ self raise. - self raiseDeiconified. - self topView activate; setForegroundWindow; activate. - ]. - - canContinue := true. - exitAction := nil. - - "/ enter private event handling loop. This is left (and we come back here again) - "/ when any button was pressed which requires continuation of the debuggee or - "/ closedown of the debugger. - [self controlLoop] ifCurtailed:[ - windowGroup notNil ifTrue:[ - windowGroup setProcess:nil. - ]. - NumberOfDebuggers := (NumberOfDebuggers ? 1) - 1. - self destroy - ]. - NumberOfDebuggers := (NumberOfDebuggers ? 1) - 1. + ]. + + self autoRaiseView ifTrue:[ + "/ self raise. + self raiseDeiconified. + self topView activate; setForegroundWindow; activate. + ]. + + canContinue := true. + exitAction := nil. + + "/ enter private event handling loop. This is left (and we come back here again) + "/ when any button was pressed which requires continuation of the debuggee or + "/ closedown of the debugger. + [self controlLoop] ifCurtailed:[ + windowGroup notNil ifTrue:[ + windowGroup setProcess:nil. + ]. + NumberOfDebuggers := (NumberOfDebuggers ? 1) - 1. + self destroy + ]. + NumberOfDebuggers := (NumberOfDebuggers ? 1) - 1. ]. "/ here after my own control loop is finished. @@ -2038,34 +2038,34 @@ codeView doItAction:nil. ObjectMemory stepInterruptHandler == self ifTrue:[ - ObjectMemory stepInterruptHandler:nil. + ObjectMemory stepInterruptHandler:nil. ]. lastSelectionInReceiverInspector := receiverInspector selectedKeyName. lastSelectionInContextInspector := contextInspector selectedKeyName. (exitAction ~~ #step) ifTrue:[ - "/ not stepping or continue - close window - self cacheMyself. - receiverInspector release. - contextInspector release. - - self unmap. - self flush. - - (exitAction == #abort) ifTrue:[ self exit_abort. "does not return" ]. - (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:[ - self exit_unwindThenDo:exitAction. - "does not return" - ]. - "not reached" - ^ self + "/ not stepping or continue - close window + self cacheMyself. + receiverInspector release. + contextInspector release. + + self unmap. + self flush. + + (exitAction == #abort) ifTrue:[ self exit_abort. "does not return" ]. + (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:[ + self exit_unwindThenDo:exitAction. + "does not return" + ]. + "not reached" + ^ self ]. "/ stepping - window stays open @@ -2073,96 +2073,96 @@ "/ restore the previous pointer grab grabber notNil ifTrue:[ - self graphicsDevice grabPointerInView:grabber. - grabber := nil. + self graphicsDevice grabPointerInView:grabber. + grabber := nil. ]. (exitAction == #step) ifTrue:[ - " - schedule another stepInterrupt - - must enter myself into the collection of open debuggers, - in case the stepping process comes back again via a halt or signal - before the step is finished. In this case, the stepping debugger should - come up (instead of a new one) - - must flush caches since optimized methods not always - look for pending interrupts - " - - "/ - "/ also must care for stepping into a return - "/ - steppedContext notNil ifTrue:[ - Processor activeProcess forceInterruptOnReturnOf:steppedContext. - ]. - - OpenDebuggers isNil ifTrue:[ - OpenDebuggers := WeakIdentitySet new. - ]. - OpenDebuggers add:self. - - self label:'single stepping - please wait ...'. - stepping := true. - - ObjectMemory stepInterruptHandler:self. - Processor activeProcess stepInterruptHandler:self. - ObjectMemory flushCaches. - - Context singleStepInterruptRequest isHandled ifTrue:[ - Context singleStepInterruptRequest - raiseWith: - (("bigStep" steppedContextLineno notNil) - ifTrue:[#next] - ifFalse:[#step]) - ] ifFalse:[ - "/ see if we came here through an interrupt-action - "/ (i.e. aProcess interruptWith:...) - - enteredByInterrupt := false. - con := thisContext findNextContextWithSelector:#timerInterrupt or:#ioInterrupt or:nil. - [enteredByInterrupt not - and:[con notNil - and:[con ~~ aContext]]] whileTrue:[ - ((sel := con selector) == #timerInterrupt - or:[sel == #ioInterrupt]) ifTrue:[ - enteredByInterrupt := true. - ] ifFalse:[ - con := con findNextContextWithSelector:#timerInterrupt or:#ioInterrupt or:nil. - ]. - ]. - - ObjectMemory flushInlineCaches. - - DebuggingDebugger == true ifTrue:[ - enteredByInterrupt printCR. - ]. - enteredByInterrupt ifTrue:[ - "/ don't want to step through all intermediate - "/ (scheduler-) contexts; place a return-trap on the - "/ one right below the interesting one + " + schedule another stepInterrupt + - must enter myself into the collection of open debuggers, + in case the stepping process comes back again via a halt or signal + before the step is finished. In this case, the stepping debugger should + come up (instead of a new one) + - must flush caches since optimized methods not always + look for pending interrupts + " + + "/ + "/ also must care for stepping into a return + "/ + steppedContext notNil ifTrue:[ + Processor activeProcess forceInterruptOnReturnOf:steppedContext. + ]. + + OpenDebuggers isNil ifTrue:[ + OpenDebuggers := WeakIdentitySet new. + ]. + OpenDebuggers add:self. + + self label:'single stepping - please wait ...'. + stepping := true. + + ObjectMemory stepInterruptHandler:self. + Processor activeProcess stepInterruptHandler:self. + ObjectMemory flushCaches. + + Context singleStepInterruptRequest isHandled ifTrue:[ + Context singleStepInterruptRequest + raiseWith: + (("bigStep" steppedContextLineno notNil) + ifTrue:[#next] + ifFalse:[#step]) + ] ifFalse:[ + "/ see if we came here through an interrupt-action + "/ (i.e. aProcess interruptWith:...) + + enteredByInterrupt := false. + con := thisContext findNextContextWithSelector:#timerInterrupt or:#ioInterrupt or:nil. + [enteredByInterrupt not + and:[con notNil + and:[con ~~ aContext]]] whileTrue:[ + ((sel := con selector) == #timerInterrupt + or:[sel == #ioInterrupt]) ifTrue:[ + enteredByInterrupt := true. + ] ifFalse:[ + con := con findNextContextWithSelector:#timerInterrupt or:#ioInterrupt or:nil. + ]. + ]. + + ObjectMemory flushInlineCaches. + + DebuggingDebugger == true ifTrue:[ + enteredByInterrupt printCR. + ]. + enteredByInterrupt ifTrue:[ + "/ don't want to step through all intermediate + "/ (scheduler-) contexts; place a return-trap on the + "/ one right below the interesting one "/ 'special unwind return' printCR. - con unwindThenDo:[ - Processor activeProcess stepInterruptHandler:self. - ObjectMemory stepInterruptHandler:self. - InStepInterrupt := nil. - StepInterruptPending := 1. - InterruptPending := 1]. - ] ifFalse:[ + con unwindThenDo:[ + Processor activeProcess stepInterruptHandler:self. + ObjectMemory stepInterruptHandler:self. + InStepInterrupt := nil. + StepInterruptPending := 1. + InterruptPending := 1]. + ] ifFalse:[ "/ 'normal step return' printCR. - skipLineNr ~~ #return ifTrue:[ - StepInterruptPending := 1. - InterruptPending := 1. - ] ifFalse:[ + skipLineNr ~~ #return ifTrue:[ + StepInterruptPending := 1. + InterruptPending := 1. + ] ifFalse:[ "/ 'step for return' printCR. - ] - ]. - InStepInterrupt := nil - ] + ] + ]. + InStepInterrupt := nil + ] ] ifFalse:[ - OpenDebuggers notNil ifTrue:[ - OpenDebuggers remove:self ifAbsent:[]. - ]. - self cacheMyself. + OpenDebuggers notNil ifTrue:[ + OpenDebuggers remove:self ifAbsent:[]. + ]. + self cacheMyself. ] "Modified: / 17-04-1997 / 13:01:32 / stefan" @@ -2207,19 +2207,19 @@ |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 + 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 ] ! @@ -2227,19 +2227,19 @@ |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 unwindAndRestart. - ]. - 'DebugView [warning]: cannot restart selected context' errorPrintCR + 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 unwindAndRestart. + ]. + 'DebugView [warning]: cannot restart selected context' errorPrintCR ] "Created: / 16-11-2001 / 17:23:17 / cg" @@ -2252,10 +2252,10 @@ retVal := nil. selectedContext notNil ifTrue:[ - " - if there is a selection in the codeView, - evaluate it and use the result as return value - " + " + if there is a selection in the codeView, + evaluate it and use the result as return value + " "/ disabled for now, there is almost always a selection (the current line) "/ and that is syntactically incorrect ... "/ ... leading to a popup warning from the codeView @@ -2273,19 +2273,19 @@ "/ ]. "/ ]. - 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 unwind:retVal. - ]. - 'DebugView [warning]: cannot return from selected context' errorPrintCR + 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 unwind:retVal. + ]. + 'DebugView [warning]: cannot return from selected context' errorPrintCR ] "Created: / 16.11.2001 / 17:22:24 / cg" @@ -2298,12 +2298,12 @@ have to catch errors occuring in unwind-blocks " Error handle:[:ex | - 'DebugView [info]: ignored error while unwinding: ' infoPrint. - ex description infoPrintCR. - ex proceed + 'DebugView [info]: ignored error while unwinding: ' infoPrint. + ex description infoPrintCR. + ex proceed ] do:[ - self cacheMyself. - Processor activeProcess terminate. + self cacheMyself. + Processor activeProcess terminate. ]. 'DebugView [warning]: cannot terminate process' errorPrintCR @@ -2329,24 +2329,24 @@ con := thisContext sender. Error handle:[:ex | - 'DebugView [info]: ignored error while unwinding: ' infoPrint. - ex description infoPrintCR. - ex proceed + 'DebugView [info]: ignored error while unwinding: ' infoPrint. + ex description infoPrintCR. + ex proceed ] do:[ - "/ find the enter:select context. - [(con selector ~~ #enter:select:) or:[con receiver ~~ self]] whileTrue:[ - con := con sender - ]. - - "/ must skip over its caller (because this one has a ControlInterrupt handler too) - con sender receiver == self class ifTrue:[ - con := con sender. - con sender receiver == self class ifTrue:[ - con := con sender methodHome. - ]. - ]. - - con unwindThenDo:aBlock. + "/ find the enter:select context. + [(con selector ~~ #enter:select:) or:[con receiver ~~ self]] whileTrue:[ + con := con sender + ]. + + "/ must skip over its caller (because this one has a ControlInterrupt handler too) + con sender receiver == self class ifTrue:[ + con := con sender. + con sender receiver == self class ifTrue:[ + con := con sender methodHome. + ]. + ]. + + con unwindThenDo:aBlock. ]. 'DebugView [warning]: abort failed' errorPrintCR @@ -2358,7 +2358,7 @@ |selection con1 con2 h| initialSelectionOrNil notNil ifTrue:[ - ^ initialSelectionOrNil + ^ initialSelectionOrNil ]. " @@ -2375,55 +2375,55 @@ "/ came here via a step? exitAction == #step ifTrue:[ - selection := 1. - steppedContext notNil ifTrue:[ - - " - if we came here by a big-step, show the method where we are - " - con1 == steppedContext ifTrue:[ - selection := 1 - ] ifFalse:[ - con2 == steppedContext ifTrue:[ - selection := 2 - ] - ]. - " - for bigStep, we could also be in a block below the actual method ... - " - ((h := con1 home) notNil - and:[h == steppedContext]) ifTrue:[ - selection := 1 - ] ifFalse:[ - (con2 notNil - and:[(h := con2 home) notNil - and:[h == steppedContext]]) ifTrue:[ - selection := 2 - ] - ]. - h := nil. - ] + selection := 1. + steppedContext notNil ifTrue:[ + + " + if we came here by a big-step, show the method where we are + " + con1 == steppedContext ifTrue:[ + selection := 1 + ] ifFalse:[ + con2 == steppedContext ifTrue:[ + selection := 2 + ] + ]. + " + for bigStep, we could also be in a block below the actual method ... + " + ((h := con1 home) notNil + and:[h == steppedContext]) ifTrue:[ + selection := 1 + ] ifFalse:[ + (con2 notNil + and:[(h := con2 home) notNil + and:[h == steppedContext]]) ifTrue:[ + selection := 2 + ] + ]. + h := nil. + ] ] ifFalse:[ - steppedContext isNil ifTrue:[ - " - preselect a more interesting context, (where halt/raise was ...) - " - "/ selection := self class interestingContextIndexFrom:aContext. - selection := self class interestingContextIndexIn:contextArray. + steppedContext isNil ifTrue:[ + " + preselect a more interesting context, (where halt/raise was ...) + " + "/ selection := self class interestingContextIndexFrom:aContext. + selection := self class interestingContextIndexIn:contextArray. "/ Transcript show:'x '; showCR:selection. - selection := selection min:(contextArray size). - ] ifFalse:[ - " - if we came here by a big-step, show the method where we are - " - con1 == steppedContext ifTrue:[ - selection := 1 - ] ifFalse:[ - con2 == steppedContext ifTrue:[ - selection := 2. - ] - ] - ] + selection := selection min:(contextArray size). + ] ifFalse:[ + " + if we came here by a big-step, show the method where we are + " + con1 == steppedContext ifTrue:[ + selection := 1 + ] ifFalse:[ + con2 == steppedContext ifTrue:[ + selection := 2. + ] + ] + ] ]. ^ selection @@ -2468,17 +2468,17 @@ continueButton preferredExtent:(w @ continueButton preferredHeight). aProcess state == #run ifTrue:[ - self graphicsDevice hasColors ifTrue:[ - continueButton foregroundColor:Color red darkened. - ]. - continueButton label:(resources string:'Stop'). - continueButton action:[self doStop]. + self graphicsDevice hasColors ifTrue:[ + continueButton foregroundColor:Color red darkened. + ]. + continueButton label:(resources string:'Stop'). + continueButton action:[self doStop]. ] ifFalse:[ - self graphicsDevice hasColors ifTrue:[ - continueButton foregroundColor:Color green darkened darkened. - ]. - continueButton label:(resources string:'Continue'). - continueButton action:[self doContinue]. + self graphicsDevice hasColors ifTrue:[ + continueButton foregroundColor:Color green darkened darkened. + ]. + continueButton label:(resources string:'Continue'). + continueButton action:[self doContinue]. ]. continueButton preferredExtent:(w @ continueButton preferredHeight). @@ -2492,9 +2492,9 @@ "/ sendButton destroy. updateButton := Button - label:(resources string:'Update') - action:[self updateContext] - in:bpanel. + label:(resources string:'Update') + action:[self updateContext] + in:bpanel. monitorToggle := Toggle in:bpanel. monitorToggle label:(resources string:'Monitor'). monitorToggle pressAction:[self autoUpdateOn]. @@ -2513,33 +2513,33 @@ nextOutButton notNil ifTrue:[nextOutButton disable; beInvisible]. aProcess isNil ifTrue:[ - terminateButton disable. - abortButton disable. - continueButton disable. - returnButton disable. - restartButton disable. + terminateButton disable. + abortButton disable. + continueButton disable. + returnButton disable. + restartButton disable. ] ifFalse:[ - (aProcess suspendedContext isNil - or:[aProcess isSystemProcess]) ifTrue:[ - terminateButton disable. - ]. - - self setContextSkippingInterruptContexts:aProcess suspendedContext. - - catchBlock := [ - catchBlock := nil. - contextArray := nil. - selectedContext := actualContext := firstContext := nil. - steppedContext := wrapperContext := nil. - - (exitAction == #terminate) ifTrue:[ - aProcess terminate. - ]. - (exitAction == #quickTerminate) ifTrue:[ - aProcess terminateNoSignal. - ]. - super destroy - ]. + (aProcess suspendedContext isNil + or:[aProcess isSystemProcess]) ifTrue:[ + terminateButton disable. + ]. + + self setContextSkippingInterruptContexts:aProcess suspendedContext. + + catchBlock := [ + catchBlock := nil. + contextArray := nil. + selectedContext := actualContext := firstContext := nil. + steppedContext := wrapperContext := nil. + + (exitAction == #terminate) ifTrue:[ + aProcess terminate. + ]. + (exitAction == #quickTerminate) ifTrue:[ + aProcess terminateNoSignal. + ]. + super destroy + ]. ]. self open @@ -2551,7 +2551,7 @@ self showSelection:index. contextView setSelection:index. index > 1 ifTrue:[ - contextView scrollToLine:(index - 1) + contextView scrollToLine:(index - 1) ]. ! @@ -2560,7 +2560,7 @@ selection := self initialSelectionOnEntry:initialSelectionOrNil context:aContext. selection notNil ifTrue:[ - self selectContextWithIndex:selection + self selectContextWithIndex:selection ]. "Created: / 16.11.2001 / 17:28:07 / cg" @@ -2593,72 +2593,72 @@ |s| aComponent == abortButton ifTrue:[ - s := 'Abort (unwind to eventLoop)' + s := 'Abort (unwind to eventLoop)' ]. aComponent == terminateButton ifTrue:[ - Processor activeProcess isGUIProcess ifTrue:[ - s := 'Terminate the process (closes view and shuts down application)' - ] ifFalse:[ - s := 'Terminate the process' - ] + Processor activeProcess isGUIProcess ifTrue:[ + s := 'Terminate the process (closes view and shuts down application)' + ] ifFalse:[ + s := 'Terminate the process' + ] ]. aComponent == continueButton ifTrue:[ - continueButton label = (resources string:'Stop') ifTrue:[ - s := 'Stop' - ] ifFalse:[ - s := 'Continue execution' - ] + continueButton label = (resources string:'Stop') ifTrue:[ + s := 'Stop' + ] ifFalse:[ + s := 'Continue execution' + ] ]. aComponent == stepButton ifTrue:[ - s := 'Step to next send in selected context (don''t enter into called methods)' + s := 'Step to next send in selected context (don''t enter into called methods)' ]. aComponent == nextButton ifTrue:[ - s := 'Step to next line in selected context (don''t enter into called methods)' + s := 'Step to next line in selected context (don''t enter into called methods)' ]. aComponent == nextOverButton ifTrue:[ - s := 'Step over to cursor-line' + s := 'Step over to cursor-line' ]. aComponent == nextOutButton ifTrue:[ - s := 'Step out to caller' + s := 'Step out to caller' ]. aComponent == sendButton ifTrue:[ - s := 'Send next message (enter into called methods)' + s := 'Send next message (enter into called methods)' ]. aComponent == returnButton ifTrue:[ - restartButton enabled ifTrue:[ - s := 'Return from the selected method' - ] ifFalse:[ - s := 'Return from the selected method.\Disabled, because this method was compiled with context optimization, and cannot be returned from.' withCRs - ] + restartButton enabled ifTrue:[ + s := 'Return from the selected method' + ] ifFalse:[ + s := 'Return from the selected method.\Disabled, because this method was compiled with context optimization, and cannot be returned from.' withCRs + ] ]. aComponent == restartButton ifTrue:[ - restartButton enabled ifTrue:[ - s := 'Restart the selected method.\If the code was changed in the meanwhile, the original method will be executed again' - ] ifFalse:[ - s := 'Restart the selected method.\Disabled, because this method was compiled with context optimization, and cannot be returned from.' withCRs - ] + restartButton enabled ifTrue:[ + s := 'Restart the selected method.\If the code was changed in the meanwhile, the original method will be executed again' + ] ifFalse:[ + s := 'Restart the selected method.\Disabled, because this method was compiled with context optimization, and cannot be returned from.' withCRs + ] ]. aComponent == resendButton ifTrue:[ - resendButton enabled ifTrue:[ - s := 'Resend the selected method''s message.\If the code was changed in the meanwhile, the new method will be called with the original arguments.' - ] ifFalse:[ - s := 'Resend the selected method''s message.\Disabled, because this method was compiled with context optimization, and cannot be returned from.' withCRs - ] + resendButton enabled ifTrue:[ + s := 'Resend the selected method''s message.\If the code was changed in the meanwhile, the new method will be called with the original arguments.' + ] ifFalse:[ + s := 'Resend the selected method''s message.\Disabled, because this method was compiled with context optimization, and cannot be returned from.' withCRs + ] ]. aComponent == monitorToggle ifTrue:[ - s := 'Toggle monitoring' + s := 'Toggle monitoring' ]. aComponent == updateButton ifTrue:[ - s := 'Update' + s := 'Update' ]. aComponent == defineButton ifTrue:[ - s := 'Define the missing method (as halting) and proceed into it.\A debugger will reopen there, so you can add the code then' + s := 'Define the missing method (as halting) and proceed into it.\A debugger will reopen there, so you can add the code then' ]. aComponent == reportButton ifTrue:[ - s := 'Send a defect report via eMail' + s := 'Send a defect report via eMail' ]. s notNil ifTrue:[ - ^ resources stringWithCRs:s + ^ resources stringWithCRs:s ]. ^ nil @@ -2681,47 +2681,47 @@ interval := pos to:pos. self - withNodeValueAtInterval:interval - do:[:value :description | - |valueClassOrSizeString valueString| - - valueClassOrSizeString := valueString := ''. - - "/ some heuristics as when to show the class name (a purely subjective preference) - value isString ifTrue:[ - value isText ifTrue:[ - valueString := '"',(value contractTo:80),'"'. - ] ifFalse:[ - valueString := value storeString contractTo:80. - ]. - ] ifFalse:[ - (value isBoolean - or:[ value isInteger - or:[ value isSymbol ]]) ifTrue:[ - valueString := value printString. - ] ifFalse:[ - valueClassOrSizeString := ' (',value class name,')'. - - (value isArray - or:[ value isOrderedCollection ]) ifTrue:[ - valueClassOrSizeString := ' (size=',value size printString,')'. - ]. - - Error handle:[:ex | - valueString := '??? (',ex description,')' - ] do:[ - [ - valueString := value printString contractTo:80. - ] valueWithWatchDog:[ valueString := value classNameWithArticle ] afterMilliseconds:30. - ] - ] - ]. - description isEmptyOrNil ifTrue:[ - s := valueString , valueClassOrSizeString - ] ifFalse:[ - s := description , ': ', valueString, valueClassOrSizeString - ]. - ]. + withNodeValueAtInterval:interval + do:[:value :description | + |valueClassOrSizeString valueString| + + valueClassOrSizeString := valueString := ''. + + "/ some heuristics as when to show the class name (a purely subjective preference) + value isString ifTrue:[ + value isText ifTrue:[ + valueString := '"',(value contractTo:80),'"'. + ] ifFalse:[ + valueString := value storeString contractTo:80. + ]. + ] ifFalse:[ + (value isBoolean + or:[ value isInteger + or:[ value isSymbol ]]) ifTrue:[ + valueString := value printString. + ] ifFalse:[ + valueClassOrSizeString := ' (',value class name,')'. + + (value isArray + or:[ value isOrderedCollection ]) ifTrue:[ + valueClassOrSizeString := ' (size=',value size printString,')'. + ]. + + Error handle:[:ex | + valueString := '??? (',ex description,')' + ] do:[ + [ + valueString := value printString contractTo:80. + ] valueWithWatchDog:[ valueString := value classNameWithArticle ] afterMilliseconds:30. + ] + ] + ]. + description isEmptyOrNil ifTrue:[ + s := valueString , valueClassOrSizeString + ] ifFalse:[ + s := description , ': ', valueString, valueClassOrSizeString + ]. + ]. "/ Transcript showCR:s. ^ s @@ -2732,87 +2732,87 @@ |s| aComponent == abortButton ifTrue:[ - s := 'HELP_ABORT' + s := 'HELP_ABORT' ]. aComponent == terminateButton ifTrue:[ - s := 'HELP_TERMINATE' + s := 'HELP_TERMINATE' ]. aComponent == continueButton ifTrue:[ - continueButton label = (resources string:'Stop') ifTrue:[ - s := 'HELP_STOP' - ] ifFalse:[ - s := 'HELP_CONTINUE' - ] + continueButton label = (resources string:'Stop') ifTrue:[ + s := 'HELP_STOP' + ] ifFalse:[ + s := 'HELP_CONTINUE' + ] ]. aComponent == stepButton ifTrue:[ - s := 'HELP_STEP' + s := 'HELP_STEP' ]. aComponent == nextButton ifTrue:[ - s := 'HELP_NEXT' + s := 'HELP_NEXT' ]. aComponent == nextOverButton ifTrue:[ - s := 'HELP_NEXTOVER' + s := 'HELP_NEXTOVER' ]. aComponent == nextOutButton ifTrue:[ - s := 'HELP_NEXTOUT' + s := 'HELP_NEXTOUT' ]. aComponent == stepButton ifTrue:[ - s := 'HELP_STEP' + s := 'HELP_STEP' ]. aComponent == sendButton ifTrue:[ - s := 'HELP_SEND' + s := 'HELP_SEND' ]. aComponent == returnButton ifTrue:[ - returnButton enabled ifTrue:[ - s := 'HELP_RETURN' - ] ifFalse:[ - s := 'HELP_RETURN_DISABLED' - ]. + returnButton enabled ifTrue:[ + s := 'HELP_RETURN' + ] ifFalse:[ + s := 'HELP_RETURN_DISABLED' + ]. ]. aComponent == restartButton ifTrue:[ - restartButton enabled ifTrue:[ - s := 'HELP_RESTART' - ] ifFalse:[ - s := 'HELP_RESTART_DISABLED' - ]. + restartButton enabled ifTrue:[ + s := 'HELP_RESTART' + ] ifFalse:[ + s := 'HELP_RESTART_DISABLED' + ]. ]. aComponent == resendButton ifTrue:[ - resendButton enabled ifTrue:[ - s := 'HELP_RESEND' - ] ifFalse:[ - s := 'HELP_RESEND_DISABLED' - ]. + resendButton enabled ifTrue:[ + s := 'HELP_RESEND' + ] ifFalse:[ + s := 'HELP_RESEND_DISABLED' + ]. ]. aComponent == contextView ifTrue:[ - s := 'HELP_WALKBACK' + s := 'HELP_WALKBACK' ]. aComponent == codeView ifTrue:[ - s := 'HELP_CODEVIEW' + s := 'HELP_CODEVIEW' ]. aComponent == monitorToggle ifTrue:[ - s := 'HELP_MONITOR' + s := 'HELP_MONITOR' ]. aComponent == updateButton ifTrue:[ - s := 'HELP_UPDATE' + s := 'HELP_UPDATE' ]. aComponent == gotoDialogOpenerButton ifTrue:[ - s := 'HELP_GOTO_DIALOG_OPENER' + s := 'HELP_GOTO_DIALOG_OPENER' ]. aComponent == gotoApplicationActionMethodButton ifTrue:[ - s := 'HELP_GOTO_APPLICATION_ACTION' + s := 'HELP_GOTO_APPLICATION_ACTION' ]. "/ aComponent == stopButton ifTrue:[ "/ s := 'HELP_STOP' "/ ]. (aComponent isComponentOf:receiverInspector) ifTrue:[ - s := 'HELP_REC_INSP' + s := 'HELP_REC_INSP' ]. (aComponent isComponentOf:contextInspector) ifTrue:[ - s := 'HELP_CON_INSP' + s := 'HELP_CON_INSP' ]. s notNil ifTrue:[ - ^ resources stringWithCRs:s + ^ resources stringWithCRs:s ]. ^ nil @@ -2843,45 +2843,45 @@ |m| withConfirmation ifTrue:[ - self checkIfCodeIsReallyModified ifTrue:[ - (self confirm:('Code modified - exit anyway ?')) - ifFalse:[ - ^ self - ] - ] + self checkIfCodeIsReallyModified ifTrue:[ + (self confirm:('Code 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. @@ -2905,7 +2905,7 @@ hideSupportCode := userPrefs hideSupportCodeInDebugger ? false. ignoreBreakpoints := true. "/ ignore halts/breakpoints in doIts of - "/ the debugger + "/ the debugger busy := false. exclusive := false. @@ -2929,102 +2929,102 @@ newLayout := userPrefs useNewLayoutInDebugger. newLayout ifFalse:[ - bpanel := HorizontalPanelView in:self. - - self initializeButtonsIn:bpanel. - - bH := bpanel preferredHeight + 5. - bpanel origin:(0.0 @ mH) - extent:(1.0 @ bH). - panel := VariableVerticalPanel - origin:(0.0 @ (mH + bH)) - corner:(1.0 @ 1.0) - in:self. - - v := self initializeContextListViewIn:panel. - v origin:(0.0 @ 0.0) corner:(1.0 @ 0.25). - - codePanel := View in:panel. - v := self initializeCodeViewIn:codePanel. - v origin:(0.0 @ 0.0) corner:(1.0 @ 1.0). - codePanel origin:(0.0 @ 0.25) corner:(1.0 @ 0.75). - - v := self initializeInspectorViewsIn:panel. - v origin:(0.0 @ 0.75) corner:(1.0 @ 1.0). + bpanel := HorizontalPanelView in:self. + + self initializeButtonsIn:bpanel. + + bH := bpanel preferredHeight + 5. + bpanel origin:(0.0 @ mH) + extent:(1.0 @ bH). + panel := VariableVerticalPanel + origin:(0.0 @ (mH + bH)) + corner:(1.0 @ 1.0) + in:self. + + v := self initializeContextListViewIn:panel. + v origin:(0.0 @ 0.0) corner:(1.0 @ 0.25). + + codePanel := View in:panel. + v := self initializeCodeViewIn:codePanel. + v origin:(0.0 @ 0.0) corner:(1.0 @ 1.0). + codePanel origin:(0.0 @ 0.25) corner:(1.0 @ 0.75). + + v := self initializeInspectorViewsIn:panel. + v origin:(0.0 @ 0.75) corner:(1.0 @ 1.0). ] ifTrue:[ - bpanel1 := HorizontalPanelView in:self. - self initializeButtons1In:bpanel1. - - contextInfoLabel := Label label:''. - contextInfoLabel adjust:#left. - bpanel1 add:contextInfoLabel. - - bH1 := bpanel1 preferredHeight + 5. - bpanel1 origin:(0.0 @ mH) - extent:(1.0 @ bH1). - panel := VariableVerticalPanel - origin:(0.0 @ (mH + bH1)) - corner:(1.0 @ 1.0) - in:self. - "/ panel showHandle:true. - "/ panel handlePosition:#left. - - v := self initializeContextListViewIn:panel. - v origin:(0.0 @ 0.0) corner:(1.0 @ 0.25). - - codePanel := View in:panel. - bpanel2 := HorizontalPanelView in:codePanel. - self initializeButtons2In:bpanel2. - - bH2 := bpanel2 preferredHeight + 5. - bpanel2 origin:(0.0 @ 0.0) - extent:(1.0 @ bH2). - - exceptionInfoLabel := Label label:''. - exceptionInfoLabel adjust:#left. - - exceptionAndTogglePanel := HorizontalPanelView in:codePanel. - exceptionAndTogglePanel horizontalLayout:#left. - exceptionAndTogglePanel - geometryLayout: - ((LayoutFrame - origin:(0.0 @ 0.0) - corner:(1.0 @ 0.0)) - topOffset:bH2; - bottomOffset:(bH2 + exceptionInfoLabel preferredHeight + 6); - rightOffset:-2). - - methodCodeToggleSelectionHolder := 1 asValue. - methodCodeToggleSelectionHolder onChangeSend:#methodCodeToggleChanged to:self. - codeToggleLabels := resources array:{ - 'Showing Original Code (being executed, but obsolete)' asText backgroundColorizeAllWith:Color red lightened . - 'Showing Current Code' asText backgroundColorizeAllWith:Color green lightened . - }. - methodCodeToggle := PopUpList label:codeToggleLabels first in:exceptionAndTogglePanel. - methodCodeToggle list:codeToggleLabels. - methodCodeToggle useIndex:true. - methodCodeToggle model:methodCodeToggleSelectionHolder. - methodCodeToggle beInvisible. - - exceptionAndTogglePanel add:exceptionInfoLabel. - - v := self initializeCodeViewIn:codePanel. - v origin:(0.0 @ (bH2+exceptionInfoLabel preferredHeight+6)) corner:(1.0 @ 1.0). - codePanel origin:(0.0 @ 0.25) corner:(1.0 @ 0.75). - - v := self initializeInspectorViewsIn:panel. - v origin:(0.0 @ 0.75) corner:(1.0 @ 1.0). + bpanel1 := HorizontalPanelView in:self. + self initializeButtons1In:bpanel1. + + contextInfoLabel := Label label:''. + contextInfoLabel adjust:#left. + bpanel1 add:contextInfoLabel. + + bH1 := bpanel1 preferredHeight + 5. + bpanel1 origin:(0.0 @ mH) + extent:(1.0 @ bH1). + panel := VariableVerticalPanel + origin:(0.0 @ (mH + bH1)) + corner:(1.0 @ 1.0) + in:self. + "/ panel showHandle:true. + "/ panel handlePosition:#left. + + v := self initializeContextListViewIn:panel. + v origin:(0.0 @ 0.0) corner:(1.0 @ 0.25). + + codePanel := View in:panel. + bpanel2 := HorizontalPanelView in:codePanel. + self initializeButtons2In:bpanel2. + + bH2 := bpanel2 preferredHeight + 5. + bpanel2 origin:(0.0 @ 0.0) + extent:(1.0 @ bH2). + + exceptionInfoLabel := Label label:''. + exceptionInfoLabel adjust:#left. + + exceptionAndTogglePanel := HorizontalPanelView in:codePanel. + exceptionAndTogglePanel horizontalLayout:#left. + exceptionAndTogglePanel + geometryLayout: + ((LayoutFrame + origin:(0.0 @ 0.0) + corner:(1.0 @ 0.0)) + topOffset:bH2; + bottomOffset:(bH2 + exceptionInfoLabel preferredHeight + 6); + rightOffset:-2). + + methodCodeToggleSelectionHolder := 1 asValue. + methodCodeToggleSelectionHolder onChangeSend:#methodCodeToggleChanged to:self. + codeToggleLabels := resources array:{ + 'Showing Original Code (being executed, but obsolete)' asText backgroundColorizeAllWith:Color red lightened . + 'Showing Current Code' asText backgroundColorizeAllWith:Color green lightened . + }. + methodCodeToggle := PopUpList label:codeToggleLabels first in:exceptionAndTogglePanel. + methodCodeToggle list:codeToggleLabels. + methodCodeToggle useIndex:true. + methodCodeToggle model:methodCodeToggleSelectionHolder. + methodCodeToggle beInvisible. + + exceptionAndTogglePanel add:exceptionInfoLabel. + + v := self initializeCodeViewIn:codePanel. + v origin:(0.0 @ (bH2+exceptionInfoLabel preferredHeight+6)) corner:(1.0 @ 1.0). + codePanel origin:(0.0 @ 0.25) corner:(1.0 @ 0.75). + + v := self initializeInspectorViewsIn:panel. + v origin:(0.0 @ 0.75) corner:(1.0 @ 1.0). ]. DefaultDebuggerBackgroundColor notNil ifTrue:[ - self allViewBackground:DefaultDebuggerBackgroundColor. + self allViewBackground:DefaultDebuggerBackgroundColor. ]. LastExtent notNil ifTrue:[ - self extent:LastExtent. + self extent:LastExtent. ]. LastOrigin notNil ifTrue:[ - self origin:LastOrigin. + self origin:LastOrigin. ]. " @@ -3036,12 +3036,12 @@ initializeAbortButtonIn:bpanel abortButton := Button - label:(resources string:'Abort') - action:[ - abortButton turnOffWithoutRedraw. - self doAbort - ] - in:bpanel. + label:(resources string:'Abort') + action:[ + abortButton turnOffWithoutRedraw. + self doAbort + ] + in:bpanel. "Created: / 17.11.2001 / 20:56:47 / cg" "Modified: / 17.11.2001 / 20:57:17 / cg" @@ -3077,9 +3077,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" ! @@ -3220,7 +3220,7 @@ self initializeDefineButtonIn:bpanel. (UserPreferences current allowSendMailFromDebugger and:[SendMailTool notNil]) ifTrue:[ - self initializeReportButtonIn:bpanel. + self initializeReportButtonIn:bpanel. ]. @@ -3232,62 +3232,62 @@ |scrollableCodeView| (UserPreferences current useCodeView2In: #Debugger) ifTrue:[ - scrollableCodeView := codeView := Tools::CodeView2 new. - codeView model: ValueHolder new. - codeView methodHolder: ValueHolder new. - codeView classHolder: ValueHolder new. + scrollableCodeView := codeView := Tools::CodeView2 new. + codeView model: ValueHolder new. + codeView methodHolder: ValueHolder new. + codeView classHolder: ValueHolder new. ] ifFalse:[ - scrollableCodeView := HVScrollableView - for:CodeView - miniScrollerH:true - miniScrollerV:false - in:panel. - - codeView := scrollableCodeView scrolledView. - codeView enableMotionEvents. "/ for active help - ]. - - (UserPreferences current showAcceptCancelBarInBrowser - and:[codeView isCodeView2 not or:[UserPreferences current codeView2ShowAcceptCancel not]]) ifTrue:[ - ViewWithAcceptAndCancelBar notNil ifTrue:[ - |v| - - v := ViewWithAcceptAndCancelBar new. - v slaveView:scrollableCodeView. - v reallyModifiedHolder:(codeView isCodeView2 - ifTrue:[ codeView reallyModifiedChannel ] - ifFalse:[ - BlockValue - with:[:m | - |same| - - same := (codeView contentsAsString string = currentMethod source string). - codeView modifiedChannel setValue:false. "/ so it triggers again - same not. - ] - argument:codeView modifiedChannel - ]). - v cancelAction: - [ - "/ codeView setClipboardText:(codeView contents). "/ for undo - codeView device rememberInCopyBufferHistory:(codeView contents). "/ for undo - codeView contents:(currentMethod source). - codeView modifiedChannel setValue:false; changed. "/ trigger - codeView requestFocus. - ]. - v compareAction: - [ - v := DiffCodeView - openOn:codeView contentsAsString - label:(resources string:'Changed definition (to be accepted ?)') - and:currentMethod source - label:(resources string:'Method''s Original Code'). - v label:(resources string:'Changed Code in Debugger'). - v waitUntilVisible. - "/ codeView requestFocus - ]. - scrollableCodeView := v. - ] + scrollableCodeView := HVScrollableView + for:CodeView + miniScrollerH:true + miniScrollerV:false + in:panel. + + codeView := scrollableCodeView scrolledView. + codeView enableMotionEvents. "/ for active help + ]. + + (UserPreferences current showAcceptCancelBarInBrowser + and:[codeView isCodeView2 not or:[UserPreferences current codeView2ShowAcceptCancel not]]) ifTrue:[ + ViewWithAcceptAndCancelBar notNil ifTrue:[ + |v| + + v := ViewWithAcceptAndCancelBar new. + v slaveView:scrollableCodeView. + v reallyModifiedHolder:(codeView isCodeView2 + ifTrue:[ codeView reallyModifiedChannel ] + ifFalse:[ + BlockValue + with:[:m | + |same| + + same := (codeView contentsAsString string = currentMethod source string). + codeView modifiedChannel setValue:false. "/ so it triggers again + same not. + ] + argument:codeView modifiedChannel + ]). + v cancelAction: + [ + "/ codeView setClipboardText:(codeView contents). "/ for undo + codeView device rememberInCopyBufferHistory:(codeView contents). "/ for undo + codeView contents:(currentMethod source). + codeView modifiedChannel setValue:false; changed. "/ trigger + codeView requestFocus. + ]. + v compareAction: + [ + v := DiffCodeView + openOn:codeView contentsAsString + label:(resources string:'Changed definition (to be accepted ?)') + and:currentMethod source + label:(resources string:'Method''s Original Code'). + v label:(resources string:'Changed Code in Debugger'). + v waitUntilVisible. + "/ codeView requestFocus + ]. + scrollableCodeView := v. + ] ]. panel add:scrollableCodeView. @@ -3300,10 +3300,10 @@ |v| v := HVScrollableView - for:SelectionInListView - miniScrollerH:true - miniScrollerV:false - in:panel. + for:SelectionInListView + miniScrollerH:true + miniScrollerV:false + in:panel. v autoHideHorizontalScrollBar:true. contextView := v scrolledView. @@ -3324,24 +3324,24 @@ initializeContinueButtonIn:bpanel continueButton := Button - label:(resources string:'Continue') - action:[ - continueButton turnOffWithoutRedraw. - self doContinue - ] - in:bpanel. + label:(resources string:'Continue') + action:[ + continueButton turnOffWithoutRedraw. + self doContinue + ] + in:bpanel. "Created: / 17.11.2001 / 20:57:34 / cg" ! initializeDefineButtonIn:bpanel defineButton := Button - label:(resources string:'Define') - action:[ - defineButton turnOffWithoutRedraw. - self doDefine - ] - in:bpanel. + label:(resources string:'Define') + action:[ + defineButton turnOffWithoutRedraw. + self doDefine + ] + in:bpanel. defineButton beInvisible "Created: / 17.11.2001 / 21:02:48 / cg" @@ -3349,24 +3349,24 @@ initializeGotoApplicationActionMethodButtonIn:bpanel gotoApplicationActionMethodButton := Button - label:(resources string:'Goto Responsible Application Method') - action:[ - gotoApplicationActionMethodButton turnOffWithoutRedraw. - self doGotoApplicationActionMethod - ] - in:bpanel. + label:(resources string:'Goto Responsible Application Method') + action:[ + gotoApplicationActionMethodButton turnOffWithoutRedraw. + self doGotoApplicationActionMethod + ] + in:bpanel. gotoApplicationActionMethodButton beInvisible ! initializeGotoDialogOpenerButtonIn:bpanel gotoDialogOpenerButton := Button - label:(resources string:'Goto Dialog Opener') - action:[ - gotoDialogOpenerButton turnOffWithoutRedraw. - self doGotoDialogOpener - ] - in:bpanel. + label:(resources string:'Goto Dialog Opener') + action:[ + gotoDialogOpenerButton turnOffWithoutRedraw. + self doGotoDialogOpener + ] + in:bpanel. gotoDialogOpenerButton beInvisible ! @@ -3377,13 +3377,13 @@ hpanel := VariableHorizontalPanel in:panel. receiverInspector := InspectorView - origin:(0.0 @ 0.0) corner:(0.5 @ 1.0) - in:hpanel. + origin:(0.0 @ 0.0) corner:(0.5 @ 1.0) + in:hpanel. receiverInspector fieldListLabel:'Receiver'. contextInspector := ContextInspectorView - origin:(0.5 @ 0.0) corner:(1.0 @ 1.0) - in:hpanel. + origin:(0.5 @ 0.0) corner:(1.0 @ 1.0) + in:hpanel. contextInspector fieldListLabel:'Context'. ^ hpanel @@ -3391,36 +3391,36 @@ initializeNextButtonIn:bpanel nextButton := Button - label:(resources string:'Debug_Next') - action:[ - stepButton turnOff. - self doNext - ] - in:bpanel. + label:(resources string:'Debug_Next') + action:[ + stepButton turnOff. + self doNext + ] + in:bpanel. "Created: / 17.11.2001 / 20:59:38 / cg" ! initializeReportButtonIn:bpanel reportButton := Button - label:(resources string:'Report by Mail...') - action:[ - reportButton turnOffWithoutRedraw. - self doOpenReportMailApp. - ] - in:bpanel. + label:(resources string:'Report by Mail...') + action:[ + reportButton turnOffWithoutRedraw. + self doOpenReportMailApp. + ] + in:bpanel. "Created: / 17.11.2001 / 21:02:20 / cg" ! initializeResendButtonIn:bpanel resendButton := Button - label:(resources string:'Resend') - action:[ - resendButton turnOff. - self doResend - ] - in:bpanel. + label:(resources string:'Resend') + action:[ + resendButton turnOff. + self doResend + ] + in:bpanel. "/ if we have this, we do not need the restart button restartButton beInvisible. @@ -3428,60 +3428,60 @@ initializeRestartButtonIn:bpanel restartButton := Button - label:(resources string:'Restart') - action:[ - restartButton turnOff. - self doRestart - ] - in:bpanel. + label:(resources string:'Restart') + action:[ + restartButton turnOff. + self doRestart + ] + in:bpanel. "Created: / 17.11.2001 / 20:58:52 / cg" ! initializeReturnButtonIn:bpanel returnButton := Button - label:(resources string:'Return') - action:[ - returnButton turnOff. - self doReturn - ] - in:bpanel. + label:(resources string:'Return') + action:[ + returnButton turnOff. + self doReturn + ] + in:bpanel. "Created: / 17.11.2001 / 20:58:22 / cg" ! initializeSendButtonIn:bpanel sendButton := Button - label:(resources string:'Send') - action:[ - sendButton turnOff. - self doSend - ] - in:bpanel. + label:(resources string:'Send') + action:[ + sendButton turnOff. + self doSend + ] + in:bpanel. "Created: / 17.11.2001 / 21:01:20 / cg" ! initializeStepButtonIn:bpanel stepButton := Button - label:(resources string:'Debug_Step') - action:[ - stepButton turnOff. - self doStep - ] - in:bpanel. + label:(resources string:'Debug_Step') + action:[ + stepButton turnOff. + self doStep + ] + in:bpanel. "Created: / 17.11.2001 / 21:00:13 / cg" ! initializeTerminateButtonIn:bpanel terminateButton := Button - label:(resources string:'Debug_Terminate') - action:[ - terminateButton turnOffWithoutRedraw. - self doTerminate - ] - in:bpanel. + label:(resources string:'Debug_Terminate') + action:[ + terminateButton turnOffWithoutRedraw. + self doTerminate + ] + in:bpanel. terminateButton backgroundColor:Color red lightened. "/ terminateButton foregroundColor:Color red. @@ -3493,14 +3493,14 @@ super postRealize. inspecting ifTrue:[ - inspectedProcess notNil ifTrue:[ - " - set prio somewhat higher (by 2, to allow walkBack-update process - to run between mine and the debugged processes prio) - " - Processor activeProcess - priority:(((inspectedProcess priority + 2) min:(Processor highIOPriority)) max:(Processor userSchedulingPriority+1)). - ] + inspectedProcess notNil ifTrue:[ + " + set prio somewhat higher (by 2, to allow walkBack-update process + to run between mine and the debugged processes prio) + " + Processor activeProcess + priority:(((inspectedProcess priority + 2) min:(Processor highIOPriority)) max:(Processor userSchedulingPriority+1)). + ] ]. self sensor addEventListener:self. @@ -3513,7 +3513,7 @@ "/ the debuggee, there would be no event loop for me. self drawableId notNil ifTrue:[ - ^ self + ^ self ]. "physically create the view & subviews" self recreate. @@ -3535,7 +3535,7 @@ inspectedProcess := nil. contextArray := nil. ((exitAction == #restart) or:[exitAction == #return or:[exitAction == #resend]]) ifFalse:[ - selectedContext := nil. + selectedContext := nil. ]. actualContext := firstContext := nil. steppedContext := wrapperContext := nil. @@ -3552,37 +3552,37 @@ lines := aMessage asStringCollection. lines size > 1 ifTrue:[ - l := lines first + l := lines first ] ifFalse:[ - l := aMessage. + l := aMessage. ]. l := l , ' ('. Error handle:[:ex | - l := l , '???' + l := l , '???' ] do:[ - processNameOrNil := aProcess name. - processNameOrNil notNil ifTrue:[ - l := l , (processNameOrNil contractTo:20) , ''. - ]. - pidOrNil := aProcess id printString. - l := l , '[' , pidOrNil , ']'. + processNameOrNil := aProcess name. + processNameOrNil notNil ifTrue:[ + l := l , (processNameOrNil contractTo:20) , ''. + ]. + pidOrNil := aProcess id printString. + l := l , '[' , pidOrNil , ']'. ]. l := l , ')'. self label:l. ((ShowThreadID == true) and:[OperatingSystem isMSDOSlike]) ifTrue:[ - osPidString := ' {threadID: ',OperatingSystem getThreadId printString,'}'. + osPidString := ' {threadID: ',OperatingSystem getThreadId printString,'}'. ]. exceptionInfoLabel notNil ifTrue:[ - exceptionInfoLabel - label:(resources - string:'%1 in process %2 [%3]%4' - with:(lines first colorizeAllWith:Color red) - with:(processNameOrNil ? '') - with:(pidOrNil ? '') - with:(osPidString ? '')) + exceptionInfoLabel + label:(resources + string:'%1 in process %2 [%3]%4' + with:(lines first colorizeAllWith:Color red) + with:(processNameOrNil ? '') + with:(pidOrNil ? '') + with:(osPidString ? '')) ]. "Modified: / 06-07-2006 / 12:43:19 / cg" @@ -3592,8 +3592,8 @@ contextInterrupt DebuggingDebugger == true ifTrue:[ - 'contextIRQ' printCR. - thisContext methodHome sender fullPrint. + 'contextIRQ' printCR. + thisContext methodHome sender fullPrint. ]. self stepOrNext @@ -3602,9 +3602,9 @@ stepInterrupt DebuggingDebugger == true ifTrue:[ - 'stepIRQ' print. - "/ ' in ' print. thisContext sender fullPrint. - '' printCR. + 'stepIRQ' print. + "/ ' in ' print. thisContext sender fullPrint. + '' printCR. ]. Processor yield. self stepOrNext @@ -3613,7 +3613,7 @@ ! stepOrNext - |where here con s isWrap method wrappedMethod + |where here con s isWrap method wrappedMethod originalMethodOfWrappedMethod originalMethodsContext inBlock subBlockLeft ignore contextBelow wrapContext leftWrap enteredWrap anyStepBlocks @@ -3629,20 +3629,20 @@ processName := (Processor activeProcess nameOrId),' [',Processor activeProcess id printString,']'. skipLineNr == #return ifTrue:[ - self label:('stepping context returned ' , ' (process: ' , processName , ')'). - here := thisContext sender sender. - here setLineNumber:nil. - here := nil. - con := thisContext sender sender sender. - - HaltInterrupt handle:[:ex | - ('DebugView [info]: halt/breakpoint in debugger at %1 ignored [stepOrNext]' bindWith:ex suspendedContext) infoPrintCR. - ex proceed - ] do:[ - self enter:con select:nil. - ]. - con := nil. - ^ self + self label:('stepping context returned ' , ' (process: ' , processName , ')'). + here := thisContext sender sender. + here setLineNumber:nil. + here := nil. + con := thisContext sender sender sender. + + HaltInterrupt handle:[:ex | + ('DebugView [info]: halt/breakpoint in debugger at %1 ignored [stepOrNext]' bindWith:ex suspendedContext) infoPrintCR. + ex proceed + ] do:[ + self enter:con select:nil. + ]. + con := nil. + ^ self ]. "/ "/ @@ -3655,8 +3655,8 @@ "/ ]. Processor activeProcess ~~ inspectedProcess ifTrue:[ - 'DebugView [info]: stray step interrupt' infoPrintCR. - ^ self + 'DebugView [info]: stray step interrupt' infoPrintCR. + ^ self ]. here := thisContext. "stepInterrupt" @@ -3664,183 +3664,183 @@ here := here sender. "the interrupted context" DebuggingDebugger2 == true ifTrue:[ - '***************************' printCR. - 'here in ' print. - inWrap ifTrue:['(wrap) ' print.]. - ((ObjectMemory addressOf:here) printStringRadix:16) print. ' ' print. - here selector printCR. - 'stepping in ' print. - steppedContext notNil ifTrue:[ - ((ObjectMemory addressOf:steppedContext) printStringRadix:16) print. ' ' print. - ]. - steppedContext printCR. + '***************************' printCR. + 'here in ' print. + inWrap ifTrue:['(wrap) ' print.]. + ((ObjectMemory addressOf:here) printStringRadix:16) print. ' ' print. + here selector printCR. + 'stepping in ' print. + steppedContext notNil ifTrue:[ + ((ObjectMemory addressOf:steppedContext) printStringRadix:16) print. ' ' print. + ]. + steppedContext printCR. ]. "/ when single stepping, ignore breakpoints here selector == #break ifTrue:[ - (here receiver isKindOf:Breakpoint) ifTrue:[ - false "here receiver isEnabled" ifFalse:[ - con := nil. - where := nil. here := nil. - StepInterruptPending := 1. - InterruptPending := 1. - InStepInterrupt := nil. - ^ self - ] - ]. + (here receiver isKindOf:Breakpoint) ifTrue:[ + false "here receiver isEnabled" ifFalse:[ + con := nil. + where := nil. here := nil. + StepInterruptPending := 1. + InterruptPending := 1. + InStepInterrupt := nil. + ^ self + ] + ]. ]. "/ kludge: a bug-workaround; "/ I should not see those... here selector == #ioInterrupt ifTrue:[ - DebuggingDebugger2 == true ifTrue:[ - 'oops - should not get that one' printCR. - ]. - Processor ioInterrupt. - StepInterruptPending := 1. - InterruptPending := 1. - where := nil. here := nil. - InStepInterrupt := nil. - ^ self + DebuggingDebugger2 == true ifTrue:[ + 'oops - should not get that one' printCR. + ]. + Processor ioInterrupt. + StepInterruptPending := 1. + InterruptPending := 1. + where := nil. here := nil. + InStepInterrupt := nil. + ^ self ]. stepUntilEntering notNil ifTrue:[ - DebuggingDebugger2 == true ifTrue:[ - 'check if entering ' print. stepUntilEntering printCR. - ]. - (stepUntilEntering match:here selector) ifTrue:[ - DebuggingDebugger2 == true ifTrue:[ - 'entering...' printCR. - ]. - self label:('arrived at ' , stepUntilEntering , ' (process: ' , processName , ')'). - - lastStepUntilEntering := stepUntilEntering. - stepUntilEntering := nil. - self enter:here select:nil. - con := nil. - ^ self - ]. - "/ see if stepping context is still active ... - - con := here. - - DebuggingDebugger2 == true ifTrue:[ - 'start searching at: ' print. - con fullPrint. - ]. - [con notNil and:[con ~~ steppedContext]] whileTrue:[ - con := con sender - ]. - con notNil ifTrue:[ - DebuggingDebugger2 == true ifTrue:[ - 'steppingContext still active - continue stepping' printCR. - ]. - con := nil. - where := nil. here := nil. - StepInterruptPending := 1. - InterruptPending := 1. - InStepInterrupt := nil. - ^ self - ]. - stepUntilEntering := nil. + DebuggingDebugger2 == true ifTrue:[ + 'check if entering ' print. stepUntilEntering printCR. + ]. + (stepUntilEntering match:here selector) ifTrue:[ + DebuggingDebugger2 == true ifTrue:[ + 'entering...' printCR. + ]. + self label:('arrived at ' , stepUntilEntering , ' (process: ' , processName , ')'). + + lastStepUntilEntering := stepUntilEntering. + stepUntilEntering := nil. + self enter:here select:nil. + con := nil. + ^ self + ]. + "/ see if stepping context is still active ... + + con := here. + + DebuggingDebugger2 == true ifTrue:[ + 'start searching at: ' print. + con fullPrint. + ]. + [con notNil and:[con ~~ steppedContext]] whileTrue:[ + con := con sender + ]. + con notNil ifTrue:[ + DebuggingDebugger2 == true ifTrue:[ + 'steppingContext still active - continue stepping' printCR. + ]. + con := nil. + where := nil. here := nil. + StepInterruptPending := 1. + InterruptPending := 1. + InStepInterrupt := nil. + ^ self + ]. + stepUntilEntering := nil. ]. " kludge to hide breakpoint wrappers in the context list and when single stepping: - check if we are in a wrapper method's hidden setup-sequence - if so, ignore the interrupt and continue single sending. - Assume we are in a wrappers setup code, if there is another context above, - which is for the wrapper method (i.e. if there is context with an originalmethod - of some other context higher in the caller chain + check if we are in a wrapper method's hidden setup-sequence + if so, ignore the interrupt and continue single sending. + Assume we are in a wrappers setup code, if there is another context above, + which is for the wrapper method (i.e. if there is context with an originalmethod + of some other context higher in the caller chain " isWrap := false. subBlockLeft := false. leftWrap := enteredWrap := false. inWrap ifTrue:[ - "/ situation1: - "/ valueWithReceiver or other - "/ foo (wrapped) <- wrapContext - "/ - "/ situation2: - "/ foo (original) <- originalMethodsContext - "/ valueWithReceiver - "/ foo (wrapped) <- wrapContext - "/ - "/ situation3: - "/ other - "/ foo (original) <- originalMethodsContext - "/ valueWithReceiver - "/ foo (wrapped) <- wrapContext - "/ - "/ situation4: - "/ ... many-contexts ... (more than 8) - "/ possibly foo (original) - "/ valueWithReceiver or other - "/ foo (wrapped) - "/ - - "/ search for the wrapped method's context and extract the original method - where := here. - 8 timesRepeat:[ - wrapContext isNil ifTrue:[ - where notNil ifTrue:[ - DebuggingDebugger2 == true ifTrue:[ - ((ObjectMemory addressOf:where) printStringRadix:16) print. ' ' print. - where printCR - ]. - where isBlockContext ifFalse:[ - method := where method. - (method notNil and:[method isWrapped]) ifTrue:[ - originalMethodOfWrappedMethod := method originalMethod. - wrappedMethod := method. - wrapContext := where. - ]. - ]. - where := where sender - ] - ] - ]. - DebuggingDebugger2 == true ifTrue:[ - 'wrap-context is: ' print. - wrapContext notNil ifTrue:[ - ((ObjectMemory addressOf:wrapContext) printStringRadix:16) print. ' ' print. - ]. - wrapContext printCR - ]. - originalMethodOfWrappedMethod isNil ifTrue:[ - 'oops no wrap?' errorPrintCR. - ]. + "/ situation1: + "/ valueWithReceiver or other + "/ foo (wrapped) <- wrapContext + "/ + "/ situation2: + "/ foo (original) <- originalMethodsContext + "/ valueWithReceiver + "/ foo (wrapped) <- wrapContext + "/ + "/ situation3: + "/ other + "/ foo (original) <- originalMethodsContext + "/ valueWithReceiver + "/ foo (wrapped) <- wrapContext + "/ + "/ situation4: + "/ ... many-contexts ... (more than 8) + "/ possibly foo (original) + "/ valueWithReceiver or other + "/ foo (wrapped) + "/ + + "/ search for the wrapped method's context and extract the original method + where := here. + 8 timesRepeat:[ + wrapContext isNil ifTrue:[ + where notNil ifTrue:[ + DebuggingDebugger2 == true ifTrue:[ + ((ObjectMemory addressOf:where) printStringRadix:16) print. ' ' print. + where printCR + ]. + where isBlockContext ifFalse:[ + method := where method. + (method notNil and:[method isWrapped]) ifTrue:[ + originalMethodOfWrappedMethod := method originalMethod. + wrappedMethod := method. + wrapContext := where. + ]. + ]. + where := where sender + ] + ] + ]. + DebuggingDebugger2 == true ifTrue:[ + 'wrap-context is: ' print. + wrapContext notNil ifTrue:[ + ((ObjectMemory addressOf:wrapContext) printStringRadix:16) print. ' ' print. + ]. + wrapContext printCR + ]. + originalMethodOfWrappedMethod isNil ifTrue:[ + 'oops no wrap?' errorPrintCR. + ]. ]. (inWrap and:[ originalMethodOfWrappedMethod notNil ]) ifTrue:[ - isWrap := false. - "/ DebuggingDebugger2 ifTrue:[ '----------->' print. originalMethodOfWrappedMethod printCR ]. - where := here. - 8 timesRepeat:[ - originalMethodsContext isNil ifTrue:[ - where notNil ifTrue:[ - DebuggingDebugger2 ifTrue:[ - ((ObjectMemory addressOf:where) printStringRadix:16) print. ' ' print. - where printCR - ]. - where isBlockContext ifFalse:[ - method := where method. - method == originalMethodOfWrappedMethod ifTrue:[ - originalMethodsContext := here. - where == here ifTrue:[ - "/ situation2 - DebuggingDebugger2 ifTrue:[ 's2' printCR ]. - isWrap := true. - "/ here setSender:(wrapContext sender). --- leads to a crash - ] ifFalse: [ - "/ situation3 - DebuggingDebugger2 ifTrue:[ 's3' printCR ]. - inWrap := false. - isWrap := false. - ]. - steppedContext := where + isWrap := false. + "/ DebuggingDebugger2 ifTrue:[ '----------->' print. originalMethodOfWrappedMethod printCR ]. + where := here. + 8 timesRepeat:[ + originalMethodsContext isNil ifTrue:[ + where notNil ifTrue:[ + DebuggingDebugger2 ifTrue:[ + ((ObjectMemory addressOf:where) printStringRadix:16) print. ' ' print. + where printCR + ]. + where isBlockContext ifFalse:[ + method := where method. + method == originalMethodOfWrappedMethod ifTrue:[ + originalMethodsContext := here. + where == here ifTrue:[ + "/ situation2 + DebuggingDebugger2 ifTrue:[ 's2' printCR ]. + isWrap := true. + "/ here setSender:(wrapContext sender). --- leads to a crash + ] ifFalse: [ + "/ situation3 + DebuggingDebugger2 ifTrue:[ 's3' printCR ]. + inWrap := false. + isWrap := false. + ]. + steppedContext := where "/ ] ifFalse:[ "/ where selector == wrapContext selector ifTrue:[ "/ where receiver == wrapContext receiver ifTrue:[ @@ -3851,62 +3851,62 @@ "/ '!!!!!!!!!!!!!!!!!!!!!!!!' printCR. "/ ]. "/ ]. - ]. - where := where sender - ]. - ]. - ]. - ]. - DebuggingDebugger2 ifTrue:[ - 'original method-context is: ' print. - originalMethodsContext notNil ifTrue:[ - ((ObjectMemory addressOf:originalMethodsContext) printStringRadix:16) print. ' ' print. - ]. - originalMethodsContext printCR - ]. - originalMethodsContext isNil ifTrue:[ - originalMethodOfWrappedMethod isNil ifTrue:[ - "/ situation4 - DebuggingDebugger2 ifTrue:[ 's4' printCR ]. - DebuggingDebugger2 ifTrue:[ steppedContext printCR ]. - isWrap := false. - ] ifFalse:[ - "/ situation1 - DebuggingDebugger2 ifTrue:[ 's1' printCR ]. - isWrap := true. - "/ steppedContext := wrapContext - ]. - ]. + ]. + where := where sender + ]. + ]. + ]. + ]. + DebuggingDebugger2 ifTrue:[ + 'original method-context is: ' print. + originalMethodsContext notNil ifTrue:[ + ((ObjectMemory addressOf:originalMethodsContext) printStringRadix:16) print. ' ' print. + ]. + originalMethodsContext printCR + ]. + originalMethodsContext isNil ifTrue:[ + originalMethodOfWrappedMethod isNil ifTrue:[ + "/ situation4 + DebuggingDebugger2 ifTrue:[ 's4' printCR ]. + DebuggingDebugger2 ifTrue:[ steppedContext printCR ]. + isWrap := false. + ] ifFalse:[ + "/ situation1 + DebuggingDebugger2 ifTrue:[ 's1' printCR ]. + isWrap := true. + "/ steppedContext := wrapContext + ]. + ]. ]. isWrap ifTrue:[ - DebuggingDebugger2 == true ifTrue:[ - 'ignore wrap' printCR. - ]. - - "/ - "/ ignore, while in wrappers hidden setup - "/ - where := nil. here := nil. - ObjectMemory flushInlineCaches. - - DebuggingDebugger2 == true ifTrue:[ - skipLineNr == #return ifTrue:[ - 'skipRet in wrap' printCR. - ] - ]. - - StepInterruptPending := 1. - InterruptPending := 1. - InStepInterrupt := nil. - ^ self + DebuggingDebugger2 == true ifTrue:[ + 'ignore wrap' printCR. + ]. + + "/ + "/ ignore, while in wrappers hidden setup + "/ + where := nil. here := nil. + ObjectMemory flushInlineCaches. + + DebuggingDebugger2 == true ifTrue:[ + skipLineNr == #return ifTrue:[ + 'skipRet in wrap' printCR. + ] + ]. + + StepInterruptPending := 1. + InterruptPending := 1. + InStepInterrupt := nil. + ^ self ]. inBlock := inBlockBelow := anyStepBlocks := false. DebuggingDebugger2 == true ifTrue:[ - 'bigStep is: ' print. bigStep printCR. - 'steppedContext is: ' print. steppedContext printCR. + 'bigStep is: ' print. bigStep printCR. + 'steppedContext is: ' print. steppedContext printCR. ]. "/ @@ -3914,31 +3914,31 @@ "/ (bigStep and:[steppedContext notNil]) ifTrue:[ - " - a step or next - ignore all contexts below the interesting one - " - where := here. "the interrupted context" - contextBelow := nil. - - where home notNil ifTrue:[ - "/ - "/ in a block called by 'our' context ? - "/ - where home == steppedContext ifTrue:[ - "/ '*block*' printCR. - inBlock := true - ] - ]. - - where == steppedContext ifFalse:[ - where := where sender. - - where notNil ifTrue:[ - where home == steppedContext ifTrue:[ - "/ '*block*' printCR. - inBlock := true. - ] - ]. + " + a step or next - ignore all contexts below the interesting one + " + where := here. "the interrupted context" + contextBelow := nil. + + where home notNil ifTrue:[ + "/ + "/ in a block called by 'our' context ? + "/ + where home == steppedContext ifTrue:[ + "/ '*block*' printCR. + inBlock := true + ] + ]. + + where == steppedContext ifFalse:[ + where := where sender. + + where notNil ifTrue:[ + where home == steppedContext ifTrue:[ + "/ '*block*' printCR. + inBlock := true. + ] + ]. "/ 'looking for ' print. "/ (steppedContextAddress printStringRadix:16)print. '' printCR. @@ -3946,301 +3946,301 @@ "/where print. ' ' print. ((ObjectMemory addressOf:where)printStringRadix:16) printCR. "/steppedContext print. ' ' print. ((ObjectMemory addressOf:steppedContext)printStringRadix:16) printCR. - where == steppedContext ifFalse:[ - - "/ check if we are in a context below steppedContext - "/ (i.e. if steppedContext can be reached from - "/ interrupted context. Not using context-ref but its - "/ address to avoid creation of many useless contexts.) - - inBlock ifFalse:[ - [where notNil] whileTrue:[ - - "/ if either the receiver or any arg of this context - "/ is a block of the steppedContext, we must really - "/ do a single step. Otherwise, stepping through a - "/ do:-loop would be very difficult. - receiver := where receiver. + where == steppedContext ifFalse:[ + + "/ check if we are in a context below steppedContext + "/ (i.e. if steppedContext can be reached from + "/ interrupted context. Not using context-ref but its + "/ address to avoid creation of many useless contexts.) + + inBlock ifFalse:[ + [where notNil] whileTrue:[ + + "/ if either the receiver or any arg of this context + "/ is a block of the steppedContext, we must really + "/ do a single step. Otherwise, stepping through a + "/ do:-loop would be very difficult. + receiver := where receiver. where selector == #critical: ifTrue:[ anyStepBlocks := true. ] ifFalse:[ - (receiver isBlock - and:[(receiver isKindOf:Block) - and:[receiver homeMethod == steppedContext method - "receiver home == steppedContext"]]) - ifTrue:[ - anyStepBlocks := true. - ] ifFalse:[ - where args do:[:arg | - (arg isBlock - and:[(arg isKindOf:Block) - and:[arg homeMethod == steppedContext method - "arg home == steppedContext"]]) - ifTrue:[ - anyStepBlocks := true. - ] ifFalse:[ - (where methodHome notNil - and:[where methodHome receiver isBlock - and:[(where methodHome receiver isKindOf:Block) - and:[where methodHome receiver homeMethod == steppedContext method - "where methodHome receiver home == steppedContext"]]]) - ifTrue:[ - anyStepBlocks := true. - ] - ]. - ] - ]. + (receiver isBlock + and:[(receiver isKindOf:Block) + and:[receiver homeMethod == steppedContext method + "receiver home == steppedContext"]]) + ifTrue:[ + anyStepBlocks := true. + ] ifFalse:[ + where args do:[:arg | + (arg isBlock + and:[(arg isKindOf:Block) + and:[arg homeMethod == steppedContext method + "arg home == steppedContext"]]) + ifTrue:[ + anyStepBlocks := true. + ] ifFalse:[ + (where methodHome notNil + and:[where methodHome receiver isBlock + and:[(where methodHome receiver isKindOf:Block) + and:[where methodHome receiver homeMethod == steppedContext method + "where methodHome receiver home == steppedContext"]]]) + ifTrue:[ + anyStepBlocks := true. + ] + ]. + ] + ]. ]. - DebuggingDebugger2 == true ifTrue:[ - ((ObjectMemory addressOf:where) printStringRadix:16)print. ' ' print. - where selector printCR. - ]. - - where == steppedContext ifTrue:[ + DebuggingDebugger2 == true ifTrue:[ + ((ObjectMemory addressOf:where) printStringRadix:16)print. ' ' print. + where selector printCR. + ]. + + where == steppedContext ifTrue:[ "/ 'found it - below; ignore' printCR. - " - found the interesting context somwehere up in the - chain. We seem to be still below the interesting one ... - " - tracing == true ifTrue:[ - here printString printCR - ]. - " - yes, a context below - - continue and schedule another stepInterrupt. - Must flush caches since optimized methods not always - look for pending interrupts - " - - contextBelow notNil ifTrue:[ + " + found the interesting context somwehere up in the + chain. We seem to be still below the interesting one ... + " + tracing == true ifTrue:[ + here printString printCR + ]. + " + yes, a context below + - continue and schedule another stepInterrupt. + Must flush caches since optimized methods not always + look for pending interrupts + " + + contextBelow notNil ifTrue:[ "/ 'prepare for unwind-catch' printCR. "/ 'con= ' print. contextBelow printCR. "/ contextBelow selector notNil ifTrue:[ "/ self label:'single stepping - please wait ...(' , contextBelow selector , ')'. "/ ]. - DebuggingDebugger2 == true ifTrue:[ - 'below stepCon; continue until unwind of: ' print. - contextBelow printCR. - ]. - Processor activeProcess forceInterruptOnReturnOf:contextBelow. - StepInterruptPending := nil. - ] ifFalse:[ - ObjectMemory flushInlineCaches. + DebuggingDebugger2 == true ifTrue:[ + 'below stepCon; continue until unwind of: ' print. + contextBelow printCR. + ]. + Processor activeProcess forceInterruptOnReturnOf:contextBelow. + StepInterruptPending := nil. + ] ifFalse:[ + ObjectMemory flushInlineCaches. "/ here selector notNil ifTrue:[ "/ self label:'single stepping - please wait ...(' , here selector , ')'. "/ ]. - DebuggingDebugger2 == true ifTrue:[ - 'in stepCon; continue single stepping' printCR. - ]. - StepInterruptPending := 1. - InterruptPending := 1. - ]. - where := nil. here := nil. - InStepInterrupt := nil. - - ^ self - ]. - - (steppedContext notNil and:[ - where methodHome == steppedContext methodHome]) ifTrue:[ - inBlockBelow := true. - ]. - - anyStepBlocks ifFalse:[ - inBlock ifFalse:[ + DebuggingDebugger2 == true ifTrue:[ + 'in stepCon; continue single stepping' printCR. + ]. + StepInterruptPending := 1. + InterruptPending := 1. + ]. + where := nil. here := nil. + InStepInterrupt := nil. + + ^ self + ]. + + (steppedContext notNil and:[ + where methodHome == steppedContext methodHome]) ifTrue:[ + inBlockBelow := true. + ]. + + anyStepBlocks ifFalse:[ + inBlock ifFalse:[ "/ workaround a VM bug, "/ which does not honor interrupt-on-return of block contexts "/ sigh where isBlockContext ifFalse:[ - contextBelow := where + contextBelow := where ]. - ] - ]. - where := where sender - ]. - s := 'Debugger: context returned'. - subBlockLeft := true. - ]. - ] ifTrue:[ + ] + ]. + where := where sender + ]. + s := 'Debugger: context returned'. + subBlockLeft := true. + ]. + ] ifTrue:[ "/ 'found it right in sender' printCR. - s := 'Debugger: after step' - ]. - ] ifTrue:[ + s := 'Debugger: after step' + ]. + ] ifTrue:[ "/ 'found it right away' printCR. - s := 'Debugger: after step' - ]. + s := 'Debugger: after step' + ]. ] ifFalse:[ "/ ' send' printCR. - " - a send - " - DebuggingDebugger2 == true ifTrue:[ - 'clear steppedContext' printCR. - ]. - steppedContext := nil. - s := 'Debugger: after send' + " + a send + " + DebuggingDebugger2 == true ifTrue:[ + 'clear steppedContext' printCR. + ]. + steppedContext := nil. + s := 'Debugger: after send' ]. ignore := false. (inBlock and:[stepHow == #nextOver or:[stepHow == #nextOut]]) ifTrue:[ - ignore := true. + ignore := true. ]. "/ handle the case, when a subBlock leaves; "/ continue stepping in the home context. subBlockLeft ifTrue:[ - steppedContext home notNil ifTrue:[ - steppedContext := steppedContext home. - s := 'Debugger: after step'. - subBlockLeft := false. + steppedContext home notNil ifTrue:[ + steppedContext := steppedContext home. + s := 'Debugger: after step'. + subBlockLeft := false. "/ DebugView enterUnconditional:thisContext withMessage:'debug'. - ] + ] ]. " kludge to hide breakpoint wrappers in the context list: - check if we are in a wrapper methods hidden exit-sequence - if so, ignore the interrupt and continue single sending + check if we are in a wrapper methods hidden exit-sequence + if so, ignore the interrupt and continue single sending " (where isNil and:[wrapperContext notNil]) ifTrue:[ - "/ did not find our steppedContext along the chain; - "/ could be in a wrappedMethods exitBlock ... - - leftWrap ifFalse:[ - where := here. - wrappedMethod := nil. - 5 timesRepeat:[ - where notNil ifTrue:[ - where isBlockContext ifFalse:[ - method := where method. - (method notNil and:[method isWrapped]) ifTrue:[ - where == wrapperContext ifTrue:[ - DebuggingDebugger2 == true ifTrue:[ - 'change stepCon fromWrapped: ' print. - steppedContext print. - ' to: ' print. - wrapperContext printCR. - ]. - - inWrap := true. - enteredWrap := true. - steppedContext := wrapperContext. - wrapperContext := nil. - ] - ]. - ]. - where := where sender - ] - ]. - ]. - enteredWrap ifTrue:[ - ignore := true - ] + "/ did not find our steppedContext along the chain; + "/ could be in a wrappedMethods exitBlock ... + + leftWrap ifFalse:[ + where := here. + wrappedMethod := nil. + 5 timesRepeat:[ + where notNil ifTrue:[ + where isBlockContext ifFalse:[ + method := where method. + (method notNil and:[method isWrapped]) ifTrue:[ + where == wrapperContext ifTrue:[ + DebuggingDebugger2 == true ifTrue:[ + 'change stepCon fromWrapped: ' print. + steppedContext print. + ' to: ' print. + wrapperContext printCR. + ]. + + inWrap := true. + enteredWrap := true. + steppedContext := wrapperContext. + wrapperContext := nil. + ] + ]. + ]. + where := where sender + ] + ]. + ]. + enteredWrap ifTrue:[ + ignore := true + ] ]. "/ subBlockLeft ifTrue:[ - "/ special care for stepInterrupt in send, - "/ when created a dummy context (lineNr == 1) - - steppedContext lineNumber isNil ifTrue:[ - steppedContext selector == here sender selector ifTrue:[ - subBlockLeft := false. - s := 'Debugger: after step'. - steppedContext := here sender. - ]. - ]. - oneMore := true + "/ special care for stepInterrupt in send, + "/ when created a dummy context (lineNr == 1) + + steppedContext lineNumber isNil ifTrue:[ + steppedContext selector == here sender selector ifTrue:[ + subBlockLeft := false. + s := 'Debugger: after step'. + steppedContext := here sender. + ]. + ]. + oneMore := true ]. inBlock ifTrue:[ - DebuggingDebugger2 == true ifTrue:[ - 'inBlock' printCR. - ]. - s := 'Debugger: in block'. + DebuggingDebugger2 == true ifTrue:[ + 'inBlock' printCR. + ]. + s := 'Debugger: in block'. ]. inBlockBelow ifTrue:[ - DebuggingDebugger2 == true ifTrue:[ - 'inBlockBelow' printCR. - ]. - ignore := true + DebuggingDebugger2 == true ifTrue:[ + 'inBlockBelow' printCR. + ]. + ignore := true ]. DebuggingDebugger2 == true ifTrue:[ - where notNil ifTrue:[ - '(' print. steppedContextLineno print. ') ' print. - where printCR. - ]. + where notNil ifTrue:[ + '(' print. steppedContextLineno print. ') ' print. + where printCR. + ]. ]. ignore ifFalse:[ - (bigStep - and:[steppedContextLineno notNil - and:[where notNil - and:[where lineNumber == steppedContextLineno]]]) ifTrue:[ - (here isBlockContext - and:[(here methodHome == steppedContext) - or:[here home == steppedContext]]) ifTrue:[ - DebuggingDebugger2 == true ifTrue:[ - 'same line but in block' printCR. - ]. - - steppedContext := actualContext := here. - steppedContextLineno := here lineNumber. - ] ifFalse:[ - "/ kludge - I only have the info for up to 255 lines - steppedContextLineno ~~ 255 ifTrue:[ - DebuggingDebugger2 == true ifTrue:[ - 'same line - ignored' printCR. - ]. - ignore := true - ]. - ]. - ]. - - (subBlockLeft not - and:[skipLineNr notNil - and:[where notNil - and:[where lineNumber notNil - and:[where lineNumber < skipLineNr]]]]) ifTrue:[ - DebuggingDebugger2 == true ifTrue:[ - 'skip (' print. skipLineNr print. ' unreached - ignored' printCR. - ]. - ignore := true - ]. - - (steppedContextLineno isNil - and:[skipLineNr isNil - and:[thisContext sender selector == #contextInterrupt]]) ifTrue:[ - DebuggingDebugger2 == true ifTrue:[ - 'same line2 (after conIRQ) - ignored' printCR. - ]. - ignore := true - ]. + (bigStep + and:[steppedContextLineno notNil + and:[where notNil + and:[where lineNumber == steppedContextLineno]]]) ifTrue:[ + (here isBlockContext + and:[(here methodHome == steppedContext) + or:[here home == steppedContext]]) ifTrue:[ + DebuggingDebugger2 == true ifTrue:[ + 'same line but in block' printCR. + ]. + + steppedContext := actualContext := here. + steppedContextLineno := here lineNumber. + ] ifFalse:[ + "/ kludge - I only have the info for up to 255 lines + steppedContextLineno ~~ 255 ifTrue:[ + DebuggingDebugger2 == true ifTrue:[ + 'same line - ignored' printCR. + ]. + ignore := true + ]. + ]. + ]. + + (subBlockLeft not + and:[skipLineNr notNil + and:[where notNil + and:[where lineNumber notNil + and:[where lineNumber < skipLineNr]]]]) ifTrue:[ + DebuggingDebugger2 == true ifTrue:[ + 'skip (' print. skipLineNr print. ' unreached - ignored' printCR. + ]. + ignore := true + ]. + + (steppedContextLineno isNil + and:[skipLineNr isNil + and:[thisContext sender selector == #contextInterrupt]]) ifTrue:[ + DebuggingDebugger2 == true ifTrue:[ + 'same line2 (after conIRQ) - ignored' printCR. + ]. + ignore := true + ]. ]. ignore ifTrue:[ "/' ' printCR. - where := nil. here := nil. - " - yes, a context below - - continue and schedule another stepInterrupt. - Must flush caches since optimized methods not always - look for pending interrupts - " - ObjectMemory flushInlineCaches. - StepInterruptPending := 1. - InterruptPending := 1. - InStepInterrupt := nil. - ^ self + where := nil. here := nil. + " + yes, a context below + - continue and schedule another stepInterrupt. + Must flush caches since optimized methods not always + look for pending interrupts + " + ObjectMemory flushInlineCaches. + StepInterruptPending := 1. + InterruptPending := 1. + InStepInterrupt := nil. + ^ self ]. "/ ' ' printCR. @@ -4255,24 +4255,24 @@ "/'enter' printCR. DebuggingDebugger2 == true ifTrue:[ - '==> enter on: ' print. thisContext sender sender printCR. + '==> enter on: ' print. thisContext sender sender printCR. ]. initiallyShown := nil. (oneMore == true) ifTrue:[ - (thisContext sender sender lineNumber ? 0) <= 1 ifTrue:[ - initiallyShown := 2 - ] ifFalse:[ - initiallyShown := 1 - ] + (thisContext sender sender lineNumber ? 0) <= 1 ifTrue:[ + initiallyShown := 2 + ] ifFalse:[ + initiallyShown := 1 + ] ]. con := thisContext sender sender. HaltInterrupt handle:[:ex | - 'DebugView [info]: halt/breakpoint in debugger ignored [stepOpNext 2]' infoPrintCR. - ex proceed + 'DebugView [info]: halt/breakpoint in debugger ignored [stepOpNext 2]' infoPrintCR. + ex proceed ] do:[ - self enter:con select:initiallyShown + self enter:con select:initiallyShown ]. con := nil @@ -4292,7 +4292,7 @@ cls := selectedContext receiver class. sel := selectedContext selector. (cls includesSelector:sel) ifFalse:[ - sel := nil + sel := nil ]. Tools::NewSystemBrowser addToBookMarks:cls selector:sel ! @@ -4313,9 +4313,9 @@ "stop the update process" updateProcess notNil ifTrue:[ - monitorToggle lampColor:(Color yellow). - updateProcess terminate. - updateProcess := nil + monitorToggle lampColor:(Color yellow). + updateProcess terminate. + updateProcess := nil ] ! @@ -4323,25 +4323,25 @@ "fork a subprocess which updates the contextList in regular intervals" updateProcess isNil ifTrue:[ - updateProcess := - [ - [true] whileTrue:[ - monitorToggle showLamp ifTrue:[ - monitorToggle lampColor:(Color yellow). - ] ifFalse:[ - monitorToggle activeForegroundColor:Color black. - ]. - (Delay forSeconds:0.25) wait. - self updateContext. - monitorToggle showLamp ifTrue:[ - monitorToggle lampColor:(Color red). - ] ifFalse:[ - monitorToggle activeForegroundColor:Color red. - ]. - (Delay forSeconds:0.25) wait. - self updateContext. - ] - ] forkAt:(Processor activePriority - 1) + updateProcess := + [ + [true] whileTrue:[ + monitorToggle showLamp ifTrue:[ + monitorToggle lampColor:(Color yellow). + ] ifFalse:[ + monitorToggle activeForegroundColor:Color black. + ]. + (Delay forSeconds:0.25) wait. + self updateContext. + monitorToggle showLamp ifTrue:[ + monitorToggle lampColor:(Color red). + ] ifFalse:[ + monitorToggle activeForegroundColor:Color red. + ]. + (Delay forSeconds:0.25) wait. + self updateContext. + ] + ] forkAt:(Processor activePriority - 1) ] ! @@ -4359,25 +4359,25 @@ sel := mthd selector. (cls notNil and:[(cls includesSelector:sel)]) ifTrue:[ - cls browserClass openInClass:cls selector:sel. - ^ self + cls browserClass openInClass:cls selector:sel. + ^ self ]. mthd source notEmptyOrNil ifTrue:[ - (Dialog confirm:'Block''s home method is (no longer) present in any class.\Do you want to see the method anyway?' withCRs) - ifTrue:[ - UserPreferences current systemBrowserClass - browseMethods:{ mthd } title:'Unbound Method' sort:false - "/ TextView openWith:mthd source title:'Unbound Method''s Source'. - ]. - ^ self + (Dialog confirm:'Block''s home method is (no longer) present in any class.\Do you want to see the method anyway?' withCRs) + ifTrue:[ + UserPreferences current systemBrowserClass + browseMethods:{ mthd } title:'Unbound Method' sort:false + "/ TextView openWith:mthd source title:'Unbound Method''s Source'. + ]. + ^ self ]. cls notNil ifTrue:[ - (Dialog confirm:'Block''s home method is (no longer) present in any class and no source can be shown.\Do you want to browse the method''s last class instead?' withCRs) - ifTrue:[ - cls browserClass openInClass:cls selector:nil. - ]. - ^ self + (Dialog confirm:'Block''s home method is (no longer) present in any class and no source can be shown.\Do you want to browse the method''s last class instead?' withCRs) + ifTrue:[ + cls browserClass openInClass:cls selector:nil. + ]. + ^ self ]. Dialog information:'Block''s home method is (no longer) present in any class.'. ! @@ -4392,7 +4392,7 @@ cls := selectedContext receiver class. sel := selectedContext selector. (cls includesSelector:sel) ifFalse:[ - sel := nil + sel := nil ]. cls browserClass openInClass:cls selector:sel. @@ -4408,11 +4408,11 @@ mthd := selectedContext method. mthd notNil ifTrue:[ - cls := mthd containingClass. - "/ still nil if unbound - then use receivers class + cls := mthd containingClass. + "/ still nil if unbound - then use receivers class ]. cls isNil ifTrue:[ - cls := selectedContext receiver class + cls := selectedContext receiver class ]. cls browserClass browseClassHierarchy:cls. @@ -4428,11 +4428,11 @@ mthd := selectedContext method. mthd notNil ifTrue:[ - cls := mthd containingClass. - "/ still nil if unbound - then use receivers class + cls := mthd containingClass. + "/ still nil if unbound - then use receivers class ]. cls isNil ifTrue:[ - cls := selectedContext receiver class + cls := selectedContext receiver class ]. cls browserClass browseFullClassProtocol:cls. @@ -4449,26 +4449,26 @@ mthd := con method. mthd notNil ifTrue:[ - who := mthd who. - who notNil ifTrue:[ - cls := who methodClass. - sel := who methodSelector. - ] ifFalse:[ - "might have been re-accepted" - (home := con methodHome) notNil ifTrue:[ - (sel := home selector) notNil ifTrue:[ - cls := home receiver class - whichClassImplements:selectedContext selector. - cls notNil ifTrue:[ - Dialog information:'Method has been changed/moved in the meanwhile.\Browser will show the most recent (current) version.' withCRs. - ]. - ] - ]. - ]. + who := mthd who. + who notNil ifTrue:[ + cls := who methodClass. + sel := who methodSelector. + ] ifFalse:[ + "might have been re-accepted" + (home := con methodHome) notNil ifTrue:[ + (sel := home selector) notNil ifTrue:[ + cls := home receiver class + whichClassImplements:selectedContext selector. + cls notNil ifTrue:[ + Dialog information:'Method has been changed/moved in the meanwhile.\Browser will show the most recent (current) version.' withCRs. + ]. + ] + ]. + ]. ]. cls isNil ifTrue:[ - "/ class not found - try receiver - cls := con receiver class + "/ class not found - try receiver + cls := con receiver class ]. cls browserClass openInClass:cls selector:sel. @@ -4481,12 +4481,12 @@ "open a browser on the implementors of the selected method's selector" selectedContext isNil ifTrue:[ - ^ self showError:'** select a context first **' + ^ self showError:'** select a context first **' ]. "/ selectedContext receiver class browserClass self withWaitCursorDo:[ - UserPreferences systemBrowserClass - browseImplementorsOf:selectedContext selector. + UserPreferences systemBrowserClass + browseImplementorsOf:selectedContext selector. ] "Modified: / 19-07-2012 / 11:44:03 / cg" @@ -4498,22 +4498,22 @@ |initial selector sel| (sel := codeView selection) notNil ifTrue:[ - initial := SystemBrowser extractSelectorFrom:sel + initial := SystemBrowser extractSelectorFrom:sel ]. initial isNil ifTrue:[ - initial := selectedContext isNil - ifTrue:[nil] - ifFalse:[selectedContext selector]. + initial := selectedContext isNil + ifTrue:[nil] + ifFalse:[selectedContext selector]. ]. selector := Dialog - requestSelector:'Selector to browse implementors of:' - initialAnswer:initial. + requestSelector:'Selector to browse implementors of:' + initialAnswer:initial. selector notEmptyOrNil ifTrue:[ - self withWaitCursorDo:[ - UserPreferences systemBrowserClass - browseImplementorsMatching:selector. - ] + self withWaitCursorDo:[ + UserPreferences systemBrowserClass + browseImplementorsMatching:selector. + ] ] "Modified: / 19-07-2012 / 11:43:52 / cg" @@ -4525,9 +4525,9 @@ |app appClass| (app := self processesApplication) notNil ifTrue:[ - appClass := app class. - appClass browserClass openInClass:appClass selector:nil. - ^ self + appClass := app class. + appClass browserClass openInClass:appClass selector:nil. + ^ self ]. ! @@ -4539,14 +4539,14 @@ selectedContext isNil ifTrue:[^ self]. selectedContext isCheapBlockContext ifTrue:[ - cls := selectedContext method mclass. - sel := selectedContext method selector. + cls := selectedContext method mclass. + sel := selectedContext method selector. ] ifFalse:[ - cls := selectedContext receiver class. - sel := selectedContext selector. + cls := selectedContext receiver class. + sel := selectedContext selector. ]. (cls includesSelector:sel) ifFalse:[ - sel := nil + sel := nil ]. cls browserClass openInClass:cls selector:sel. @@ -4557,11 +4557,11 @@ "open a browser on the senders of the selected method's selector" selectedContext isNil ifTrue:[ - ^ self showError:'** select a context first **' + ^ self showError:'** select a context first **' ]. self withWaitCursorDo:[ - UserPreferences systemBrowserClass - browseAllCallsOn:selectedContext selector. + UserPreferences systemBrowserClass + browseAllCallsOn:selectedContext selector. ] "Modified: / 19-07-2012 / 11:43:02 / cg" @@ -4573,22 +4573,22 @@ |initial selector sel| (sel := codeView selection) notNil ifTrue:[ - initial := SystemBrowser extractSelectorFrom:sel + initial := SystemBrowser extractSelectorFrom:sel ]. initial isNil ifTrue:[ - initial := selectedContext isNil - ifTrue:[nil] - ifFalse:[selectedContext selector]. + initial := selectedContext isNil + ifTrue:[nil] + ifFalse:[selectedContext selector]. ]. selector := Dialog - requestSelector:'Selector to browse senders of:' - initialAnswer:initial. + requestSelector:'Selector to browse senders of:' + initialAnswer:initial. selector notEmptyOrNil ifTrue:[ - self withWaitCursorDo:[ - UserPreferences systemBrowserClass - browseAllCallsOn:selector asSymbol. - ] + self withWaitCursorDo:[ + UserPreferences systemBrowserClass + browseAllCallsOn:selector asSymbol. + ] ] "Modified: / 19-07-2012 / 11:43:29 / cg" @@ -4605,15 +4605,15 @@ closeAllDebuggers (Dialog confirm:'Close all Debuggers (without confirmation if code was changed)?') ifFalse:[ - ^ self - ]. - - self class allInstancesDo:[:debugger | - debugger ~~ self ifTrue:[ - debugger busy ifTrue:[ - debugger destroyWithConfirmation:true. - ]. - ]. + ^ self + ]. + + self class allInstancesDo:[:debugger | + debugger ~~ self ifTrue:[ + debugger busy ifTrue:[ + debugger destroyWithConfirmation:true. + ]. + ]. ]. self closeRequest. @@ -4637,14 +4637,14 @@ |infoText| firstContext isNil ifTrue:[ - infoText := 'No context, no walkback'. + infoText := 'No context, no walkback'. ] ifFalse:[ - exceptionInfoLabel notNil ifTrue:[ - infoText := exceptionInfoLabel label , '\\' withCRs. - ] ifFalse:[ - infoText := '' - ]. - infoText := infoText asStringCollection, firstContext fullPrintAllString asStringCollection. + exceptionInfoLabel notNil ifTrue:[ + infoText := exceptionInfoLabel label , '\\' withCRs. + ] ifFalse:[ + infoText := '' + ]. + infoText := infoText asStringCollection, firstContext fullPrintAllString asStringCollection. ]. self setClipboardText:infoText @@ -4658,23 +4658,23 @@ from whatever the process is doing, but does not terminate it." self checkIfCodeIsReallyModified ifTrue:[ - (self confirm:('Code modified - abort anyway ?')) - ifFalse:[ - ^ self - ] + (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 + 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. @@ -4683,11 +4683,11 @@ "exit private event-loop" catchBlock notNil ifTrue:[ - abortButton turnOff. - catchBlock value. - - "/ not reached - 'DebugView [warning]: abort failed' errorPrintCR. + abortButton turnOff. + catchBlock value. + + "/ not reached + 'DebugView [warning]: abort failed' errorPrintCR. ]. ^ self. @@ -4701,23 +4701,23 @@ from whatever the process is doing, but does not terminate it." self checkIfCodeIsReallyModified ifTrue:[ - (self confirm:('Code modified - abort anyway ?')) - ifFalse:[ - ^ self - ] + (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:[AbortAllOperationRequest raise]. - ]. - ^ self + inspectedProcess isDead ifTrue:[ + self showTerminated. + ^ self + ]. + (AbortOperationRequest isHandledIn:inspectedProcess suspendedContext) ifFalse:[ + self showError:'** the process does not handle the abort signal **' + ] ifTrue:[ + self interruptProcessWith:[AbortAllOperationRequest raise]. + ]. + ^ self ]. steppedContext := wrapperContext := nil. @@ -4726,11 +4726,11 @@ "exit private event-loop" catchBlock notNil ifTrue:[ - abortButton turnOff. - catchBlock value. - - "/ not reached - 'DebugView [warning]: abort failed' errorPrintCR. + abortButton turnOff. + catchBlock value. + + "/ not reached + 'DebugView [warning]: abort failed' errorPrintCR. ]. ^ self. @@ -4746,21 +4746,21 @@ oldPrio := (inspectedProcess ? Processor activeProcess) priority. [ - s := Dialog - request:(resources stringWithCRs:'Change the processes priority to (proceed with prio):\\ 2 - system background\ 4 - user background\ 8 - normal\ 9 - high\ 16 - I/O (danger alert)\') - initialAnswer:oldPrio printString. - s isEmptyOrNil ifTrue:[^ self]. - newPrio := Integer readFrom:s onError:nil. - newPrio isNil + s := Dialog + request:(resources stringWithCRs:'Change the processes priority to (proceed with prio):\\ 2 - system background\ 4 - user background\ 8 - normal\ 9 - high\ 16 - I/O (danger alert)\') + initialAnswer:oldPrio printString. + s isEmptyOrNil ifTrue:[^ self]. + newPrio := Integer readFrom:s onError:nil. + newPrio isNil ] whileTrue. newPrio := newPrio max:(Processor lowestPriority). newPrio := newPrio min:(Processor highestPriority). newPrio >= Processor highIOPriority ifTrue:[ - (Dialog - confirm:(resources - stringWithCRs:'Attention: event handling takes place at prio 16.\An ever running high priority process\could block the system and make the UI unusable.\\Proceed?')) - ifFalse:[^ self]. + (Dialog + confirm:(resources + stringWithCRs:'Attention: event handling takes place at prio 16.\An ever running high priority process\could block the system and make the UI unusable.\\Proceed?')) + ifFalse:[^ self]. ]. (inspectedProcess ? Processor activeProcess) priority:newPrio. @@ -4773,59 +4773,59 @@ |proc exContext ex answer| self checkIfCodeIsReallyModified ifTrue:[ - (self confirm:('Code modified - continue anyway ?')) ifFalse:[ - ^ self - ] + (self confirm:('Code modified - continue anyway ?')) ifFalse:[ + ^ self + ] ]. inspecting ifTrue:[ - self graphicsDevice hasColors ifTrue:[ - continueButton foregroundColor:Color red darkened. - ]. - continueButton label:(resources string:'Stop'). - continueButton action:[self doStop]. - - self processPerform:#resume. - - ^ self + self graphicsDevice hasColors ifTrue:[ + continueButton foregroundColor:Color red darkened. + ]. + continueButton label:(resources string:'Stop'). + continueButton action:[self doStop]. + + self processPerform:#resume. + + ^ self ]. canContinue ifTrue:[ - exContext := thisContext findSpecialHandle:false raise:true. - - (exContext notNil - and:[ (ex := exContext receiver) isLazyValue not - and:[ ex isException - and:[ ex creator == NoHandlerError - and:[ ex exception creator == RecursionError]]]]) - ifTrue:[ - "/ debug due to unhandled recursionInterrupt. - "/ ask if we should proceed with more stack. - - answer := self confirm:'Debugger entered due to a stack overflow.\\Continue with more stack ?' withCRs. - answer == true ifTrue:[ - proc := Processor activeProcess. - proc setMaximumStackSize:(proc maximumStackSize * 2). - ]. - ]. - - steppedContext := wrapperContext := nil. - tracing := false. - haveControl := false. - exitAction := #continue. - - "exit private event-loop" - catchBlock value. - - "/ not reached. - 'DebugView [warning]: continue failed' errorPrintCR. - continueButton turnOff. + exContext := thisContext findSpecialHandle:false raise:true. + + (exContext notNil + and:[ (ex := exContext receiver) isLazyValue not + and:[ ex isException + and:[ ex creator == NoHandlerError + and:[ ex exception creator == RecursionError]]]]) + ifTrue:[ + "/ debug due to unhandled recursionInterrupt. + "/ ask if we should proceed with more stack. + + answer := self confirm:'Debugger entered due to a stack overflow.\\Continue with more stack ?' withCRs. + answer == true ifTrue:[ + proc := Processor activeProcess. + proc setMaximumStackSize:(proc maximumStackSize * 2). + ]. + ]. + + steppedContext := wrapperContext := nil. + tracing := false. + haveControl := false. + exitAction := #continue. + + "exit private event-loop" + catchBlock value. + + "/ not reached. + 'DebugView [warning]: continue failed' errorPrintCR. + continueButton turnOff. ] ifFalse:[ - inspecting ifFalse:[ - 'DebugView [info]: resuming top context' infoPrintCR. - self showSelection:1. - self doReturn - ] + inspecting ifFalse:[ + 'DebugView [info]: resuming top context' infoPrintCR. + self showSelection:1. + self doReturn + ] ] "Modified: / 5.10.1998 / 13:03:47 / cg" @@ -4845,43 +4845,43 @@ restart := true. selectorToDefine notNil ifTrue:[ - selector := selectorToDefine. - receiversClass := classToDefineIn. + selector := selectorToDefine. + receiversClass := classToDefineIn. ] ifFalse:[ - selector := actualContext selector. - receiversClass := actualContext receiver class. + selector := actualContext selector. + receiversClass := actualContext receiver class. ]. implClass := actualContext receiver class whichClassIncludesSelector:selector. implClass notNil ifTrue:[ - "/ must be a subclassResponsibility - - idx := contextArray identityIndexOf:actualContext. - idx > 1 ifTrue:[ - callee := contextArray at:idx-1. - - callee selector == #subclassResponsibility ifTrue:[ - restart := false. - ] - ]. + "/ must be a subclassResponsibility + + idx := contextArray identityIndexOf:actualContext. + idx > 1 ifTrue:[ + callee := contextArray at:idx-1. + + callee selector == #subclassResponsibility ifTrue:[ + restart := false. + ] + ]. ]. "generate nice argument names" bagOfClassNames := (actualContext args collect:[:eachArg | eachArg class name]) asBag. bagOfUsedClassNames := Bag new. argNames := actualContext args - collect: - [:eachArg | - |nm| - - nm := eachArg class nameWithoutPrefix. - (bagOfClassNames occurrencesOf:nm) == 1 ifTrue:[ - nm article , nm - ] ifFalse:[ - bagOfUsedClassNames add:nm. - nm asLowercaseFirst , (bagOfUsedClassNames occurrencesOf:nm) printString - ]. - ]. + collect: + [:eachArg | + |nm| + + nm := eachArg class nameWithoutPrefix. + (bagOfClassNames occurrencesOf:nm) == 1 ifTrue:[ + nm article , nm + ] ifFalse:[ + bagOfUsedClassNames add:nm. + nm asLowercaseFirst , (bagOfUsedClassNames occurrencesOf:nm) printString + ]. + ]. proto := Method methodDefinitionTemplateForSelector:selector andArgumentNames:argNames. @@ -4890,17 +4890,17 @@ ( { UndefinedObject . True . False } includes:receiversClass ) ifTrue:[ - (self confirm:'Are you sure you want to add this method (to ',receiversClass name,') ?') - ifFalse:[ - ^ self - ] + (self confirm:'Are you sure you want to add this method (to ',receiversClass name,') ?') + ifFalse:[ + ^ self + ] ]. "/ code for a getter (receiversClass instVarNames includes:selector) ifTrue:[ - code := '%1\' , haltStmtFix , '\ ^ %2'. - cat := 'accessing'. + code := '%1\' , haltStmtFix , '\ ^ %2'. + cat := 'accessing'. ]. "/ code for a setter @@ -4908,10 +4908,10 @@ and:[(selector endsWith:':') and:[receiversClass instVarNames includes:(selector copyButLast:1)]]) ifTrue:[ - varName := selector copyButLast:1. - argName := argNames first. - code := '%1\' , haltStmtFix , '\ %3 := %4.'. - cat := 'accessing'. + varName := selector copyButLast:1. + argName := argNames first. + code := '%1\' , haltStmtFix , '\ %3 := %4.'. + cat := 'accessing'. ]. "/ code for a tester @@ -4919,12 +4919,12 @@ and:[(selector startsWith:'is') and:[(Smalltalk classNamed:(selector copyFrom:3)) notNil ]]) ifTrue:[ - (receiversClass nameWithoutPrefix = (selector copyFrom:3)) ifTrue:[ - code := '%1\' , haltStmtFix , '\ ^ true.'. - ] ifFalse:[ - code := '%1\' , haltStmtFix , '\ ^ false.'. - ]. - cat := 'testing'. + (receiversClass nameWithoutPrefix = (selector copyFrom:3)) ifTrue:[ + code := '%1\' , haltStmtFix , '\ ^ true.'. + ] ifFalse:[ + code := '%1\' , haltStmtFix , '\ ^ false.'. + ]. + cat := 'testing'. ]. "/ actualContext receiver isClass ifTrue:[ @@ -4936,19 +4936,19 @@ "/ ]. "/ ]. code isNil ifTrue:[ - code := '%1\' , haltStmtDef + code := '%1\' , haltStmtDef ]. self - codeAccept:(code bindWith:proto with:selector with:varName with:argName) withCRs - inClass:receiversClass - unwind:false - category:cat - onCancel:[^ self]. + codeAccept:(code bindWith:proto with:selector with:varName with:argName) withCRs + inClass:receiversClass + unwind:false + category:cat + onCancel:[^ self]. self doShowSelection:selectionIndex. restart ifTrue:[ - self doRestart + self doRestart ] "Modified: / 23-03-2012 / 09:49:31 / cg" @@ -4960,21 +4960,21 @@ to quickly navigate to the responsible code of you application" contextArray keysAndValuesDo:[:i :c | - |nextCon nextRcvr dialog| - - "/ find the first appModel context - nextCon := contextArray at:i+1. - "/ - "/ while not in the appModel - "/ - [ - nextRcvr := nextCon receiver. - (nextRcvr isKindOf:ApplicationModel) - ] whileFalse:[ - nextCon := nextCon sender - ]. - self selectContext:nextCon. - ^ self. + |nextCon nextRcvr dialog| + + "/ find the first appModel context + nextCon := contextArray at:i+1. + "/ + "/ while not in the appModel + "/ + [ + nextRcvr := nextCon receiver. + (nextRcvr isKindOf:ApplicationModel) + ] whileFalse:[ + nextCon := nextCon sender + ]. + self selectContext:nextCon. + ^ self. ]. "/ not found gotoApplicationActionMethodButton disable. @@ -4986,66 +4986,66 @@ is open, to quickly navigate to the corresponding opening code of you application" contextArray keysAndValuesDo:[:i :c | - |nextCon nextRcvr dialog| - - "/ find the openModal, then walk upward - ((c selector == #openModal) or:[c selector == #openModal:]) ifTrue:[ - dialog := c receiver. - nextCon := contextArray at:i+1. - "/ - "/ while still in dialog code - "/ - [ - nextRcvr := nextCon receiver. - (nextRcvr == dialog) - or:[ nextRcvr == dialog class - or:[ nextRcvr == DialogBox ]] - ] whileTrue:[ - (nextCon isBlockContext and:[ nextCon methodHome notNil]) ifTrue:[ - nextCon := nextCon methodHome - ]. - nextCon := nextCon sender. - ]. - "/ - "/ while still in a Notification - "/ - [ - nextRcvr := nextCon receiver. - (nextRcvr isKindOf:UserInformation) - or:[ nextRcvr isBehavior - and:[nextRcvr includesBehavior:UserInformation]] - ] whileTrue:[ - nextCon := nextCon sender - ]. - "/ - "/ while still in UIBuilder - "/ - [ - nextRcvr := nextCon receiver. - (nextRcvr isKindOf:WindowBuilder) - ] whileTrue:[ - nextCon := nextCon sender - ]. - "/ - "/ while still in SimpleDialog - "/ - [ - nextRcvr := nextCon receiver. - (nextRcvr class == SimpleDialog) - ] whileTrue:[ - nextCon := nextCon sender - ]. - "/ - "/ while still in applicationModel support code - "/ - [ - (nextCon selector startsWith:'openDialogSpec'). - ] whileTrue:[ - nextCon := nextCon sender - ]. - self selectContext:nextCon. - ^ self. - ] + |nextCon nextRcvr dialog| + + "/ find the openModal, then walk upward + ((c selector == #openModal) or:[c selector == #openModal:]) ifTrue:[ + dialog := c receiver. + nextCon := contextArray at:i+1. + "/ + "/ while still in dialog code + "/ + [ + nextRcvr := nextCon receiver. + (nextRcvr == dialog) + or:[ nextRcvr == dialog class + or:[ nextRcvr == DialogBox ]] + ] whileTrue:[ + (nextCon isBlockContext and:[ nextCon methodHome notNil]) ifTrue:[ + nextCon := nextCon methodHome + ]. + nextCon := nextCon sender. + ]. + "/ + "/ while still in a Notification + "/ + [ + nextRcvr := nextCon receiver. + (nextRcvr isKindOf:UserInformation) + or:[ nextRcvr isBehavior + and:[nextRcvr includesBehavior:UserInformation]] + ] whileTrue:[ + nextCon := nextCon sender + ]. + "/ + "/ while still in UIBuilder + "/ + [ + nextRcvr := nextCon receiver. + (nextRcvr isKindOf:WindowBuilder) + ] whileTrue:[ + nextCon := nextCon sender + ]. + "/ + "/ while still in SimpleDialog + "/ + [ + nextRcvr := nextCon receiver. + (nextRcvr class == SimpleDialog) + ] whileTrue:[ + nextCon := nextCon sender + ]. + "/ + "/ while still in applicationModel support code + "/ + [ + (nextCon selector startsWith:'openDialogSpec'). + ] whileTrue:[ + nextCon := nextCon sender + ]. + self selectContext:nextCon. + ^ self. + ] ]. "/ not found gotoDialogOpenerButton disable. @@ -5061,23 +5061,23 @@ inspecting ifTrue:[^ self]. self checkIfCodeIsReallyModified ifTrue:[ - (self confirm:('Code modified - step anyway ?')) - ifFalse:[ - ^ self - ] + (self confirm:('Code 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" @@ -5120,8 +5120,8 @@ doNoTrace traceView notNil ifTrue:[ - traceView topView destroy. - traceView := nil. + traceView topView destroy. + traceView := nil. ]. tracing := false ! @@ -5134,9 +5134,9 @@ str := '' writeStream. str nextPutLine:('Error notification from ' - , OperatingSystem getLoginName - , '@' - , OperatingSystem getHostName). + , OperatingSystem getLoginName + , '@' + , OperatingSystem getHostName). str cr. str nextPutLine:('Time: ' , Timestamp now printString). @@ -5149,16 +5149,16 @@ str cr. firstContext notNil ifTrue:[ - firstContext fullPrintAllOn:str. + firstContext fullPrintAllOn:str. ]. str cr;cr. SendMailTool - openForMessage:(str contents) - withSubject:('STX Error:[', self label, ']') - preOpenBlock:[:inst| - inst recipientEntryField value:'error@exept.de' - ]. + openForMessage:(str contents) + withSubject:('STX Error:[', self label, ']') + preOpenBlock:[:inst| + inst recipientEntryField value:'error@exept.de' + ]. "Modified: / 20-09-2007 / 12:40:40 / cg" ! @@ -5168,12 +5168,12 @@ To be done after a cde change, to get nto the new method" self checkIfCodeIsReallyModified ifTrue:[ - (self confirm:('Code modified - resend anyway ?')) ifFalse:[ - ^ self - ] + (self confirm:('Code modified - resend anyway ?')) ifFalse:[ + ^ self + ] ]. inspecting ifTrue:[ - ^ self showError:'** not avail in inspecting debugger **' + ^ self showError:'** not avail in inspecting debugger **' ]. steppedContext := wrapperContext := nil. haveControl := false. @@ -5191,16 +5191,16 @@ "restart - the selected context will be restarted" self checkIfCodeIsReallyModified ifTrue:[ - (self confirm:('Code modified - restart anyway ?')) ifFalse:[ - ^ self - ] + (self confirm:('Code modified - restart anyway ?')) ifFalse:[ + ^ self + ] ]. inspecting ifTrue:[ - selectedContext isNil ifTrue:[ - ^ self showError:'** select a context first **' - ]. - self interruptProcessWith:[ selectedContext unwindAndRestart ]. - ^ self + selectedContext isNil ifTrue:[ + ^ self showError:'** select a context first **' + ]. + self interruptProcessWith:[ selectedContext unwindAndRestart ]. + ^ self ]. steppedContext := wrapperContext := nil. haveControl := false. @@ -5220,18 +5220,18 @@ "return - the selected context will do a ^nil" self checkIfCodeIsReallyModified ifTrue:[ - (self confirm:('Code modified - return anyway ?')) - ifFalse:[ - ^ self - ] + (self confirm:('Code modified - return anyway ?')) + ifFalse:[ + ^ self + ] ]. inspecting ifTrue:[ - selectedContext isNil ifTrue:[ - ^ self showError:'** select a context first **' - ]. - self interruptProcessWith:[selectedContext unwind:nil]. - ^ self + selectedContext isNil ifTrue:[ + ^ self showError:'** select a context first **' + ]. + self interruptProcessWith:[selectedContext unwind:nil]. + ^ self ]. steppedContext := wrapperContext := nil. @@ -5291,70 +5291,70 @@ inspecting ifTrue:[^ self]. self checkIfCodeIsReallyModified ifTrue:[ - (self confirm:('Code modified - step anyway ?')) - ifFalse:[ - ^ self - ] + (self confirm:('Code 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" @@ -5369,15 +5369,15 @@ "stop the process (if its running, otherwise this is a no-op)" inspecting ifTrue:[ - self graphicsDevice hasColors ifTrue:[ - continueButton foregroundColor:Color green darkened darkened. - ]. - continueButton label:(resources string:'Continue'). - continueButton action:[self doContinue]. - - self processPerform:#stop. - - ^ self + self graphicsDevice hasColors ifTrue:[ + continueButton foregroundColor:Color green darkened darkened. + ]. + continueButton label:(resources string:'Continue'). + continueButton action:[self doContinue]. + + self processPerform:#stop. + + ^ self ]. "Modified: 20.10.1996 / 18:30:48 / cg" @@ -5387,15 +5387,15 @@ "terminate - the process has a chance for cleanup" self checkIfCodeIsReallyModified ifTrue:[ - (self confirm:('Code modified - terminate anyway ?')) - ifFalse:[ - ^ self - ] + (self confirm:('Code modified - terminate anyway ?')) + ifFalse:[ + ^ self + ] ]. inspecting ifTrue:[ - self processPerform:#terminate. - ^ self + self processPerform:#terminate. + ^ self ]. steppedContext := wrapperContext := nil. @@ -5407,11 +5407,11 @@ "/ not reached (normally) inspecting ifFalse:[ - 'DebugView [warning]: terminate failed' errorPrintCR. - (self confirm:'Regular terminate failed - do it the hard way ?') ifTrue:[ - Debugger newDebugger. - Processor activeProcess terminate. - ] + 'DebugView [warning]: terminate failed' errorPrintCR. + (self confirm:'Regular terminate failed - do it the hard way ?') ifTrue:[ + Debugger newDebugger. + Processor activeProcess terminate. + ] ]. terminateButton turnOff. @@ -5451,8 +5451,8 @@ "tracestep - not implemented yet" canContinue ifTrue:[ - tracing := true. - self doStep + tracing := true. + self doStep ] ! @@ -5470,13 +5470,13 @@ con := con sender. [con notNil] whileTrue:[ - (aBlock value:con) ifTrue:[ - (self selectContext:con) ifTrue:[ - additionalAction value:con. - ^ self. - ] - ]. - con := con sender. + (aBlock value:con) ifTrue:[ + (self selectContext:con) ifTrue:[ + additionalAction value:con. + ^ self. + ] + ]. + con := con sender. ]. Dialog information:'None found'. @@ -5488,15 +5488,15 @@ stringToSearch := Dialog request:'Search what:'. stringToSearch isEmptyOrNil ifTrue:[^ self]. - self - findContextForWhich:[:con | - con method notNil - and:[ (source := con method source) notNil - and:[ (source includesString:stringToSearch) ]] - ] - thenDo:[:con | - codeView searchFwd:stringToSearch. - ] + self + findContextForWhich:[:con | + con method notNil + and:[ (source := con method source) notNil + and:[ (source includesString:stringToSearch) ]] + ] + thenDo:[:con | + codeView searchFwd:stringToSearch. + ] ! findContextWithValueInVariable @@ -5505,73 +5505,73 @@ valueStringToSearch := Dialog request:'Search for a local value whith printString containing:'. valueStringToSearch isEmptyOrNil ifTrue:[^ self]. - self - findContextForWhich:[:con | - con argsAndVars contains:[:val | val printString asLowercase includesString: valueStringToSearch asLowercase] - ] - thenDo:[:con | ] + self + findContextForWhich:[:con | + con argsAndVars contains:[:val | val printString asLowercase includesString: valueStringToSearch asLowercase] + ] + thenDo:[:con | ] ! findHandlerFor |exClass con| - (con := self selectedContext) isNil ifTrue:[ - con := contextArray at:1 + (con := self selectedContext) isNil ifTrue:[ + con := contextArray at:1 ]. con sender isNil ifTrue:[ - self information:'Context has already returned'. - ^ self - ]. - - exClass := Dialog - choose:'Exception class:' - fromList:(GenericException withAllSubclasses copyAsOrderedCollection sort:[:a :b | a name < b name]) - lines:25 - title:'Choose Exception class'. + self information:'Context has already returned'. + ^ self + ]. + + exClass := Dialog + choose:'Exception class:' + fromList:(GenericException withAllSubclasses copyAsOrderedCollection sort:[:a :b | a name < b name]) + lines:25 + title:'Choose Exception class'. exClass isNil ifTrue:[^ self]. - self - findContextForWhich:[:con | - con isHandleContext - and:[ (con receiver handlerForSignal:exClass context:con originator:nil) notNil ] - ] - thenDo:[:con | - self selectContext:con sender. - ] + self + findContextForWhich:[:con | + con isHandleContext + and:[ (con receiver handlerForSignal:exClass context:con originator:nil) notNil ] + ] + thenDo:[:con | + self selectContext:con sender. + ] ! findHomeContext |con home| (con := self selectedContext) isNil ifTrue:[ - self beep. - ^ self. + self beep. + ^ self. ]. (home := con home) isNil ifTrue:[ - self beep. - ^ self. + self beep. + ^ self. ]. "/ still have to find it - home could be elsewhere (another process) "/ (i.e. cannot simply select it) - self - findContextForWhich:[:con | - con == home - ] - thenDo:[:con | - self selectContext:con. - ] + self + findContextForWhich:[:con | + con == home + ] + thenDo:[:con | + self selectContext:con. + ] ! findNextExceptionHandlerContext - self - findContextForWhich:[:con | - con isHandleContext - ] - thenDo:[:con | - self selectContext:con sender. - ] + self + findContextForWhich:[:con | + con isHandleContext + ] + thenDo:[:con | + self selectContext:con sender. + ] ! inspectContext @@ -5580,7 +5580,7 @@ |con| (con := self selectedContext) notNil ifTrue:[ - con inspect. + con inspect. ] "Modified: / 17-07-2012 / 12:52:34 / cg" @@ -5592,7 +5592,7 @@ |con| (con := self selectedContext) notNil ifTrue:[ - con method inspect. + con method inspect. ] ! @@ -5601,15 +5601,15 @@ selectedContext isNil ifTrue:[ ^ self ]. Tools::ViewTreeInspectorApplication isNil ifTrue:[ - Dialog warn:'Missing class: Tools::ViewTreeInspectorApplication'. - ^ self. + Dialog warn:'Missing class: Tools::ViewTreeInspectorApplication'. + ^ self. ]. rcvr := selectedContext receiver. rcvr isView ifTrue:[ - view := rcvr + view := rcvr ] ifFalse:[ - view := rcvr window + view := rcvr window ]. Tools::ViewTreeInspectorApplication openOn:view ! @@ -5620,38 +5620,38 @@ |items m nameOfExecutable| exclusive ifTrue:[ - items := #( - ('Show More WalkBack' showMore ) - ('-' ) - ('Add Breakpoint' addBreakpoint ) - ('Remove Breakpoint' removeBreakpoint ) - ('Remove all Break- && Tracepoints' removeAllBreakpoints ) - ('-' ) - ). + items := #( + ('Show More WalkBack' showMore ) + ('-' ) + ('Add Breakpoint' addBreakpoint ) + ('Remove Breakpoint' removeBreakpoint ) + ('Remove all Break- && Tracepoints' removeAllBreakpoints ) + ('-' ) + ). ] ifFalse:[ - items := #( - ('Show More WalkBack' showMore ) - ('-' ) - ('Skip' skip ) - ('Step Out' skipForReturn ) - ('Skip until Entering...' skipUntilEntering ) - ('-' ) + items := #( + ('Show More WalkBack' showMore ) + ('-' ) + ('Skip' skip ) + ('Step Out' skipForReturn ) + ('Skip until Entering...' skipUntilEntering ) + ('-' ) " - ('Continue' doContinue ) - ('Terminate' doTerminate ) - ('Abort' doAbort ) - ('-' ) - ('Step' doStep ) - ('Send' doSend ) - ('-' ) - ('Return' doReturn ) - ('Restart' doRestart ) - ('-' ) + ('Continue' doContinue ) + ('Terminate' doTerminate ) + ('Abort' doAbort ) + ('-' ) + ('Step' doStep ) + ('Send' doSend ) + ('-' ) + ('Return' doReturn ) + ('Restart' doRestart ) + ('-' ) " - ('Add Breakpoint' addBreakpoint ) - ('Remove Breakpoint' removeBreakpoint ) - ('Remove all Break- & Tracepoints' removeAllBreakpoints ) - ). + ('Add Breakpoint' addBreakpoint ) + ('Remove Breakpoint' removeBreakpoint ) + ('Remove all Break- & Tracepoints' removeAllBreakpoints ) + ). "/ self allowBreakPointsInDebugger ifFalse:[ "/ items := items , #( @@ -5663,46 +5663,46 @@ "/ ). "/ ]. - items := items , #( - ('-' ) - ('Browse Implementing Class' browseImplementingClass ) - ('Browse Receiver''s Class' browseReceiversClass ) - ('Browse Blocks''s Home' browseBlocksHome ) + items := items , #( + ('-' ) + ('Browse Implementing Class' browseImplementingClass ) + ('Browse Receiver''s Class' browseReceiversClass ) + ('Browse Blocks''s Home' browseBlocksHome ) "/ ('Browse Receivers Class Hierarchy' browseClassHierarchy ) "/ ('Browse Receivers Full Protocol' browseFullClassProtocol ) - ('Implementors' browseImplementors ) - ('Implementors Of...' browseImplementorsOf ) - ('Senders' browseSenders ) - ('Senders Of...' browseSendersOf ) - ('-' ) - ('Inspect Context' inspectContext ) - ). + ('Implementors' browseImplementors ) + ('Implementors Of...' browseImplementorsOf ) + ('Senders' browseSenders ) + ('Senders Of...' browseSendersOf ) + ('-' ) + ('Inspect Context' inspectContext ) + ). ]. items := items , #( - ('Copy WalkBack Text' copyWalkbackText ) - ('-' ) - ('Hard Terminate (Danger)' quickTerminate ) - ('=' )). + ('Copy WalkBack Text' copyWalkbackText ) + ('-' ) + ('Hard Terminate (Danger)' quickTerminate ) + ('=' )). nameOfExecutable := OperatingSystem nameOfSTXExecutable asFilename withoutSuffix baseName. nameOfExecutable = 'stx' ifTrue:[ nameOfExecutable := 'Smalltalk' ]. items := items , { - { 'Exit %1 (No Confirmation)' bindWith:nameOfExecutable. #exit }}. + { 'Exit %1 (No Confirmation)' bindWith:nameOfExecutable. #exit }}. m := PopUpMenu - itemList:items - resources:resources - receiver:self - for:contextView. + itemList:items + resources:resources + receiver:self + for:contextView. inspecting ifTrue:[ - m notNil ifTrue:[ - m disableAll:#(doTraceStep removeBreakpoint browseImplementingClass browseReceiversClass - browseClassHierarchy browseFullClassProtocol - browseImplementors browseSenders browseBlocksHome inspectContext skip doStepOut). - ]. + m notNil ifTrue:[ + m disableAll:#(doTraceStep removeBreakpoint browseImplementingClass browseReceiversClass + browseClassHierarchy browseFullClassProtocol + browseImplementors browseSenders browseBlocksHome inspectContext skip doStepOut). + ]. ]. self updateMenuItems. @@ -5733,16 +5733,16 @@ |settingsList| settingsList := - #( - #('Debugger' #'AbstractSettingsApplication::DebuggerSettingsAppl' ) - #('Editor' #'AbstractSettingsApplication::EditSettingsAppl' ) - #('Syntax Color' #'AbstractSettingsApplication::SyntaxColorSettingsAppl' ) - #('Code Format' #'AbstractSettingsApplication::SourceCodeFormatSettingsAppl' ) - ). - - SettingsDialog - openWithList:settingsList - label:(resources string:'Debugger Settings'). + #( + #('Debugger' #'AbstractSettingsApplication::DebuggerSettingsAppl' ) + #('Editor' #'AbstractSettingsApplication::EditSettingsAppl' ) + #('Syntax Color' #'AbstractSettingsApplication::SyntaxColorSettingsAppl' ) + #('Code Format' #'AbstractSettingsApplication::SourceCodeFormatSettingsAppl' ) + ). + + SettingsDialog + openWithList:settingsList + label:(resources string:'Debugger Settings'). ! processesApplication @@ -5754,23 +5754,23 @@ p := inspectedProcess ? Processor activeProcess. (p notNil and:[p isGUIProcess]) ifTrue:[ - wgs := WindowGroup scheduledWindowGroups select:[:wg | wg process == p]. - nonModalWGs := wgs reject:[:wg | wg isModal]. - nonModalWGs notEmpty ifTrue:[^ nonModalWGs first application]. - - wgs do:[:wg | - |wgi| - - wgi := wg. - [wgi notNil] whileTrue:[ - (app := wgi application) notNil ifTrue:[^ app]. - wgi isModal ifTrue:[ - wgi := wgi previousGroup - ] ifFalse:[ - wgi := nil. - ] - ] - ] + wgs := WindowGroup scheduledWindowGroups select:[:wg | wg process == p]. + nonModalWGs := wgs reject:[:wg | wg isModal]. + nonModalWGs notEmpty ifTrue:[^ nonModalWGs first application]. + + wgs do:[:wg | + |wgi| + + wgi := wg. + [wgi notNil] whileTrue:[ + (app := wgi application) notNil ifTrue:[^ app]. + wgi isModal ifTrue:[ + wgi := wgi previousGroup + ] ifFalse:[ + wgi := nil. + ] + ] + ] ]. ^ nil ! @@ -5779,8 +5779,8 @@ "quick terminate - the process will get no chance for cleanup actions" inspecting ifTrue:[ - self processPerform:#terminateNoSignal. - ^ self + self processPerform:#terminateNoSignal. + ^ self ]. steppedContext := wrapperContext := nil. @@ -5792,11 +5792,11 @@ "/ not reached (normally) inspecting ifFalse:[ - 'DebugView [warning]: quick terminate failed' errorPrintCR. - (self confirm:'Regular quick terminate failed - do it the hard way ?') ifTrue:[ - Debugger newDebugger. - Processor activeProcess terminateNoSignal. - ] + 'DebugView [warning]: quick terminate failed' errorPrintCR. + (self confirm:'Regular quick terminate failed - do it the hard way ?') ifTrue:[ + Debugger newDebugger. + Processor activeProcess terminateNoSignal. + ] ]. terminateButton turnOff. @@ -5819,27 +5819,27 @@ idx := contextArray identityIndexOf:aContext. idx == 0 ifTrue:[ - "/ some contexts hidden? - (self showingDenseWalkback or:[self showingSupportCode not]) ifTrue:[ - Dialog information:'Context is hidden - disabling the "hideSupportCode" option (see view menu)'. - self showFullWalkback. - self showingDenseWalkback:false. - self showingSupportCode:true. - ]. - idx := contextArray identityIndexOf:aContext. + "/ some contexts hidden? + (self showingDenseWalkback or:[self showingSupportCode not]) ifTrue:[ + Dialog information:'Context is hidden - disabling the "hideSupportCode" option (see view menu)'. + self showFullWalkback. + self showingDenseWalkback:false. + self showingSupportCode:true. + ]. + idx := contextArray identityIndexOf:aContext. ]. idx ~~ 0 ifTrue:[ - self selectContextWithIndex:idx. - ^ true. + self selectContextWithIndex:idx. + ^ true. ]. ^ false ! selectedContext contextView selection notNil ifTrue:[ - (contextView selectionValue startsWith:'**') ifFalse:[ - ^ (contextArray at:(contextView selection)). - ] + (contextView selectionValue startsWith:'**') ifFalse:[ + ^ (contextArray at:(contextView selection)). + ] ]. ^ nil @@ -5850,8 +5850,8 @@ "double the number of contexts shown" contextArray notNil ifTrue:[ - nChainShown := 9999. - self redisplayBacktrace. + nChainShown := 9999. + self redisplayBacktrace. ] "Created: / 23-07-2012 / 12:24:02 / cg" @@ -5861,8 +5861,8 @@ "double the number of contexts shown" contextArray notNil ifTrue:[ - nChainShown := nChainShown * 2. - self redisplayBacktrace. + nChainShown := nChainShown * 2. + self redisplayBacktrace. ] "Modified: / 17.11.2001 / 20:14:31 / cg" @@ -5942,8 +5942,8 @@ |selector| selector := Dialog - request:'Skip until entering what (matchpattern):' - initialAnswer:self goodSkipUntilSelector. + request:'Skip until entering what (matchpattern):' + initialAnswer:self goodSkipUntilSelector. selector size == 0 ifTrue:[^ self]. stepUntilEntering := selector asSymbol. @@ -5955,9 +5955,9 @@ toggleShowSupportCode hideSupportCode ifTrue:[ - self showSupportCode + self showSupportCode ] ifFalse:[ - self hideSupportCode + self hideSupportCode ]. "Modified: / 17-11-2001 / 20:07:45 / cg" @@ -5977,59 +5977,59 @@ m := contextView middleButtonMenu. m notNil ifTrue:[ - m disable:#removeBreakpoint. - m disable:#addBreakpoint. - canShowMore ifFalse:[ - m disable:#showMore - ]. - - selectedContext notNil ifTrue:[ - m enableAll:#(browseImplementors browseSenders inspectContext skip skipForReturn). - - mthd := selectedContext method. - mthd notNil ifTrue:[ - cls := mCls := mthd containingClass. - mthd isBreakpointed ifTrue:[ - m enable:#removeBreakpoint. - ] ifFalse:[ - m enable:#addBreakpoint. - ] - ]. - (selectedContext isBlockContext and:[selectedContext home isNil]) ifTrue:[ - "/ a cheap block's context - ] ifFalse:[ - rCls := selectedContext receiver class. - cls isNil ifTrue:[ - cls := rCls - ]. - ]. - cls notNil ifTrue:[ - m enableAll:#(browseImplementingClass browseReceiversClass browseClassHierarchy browseFullClassProtocol). - rCls == mCls ifTrue:[ - m disable:#browseReceiversClass - ]. - mCls isNil ifTrue:[ - m disable:#browseImplementingClass - ] - - ] ifFalse:[ - m disableAll:#(browseImplementingClass browseReceiversClass browseClassHierarchy browseFullClassProtocol). - ]. - mthd notNil ifTrue:[ - m enableAll:#(browseImplementingClass). - ]. - selectedContext isCheapBlockContext ifTrue:[ - m disableAll:#(browseReceiversClass). - ]. - selectedContext receiver isBlock ifTrue:[ - m enableAll:#(browseBlocksHome). - ] ifFalse:[ - m disableAll:#(browseBlocksHome). - ]. - ] ifFalse:[ - m disableAll:#(browseImplementingClass browseReceiversClass browseClassHierarchy - browseBlocksHome browseFullClassProtocol). - ] + m disable:#removeBreakpoint. + m disable:#addBreakpoint. + canShowMore ifFalse:[ + m disable:#showMore + ]. + + selectedContext notNil ifTrue:[ + m enableAll:#(browseImplementors browseSenders inspectContext skip skipForReturn). + + mthd := selectedContext method. + mthd notNil ifTrue:[ + cls := mCls := mthd containingClass. + mthd isBreakpointed ifTrue:[ + m enable:#removeBreakpoint. + ] ifFalse:[ + m enable:#addBreakpoint. + ] + ]. + (selectedContext isBlockContext and:[selectedContext home isNil]) ifTrue:[ + "/ a cheap block's context + ] ifFalse:[ + rCls := selectedContext receiver class. + cls isNil ifTrue:[ + cls := rCls + ]. + ]. + cls notNil ifTrue:[ + m enableAll:#(browseImplementingClass browseReceiversClass browseClassHierarchy browseFullClassProtocol). + rCls == mCls ifTrue:[ + m disable:#browseReceiversClass + ]. + mCls isNil ifTrue:[ + m disable:#browseImplementingClass + ] + + ] ifFalse:[ + m disableAll:#(browseImplementingClass browseReceiversClass browseClassHierarchy browseFullClassProtocol). + ]. + mthd notNil ifTrue:[ + m enableAll:#(browseImplementingClass). + ]. + selectedContext isCheapBlockContext ifTrue:[ + m disableAll:#(browseReceiversClass). + ]. + selectedContext receiver isBlock ifTrue:[ + m enableAll:#(browseBlocksHome). + ] ifFalse:[ + m disableAll:#(browseBlocksHome). + ]. + ] ifFalse:[ + m disableAll:#(browseImplementingClass browseReceiversClass browseClassHierarchy + browseBlocksHome browseFullClassProtocol). + ] ] "Modified: / 19-07-2012 / 11:53:30 / cg" @@ -6043,18 +6043,18 @@ |implementorClass method| selectedContext isNil ifTrue:[ - ^ self showError:'** select a context first **' + ^ self showError:'** select a context first **' ]. (MessageTracer isNil or:[MessageTracer isLoaded not]) ifTrue:[ - ^ self + ^ self ]. implementorClass := selectedContext methodClass. implementorClass notNil ifTrue:[ - method := implementorClass compiledMethodAt:selectedContext selector. - (method notNil and:[method isBreakpointed not]) ifTrue:[ - method setBreakPoint - ] + method := implementorClass compiledMethodAt:selectedContext selector. + (method notNil and:[method isBreakpointed not]) ifTrue:[ + method setBreakPoint + ] ]. contextView middleButtonMenu disable:#addBreakpoint. contextView middleButtonMenu enable:#removeBreakpoint. @@ -6081,49 +6081,49 @@ ! ignoreAllHaltsForCurrentProcess - self - addIgnoredHaltForCount:nil orTimeDuration:nil orUntilShiftKey:false - orThisReceiverClass:false orCurrentProcess:true - orIfCalledFromMethod:nil - forAll:true. + self + addIgnoredHaltForCount:nil orTimeDuration:nil orUntilShiftKey:false + orThisReceiverClass:false orCurrentProcess:true + orIfCalledFromMethod:nil + forAll:true. "Created: / 27-01-2012 / 11:32:14 / cg" ! ignoreAllHaltsForThisReceiverClass - self - addIgnoredHaltForCount:nil orTimeDuration:nil orUntilShiftKey:false - orThisReceiverClass:true orCurrentProcess:false - orIfCalledFromMethod:nil - forAll:true. + self + addIgnoredHaltForCount:nil orTimeDuration:nil orUntilShiftKey:false + orThisReceiverClass:true orCurrentProcess:false + orIfCalledFromMethod:nil + forAll:true. "Created: / 27-01-2012 / 11:32:14 / cg" ! ignoreAllHaltsForever - self - addIgnoredHaltForCount:-1 orTimeDuration:nil orUntilShiftKey:false - orThisReceiverClass:false orCurrentProcess:false - orIfCalledFromMethod:nil - forAll:true. + self + addIgnoredHaltForCount:-1 orTimeDuration:nil orUntilShiftKey:false + orThisReceiverClass:false orCurrentProcess:false + orIfCalledFromMethod:nil + forAll:true. "Created: / 08-05-2011 / 10:19:56 / cg" ! ignoreAllHaltsIfCalledFromMethod:aMethod - self - addIgnoredHaltForCount:nil orTimeDuration:nil orUntilShiftKey:false - orThisReceiverClass:false orCurrentProcess:false - orIfCalledFromMethod:aMethod - forAll:true. + self + addIgnoredHaltForCount:nil orTimeDuration:nil orUntilShiftKey:false + orThisReceiverClass:false orCurrentProcess:false + orIfCalledFromMethod:aMethod + forAll:true. ! ignoreAllHaltsUntilShiftKeyIsPressed - self - addIgnoredHaltForCount:nil orTimeDuration:nil orUntilShiftKey:true - orThisReceiverClass:false orCurrentProcess:false - orIfCalledFromMethod:nil - forAll:true. + self + addIgnoredHaltForCount:nil orTimeDuration:nil orUntilShiftKey:true + orThisReceiverClass:false orCurrentProcess:false + orIfCalledFromMethod:nil + forAll:true. "Created: / 27-01-2012 / 11:32:14 / cg" ! @@ -6136,59 +6136,59 @@ ! ignoreBreakpointsWithThisParameterUntilShiftKeyIsPressed - self - addIgnoredHaltForCount:nil orTimeDuration:nil orUntilShiftKey:true - orThisReceiverClass:false orCurrentProcess:false - orIfCalledFromMethod:nil - forAll:false. + self + addIgnoredHaltForCount:nil orTimeDuration:nil orUntilShiftKey:true + orThisReceiverClass:false orCurrentProcess:false + orIfCalledFromMethod:nil + forAll:false. "Created: / 06-03-2012 / 12:35:22 / cg" ! ignoreHaltForCurrentProcess - self - addIgnoredHaltForCount:nil orTimeDuration:nil orUntilShiftKey:false - orThisReceiverClass:false orCurrentProcess:true - orIfCalledFromMethod:nil - forAll:false. + self + addIgnoredHaltForCount:nil orTimeDuration:nil orUntilShiftKey:false + orThisReceiverClass:false orCurrentProcess:true + orIfCalledFromMethod:nil + forAll:false. "Created: / 27-01-2012 / 11:32:14 / cg" ! ignoreHaltForThisReceiverClass - self - addIgnoredHaltForCount:nil orTimeDuration:nil orUntilShiftKey:false - orThisReceiverClass:true orCurrentProcess:false - orIfCalledFromMethod:nil - forAll:false. + self + addIgnoredHaltForCount:nil orTimeDuration:nil orUntilShiftKey:false + orThisReceiverClass:true orCurrentProcess:false + orIfCalledFromMethod:nil + forAll:false. "Created: / 27-01-2012 / 11:32:14 / cg" ! ignoreHaltForever - self - addIgnoredHaltForCount:-1 orTimeDuration:nil orUntilShiftKey:false - orThisReceiverClass:false orCurrentProcess:false - orIfCalledFromMethod:nil - forAll:false. + self + addIgnoredHaltForCount:-1 orTimeDuration:nil orUntilShiftKey:false + orThisReceiverClass:false orCurrentProcess:false + orIfCalledFromMethod:nil + forAll:false. "Modified: / 27-01-2012 / 11:31:37 / cg" ! ignoreHaltIfCalledFromMethod:aMethod - self - addIgnoredHaltForCount:nil orTimeDuration:nil orUntilShiftKey:false - orThisReceiverClass:false orCurrentProcess:false - orIfCalledFromMethod:aMethod - forAll:false. + self + addIgnoredHaltForCount:nil orTimeDuration:nil orUntilShiftKey:false + orThisReceiverClass:false orCurrentProcess:false + orIfCalledFromMethod:aMethod + forAll:false. ! ignoreHaltUntilShiftKeyIsPressed - self - addIgnoredHaltForCount:nil orTimeDuration:nil orUntilShiftKey:true - orThisReceiverClass:false orCurrentProcess:false - orIfCalledFromMethod:nil - forAll:false. + self + addIgnoredHaltForCount:nil orTimeDuration:nil orUntilShiftKey:true + orThisReceiverClass:false orCurrentProcess:false + orIfCalledFromMethod:nil + forAll:false. "Created: / 27-01-2012 / 11:36:54 / cg" ! @@ -6215,27 +6215,27 @@ already := IdentitySet new. contextArray do:[:con | - |mthd cls sel| - - mthd := con method. - mthd notNil ifTrue:[ - mthd isWrapped ifFalse:[ - (already includes:already) ifFalse:[ - already add:mthd. - m addItem:(MenuItem - label: (mthd whoString) - itemValue: [ forAllHaltsBoolean - ifTrue:[self ignoreHaltIfCalledFromMethod:mthd] - ifFalse:[self ignoreAllHaltsIfCalledFromMethod:mthd] - ] - translateLabel: false). - count := count + 1. - (count > 20) ifTrue:[ - ^ m - ]. - ] - ] - ] + |mthd cls sel| + + mthd := con method. + mthd notNil ifTrue:[ + mthd isWrapped ifFalse:[ + (already includes:already) ifFalse:[ + already add:mthd. + m addItem:(MenuItem + label: (mthd whoString) + itemValue: [ forAllHaltsBoolean + ifTrue:[self ignoreHaltIfCalledFromMethod:mthd] + ifFalse:[self ignoreAllHaltsIfCalledFromMethod:mthd] + ] + translateLabel: false). + count := count + 1. + (count > 20) ifTrue:[ + ^ m + ]. + ] + ] + ] ]. ^ m ! @@ -6250,21 +6250,21 @@ |answer dT| [ - answer := Dialog - request:(resources string:'How long should all halts/breakpoints be ignored [smh] ?') - initialAnswer:(LastIgnoreHaltDuration ? '30s') printString. - answer isEmptyOrNil ifTrue:[^ self]. - - dT := TimeDuration readFrom:answer onError:[ nil ]. - dT notNil ifTrue:[ - LastIgnoreHaltDuration := dT. - self - addIgnoredHaltForCount:nil orTimeDuration:dT orUntilShiftKey:false - orThisReceiverClass:false orCurrentProcess:false - orIfCalledFromMethod:nil - forAll:true. - ^ self. - ]. + answer := Dialog + request:(resources string:'How long should all halts/breakpoints be ignored [smh] ?') + initialAnswer:(LastIgnoreHaltDuration ? '30s') printString. + answer isEmptyOrNil ifTrue:[^ self]. + + dT := TimeDuration readFrom:answer onError:[ nil ]. + dT notNil ifTrue:[ + LastIgnoreHaltDuration := dT. + self + addIgnoredHaltForCount:nil orTimeDuration:dT orUntilShiftKey:false + orThisReceiverClass:false orCurrentProcess:false + orIfCalledFromMethod:nil + forAll:true. + ^ self. + ]. ] loop "Created: / 08-05-2011 / 10:19:20 / cg" @@ -6274,23 +6274,23 @@ |answer n| [ - answer := Dialog - request:(resources - string:'How often should breakpoints with parameter "%1" be ignored ?' - with:breakPointParameter) - initialAnswer:(LastIgnoreHaltNTimes ? '') printString. - answer isEmptyOrNil ifTrue:[^ self]. - - n := Integer readFrom:answer onError:nil. - n notNil ifTrue:[ - LastIgnoreHaltNTimes := n. - self - addIgnoredHaltForCount:n orTimeDuration:nil orUntilShiftKey:false - orThisReceiverClass:false orCurrentProcess:false - orIfCalledFromMethod:nil - forAll:false. - ^ self. - ]. + answer := Dialog + request:(resources + string:'How often should breakpoints with parameter "%1" be ignored ?' + with:breakPointParameter) + initialAnswer:(LastIgnoreHaltNTimes ? '') printString. + answer isEmptyOrNil ifTrue:[^ self]. + + n := Integer readFrom:answer onError:nil. + n notNil ifTrue:[ + LastIgnoreHaltNTimes := n. + self + addIgnoredHaltForCount:n orTimeDuration:nil orUntilShiftKey:false + orThisReceiverClass:false orCurrentProcess:false + orIfCalledFromMethod:nil + forAll:false. + ^ self. + ]. ] loop. "Modified: / 27-01-2012 / 11:31:44 / cg" @@ -6301,23 +6301,23 @@ |answer dT| [ - answer := Dialog - request:(resources - string:'How long should breakpoints with parameter "%1" be ignored (s/m/h) ?' - with:breakPointParameter) - initialAnswer:(LastIgnoreHaltDuration ? '30s') printString. - answer isEmptyOrNil ifTrue:[^ self]. - - dT := TimeDuration readFrom:answer onError:[ nil ]. - dT notNil ifTrue:[ - LastIgnoreHaltDuration := dT. - self - addIgnoredHaltForCount:nil orTimeDuration:dT orUntilShiftKey:false - orThisReceiverClass:false orCurrentProcess:false - orIfCalledFromMethod:nil - forAll:false. - ^ self. - ]. + answer := Dialog + request:(resources + string:'How long should breakpoints with parameter "%1" be ignored (s/m/h) ?' + with:breakPointParameter) + initialAnswer:(LastIgnoreHaltDuration ? '30s') printString. + answer isEmptyOrNil ifTrue:[^ self]. + + dT := TimeDuration readFrom:answer onError:[ nil ]. + dT notNil ifTrue:[ + LastIgnoreHaltDuration := dT. + self + addIgnoredHaltForCount:nil orTimeDuration:dT orUntilShiftKey:false + orThisReceiverClass:false orCurrentProcess:false + orIfCalledFromMethod:nil + forAll:false. + ^ self. + ]. ] loop "Created: / 06-03-2012 / 12:03:36 / cg" @@ -6327,21 +6327,21 @@ |answer n| [ - answer := Dialog - request:(resources string:'How often should this halt be ignored ?') - initialAnswer:(LastIgnoreHaltNTimes ? '') printString. - answer isEmptyOrNil ifTrue:[^ self]. - - n := Integer readFrom:answer onError:nil. - n notNil ifTrue:[ - LastIgnoreHaltNTimes := n. - self - addIgnoredHaltForCount:n orTimeDuration:nil orUntilShiftKey:false - orThisReceiverClass:false orCurrentProcess:false - orIfCalledFromMethod:nil - forAll:false. - ^ self. - ]. + answer := Dialog + request:(resources string:'How often should this halt be ignored ?') + initialAnswer:(LastIgnoreHaltNTimes ? '') printString. + answer isEmptyOrNil ifTrue:[^ self]. + + n := Integer readFrom:answer onError:nil. + n notNil ifTrue:[ + LastIgnoreHaltNTimes := n. + self + addIgnoredHaltForCount:n orTimeDuration:nil orUntilShiftKey:false + orThisReceiverClass:false orCurrentProcess:false + orIfCalledFromMethod:nil + forAll:false. + ^ self. + ]. ] loop. "Modified: / 27-01-2012 / 11:31:44 / cg" @@ -6351,21 +6351,21 @@ |answer dT| [ - answer := Dialog - request:(resources string:'How long should this halt/breakpoint be ignored (s/m/h) ?') - initialAnswer:(LastIgnoreHaltDuration ? '30s') printString. - answer isEmptyOrNil ifTrue:[^ self]. - - dT := TimeDuration readFrom:answer onError:[ nil ]. - dT notNil ifTrue:[ - LastIgnoreHaltDuration := dT. - self - addIgnoredHaltForCount:nil orTimeDuration:dT orUntilShiftKey:false - orThisReceiverClass:false orCurrentProcess:false - orIfCalledFromMethod:nil - forAll:false. - ^ self. - ]. + answer := Dialog + request:(resources string:'How long should this halt/breakpoint be ignored (s/m/h) ?') + initialAnswer:(LastIgnoreHaltDuration ? '30s') printString. + answer isEmptyOrNil ifTrue:[^ self]. + + dT := TimeDuration readFrom:answer onError:[ nil ]. + dT notNil ifTrue:[ + LastIgnoreHaltDuration := dT. + self + addIgnoredHaltForCount:nil orTimeDuration:dT orUntilShiftKey:false + orThisReceiverClass:false orCurrentProcess:false + orIfCalledFromMethod:nil + forAll:false. + ^ self. + ]. ] loop "Modified: / 27-01-2012 / 11:31:47 / cg" @@ -6375,12 +6375,12 @@ "remove all trace & breakpoints - if any" self withExecuteCursorDo:[ - (MessageTracer notNil and:[MessageTracer isLoaded]) ifTrue:[ - MessageTracer unwrapAllMethods - ]. - (MethodWithBreakpoints notNil and:[MethodWithBreakpoints isLoaded]) ifTrue:[ - MethodWithBreakpoints removeAllBreakpoints - ]. + (MessageTracer notNil and:[MessageTracer isLoaded]) ifTrue:[ + MessageTracer unwrapAllMethods + ]. + (MethodWithBreakpoints notNil and:[MethodWithBreakpoints isLoaded]) ifTrue:[ + MethodWithBreakpoints removeAllBreakpoints + ]. ] "Modified: / 21.5.1998 / 01:44:43 / cg" @@ -6392,18 +6392,18 @@ |implementorClass method| selectedContext isNil ifTrue:[ - ^ self showError:'** select a context first **' + ^ self showError:'** select a context first **' ]. (MessageTracer isNil or:[MessageTracer isLoaded not]) ifTrue:[ - ^ self + ^ self ]. implementorClass := selectedContext methodClass. implementorClass notNil ifTrue:[ - method := implementorClass compiledMethodAt:selectedContext selector. - (method notNil and:[method isBreakpointed]) ifTrue:[ - method clearBreakPoint - ] + method := implementorClass compiledMethodAt:selectedContext selector. + (method notNil and:[method isBreakpointed]) ifTrue:[ + method clearBreakPoint + ] ]. contextView middleButtonMenu disable:#removeBreakpoint. contextView middleButtonMenu enable:#addBreakpoint. @@ -6436,17 +6436,17 @@ interval := self selectedInterval. interval isEmpty ifTrue:[ - crsrPos := codeView characterPositionOfCursor. - codeView characterUnderCursor isSeparator ifTrue:[ - crsrPos := (crsrPos - 1) max:1 - ]. - interval := crsrPos to:crsrPos. + crsrPos := codeView characterPositionOfCursor. + codeView characterUnderCursor isSeparator ifTrue:[ + crsrPos := (crsrPos - 1) max:1 + ]. + interval := crsrPos to:crsrPos. ]. self - withNodeValueAtInterval:interval - do:[:value :description | - self showValue:value - ]. + withNodeValueAtInterval:interval + do:[:value :description | + self showValue:value + ]. ! findNodeForInterval:interval @@ -6472,14 +6472,14 @@ 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] - ] - ] + (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 ! @@ -6492,7 +6492,7 @@ current := selectedContext selector. current isNil ifTrue:[^ nil]. ('change:*' match:current) ifTrue:[ - ^ 'update:*' + ^ 'update:*' ]. ^ nil ! @@ -6507,8 +6507,8 @@ "let inspected process do something, then update the context list" inspectedProcess isDead ifTrue:[ - self showTerminated. - ^ self + self showTerminated. + ^ self ]. inspectedProcess interruptWith:aBlock. " @@ -6532,8 +6532,8 @@ "do something, then update the context list" inspectedProcess isDead ifTrue:[ - self showTerminated. - ^ self + self showTerminated. + ^ self ]. inspectedProcess perform:aMessage. @@ -6551,30 +6551,30 @@ |oldSelection oldContext con idx| contextArray notNil ifTrue:[ - self withExecuteCursorDo:[ - oldSelection := contextView selection. - oldSelection notNil ifTrue:[ - oldContext := contextArray at:oldSelection ifAbsent:nil. - ]. - - con := firstContext. + self withExecuteCursorDo:[ + oldSelection := contextView selection. + oldSelection notNil ifTrue:[ + oldContext := contextArray at:oldSelection ifAbsent:nil. + ]. + + con := firstContext. "/ con := contextArray at:1. - "/ force redeisplay, even if same by changing the first entry - contextArray size > 0 ifTrue:[ - contextArray at:1 put:nil. - ]. - self setContext:con. - - oldContext isNil ifTrue:[ - idx := oldSelection - ] ifFalse:[ - idx := contextArray identityIndexOf:oldContext ifAbsent:nil. - ]. - contextView setSelection:idx. - idx notNil ifTrue:[ - self showSelection:idx - ] - ] + "/ force redeisplay, even if same by changing the first entry + contextArray size > 0 ifTrue:[ + contextArray at:1 put:nil. + ]. + self setContext:con. + + oldContext isNil ifTrue:[ + idx := oldSelection + ] ifFalse:[ + idx := contextArray identityIndexOf:oldContext ifAbsent:nil. + ]. + contextView setSelection:idx. + idx notNil ifTrue:[ + self showSelection:idx + ] + ] ] "Created: / 10.1.1997 / 21:36:46 / cg" @@ -6588,16 +6588,16 @@ showError:message codeView contents:(resources string:message). shown ifTrue:[ - exclusive ifTrue:[ - "/ consider this a kludge: - "/ if exclusive, cannot use flash, since it suspends - "/ (but we cannot suspend here ...) - codeView redrawInverted. self flush. - OperatingSystem millisecondDelay:200. - codeView redraw - ] ifFalse:[ - codeView flash - ] + exclusive ifTrue:[ + "/ consider this a kludge: + "/ if exclusive, cannot use flash, since it suspends + "/ (but we cannot suspend here ...) + codeView redrawInverted. self flush. + OperatingSystem millisecondDelay:200. + codeView redraw + ] ifFalse:[ + codeView flash + ] ] "Modified: / 18.11.2001 / 00:01:13 / cg" @@ -6630,44 +6630,44 @@ m := contextView middleButtonMenu. m notNil ifTrue:[ - self updateMenuItems. - - (inspecting or:[AbortOperationRequest isHandledIn:aContext]) ifTrue:[ - abortButton enable. - m enable:#doAbort. - ] ifFalse:[ - abortButton disable. - m disable:#doAbort. - ]. - exclusive ifTrue:[ - terminateButton disable. - m disable:#doTerminate. - ] ifFalse:[ - terminateButton enable. - m enable:#doTerminate. - ]. + self updateMenuItems. + + (inspecting or:[AbortOperationRequest isHandledIn:aContext]) ifTrue:[ + abortButton enable. + m enable:#doAbort. + ] ifFalse:[ + abortButton disable. + m disable:#doAbort. + ]. + exclusive ifTrue:[ + terminateButton disable. + m disable:#doTerminate. + ] ifFalse:[ + terminateButton enable. + m enable:#doTerminate. + ]. ]. mayProceed == false ifTrue:[ - continueButton disable. - m notNil ifTrue:[m disable:#doContinue]. + continueButton disable. + m notNil ifTrue:[m disable:#doContinue]. ] ifFalse:[ - continueButton enable. - m notNil ifTrue:[m enable:#doContinue] + continueButton enable. + m notNil ifTrue:[m enable:#doContinue] ]. isStoppedInModalDialog ifTrue:[ - gotoDialogOpenerButton enable. - gotoDialogOpenerButton beVisible. + gotoDialogOpenerButton enable. + gotoDialogOpenerButton beVisible. ] ifFalse:[ - gotoDialogOpenerButton beInvisible. + gotoDialogOpenerButton beInvisible. ]. (isStoppedInModalDialog not & isStoppedInApplicationAction) ifTrue:[ - gotoApplicationActionMethodButton enable. - gotoApplicationActionMethodButton beVisible. + gotoApplicationActionMethodButton enable. + gotoApplicationActionMethodButton beVisible. ] ifFalse:[ - gotoApplicationActionMethodButton beInvisible. + gotoApplicationActionMethodButton beInvisible. ]. "Created: / 06-07-2011 / 12:24:53 / cg" @@ -6677,24 +6677,24 @@ |oldContext idx| inspectedProcess state == #dead ifTrue:[ - self showTerminated. - ^ self + self showTerminated. + ^ self ]. oldContext := selectedContext. [ - (self setContextSkippingInterruptContexts:inspectedProcess suspendedContext) ifTrue:[ - oldContext notNil ifTrue:[ - contextArray notNil ifTrue:[ - idx := contextArray identityIndexOf:oldContext. - idx ~~ 0 ifTrue:[ - self showSelection:idx - ] ifFalse:[ - codeView contents:('** context returned **') - ] - ] - ] - ]. + (self setContextSkippingInterruptContexts:inspectedProcess suspendedContext) ifTrue:[ + oldContext notNil ifTrue:[ + contextArray notNil ifTrue:[ + idx := contextArray identityIndexOf:oldContext. + idx ~~ 0 ifTrue:[ + self showSelection:idx + ] ifFalse:[ + codeView contents:('** context returned **') + ] + ] + ] + ]. ] valueUninterruptably. "Modified: 20.10.1996 / 18:11:24 / cg" @@ -6703,22 +6703,22 @@ withNodeValueAtInterval:interval do:aBlock "helper for flyByHelp and explan-selection" - |node definingNode nm nmBold nameSymbol + |node definingNode nm nmBold nameSymbol varIdx parentNode receiver con receiversNonMetaClass| "/ interval printCR. Error - handle:[:ex | ] - do:[ - [ - node := self findNodeForInterval:interval - ] valueWithWatchDog:[ ^ self ] afterMilliseconds:50. - ]. + handle:[:ex | ] + do:[ + [ + node := self findNodeForInterval:interval + ] valueWithWatchDog:[ ^ self ] afterMilliseconds:50. + ]. node isNil ifTrue:[ ^ self ]. node isVariable ifFalse:[ - "/ Transcript showCR:node. - ^ self + "/ Transcript showCR:node. + ^ self ]. nm := node name. @@ -6728,155 +6728,155 @@ receiver := actualContext methodHome receiver. (nm = 'self') ifTrue:[ - aBlock value:receiver value:'receiver' allBold. - ^ self + aBlock value:receiver value:'receiver' allBold. + ^ self ]. (nm = 'super') ifTrue:[ - aBlock value:receiver value:'receiver' allBold. - ^ self + aBlock value:receiver value:'receiver' allBold. + ^ self ]. (nm = 'thisContext') ifTrue:[ - aBlock value:actualContext value:'context' allBold. - ^ self + aBlock value:actualContext value:'context' allBold. + ^ self ]. definingNode := node whoDefines:nm. definingNode isNil ifTrue:[ - (receiver class allInstVarNames includes:nm) ifTrue:[ + (receiver class allInstVarNames includes:nm) ifTrue:[ "/aBlock value:'xIII' value:'instVar'. - receiver class isMetaclass ifTrue:[ - aBlock value:(receiver instVarNamed:nm) value:'classInstVar ',nmBold. - ] ifFalse:[ - aBlock value:(receiver instVarNamed:nm) value:'instVar ',nmBold. - ]. - ^ self - ]. - - receiversNonMetaClass := receiver class theNonMetaclass. - (receiversNonMetaClass privateClasses contains:[:cls | cls nameWithoutPrefix = nm]) ifTrue:[ - aBlock value:'' value:'private class ',nmBold. - ^ self - ]. - (receiversNonMetaClass classVarNames includes:nm) ifTrue:[ - aBlock value:((currentMethod mclass ? receiversNonMetaClass) theNonMetaclass classVarAt:nm) value:'classVar ',nmBold. - ^ self - ]. - receiversNonMetaClass sharedPoolNames do:[:eachPoolName | - |pool| - - pool := Smalltalk at:eachPoolName. - pool isNil ifTrue:[ pool := receiversNonMetaClass topNameSpace at:eachPoolName]. - (pool classVarNames includes:nm) ifTrue:[ - aBlock value:(pool classVarAt:nm) value:'poolVar ',nm allBold,' in ',eachPoolName allBold,' '. - ^ self - ]. - ]. - nameSymbol := nm asSymbolIfInterned. - nameSymbol notNil ifTrue:[ - (Smalltalk includesKey:nameSymbol) ifTrue:[ - (Smalltalk at:nameSymbol) isClass ifTrue:[ - aBlock value:'class: ',nmBold value:nil. - ] ifFalse:[ - aBlock value:(Smalltalk at:nameSymbol) value:'global ',nmBold. - ]. - ^ self - ]. - ]. - aBlock value:'' value:'unknown'. - ^ self + receiver class isMetaclass ifTrue:[ + aBlock value:(receiver instVarNamed:nm) value:'classInstVar ',nmBold. + ] ifFalse:[ + aBlock value:(receiver instVarNamed:nm) value:'instVar ',nmBold. + ]. + ^ self + ]. + + receiversNonMetaClass := receiver class theNonMetaclass. + (receiversNonMetaClass privateClasses contains:[:cls | cls nameWithoutPrefix = nm]) ifTrue:[ + aBlock value:'' value:'private class ',nmBold. + ^ self + ]. + (receiversNonMetaClass classVarNames includes:nm) ifTrue:[ + aBlock value:((currentMethod mclass ? receiversNonMetaClass) theNonMetaclass classVarAt:nm) value:'classVar ',nmBold. + ^ self + ]. + receiversNonMetaClass sharedPoolNames do:[:eachPoolName | + |pool| + + pool := Smalltalk at:eachPoolName. + pool isNil ifTrue:[ pool := receiversNonMetaClass topNameSpace at:eachPoolName]. + (pool classVarNames includes:nm) ifTrue:[ + aBlock value:(pool classVarAt:nm) value:'poolVar ',nm allBold,' in ',eachPoolName allBold,' '. + ^ self + ]. + ]. + nameSymbol := nm asSymbolIfInterned. + nameSymbol notNil ifTrue:[ + (Smalltalk includesKey:nameSymbol) ifTrue:[ + (Smalltalk at:nameSymbol) isClass ifTrue:[ + aBlock value:'class: ',nmBold value:nil. + ] ifFalse:[ + aBlock value:(Smalltalk at:nameSymbol) value:'global ',nmBold. + ]. + ^ self + ]. + ]. + aBlock value:'' value:'unknown'. + ^ self ]. "/definingNode printCR. definingNode isMethod ifTrue:[ - varIdx := definingNode arguments findFirst:[:arg | arg name = nm]. - varIdx ~~ 0 ifTrue:[ - Error - handle:[:ex | ] - do:[ aBlock value:(actualContext methodHome argAt:varIdx) value:'methodArg ',nmBold ]. - ^ self - ]. - varIdx := definingNode temporaries findFirst:[:var | var name = nm]. - varIdx ~~ 0 ifTrue:[ - actualContext methodHome numVars >= varIdx ifTrue:[ - Error - handle:[:ex | ] - do:[ aBlock value:(actualContext methodHome varAt:varIdx) value:'methodVar ',nmBold ]. - ^ self - ] - ]. + varIdx := definingNode arguments findFirst:[:arg | arg name = nm]. + varIdx ~~ 0 ifTrue:[ + Error + handle:[:ex | ] + do:[ aBlock value:(actualContext methodHome argAt:varIdx) value:'methodArg ',nmBold ]. + ^ self + ]. + varIdx := definingNode temporaries findFirst:[:var | var name = nm]. + varIdx ~~ 0 ifTrue:[ + actualContext methodHome numVars >= varIdx ifTrue:[ + Error + handle:[:ex | ] + do:[ aBlock value:(actualContext methodHome varAt:varIdx) value:'methodVar ',nmBold ]. + ^ self + ] + ]. ]. definingNode isBlock ifTrue:[ - varIdx := definingNode arguments findFirst:[:arg | arg name = nm]. - (definingNode arguments contains:[:arg | arg name = nm]) ifTrue:[ - varIdx ~~ 0 ifTrue:[ - "/ am I in this block ? - (actualContext lineNumber notNil - and:[ definingNode lastLineNumber notNil - and:[ (actualContext lineNumber - between:definingNode firstLineNumber - and:definingNode lastLineNumber) - and:[ varIdx <= actualContext numArgs ] ]]) - ifTrue:[ - aBlock value:(actualContext argAt:varIdx) value:'blockArg ',nmBold . - ^ self - ]. - aBlock value:nmBold , ' is not in scope of selected context' value:nil. - ^ self - ] - ]. + varIdx := definingNode arguments findFirst:[:arg | arg name = nm]. + (definingNode arguments contains:[:arg | arg name = nm]) ifTrue:[ + varIdx ~~ 0 ifTrue:[ + "/ am I in this block ? + (actualContext lineNumber notNil + and:[ definingNode lastLineNumber notNil + and:[ (actualContext lineNumber + between:definingNode firstLineNumber + and:definingNode lastLineNumber) + and:[ varIdx <= actualContext numArgs ] ]]) + ifTrue:[ + aBlock value:(actualContext argAt:varIdx) value:'blockArg ',nmBold . + ^ self + ]. + aBlock value:nmBold , ' is not in scope of selected context' value:nil. + ^ self + ] + ]. ]. parentNode := definingNode parent. [parentNode notNil] whileTrue:[ - "/'isMethod ' print. parentNode isMethod printCR. - parentNode isMethod ifTrue:[ - varIdx := parentNode temporaries findFirst:[:var | var name = nm]. - varIdx ~~ 0 ifTrue:[ - actualContext methodHome numVars >= varIdx ifTrue:[ - Error - handle:[:ex | ] - do:[ aBlock value:(actualContext methodHome varAt:varIdx) value:'methodVar ',nmBold ]. - ^ self - ] - ]. - ]. - "/'isBlock ' print. parentNode isBlock printCR. - parentNode isBlock ifTrue:[ - "/ we don't have any information on the inlineability - "/ of this block here (RBParser does not know what - "/ the compiler does). - "/ therefore, it is questionable if we can use the - "/ context's home context here. - "/ am I in this block ? - con := actualContext. - [con notNil - and:[ parentNode lastLineNumber notNil - and:[ con lineNumber notNil - and:[ con lineNumber - between:parentNode firstLineNumber - and:parentNode lastLineNumber ]]]] whileTrue:[ - con := con sender. - ]. - con notNil ifTrue:[ - varIdx := parentNode arguments findFirst:[:arg | arg name = nm]. - varIdx ~~ 0 ifTrue:[ - Error - handle:[:ex | ] - do:[ aBlock value:(con argAt:varIdx) value:'blockArg ',nmBold ]. - ^ self - ]. - varIdx := parentNode body temporaries findFirst:[:var | var name = nm]. - varIdx ~~ 0 ifTrue:[ - Error - handle:[:ex | ] - do:[ aBlock value:(con varAt:varIdx) value:'blockVar ',nmBold ]. - ^ self - ]. - ]. - ]. - parentNode := parentNode parent. + "/'isMethod ' print. parentNode isMethod printCR. + parentNode isMethod ifTrue:[ + varIdx := parentNode temporaries findFirst:[:var | var name = nm]. + varIdx ~~ 0 ifTrue:[ + actualContext methodHome numVars >= varIdx ifTrue:[ + Error + handle:[:ex | ] + do:[ aBlock value:(actualContext methodHome varAt:varIdx) value:'methodVar ',nmBold ]. + ^ self + ] + ]. + ]. + "/'isBlock ' print. parentNode isBlock printCR. + parentNode isBlock ifTrue:[ + "/ we don't have any information on the inlineability + "/ of this block here (RBParser does not know what + "/ the compiler does). + "/ therefore, it is questionable if we can use the + "/ context's home context here. + "/ am I in this block ? + con := actualContext. + [con notNil + and:[ parentNode lastLineNumber notNil + and:[ con lineNumber notNil + and:[ con lineNumber + between:parentNode firstLineNumber + and:parentNode lastLineNumber ]]]] whileTrue:[ + con := con sender. + ]. + con notNil ifTrue:[ + varIdx := parentNode arguments findFirst:[:arg | arg name = nm]. + varIdx ~~ 0 ifTrue:[ + Error + handle:[:ex | ] + do:[ aBlock value:(con argAt:varIdx) value:'blockArg ',nmBold ]. + ^ self + ]. + varIdx := parentNode body temporaries findFirst:[:var | var name = nm]. + varIdx ~~ 0 ifTrue:[ + Error + handle:[:ex | ] + do:[ aBlock value:(con varAt:varIdx) value:'blockVar ',nmBold ]. + ^ self + ]. + ]. + ]. + parentNode := parentNode parent. ]. aBlock value:nmBold , ' is not in scope of selected context' value:nil. @@ -6922,10 +6922,10 @@ ! canCloseAllDebuggers - self class allInstancesDo:[:debugger | - debugger ~~ self ifTrue:[ - debugger busy ifTrue:[^ true]. - ] + self class allInstancesDo:[:debugger | + debugger ~~ self ifTrue:[ + debugger busy ifTrue:[^ true]. + ] ]. ^ false @@ -6941,7 +6941,7 @@ ^ selectedContext notNil and:[ (rcvr := selectedContext receiver) isView - or:[ rcvr isKindOf: ApplicationModel ]] + or:[ rcvr isKindOf: ApplicationModel ]] ! canRestart @@ -7003,8 +7003,8 @@ |con mthd| (con := self selectedContext) notNil ifTrue:[ - mthd := con method. - ^ mthd notNil and:[mthd isWrapped] + mthd := con method. + ^ mthd notNil and:[mthd isWrapped] ]. ^ false. @@ -7021,42 +7021,42 @@ !DebugView methodsFor:'private-breakpoints'! -addIgnoredHaltForCount:countOrNil - orTimeDuration:dTOrNil orUntilShiftKey:untilShiftKey - orThisReceiverClass:forThisReceiverClass orCurrentProcess:forCurrentProcess - orIfCalledFromMethod:ifCalledForMethodOrNil - forAll:aBoolean +addIgnoredHaltForCount:countOrNil + orTimeDuration:dTOrNil orUntilShiftKey:untilShiftKey + orThisReceiverClass:forThisReceiverClass orCurrentProcess:forCurrentProcess + orIfCalledFromMethod:ifCalledForMethodOrNil + forAll:aBoolean |haltingContext haltingMethod lineNrOfHalt receiverClassOrNil processOrNil| aBoolean ifTrue:[ - haltingMethod := #all + haltingMethod := #all ] ifFalse:[ - haltingContext := self findHaltingContext. - haltingContext isNil ifTrue:[ - Transcript showCR:'no halting context found'. - ^ self - ]. - - haltingMethod := haltingContext method. - lineNrOfHalt := haltingContext lineNumber. - (lineNrOfHalt isNil or:[lineNrOfHalt <= 0]) ifTrue:[ - Transcript showCR:'no halt lineNr found'. - ^ self - ]. - forThisReceiverClass ifTrue:[ - receiverClassOrNil := haltingContext receiver class - ]. - forCurrentProcess ifTrue:[ - processOrNil := Processor activeProcess - ]. + haltingContext := self findHaltingContext. + haltingContext isNil ifTrue:[ + Transcript showCR:'no halting context found'. + ^ self + ]. + + haltingMethod := haltingContext method. + lineNrOfHalt := haltingContext lineNumber. + (lineNrOfHalt isNil or:[lineNrOfHalt <= 0]) ifTrue:[ + Transcript showCR:'no halt lineNr found'. + ^ self + ]. + forThisReceiverClass ifTrue:[ + receiverClassOrNil := haltingContext receiver class + ]. + forCurrentProcess ifTrue:[ + processOrNil := Processor activeProcess + ]. ]. self class - ignoreHaltIn:haltingMethod at:lineNrOfHalt - forCount:countOrNil orTimeDuration:dTOrNil orUntilShiftKey:untilShiftKey - orReceiverClass:receiverClassOrNil orProcess:processOrNil - orIfCalledFromMethod:ifCalledForMethodOrNil + ignoreHaltIn:haltingMethod at:lineNrOfHalt + forCount:countOrNil orTimeDuration:dTOrNil orUntilShiftKey:untilShiftKey + orReceiverClass:receiverClassOrNil orProcess:processOrNil + orIfCalledFromMethod:ifCalledForMethodOrNil "Created: / 27-01-2012 / 11:31:12 / cg" ! @@ -7081,30 +7081,30 @@ haltSelectors := self haltSelectors. contextArray keysAndValuesDo:[:idx :con | - |sel con2 sel2 method| - - sel := con selector. - (haltSelectors includes:sel) ifTrue:[ - (method := con method) notNil ifTrue:[ - method mclass == Object ifTrue:[ - con2 := contextArray at:idx+1. - sel2 := con2 selector. - (haltSelectors includes:sel2) ifTrue:[ - con2 method mclass == Object ifTrue:[ - ^ contextArray at:idx+2. - ] - ]. - ^ contextArray at:idx+1 - ]. - method mclass == Breakpoint ifTrue:[ + |sel con2 sel2 method| + + sel := con selector. + (haltSelectors includes:sel) ifTrue:[ + (method := con method) notNil ifTrue:[ + method mclass == Object ifTrue:[ + con2 := contextArray at:idx+1. + sel2 := con2 selector. + (haltSelectors includes:sel2) ifTrue:[ + con2 method mclass == Object ifTrue:[ + ^ contextArray at:idx+2. + ] + ]. + ^ contextArray at:idx+1 + ]. + method mclass == Breakpoint ifTrue:[ (contextArray at:idx+1) infoPrintCR. - ^ contextArray at:idx+1 - ]. - ]. - ]. - con method isWrapped ifTrue:[ - ^ con - ]. + ^ contextArray at:idx+1 + ]. + ]. + ]. + con method isWrapped ifTrue:[ + ^ con + ]. ]. ^ nil @@ -7128,7 +7128,7 @@ Otherwise, the GC will not be able to release it." windowGroup notNil ifTrue:[ - windowGroup setProcess:nil. + windowGroup setProcess:nil. ]. self releaseDebuggee. @@ -7139,15 +7139,15 @@ "/ only cache if I am on the Display (i.e. the default screen) "/ self graphicsDevice == Display ifTrue:[ - exclusive ifTrue:[ - CachedExclusive := self - ] ifFalse:[ - CachedDebugger := self - ]. + exclusive ifTrue:[ + CachedExclusive := self + ] ifFalse:[ + CachedDebugger := self + ]. ]. ObjectMemory stepInterruptHandler == self ifTrue:[ - ObjectMemory stepInterruptHandler:nil + ObjectMemory stepInterruptHandler:nil ]. "Modified: 10.7.1997 / 15:50:46 / stefan" @@ -7158,10 +7158,10 @@ "tell whether we are a cached debugger" CachedExclusive == self ifTrue:[ - ^ true. + ^ true. ]. CachedDebugger == self ifTrue:[ - ^ true. + ^ true. ]. ^ false. @@ -7176,13 +7176,13 @@ cachable := false. CachedExclusive == self ifTrue:[ - CachedExclusive := nil. + CachedExclusive := nil. ]. CachedDebugger == self ifTrue:[ - CachedDebugger := nil. + CachedDebugger := nil. ]. OpenDebuggers notNil ifTrue:[ - OpenDebuggers remove:self ifAbsent:[]. + OpenDebuggers remove:self ifAbsent:[]. ]. "Modified: 31.7.1997 / 21:20:11 / cg" @@ -7201,24 +7201,24 @@ contextListEntryFor:aContext ^ Error - handle:[:ex | '???' ] - do:[ - |s| - - aContext selector == #doIt ifTrue:[ - aContext receiver isNil ifTrue:[ - s := 'doIt' allBold - ] - ]. - - s := Text streamContents:[:s | aContext printOn:s ]. - RememberedCallChain notNil ifTrue:[ - (RememberedCallChain includesIdentical:aContext) ifTrue:[ - s := s colorizeAllWith:(Color red). - ]. - ]. - s - ]. + handle:[:ex | '???' ] + do:[ + |s| + + aContext selector == #doIt ifTrue:[ + aContext receiver isNil ifTrue:[ + s := 'doIt' allBold + ] + ]. + + s := Text streamContents:[:s | aContext printOn:s ]. + RememberedCallChain notNil ifTrue:[ + (RememberedCallChain includesIdentical:aContext) ifTrue:[ + s := s colorizeAllWith:(Color red). + ]. + ]. + s + ]. "Created: / 21-05-2007 / 13:30:24 / cg" ! @@ -7228,7 +7228,7 @@ con := aContext. [con notNil and:[con ~~ aHomeContext]] whileTrue:[ - con := con sender + con := con sender ]. ^ con notNil @@ -7243,7 +7243,7 @@ "/ look for a breakpoint-wrapper's context c := thisContext findNextContextWithSelector:#'raiseRequestWith:errorString:in:' or:nil or:nil. c isNil ifTrue:[ - ^ true. + ^ true. ]. cReceiver := c receiver. ^ cReceiver == BreakPointInterrupt @@ -7263,65 +7263,65 @@ "/ look for a method breakpoint-wrapper's context c := thisContext findNextContextWithSelector:#doRaise or:nil or:nil. c notNil ifTrue:[ - ((cReceiver := c receiver) isKindOf:NoHandlerError) ifTrue:[ - c := c sender findNextContextWithSelector:#doRaise or:nil or:nil. - cReceiver := c receiver. - ]. - (cReceiver isKindOf:BreakPointInterrupt) ifFalse:[ - c := nil - ] ifTrue:[ - [ - sender := c sender. - ((sReceiver := sender receiver) isKindOf:BreakPointInterrupt) - or:[ sReceiver == BreakPointInterrupt ] - ] whileTrue:[ - c := sender - ]. - [ (sender := c sender) isBlockContext ] whileTrue:[ - c := sender - ]. - sender := nil. "/ avoid keeping a reference to this context - ]. + ((cReceiver := c receiver) isKindOf:NoHandlerError) ifTrue:[ + c := c sender findNextContextWithSelector:#doRaise or:nil or:nil. + cReceiver := c receiver. + ]. + (cReceiver isKindOf:BreakPointInterrupt) ifFalse:[ + c := nil + ] ifTrue:[ + [ + sender := c sender. + ((sReceiver := sender receiver) isKindOf:BreakPointInterrupt) + or:[ sReceiver == BreakPointInterrupt ] + ] whileTrue:[ + c := sender + ]. + [ (sender := c sender) isBlockContext ] whileTrue:[ + c := sender + ]. + sender := nil. "/ avoid keeping a reference to this context + ]. ]. "/ Transcript showCR:c. c isNil ifTrue:[ - "/ look for halts or explicit breakpoints - c := thisContext findNextContextWithSelector:#halt or:#halt: or:nil. - c isNil ifTrue:[ - c := thisContext findNextContextWithSelector:#breakPoint: or:#breakPoint:info: or:nil. - c isNil ifTrue:[ - ^ false - ]. - breakpointParameter := c argAt:1. - (self class - isBreakpointToBeIgnoredForParameter:breakpointParameter - context:(c sender) - modifyEntryCount:true - ) ifTrue:[ - ^ true. - ]. - ]. + "/ look for halts or explicit breakpoints + c := thisContext findNextContextWithSelector:#halt or:#halt: or:nil. + c isNil ifTrue:[ + c := thisContext findNextContextWithSelector:#breakPoint: or:#breakPoint:info: or:nil. + c isNil ifTrue:[ + ^ false + ]. + breakpointParameter := c argAt:1. + (self class + isBreakpointToBeIgnoredForParameter:breakpointParameter + context:(c sender) + modifyEntryCount:true + ) ifTrue:[ + ^ true. + ]. + ]. ]. c := c sender. "/ a code-breakpoint ? (c receiver isKindOf:Breakpoint) ifTrue:[ - c := c sender. + c := c sender. ]. haltingMethod := c method. haltingMethod isWrapped ifTrue:[ - lineNrInHaltingMethod := 1. + lineNrInHaltingMethod := 1. ] ifFalse:[ - lineNrInHaltingMethod := c lineNumber. - "/ Transcript showCR:c. + lineNrInHaltingMethod := c lineNumber. + "/ Transcript showCR:c. ]. ^ self class - isHaltToBeIgnoredIn:haltingMethod - atLineNr:lineNrInHaltingMethod - context:c - modifyEntryCount:true. + isHaltToBeIgnoredIn:haltingMethod + atLineNr:lineNrInHaltingMethod + context:c + modifyEntryCount:true. "Created: / 22-10-2010 / 12:09:53 / cg" "Modified: / 06-03-2012 / 12:54:09 / cg" @@ -7339,7 +7339,7 @@ "show calling chain from aContext in the walk-back listview. Most complications here arise from filtering less-interesting contexts if not in verbose-context mode or when hiding implementation contexts. - There is a lot of heuristic magic here, to make the debugger as useful + There is a lot of heuristic magic here, to make the debugger as useful as possible for the user (but not particularly for the debugger-developer)" |con sel text method caller caller2 called called2 m count c cc sndr @@ -7359,301 +7359,301 @@ m := contextView middleButtonMenu. m notNil ifTrue:[ - m disable:#showMore. + m disable:#showMore. ]. canShowMore := false. aContext isNil ifTrue:[ - text := Array with:'** no context **'. - contextArray := nil. + text := Array with:'** no context **'. + contextArray := nil. ] ifFalse:[ - text := OrderedCollection new:nChainShown. - contextArray := OrderedCollection new:nChainShown. - - con := aContext. - calledContext := nil. + text := OrderedCollection new:nChainShown. + contextArray := OrderedCollection new:nChainShown. + + con := aContext. + calledContext := nil. '======================================' print. con printCR. - alreadyInApplicationCode := - con receiver isLazyValue not "/ careful to not force futures/lazy values - and:[con receiver isKindOf:ApplicationModel]. - - verboseBacktrace ~~ true ifTrue:[ - "/ with dense backtrace, hide the ProcessorScheduler - "/ contexts at the top; look for a Process>>suspend* - "/ context within the first 10 contexts - - suspendContext := nil. - c := con. - 1 to:10 do:[:i | - |selector| - - c notNil ifTrue:[ - selector := c selector. - selector notNil ifTrue:[ - (selector isSymbol and:[(selector startsWith:'suspend') and:[c receiver isMemberOf:Process]]) ifTrue:[ - suspendContext := c. - calledBySuspendContext := cc. - ]. - ]. - cc := c. - c := c sender. - ] - ]. - suspendContext notNil ifTrue:[ - con := suspendContext. - calledContext := calledBySuspendContext. - suspendContext := nil - ]. - ]. - "/ Transcript show:'1 '; showCR:con. - con notNil ifTrue:[ - "/ hide the halt implementation - sel := con selector. - (self haltSelectors includes:sel) ifTrue:[ - (method := con method) notNil ifTrue:[ - method mclass == Object ifTrue:[ - (sel isSymbol and:[ sel startsWith:'breakPoint:']) ifTrue:[ - isStoppedAtBreakPointWithParameter := true. - breakPointParameter := con argAt:1. - ]. - isStoppedAtHaltOrBreakPoint := true. - verboseBacktrace ~~ true ifTrue:[ - calledContext := con. - con := con sender. - ] - ] ifFalse:[ - method mclass == Breakpoint ifTrue:[ - isStoppedAtHaltOrBreakPoint := true. - isStoppedAtStatementBreakpoint := true. - verboseBacktrace ~~ true ifTrue:[ - calledContext := con. - con := con sender. - ]. - "/ Transcript show:'2 '; showCR:con. - ]. - ]. - ]. - ]. - ]. - - (verboseBacktrace not or:[ hideSupportCode]) ifTrue:[ - [ - con notNil - and:[ con isBlockContext not - and:[ con method notNil - and:[ (con method shouldBeSkippedInDebuggersWalkBack) - and:[ (self haltSelectors includes: con selector) not]]]] - ] whileTrue:[ - "/ Transcript show:'xx '; showCR:con. - calledContext := con. - con := con sender - ]. - ]. - - " - get them all, by walking along the caller chain. - depending on the settings, skip some intermediate contexts - (such as collection enumeration implementations), which are usually not - of interest when debugging an application. - On the fly, gather some additional information - such as: are we at a halt/breakpoint, are we in a modal dialog opened, - are we coming from an application model's action etc. - " - count := 0. - [con notNil and:[count <= nChainShown]] whileTrue:[ - "/ remember any halt/breakpoint or openModal on the fly + alreadyInApplicationCode := + con receiver isLazyValue not "/ careful to not force futures/lazy values + and:[con receiver isKindOf:ApplicationModel]. + + verboseBacktrace ~~ true ifTrue:[ + "/ with dense backtrace, hide the ProcessorScheduler + "/ contexts at the top; look for a Process>>suspend* + "/ context within the first 10 contexts + + suspendContext := nil. + c := con. + 1 to:10 do:[:i | + |selector| + + c notNil ifTrue:[ + selector := c selector. + selector notNil ifTrue:[ + (selector isSymbol and:[(selector startsWith:'suspend') and:[c receiver isMemberOf:Process]]) ifTrue:[ + suspendContext := c. + calledBySuspendContext := cc. + ]. + ]. + cc := c. + c := c sender. + ] + ]. + suspendContext notNil ifTrue:[ + con := suspendContext. + calledContext := calledBySuspendContext. + suspendContext := nil + ]. + ]. + "/ Transcript show:'1 '; showCR:con. + con notNil ifTrue:[ + "/ hide the halt implementation + sel := con selector. + (self haltSelectors includes:sel) ifTrue:[ + (method := con method) notNil ifTrue:[ + method mclass == Object ifTrue:[ + (sel isSymbol and:[ sel startsWith:'breakPoint:']) ifTrue:[ + isStoppedAtBreakPointWithParameter := true. + breakPointParameter := con argAt:1. + ]. + isStoppedAtHaltOrBreakPoint := true. + verboseBacktrace ~~ true ifTrue:[ + calledContext := con. + con := con sender. + ] + ] ifFalse:[ + method mclass == Breakpoint ifTrue:[ + isStoppedAtHaltOrBreakPoint := true. + isStoppedAtStatementBreakpoint := true. + verboseBacktrace ~~ true ifTrue:[ + calledContext := con. + con := con sender. + ]. + "/ Transcript show:'2 '; showCR:con. + ]. + ]. + ]. + ]. + ]. + + (verboseBacktrace not or:[ hideSupportCode]) ifTrue:[ + [ + con notNil + and:[ con isBlockContext not + and:[ con method notNil + and:[ (con method shouldBeSkippedInDebuggersWalkBack) + and:[ (self haltSelectors includes: con selector) not]]]] + ] whileTrue:[ + "/ Transcript show:'xx '; showCR:con. + calledContext := con. + con := con sender + ]. + ]. + + " + get them all, by walking along the caller chain. + depending on the settings, skip some intermediate contexts + (such as collection enumeration implementations), which are usually not + of interest when debugging an application. + On the fly, gather some additional information + such as: are we at a halt/breakpoint, are we in a modal dialog opened, + are we coming from an application model's action etc. + " + count := 0. + [con notNil and:[count <= nChainShown]] whileTrue:[ + "/ remember any halt/breakpoint or openModal on the fly '---' print. con printCR. - sel := con selector. - (self haltSelectors includes:sel) ifTrue:[ - (method := con method) notNil ifTrue:[ - method mclass == Object ifTrue:[ - (sel isSymbol and:[sel startsWith:'breakPoint:']) ifTrue:[ - isStoppedAtBreakPointWithParameter := true. - breakPointParameter := con argAt:1. - ]. - isStoppedAtHaltOrBreakPoint := true. - ] ifFalse:[ - method mclass == Breakpoint ifTrue:[ - isStoppedAtHaltOrBreakPoint := true. - ]. - ] - ] - ] ifFalse:[ - ((sel == #openModal) or:[sel == #openModal:]) ifTrue:[ - isStoppedInModalDialog := true. - ] ifFalse:[ - alreadyInApplicationCode ifFalse:[ - (con receiver isLazyValue not "/ careful to not force futures/lazy values - and:[con receiver isKindOf:ApplicationModel]) ifTrue:[ - isStoppedInApplicationAction := true. - ] - ] - ] - ]. - - [ - |show1| - - show1 := self showingContext1:con calling:calledContext. - DebuggingDebugger3 := true== true ifTrue:[ - 'showingContext1: (' print. con print. ') --> ' print. show1 printCR. - ]. - show1 - ] whileFalse:[ - calledContext := con. - con := con sender. - ]. - - show2 := self showingContext2:con nesting:count. - DebuggingDebugger3 == true ifTrue:[ - 'showingContext2: (' print. con print. ') --> ' print. show2 printCR. - ]. - - show2 ifTrue:[ - contextArray add:con. - - (MoreDebuggingDetail == true) ifTrue:[ - nm := (((ObjectMemory addressOf:con) printStringRadix:16) , ' ' , con printString). - ] ifFalse:[ - nm := self contextListEntryFor:con. - ]. - text add:nm. - count := count + 1. - ]. - - "/ with hidden support code, skip over internals of exceptions - hideSupportCode == true ifTrue:[ - "/ Transcript showCR:'x'. - (con isBlockContext - and:[ (h := con home) notNil - and:[ (self is:h inCallingChainOf:con) ]]) ifTrue:[ - |blocksReceiver| - blocksReceiver := con receiver. - c := con sender. - [ - c notNil - and:[ - sndr := c sender. - (sndr ~= h) - and:[ - blocksReceiver isCollection "/ skip collection implementations - or:[ ( #( #'handle:do:' "/ skip exception implementations - #'handleDo:' - #'answer:do:' - #'ensure:' ) includes: c selector ) - or:[ #'perform:*' "/ skip perform implementations - match: c selector ]] - ] - ] - ] whileTrue:[ - c := sndr - ]. - c notNil ifTrue:[ - con := c "sender". - ]. - ]. - ]. - - "/ - "/ kludge: if it's a wrapped method, then hide the wrap-call - "/ - method := con method. - method notNil ifTrue:[ - called := con. - caller := con sender. - (caller notNil and:[caller receiver == method]) ifTrue:[ - called2 := caller. - caller2 := caller sender. - caller2 notNil ifTrue:[ - (caller2 method isWrapped - and:[ caller2 method originalMethod == method ]) ifTrue:[ - calledContext := called2. - con := caller2 - ]. - ]. - - ]. - caller := caller2 := nil - ]. - - "/ with dense backtrace, skip the doIt method's context - "/ (its dummy anyway) and fake that context's name - - verboseBacktrace ~~ true ifTrue:[ - (con isBlockContext - and:[(h := con home) == con sender - and:[h notNil - and:[(self setOfHiddenCallingSelectors includes:h selector) - and:[h method who isNil]]]]) ifTrue:[ - calledContext := con. - con := con sender. - text removeLast. - - text add:(self contextListEntryFor:con methodHome). - ]. - h := nil. "/ never keep refs to contexts unless you really need them ... - ]. - - "/ with dense backtrace, don't show contexts below the doIt - ( verboseBacktrace ~~ true - and:[ (self setOfHiddenCallingSelectors includes:con selector) ]) ifTrue:[ - con := nil. - ] ifFalse:[ - calledContext := con. - con := con sender - ]. - ]. - - " - did we reach the end ? - " - (con isNil or:[con sender isNil]) ifTrue:[ - - "/ the very last one is the startup context - "/ (in main) - it has nil as receiver and nil as selector - - (contextArray notEmpty - and:[contextArray last selector isNil]) ifTrue:[ - contextArray removeLast. - text removeLast - ]. - - verboseBacktrace ~~ true ifTrue:[ - "/ in dense mode, remove process startup contexts (if any) - - (contextArray size > 0 - and:[(con := contextArray last) methodClass == Process]) ifTrue:[ - con selector == #start ifTrue:[ - contextArray removeLast. - text removeLast. - - [contextArray size > 0 - and:[contextArray last methodHome == con]] whileTrue:[ - contextArray removeLast. - text removeLast. - ] - ] - ] - ] - ] ifFalse:[ - m notNil ifTrue:[ - m enable:#showMore. - ]. - canShowMore := true. - text add:(resources string:'*** more walkback follows - click here to see them ***') - ]. + sel := con selector. + (self haltSelectors includes:sel) ifTrue:[ + (method := con method) notNil ifTrue:[ + method mclass == Object ifTrue:[ + (sel isSymbol and:[sel startsWith:'breakPoint:']) ifTrue:[ + isStoppedAtBreakPointWithParameter := true. + breakPointParameter := con argAt:1. + ]. + isStoppedAtHaltOrBreakPoint := true. + ] ifFalse:[ + method mclass == Breakpoint ifTrue:[ + isStoppedAtHaltOrBreakPoint := true. + ]. + ] + ] + ] ifFalse:[ + ((sel == #openModal) or:[sel == #openModal:]) ifTrue:[ + isStoppedInModalDialog := true. + ] ifFalse:[ + alreadyInApplicationCode ifFalse:[ + (con receiver isLazyValue not "/ careful to not force futures/lazy values + and:[con receiver isKindOf:ApplicationModel]) ifTrue:[ + isStoppedInApplicationAction := true. + ] + ] + ] + ]. + + [ + |show1| + + show1 := self showingContext1:con calling:calledContext. + DebuggingDebugger3 == true ifTrue:[ + 'showingContext1: (' print. con print. ') --> ' print. show1 printCR. + ]. + show1 + ] whileFalse:[ + calledContext := con. + con := con sender. + ]. + + show2 := self showingContext2:con nesting:count. + DebuggingDebugger3 == true ifTrue:[ + 'showingContext2: (' print. con print. ') --> ' print. show2 printCR. + ]. + + show2 ifTrue:[ + contextArray add:con. + + (MoreDebuggingDetail == true) ifTrue:[ + nm := (((ObjectMemory addressOf:con) printStringRadix:16) , ' ' , con printString). + ] ifFalse:[ + nm := self contextListEntryFor:con. + ]. + text add:nm. + count := count + 1. + ]. + + "/ with hidden support code, skip over internals of exceptions + hideSupportCode == true ifTrue:[ + "/ Transcript showCR:'x'. + (con isBlockContext + and:[ (h := con home) notNil + and:[ (self is:h inCallingChainOf:con) ]]) ifTrue:[ + |blocksReceiver| + blocksReceiver := con receiver. + c := con sender. + [ + c notNil + and:[ + sndr := c sender. + (sndr ~= h) + and:[ + blocksReceiver isCollection "/ skip collection implementations + or:[ ( #( #'handle:do:' "/ skip exception implementations + #'handleDo:' + #'answer:do:' + #'ensure:' ) includes: c selector ) + or:[ #'perform:*' "/ skip perform implementations + match: c selector ]] + ] + ] + ] whileTrue:[ + c := sndr + ]. + c notNil ifTrue:[ + con := c "sender". + ]. + ]. + ]. + + "/ + "/ kludge: if it's a wrapped method, then hide the wrap-call + "/ + method := con method. + method notNil ifTrue:[ + called := con. + caller := con sender. + (caller notNil and:[caller receiver == method]) ifTrue:[ + called2 := caller. + caller2 := caller sender. + caller2 notNil ifTrue:[ + (caller2 method isWrapped + and:[ caller2 method originalMethod == method ]) ifTrue:[ + calledContext := called2. + con := caller2 + ]. + ]. + + ]. + caller := caller2 := nil + ]. + + "/ with dense backtrace, skip the doIt method's context + "/ (its dummy anyway) and fake that context's name + + verboseBacktrace ~~ true ifTrue:[ + (con isBlockContext + and:[(h := con home) == con sender + and:[h notNil + and:[(self setOfHiddenCallingSelectors includes:h selector) + and:[h method who isNil]]]]) ifTrue:[ + calledContext := con. + con := con sender. + text removeLast. + + text add:(self contextListEntryFor:con methodHome). + ]. + h := nil. "/ never keep refs to contexts unless you really need them ... + ]. + + "/ with dense backtrace, don't show contexts below the doIt + ( verboseBacktrace ~~ true + and:[ (self setOfHiddenCallingSelectors includes:con selector) ]) ifTrue:[ + con := nil. + ] ifFalse:[ + calledContext := con. + con := con sender + ]. + ]. + + " + did we reach the end ? + " + (con isNil or:[con sender isNil]) ifTrue:[ + + "/ the very last one is the startup context + "/ (in main) - it has nil as receiver and nil as selector + + (contextArray notEmpty + and:[contextArray last selector isNil]) ifTrue:[ + contextArray removeLast. + text removeLast + ]. + + verboseBacktrace ~~ true ifTrue:[ + "/ in dense mode, remove process startup contexts (if any) + + (contextArray size > 0 + and:[(con := contextArray last) methodClass == Process]) ifTrue:[ + con selector == #start ifTrue:[ + contextArray removeLast. + text removeLast. + + [contextArray size > 0 + and:[contextArray last methodHome == con]] whileTrue:[ + contextArray removeLast. + text removeLast. + ] + ] + ] + ] + ] ifFalse:[ + m notNil ifTrue:[ + m enable:#showMore. + ]. + canShowMore := true. + text add:(resources string:'*** more walkback follows - click here to see them ***') + ]. ]. contextView setList:text. releaseInspectors ifTrue:[ - receiverInspector release. - contextInspector release. + receiverInspector release. + contextInspector release. ]. m notNil ifTrue:[ - m disableAll:#(addBreakpoint removeBreakpoint browseImplementors browseSenders browseReceiversClass). + m disableAll:#(addBreakpoint removeBreakpoint browseImplementors browseSenders browseReceiversClass). ]. self updateMenuItems. ^ true @@ -7670,12 +7670,12 @@ con := aContext. self verboseBacktraceHolder value ifFalse:[ - (con notNil and:[con selector == #threadSwitch:]) ifTrue:[ - con := con sender. - (con notNil and:[con selector == #timerInterrupt]) ifTrue:[ - con := con sender. - ]. - ]. + (con notNil and:[con selector == #threadSwitch:]) ifTrue:[ + con := con sender. + (con notNil and:[con selector == #timerInterrupt]) ifTrue:[ + con := con sender. + ]. + ]. ]. ^ self setContext:con releaseInspectors:true @@ -7701,48 +7701,48 @@ "/ to avoid firing/waiting the lazy or future recIsException := (rec isLazyValue not) and:[rec isException]. aContext sender notNil ifTrue:[ - senderRec := aContext sender receiver + senderRec := aContext sender receiver ]. DebuggingDebugger3 == true ifTrue:[ - 'showingContext1: (' print. aContext print. - ') calling: (' print. calledContext print. - ')' printCR. + 'showingContext1: (' print. aContext print. + ') calling: (' print. calledContext print. + ')' printCR. ]. (#(doCallHandler: doRaise ) includes:sel) - ifTrue:[ - recIsException ifTrue:[ ^ false]. - ]. + ifTrue:[ + recIsException ifTrue:[ ^ false]. + ]. (#(raise raiseRequest ) includes:sel) - ifTrue:[ - recIsException ifTrue:[ - (senderRec isLazyValue not - and:[ senderRec isExceptionCreator]) ifTrue:[^ false]. - ]. - ]. + ifTrue:[ + recIsException ifTrue:[ + (senderRec isLazyValue not + and:[ senderRec isExceptionCreator]) ifTrue:[^ false]. + ]. + ]. (#(doWhile: ) includes:sel) - ifTrue:[ - rec isBlock ifTrue:[ - true "aContext sender isBlockContext" ifTrue:[^ false]. - ]. - ]. + ifTrue:[ + rec isBlock ifTrue:[ + true "aContext sender isBlockContext" ifTrue:[^ false]. + ]. + ]. calledContext notNil ifTrue:[ - calledSel := calledContext selector. - calledRec := calledContext receiver. - - calledRec isBlock ifTrue:[ - (calledSel == #ensure:) ifTrue:[^ false]. - (calledSel == #ifCurtailed:) ifTrue:[^ false]. - ]. - (calledSel == #handle:do:) ifTrue:[^ false]. - (calledSel == #answer:do:) ifTrue:[^ false]. + calledSel := calledContext selector. + calledRec := calledContext receiver. + + calledRec isBlock ifTrue:[ + (calledSel == #ensure:) ifTrue:[^ false]. + (calledSel == #ifCurtailed:) ifTrue:[^ false]. + ]. + (calledSel == #handle:do:) ifTrue:[^ false]. + (calledSel == #answer:do:) ifTrue:[^ false]. "/ calledRec isLazyValue ifFalse:[ "/ ((calledSel == #doWhile:) @@ -7761,31 +7761,31 @@ ]. (#(handleDo:) includes:sel) - ifTrue:[ - (calledRec isLazyValue not and:[calledRec isExceptionHandler]) ifTrue:[^ false]. - ]. + ifTrue:[ + (calledRec isLazyValue not and:[calledRec isExceptionHandler]) ifTrue:[^ false]. + ]. (#( - withCursor:do: - withWaitCursorDo: - withReadCursorDo: - withWriteCursorDo: - withSearchCursorDo: + withCursor:do: + withWaitCursorDo: + withReadCursorDo: + withWriteCursorDo: + withSearchCursorDo: ) includes:sel) - ifTrue:[ - (mthdClass == TopView) ifTrue:[^ false]. - (mthdClass == ApplicationModel) ifTrue:[^ false]. - (mthdClass == WindowGroup) ifTrue:[^ false]. - ]. + ifTrue:[ + (mthdClass == TopView) ifTrue:[^ false]. + (mthdClass == ApplicationModel) ifTrue:[^ false]. + (mthdClass == WindowGroup) ifTrue:[^ false]. + ]. (#( - wait - waitWithTimeout: - waitWithTimeoutMs: + wait + waitWithTimeout: + waitWithTimeoutMs: ) includes:sel) - ifTrue:[ - (mthdClass == Semaphore) ifTrue:[^ false]. - (mthdClass == SemaphoreSet) ifTrue:[^ false]. - ]. + ifTrue:[ + (mthdClass == Semaphore) ifTrue:[^ false]. + (mthdClass == SemaphoreSet) ifTrue:[^ false]. + ]. ^ true @@ -7810,29 +7810,29 @@ sender := aContext sender. sender notNil ifTrue:[ - senderSelector := sender selector. - senderReceiver := sender receiver. - senderReceiverClass := senderReceiver class. + senderSelector := sender selector. + senderReceiver := sender receiver. + senderReceiverClass := senderReceiver class. ]. sel == #withCursor:do: ifTrue:[ - (mClass == WindowGroup) ifTrue:[^ false]. - (mClass == TopView) ifTrue:[^ false]. + (mClass == WindowGroup) ifTrue:[^ false]. + (mClass == TopView) ifTrue:[^ false]. ]. (sel == #withExecuteCursorDo: or:[sel == #withWaitCursorDo:]) ifTrue:[ - (mClass == DisplaySurface) ifTrue:[^ false]. + (mClass == DisplaySurface) ifTrue:[^ false]. ]. (sel == #do: or:[sel == #from:to:do: or:[sel == #keysAndValuesDo: or:[sel == #doWithIndex:]]]) ifTrue:[ - mClass == Array ifTrue:[^ false]. - mClass == OrderedCollection ifTrue:[^ false]. - mClass == Set ifTrue:[^ false]. - mClass == Dictionary ifTrue:[^ false]. - mClass == Interval ifTrue:[^ false]. + mClass == Array ifTrue:[^ false]. + mClass == OrderedCollection ifTrue:[^ false]. + mClass == Set ifTrue:[^ false]. + mClass == Dictionary ifTrue:[^ false]. + mClass == Interval ifTrue:[^ false]. ]. (sel == #perform: or:[sel == #perform:with: @@ -7843,44 +7843,44 @@ or:[sel == #perform:with:ifNotUnderstood: or:[sel == #perform:withArguments:ifNotUnderstood:]]]]]]]) ifTrue:[ - hideSupportCode == true ifTrue:[ - "/ 'x' printCR. - mClass == Object ifTrue:[^ false] - ]. - nesting == 0 ifTrue:[^ true]. - mClass == Array ifTrue:[^ false]. - mClass == OrderedCollection ifTrue:[^ false]. + hideSupportCode == true ifTrue:[ + "/ 'x' printCR. + mClass == Object ifTrue:[^ false] + ]. + nesting == 0 ifTrue:[^ true]. + mClass == Array ifTrue:[^ false]. + mClass == OrderedCollection ifTrue:[^ false]. ]. sel == #valueWithReceiver:arguments:selector:search:sender: ifTrue:[^ false]. (mClass == Object) ifTrue:[ - (sel startsWith:'perform:') ifTrue:[^ false] + (sel startsWith:'perform:') ifTrue:[^ false] ]. (mClass == Method) ifTrue:[ - (sel startsWith:'valueWithReceiver:') ifTrue:[^ false] + (sel startsWith:'valueWithReceiver:') ifTrue:[^ false] ]. (mClass == SmallInteger) ifTrue:[ - (sel == #to:do:) ifTrue:[^ false]. - (sel == #to:by:do:) ifTrue:[^ false]. + (sel == #to:do:) ifTrue:[^ false]. + (sel == #to:by:do:) ifTrue:[^ false]. ]. (mClass == Block) ifTrue:[ - sel == #ensure: ifTrue:[^ false]. - sel == #ifCurtailed: ifTrue:[^ false]. - sel == #valueNowOrOnUnwindDo: ifTrue:[^ false]. - sel == #valueOnUnwindDo: ifTrue:[^ false]. - sel == #on:do: ifTrue:[^ false]. - - sel == #value ifTrue:[^ false]. - sel == #value: ifTrue:[^ false]. - sel == #value:value: ifTrue:[^ false]. - sel == #value:value:value: ifTrue:[^ false]. - sel == #value:value:value:value: ifTrue:[^ false]. - sel == #value:value:value:value:Value: ifTrue:[^ false]. - sel == #value:value:value:value:value:value: ifTrue:[^ false]. + sel == #ensure: ifTrue:[^ false]. + sel == #ifCurtailed: ifTrue:[^ false]. + sel == #valueNowOrOnUnwindDo: ifTrue:[^ false]. + sel == #valueOnUnwindDo: ifTrue:[^ false]. + sel == #on:do: ifTrue:[^ false]. + + sel == #value ifTrue:[^ false]. + sel == #value: ifTrue:[^ false]. + sel == #value:value: ifTrue:[^ false]. + sel == #value:value:value: ifTrue:[^ false]. + sel == #value:value:value:value: ifTrue:[^ false]. + sel == #value:value:value:value:Value: ifTrue:[^ false]. + sel == #value:value:value:value:value:value: ifTrue:[^ false]. ]. aContext isBlockContext ifTrue:[ @@ -7898,43 +7898,43 @@ "/ ] "/ ] - aContext home notNil ifTrue:[ - aContext home receiver isLazyValue ifFalse:[ - (aContext home receiver isMemberOf:Semaphore) ifTrue:[ - (aContext home selector == #wait) ifTrue:[^ false]. - (aContext home selector == #waitWithTimeoutMs:) ifTrue:[^ false]. - ] - ] - ] + aContext home notNil ifTrue:[ + aContext home receiver isLazyValue ifFalse:[ + (aContext home receiver isMemberOf:Semaphore) ifTrue:[ + (aContext home selector == #wait) ifTrue:[^ false]. + (aContext home selector == #waitWithTimeoutMs:) ifTrue:[^ false]. + ] + ] + ] ]. (rec isExceptionHandler) ifTrue:[ - sel == #handle:do: ifTrue:[^ false]. - sel == #handleDo: ifTrue:[^ false]. - (sel startsWith:#raise) ifTrue:[^ false]. - sel == #answer:do: ifTrue:[^ false]. + sel == #handle:do: ifTrue:[^ false]. + sel == #handleDo: ifTrue:[^ false]. + (sel startsWith:#raise) ifTrue:[^ false]. + sel == #answer:do: ifTrue:[^ false]. ]. (rec isLazyValue not and:[ rec isException] ) ifTrue:[ - sel == #doRaise ifTrue:[^ false]. - sel == #doCallHandler: ifTrue:[^ false]. - (sel == #raise or:[sel == #raiseRequest]) ifTrue:[ - senderReceiverClass == Signal ifTrue:[^ false]. - ] + sel == #doRaise ifTrue:[^ false]. + sel == #doCallHandler: ifTrue:[^ false]. + (sel == #raise or:[sel == #raiseRequest]) ifTrue:[ + senderReceiverClass == Signal ifTrue:[^ false]. + ] ]. (mClass == Context) ifTrue:[ - sel == #unwind ifTrue:[^ false]. - sel == #unwind: ifTrue:[^ false]. + sel == #unwind ifTrue:[^ false]. + sel == #unwind: ifTrue:[^ false]. ]. (mClass == ProcessorScheduler) ifTrue:[ - sel == #interruptActive ifTrue:[^ false]. - sel == #threadSwitch: ifTrue:[^ false]. - sel == #suspend: ifTrue:[^ false]. + sel == #interruptActive ifTrue:[^ false]. + sel == #threadSwitch: ifTrue:[^ false]. + sel == #suspend: ifTrue:[^ false]. ]. mClass == Process ifTrue:[ - sel == #suspendWithState: ifTrue:[^ false]. + sel == #suspendWithState: ifTrue:[^ false]. ]. (sel == #break) ifTrue:[ - (mClass == Breakpoint) ifTrue:[^ false]. + (mClass == Breakpoint) ifTrue:[^ false]. ]. ^ true. @@ -7946,21 +7946,21 @@ controlLoop "this is a kludge: - start a dispatchloop which exits when - either continue, return or step is pressed + start a dispatchloop which exits when + either continue, return or step is pressed " haveControl := true. [ - [haveControl] whileTrue:[ + [haveControl] whileTrue:[ AbortOperationRequest handle:[:ex | ] do:[ - self controlLoopCatchingErrors + self controlLoopCatchingErrors ] - ]. + ]. ] ensure:[ - catchBlock := nil. - haveControl := false + catchBlock := nil. + haveControl := false ]. "Modified: 9.7.1996 / 18:29:09 / cg" @@ -7974,40 +7974,40 @@ catchBlock := [catchBlock := nil. ^ nil]. (exclusive or:[windowGroup isNil]) ifTrue:[ - "if we do not have multiple processes or its a system process - we start another dispatch loop, which exits when - either continue, return or step is pressed - or (via the catchBlock) if an error occurs. - Since our display is an extra exclusive one, - all processing for normal views stops here ... - " - - WindowGroup setActiveGroup:windowGroup. - SignalSet anySignal handle:[:ex | - |signal| - - signal := ex creator. - (UserInterruptSignal accepts:signal) ifTrue:[ + "if we do not have multiple processes or its a system process + we start another dispatch loop, which exits when + either continue, return or step is pressed + or (via the catchBlock) if an error occurs. + Since our display is an extra exclusive one, + all processing for normal views stops here ... + " + + WindowGroup setActiveGroup:windowGroup. + SignalSet anySignal handle:[:ex | + |signal| + + signal := ex creator. + (UserInterruptSignal accepts:signal) ifTrue:[ Transcript showCR:'UserInterruptSignal'. - self topView raiseDeiconified. - ex proceed. - ]. - - (UserNotification accepts:signal) ifTrue:[ + self topView raiseDeiconified. + ex proceed. + ]. + + (UserNotification accepts:signal) ifTrue:[ Transcript showCR:'UserNotification'. - (signal ~~ ActivityNotificationSignal) ifTrue:[ - self showError:ex description. - ]. - ex proceed. - ]. - (HaltInterrupt accepts:signal) ifTrue:[ + (signal ~~ ActivityNotificationSignal) ifTrue:[ + self showError:ex description. + ]. + ex proceed. + ]. + (HaltInterrupt accepts:signal) ifTrue:[ Transcript showCR:'HaltInterrupt'. - Transcript showCR:'Halt/Break in debugger ignored'. - self topView raiseDeiconified. - ex proceed. - ]. - - self showError:'*** Error in modal debugger: + Transcript showCR:'Halt/Break in debugger ignored'. + self topView raiseDeiconified. + ex proceed. + ]. + + self showError:'*** Error in modal debugger: >>>> Signal: ' , signal printString , ' >>>> In: ' , ex suspendedContext printString , ' @@ -8028,8 +8028,8 @@ >>>> Message: ' , ex description , ' caught & ignored.'. - ex return. - ] do:[ + ex return. + ] do:[ "/ UserNotification handle:[:ex | "/ (ex signal == ActivityNotificationSignal) ifTrue:[ "/ ex proceed @@ -8037,69 +8037,69 @@ "/ self showError:ex description. "/ ex proceed. "/ ] do:[ - self graphicsDevice - dispatchModalWhile:[ - Processor activeProcess state:#debug. - haveControl]. + self graphicsDevice + dispatchModalWhile:[ + Processor activeProcess state:#debug. + haveControl]. "/ ] - ]. - WindowGroup setActiveGroup:nil. + ]. + WindowGroup setActiveGroup:nil. ] ifFalse:[ - "we do have multiple processes - - simply enter the DebugViews-Windowgroup event loop. - effectively suspending event processing for the currently - active group. - " - SignalSet anySignal handle:[:ex | - |answer signal eMsg| - - signal := ex creator. - - DebuggingDebugger ~~ true ifTrue:[ - (signal == ActivityNotification) ifTrue:[ - ex proceed - ]. - "/ - "/ ignore exceptions which say they explicitly have to be ignored - "/ - ex catchInDebugger ifTrue:[ - 'DebugView [info]: ',signal printString,'-signal in debugger caught for close' infoPrintCR. - self destroy. - ex reject - ]. - - "/ - "/ ignore recursive breakpoints - "/ - (signal isControlInterrupt) ifTrue:[ - ignoreBreakpoints == true ifTrue:[ - 'DebugView [info]: halt/break in debugger ignored 1' infoPrintCR. - ('DebugView [info]: ',ex suspendedContext printString) infoPrintCR. - self topView raiseDeiconified. - ex proceed - ]. - ]. - (signal == TerminateProcessRequest) ifTrue:[ - "/ mhm - someone wants to shoot me down while debugging ... - answer := Dialog - choose:('Process termination signal arrived while debugging\\close debugger ?') withCRs - labels:#( 'Ignore' 'Close & terminate' ) - values:#( #proceed #close ) - default:#close. - answer == #close ifTrue:[ - self destroy. - ex reject - ]. - ex return. - ]. - signal == RecursiveExceptionError ifTrue:[ - (ex exception creator == BreakPointInterrupt) - ifTrue:[ - 'DebugView [info]: recursive breakpoint in debugger ignored' infoPrintCR. - ex proceed. - ]. - - self showError:'*** Recursive error in debugger: + "we do have multiple processes - + simply enter the DebugViews-Windowgroup event loop. + effectively suspending event processing for the currently + active group. + " + SignalSet anySignal handle:[:ex | + |answer signal eMsg| + + signal := ex creator. + + DebuggingDebugger ~~ true ifTrue:[ + (signal == ActivityNotification) ifTrue:[ + ex proceed + ]. + "/ + "/ ignore exceptions which say they explicitly have to be ignored + "/ + ex catchInDebugger ifTrue:[ + 'DebugView [info]: ',signal printString,'-signal in debugger caught for close' infoPrintCR. + self destroy. + ex reject + ]. + + "/ + "/ ignore recursive breakpoints + "/ + (signal isControlInterrupt) ifTrue:[ + ignoreBreakpoints == true ifTrue:[ + 'DebugView [info]: halt/break in debugger ignored 1' infoPrintCR. + ('DebugView [info]: ',ex suspendedContext printString) infoPrintCR. + self topView raiseDeiconified. + ex proceed + ]. + ]. + (signal == TerminateProcessRequest) ifTrue:[ + "/ mhm - someone wants to shoot me down while debugging ... + answer := Dialog + choose:('Process termination signal arrived while debugging\\close debugger ?') withCRs + labels:#( 'Ignore' 'Close & terminate' ) + values:#( #proceed #close ) + default:#close. + answer == #close ifTrue:[ + self destroy. + ex reject + ]. + ex return. + ]. + signal == RecursiveExceptionError ifTrue:[ + (ex exception creator == BreakPointInterrupt) + ifTrue:[ + 'DebugView [info]: recursive breakpoint in debugger ignored' infoPrintCR. + ex proceed. + ]. + + self showError:'*** Recursive error in debugger: >>>> Signal: ' , ex creator printString , ' >>>> ' , ex parameter creator printString , ' @@ -8111,54 +8111,54 @@ >>>> Message: ' , ex description , ' caught & ignored.'. - ex return - ]. - ]. - - self topView raiseDeiconified. - - eMsg := ex description. - (signal isControlInterrupt) ifTrue:[ - eMsg := eMsg , Character cr asString , 'in ' , ex suspendedContext printString - ]. - Dialog aboutToOpenBoxNotificationSignal - handle:[:ex | ex proceed ] - do:[ - answer := Dialog - choose:(ex creator class name,' in debugger:\' withCRs , eMsg , '\\debug again ?' withCRs) - labels:#( 'Proceed' 'Cancel' 'Debug' ) - values:#( #proceed #cancel #debug ) - default:#cancel. - ]. - answer == #debug ifTrue:[ - 'DebugView [info]: caught exception - debugging' infoPrintCR. - Debugger - enterUnconditional:(ex suspendedContext) - withMessage:(ex creator class name,' in debugger: ' , eMsg) - mayProceed:true. - ex proceed. - ]. - answer == #proceed ifTrue:[ - 'DebugView [info]: ignored exception - proceeding' infoPrintCR. - ex proceed. - ]. - 'DebugView [info]: caught exception - returning' infoPrintCR. - ex return. - ] do:[ - "/ make certain that sub-debuggers, inspectors etc. - "/ come up on my device. - Screen currentScreenQuerySignal answer:self graphicsDevice - do:[ - Dialog aboutToOpenBoxNotificationSignal - handle:[:ex | ex proceed ] - do:[ - windowGroup - eventLoopWhile:[Processor activeProcess state:#debug. - true] - onLeave:[] - ] - ] - ]. + ex return + ]. + ]. + + self topView raiseDeiconified. + + eMsg := ex description. + (signal isControlInterrupt) ifTrue:[ + eMsg := eMsg , Character cr asString , 'in ' , ex suspendedContext printString + ]. + Dialog aboutToOpenBoxNotificationSignal + handle:[:ex | ex proceed ] + do:[ + answer := Dialog + choose:(ex creator class name,' in debugger:\' withCRs , eMsg , '\\debug again ?' withCRs) + labels:#( 'Proceed' 'Cancel' 'Debug' ) + values:#( #proceed #cancel #debug ) + default:#cancel. + ]. + answer == #debug ifTrue:[ + 'DebugView [info]: caught exception - debugging' infoPrintCR. + Debugger + enterUnconditional:(ex suspendedContext) + withMessage:(ex creator class name,' in debugger: ' , eMsg) + mayProceed:true. + ex proceed. + ]. + answer == #proceed ifTrue:[ + 'DebugView [info]: ignored exception - proceeding' infoPrintCR. + ex proceed. + ]. + 'DebugView [info]: caught exception - returning' infoPrintCR. + ex return. + ] do:[ + "/ make certain that sub-debuggers, inspectors etc. + "/ come up on my device. + Screen currentScreenQuerySignal answer:self graphicsDevice + do:[ + Dialog aboutToOpenBoxNotificationSignal + handle:[:ex | ex proceed ] + do:[ + windowGroup + eventLoopWhile:[Processor activeProcess state:#debug. + true] + onLeave:[] + ] + ] + ]. ]. catchBlock := nil. @@ -8176,51 +8176,51 @@ classToDefineIn := selectorToDefine := nil. "/ sorry - left as info to define action callee notNil ifTrue:[ - "/ clicked on an unimplemented method ? - callee sender notNil ifTrue:[ - mthd := callee sender method. - mthd isNil ifTrue:[ - callee sender isBlockContext ifFalse:[ - "/ an unimplemented method - selector := callee sender selector. - (callee sender receiver class canUnderstand:selector) ifFalse:[ - classToDefineIn := callee sender receiver class. - selectorToDefine := selector. - ^ true - ] - ] - ]. - ]. - - mthd := callee method. - mthd notNil ifTrue:[ - (mthd selector == #subclassResponsibility) ifTrue:[ - classToDefineIn := callee sender receiver class. - selectorToDefine := callee sender selector. - ^ true. - ]. - - "/ that's a big hack, but I am tired of navigating to find the missing menu message... - "/ you will thank me!! - mthd selector == #error:mayProceed: ifTrue:[ - (callee receiver isKindOf:MenuPanel) ifTrue:[ - callee sender home notNil ifTrue:[ - (callee sender home selector startsWith:'accept:') ifTrue:[ - (inspectedProcess notNil and:[inspectedProcess isGUIProcess]) ifTrue:[ - (app := self processesApplication) notNil ifTrue:[ - heuristic := callee sender home argsAndVars select:[:o | o isSymbol]. - heuristic size == 1 ifTrue:[ - classToDefineIn := app class. - selectorToDefine := heuristic first. - ^ true - ]. - ]. - ]. - ]. - ]. - ]. - ] - ] + "/ clicked on an unimplemented method ? + callee sender notNil ifTrue:[ + mthd := callee sender method. + mthd isNil ifTrue:[ + callee sender isBlockContext ifFalse:[ + "/ an unimplemented method + selector := callee sender selector. + (callee sender receiver class canUnderstand:selector) ifFalse:[ + classToDefineIn := callee sender receiver class. + selectorToDefine := selector. + ^ true + ] + ] + ]. + ]. + + mthd := callee method. + mthd notNil ifTrue:[ + (mthd selector == #subclassResponsibility) ifTrue:[ + classToDefineIn := callee sender receiver class. + selectorToDefine := callee sender selector. + ^ true. + ]. + + "/ that's a big hack, but I am tired of navigating to find the missing menu message... + "/ you will thank me!! + mthd selector == #error:mayProceed: ifTrue:[ + (callee receiver isKindOf:MenuPanel) ifTrue:[ + callee sender home notNil ifTrue:[ + (callee sender home selector startsWith:'accept:') ifTrue:[ + (inspectedProcess notNil and:[inspectedProcess isGUIProcess]) ifTrue:[ + (app := self processesApplication) notNil ifTrue:[ + heuristic := callee sender home argsAndVars select:[:o | o isSymbol]. + heuristic size == 1 ifTrue:[ + classToDefineIn := app class. + selectorToDefine := heuristic first. + ^ true + ]. + ]. + ]. + ]. + ]. + ]. + ] + ] ]. ^ false ! @@ -8238,16 +8238,16 @@ codeView modified ifFalse:[^ false]. currentMethod isNil ifTrue:[ - ^ false + ^ false ]. source := currentMethod source. source notNil ifTrue:[ - source string = codeView contents string ifTrue:[ - ^ false - ]. - (source string withTabsExpanded:8) = (codeView contents string withTabsExpanded:8) ifTrue:[ - ^ false - ]. + source string = codeView contents string ifTrue:[ + ^ false + ]. + (source string withTabsExpanded:8) = (codeView contents string withTabsExpanded:8) ifTrue:[ + ^ false + ]. ]. ^ true ! @@ -8263,22 +8263,22 @@ (newSelection notNil and:[newSelection = contextView selection]) ifTrue:[ - ^ true - ]. - - answer := Dialog - confirmWithCancel:('Code modified - change selection anyway ?') - labels:#('No' 'No, Show Diffs' 'Yes'). + ^ true + ]. + + answer := Dialog + confirmWithCancel:('Code modified - change selection anyway ?') + labels:#('No' 'No, Show Diffs' 'Yes'). answer isNil ifTrue:[^ false]. answer == false ifTrue:[ - v := DiffCodeView - openOn:codeView contents - label:(resources string:'Changed code (to be accepted ?)') - and:currentMethod source - label:(resources string:'Method''s actual (maybe original) code'). - v label:(resources string:'Comparing method''s code'). - v waitUntilVisible. - ^ false + v := DiffCodeView + openOn:codeView contents + label:(resources string:'Changed code (to be accepted ?)') + and:currentMethod source + label:(resources string:'Method''s actual (maybe original) code'). + v label:(resources string:'Comparing method''s code'). + v waitUntilVisible. + ^ false ]. codeView modified:false. @@ -8289,17 +8289,17 @@ "user wants some code to be recompiled" ParseError handle:[:ex | - ex lineNumber notNil ifTrue:[ - codeView selectLine:ex lineNumber. "/ selectFromCharacterPosition:ex startPosition to:ex endPosition. - ]. - Dialog information:ex description. + ex lineNumber notNil ifTrue:[ + codeView selectLine:ex lineNumber. "/ selectFromCharacterPosition:ex startPosition to:ex endPosition. + ]. + Dialog information:ex description. "/ ParseError new "/ errorMessage:aMessage startPosition:position endPosition:endPos; "/ parameter:self; "/ lineNumber:tokenLineNr; "lineNr" "/ raiseRequest. - ] do:[ - ^ self codeAccept:someCode unwind:false category:nil onCancel:nil + ] do:[ + ^ self codeAccept:someCode unwind:false category:nil onCancel:nil ]. "Modified: / 28-11-2006 / 19:49:04 / cg" @@ -8309,118 +8309,118 @@ "user wants some code to be recompiled. Optionally unwind stack to right above the changed method. This undwind option is a leftover from times, when the debugger had no chance to - show the original code. - Now, it can, and got a choice-field to select between original and changed code. - So the undwind option is not longer used and probably completely obsolete now + show the original code. + Now, it can, and got a choice-field to select between original and changed code. + So the undwind option is not longer used and probably completely obsolete now (aka: this method is always called with doUnwind==false, these days)" |con newMethod| codeView withWaitCursorDo:[ - " - find the method-home context for this one - " - doUnwind ifTrue:[ - con := selectedContext. - top := con. - [con notNil] whileTrue:[ - (con methodHome == selectedContext) ifTrue:[ - top := con - ]. - con := con sender - ]. - ]. - - "/ - "/ provide the classes nameSpace and changefile-update answers; - "/ in case we accept while in another context, to not capture these settings again - "/ - (Class updateChangeFileQuerySignal, - Class updateChangeListQuerySignal, - Class updateHistoryLineQuerySignal) answer:true - do:[ - Class nameSpaceQuerySignal answer:(aClass nameSpace) - do:[ - "/ the compiler nowadays already cares for the package... - "/ no, actually, it does not in case we are in the middle of a fileIn, - "/ and packageQuery is already answered by someone else. - "/ Better make it unpackaged, in case the user makes changes to other - "/ classes here (actually, I often change compiler, debugger, inspector here) - Class packageQuerySignal - answer:nil - do:[ - codeView contents:someCode. - Class methodRedefinitionNotification - answer:#keep - do:[ - | breakpoints | - - breakpoints := nil. - codeView isCodeView2 ifTrue:[ - breakpoints := codeView breakpoints. - ]. - - BreakpointQuery answer: breakpoints do:[ - "/ Use original method's programming language instead of class's one. - "/ In most cases it's the same, but it may be that the method edited - "/ and accepted was an extension method written in another languages - "/ (such as Smalltalk extension to Java class or Ruby extension to - "/ Smalltalk class. - newMethod := selectedContext programmingLanguage compilerClassForInteractiveTools - compile:someCode - forClass:aClass - inCategory:category - notifying:codeView. - "/ Kludge for accepting Java code in a debugger. The Java compiler - "/ does not compile single classes by always a full class and returns - "/ the compiled class(es) rather than a method. However, we need to update - "/ method holder of a codeView. - "/ - "/ So, here we check whether the retuned `newMethod` is really a method, - "/ if it's a class, try to search that class for a method with the - "/ same selector as selector of currently selected context. If found, - "/ thet's the 'new' method we are going to show. - newMethod isBehavior ifTrue:[ - | selector | - - selector := selectedContext selector. - newMethod := newMethod"actually a class" compiledMethodAt: selector ifAbsent: nil. - ]. - ]. - ]. - ]. - ]. - ]. - - methodCodeToggleSelectionHolder value:2. "/ showing current code - methodCodeToggle beVisible. - - inspecting ifFalse:[ - (newMethod notNil and:[newMethod ~~ #Error]) ifTrue:[ - codeView modified:false. - codeView isCodeView2 ifTrue:[ - codeView methodHolder value: newMethod. - ]. - - doUnwind ifTrue:[ - "/ if it worked, and doUnwind is true, - "/ remove everything up to and including top - "/ from the context chain - - selectedContext canReturn ifTrue:[ - self setContext:(top "sender"). - exitAction := #restart. - selectedContext setLineNumber:1. - self doRestart. - ] ifFalse:[ - self setContext:(top sender). - exitAction := #return. - ]. - ]. - ] ifFalse:[ - ^ cancelAction value - ] - ]. + " + find the method-home context for this one + " + doUnwind ifTrue:[ + con := selectedContext. + top := con. + [con notNil] whileTrue:[ + (con methodHome == selectedContext) ifTrue:[ + top := con + ]. + con := con sender + ]. + ]. + + "/ + "/ provide the classes nameSpace and changefile-update answers; + "/ in case we accept while in another context, to not capture these settings again + "/ + (Class updateChangeFileQuerySignal, + Class updateChangeListQuerySignal, + Class updateHistoryLineQuerySignal) answer:true + do:[ + Class nameSpaceQuerySignal answer:(aClass nameSpace) + do:[ + "/ the compiler nowadays already cares for the package... + "/ no, actually, it does not in case we are in the middle of a fileIn, + "/ and packageQuery is already answered by someone else. + "/ Better make it unpackaged, in case the user makes changes to other + "/ classes here (actually, I often change compiler, debugger, inspector here) + Class packageQuerySignal + answer:nil + do:[ + codeView contents:someCode. + Class methodRedefinitionNotification + answer:#keep + do:[ + | breakpoints | + + breakpoints := nil. + codeView isCodeView2 ifTrue:[ + breakpoints := codeView breakpoints. + ]. + + BreakpointQuery answer: breakpoints do:[ + "/ Use original method's programming language instead of class's one. + "/ In most cases it's the same, but it may be that the method edited + "/ and accepted was an extension method written in another languages + "/ (such as Smalltalk extension to Java class or Ruby extension to + "/ Smalltalk class. + newMethod := selectedContext programmingLanguage compilerClassForInteractiveTools + compile:someCode + forClass:aClass + inCategory:category + notifying:codeView. + "/ Kludge for accepting Java code in a debugger. The Java compiler + "/ does not compile single classes by always a full class and returns + "/ the compiled class(es) rather than a method. However, we need to update + "/ method holder of a codeView. + "/ + "/ So, here we check whether the retuned `newMethod` is really a method, + "/ if it's a class, try to search that class for a method with the + "/ same selector as selector of currently selected context. If found, + "/ thet's the 'new' method we are going to show. + newMethod isBehavior ifTrue:[ + | selector | + + selector := selectedContext selector. + newMethod := newMethod"actually a class" compiledMethodAt: selector ifAbsent: nil. + ]. + ]. + ]. + ]. + ]. + ]. + + methodCodeToggleSelectionHolder value:2. "/ showing current code + methodCodeToggle beVisible. + + inspecting ifFalse:[ + (newMethod notNil and:[newMethod ~~ #Error]) ifTrue:[ + codeView modified:false. + codeView isCodeView2 ifTrue:[ + codeView methodHolder value: newMethod. + ]. + + doUnwind ifTrue:[ + "/ if it worked, and doUnwind is true, + "/ remove everything up to and including top + "/ from the context chain + + selectedContext canReturn ifTrue:[ + self setContext:(top "sender"). + exitAction := #restart. + selectedContext setLineNumber:1. + self doRestart. + ] ifFalse:[ + self setContext:(top sender). + exitAction := #return. + ]. + ]. + ] ifFalse:[ + ^ cancelAction value + ] + ]. ]. "Created: / 17-11-2001 / 21:50:55 / cg" @@ -8446,59 +8446,59 @@ "/ con := con sender "/ ]. - " - use class&selector to find the method for the compilation - and compile. - " - category := givenCategoryOrNil. - sel := selectedContext selector. - implementorClass := selectedContext methodClass. - method := selectedContext method. - - implementorClass isNil ifTrue:[ - (method notNil and:[method mclass isNil and:[method wrapper notNil]]) ifTrue:[ - method := method wrapper. - ]. - method notNil ifTrue:[ - implementorClass := method mclass. - implementorClass isNil ifTrue:[ - implementorClass := method getMclass - ]. - ]. - ]. - implementorClass notNil ifTrue:[ - category isNil ifTrue:[ - method isNil ifTrue:[ - method := implementorClass compiledMethodAt:sel. - ]. - category := method category - ] - ] ifFalse:[ - receiverClass := selectedContext receiver class. - implementorClass := receiverClass whichClassImplements:sel. - implementorClass := implementorClass ? receiverClass. - implementorClass ~~ Object ifTrue:[ - implementorClass := Dialog - request:('Define ''%1'' in class:' bindWith:sel allBold) - initialAnswer:implementorClass name - list:(implementorClass withAllSuperclasses collect:[:each| each name]). - implementorClass size == 0 ifTrue:[ - ^ cancelAction value "/ cancelled - ]. - implementorClass := Smalltalk classNamed:implementorClass. - implementorClass isNil ifTrue:[ - Dialog warn:'No such class'. - ^ cancelAction value "/ cancelled - ]. - ]. - ]. - - self - codeAccept:someCode - inClass:implementorClass - unwind:doUnwind - category:category - onCancel:cancelAction. + " + use class&selector to find the method for the compilation + and compile. + " + category := givenCategoryOrNil. + sel := selectedContext selector. + implementorClass := selectedContext methodClass. + method := selectedContext method. + + implementorClass isNil ifTrue:[ + (method notNil and:[method mclass isNil and:[method wrapper notNil]]) ifTrue:[ + method := method wrapper. + ]. + method notNil ifTrue:[ + implementorClass := method mclass. + implementorClass isNil ifTrue:[ + implementorClass := method getMclass + ]. + ]. + ]. + implementorClass notNil ifTrue:[ + category isNil ifTrue:[ + method isNil ifTrue:[ + method := implementorClass compiledMethodAt:sel. + ]. + category := method category + ] + ] ifFalse:[ + receiverClass := selectedContext receiver class. + implementorClass := receiverClass whichClassImplements:sel. + implementorClass := implementorClass ? receiverClass. + implementorClass ~~ Object ifTrue:[ + implementorClass := Dialog + request:('Define ''%1'' in class:' bindWith:sel allBold) + initialAnswer:implementorClass name + list:(implementorClass withAllSuperclasses collect:[:each| each name]). + implementorClass size == 0 ifTrue:[ + ^ cancelAction value "/ cancelled + ]. + implementorClass := Smalltalk classNamed:implementorClass. + implementorClass isNil ifTrue:[ + Dialog warn:'No such class'. + ^ cancelAction value "/ cancelled + ]. + ]. + ]. + + self + codeAccept:someCode + inClass:implementorClass + unwind:doUnwind + category:category + onCancel:cancelAction. ]. "Created: / 17-11-2001 / 21:50:55 / cg" @@ -8506,7 +8506,7 @@ ! codeCompletion - "/ I found this code 3 times (CodeView2, NewSystemBrowser and DebugView) - smell? + "/ I found this code 3 times (CodeView2, NewSystemBrowser and DebugView) - smell? "/ (can we move that to a utility - probably DoWhatIMeanSupport) |cls language| @@ -8514,14 +8514,14 @@ currentMethod isNil ifTrue:[ ^ self ]. cls := currentMethod mclass. - cls notNil ifTrue:[ - language := cls programmingLanguage. + cls notNil ifTrue:[ + language := cls programmingLanguage. ]. UserInformation handle:[:ex | - ex proceed. + ex proceed. ] do:[ - DoWhatIMeanSupport codeCompletionForLanguage:language class:cls context:selectedContext codeView:codeView. + DoWhatIMeanSupport codeCompletionForLanguage:language class:cls context:selectedContext codeView:codeView. ]. "Modified: / 18-09-2013 / 14:20:21 / Jan Vrany " @@ -8532,7 +8532,7 @@ Redefined here, to answer true, if exclusice Debugger, which cannot handle popup boxes" (exclusive or:[windowGroup isNil]) ifTrue:[ - ^ true + ^ true ]. ^ super confirm:aString. ! @@ -8542,11 +8542,11 @@ Also sent to autoselect an interesting context on entry." HaltInterrupt handle:[:ex | - ignoreBreakpoints ifFalse:[ex reject]. - ('DebugView [info]: halt/breakpoint in debugger at %1 ignored [doShowSelection.]' bindWith:ex suspendedContext) infoPrintCR. - ex proceed + ignoreBreakpoints ifFalse:[ex reject]. + ('DebugView [info]: halt/breakpoint in debugger at %1 ignored [doShowSelection.]' bindWith:ex suspendedContext) infoPrintCR. + ex proceed ] do:[ - self updateForContext:lineNr + self updateForContext:lineNr ]. self updateMenuItems @@ -8555,10 +8555,10 @@ hideStackInspector stackInspector notNil ifTrue:[ - stackInspector destroy. - stackInspector := nil. - receiverInspector origin:(0.0 @ 0.0) corner:0.5 @ 1.0. - contextInspector origin:(0.5 @ 0.0) corner:(1.0 @ 1.0) + stackInspector destroy. + stackInspector := nil. + receiverInspector origin:(0.0 @ 0.0) corner:0.5 @ 1.0. + contextInspector origin:(0.5 @ 0.0) corner:(1.0 @ 1.0) ] ! @@ -8567,7 +8567,7 @@ sel := contextView selection. sel notNil ifTrue:[ - self showSelection:sel + self showSelection:sel ] "Created: / 18-06-2010 / 12:29:21 / cg" @@ -8583,45 +8583,45 @@ evView := anEvent view. evView notNil ifTrue:[ - focusView := evView windowGroup focusView. - focusView isNil ifTrue:[ - focusView := evView. - ]. - - anEvent isKeyPressEvent ifTrue:[ - key := anEvent key. - rawKey := anEvent rawKey. - - inCodeView := (focusView == codeView - or:[focusView isComponentOf:codeView]). - inCodeView ifTrue:[ - key == #CodeCompletion ifTrue:[ - "/ complete the word before/under the cursor. - self sensor - pushUserEvent:#codeCompletion - for:self - withArguments:#(). - ^ true - ]. - ]. - ]. + focusView := evView windowGroup focusView. + focusView isNil ifTrue:[ + focusView := evView. + ]. + + anEvent isKeyPressEvent ifTrue:[ + key := anEvent key. + rawKey := anEvent rawKey. + + inCodeView := (focusView == codeView + or:[focusView isComponentOf:codeView]). + inCodeView ifTrue:[ + key == #CodeCompletion ifTrue:[ + "/ complete the word before/under the cursor. + self sensor + pushUserEvent:#codeCompletion + for:self + withArguments:#(). + ^ true + ]. + ]. + ]. false ifTrue:[ - anEvent isButtonReleaseEvent ifTrue:[ - anEvent view == codeView ifTrue:[ - (RBParser notNil and:[RBParser isLoaded]) - ifTrue:[ - self sensor - pushEvent:anEvent. "/ must be first in queue - - self sensor - pushUserEvent:#explainSelection - for:self - withArguments:nil. - ^ true "/ eaten - ] - ] - ]. + anEvent isButtonReleaseEvent ifTrue:[ + anEvent view == codeView ifTrue:[ + (RBParser notNil and:[RBParser isLoaded]) + ifTrue:[ + self sensor + pushEvent:anEvent. "/ must be first in queue + + self sensor + pushUserEvent:#explainSelection + for:self + withArguments:nil. + ^ true "/ eaten + ] + ] + ]. ]. ]. @@ -8632,39 +8632,39 @@ currentMethod := aMethodOrNil. ! -showSelection:lineNr +showSelection:lineNr "user clicked on a header line - show selected code in textView. Also sent to autoselect an interesting context on entry." - - UserNotification - handle:[:ex | - "/ ex suspendedContext fullPrintAll. - Transcript showCR:ex description. - "/ Transcript showCR:ex parameter. - ex proceed - ] - do:[ - Error - handle:[:ex | - |s con| - - ex creator isControlInterrupt ifTrue:[ - 'DebugView [info]: halt/break ignored - while showing selection in debugger' - infoPrintCR. - ex proceed - ]. - ('DebugView [info]: error at %1 when showing selection in debugger ignored' - bindWith:ex suspendedContext) infoPrintCR. - s := '' writeStream. - s nextPutLine:'**** error in debugger, while extracting source'. - s nextPutLine:'****'. - s nextPutLine:'**** ',(ex description). - s nextPutLine:'****'. - con := ex suspendedContext. - s nextPutLine:'**** ',(con printString). - con := con sender. - HaltInterrupt ignoreIn:[ con fullPrintAllOn:s. ]. - + + UserNotification + handle:[:ex | + "/ ex suspendedContext fullPrintAll. + Transcript showCR:ex description. + "/ Transcript showCR:ex parameter. + ex proceed + ] + do:[ + Error + handle:[:ex | + |s con| + + ex creator isControlInterrupt ifTrue:[ + 'DebugView [info]: halt/break ignored - while showing selection in debugger' + infoPrintCR. + ex proceed + ]. + ('DebugView [info]: error at %1 when showing selection in debugger ignored' + bindWith:ex suspendedContext) infoPrintCR. + s := '' writeStream. + s nextPutLine:'**** error in debugger, while extracting source'. + s nextPutLine:'****'. + s nextPutLine:'**** ',(ex description). + s nextPutLine:'****'. + con := ex suspendedContext. + s nextPutLine:'**** ',(con printString). + con := con sender. + HaltInterrupt ignoreIn:[ con fullPrintAllOn:s. ]. + "/ [con notNil] whileTrue:[ "/ Error catch:[:ex | "/ s nextPutAll: '**** '; nextPutLine:(con printString). @@ -8676,27 +8676,27 @@ "/ con := con sender. "/ ] "/ ]. - - codeView contents:(s contents). - ex return. - ] - do:[ self doShowSelection:lineNr ] - ] + + codeView contents:(s contents). + ex return. + ] + do:[ self doShowSelection:lineNr ] + ] "Modified: / 19-07-2012 / 10:56:58 / cg" ! showStackInspectorFor:con stackInspector isNil ifTrue:[ - receiverInspector origin:(0.0 @ 0.0) corner:0.3 @ 1.0. - contextInspector origin:(0.3 @ 0.0) corner:(0.6 @ 1.0). - stackInspector := InspectorView - origin:(0.6 @ 0.0) - corner:(1.0 @ 1.0) - in:contextInspector superView. - stackInspector realize. - stackInspector fieldListLabel:'Stack'. - stackInspector hideReceiver:true + receiverInspector origin:(0.0 @ 0.0) corner:0.3 @ 1.0. + contextInspector origin:(0.3 @ 0.0) corner:(0.6 @ 1.0). + stackInspector := InspectorView + origin:(0.6 @ 0.0) + corner:(1.0 @ 1.0) + in:contextInspector superView. + stackInspector realize. + stackInspector fieldListLabel:'Stack'. + stackInspector hideReceiver:true ]. stackInspector inspect:(con stackFrame asArray). stackInspector showLast @@ -8705,41 +8705,41 @@ updateContextInfoFor:aContext "additional info as-per selected context; for now: - update:with:from: - show who was responsible + update:with:from: - show who was responsible " |whatChanged changedObject receiver| aContext selector == #'update:with:from:' ifTrue:[ - receiver := aContext receiver. - whatChanged := aContext argAt:1. - changedObject := aContext argAt:3. - - changedObject isBehavior ifTrue:[ - contextInfoLabel label:('update (',whatChanged printString allBold,') triggered by ',changedObject name allBold). - ^ self - ]. - - receiver class allInstanceVariableNames keysAndValuesDo:[:i :nm | - (receiver instVarAt:i) == changedObject ifTrue:[ - contextInfoLabel label:('update (',whatChanged printString allBold,') triggered by ',nm allBold). - ^ self - ] - ]. - - (receiver isKindOf:ApplicationModel) ifTrue:[ - receiver builder notNil ifTrue:[ - (receiver builder bindings ? #()) keysAndValuesDo:[:eachAspect :eachValue | - eachValue == changedObject ifTrue:[ - contextInfoLabel label:('update (',whatChanged printString allBold,') triggered by aspect ',eachAspect allBold). - ^ self - ] - ] - ] - ]. - - contextInfoLabel label:('update (',whatChanged printString allBold,') triggered by ',changedObject classNameWithArticle allBold). - ^self. + receiver := aContext receiver. + whatChanged := aContext argAt:1. + changedObject := aContext argAt:3. + + changedObject isBehavior ifTrue:[ + contextInfoLabel label:('update (',whatChanged printString allBold,') triggered by ',changedObject name allBold). + ^ self + ]. + + receiver class allInstanceVariableNames keysAndValuesDo:[:i :nm | + (receiver instVarAt:i) == changedObject ifTrue:[ + contextInfoLabel label:('update (',whatChanged printString allBold,') triggered by ',nm allBold). + ^ self + ] + ]. + + (receiver isKindOf:ApplicationModel) ifTrue:[ + receiver builder notNil ifTrue:[ + (receiver builder bindings ? #()) keysAndValuesDo:[:eachAspect :eachValue | + eachValue == changedObject ifTrue:[ + contextInfoLabel label:('update (',whatChanged printString allBold,') triggered by aspect ',eachAspect allBold). + ^ self + ] + ] + ] + ]. + + contextInfoLabel label:('update (',whatChanged printString allBold,') triggered by ',changedObject classNameWithArticle allBold). + ^self. ]. contextInfoLabel label:nil. ! @@ -8758,407 +8758,407 @@ self setCurrentMethod:nil. contextArray notNil ifTrue:[ - lineNr <= contextArray size ifTrue:[ - con := contextArray at:lineNr. - callee := contextArray at:lineNr-1 ifAbsent:nil. - ]. - " - clicking on the '** ...'-line shows more ... - " - con isNil ifTrue:[ - line := contextView list at:lineNr. - (line startsWith:'**') ifTrue:[ - self showMore. - lineNr >= contextArray size ifTrue:[ - contextView setSelection:lineNr. - con := contextArray at:lineNr ifAbsent:nil - ] - ]. - con isNil ifTrue:[ - codeView contents:nil. - ^ self - ]. - ]. - - selectedContext := con. - m := contextView middleButtonMenu. - (m notNil and:[selectedContext notNil]) ifTrue:[ - m enableAll:#(browseImplementors browseSenders inspectContext) - ]. - - self withExecuteCursorDo:[ - codeSet := false. - - " - give it to the (lower right) inspector - " - Error handle:[:ex | - 'DebugView [warning]: error while accessing context: ' errorPrint. - ex description errorPrintCR. - contextInspector inspect:nil. - contextInspector fieldListLabel:('Context'). - ex suspendedContext fullPrintAllOn: Transcript. + lineNr <= contextArray size ifTrue:[ + con := contextArray at:lineNr. + callee := contextArray at:lineNr-1 ifAbsent:nil. + ]. + " + clicking on the '** ...'-line shows more ... + " + con isNil ifTrue:[ + line := contextView list at:lineNr. + (line startsWith:'**') ifTrue:[ + self showMore. + lineNr >= contextArray size ifTrue:[ + contextView setSelection:lineNr. + con := contextArray at:lineNr ifAbsent:nil + ] + ]. + con isNil ifTrue:[ + codeView contents:nil. + ^ self + ]. + ]. + + selectedContext := con. + m := contextView middleButtonMenu. + (m notNil and:[selectedContext notNil]) ifTrue:[ + m enableAll:#(browseImplementors browseSenders inspectContext) + ]. + + self withExecuteCursorDo:[ + codeSet := false. + + " + give it to the (lower right) inspector + " + Error handle:[:ex | + 'DebugView [warning]: error while accessing context: ' errorPrint. + ex description errorPrintCR. + contextInspector inspect:nil. + contextInspector fieldListLabel:('Context'). + ex suspendedContext fullPrintAllOn: Transcript. "/ ex reject. - ] do:[ - contextInspector inspect:con. - "/ contextInspector fieldListLabel:('Context: ',con method whoString). - contextInspector tryToSelectKeyNamed:lastSelectionInContextInspector. - ]. - - "/ show a stack inspector sometimes - - con hasStackToShow ifTrue:[ - self showStackInspectorFor:con - ] ifFalse:[ - self hideStackInspector - ]. - - homeContext := con methodHome. - con canReturn ifTrue:[ - returnButton enable. restartButton enable. - ] ifFalse:[ - returnButton disable. restartButton disable. - ]. - - lineNrInMethod := con lineNumber. - - canAccept := false. - - homeContext isNil ifTrue:[ - " - mhmh - an optimized block - should get the block here, and get the method from - that one ... - But in the current version, there is no easy way to get to the block - since that one is not in the context. - A future new block calling scheme will fix this - (passing the block instead of the home as block argument). - " - (method := con method) isNil ifTrue:[ - "temporary kludge - peek into the sender context. - If its a do-like method and there is a single block variable - in the args or temporaries, that must be the one. - This helps in some cases. - " - (sender := con sender) notNil ifTrue:[ - tryVars := false. - (selSender := sender selector) notNil ifTrue:[ - ((selSender endsWith:'do:') or:[selSender endsWith:'Do:']) ifTrue:[ - tryVars := true. - ] - ]. - tryVars ifTrue:[ - possibleBlocks := sender argsAndVars select:[:v | v isBlock]. - possibleBlocks := possibleBlocks select:[:b | b home isNil]. - possibleBlocks size == 1 ifTrue:[ - method := possibleBlocks first method. - ]. - ] - ]. - ] - ] ifFalse:[ - "fetch rec here - so we won't need context in doItAction" - rec := homeContext receiver. - sel := homeContext selector. - sel notNil ifTrue:[ - canAccept := true. - - implementorClass := homeContext methodClass. - implementorClass isNil ifTrue:[ - homeContext method notNil ifTrue:[ - WrappedMethod allInstancesDo:[:wrapped | - wrapped originalMethod == homeContext method ifTrue:[ - implementorClass := wrapped mclass - ] - ]. - implementorClass isNil ifTrue:[ - (homeContext searchClass notNil - and:[homeContext searchClass isObsolete]) ifTrue:[ - cannotAcceptDueToOutdatedClass := true. - ] - ]. - ]. - ]. - implementorClass isNil ifTrue:[ - Error handle:[:ex | + ] do:[ + contextInspector inspect:con. + "/ contextInspector fieldListLabel:('Context: ',con method whoString). + contextInspector tryToSelectKeyNamed:lastSelectionInContextInspector. + ]. + + "/ show a stack inspector sometimes + + con hasStackToShow ifTrue:[ + self showStackInspectorFor:con + ] ifFalse:[ + self hideStackInspector + ]. + + homeContext := con methodHome. + con canReturn ifTrue:[ + returnButton enable. restartButton enable. + ] ifFalse:[ + returnButton disable. restartButton disable. + ]. + + lineNrInMethod := con lineNumber. + + canAccept := false. + + homeContext isNil ifTrue:[ + " + mhmh - an optimized block + should get the block here, and get the method from + that one ... + But in the current version, there is no easy way to get to the block + since that one is not in the context. + A future new block calling scheme will fix this + (passing the block instead of the home as block argument). + " + (method := con method) isNil ifTrue:[ + "temporary kludge - peek into the sender context. + If its a do-like method and there is a single block variable + in the args or temporaries, that must be the one. + This helps in some cases. + " + (sender := con sender) notNil ifTrue:[ + tryVars := false. + (selSender := sender selector) notNil ifTrue:[ + ((selSender endsWith:'do:') or:[selSender endsWith:'Do:']) ifTrue:[ + tryVars := true. + ] + ]. + tryVars ifTrue:[ + possibleBlocks := sender argsAndVars select:[:v | v isBlock]. + possibleBlocks := possibleBlocks select:[:b | b home isNil]. + possibleBlocks size == 1 ifTrue:[ + method := possibleBlocks first method. + ]. + ] + ]. + ] + ] ifFalse:[ + "fetch rec here - so we won't need context in doItAction" + rec := homeContext receiver. + sel := homeContext selector. + sel notNil ifTrue:[ + canAccept := true. + + implementorClass := homeContext methodClass. + implementorClass isNil ifTrue:[ + homeContext method notNil ifTrue:[ + WrappedMethod allInstancesDo:[:wrapped | + wrapped originalMethod == homeContext method ifTrue:[ + implementorClass := wrapped mclass + ] + ]. + implementorClass isNil ifTrue:[ + (homeContext searchClass notNil + and:[homeContext searchClass isObsolete]) ifTrue:[ + cannotAcceptDueToOutdatedClass := true. + ] + ]. + ]. + ]. + implementorClass isNil ifTrue:[ + Error handle:[:ex | "/ not covered by Error, anyway "/ ex signal == BreakPointInterrupt ifTrue:[ "/ ex proceed. "/ ]. - code := 'error while asking method for its source'. - code := code , Character cr , ex creator printString. - code := code , Character cr , 'in: ' , ex suspendedContext printString. - - canAccept := false. - ex return. - ] do:[ - " - special: look if this context was created by - valueWithReceiver kind of method invocation; - if so, grab the method from the sender and show it - " - ((sender := homeContext sender) notNil - and:[((sender selector ? '') startsWith:'valueWithReceiver:') - and:[sender receiver isMethod]]) ifTrue:[ - method := sender receiver. - canAccept := false. - ] ifFalse:[ - (method := con method) notNil ifTrue:[ - canAccept := false. - ] - ]. - ] - ] ifFalse:[ - method := implementorClass compiledMethodAt:sel. - ]. - ] - ]. - - homeContext notNil ifTrue:[ - searchClass := homeContext searchClass ? rec class. - currentMethod := searchClass lookupMethodFor:sel. - ]. - originalMethod := currentMethod. - (currentMethod notNil - and:[currentMethod ~~ method - and:[ (currentMethod isWrapped and:[ method == currentMethod originalMethod]) not ]]) ifTrue:[ - originalMethod := method. - methodCodeToggleSelectionHolder value = 1 ifTrue:[ - method := originalMethod. "/ the one which is suspended / was executing - ] ifFalse:[ - method := currentMethod. "/ the one which has already been accepted/modified. - lineNrInMethod := nil. - canAccept := true. - ]. - methodCodeToggle beVisible. - ] ifFalse:[ - methodCodeToggle beInvisible. - ]. - - code isNil ifTrue:[ - errMsg := nil. - method isNil ifTrue:[ - "/ fall back heuristics (see how this was called, fetch block from caller) - sender := con sender. - con isBlockContext ifTrue:[ - (sender notNil - and:[((sender selector ? '') startsWith:'value') - and:[sender receiver isBlock]]) ifTrue:[ - code := sender receiver source. - ] - ] ifFalse:[ - (sender notNil - and:[((sender selector ? '') startsWith:'valueWith') - and:[sender receiver isMethod]]) ifTrue:[ - method := sender receiver. - ] - ] - ]. - method notNil ifTrue:[ - contextInspector fieldListLabel:(method selector "whoString"). - Error handle:[:ex | + code := 'error while asking method for its source'. + code := code , Character cr , ex creator printString. + code := code , Character cr , 'in: ' , ex suspendedContext printString. + + canAccept := false. + ex return. + ] do:[ + " + special: look if this context was created by + valueWithReceiver kind of method invocation; + if so, grab the method from the sender and show it + " + ((sender := homeContext sender) notNil + and:[((sender selector ? '') startsWith:'valueWithReceiver:') + and:[sender receiver isMethod]]) ifTrue:[ + method := sender receiver. + canAccept := false. + ] ifFalse:[ + (method := con method) notNil ifTrue:[ + canAccept := false. + ] + ]. + ] + ] ifFalse:[ + method := implementorClass compiledMethodAt:sel. + ]. + ] + ]. + + homeContext notNil ifTrue:[ + searchClass := homeContext searchClass ? rec class. + currentMethod := searchClass lookupMethodFor:sel. + ]. + originalMethod := currentMethod. + (currentMethod notNil + and:[currentMethod ~~ method + and:[ (currentMethod isWrapped and:[ method == currentMethod originalMethod]) not ]]) ifTrue:[ + originalMethod := method. + methodCodeToggleSelectionHolder value = 1 ifTrue:[ + method := originalMethod. "/ the one which is suspended / was executing + ] ifFalse:[ + method := currentMethod. "/ the one which has already been accepted/modified. + lineNrInMethod := nil. + canAccept := true. + ]. + methodCodeToggle beVisible. + ] ifFalse:[ + methodCodeToggle beInvisible. + ]. + + code isNil ifTrue:[ + errMsg := nil. + method isNil ifTrue:[ + "/ fall back heuristics (see how this was called, fetch block from caller) + sender := con sender. + con isBlockContext ifTrue:[ + (sender notNil + and:[((sender selector ? '') startsWith:'value') + and:[sender receiver isBlock]]) ifTrue:[ + code := sender receiver source. + ] + ] ifFalse:[ + (sender notNil + and:[((sender selector ? '') startsWith:'valueWith') + and:[sender receiver isMethod]]) ifTrue:[ + method := sender receiver. + ] + ] + ]. + method notNil ifTrue:[ + contextInspector fieldListLabel:(method selector "whoString"). + Error handle:[:ex | "/ not covered by Error, anyway "/ ex signal isControlInterrupt ifTrue:[ "/ ex proceed. "/ ]. - code := 'error while asking method for its source'. - code := code , Character cr , ex creator printString. - code := code , Character cr , 'in: ' , ex suspendedContext printString. - - canAccept := false. - ex return. - ] do:[ - self sensor shiftDown ifTrue:[ - code := method decompiledSource - ] ifFalse:[ - code := method source. - ]. - ]. - - code isNil ifTrue:[ - method sourceFilename notNil ifTrue:[ - codeView contents:(resources - string:'** no sourcefile: %1 **' - with:method sourceFilename). - codeView realized ifTrue:[ - "codeView is not realized on initial startup" - codeView flash:'no source'. - ]. - codeSet := true. - ] ifFalse:[ - [ - |src| - - src := String streamContents:[:s | Decompiler decompile:method to:s]. - codeView contents:src. - codeSet := true. - ] on: Error do:[ - errMsg := '** no source **' - ]. - ] - ]. - ] ifFalse:[ - contextInspector fieldListLabel:'Context'. - homeContext isNil ifTrue:[ - errMsg := '** sorry; cannot show code of all optimized blocks (yet) **'. - ] ifFalse:[ - errMsg := '** no method - no source **'. - canDefine := false. "/ true. - ] - ]. - errMsg notNil ifTrue:[ - self showError:errMsg. - codeSet := true. - ] - ]. - - code isNil ifTrue:[ - "/ canAccept := false. - codeSet ifFalse:[ - codeView contents:nil. - ] - ] ifFalse:[ - lineNrInMethod notNil ifTrue:[ - lineNrInMethod == 0 ifTrue:[ - (method notNil and:[method isJavaMethod]) ifTrue:[ - lineNrInMethod := method lineNumber - ]. - "/ guess lineNumber from sent-messages selector - "/ kludge to fix lineNr-display of shared subclassResponsibility methods. - lineNrInMethod == 0 ifTrue:[ - |conIdx sentContext messages| - - conIdx := contextArray identityIndexOf:con. - conIdx > 1 ifTrue:[ - sentContext := contextArray at:conIdx-1. - sentContext isBlockContext ifFalse:[ - (method notNil and:[code notNil]) ifTrue:[ - messages := method messagesSent. - messages size == 1 ifTrue:[ - sentContext selector == messages first ifTrue:[ - lineNrInMethod := code asStringCollection findFirst:[:l | l includesString:sentContext selector]. - ] - ] - ]. - ]. - ]. - ]. - ]. - ]. - codeView isCodeView2 ifTrue:[ - codeView model - setValue: code; - changed. - codeView methodHolder value: method. - codeView classHolder value: ((method respondsTo: #mclass) ifTrue:[method mclass] ifFalse:[rec class]) - ] ifFalse:[ - UserPreferences current syntaxColoring ifTrue:[ - implementorClass isNil ifTrue:[ - (con isBlockContext - and:[con home isNil - and:[con guessedHome notNil]]) - ifTrue:[ - implementorClass := con guessedHome mclass - ] - ]. - implementorClass notNil ifTrue:[ - (highlighter := implementorClass syntaxHighlighterClass) notNil ifTrue:[ - code size < 100000 ifTrue:[ - Error catch:[ - code := highlighter formatMethodSource:code in:implementorClass. - ] - ] - ] - ] - ]. + code := 'error while asking method for its source'. + code := code , Character cr , ex creator printString. + code := code , Character cr , 'in: ' , ex suspendedContext printString. + + canAccept := false. + ex return. + ] do:[ + self sensor shiftDown ifTrue:[ + code := method decompiledSource + ] ifFalse:[ + code := method source. + ]. + ]. + + code isNil ifTrue:[ + method sourceFilename notNil ifTrue:[ + codeView contents:(resources + string:'** no sourcefile: %1 **' + with:method sourceFilename). + codeView realized ifTrue:[ + "codeView is not realized on initial startup" + codeView flash:'no source'. + ]. + codeSet := true. + ] ifFalse:[ + [ + |src| + + src := String streamContents:[:s | Decompiler decompile:method to:s]. + codeView contents:src. + codeSet := true. + ] on: Error do:[ + errMsg := '** no source **' + ]. + ] + ]. + ] ifFalse:[ + contextInspector fieldListLabel:'Context'. + homeContext isNil ifTrue:[ + errMsg := '** sorry; cannot show code of all optimized blocks (yet) **'. + ] ifFalse:[ + errMsg := '** no method - no source **'. + canDefine := false. "/ true. + ] + ]. + errMsg notNil ifTrue:[ + self showError:errMsg. + codeSet := true. + ] + ]. + + code isNil ifTrue:[ + "/ canAccept := false. + codeSet ifFalse:[ + codeView contents:nil. + ] + ] ifFalse:[ + lineNrInMethod notNil ifTrue:[ + lineNrInMethod == 0 ifTrue:[ + (method notNil and:[method isJavaMethod]) ifTrue:[ + lineNrInMethod := method lineNumber + ]. + "/ guess lineNumber from sent-messages selector + "/ kludge to fix lineNr-display of shared subclassResponsibility methods. + lineNrInMethod == 0 ifTrue:[ + |conIdx sentContext messages| + + conIdx := contextArray identityIndexOf:con. + conIdx > 1 ifTrue:[ + sentContext := contextArray at:conIdx-1. + sentContext isBlockContext ifFalse:[ + (method notNil and:[code notNil]) ifTrue:[ + messages := method messagesSent. + messages size == 1 ifTrue:[ + sentContext selector == messages first ifTrue:[ + lineNrInMethod := code asStringCollection findFirst:[:l | l includesString:sentContext selector]. + ] + ] + ]. + ]. + ]. + ]. + ]. + ]. + codeView isCodeView2 ifTrue:[ + codeView model + setValue: code; + changed. + codeView methodHolder value: method. + codeView classHolder value: ((method respondsTo: #mclass) ifTrue:[method mclass] ifFalse:[rec class]) + ] ifFalse:[ + UserPreferences current syntaxColoring ifTrue:[ + implementorClass isNil ifTrue:[ + (con isBlockContext + and:[con home isNil + and:[con guessedHome notNil]]) + ifTrue:[ + implementorClass := con guessedHome mclass + ] + ]. + implementorClass notNil ifTrue:[ + (highlighter := implementorClass syntaxHighlighterClass) notNil ifTrue:[ + code size < 100000 ifTrue:[ + Error catch:[ + code := highlighter formatMethodSource:code in:implementorClass. + ] + ] + ] + ] + ]. "/ code ~= (codeView contents) ifTrue:[ - cannotAcceptDueToOutdatedClass ifTrue:[ - codeView setContents:(('Obsolete code (outdated due to class change). Use Browser.' colorizeAllWith:Color red),Character cr,Character cr,code asString). - ] ifFalse:[ - codeView setContents:code. - ]. + cannotAcceptDueToOutdatedClass ifTrue:[ + codeView setContents:(('Obsolete code (outdated due to class change). Use Browser.' colorizeAllWith:Color red),Character cr,Character cr,code asString). + ] ifFalse:[ + codeView setContents:code. + ]. "/ ]. - ]. - (lineNrInMethod notNil - and:[lineNrInMethod ~~ 0 - and:[lineNrInMethod <= codeView list size]]) ifTrue:[ + ]. + (lineNrInMethod notNil + and:[lineNrInMethod ~~ 0 + and:[lineNrInMethod <= codeView list size]]) ifTrue:[ lineNrInMethod == 255 ifFalse:[ - (lineNrInMethod == 255 - and:[method notNil - and:[method hasCode not]]) ifTrue:[ - "/ means: do not really know in interpreted methods - codeView selectFromLine:255 col:1 toLine:codeView list size + 1 col:0. - ] ifFalse:[ - codeView selectLine:lineNrInMethod. - ]. - codeView makeSelectionVisible + (lineNrInMethod == 255 + and:[method notNil + and:[method hasCode not]]) ifTrue:[ + "/ means: do not really know in interpreted methods + codeView selectFromLine:255 col:1 toLine:codeView list size + 1 col:0. + ] ifFalse:[ + codeView selectLine:lineNrInMethod. + ]. + codeView makeSelectionVisible ]. - ] ifFalse:[ - codeView unselect. - codeView scrollToTop - ] - ]. - - codeView acceptEnabled:canAccept. - canAccept ifTrue:[ - codeView acceptAction:[:code | self codeAccept:code asString] - ] ifFalse:[ - codeView acceptAction:[:code | self beep] - ]. - - receiverInspector inspect:rec. - receiverInspector fieldListLabel:("'Receiver: ',"rec classNameWithArticle). - receiverInspector tryToSelectKeyNamed:lastSelectionInReceiverInspector. - - " - the one below is wrong: currently, the - evaluator cannot handle passed contexts. - Once it does, pass con as in:-arg - " - (rec isJavaObject - and:[method isNil or:[method isJavaMethod not]]) ifTrue:[ - "/ although a java object, use the smalltalk parser here for doIts. - evaluatorClass := Parser. - codeView commentStrings:#( '//' ( '/*' '*/' ) ). - ] ifFalse:[ - (method notNil and:[method mclass notNil]) ifTrue:[ - evaluatorClass := method mclass evaluatorClass. - codeView commentStrings:method mclass programmingLanguage commentStrings. - ] ifFalse:[ - evaluatorClass := rec class evaluatorClass. - codeView commentStrings:rec class programmingLanguage commentStrings. - ]. - ]. - - codeView - doItAction: - [:theCode | - evaluatorClass - evaluate:theCode - in:actualContext "/ (selectedContext ? actualContext) - receiver:rec - notifying:codeView - logged:true - ifFail:nil - ]; - editedMethodOrClass:(method ? rec class). - - - self setCurrentMethod:method. - - selectedContext := homeContext ? con. - actualContext := con - ]. + ] ifFalse:[ + codeView unselect. + codeView scrollToTop + ] + ]. + + codeView acceptEnabled:canAccept. + canAccept ifTrue:[ + codeView acceptAction:[:code | self codeAccept:code asString] + ] ifFalse:[ + codeView acceptAction:[:code | self beep] + ]. + + receiverInspector inspect:rec. + receiverInspector fieldListLabel:("'Receiver: ',"rec classNameWithArticle). + receiverInspector tryToSelectKeyNamed:lastSelectionInReceiverInspector. + + " + the one below is wrong: currently, the + evaluator cannot handle passed contexts. + Once it does, pass con as in:-arg + " + (rec isJavaObject + and:[method isNil or:[method isJavaMethod not]]) ifTrue:[ + "/ although a java object, use the smalltalk parser here for doIts. + evaluatorClass := Parser. + codeView commentStrings:#( '//' ( '/*' '*/' ) ). + ] ifFalse:[ + (method notNil and:[method mclass notNil]) ifTrue:[ + evaluatorClass := method mclass evaluatorClass. + codeView commentStrings:method mclass programmingLanguage commentStrings. + ] ifFalse:[ + evaluatorClass := rec class evaluatorClass. + codeView commentStrings:rec class programmingLanguage commentStrings. + ]. + ]. + + codeView + doItAction: + [:theCode | + evaluatorClass + evaluate:theCode + in:actualContext "/ (selectedContext ? actualContext) + receiver:rec + notifying:codeView + logged:true + ifFail:nil + ]; + editedMethodOrClass:(method ? rec class). + + + self setCurrentMethod:method. + + selectedContext := homeContext ? con. + actualContext := con + ]. ] ifFalse:[ - codeView contents:nil. + codeView contents:nil. ]. codeView modified:false. con isContext ifFalse:[ - sendButton disable. + sendButton disable. ] ifTrue:[ - sendButton enable. + sendButton enable. ]. self updateContextInfoFor:con. @@ -9171,9 +9171,9 @@ homeContext := nil. (canDefine or:[self canDefineForCallee:callee]) ifTrue:[ - defineButton beVisible. + defineButton beVisible. ] ifFalse:[ - defineButton beInvisible. + defineButton beInvisible. ]. "/ enable/disable some menu items @@ -9196,21 +9196,21 @@ ignoreForProcess:aProcess ignoredProcesses isNil ifTrue:[ - ignoredProcesses := WeakIdentitySet new. + ignoredProcesses := WeakIdentitySet new. ]. ignoredProcesses add:aProcess ! ignoreForReceiverClass:aClass ignoredReceiverClasses isNil ifTrue:[ - ignoredReceiverClasses := WeakIdentitySet new. + ignoredReceiverClasses := WeakIdentitySet new. ]. ignoredReceiverClasses add:aClass ! ignoreIfCalledFromMethod:aMethod ignoredSendingClassAndSelectors isNil ifTrue:[ - ignoredSendingClassAndSelectors := OrderedCollection new. + ignoredSendingClassAndSelectors := OrderedCollection new. ]. "/ remember the method's name, not the method. @@ -9228,9 +9228,9 @@ decrementIgnoreCount ignoreCount notNil ifTrue:[ - ignoreCount > 0 ifTrue:[ - ignoreCount := ignoreCount - 1 - ] + ignoreCount > 0 ifTrue:[ + ignoreCount := ignoreCount - 1 + ] ] ! ! @@ -9238,43 +9238,43 @@ printConditionOn:aStream ignoredSendingClassAndSelectors notEmptyOrNil ifTrue:[ - aStream nextPutAll:(' if called from %1 >> %2' - bindWith:ignoredSendingClassAndSelectors first first - with:ignoredSendingClassAndSelectors first second). - ^ self. + aStream nextPutAll:(' if called from %1 >> %2' + bindWith:ignoredSendingClassAndSelectors first first + with:ignoredSendingClassAndSelectors first second). + ^ self. ]. ignoredProcesses notEmptyOrNil ifTrue:[ - aStream nextPutAll:(' in %1 processes (%2)' - bindWith:ignoredProcesses size - with:((ignoredProcesses collect:[:each | each name] as:OrderedCollection) asStringWith:', ')). - ^ self. + aStream nextPutAll:(' in %1 processes (%2)' + bindWith:ignoredProcesses size + with:((ignoredProcesses collect:[:each | each name] as:OrderedCollection) asStringWith:', ')). + ^ self. ]. ignoredReceiverClasses notNil ifTrue:[ - aStream nextPutAll:(' for %1 classes (%2)' - bindWith:ignoredReceiverClasses size - with:((ignoredReceiverClasses collect:[:each | each name] as:OrderedCollection) asStringWith:', ')). - ^ self. + aStream nextPutAll:(' for %1 classes (%2)' + bindWith:ignoredReceiverClasses size + with:((ignoredReceiverClasses collect:[:each | each name] as:OrderedCollection) asStringWith:', ')). + ^ self. ]. ignoreUntilShiftKeyPressed == true ifTrue:[ - aStream nextPutAll:' until shiftKey pressed'. - ^ self. + aStream nextPutAll:' until shiftKey pressed'. + ^ self. ]. ignoreEndTime notNil ifTrue:[ - aStream nextPutAll:' until '. - ignoreEndTime printOn:aStream. - ^ self. + aStream nextPutAll:' until '. + ignoreEndTime printOn:aStream. + ^ self. ]. (ignoreCount notNil) ifTrue:[ - (ignoreCount > 0) ifTrue:[ - aStream nextPutAll:' for '. - ignoreCount printOn:aStream. - ^ self. - ]. - (ignoreCount < 0) ifTrue:[ - aStream nextPutAll:' forEver'. - ^ self. - ]. - aStream nextPutAll:' no longer'. + (ignoreCount > 0) ifTrue:[ + aStream nextPutAll:' for '. + ignoreCount printOn:aStream. + ^ self. + ]. + (ignoreCount < 0) ifTrue:[ + aStream nextPutAll:' forEver'. + ^ self. + ]. + aStream nextPutAll:' no longer'. ]. ! ! @@ -9285,8 +9285,8 @@ nil if not ignored" ^ String streamContents:[:s | - s nextPutAll:'ignored '. - self printConditionOn:s + s nextPutAll:'ignored '. + self printConditionOn:s ]. "/ ignoreCount notNil ifTrue:[ @@ -9323,17 +9323,17 @@ "true if this ignore-entry is still active" ignoreEndTime notNil ifTrue:[ - ^ ignoreEndTime > Timestamp now + ^ ignoreEndTime > Timestamp now ]. ignoreCount notNil ifTrue:[ - ^ ignoreCount == -1 or:[ ignoreCount > 0 ] + ^ ignoreCount == -1 or:[ ignoreCount > 0 ] ]. ignoredProcesses notNil ifTrue:[ - ignoredProcesses := ignoredProcesses reject:[:p | p notNil and:[p isDead]]. - ignoredProcesses isEmpty ifTrue:[ - ignoredProcesses := nil. - ^ false - ]. + ignoredProcesses := ignoredProcesses reject:[:p | p notNil and:[p isDead]]. + ignoredProcesses isEmpty ifTrue:[ + ignoredProcesses := nil. + ^ false + ]. ]. ^ true @@ -9358,13 +9358,13 @@ "true if this halt should be ignored (sometimes)" ignoreUntilShiftKeyPressed == true ifTrue:[ - ^ Screen current shiftDown not + ^ Screen current shiftDown not ]. ignoreCount notNil ifTrue:[ - ^ ignoreCount > 0 + ^ ignoreCount > 0 ]. ignoreEndTime notNil ifTrue:[ - ^ ignoreEndTime > Timestamp now + ^ ignoreEndTime > Timestamp now ]. ^ true @@ -9398,9 +9398,9 @@ "/ self assert:(methodArg mclass notNil). methodArg == #all ifTrue:[ - weakMethodHolder := methodArg + weakMethodHolder := methodArg ] ifFalse:[ - weakMethodHolder := WeakArray with:methodArg. + weakMethodHolder := WeakArray with:methodArg. ]. lineNumber := lineNumberArg. @@ -9413,15 +9413,15 @@ |method| (method := self method) isNil ifTrue:[ - aStream nextPutAll:'an obsolete IgnoredHalt'. - ^ self + aStream nextPutAll:'an obsolete IgnoredHalt'. + ^ self ]. aStream nextPutAll:'Ignore '. method isSymbol ifTrue:[ - method printOn:aStream. + method printOn:aStream. ] ifFalse:[ - method whoString printOn:aStream. + method whoString printOn:aStream. ]. self printConditionOn:aStream. @@ -9464,30 +9464,30 @@ "/ Transcript show:'is same; ignored: '; showCR:self isHaltIgnored. context notNil ifTrue:[ - ignoredReceiverClasses notNil ifTrue:[ - ^ ignoredReceiverClasses includes:(context receiver class) - ]. + ignoredReceiverClasses notNil ifTrue:[ + ^ ignoredReceiverClasses includes:(context receiver class) + ]. ]. "/ Transcript showCR:ignoredProcesses. "/ Transcript showCR:Processor activeProcess. ignoredProcesses notNil ifTrue:[ - ^ ignoredProcesses includes:(Processor activeProcess) + ^ ignoredProcesses includes:(Processor activeProcess) ]. ignoredSendingClassAndSelectors notNil ifTrue:[ - context withAllSendersDo:[:each | - |m className selector cls| - - (m := each method) notNil ifTrue:[ - cls := m mclass. - cls notNil ifTrue:[ - className := cls name. - selector := m selector. - (ignoredSendingClassAndSelectors contains:[:entry | entry first = className and:[entry second = selector]]) - ifTrue:[^ true]. - ]. - ] - ] + context withAllSendersDo:[:each | + |m className selector cls| + + (m := each method) notNil ifTrue:[ + cls := m mclass. + cls notNil ifTrue:[ + className := cls name. + selector := m selector. + (ignoredSendingClassAndSelectors contains:[:entry | entry first = className and:[entry second = selector]]) + ifTrue:[^ true]. + ]. + ] + ] ]. ^ self isHaltIgnored "/ unconditionally @@ -9529,15 +9529,15 @@ !DebugView class methodsFor:'documentation'! version - ^ '$Header: /cvs/stx/stx/libtool/DebugView.st,v 1.687 2015-02-24 18:23:38 cg Exp $' + ^ '$Header: /cvs/stx/stx/libtool/DebugView.st,v 1.688 2015-02-25 00:26:22 cg Exp $' ! version_CVS - ^ '$Header: /cvs/stx/stx/libtool/DebugView.st,v 1.687 2015-02-24 18:23:38 cg Exp $' + ^ '$Header: /cvs/stx/stx/libtool/DebugView.st,v 1.688 2015-02-25 00:26:22 cg Exp $' ! version_SVN - ^ '$Id: DebugView.st,v 1.687 2015-02-24 18:23:38 cg Exp $' + ^ '$Id: DebugView.st,v 1.688 2015-02-25 00:26:22 cg Exp $' ! !