"

 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.

"

'From Smalltalk/X, Version:2.10.4 on 25-feb-1995 at 9:36:24 am'!

StandardSystemView subclass:#DebugView

	 instanceVariableNames:'busy haveControl exitAction canContinue contextView codeView

		receiverInspector contextInspector contextArray selectedContext

		catchBlock grabber traceView tracing bigStep skipLineNr

		steppedContextAddress canAbort abortButton terminateButton

		continueButton stepButton nextButton sendButton returnButton restartButton

		exclusive inspecting nChainShown inspectedProcess updateProcess

		stopButton updateButton monitorToggle stepping steppedContextLineno actualContext inWrap'

	 classVariableNames:'CachedDebugger CachedExclusive OpenDebuggers MoreDebuggingDetail'

	 poolDictionaries:''

	 category:'Interface-Debugger'

!

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

"

!

version

!

documentation

"

    this class implements a graphical debugger interface.

    The debugger usually sits on top of the faulting process,

    taking over its event processing. Thus only the 'stopped' 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 destoyed 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.

"

! !

!DebugView class methodsFor:'instance creation'!

enterUnconditional:aContext withMessage:aString

    "enter a debugger - do not check for recursive invocation"

    |aDebugger|

    StepInterruptPending := nil.

    aDebugger := self new.

    aDebugger setLabelFor:aString in:Processor activeProcess.

    aDebugger enter:aContext.

    ^ nil

    "nil halt"

!

