Debug action events small improvements

src/NewTools-Debugger/StDebuggerActionModel.class.st

@@ -268,12 +268,6 @@ StDebuggerActionModel >> isInterruptedContextSubclassResponsibilityException [
 	^ self contextPredicate isContextSubclassResponsibilityException
 ]
 
-{ #category : 'instance creation' }
-StDebuggerActionModel >> newStepAnnouncement [
-
-	^ (StDebuggerActionModelStepAnnouncement debuggerActionModel: self)
-]
-
 { #category : 'debug - execution' }
 StDebuggerActionModel >> peelToFirstLike: aContext [
 	self session peelToFirstLike: aContext.
@@ -306,6 +300,12 @@ StDebuggerActionModel >> predicateFor: aContext postMortem: isContextPostMortem
 		  yourself
 ]
 
+{ #category : 'accessing' }
+StDebuggerActionModel >> preventUpdate [
+
+	^ preventUpdate ifNil: [ preventUpdate := false ]
+]
+
 { #category : 'updating' }
 StDebuggerActionModel >> preventUpdatesDuring: aBlock [
 
@@ -373,14 +373,13 @@ StDebuggerActionModel >> referenceContext [
 { #category : 'events - handling' }
 StDebuggerActionModel >> registerActionsForSession: aSession [
 
-	self flag: 'Rewrite it'.
 	aSession ifNotNil: [
 		aSession
 			when: #restart send: #updateRestart to: self;
 			when: #resume send: #updateResume to: self;
 			when: #stepInto send: #updateStep to: self;
-			when: #stepOver send: #updateStep to: self;
-			when: #stepThrough send: #updateStep to: self;
+			when: #stepOver send: #updateStepOver to: self;
+			when: #stepThrough send: #updateStepThrough to: self;
 			when: #contextChanged send: #updateContextChanged to: self;
 			when: #clear send: #clear to: self ]
 ]
@@ -454,6 +453,12 @@ StDebuggerActionModel >> shouldFilterStack [
 	^ self filterStack and: [ self class shouldFilterStack ]
 ]
 
+{ #category : 'actions' }
+StDebuggerActionModel >> sourceNodeExecuted [
+
+	^self referenceContext ifNotNil:[:ctx| ctx sourceNodeExecuted]
+]
+
 { #category : 'accessing - variables' }
 StDebuggerActionModel >> stack [
 	^ self session stack
@@ -550,7 +555,7 @@ StDebuggerActionModel >> updateAfterMethodAdded [
 			 self)
 ]
 
-{ #category : 'instance creation' }
+{ #category : 'updating' }
 StDebuggerActionModel >> updateContextChanged [
 
 	self updateIfAble:
@@ -591,8 +596,7 @@ StDebuggerActionModel >> updateIfAble [
 { #category : 'accessing' }
 StDebuggerActionModel >> updateIfAble: anAnnouncement [
 
-	preventUpdate ifNil: [ ^ self ].
-	preventUpdate ifFalse: [ self update: anAnnouncement ]
+	self preventUpdate ifFalse: [ self update: anAnnouncement ]
 ]
 
 { #category : 'announcement' }
@@ -603,18 +607,32 @@ StDebuggerActionModel >> updateRestart [
 			   self)
 ]
 
-{ #category : 'instance creation' }
+{ #category : 'updating' }
 StDebuggerActionModel >> updateResume [
 
 	self updateIfAble:
 		(StDebuggerActionModelResumeAnnouncement debuggerActionModel: self)
 ]
 
-{ #category : 'instance creation' }
+{ #category : 'updating' }
 StDebuggerActionModel >> updateStep [
 
 	self updateIfAble:
-		(StDebuggerActionModelStepAnnouncement debuggerActionModel: self)
+		(StDebuggerActionModelStepAnnouncement stepInto: self)
+]
+
+{ #category : 'updating' }
+StDebuggerActionModel >> updateStepOver [
+
+	self updateIfAble:
+		(StDebuggerActionModelStepAnnouncement stepOver: self)
+]
+
+{ #category : 'updating' }
+StDebuggerActionModel >> updateStepThrough [
+
+	self updateIfAble:
+		(StDebuggerActionModelStepAnnouncement stepThrough: self)
 ]
 
 { #category : 'context' }

src/NewTools-Debugger/StDebuggerActionModelAnnouncement.class.st

@@ -2,7 +2,8 @@ Class {
 	#name : 'StDebuggerActionModelAnnouncement',
 	#superclass : 'Announcement',
 	#instVars : [
-		'debuggerActionModel'
+		'debuggerActionModel',
+		'node'
 	],
 	#category : 'NewTools-Debugger-Model',
 	#package : 'NewTools-Debugger',
@@ -12,7 +13,7 @@ Class {
 { #category : 'instance creation' }
 StDebuggerActionModelAnnouncement class >> debuggerActionModel: aDebuggerActionModel [
 
-	^ self new debuggerActionModel: aDebuggerActionModel
+	^ self new on: aDebuggerActionModel
 ]
 
 { #category : 'accessing' }
@@ -26,3 +27,15 @@ StDebuggerActionModelAnnouncement >> debuggerActionModel: aDebuggerActionModel [
 
 	debuggerActionModel := aDebuggerActionModel
 ]
+
+{ #category : 'accessing' }
+StDebuggerActionModelAnnouncement >> node [
+
+	^ node
+]
+
+{ #category : 'initialize' }
+StDebuggerActionModelAnnouncement >> on: aDebuggerActionModel [
+
+	self debuggerActionModel: aDebuggerActionModel
+]

src/NewTools-Debugger/StDebuggerActionModelContextChangedAnnouncement.class.st

@@ -5,3 +5,10 @@ Class {
 	#package : 'NewTools-Debugger',
 	#tag : 'Model'
 }
+
+{ #category : 'initialize' }
+StDebuggerActionModelContextChangedAnnouncement >> on: aDebuggerActionModel [
+
+	super on: aDebuggerActionModel.
+	node := aDebuggerActionModel sourceNodeExecuted methodNode
+]

src/NewTools-Debugger/StDebuggerActionModelRestartAnnouncement.class.st

@@ -5,3 +5,15 @@ Class {
 	#package : 'NewTools-Debugger',
 	#tag : 'Model'
 }
+
+{ #category : 'initialize' }
+StDebuggerActionModelRestartAnnouncement >> on: aDebuggerActionModel [
+
+	super on: aDebuggerActionModel.
+	node := aDebuggerActionModel sourceNodeExecuted methodNode
+]
+
+{ #category : 'printing' }
+StDebuggerActionModelRestartAnnouncement >> printOn: aStream [
+	aStream << 'Restart context'
+]

src/NewTools-Debugger/StDebuggerActionModelStepAnnouncement.class.st

@@ -1,7 +1,63 @@
 Class {
 	#name : 'StDebuggerActionModelStepAnnouncement',
 	#superclass : 'StDebuggerActionModelAnnouncement',
+	#instVars : [
+		'step'
+	],
 	#category : 'NewTools-Debugger-Model',
 	#package : 'NewTools-Debugger',
 	#tag : 'Model'
 }
+
+{ #category : 'debugging actions' }
+StDebuggerActionModelStepAnnouncement class >> stepInto: aDebuggerActionModel [
+
+	^ (self debuggerActionModel: aDebuggerActionModel)
+		  stepInto;
+		  yourself
+]
+
+{ #category : 'debugging actions' }
+StDebuggerActionModelStepAnnouncement class >> stepOver: aDebuggerActionModel [
+
+	^ (self debuggerActionModel: aDebuggerActionModel)
+		  stepOver;
+		  yourself
+]
+
+{ #category : 'debugging actions' }
+StDebuggerActionModelStepAnnouncement class >> stepThrough: aDebuggerActionModel [
+
+	^ (self debuggerActionModel: aDebuggerActionModel)
+		  stepThrough;
+		  yourself
+]
+
+{ #category : 'initialize' }
+StDebuggerActionModelStepAnnouncement >> on: aDebuggerActionModel [
+
+	super on: aDebuggerActionModel.
+	node := aDebuggerActionModel sourceNodeExecuted
+]
+
+{ #category : 'printing' }
+StDebuggerActionModelStepAnnouncement >> printOn: aStream [
+	aStream << 'Step'.
+	aStream space.
+	aStream << step
+]
+
+{ #category : 'actions' }
+StDebuggerActionModelStepAnnouncement >> stepInto [
+	step := 'into'
+]
+
+{ #category : 'actions' }
+StDebuggerActionModelStepAnnouncement >> stepOver [
+	step := 'over'
+]
+
+{ #category : 'actions' }
+StDebuggerActionModelStepAnnouncement >> stepThrough [
+	step := 'through'
+]