"{ 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 := 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 := 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)"

    ^ 10

!

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

!

stopIgnoringHaltsFor:haltingMethod atLineNr:lineNrInHaltingMethod

    "remove the information (if any) about the ignore-state of a halt;

     effectively reenables the breakpoint/halt"

    IgnoredHalts isNil ifTrue:[^ self].