sync

.github/workflows/spec.yml

@@ -6,9 +6,9 @@ env:
 
 on:
   push:
-    branches: [ Pharo12, dev-1.0 ]
+    branches: [ Pharo12, dev-3.0 ]
   pull_request:
-    branches: [ Pharo12, dev-1.0 ]
+    branches: [ Pharo12, dev-3.0 ]
 
   # Allows you to run this workflow manually from the Actions tab
   workflow_dispatch:
@@ -23,11 +23,11 @@ jobs:
     runs-on: ${{ matrix.os }}
     name: ${{ matrix.smalltalk }} on ${{ matrix.os }}
     steps:
-      - uses: actions/checkout@v3
+      - uses: actions/checkout@v2
       - name: Setup smalltalkCI
         uses: hpi-swa/setup-smalltalkCI@v1
         with:
-          smalltalk-image: ${{ matrix.smalltalk }}
+          smalltalk-version: ${{ matrix.smalltalk }}
       - name: Load Image and Run Tests
         run: smalltalkci -s ${{ matrix.smalltalk }}
         timeout-minutes: 15

src/BaselineOfSpecCore/BaselineOfSpecCore.class.st

@@ -23,6 +23,10 @@ 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') ];

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

@@ -0,0 +1,43 @@
+Class {
+	#name : #SpAlexandrieMorph,
+	#superclass : #Morph,
+	#instVars : [
+		'surface',
+		'drawBlock',
+		'lastExtent'
+	],
+	#category : #'Spec2-Adapters-Morphic-Alexandrie-Base'
+}
+
+{ #category : #accessing }
+SpAlexandrieMorph >> drawBlock: aBlock [
+
+	drawBlock := aBlock
+]
+
+{ #category : #drawing }
+SpAlexandrieMorph >> drawOn: aMorphicCanvas [
+
+	self redraw.
+	self surface 
+		displayOnMorphicCanvas: aMorphicCanvas 
+		at: bounds origin
+]
+
+{ #category : #drawing }
+SpAlexandrieMorph >> redraw [
+
+	self surface drawDuring: [ :canvas | 
+		drawBlock 
+			cull: canvas
+			cull: (0@0 extent: self extent) ]
+]
+
+{ #category : #accessing }
+SpAlexandrieMorph >> surface [
+
+	lastExtent = self extent ifFalse: [ surface := nil ].
+	^ surface ifNil: [ 
+		lastExtent := self extent.
+		surface := AthensCairoSurface extent: self extent ]
+]

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

@@ -0,0 +1,34 @@
+Class {
+	#name : #SpMorphicAlexandrieAdapter,
+	#superclass : #SpAbstractMorphicAdapter,
+	#category : #'Spec2-Adapters-Morphic-Alexandrie-Base'
+}
+
+{ #category : #factory }
+SpMorphicAlexandrieAdapter >> buildWidget [
+
+	| instance |
+	instance := SpAthensMorph new.
+	self presenter whenDrawBlockChangedDo: [ :newBlock | 
+		instance drawBlock: newBlock ].
+	self presenter whenExtentChangedDo: [ :newExtent | 
+		instance extent: newExtent ].
+	instance extent: self presenter surfaceExtent.
+	instance drawBlock: self presenter drawBlock.
+	instance setBalloonText: self model help.
+	self presenter whenHelpChangedDo: [ 
+		instance setBalloonText: self model help ].
+	^ instance
+]
+
+{ #category : #drawing }
+SpMorphicAlexandrieAdapter >> redraw [
+
+	widget redraw
+]
+
+{ #category : #accessing }
+SpMorphicAlexandrieAdapter >> surface [
+
+	^ widget surface
+]

src/Spec2-Adapters-Morphic-Alexandrie/package.st

@@ -0,0 +1 @@
+Package { #name : #'Spec2-Adapters-Morphic-Alexandrie' }

src/Spec2-Adapters-Morphic-ListView/SpMorphicListViewAdapter.class.st

@@ -0,0 +1,52 @@
+"
+A morphic adapter for `SpListViewPresenter`
+"
+Class {
+	#name : 'SpMorphicListViewAdapter',
+	#superclass : 'SpMorphicListAdapter',
+	#category : 'Spec2-Adapters-Morphic-ListView',
+	#package : 'Spec2-Adapters-Morphic-ListView'
+}
+
+{ #category : 'factory' }
+SpMorphicListViewAdapter >> buildWidget [
+	| datasource |
+
+	datasource := self newDataSource.
+	datasource model: self model.
+	widget := self newTableWith: datasource.
+
+	self presenter whenModelChangedDo: [ widget refresh ].
+	self presenter whenSelectionChangedDo: [ self refreshWidgetSelection ].
+	self presenter selection whenChangedDo: [ self refreshWidgetSelection ].
+
+	self refreshWidgetSelection.
+	self configureScrolling.
+
+	^ widget
+]
+
+{ #category : 'factory' }
+SpMorphicListViewAdapter >> newDataSource [
+
+	^ SpMorphicListViewDataSource new
+]
+
+{ #category : 'factory' }
+SpMorphicListViewAdapter >> newTableWith: datasource [
+
+	^ SpFTTableMorph new
+		disableFunction;
+		dataSource: datasource;
+		hideColumnHeaders;
+		beResizable;
+		setMultipleSelection: self model isMultipleSelection;
+		dragEnabled: self dragEnabled;
+		dropEnabled: self dropEnabled;
+		setBalloonText: self help;
+		hResizing: #spaceFill;
+		vResizing: #spaceFill;
+		onAnnouncement: FTSelectionChanged send: #selectionChanged: to: self;
+		onAnnouncement: FTStrongSelectionChanged send: #strongSelectionChanged: to: self;
+		yourself
+]

src/Spec2-Adapters-Morphic-ListView/SpMorphicListViewDataSource.class.st

@@ -0,0 +1,33 @@
+"
+A morphic datasource for `SpListViewPresenter`, to be used on the `SpMorphicListViewAdapter`.
+"
+Class {
+	#name : 'SpMorphicListViewDataSource',
+	#superclass : 'SpMorphicListDataSource',
+	#category : 'Spec2-Adapters-Morphic-ListView',
+	#package : 'Spec2-Adapters-Morphic-ListView'
+}
+
+{ #category : 'accessing' }
+SpMorphicListViewDataSource >> cellColumn: column row: rowIndex [
+	| cell contentPresenter |
+
+	cell := FTCellMorph new.
+
+	contentPresenter := self model setupAction value: self model.
+	self model bindAction 
+		value: contentPresenter
+		value: (self elementAt: rowIndex).
+
+	^ cell addMorphBack: contentPresenter build
+]
+
+{ #category : 'accessing' }
+SpMorphicListViewDataSource >> headerColumn: column [
+
+	column id ifNil: [ ^ nil ]. 
+	^ FTCellMorph new 
+		listCentering: #left;
+		addMorph: column id asMorph asReadOnlyMorph;
+		yourself
+]

src/Spec2-Adapters-Morphic-ListView/package.st

@@ -0,0 +1 @@
+Package { #name : 'Spec2-Adapters-Morphic-ListView' }

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

@@ -130,8 +130,8 @@ SpAbstractMorphicAdapter >> applyStyle: morph [
 { #category : 'initialization' }
 SpAbstractMorphicAdapter >> applyVisibility [
 
-	"It may happen that some presenters use generic adapters and they do not have an associated presenter.
-	In that case, do not manage visibility..."
+	"It may happen that some presenters use generic adapters and they do not have an 
+	associated presenter. In that case, do not manage visibility..."
 	self presenter ifNil: [ ^ self ].
 
 	self widget visible: self presenter isVisible.
@@ -335,7 +335,7 @@ SpAbstractMorphicAdapter >> installFocusReceivedEvent: anEvent to: aWidget [
 
 	aWidget announcer
 		when: MorphGotFocus
-		do: [ anEvent action value ]
+		do: [ anEvent action cull: anEvent ]
 		for: self
 ]
 
@@ -695,8 +695,10 @@ SpAbstractMorphicAdapter >> vSpaceFill [
 { #category : 'protocol' }
 SpAbstractMorphicAdapter >> when: anAnnouncement do: aBlock [
 
-	self widgetDo: [ :w | w announcer
-		when: anAnnouncement do: aBlock ]
+	self widgetDo: [ :w | 
+		w announcer
+			when: anAnnouncement 
+			do: aBlock ]
 ]
 
 { #category : 'emulating' }

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

@@ -41,19 +41,19 @@ SpAbstractMorphicListAdapter >> addKeyBindingsTo: aWidget [
 
 { #category : 'scrolling' }
 SpAbstractMorphicListAdapter >> configureScrolling [
-	self presenter verticalAlignment
-		whenChangedDo: [ widget
-				scrollToIndex: self presenter verticalAlignment desiredVisibleRow ].
-			
-	self presenter
-		whenDisplayDo: [ widget
-				scrollToIndex: self presenter verticalAlignment desiredVisibleRow.
-			self scrollingChanged ].
+	| vAlignment |
+
+	vAlignment := self presenter verticalAlignment.
+	vAlignment whenChangedDo: [ 
+		widget scrollToIndex: vAlignment desiredVisibleRow ].
+	self presenter whenDisplayDo: [ 
+		widget scrollToIndex: vAlignment desiredVisibleRow.
+		self scrollingChanged ].
 
 	widget
 		onAnnouncement: FTScrollingChanged
 		send: #scrollingChanged
-		to: self.
+		to: self
 ]
 
 { #category : 'widget API' }

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

@@ -39,6 +39,15 @@ SpMorphicBackend >> forceDefer: aBlock [
 	UIManager default defer: aBlock
 ]
 
+{ #category : 'ui - dialogs' }
+SpMorphicBackend >> inform: aString [
+
+	(ProvideAnswerNotification signal: aString) ifNotNil: [ :answer | ^ true ].
+	GrowlMorph
+		openWithLabel: 'Information' translated
+		contents: aString
+]
+
 { #category : 'private - notifying' }
 SpMorphicBackend >> notifyError: aSpecNotification [
 
@@ -57,13 +66,13 @@ SpMorphicBackend >> notifyInfo: aSpecNotification [
 		contents: aSpecNotification message
 ]
 
-{ #category : 'ui dialogs' }
+{ #category : 'ui - dialogs' }
 SpMorphicBackend >> selectDirectoryTitle: aString [
 
 	^ UIManager default chooseDirectory: aString path: ''
 ]
 
-{ #category : 'ui dialogs' }
+{ #category : 'ui - dialogs' }
 SpMorphicBackend >> selectFileTitle: aString [
 
 	^ UIManager default

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

@@ -38,7 +38,9 @@ SpMorphicBaseBoxLayout >> applyVerticalHomogeneousLayout: aMorph in: aRect [
 		self error: 'It does not looks like a spec box panel' ].
 
 	allMorphs := aMorph submorphs flatCollect: [ :each | each submorphs ].
-	elementHeight := (aRect height - (self borderWidth * 2) - (self spacing * (allMorphs size - 1)) / (allMorphs size max: 1)) floor.
+	elementHeight := (aRect height 
+		- (self borderWidth * 2) 
+		- (self spacing * (allMorphs size - 1)) / (allMorphs size max: 1)) floor.
 
 	allMorphs do: [ :each | 
 		each minHeight: elementHeight ]