new

    "return a new DebugView - return a cached debugger if it already

     exists"

    |debugger|

    "

     need a blocking debugger if no processes or 

     or if its a timing/interrupt process 

     (because otherwise we would not get any events here ...

    "

    Processor activeProcessIsSystemProcess ifTrue:[

	CachedExclusive isNil ifTrue:[

	    debugger := self newExclusive

	] ifFalse:[

	    debugger := CachedExclusive.

	    CachedExclusive := nil.

	].

    ] ifFalse:[

	CachedDebugger isNil ifTrue:[

	    debugger := super new.

	    debugger label:'Debugger'.

	    debugger icon:(Form fromFile:'Debugger.xbm' resolution:100).

	] ifFalse:[

	    debugger := CachedDebugger.

	    CachedDebugger := nil.

	]

    ].

    ^ debugger

!

enter:aContext withMessage:aString

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

    |active|

    StepInterruptPending := nil.

    thisContext isRecursive ifTrue:[

	^ MiniDebugger enterWithMessage:'recursive error in debugger'.

    ].

    "

     well, it could be a stepping or sending debugger up there;

     in this case, return to it. This happens, when a stepping process

     runs into an error (for example, a halt). In this case, we want the

     stepping debugger to come up again instead of a new one.

    "

    OpenDebuggers notNil ifTrue:[

	active := Processor activeProcess.

	OpenDebuggers do:[:aDebugger |

	    aDebugger notNil ifTrue:[

		(aDebugger inspectedProcess == active) ifTrue:[

"/ 'entering stepping debugger again' printNL.

		    aDebugger unstep.

		    aDebugger setLabelFor:aString in:active.

		    ^ aDebugger enter:aContext.

		]

	    ]

	]

    ].

    ^ self enterUnconditional:aContext withMessage:aString

!

newExclusive

    "return a debugger for exclusive display access"

    |debugger|

    debugger := super new.

    debugger label:'Debugger'.

    debugger icon:(Form fromFile:'Debugger.xbm' resolution:100).

    debugger exclusive:true.

    ^ debugger

!

newDebugger

    "force creation of a new debugger"

    CachedDebugger := nil.

    CachedExclusive := nil.

    OpenDebuggers := nil.

    "

     DebugView newDebugger

    "

!

lowSpaceCleanup 

    "in low memory situations, give up cached debuggers"

    self newDebugger

!

openOn:aProcess

    "start a  debugger on aProcess

     (actually not more than a good-looking inspector)"

    |aDebugger label nm|

    aDebugger := super new.

    aDebugger icon:(Form fromFile:'Debugger.xbm' resolution:100).

    aProcess notNil ifTrue:[

	nm := aProcess name.

	nm notNil ifTrue:[

	    nm := (nm contractTo:17) , '-' , aProcess id printString

	] ifFalse:[

	    nm := aProcess id printString

	].

	label := 'Debugger [' , nm , ']'.

    ] ifFalse:[

	label := 'no process'

    ].

    aDebugger label:label.

    aDebugger iconLabel:'Debugger'.

    aDebugger openOn:aProcess.

    ^ nil

!

enterWithMessage:aString

    "the standard way of entering the debugger - sent from Objects

     error- and halt messages"

    ^ self enter:(thisContext sender) withMessage:aString

    "Debugger enterWithMessage:'hi there'"

!

enter

    "another way of entering the debugger"

    ^ self enter:(thisContext sender) withMessage:'Debugger'

    "Debugger enter"

!

enter:aContext

    "enter the debugger on aContext"

    ^ self enter:aContext withMessage:'Debugger'

! !

!DebugView methodsFor:'private control loop'!

controlLoop

    "this is a kludge:

	start a dispatchloop which exits when

	either continue, return or step is pressed

    "

    haveControl := true.

    [haveControl] whileTrue:[

	self controlLoopCatchingErrors

    ].

    catchBlock := nil.

!

controlLoopCatchingErrors

    "setup a self removing catch-block"

    catchBlock := [catchBlock := nil. ^ nil].

    (exclusive or:[windowGroup isNil]) ifTrue:[

	"if we do not have multiple processes or its a system process

	 we start another dispatch loop, which exits when

	 either continue, return or step is pressed

	 or (via the catchBlock) if an error occurs.

	 Since our display is an extra exclusive one 

	 all processing for normal views stops here ...

	"

	device dispatchModalWhile:[haveControl]

    ] ifFalse:[

	"we do have multiple processes -

	 simply enter the DebugViews-Windowgroup event loop.

	 effectively suspending event processing for the currently 

	 active group.

	"

	SignalSet anySignal handle:[:ex |

	    |answer|

"/            answer := self confirm:('error in debugger: ' , ex errorString , '\\debug again ?') withCRs. 

"/            answer ifTrue:[

"/                Debugger enterUnconditional:(ex suspendedContext) withMessage:'error in debugger: ' , ex errorString.

"/            ] ifFalse:[

"/                'ignored error in debugger: ' errorPrint. 

"/                ex errorString errorPrintNL.

"/            ].

	    answer := Dialog 

			choose:('error in debugger: ' , ex errorString , '\\debug again ?') withCRs

			labels:#('debug' 'proceed' 'ignore' ) 

			values:#(#debug #proceed #ignore) 

			default:#ignore.

	    answer == #debug ifTrue:[

		Debugger enterUnconditional:(ex suspendedContext) withMessage:'error in debugger: ' , ex errorString.

		ex proceed.

	    ].

	    answer == #proceed ifTrue:[

		ex proceed.

	    ].

	    ex return.

	] do:[

	    windowGroup eventLoopWhile:[true] onLeave:[]

	].

    ].

    catchBlock := nil.

! !

!DebugView methodsFor:'initialization'!

initialize

    |v panel hpanel bpanel separator|

    super initialize.

    font := font on:device.

    busy := false.

    exclusive := false.

    inspecting := false.

    exitAction := nil.

    bigStep := false.

    canContinue := false.

    canAbort := false.

    bpanel := HorizontalPanelView

"/                        origin:(0.0 @ 0.0)

