diff --git a/src/Morphic-Widgets-FastTable/FTScrollingChanged.class.st b/src/Morphic-Widgets-FastTable/FTScrollingChanged.class.st
new file mode 100644
index 00000000000..b0a4c2bbc69
--- /dev/null
+++ b/src/Morphic-Widgets-FastTable/FTScrollingChanged.class.st
@@ -0,0 +1,37 @@
+Class {
+	#name : #FTScrollingChanged,
+	#superclass : #FTAnnouncement,
+	#instVars : [
+		'newScrollingIndex',
+		'oldScrollingIndex'
+	],
+	#category : #'Morphic-Widgets-FastTable-Announcement'
+}
+
+{ #category : #'instance creation' }
+FTScrollingChanged class >> from: oldIndex to: newIndex [
+	^ self new
+		oldScrollingIndex: oldIndex;
+		newScrollingIndex: newIndex;
+		yourself
+]
+
+{ #category : #accessing }
+FTScrollingChanged >> newScrollingIndex [
+	^ newScrollingIndex
+]
+
+{ #category : #accessing }
+FTScrollingChanged >> newScrollingIndex: anObject [
+	newScrollingIndex := anObject
+]
+
+{ #category : #accessing }
+FTScrollingChanged >> oldScrollingIndex [
+	^ oldScrollingIndex
+]
+
+{ #category : #accessing }
+FTScrollingChanged >> oldScrollingIndex: anObject [
+	oldScrollingIndex := anObject
+]
diff --git a/src/Morphic-Widgets-FastTable/FTTableContainerMorph.class.st b/src/Morphic-Widgets-FastTable/FTTableContainerMorph.class.st
index 6b9e4be0bc6..63e8e1b7a65 100644
--- a/src/Morphic-Widgets-FastTable/FTTableContainerMorph.class.st
+++ b/src/Morphic-Widgets-FastTable/FTTableContainerMorph.class.st
@@ -116,12 +116,14 @@ FTTableContainerMorph >> calculateStartIndexWhenShowing: visibleRows [
 	"Answer the first row to show when showing visibleRows rows. 
 	 This works in case we are exceeding the available rows to show"
 
-	| currentIndex startIndex |
+	| currentIndex startIndex oldIndex |
 	currentIndex := self table showIndex.
 	currentIndex + visibleRows - 1 > self table numberOfRows ifTrue: [ 
 		currentIndex := self table numberOfRows - visibleRows + 2].
 	startIndex := currentIndex max: 1.
+	oldIndex := self table showIndex.
 	self table basicMoveShowIndexTo: startIndex.
+	self table announceScrollChangedFrom: oldIndex to: self table showIndex.
 	^startIndex
 	
 ]
@@ -244,6 +246,14 @@ FTTableContainerMorph >> exposedRows [
 	^ exposedRows
 ]
 
+{ #category : #accessing }
+FTTableContainerMorph >> firstVisibleRowIndex [
+
+	^ self exposedRows
+		ifNotEmpty: [ :rows | rows keys first ]
+		ifEmpty: [ 0 ]
+]
+
 { #category : #accessing }
 FTTableContainerMorph >> headerRow [
 
@@ -281,6 +291,14 @@ FTTableContainerMorph >> isRowIndexVisible: rowIndex [
 	^ self exposedRows includesKey: rowIndex
 ]
 
+{ #category : #accessing }
+FTTableContainerMorph >> lastVisibleRowIndex [
+
+	^ self exposedRows
+		ifNotEmpty: [ :rows | rows keys last ]
+		ifEmpty: [ 0 ]
+]
+
 { #category : #private }
 FTTableContainerMorph >> needsRefreshExposedRows [
 	^ needsRefreshExposedRows
diff --git a/src/Morphic-Widgets-FastTable/FTTableMorph.class.st b/src/Morphic-Widgets-FastTable/FTTableMorph.class.st
index 6d803e5c3b5..e9099edb617 100644
--- a/src/Morphic-Widgets-FastTable/FTTableMorph.class.st
+++ b/src/Morphic-Widgets-FastTable/FTTableMorph.class.st
@@ -127,6 +127,17 @@ FTTableMorph >> allowsDeselection: aBoolean [
 	allowsDeselection := aBoolean
 ]
 
+{ #category : #private }
+FTTableMorph >> announceScrollChangedFrom: oldIndex to: newIndex [
+	"If the index did not change, do nothing"
+	oldIndex = newIndex ifTrue: [ ^ self ].
+	self
+		doAnnounce:
+			((FTScrollingChanged from: oldIndex to: newIndex)
+				fastTable: self;
+				yourself)
+]
+
 { #category : #updating }
 FTTableMorph >> autoScrollHeightLimit [
 
@@ -146,8 +157,8 @@ FTTableMorph >> basicHighlightRowIndexes: anArray [
 
 { #category : #private }
 FTTableMorph >> basicMoveShowIndexTo: aNumber [
-	showIndex := aNumber.
 
+	showIndex := aNumber
 ]
 
 { #category : #private }
@@ -349,6 +360,12 @@ FTTableMorph >> extent: aPoint [
 	self resizeAllSubviews
 ]
 
+{ #category : #accessing }
+FTTableMorph >> firstVisibleRowIndex [
+	
+	^ self container firstVisibleRowIndex
+]
+
 { #category : #'event handling' }
 FTTableMorph >> handleMouseMove: anEvent [
 	"Reimplemented because we really want #mouseMove when a morph is dragged around"
@@ -694,6 +711,12 @@ FTTableMorph >> keyboardFocusChange: aBoolean [
 	self focusChanged
 ]
 
+{ #category : #accessing }
+FTTableMorph >> lastVisibleRowIndex [
+
+	^ self container lastVisibleRowIndex
+]
+
 { #category : #layout }
 FTTableMorph >> minHeight [ 
 	"Ceiling is required because there is strange behavior when this method return float.
@@ -795,11 +818,14 @@ FTTableMorph >> moveShowIndexTo: arg [
 	 showing pointer should do it directly. 
 	 Use me just in case you need to force a refresh after settign the index"
 
-	| index |
+	| index oldIndex |
 	index := self selectionModeStrategy rowIndexFrom: arg.
+	oldIndex := showIndex.
 	self basicMoveShowIndexTo: index.
 	self verticalScrollBar value: (self rowIndexToVerticalScrollBarValue: index).
-	self refresh
+	self refresh.
+	
+	self announceScrollChangedFrom: oldIndex to: index.
 ]
 
 { #category : #accessing }
@@ -951,6 +977,15 @@ FTTableMorph >> scrollBarThickness [
 	^ self theme scrollbarThickness
 ]
 
+{ #category : #private }
+FTTableMorph >> scrollToIndex: anIndex [
+	(self container isRowIndexFullyVisible: anIndex) ifTrue: [ ^ self ].
+
+	anIndex <= self showIndex
+		ifTrue: [ self moveShowIndexTo: anIndex ]
+		ifFalse: [ self moveShowIndexTo: (self selectionModeStrategy indexForRow: anIndex - self container calculateMinVisibleRows + 1) ]
+]
+
 { #category : #'accessing colors' }
 FTTableMorph >> secondarySelectionColor [ 
 	^ secondarySelectionColor ifNil: [ self class defaultSecondarySelectionColor ]
diff --git a/src/Spec2-Adapters-Morphic/SpMorphicListAdapter.class.st b/src/Spec2-Adapters-Morphic/SpMorphicListAdapter.class.st
index 9eea9a0f736..83d7aff6943 100644
--- a/src/Spec2-Adapters-Morphic/SpMorphicListAdapter.class.st
+++ b/src/Spec2-Adapters-Morphic/SpMorphicListAdapter.class.st
@@ -56,11 +56,18 @@ SpMorphicListAdapter >> buildWidget [
 	self presenter whenModelChangedDo: [ widget refresh ].
 	self presenter whenSelectionChangedDo: [ self refreshWidgetSelection ].
 	self presenter selection whenChangedDo: [ self refreshWidgetSelection ].
+	
 	self refreshWidgetHeaderTitle.
 	self refreshWidgetSelection.
 	self presenter whenItemFilterBlockChangedDo: [ :block | self updateItemFilterBlockWith: block ].
 	self updateItemFilterBlockWith: self itemFilter.
-
+	
+	self presenter verticalAlignment whenChangedDo: [ 
+		widget scrollToIndex: self presenter verticalAlignment desiredVisibleRow ].
+	self presenter whenDisplayDo: [ 
+		widget scrollToIndex: self presenter verticalAlignment desiredVisibleRow.
+		self scrollingChanged ].
+	widget onAnnouncement: FTScrollingChanged send: #scrollingChanged to: self.
 	widget bindKeyCombination: Character space toAction: [ self model clickOnSelectedItem ].
 
 	^ widget
@@ -166,6 +173,15 @@ SpMorphicListAdapter >> rightClicked [
 	self widget click: evt
 ]
 
+{ #category : #scrolling }
+SpMorphicListAdapter >> scrollingChanged [
+
+	widget container updateAllRows.
+	self presenter verticalAlignment
+		firstVisibleRowIndex: widget firstVisibleRowIndex;
+		lastVisibleRowIndex: widget lastVisibleRowIndex
+]
+
 { #category : #selecting }
 SpMorphicListAdapter >> selectIndex: anInteger [ 
 	
diff --git a/src/Spec2-Adapters-Morphic/SpMorphicTableAdapter.class.st b/src/Spec2-Adapters-Morphic/SpMorphicTableAdapter.class.st
index b9c6c0ebd09..02933449b7b 100644
--- a/src/Spec2-Adapters-Morphic/SpMorphicTableAdapter.class.st
+++ b/src/Spec2-Adapters-Morphic/SpMorphicTableAdapter.class.st
@@ -28,6 +28,13 @@ SpMorphicTableAdapter >> addModelTo: tableMorph [
 	
 	tableMorph setBalloonText: self help.
 
+	self presenter verticalAlignment whenChangedDo: [ 
+		widget scrollToIndex: self presenter verticalAlignment desiredVisibleRow ].
+	self presenter whenDisplayDo: [ 
+		widget scrollToIndex: self presenter verticalAlignment desiredVisibleRow.
+		self scrollingChanged ].
+	widget onAnnouncement: FTScrollingChanged send: #scrollingChanged to: self.
+
 	tableMorph
 		onAnnouncement: FTSelectionChanged
 			send: #selectionChanged:
@@ -151,6 +158,15 @@ SpMorphicTableAdapter >> rightClicked [
 	self widget click: evt
 ]
 
+{ #category : #factory }
+SpMorphicTableAdapter >> scrollingChanged [
+
+	widget container updateAllRows.
+	self presenter verticalAlignment
+		firstVisibleRowIndex: widget firstVisibleRowIndex;
+		lastVisibleRowIndex: widget lastVisibleRowIndex
+]
+
 { #category : #selection }
 SpMorphicTableAdapter >> selectIndex: anInteger [ 
 
diff --git a/src/Spec2-Backend-Tests/SpAbstractAdapterTestCase.class.st b/src/Spec2-Backend-Tests/SpAbstractAdapterTestCase.class.st
index 382e1bf907b..7021234f218 100644
--- a/src/Spec2-Backend-Tests/SpAbstractAdapterTestCase.class.st
+++ b/src/Spec2-Backend-Tests/SpAbstractAdapterTestCase.class.st
@@ -89,18 +89,21 @@ SpAbstractAdapterTestCase >> openInstance [
 
 ]
 
-{ #category : #private }
+{ #category : #running }
 SpAbstractAdapterTestCase >> performTest [
-	
-	specInitializationStrategy beforeTest: self.
-	super performTest.
+
+	backendForTest runTest: [
+		presenter := self classToTest new.
+		self initializeTestedInstance.
+		super performTest]
 ]
 
 { #category : #running }
-SpAbstractAdapterTestCase >> prepareToRunAgain [
-
-	backendForTest runTest: [ super prepareToRunAgain ]
+SpAbstractAdapterTestCase >> prepareToRunAgain [ 	
 
+	"Redefined because setup is cancelled in this class"
+	self tearDown.
+	super setUp.
 ]
 
 { #category : #accessing }
@@ -110,14 +113,9 @@ SpAbstractAdapterTestCase >> presenter [
 
 { #category : #running }
 SpAbstractAdapterTestCase >> runCase [
-
 	self resources do: [:each | each availableFor: self].
-	[	super setUp.
-		backendForTest runTest: [
-			presenter := self classToTest new.
-			self initializeTestedInstance.
-			self performTest].
-	] ensure: [
+	[super setUp.
+	self performTest] ensure: [
 		self tearDown.
 		self cleanUpInstanceVariables]
 ]
diff --git a/src/Spec2-Backend-Tests/SpAbstractListCommonPropertiestTest.class.st b/src/Spec2-Backend-Tests/SpAbstractListCommonPropertiestTest.class.st
index c48a18003b6..4808d6ca011 100644
--- a/src/Spec2-Backend-Tests/SpAbstractListCommonPropertiestTest.class.st
+++ b/src/Spec2-Backend-Tests/SpAbstractListCommonPropertiestTest.class.st
@@ -36,6 +36,14 @@ SpAbstractListCommonPropertiestTest >> testDoubleClickActivatesRowInDoubleClickA
 	self assert: activated
 ]
 
+{ #category : #'tests-scrolling' }
+SpAbstractListCommonPropertiestTest >> testFirstVisibleRowIsInitiallyFirstRow [
+
+	presenter items: (1 to: 500).
+	self openInstance.
+	self assert: presenter verticalAlignment firstVisibleRowIndex equals: 1.
+]
+
 { #category : #tests }
 SpAbstractListCommonPropertiestTest >> testRightClickShowsMenu [
 	| menu |
@@ -46,6 +54,32 @@ SpAbstractListCommonPropertiestTest >> testRightClickShowsMenu [
 	self assert: menu shown
 ]
 
+{ #category : #'tests-scrolling' }
+SpAbstractListCommonPropertiestTest >> testScrollDownToPosteriorIndexScrollsBottomToIndex [
+
+	presenter items: (1 to: 500).
+	presenter verticalAlignment desiredVisibleRow: 100.
+
+	"Force opening the spec instance here.
+	We want to test that once open we can change the state"
+	self openInstance.
+	
+	"Some backends will show entirely row 100 and a part of the next row, so row 101 is also a valid answer"
+	self assert: (presenter verticalAlignment lastVisibleRowIndex between: 100 and: 101).
+]
+
+{ #category : #'tests-scrolling' }
+SpAbstractListCommonPropertiestTest >> testScrollUpToPreviousIndexScrollsTopToIndex [
+
+	presenter items: (1 to: 500).
+	presenter verticalAlignment desiredVisibleRow: 100.
+	self openInstance.
+
+	presenter verticalAlignment desiredVisibleRow: 50.
+	
+	self assert: presenter verticalAlignment firstVisibleRowIndex equals: 50.
+]
+
 { #category : #running }
 SpAbstractListCommonPropertiestTest >> testSingleClickActivatesRowInSingleClickActivationMode [
 
diff --git a/src/Spec2-Core/SpAbstractListPresenter.class.st b/src/Spec2-Core/SpAbstractListPresenter.class.st
index e6eb5a73894..9be1106f32f 100644
--- a/src/Spec2-Core/SpAbstractListPresenter.class.st
+++ b/src/Spec2-Core/SpAbstractListPresenter.class.st
@@ -9,7 +9,8 @@ Class {
 		'#activateOnSingleClick',
 		'#model',
 		'#contextMenu => SpObservableSlot',
-		'#itemFilter => SpObservableSlot'
+		'#itemFilter => SpObservableSlot',
+		'#verticalAlignment'
 	],
 	#category : #'Spec2-Core-Widgets-Table'
 }
@@ -118,6 +119,7 @@ SpAbstractListPresenter >> initialize [
 	super initialize.
 	
 	activationBlock := [ ].
+	verticalAlignment := SpVerticalAlignment new.
 	
 	self withScrollBars.
 	self model: 	self newEmptyModel.
@@ -321,6 +323,12 @@ SpAbstractListPresenter >> unselectItem: anInteger [
 	self selection unselectItem: anInteger
 ]
 
+{ #category : #api }
+SpAbstractListPresenter >> verticalAlignment [
+
+	^ verticalAlignment
+]
+
 { #category : #'api-events' }
 SpAbstractListPresenter >> whenActivatedDo: aBlockClosure [ 
 	
diff --git a/src/Spec2-Core/SpPresenter.class.st b/src/Spec2-Core/SpPresenter.class.st
index 971c1121022..8861e8fd395 100644
--- a/src/Spec2-Core/SpPresenter.class.st
+++ b/src/Spec2-Core/SpPresenter.class.st
@@ -244,6 +244,17 @@ SpPresenter >> announce: anAnnouncement [
 	self announcer announce: anAnnouncement
 ]
 
+{ #category : #events }
+SpPresenter >> announceDisplayed [
+
+	"When using a VersatileDialogPresenter the adapter is nil.
+	We do not know if that is a correct behaviour"
+	self announcer announce: (SpWidgetDisplayed new
+		presenter: self;
+		widget: (adapter ifNotNil: [ adapter widget]);
+		yourself).
+]
+
 { #category : #accessing }
 SpPresenter >> application [
 
@@ -598,6 +609,12 @@ SpPresenter >> instantiatePresenters: aCollectionOfPairs [
 				pairsDo: [ :k :v | self instVarNamed: k asString put: (self createInstanceFor: v) ] ]
 ]
 
+{ #category : #api }
+SpPresenter >> isBuilt [
+	
+	^ self isDisplayed
+]
+
 { #category : #api }
 SpPresenter >> isDisplayed [
 	"Return true if the widget is currently displayed on screen"
@@ -1010,6 +1027,14 @@ SpPresenter >> visibleIf: aValuable [
 	visible := aValuable
 ]
 
+{ #category : #events }
+SpPresenter >> whenDisplayDo: aBlockClosure [ 
+
+	self announcer 
+		when: SpWidgetDisplayed
+		do: aBlockClosure
+]
+
 { #category : #'api-events' }
 SpPresenter >> whenShortcutsChanged: aBlock [
 	"Set a block to value when the shortcuts block has changed"
diff --git a/src/Spec2-Core/SpVerticalAlignment.class.st b/src/Spec2-Core/SpVerticalAlignment.class.st
new file mode 100644
index 00000000000..c2c1d249af8
--- /dev/null
+++ b/src/Spec2-Core/SpVerticalAlignment.class.st
@@ -0,0 +1,59 @@
+Class {
+	#name : #SpVerticalAlignment,
+	#superclass : #Object,
+	#traits : 'TSpObservable',
+	#classTraits : 'TSpObservable classTrait',
+	#instVars : [
+		'#firstVisibleRowIndex',
+		'#lastVisibleRowIndex',
+		'#desiredVisibleRow => SpObservableSlot'
+	],
+	#category : #'Spec2-Core-Widgets-Table'
+}
+
+{ #category : #accessing }
+SpVerticalAlignment >> desiredVisibleRow [
+	^ desiredVisibleRow
+]
+
+{ #category : #accessing }
+SpVerticalAlignment >> desiredVisibleRow: anInteger [
+
+	desiredVisibleRow := anInteger 
+]
+
+{ #category : #accessing }
+SpVerticalAlignment >> firstVisibleRowIndex [
+	"valid only after UI is open"
+	^ firstVisibleRowIndex
+]
+
+{ #category : #accessing }
+SpVerticalAlignment >> firstVisibleRowIndex: anInteger [ 
+	firstVisibleRowIndex := anInteger
+]
+
+{ #category : #initialization }
+SpVerticalAlignment >> initialize [
+	
+	self class initializeSlots: self.
+	super initialize.
+	desiredVisibleRow := 1.
+]
+
+{ #category : #accessing }
+SpVerticalAlignment >> lastVisibleRowIndex [
+	^ lastVisibleRowIndex
+]
+
+{ #category : #accessing }
+SpVerticalAlignment >> lastVisibleRowIndex: anInteger [ 
+
+	lastVisibleRowIndex := anInteger 
+]
+
+{ #category : #events }
+SpVerticalAlignment >> whenChangedDo: aBlockClosure [ 
+	
+	self property: #desiredVisibleRow whenChangedDo: aBlockClosure
+]
diff --git a/src/Spec2-Core/SpWidgetBuilt.class.st b/src/Spec2-Core/SpWidgetBuilt.class.st
index 42442440c14..ce0d62c7be7 100644
--- a/src/Spec2-Core/SpWidgetBuilt.class.st
+++ b/src/Spec2-Core/SpWidgetBuilt.class.st
@@ -1,5 +1,5 @@
 "
-I am raised when a widget has been built
+I am raised when a widget has been built with all its children, but not yet shown
 "
 Class {
 	#name : #SpWidgetBuilt,
diff --git a/src/Spec2-Core/SpWidgetDisplayed.class.st b/src/Spec2-Core/SpWidgetDisplayed.class.st
new file mode 100644
index 00000000000..3ad01a62475
--- /dev/null
+++ b/src/Spec2-Core/SpWidgetDisplayed.class.st
@@ -0,0 +1,32 @@
+"
+I am raised when a widget has been already shown in the screen
+"
+Class {
+	#name : #SpWidgetDisplayed,
+	#superclass : #Announcement,
+	#instVars : [
+		'presenter',
+		'widget'
+	],
+	#category : #'Spec2-Core-Support'
+}
+
+{ #category : #accessing }
+SpWidgetDisplayed >> presenter [
+	^ presenter
+]
+
+{ #category : #accessing }
+SpWidgetDisplayed >> presenter: anObject [
+	presenter := anObject
+]
+
+{ #category : #accessing }
+SpWidgetDisplayed >> widget [
+	^ widget
+]
+
+{ #category : #accessing }
+SpWidgetDisplayed >> widget: anObject [
+	widget := anObject
+]
diff --git a/src/Spec2-Core/SpWindowPresenter.class.st b/src/Spec2-Core/SpWindowPresenter.class.st
index 74bef32eba6..436cc4cd07b 100644
--- a/src/Spec2-Core/SpWindowPresenter.class.st
+++ b/src/Spec2-Core/SpWindowPresenter.class.st
@@ -339,6 +339,9 @@ SpWindowPresenter >> openWithSpecLayout: aSpec [
 
 	self buildWithSpecLayout: aSpec.
 	self changed: #open with: #().
+	
+	self allPresenters do: [ :each | each announceDisplayed ].
+
 	self updateTitle.
 ]
 
@@ -408,6 +411,13 @@ SpWindowPresenter >> toolBar: aToolbarPresenter [
 	^ toolBar := aToolbarPresenter
 ]
 
+{ #category : #'private-traversing' }
+SpWindowPresenter >> traversePresentersDo: aBlock excluding: excludes [
+
+	super traversePresentersDo: aBlock excluding: excludes.
+	presenter traversePresentersDo: aBlock excluding: excludes.
+]
+
 { #category : #api }
 SpWindowPresenter >> triggerCancelAction [
 	"do nothing (ensure polymorphism with DialogWindow)"
diff --git a/src/Spec2-Tests/SpListPresenterMultipleSelectionTest.class.st b/src/Spec2-Tests/SpListPresenterMultipleSelectionTest.class.st
index 9bfcac106a0..397d278efba 100644
--- a/src/Spec2-Tests/SpListPresenterMultipleSelectionTest.class.st
+++ b/src/Spec2-Tests/SpListPresenterMultipleSelectionTest.class.st
@@ -13,10 +13,9 @@ SpListPresenterMultipleSelectionTest >> classToTest [
 SpListPresenterMultipleSelectionTest >> setUp [
 
 	super setUp.
-	window := presenter
+	presenter
 		beMultipleSelection;
-		items: #(10 20 30);
-		openWithSpec.
+		items: #(10 20 30).
 ]
 
 { #category : #'tests-select-index' }
diff --git a/src/Spec2-Tests/SpListPresenterSingleSelectionTest.class.st b/src/Spec2-Tests/SpListPresenterSingleSelectionTest.class.st
index 5e7b0af979a..dfc49464db3 100644
--- a/src/Spec2-Tests/SpListPresenterSingleSelectionTest.class.st
+++ b/src/Spec2-Tests/SpListPresenterSingleSelectionTest.class.st
@@ -14,10 +14,9 @@ SpListPresenterSingleSelectionTest >> setUp [
 
 	super setUp.
 
-	window := presenter
+	presenter
 		beSingleSelection;
-		items: #(10 20 30);
-		openWithSpec.
+		items: #(10 20 30)
 ]
 
 { #category : #'tests-select-index' }
diff --git a/src/Spec2-Tests/SpTestCase.class.st b/src/Spec2-Tests/SpTestCase.class.st
index f7eabe6273d..bf4573de47a 100644
--- a/src/Spec2-Tests/SpTestCase.class.st
+++ b/src/Spec2-Tests/SpTestCase.class.st
@@ -8,6 +8,12 @@ Class {
 	#category : #'Spec2-Tests-Utils'
 }
 
+{ #category : #testing }
+SpTestCase class >> isAbstract [
+
+	^ self == SpTestCase
+]
+
 { #category : #assertions }
 SpTestCase >> assertEvent: anEventName isRaisedInPresenter: aPresenter whenDoing: aBlock [
 	
@@ -75,6 +81,70 @@ SpTestCase >> tearDown [
 	super tearDown
 ]
 
+{ #category : #tests }
+SpTestCase >> testNewPresenterIsNotBuilt [
+
+	self deny: presenter isBuilt
+]
+
+{ #category : #tests }
+SpTestCase >> testNewPresenterIsNotDisplayed [
+
+	self deny: presenter isDisplayed
+]
+
+{ #category : #tests }
+SpTestCase >> testNonOpenPresenterDoesNotRaiseBuiltEvent [
+
+	| built |
+	built := false.
+	presenter whenBuiltDo: [ built := true ].
+	self deny: built
+]
+
+{ #category : #tests }
+SpTestCase >> testNonOpenPresenterDoesNotRaiseDisplayedEvent [
+
+	| displayed |
+	displayed := false.
+	presenter whenDisplayDo: [ displayed := true ].
+	self deny: displayed
+]
+
+{ #category : #tests }
+SpTestCase >> testOpenPresenterIsBuilt [
+
+	self openInstance.
+	self assert: presenter isBuilt
+]
+
+{ #category : #tests }
+SpTestCase >> testOpenPresenterIsDisplayed [
+
+	self openInstance.
+	self assert: presenter isDisplayed
+]
+
+{ #category : #tests }
+SpTestCase >> testOpenPresenterRaisesBuiltEvent [
+
+	| built |
+	built := false.
+	presenter whenBuiltDo: [ built := true ].
+	self openInstance.
+	self assert: built
+]
+
+{ #category : #tests }
+SpTestCase >> testOpenPresenterRaisesDisplayEvent [
+
+	| displayed |
+	displayed := false.
+	presenter whenDisplayDo: [ displayed := true ].
+	self openInstance.
+	self assert: displayed
+]
+
 { #category : #accessing }
 SpTestCase >> widget [