"

 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

	 classVariableNames:'CachedDebugger CachedExclusive OpenDebuggers MoreDebuggingDetail'

	 poolDictionaries:''

	 category:'Interface-Debugger'

!

DebugView comment:'

COPYRIGHT (c) 1989 by Claus Gittinger

	      All Rights Reserved

'!

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

    StepInterruptPending := nil.

    thisContext isRecursive ifTrue:[

	^ MiniDebugger enterWithMessage:'recursive error'.

    ].

    "

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

	OpenDebuggers do:[:aDebugger |

	    aDebugger notNil ifTrue:[

		(aDebugger inspectedProcess == Processor activeProcess) ifTrue:[

"/ 'entering stepping debugger again' printNL.

		    aDebugger unstep.

		    aDebugger setLabelFor:aString in:Processor activeProcess.

		    ^ 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

    "

!

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

	    ].

	    ex return.

	] do:[

	    windowGroup eventLoopWhile:[true]

	].

    ].

    catchBlock := nil.

! !

!DebugView methodsFor:'initialization'!

initialize

    |v panel hpanel bpanel dummy|

    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 layout:#left.

    terminateButton := Button

			label:(resources at:'terminate')

			action:[terminateButton turnOffWithoutRedraw. self doTerminate]

			in:bpanel.

    dummy := View extent:(20 @ 5) in:bpanel.

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

    dummy := View extent:(20 @ 5) in:bpanel.

    dummy borderWidth:0; level:0.

    continueButton := Button

			label:(resources at:'continue')

			action:[continueButton turnOffWithoutRedraw. self doContinue]

			in:bpanel.

    dummy := View extent:(20 @ 5) in:bpanel.

    dummy borderWidth:0; level:0.

    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.

    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'

				'-'

				'-'

				'inspect context'

				'-'

				'quickTerminate'

				'-'

				'exit smalltalk'

			      ).

    m := (PopUpMenu 

				labels:labels

			     selectors:#(

					 showMore

					 nil

					 skip

					 nil

"

					 doContinue

					 doTerminate

					 doAbort

					 nil

					 doStep

					 doSend

					 nil

					 doReturn

					 doRestart

					 nil

"

					 removeBreakpoint

					 removeAllBreakpoints

					 nil

					 browseClass

					 implementors

					 senders

					 nil

					 inspectContext

					 nil

					 quickTerminate

					 nil

					 exit

					)

				  receiver:self

				       for:contextView).

    contextView middleButtonMenu:m. 

    inspecting ifTrue:[

	m notNil ifTrue:[

	    m disable:#doTraceStep.

	    m disable:#removeBreakpoint.

	].

    ]

!

setLabelFor:aMessage in:aProcess

    |l nm|

    l := aMessage , ' ('.

    nm := aProcess name.

    nm notNil ifTrue:[

	l := l , (nm contractTo:17) , '-'.

    ].

    l := l , aProcess id printString , ')'.

    self label:l.

!

addToCurrentProject

    "ignored here"

    ^ self

!

realize

    super realize.

    exclusive ifTrue:[

	windowGroup := nil

    ].

    inspecting ifTrue:[