From 65d15b4b77e1dadccb1970149e25d0cdc0b3ab41 Mon Sep 17 00:00:00 2001
From: Steven Costiou <26929529+StevenCostiou@users.noreply.github.com>
Date: Fri, 24 Nov 2023 11:54:30 +0100
Subject: [PATCH] Integration of object-centric halt once on call breakpoint to
 tools

---
 .../StHaltOnceOnCallCommand.class.st          | 36 +++++++++++++++++++
 .../StMetaBrowserPresenter.extension.st       | 10 +++++-
 2 files changed, 45 insertions(+), 1 deletion(-)
 create mode 100644 src/NewTools-ObjectCentricBreakpoints/StHaltOnceOnCallCommand.class.st

diff --git a/src/NewTools-ObjectCentricBreakpoints/StHaltOnceOnCallCommand.class.st b/src/NewTools-ObjectCentricBreakpoints/StHaltOnceOnCallCommand.class.st
new file mode 100644
index 000000000..fc1be3af2
--- /dev/null
+++ b/src/NewTools-ObjectCentricBreakpoints/StHaltOnceOnCallCommand.class.st
@@ -0,0 +1,36 @@
+Class {
+	#name : 'StHaltOnceOnCallCommand',
+	#superclass : 'StBreakpointCommand',
+	#category : 'NewTools-ObjectCentricBreakpoints',
+	#package : 'NewTools-ObjectCentricBreakpoints'
+}
+
+{ #category : 'default' }
+StHaltOnceOnCallCommand class >> defaultDescription [
+
+	^ 'Halts once when this method is called'
+]
+
+{ #category : 'deafult' }
+StHaltOnceOnCallCommand class >> defaultIconName [
+
+	^ #smallDebug
+]
+
+{ #category : 'default' }
+StHaltOnceOnCallCommand class >> defaultName [ 
+
+	^ 'Halt once on call'
+]
+
+{ #category : 'testing' }
+StHaltOnceOnCallCommand >> canBeExecuted [
+
+	^ self appliesTo: context
+]
+
+{ #category : 'executing' }
+StHaltOnceOnCallCommand >> execute [
+
+	^ context haltOnceInspectedObjectOnCallToSelectedMethod
+]
diff --git a/src/NewTools-ObjectCentricBreakpoints/StMetaBrowserPresenter.extension.st b/src/NewTools-ObjectCentricBreakpoints/StMetaBrowserPresenter.extension.st
index b430efd7a..4f031d9ce 100644
--- a/src/NewTools-ObjectCentricBreakpoints/StMetaBrowserPresenter.extension.st
+++ b/src/NewTools-ObjectCentricBreakpoints/StMetaBrowserPresenter.extension.st
@@ -7,10 +7,18 @@ StMetaBrowserPresenter >> haltInspectedObjectOnCallToSelectedMethod [
 	self model haltOnCallTo: method selector
 ]
 
+{ #category : '*NewTools-ObjectCentricBreakpoints' }
+StMetaBrowserPresenter >> haltOnceInspectedObjectOnCallToSelectedMethod [
+	|method|
+	method := self selectedMethod ifNil:[^self].
+	self model haltOnceOnCallTo: method selector
+]
+
 { #category : '*NewTools-ObjectCentricBreakpoints' }
 StMetaBrowserPresenter class >> objectCentricBreakpointCommandsWith: presenter forRootGroup: aRootCmCommandsGroup [
 	<extensionCommands>
 	
 	(aRootCmCommandsGroup / 'methods')
-		register: StHaltOnCallCommand forSpec
+		register: StHaltOnCallCommand forSpec;
+		register: StHaltOnceOnCallCommand forSpec
 ]