"{ Encoding: utf8 }"

"

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

"{ NameSpace: Smalltalk }"

StandardSystemView subclass:#DebugView

        instanceVariableNames:'busy haveControl exitAction canContinue contextView codeView

                receiverInspector contextInspector contextArray selectedContext

                catchBlock grabber mayProceed traceView tracing bigStep

                skipLineNr abortButton terminateButton continueButton stepButton

                nextButton nextOverButton nextOutButton sendButton returnButton

                restartButton exclusive inspecting nChainShown inspectedProcess

                updateProcess updateButton defineButton monitorToggle stepping

                steppedContextLineno actualContext inWrap stackInspector

                steppedContext wrapperContext firstContext stepHow cachable

                currentMethod ignoreBreakpoints stepUntilEntering

                lastStepUntilEntering lastSelectionInReceiverInspector

                lastSelectionInContextInspector canShowMore reportButton

                setOfHiddenCallingSelectors isStoppedAtHaltOrBreakPoint

                exceptionInfoLabel methodCodeToggle

                methodCodeToggleSelectionHolder

                isStoppedAtBreakPointWithParameter breakPointParameter

                hideSupportCode contextInfoLabel resendButton

                gotoDialogOpenerButton isStoppedInModalDialog selectorToDefine

                classToDefineIn gotoApplicationActionMethodButton

                isStoppedInApplicationAction isStoppedAtStatementBreakpoint

                verboseBacktraceHolder'

        classVariableNames:'CachedDebugger CachedExclusive OpenDebuggers MoreDebuggingDetail

                DebuggingDebugger DebuggingDebugger2 DebuggingContextWalk

                DefaultDebuggerBackgroundColor InitialNChainShown IgnoredHalts

                ShowThreadID LastIgnoreHaltNTimes LastIgnoreHaltDuration

                LastExtent LastOrigin RememberedCallChain DebuggingDebugger3

                NumberOfDebuggers DebuggerOnMainDisplayOnly'

        poolDictionaries:''

        category:'Interface-Debugger'

!

Object subclass:#IgnoredHaltOrBreakpoint

        instanceVariableNames:'ignoreEndTime ignoreCount ignoreUntilShiftKeyPressed

                ignoredReceiverClasses ignoredProcesses

                ignoredSendingClassAndSelectors'

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

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

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

        CachedDebugger destroy.

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

     Call this, if you changed the debugger heavily, and you want to avoid

     that an old, cached debugger gets reused when the next error comes around."

    CachedDebugger notNil ifTrue:[

        CachedDebugger destroy.

        CachedDebugger := nil.

    ].

    CachedExclusive := nil.

    OpenDebuggers := nil.

    "/ only assign to the global debugger, if it has not been redefined

    "/ to another class.

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

        Smalltalk at:#Debugger put:self

    ].

    "

     DebugView newDebugger

    "

! !

!DebugView class methodsFor:'defaults'!

debuggerOnMainDisplayOnly

    ^ DebuggerOnMainDisplayOnly ? true

!

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

    ^ 20

!

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

        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

    "remember to ignore a halt in some method for some number of invocations

     or until some time has elapsed. 

     With a count of -1, it is ignored forever (i.e. until reenabled via the

     settings).

     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

    "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

    "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

      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.

    ].

    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 showCR:'Debugger [info]: halt/break ignored: %1' with:ign.

            modifyCount ifTrue:[ ign decrementIgnoreCount ].

            ign isHaltIgnored ifFalse:[

                Transcript showCR:'Debugger [info]: no longer ignored (rest count=0)'.

                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.