[ENH] Enhanced Debugging Experience (first shot)

Henrik Gedenryd Henrik.Gedenryd at lucs.lu.se
Sun Jul 29 10:33:07 UTC 2001


Hans-Martin Mosner wrote:

> Hi Henrik,
> yes I would like to incorporate the stuff and implement the going out part!
> Could you just send it to me, or give me a pointer to a place on the web?
> 
> Cheers,
> Hans-Martin

Here it is. It is the result of some quick image archaeology, so let me know
if something seems to be missing or so.

Henrik

-------------- next part --------------
'From Squeak2.9alpha of 13 June 2000 [latest update: #2774] on 29 July 2001 at 12:31:11 pm'!

!Debugger methodsFor: 'initialize' stamp: 'hg 10/31/2000 19:05'!
openFullMorphicLabel: labelString
	| window aListMorph codeTop aTextMorph |
	self expandStack.
	window _ (SystemWindow labelled: labelString) model: self.
	aListMorph _ PluggableListMorph on: self list: #contextStackList
			selected: #contextStackIndex changeSelected: #toggleContextStackIndex:
			menu: #contextStackMenu:shifted: keystroke: #contextStackKey:from:.
	aListMorph menuTitleSelector: #messageListSelectorTitle.
	window addMorph: aListMorph
		frame: (0 at 0 corner: 1 at 0.3).

	Preferences useAnnotationPanes
		ifFalse:
			[codeTop _ 0.3]
		ifTrue:
			[aTextMorph _ PluggableTextMorph on: self
					text: #annotation accept: nil
					readSelection: nil menu: nil.
			aTextMorph askBeforeDiscardingEdits: false.
			window addMorph: aTextMorph
				frame: (0 at 0.3 corner: 1 at 0.35).
			codeTop _ 0.35].

	Preferences optionalButtons ifTrue:
		[window addMorph: self optionalButtonRow frame: ((0 at codeTop corner: 1 @ (codeTop + 0.1))).
		codeTop _ codeTop + 0.1].
	window addMorph: (PluggableTextMorph on: self
			text: #contents accept: #contents:notifying:
			readSelection: #contentsSelection menu: #codePaneMenu:shifted:)
		frame: (0 @ codeTop corner: 1 @ 0.7).
	window addMorph: ((PluggableListMorph on: self receiverInspector list: #fieldList
			selected: #selectionIndex changeSelected: #toggleIndex:
			menu: #fieldListMenu: keystroke: #inspectorKey:from:) doubleClickSelector: #inspectSelection)
		frame: (0 at 0.7 corner: 0.2 at 1).
	window addMorph: (PluggableTextMorph on: self receiverInspector
			text: #contents accept: #accept:
			readSelection: #contentsSelection menu: #codePaneMenu:shifted:)
		frame: (0.2 at 0.7 corner: 0.5 at 1).
	window addMorph: ((PluggableListMorph on: self contextVariablesInspector list: #fieldList
			selected: #selectionIndex changeSelected: #toggleIndex:
			menu: #fieldListMenu: keystroke: #inspectorKey:from:) doubleClickSelector: #inspectSelection)
		frame: (0.5 at 0.7 corner: 0.7 at 1).
	window addMorph: (PluggableTextMorph on: self contextVariablesInspector
			text: #contents accept: #accept:
			readSelection: #contentsSelection menu: #codePaneMenu:shifted:)
		frame: (0.7 at 0.7 corner: 1 at 1).

	[self toggleContextStackIndex: 2]
		on: Error do: [self toggleContextStackIndex: 0].
	^ window openInWorld! !

!Debugger methodsFor: 'context stack menu' stamp: 'hg 7/9/2000 13:35'!
contextStackMenu: aMenu shifted: shifted
	^ shifted ifFalse: [aMenu labels: 
'fullStack (f)
restart (r)
restart stepping (R)
proceed (p)
step (t)
send (e)
where (w)
peel to first like this
senders of... (n)
implementors of... (m)
inheritance (i)
versions (v)
inst var refs...
inst var defs...
class var refs...
class variables
class refs (N)
browse full (b)
file out 
more...'
	lines: #(8 12 14 17 19)
	selections: #(fullStack restart restartStepping proceed doStep send where peelToFirst
browseSendersOfMessages browseMessages methodHierarchy browseVersions
browseInstVarRefs browseInstVarDefs
browseClassVarRefs browseClassVariables browseClassRefs
browseMethodFull fileOutMessage
shiftedYellowButtonActivity)]

	ifTrue: [aMenu labels: 
'browse class hierarchy
browse class
browse method (O)
implementors of sent messages
change sets with this method
inspect instances
inspect subinstances
revert to previous version
remove from current change set
revert and forget
more...' 
	lines: #(5 7 10)
	selections: #(classHierarchy browseClass 
		openSingleMessageBrowser browseAllMessages findMethodInChangeSets 
		inspectInstances inspectSubInstances
		revertToPreviousVersion 
		removeFromCurrentChanges revertAndForget
		unshiftedYellowButtonActivity)]

! !

!Debugger methodsFor: 'context stack menu' stamp: 'hg 4/6/2000 11:19'!
doStep
	"Send the selected message in the accessed method, and regain control 
	after the invoked method returns."
	
	| currentContext oldMethod |
	self okToChange ifFalse: [^ self].
	self checkContextSelection.
	externalInterrupt ifFalse: [contextStackTop push: proceedValue].
	externalInterrupt _ true. "simulation leaves same state as interrupting"
	currentContext _ self selectedContext.
	self contextStackIndex > 1
		ifTrue: 
			[currentContext completeCallee: contextStackTop.
			self resetContext: currentContext]
		ifFalse: 
			[currentContext stepToSendOrReturn.
			currentContext willReturn
				ifTrue: 
					[oldMethod _ currentContext method.
					currentContext _ currentContext step.
					currentContext stepToSendOrReturn.
					self resetContext: currentContext.
					oldMethod == currentContext method "didnt used to update pc here"
						ifTrue: [self changed: #contentsSelection]]
				ifFalse: 
					[currentContext completeCallee: currentContext step.
					self changed: #contentsSelection]].
	self updateInspectors! !

!Debugger methodsFor: 'context stack menu' stamp: 'hg 4/6/2000 11:20'!
send
	"Send the selected message in the accessed method, and take control in 
	the method invoked to allow further step or 
send."

	| currentContext |
	"Sensor leftShiftDown ifTrue: [self halt]."
	self okToChange ifFalse: [^ self].
	self checkContextSelection.
	externalInterrupt ifFalse: [contextStackTop push: proceedValue].
	externalInterrupt _ true. "simulation leaves same state as interrupting"
	currentContext _ self selectedContext.
	currentContext stepToSendOrReturn.
	self contextStackIndex > 1 | currentContext willReturn
		ifTrue: 
			[self changed: #notChanged]
		ifFalse: 
			[currentContext _ currentContext step.
			currentContext stepToSendOrReturn.
			self resetContext: currentContext].
	self updateInspectors! !

!Debugger methodsFor: 'context stack menu' stamp: 'hg 4/6/2000 11:12'!
stepIntoBlock
	"Send messages until you return to the present method context.
	 Used to step into a block in the method."

	| startContext ctxt current |
"	self selectedContext halt.
"	startContext _ self selectedContext.
	self send.

	"check if nothing happend on send, otherwise continue until block"
	self contextStackIndex > 1 "| self selectedContext willReturn" ifFalse: [
		ctxt _ contextStackTop.
		["(ctxt == current or: [ctxt hasSender: self]) and: ["ctxt home ~= startContext"]"]
			whileTrue: 
				[current _ ctxt.
				ctxt _ ctxt step].
		ctxt _ ctxt stepToSendOrReturn.
		self resetContext: ctxt]! !

!Debugger methodsFor: 'private' stamp: 'hg 10/31/2000 19:04'!
contextStackIndex: anInteger oldContextWas: oldContext

	| newMethod |
	contextStackIndex _ anInteger.
	anInteger = 0
		ifTrue:
			[tempNames _ sourceMap _ contents _ nil.
			self changed: #contextStackIndex.
			self contentsChanged.
			contextVariablesInspector object: nil.
			receiverInspector object: self receiver.
			^self].
	(newMethod _ oldContext == nil or:
		[oldContext method ~~ self selectedContext method])
		ifTrue:
			[tempNames _ sourceMap _ nil.
			contents _ self selectedMessage.
			self contentsChanged.
			self pcRange "will compute tempNamesunless noFrills"].
	self changed: #contextStackIndex.
	tempNames == nil
		ifTrue: [tempNames _ 
					self selectedClassOrMetaClass parserClass new parseArgsAndTemps: contents notifying: nil].
	contextVariablesInspector object: self selectedContext.
	receiverInspector object: self receiver.
	[	self receiverInspector toggleIndex: 2.
		self contextVariablesInspector toggleIndex: 2 
	] on: Error do: [
		self receiverInspector toggleIndex: 0.
		self contextVariablesInspector toggleIndex: 0].
	newMethod ifFalse: [self changed: #contentsSelection]! !


!Debugger class methodsFor: 'class initialization' stamp: 'hg 7/9/2000 13:34'!
initialize
	ErrorRecursion _ false.
	ContextStackKeystrokes _ Dictionary new
		at: $e put: #send;
		at: $t put: #doStep;
		at: $T put: #stepIntoBlock;
		at: $p put: #proceed;
		at: $r put: #restart;
		at: $R put: #restart;
		at: $f put: #fullStack;
		at: $w put: #where;
		yourself.

	"Debugger initialize"! !

Debugger initialize!


More information about the Squeak-dev mailing list