"{ Encoding: utf8 }"

"

 COPYRIGHT (c) 1989 by Claus Gittinger

 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

!

Object subclass:#IgnoredHaltOrBreakpoint

!

DebugView::IgnoredHaltOrBreakpoint subclass:#IgnoredHalt

!

DebugView::IgnoredHaltOrBreakpoint subclass:#IgnoredBreakpoint

!

!DebugView class methodsFor:'documentation'!

copyright

"

 COPYRIGHT (c) 1989 by Claus Gittinger

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

    [author:]

    [see also:]

"

! !

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

    ].

    ^ nil.

!

hasIgnoredHalts

    self removeInactiveIgnores.

    ^ IgnoredHalts notEmptyOrNil

!

ignoreBreakpointWithParameter:parameterOrNil

    "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

!

ignoreHaltIn:haltingMethod at:lineNrOfHalt

    "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

!

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

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

    ].

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

    ].

!

stopIgnoringHalts

    "forget about all ignored halts"

    IgnoredHalts := nil.

    Smalltalk changed:#ignoredHalts.