"

 COPYRIGHT (c) 1989 by Claus Gittinger

              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

 inclusion of the above copyright notice.   This software may not

 be provided or otherwise made available to, or used by, any

 other person.  No title to or ownership of the software is

 hereby transferred.

"

"{ Package: 'stx:libtool' }"

StandardSystemView subclass:#DebugView

	instanceVariableNames:'busy haveControl exitAction canContinue contextView codeView

		receiverInspector contextInspector contextArray selectedContext

		catchBlock grabber mayProceed traceView tracing bigStep

		skipLineNr steppedContextAddress abortButton terminateButton

		continueButton stepButton nextButton nextOverButton nextOutButton

		sendButton returnButton restartButton exclusive inspecting

		nChainShown inspectedProcess updateProcess stopButton

		updateButton defineButton monitorToggle stepping

		steppedContextLineno stepForReturn actualContext inWrap

		stackInspector steppedContext wrapperContext verboseBacktrace

		firstContext stepHow cachable currentMethod ignoreBreakpoints

		stepUntilEntering lastStepUntilEntering

		lastSelectionInReceiverInspector lastSelectionInContextInspector

		canShowMore exitAbort reportButton setOfHiddenCallingSelectors

		isStoppedAtHaltOrBreakPoint exceptionInfoLabel methodCodeToggle

		methodCodeToggleSelectionHolder

		isStoppedAtBreakPointWithParameter breakPointParameter

		hideSupportCode contextInfoLabel resendButton

		gotoDialogOpenerButton isStoppedInModalDialog'

	classVariableNames:'CachedDebugger CachedExclusive OpenDebuggers MoreDebuggingDetail

		DebuggingDebugger DebuggingDebugger2

		DefaultDebuggerBackgroundColor InitialNChainShown IgnoredHalts

		ShowThreadID LastIgnoreHaltNTimes LastIgnoreHaltDuration

		LastExtent LastOrigin RememberedCallChain DebuggingDebugger3

		NumberOfDebuggers'

	poolDictionaries:''

	category:'Interface-Debugger'

!

Object subclass:#IgnoredHaltOrBreakpoint

	instanceVariableNames:'ignoreEndTime ignoreCount ignoreUntilShiftKeyPressed

		ignoredReceiverClasses ignoredProcesses'

	classVariableNames:''

	poolDictionaries:''

	privateIn:DebugView

!

DebugView::IgnoredHaltOrBreakpoint subclass:#IgnoredHalt

	instanceVariableNames:'weakMethodHolder lineNumber'

	classVariableNames:''

	poolDictionaries:''

	privateIn:DebugView

!

DebugView::IgnoredHaltOrBreakpoint subclass:#IgnoredBreakpoint

	instanceVariableNames:'parameter'

	classVariableNames:''

	poolDictionaries:''

	privateIn:DebugView

!

!DebugView class methodsFor:'documentation'!

copyright

"

 COPYRIGHT (c) 1989 by Claus Gittinger

              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

 inclusion of the above copyright notice.   This software may not

 be provided or otherwise made available to, or used by, any

 other person.  No title to or ownership of the software is

 hereby transferred.

"

!

documentation

