"{ 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 foundRaisingMethod gotoRaisingMethodButton

		stepInButton infoLabelHolder isStoppedAtError isStoppedAtAssert'

	classVariableNames:'CachedDebugger CachedExclusive OpenDebuggers MoreDebuggingDetail

		DebuggingDebugger DebuggingDebugger2 DebuggingContextWalk

		DefaultDebuggerBackgroundColor InitialNChainShown IgnoredHalts

		ShowThreadID LastIgnoreHaltNTimes LastIgnoreHaltDuration

		LastExtent LastOrigin RememberedCallChain DebuggingDebugger3

		NumberOfDebuggers DebuggerOnMainDisplayOnly IgnoredErrors

		IgnoredAsserts'

	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::IgnoredHalt subclass:#IgnoredError

	instanceVariableNames:'action'

	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 things like 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 

        (otherwise, the already instantiated, cached debugger will be reused).

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

    |tmp|

    CachedDebugger notNil ifTrue:[

        tmp := CachedDebugger.

        CachedDebugger := nil.

        tmp destroy.

    ].

    CachedExclusive := nil.

    OpenDebuggers := nil.

    RememberedCallChain := nil.

    "

     DebugView lowSpaceCleanup

    "

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

    "Modified: / 16-10-2017 / 13:52:55 / stefan"

!

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

    |tmp|

    CachedDebugger notNil ifTrue:[

        tmp := CachedDebugger.

        CachedDebugger := nil.

        Error catch:[

            tmp destroy.

        ].

    ].

    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)

      and:[self name = #DebugView]]) ifTrue:[

        Smalltalk at:#Debugger put:self

    ].

    "

     DebugView newDebugger

     DebugView withAllSubclassesDo:#newDebugger

    "

    "Modified: / 17-10-2017 / 12:55:09 / stefan"

    "Modified: / 30-01-2019 / 02:30:40 / Claus Gittinger"

    "Modified (comment): / 01-02-2019 / 15:59:33 / Claus Gittinger"

! !

!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 debug22x22IconForBlackBackground

    "Modified: / 30-05-2017 / 19:28:40 / mawalch"

!

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

!

ignoreAssertIn:haltingMethod at:lineNrOfHalt

        forCount:countOrNil orTimeDuration:dTOrNil orUntilShiftKey:untilShiftKey

        orReceiverClass:receiverClassOrNil orProcess:processOrNil

        orIfCalledFromMethod:ifCalledForMethodOrNil

    "remember to ignore an assert 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 assert is reactivated"

    self

        ignoreHaltOrBreakpoint:#assert

        method:haltingMethod line:lineNrOfHalt

        parameter:nil

        forCount:countOrNil orTimeDuration:dTOrNil orUntilShiftKey:untilShiftKey

        orReceiverClass:receiverClassOrNil orProcess:processOrNil

        orIfCalledFromMethod:ifCalledForMethodOrNil

!

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

!

ignoreErrorIn:methodOrNil line:lineNrOrNil 

        forCount:countOrNil orTimeDuration:dTOrNil orUntilShiftKey:untilShiftKey

        orReceiverClass:receiverClassOrNil orProcess:processOrNil

        orIfCalledFromMethod:ifCalledFromMethodOrNil

    "remember to ignore an error, either forEver, for some number of invocations,

     or until some time has elapsed.

     With nil count and time arguments, such an ignored error is reactivated"

    |oldEntry ign|

    IgnoredErrors notNil ifTrue:[

        self removeInactiveIgnores.

        oldEntry := IgnoredErrors

                        detect:[:ign | ign isForMethod:methodOrNil line:lineNrOrNil]

                        ifNone:nil.

        oldEntry notNil ifTrue:[

            (processOrNil notNil or:[receiverClassOrNil notNil]) ifTrue:[

                receiverClassOrNil notNil ifTrue:[

                    oldEntry ignoreForReceiverClass:receiverClassOrNil.

                ].

                processOrNil notNil ifTrue:[

                    oldEntry ignoreForProcess:processOrNil.

                ].

                ^ self.

            ].

            IgnoredErrors remove:oldEntry ifAbsent:[].

        ]

    ].

    (countOrNil notNil

      or:[dTOrNil notNil

      or:[untilShiftKey == true

      or:[receiverClassOrNil notNil

      or:[processOrNil notNil

      or:[ifCalledFromMethodOrNil notNil]]]]]

    ) ifTrue:[

        IgnoredErrors isNil ifTrue:[

            IgnoredErrors := OrderedCollection new.

        ].

        ign := IgnoredError new method:methodOrNil lineNumber:lineNrOrNil.

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

        ].

        ign action:#abort.

        IgnoredErrors add:ign.

    ].

    Smalltalk changed:#ignoredErrors.

    "Created: / 27-02-2019 / 22:22:47 / Claus Gittinger"

!

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