"

 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'

        classVariableNames:'CachedDebugger CachedExclusive OpenDebuggers MoreDebuggingDetail

                DebuggingDebugger DebuggingDebugger2

                DefaultDebuggerBackgroundColor InitialNChainShown IgnoredHalts

                ShowThreadID LastIgnoreHaltNTimes LastIgnoreHaltDuration

                LastExtent LastOrigin RememberedCallChain DebuggingDebugger3'

        poolDictionaries:''

        category:'Interface-Debugger'

!

Object subclass:#IgnoredHaltOrBreakpoint

        instanceVariableNames:'ignoreEndTime ignoreCount ignoreUntilShiftKeyPressed'

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

    The whole debugging will 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)

    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 will be fixed to avoid this problem.

        You also have to remove 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

    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

!

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 isHaltIgnoredInMethod:haltingMethod line:lineNrInHaltingMethod) ifTrue:[

            ^ ign

        ].

    ].

    ^ nil.

!

hasIgnoredHalts

    self removeInactiveIgnores.

    ^ IgnoredHalts notEmptyOrNil

!

ignoreBreakpointWithParameter:parameterOrNil forCount:countOrNil orTimeDuration:dTOrNil orUntilShiftKey:untilShiftKey

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

        oldEntry := IgnoredHalts

                        detect:[:ign | ign isForBreakpointWithParameter:parameterOrNil]

                        ifNone:nil.

        oldEntry notNil ifTrue:[

            IgnoredHalts remove:oldEntry ifAbsent:[].

        ]

    ].

    (countOrNil notNil or:[dTOrNil notNil or:[untilShiftKey == true]]) ifTrue:[

        IgnoredHalts isNil ifTrue:[

            IgnoredHalts := OrderedCollection new.

        ].

        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.

        ].

        IgnoredHalts add:ign.

    ].

    Smalltalk changed:#ignoredHalts.

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

!

ignoreHaltIn:haltingMethod at:lineNrOfHalt forCount:countOrNil orTimeDuration:dTOrNil orUntilShiftKey:untilShiftKey

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

    |oldEntry ign|

    IgnoredHalts notNil ifTrue:[

        self removeInactiveIgnores.

        oldEntry := IgnoredHalts

                        detect:[:ign | ign isForMethod:haltingMethod line:lineNrOfHalt]

                        ifNone:nil.

        oldEntry notNil ifTrue:[

            IgnoredHalts remove:oldEntry ifAbsent:[].

        ]

    ].

    (countOrNil notNil or:[dTOrNil notNil or:[untilShiftKey == true]]) ifTrue:[

        IgnoredHalts isNil ifTrue:[

            IgnoredHalts := OrderedCollection new.

        ].

        ign := IgnoredHalt new method:haltingMethod lineNumber:lineNrOfHalt.

        (countOrNil notNil and:[countOrNil > 0]) ifTrue:[

            ign ignoreCount:countOrNil.

        ].

        (dTOrNil notNil) ifTrue:[

            ign ignoreEndTime:(Timestamp now + dTOrNil).

        ].

        untilShiftKey == true ifTrue:[

            ign ignoreUntilShiftKeyPressed:true.

        ].

        IgnoredHalts add:ign.

    ].

    Smalltalk changed:#ignoredHalts.

    "Created: / 27-01-2012 / 11:33:38 / cg"

!

isBreakpointToBeIgnoredForParameter:parameter 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 ].

    IgnoredHalts isEmpty ifTrue:[

        IgnoredHalts := nil.

    ].

    ^ false.

    "Created: / 06-03-2012 / 12:50:30 / 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|

    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:[

                        aDebugger device isOpen ifTrue:[

                            DebuggingDebugger == true ifTrue:[

                                'reusing cached debugger' errorPrintCR.

                            ].

                            aDebugger unstep.

                            aDebugger setLabelFor:aString in:active.

                            aDebugger mayProceed:mayProceed.

                            ^ aDebugger enter:aContext select:nil.

                        ]

                    ].

                    (debuggersProcess notNil and:[ debuggersProcess isDead ]) ifTrue:[

                        aDebugger destroy.

                    ].

                ]

            ]

        ].

    ].

    ^ self enterUnconditional:aContext withMessage:aString mayProceed:mayProceed

    "Modified: / 17-07-2012 / 19:08:18 / cg"

!

enterException:ex

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

    ^ self

        enter:ex returnableSuspendedContext

        withMessage:ex descriptionForDebugger

        mayProceed:(ex mayProceed).

!

enterUnconditional:aContext withMessage:aString mayProceed:mayProceed

    "enter a debugger - do not check for recursive invocation"

    <context: #return>

    |aDebugger|

    StepInterruptPending := nil.

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

    ] do:[

        aDebugger := self new.

    ].

    aDebugger isNil ifTrue:[

        'DebugView [error]: cannot open debugger' errorPrintCR.

        'DebugView [error]: Exception: ' errorPrint. aString errorPrintCR.

        mayProceed ifTrue:[

            (Dialog confirm:'Error/Breakpoint cought.\\Press Continue or Abort.' withCRs

                   yesLabel:'Continue' noLabel:'Abort')

            ifTrue:[

                ^ nil

            ].

        ] ifFalse:[

            self information:'Error cought.\\Press OK to abort the operation.' withCRs.

        ].

        AbortOperationRequest raise.

        "not reached"

    ].

    aDebugger mayProceed:mayProceed.

    aDebugger setLabelFor:aString in:Processor activeProcess.

    aDebugger enter:aContext select:nil.