Making all debugger ad-hoc clients to use Oups throug OupsDebugRequests

pharo-project · Aug 24, 2020 · 9cbf04c · 9cbf04c
1 parent bed26f0
commit 9cbf04c
Show file tree

Hide file tree

Showing 5 changed files with 42 additions and 47 deletions.
diff --git a/src/Calypso-SystemPlugins-Critic-Browser/ClyDebugBrokenCritiqueCommand.class.st b/src/Calypso-SystemPlugins-Critic-Browser/ClyDebugBrokenCritiqueCommand.class.st
@@ -40,11 +40,9 @@ ClyDebugBrokenCritiqueCommand >> defaultMenuItemName [
 ]
 
 { #category : #execution }
-ClyDebugBrokenCritiqueCommand >> execute [ 
+ClyDebugBrokenCritiqueCommand >> execute [
 
-	UIManager default
-			debugProcess: Processor activeProcess 
-			context: critique stack
-			label: critique message 
-			fullView: true
+	(OupsDebugRequest newForContext: critique stack)
+		label: critique message;
+		submit
 ]
diff --git a/src/Calypso-SystemQueries/ClyClassSideScope.class.st b/src/Calypso-SystemQueries/ClyClassSideScope.class.st
@@ -22,5 +22,5 @@ ClyClassSideScope >> methodsDo: aBlock [
 
 	self classesDo: [ :eachClass | 
 		self metaLevelsOf: eachClass do: [ :concreteMetaLevelClass |
-			concreteMetaLevelClass visibleMethods do: aBlock ] ]
+			concreteMetaLevelClass methods do: aBlock ] ]
 ]
diff --git a/src/Renraku/ReExceptionProperty.class.st b/src/Renraku/ReExceptionProperty.class.st
@@ -26,16 +26,14 @@ ReExceptionProperty class >> for: anEntity with: anException [
 { #category : #actions }
 ReExceptionProperty >> actions [
 
-	^ {RePropertyAction new
-			icon: (self iconNamed: #smallDebug);
-			description: 'Debug the exception';
-			action: [ :prop |
-				UIManager default
-					debugProcess: Processor activeProcess 
-					context: prop stack
-					label: prop message 
-					fullView: true ];
-			yourself}
+	^ { (RePropertyAction new
+		   icon: (self iconNamed: #smallDebug);
+		   description: 'Debug the exception';
+		   action: [ :prop | 
+			   (OupsDebugRequest newForContext: prop stack)
+				   label: prop message;
+				   submit ];
+		   yourself) }
 ]
 
 { #category : #accessing }

diff --git a/src/Rubric/RubSmalltalkEditor.class.st b/src/Rubric/RubSmalltalkEditor.class.st
@@ -451,19 +451,21 @@ RubSmalltalkEditor >> debug: aStream [
 
 { #category : #'do-its' }
 RubSmalltalkEditor >> debug: aCompiledMethod receiver: anObject in: evalContext [
-	| guineaPig context debugSession |
-	guineaPig := [ aCompiledMethod
-		valueWithReceiver: anObject
-		arguments: (evalContext ifNil: [ #() ] ifNotNil: [ {evalContext} ]) ]
-		newProcess.
-	context := guineaPig suspendedContext.
-
-	debugSession := guineaPig newDebugSessionNamed: 'debug it' startedAt: context.
-	debugSession stepIntoUntil: [:currentContext | 
-		currentContext method == aCompiledMethod ].
-
-	Smalltalk tools debugger openOn: debugSession withFullView: true.
-
+
+	| process suspendedContext |
+	process := [ 
+	           aCompiledMethod
+		           valueWithReceiver: anObject
+		           arguments:
+		           (evalContext
+			            ifNil: [ #(  ) ]
+			            ifNotNil: [ { evalContext } ]) ] newProcess.
+	suspendedContext := process suspendedContext.
+	(OupsDebugRequest newForContext: suspendedContext)
+		process: process;
+		compiledMethod: aCompiledMethod;
+		label: 'debug it';
+		submit
 ]
 
 { #category : #'do-its' }

diff --git a/src/Spec2-Code-Commands/SpCodeDebugItCommand.class.st b/src/Spec2-Code-Commands/SpCodeDebugItCommand.class.st
@@ -62,24 +62,21 @@ SpCodeDebugItCommand >> debug: aStream [
 
 { #category : #private }
 SpCodeDebugItCommand >> debug: aCompiledMethod receiver: anObject in: evalContext [
-	| guineaPig suspendedContext debugSession |
 
-	guineaPig := [ 
-		aCompiledMethod
-			valueWithReceiver: anObject
-			arguments: (evalContext ifNil: [ #() ] ifNotNil: [ { evalContext } ]) ]
-			newProcess.
-	suspendedContext := guineaPig suspendedContext.
-
-	debugSession := guineaPig newDebugSessionNamed: 'debug it' startedAt: suspendedContext.
-	debugSession stepIntoUntil: [ :currentContext | 
-		currentContext method == aCompiledMethod ].
-
-	Smalltalk tools debugger openOn: debugSession withFullView: true.
-	"(StDebugger on: debugSession)
-		application: context application;
-		openWithFullView"
-
+	| process suspendedContext |
+	process := [ 
+	           aCompiledMethod
+		           valueWithReceiver: anObject
+		           arguments:
+		           (evalContext
+			            ifNil: [ #(  ) ]
+			            ifNotNil: [ { evalContext } ]) ] newProcess.
+	suspendedContext := process suspendedContext.
+	(OupsDebugRequest newForContext: suspendedContext)
+		process: process;
+		compiledMethod: aCompiledMethod;
+		label: 'debug it';
+		submit
 ]
 
 { #category : #execution }