Merge 5b6ba6a

src/BaselineOfSpecCore/BaselineOfSpecCore.class.st

@@ -23,10 +23,6 @@ BaselineOfSpecCore >> baseline: spec [
 			package: 'Spec2-Transmission' with: [ spec requires: #('Spec2-Core') ];
 			package: 'Spec2-Interactions' with: [ spec requires: #('Spec2-Core') ];
 			package: 'Spec2-Commander2' with: [ spec requires: #('Spec2-Core' 'Spec2-Interactions') ];
-			"ListView"
-			package: 'Spec2-ListView' with: [ spec requires: #('Spec2-Core') ];
-			package: 'Spec2-Adapters-Morphic-ListView' with: [ spec requires: #('Spec2-ListView') ];
-			package: 'Spec2-ListView-Tests' with: [ spec requires: #('Spec2-ListView') ];
 			"Code"
 			package: 'Spec2-Code' with: [ spec requires: #('Spec2-Core' 'Spec2-Commands') ];
 			package: 'Spec2-Code-Commands' with: [ spec requires: #('Spec2-Core' 'Spec2-Commands') ];
@@ -55,15 +51,13 @@ BaselineOfSpecCore >> baseline: spec [
 		'Spec2-Core' 
 		'Spec2-Dialogs' 
 		'Spec2-CommandLine' 
-		'Spec2-Adapters-Stub'
-		'Spec2-Adapters-Morphic-ListView'
-		'Spec2-ListView'  
+		'Spec2-Adapters-Stub' 
 		'Spec2-Interactions' 
 		'Spec2-Commander2' ).
 	spec group: 'Code' with: #('Core' 'Spec2-Code-Commands' 'Spec2-Code' 'Spec2-Code-Diff').
 	spec group: 'CodeTests' with: #('Spec2-Code-Tests' 'Spec2-Code-Diff-Tests').
 	spec group: 'Support' with: #('Core' 'Spec2-Examples').
-	spec group: 'Tests' with: #('Core' 'Spec2-Tests' 'Spec2-Commander2-Tests' 'Spec2-ListView-Tests').
+	spec group: 'Tests' with: #('Core' 'Spec2-Tests' 'Spec2-Commander2-Tests').
 	spec group: 'SupportTests' with: #('Support').
 	spec group: 'Pillar' with: #('Spec2-Pillar' ).
 	spec group: 'Base' with: #('Core' 'Support').

src/Spec2-Adapters-Morphic-Alexandrie/SpAlexandrieMorph.class.st

@@ -21,21 +21,18 @@ SpAlexandrieMorph >> drawBlock: aBlock [
 SpAlexandrieMorph >> drawOn: aMorphicCanvas [
 
 	self redraw.
-	aMorphicCanvas
-		image: self surface asForm
-		at: self position
-		sourceRect: (0@0 extent: self extent)
-		rule: 34
+	self surface 
+		displayOnMorphicCanvas: aMorphicCanvas 
+		at: bounds origin
 ]
 
 { #category : 'drawing' }
 SpAlexandrieMorph >> redraw [
-	| context |
 
-	context := self surface newContext. 
-	drawBlock 
-		cull: context
-		cull: (0@0 extent: self extent)
+	self surface drawDuring: [ :canvas | 
+		drawBlock 
+			cull: canvas
+			cull: (0@0 extent: self extent) ]
 ]
 
 { #category : 'accessing' }
@@ -44,5 +41,5 @@ SpAlexandrieMorph >> surface [
 	lastExtent = self extent ifFalse: [ surface := nil ].
 	^ surface ifNil: [ 
 		lastExtent := self extent.
-		surface := AeCairoImageSurface extent: self extent ]
+		surface := AthensCairoSurface extent: self extent ]
 ]

src/Spec2-Adapters-Morphic-Alexandrie/SpMorphicAlexandrieAdapter.class.st

@@ -8,9 +8,9 @@ Class {
 
 { #category : 'factory' }
 SpMorphicAlexandrieAdapter >> buildWidget [
+
 	| instance |
-
-	instance := SpAlexandrieMorph new.
+	instance := SpAthensMorph new.
 	self presenter whenDrawBlockChangedDo: [ :newBlock | 
 		instance drawBlock: newBlock ].
 	self presenter whenExtentChangedDo: [ :newExtent | 

src/Spec2-Adapters-Morphic-Tests/SpMorphicListAdapterTest.class.st

@@ -0,0 +1,54 @@
+Class {
+	#name : 'SpMorphicListAdapterTest',
+	#superclass : 'TestCase',
+	#instVars : [
+		'presenter'
+	],
+	#category : 'Spec2-Adapters-Morphic-Tests',
+	#package : 'Spec2-Adapters-Morphic-Tests'
+}
+
+{ #category : 'private' }
+SpMorphicListAdapterTest >> configureList: aNumber [
+
+	presenter := SpListPresenter new
+		items: (1 to: aNumber);
+		yourself.
+
+]
+
+{ #category : 'running' }
+SpMorphicListAdapterTest >> tearDown [
+
+	presenter delete.
+	super tearDown.
+]
+
+{ #category : 'tests' }
+SpMorphicListAdapterTest >> testScrollToIndexInvisibleScrollbars [
+
+	self configureList: 5.
+	presenter open.
+	presenter scrollToIndex: 100.
+	self 
+		assert: presenter scrollIndex
+		equals: 1.
+]
+
+{ #category : 'tests' }
+SpMorphicListAdapterTest >> testScrollToIndexVisibleScrollbars [
+
+	self configureList: 100.
+	presenter 
+		open;
+		withWindowDo: [ : w | w resize: (200 @ 400) scaledByDisplayScaleFactor ].
+	self 
+		assert: presenter scrollIndex
+		equals: 1.
+
+	presenter scrollToIndex: 50.
+
+	self 
+		assert: presenter scrollIndex > 1
+		description: 'For now we only check if the scroller worked, the CI returns 39 but running the test interactively returns 38 without loading preferences'
+]

src/Spec2-Adapters-Morphic-Tests/SpMorphicScrollableAdapterTest.class.st

@@ -0,0 +1,81 @@
+Class {
+	#name : 'SpMorphicScrollableAdapterTest',
+	#superclass : 'TestCase',
+	#instVars : [
+		'scrollable',
+		'presenter'
+	],
+	#category : 'Spec2-Adapters-Morphic-Tests',
+	#package : 'Spec2-Adapters-Morphic-Tests'
+}
+
+{ #category : 'running' }
+SpMorphicScrollableAdapterTest >> configureBasicContainer: aNumber [
+
+	| boxLayout widgets |
+	boxLayout := SpBoxLayout newVertical.
+	widgets := (1 to: aNumber) collect: [ : i | 
+		boxLayout add: (SpButtonPresenter new label: i asString; yourself) ].
+
+	presenter := SpPresenter new
+		layout: (scrollable := SpScrollableLayout new
+			child:(SpPresenter new
+				layout: boxLayout;
+				yourself);
+			yourself);
+		yourself.
+
+]
+
+{ #category : 'running' }
+SpMorphicScrollableAdapterTest >> tearDown [
+
+	presenter delete.
+	super tearDown.
+]
+
+{ #category : 'tests' }
+SpMorphicScrollableAdapterTest >> testVScrollToAfterOpen100SubPresenters [
+
+	| adapterWidget |
+
+	self configureBasicContainer: 100.
+	presenter open.
+	scrollable withAdapterDo: [ : a | a widget height: 270 ].
+
+	self assert: presenter isDisplayed.
+	self assert: presenter isVisible.
+
+	scrollable scrollTo: 0.1 @ 2.
+	adapterWidget := scrollable adapter widget.
+	self assert: adapterWidget vScrollbarValue closeTo: 0.74074074074074.
+
+	scrollable scrollTo: 0.5 @ 2.
+	adapterWidget := scrollable adapter widget.
+	self assert: adapterWidget vScrollbarValue closeTo: 0.74074074074074
+]
+
+{ #category : 'tests' }
+SpMorphicScrollableAdapterTest >> testVScrollToAfterOpen500SubPresenters [
+
+	| adapterWidget |
+
+	self configureBasicContainer: 500.
+	presenter open.
+	scrollable withAdapterDo: [ : a | a widget height: 270 ].
+	scrollable scrollTo: 0.1 @ 2.
+	adapterWidget := scrollable adapter widget.
+	self assert: adapterWidget vScrollbarValue closeTo: 0.74074074074074
+]
+
+{ #category : 'tests' }
+SpMorphicScrollableAdapterTest >> testVScrollToBeforeOpen100SubPresenters [
+
+	| adapterWidget |
+
+	self configureBasicContainer: 100.
+	scrollable scrollTo: 0.1 @ 2.
+	presenter open.
+	adapterWidget := scrollable adapter widget.
+	self assert: adapterWidget vScrollbarValue closeTo: 0.0
+]

src/Spec2-Adapters-Morphic/SpAbstractMorphicListAdapter.class.st

@@ -124,6 +124,7 @@ SpAbstractMorphicListAdapter >> transferFrom: aTransferMorph event: anEvent [
 	rowAndColumn := self widget container rowAndColumnIndexContainingPoint: anEvent position.
 	^ SpDragAndDropTransferToList new
 		passenger: aTransferMorph passenger;
+		shouldCopy: aTransferMorph shouldCopy;
 		index: (rowAndColumn first ifNil: [ 0 ]);
 		yourself
 ]

src/Spec2-Adapters-Morphic/SpDialogWindowMorph.class.st

@@ -6,8 +6,7 @@ Class {
 	#name : 'SpDialogWindowMorph',
 	#superclass : 'DialogWindowMorph',
 	#instVars : [
-		'toolbar',
-		'toolbarMorph'
+		'toolbar'
 	],
 	#category : 'Spec2-Adapters-Morphic-Support',
 	#package : 'Spec2-Adapters-Morphic',
@@ -76,13 +75,6 @@ SpDialogWindowMorph >> okAction: aBlock [
 	self toolbar okAction: aBlock 
 ]
 
-{ #category : 'accessing' }
-SpDialogWindowMorph >> removeToolbar [
-
-	toolbarMorph ifNil: [ ^ self ].
-	self submorphs last removeMorph: toolbarMorph
-]
-
 { #category : 'protocol' }
 SpDialogWindowMorph >> setToolbarFrom: aBlock [
 	| newToolbar |
@@ -103,18 +95,11 @@ SpDialogWindowMorph >> toolbar: anObject [
 	| content |
 
 	toolbar := anObject.
-	toolbarMorph 
-		ifNotNil: [
-			self removeToolbar.
-			toolbarMorph := self newButtonRow.
-			self submorphs last addMorphBack: toolbarMorph ]
-		ifNil: [
-			toolbarMorph := self newButtonRow.   
-			self removeMorph: (content := self submorphs last).
-			self 
-				addMorph: (self newDialogPanel 
-					addMorphBack: content; 
-					addMorphBack: toolbarMorph; 
-					yourself) 
-				frame: (0 @ 0 corner: 1 @ 1) ]
+	self removeMorph: (content := self submorphs last).
+	self 
+		addMorph: (self newDialogPanel 
+			addMorphBack: content; 
+			addMorphBack: self newButtonRow; 
+			yourself) 
+		frame: (0 @ 0 corner: 1 @ 1)
 ]

src/Spec2-Adapters-Morphic/SpDragAndDropTransfer.class.st

@@ -2,7 +2,8 @@ Class {
 	#name : 'SpDragAndDropTransfer',
 	#superclass : 'Object',
 	#instVars : [
-		'passenger'
+		'passenger',
+		'shouldCopy'
 	],
 	#category : 'Spec2-Adapters-Morphic-Support',
 	#package : 'Spec2-Adapters-Morphic',
@@ -20,3 +21,15 @@ SpDragAndDropTransfer >> passenger: anObject [
 
 	passenger := anObject
 ]
+
+{ #category : 'accessing' }
+SpDragAndDropTransfer >> shouldCopy [
+
+	^ shouldCopy
+]
+
+{ #category : 'accessing' }
+SpDragAndDropTransfer >> shouldCopy: anObject [
+
+	shouldCopy := anObject
+]