"

    This class implements a graphical debugger interface.

    The debugger usually sits on top of the faulting process,

    taking over its event processing.

    (this is different from other Smalltalk debuggers, which control

     the debuggee as a separate process. Consider this an historic

     leftover - the debugger was one of the first applications written for

     ST/X.

     The whole setup might be changed, once the required process primitives

     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, why should we change it without a particular need...).

    Only the 'stopped' debugged process is affected;

    other processes continue to respond to events.

    The one exception to this is when an error occurs within the dispatcher process

    or in one of the eventhandler processes. In this case, the debugger

    will sit on an exclusive display connection.

    See additional information in 'doc/misc/debugger.doc'.

    Notice & Warning:

        the DebugView class caches the last used debugger in a class variable. 

        It may happen, that a malfunctioning debugger (for example, a halfway 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

    [see also:]

        Exception Signal

        Process

"

! !

!DebugView class methodsFor:'initialization'!

initialize

    DebuggingDebugger := DebuggingDebugger2 := MoreDebuggingDetail := false.

    InitialNChainShown := 50.

    "/ DefaultDebuggerBackgroundColor := nil.

    "/ DefaultDebuggerBackgroundColor := Color red lightened.

    "/ DefaultDebuggerBackgroundColor := Color blue lightened lightened.

    "Created: 20.3.1997 / 16:53:37 / cg"

    "Modified: 20.3.1997 / 16:54:32 / cg"

!

reinitialize

    "reinitialize after an image-restart"

    self newDebugger

! !

!DebugView class methodsFor:'cleanup'!

lowSpaceCleanup

    "in low memory situations, give up cached debuggers"

    CachedDebugger := nil.

    CachedExclusive := nil.

    OpenDebuggers := nil.

    RememberedCallChain := nil.

    "

     DebugView lowSpaceCleanup

    "

    "Modified: / 08-03-2012 / 01:30:21 / cg"

!

newDebugger

    "force creation of a new debugger (give up cached debuggers)"

    CachedDebugger := nil.

    CachedExclusive := nil.

    OpenDebuggers := nil.

    (Debugger isBehavior and:[Debugger name = #DebugView]) ifTrue:[

        Debugger := self

    ].

    "

     DebugView newDebugger

    "

! !

!DebugView class methodsFor:'defaults'!

defaultIcon

    "return the browsers default window icon"

    <resource: #programImage>

    ^ ToolbarIconLibrary debug22x22Icon

    "/ ^ ToolbarIconLibrary debugIt20x20Icon

    "Modified: / 11-02-2007 / 11:47:20 / cg"

!

defaultIconForAboutBox

    <resource: #programImage>

    ^ ToolbarIconLibrary debug22x22IconForBlackBackgound

!

defaultVerboseBacktrace

    <resource: #obsolete>

    self obsoleteMethodWarning.

    ^ UserPreferences current verboseBacktraceInDebugger

    "Created: 11.1.1997 / 12:14:35 / cg"

!

defaultVerboseBacktrace:aBoolean

    <resource: #obsolete>

    self obsoleteMethodWarning.

    UserPreferences current verboseBacktraceInDebugger:aBoolean

!

maxNumberOfDebuggers

    "to prevent debuggers from flooding the screen,

     in case of an error in an ever-forked background process

     (such as tooltip process)"

    ^ 10

!

updateStyleCache

    "extract values from the styleSheet and cache them in class variables"

    <resource: #style (#'debugView.viewBackgroundColor')>

    DefaultDebuggerBackgroundColor := StyleSheet at:#'debugView.viewBackgroundColor'

    "Modified: / 17.11.2001 / 17:31:42 / cg"

! !

!DebugView class methodsFor:'ignoring halts'!

haltIgnoreInformationFor:haltingMethod atLineNr:lineNrInHaltingMethod

    "the information (if any) about the ignore-state of a halt"

    IgnoredHalts isNil ifTrue:[^ nil].

    IgnoredHalts do:[:ign |

        (ign isForMethod:haltingMethod line:lineNrInHaltingMethod)

        "/ (ign isHaltIgnoredInMethod:haltingMethod line:lineNrInHaltingMethod) 

        ifTrue:[

            ^ ign

        ].

    ].

    ^ nil.

!

hasIgnoredHalts

    self removeInactiveIgnores.

    ^ IgnoredHalts notEmptyOrNil

!

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

!

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

!

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"

    |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 

      or:[untilShiftKey == true

      or:[receiverClassOrNil notNil

      or:[processOrNil 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.

        ].

        IgnoredHalts add:ign.

    ].

    Smalltalk changed:#ignoredHalts.

    "Created: / 06-03-2012 / 12:37:58 / cg"

!

isBreakpointToBeIgnoredForParameter:parameter context:aContext modifyEntryCount:modifyCount

    "/ should a breakpoint be ignored ?

    IgnoredHalts isNil ifTrue:[^ false].

    "/ 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.

        ].

    ].

    IgnoredHalts := (IgnoredHalts reject:[:ign | ign isActive not ]) asNilIfEmpty.

    ^ false.

    "Created: / 06-03-2012 / 12:50:30 / cg"

!

isHaltToBeIgnoredIn:haltingMethod atLineNr:lineNrInHaltingMethod context:aContext modifyEntryCount:modifyCount

    "should a halt be ignored ?"

    IgnoredHalts isNil ifTrue:[^ false].

    "/ 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.

        ].

    ].

    IgnoredHalts := (IgnoredHalts reject:[:ign | ign isActive not]) asNilIfEmpty.

    ^ false.

    "Modified (comment): / 06-03-2012 / 12:51:43 / cg"

!

removeInactiveIgnores

    IgnoredHalts notNil ifTrue:[

        IgnoredHalts := IgnoredHalts select:[:i | i isActive].

    ].

!

stopIgnoringHalts

    "forget about all ignored halts"

    IgnoredHalts := nil.

    Smalltalk changed:#ignoredHalts.

! !

!DebugView class methodsFor:'instance creation / entering'!

enter

    "enter a debugger"

    <context: #return>

    ^ self

        enter:thisContext sender

        withMessage:'debugger entered'

        mayProceed:true.

!

enter:aContext withMessage:aString

    "enter a debugger"

    <context: #return>

    ^ self

        enter:aContext

        withMessage:aString

        mayProceed:true

!

enter:aContext withMessage:aString mayProceed:mayProceed

    "enter a debugger; if this is a recursive invocation, enter

     a MiniDebugger instead.

     This is the standard way of entering the debugger;

     sent from error- and halt messages."

    <context: #return>

    |active|

    (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.

        ].

    ].

    DebuggingDebugger == true ifTrue:[

        '==> enter1: (' print. aContext print. ')' printCR.

    ].

    StepInterruptPending := nil.

    ControlInterrupt handle:[:ex |

        'DebugView [info]: breakpoint in debugger setup ignored [enter.]' infoPrintCR.

        ('DebugView [info]: breakpoint on:' , ex suspendedContext printString) infoPrintCR.

        ex proceed

    ] do:[

        "

         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.

        "

        OpenDebuggers notNil ifTrue:[

            active := Processor activeProcess.

            OpenDebuggers do:[:aDebugger |

                |debuggersProcess|

                (aDebugger notNil and:[aDebugger ~~ 0]) ifTrue:[

                    debuggersProcess := aDebugger inspectedProcess.

                    debuggersProcess == active ifTrue:[