"/                        extent:(1.0 @ (font height * 2))

			    in:self.

    bpanel horizontalLayout:#leftSpace.

    bpanel verticalSpace:ViewSpacing // 2.

    terminateButton := Button

			label:(resources at:'terminate')

			action:[terminateButton turnOffWithoutRedraw. self doTerminate]

			in:bpanel.

    separator := View extent:(10 @ 5) in:bpanel.

    separator borderWidth:0; level:0.

    abortButton := Button

			label:(resources at:'abort')

			action:[abortButton turnOffWithoutRedraw. self doAbort]

			in:bpanel.

    returnButton := Button

			label:(resources at:'return')

			action:[returnButton turnOff. self doReturn]

			in:bpanel.

    restartButton := Button

			label:(resources at:'restart')

			action:[restartButton turnOff. self doRestart]

			in:bpanel.

    separator := View extent:(10 @ 5) in:bpanel.

    separator borderWidth:0; level:0.

    continueButton := Button

			label:(resources at:'continue')

			action:[continueButton turnOffWithoutRedraw. self doContinue]

			in:bpanel.

    separator := View extent:(10 @ 5) in:bpanel.

    separator borderWidth:0; level:0.

    nextButton := Button

			label:(resources at:'next')

			action:[stepButton turnOff. self doNext]

			in:bpanel.

    stepButton := Button

			label:(resources at:'step')

			action:[stepButton turnOff. self doStep]

			in:bpanel.

    sendButton := Button

			label:(resources at:'send')

			action:[sendButton turnOff. self doSend]

			in:bpanel.

    bpanel origin:(0.0 @ 0.0)

	   extent:(1.0 @ (bpanel preferredExtent y)).

    panel := VariableVerticalPanel

			origin:(0.0 @ bpanel height)

			corner:(1.0 @ 1.0)

			    in:self.

    v := ScrollableView for:SelectionInListView in:panel.

    v origin:(0.0 @ 0.0) corner:(1.0 @ 0.25).

    contextView := v scrolledView.

    contextView action:[:lineNr | self showSelection:lineNr].

    v := ScrollableView for:CodeView in:panel.

    v origin:(0.0 @ 0.25) corner:(1.0 @ 0.75).

    codeView := v scrolledView.

    hpanel := VariableHorizontalPanel in:panel.

    hpanel origin:(0.0 @ 0.75) corner:(1.0 @ 1.0).

    receiverInspector := InspectorView

				origin:(0.0 @ 0.0) corner:(0.5 @ 1.0)

				    in:hpanel.

    contextInspector := ContextInspectorView

				origin:(0.5 @ 0.0) corner:(1.0 @ 1.0)

				    in:hpanel

!

createOnTop

    ^ false "true"

!

initializeMiddleButtonMenu

    |labels m|

    labels := resources array:#(

				'show more'

				'-'

				'skip'

				'-'

"

				'continue'

				'terminate'

				'abort'

				'-'

				'step'

				'send'

				'-'

				'return'

				'restart'

				'-'

"

				'remove breakpoint'

				'remove all trace & breakpoints'

				'-'

				'browse class'

				'browse class hierarchy'

				'browse full class protocol'

				'implementors'

				'senders'

				'-'

				'inspect context'

				'copy walkback text'

				'-'

				'quickTerminate'

				'='

				'exit smalltalk (no confirmation)'

			      ).

    m := (PopUpMenu 

				labels:labels

			     selectors:#(

					 showMore

					 nil

					 skip

					 nil

"

					 doContinue

					 doTerminate

					 doAbort

					 nil

					 doStep

					 doSend

					 nil

					 doReturn

					 doRestart

					 nil

"

					 removeBreakpoint

					 removeAllBreakpoints

					 nil

					 browseClass

					 browseClassHierarchy

					 browseFullClassProtocol

					 implementors

					 senders

					 nil

					 inspectContext

					 nil

					 quickTerminate

					 copyWalkbackText

					 nil

					 exit

					)

				  receiver:self

				       for:contextView).

    contextView middleButtonMenu:m. 

    inspecting ifTrue:[

	m notNil ifTrue:[

	    m disableAll:#(doTraceStep removeBreakpoint).

	].

    ]