"

 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

!

Object subclass:#IgnoredHaltOrBreakpoint

!

DebugView::IgnoredHaltOrBreakpoint subclass:#IgnoredHalt

!

DebugView::IgnoredHaltOrBreakpoint subclass:#IgnoredBreakpoint

!

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

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

!

isHaltToBeIgnored

    |c sender haltingMethod lineNrInHaltingMethod breakpointParameter|

    "/ should a halt be ignored ?

    IgnoredHalts isNil ifTrue:[^ false].

    "/ look for a breakpoint-wrapper's context

    c := thisContext findNextContextWithSelector:#doRaise or:nil or:nil.

    c notNil ifTrue:[

        (c receiver isKindOf:NoHandlerError) ifTrue:[

            c := c sender findNextContextWithSelector:#doRaise or:nil or:nil.

        ].

        (c receiver isKindOf:BreakPointInterrupt) ifFalse:[

            c := nil

        ] ifTrue:[

            [ ((sender := c sender) receiver isKindOf:BreakPointInterrupt)

            or:[ sender receiver == BreakPointInterrupt ]] whileTrue:[

                c := sender

            ].

            [ (sender := c sender) isBlockContext ] whileTrue:[

                c := sender

            ].

            sender := nil. "/ avoid keeping a reference to this context

        ].

    ].

    c isNil ifTrue:[

        "/ look for halts or explicit breakpoints

        c := thisContext findNextContextWithSelector:#halt or:#halt: or:nil.

        c isNil ifTrue:[

            c := thisContext findNextContextWithSelector:#breakPoint: or:#breakPoint:info: or:nil.

            c isNil ifTrue:[

               ^ false

            ].

            breakpointParameter := c argAt:1.

            (self isBreakpointToBeIgnoredForParameter:breakpointParameter modifyEntryCount:true) ifTrue:[

                ^ true.

            ].

        ].

    ].

    c := c sender.

    "/ a code-breakpoint ?

    (c receiver isKindOf:Breakpoint) ifTrue:[

        c := c sender.

    ].

    haltingMethod := c method.

    haltingMethod isWrapped ifTrue:[

        lineNrInHaltingMethod := 1.

    ] ifFalse:[

        lineNrInHaltingMethod := c lineNumber.

        "/ Transcript showCR:c.

    ].

    ^ self

        isHaltToBeIgnoredIn:haltingMethod

        atLineNr:lineNrInHaltingMethod

        modifyEntryCount:true.

    "Created: / 22-10-2010 / 12:09:53 / cg"

    "Modified: / 06-03-2012 / 12:54:09 / cg"

!

isHaltToBeIgnoredIn:haltingMethod atLineNr:lineNrInHaltingMethod

    ^ self

        isHaltToBeIgnoredIn:haltingMethod

        atLineNr:lineNrInHaltingMethod

        modifyEntryCount:false

!

isHaltToBeIgnoredIn:haltingMethod atLineNr:lineNrInHaltingMethod 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) 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].

    IgnoredHalts isEmpty ifTrue:[

        IgnoredHalts := nil.

    ].

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