Merge branch 'Pharo13' into 1670-Introduce-a-common-stCommand-superclass

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

@@ -0,0 +1,68 @@
+Class {
+	#name : 'SpMorphicColumnViewAdapter',
+	#superclass : 'SpMorphicTableAdapter',
+	#category : 'Spec2-Adapters-Morphic-ListView',
+	#package : 'Spec2-Adapters-Morphic-ListView'
+}
+
+{ #category : 'factory' }
+SpMorphicColumnViewAdapter >> addModelTo: tableMorph [
+
+	"no search on column view (it has to be provided elsewhere)"
+	tableMorph disableFunction.
+
+	self model columns do: [ :each |
+		tableMorph addColumn: (self newColumnFrom: each) ].
+	self ensureAtLeastOneColumnIn: tableMorph.
+
+	self isResizable 
+		ifTrue: [ tableMorph beResizable ] 
+		ifFalse: [ tableMorph beNotResizable ].
+
+	tableMorph setMultipleSelection: self model isMultipleSelection.
+
+	self refreshShowColumnHeaders.
+	self refreshWidgetSelection.
+
+	self presenter whenModelChangedDo: [ self refreshModel ].
+	self presenter whenColumnsChangedDo: [ self refreshColumnsInWidget ].
+
+	tableMorph setBalloonText: self help.
+
+	self configureScrolling.
+
+	tableMorph
+		onAnnouncement: FTSelectionChanged
+			send: #selectionChanged:
+			to: self;
+		onAnnouncement: FTStrongSelectionChanged
+			send: #strongSelectionChanged:
+			to: self.
+
+	tableMorph dataSource: self newDataSource.
+
+	self presenter whenSearchEnabledChangedDo: [ 
+		self updateSearch ]
+]
+
+{ #category : 'testing' }
+SpMorphicColumnViewAdapter >> isResizable [
+
+	^ self presenter isResizable
+]
+
+{ #category : 'private - factory' }
+SpMorphicColumnViewAdapter >> newColumnFrom: aColumnViewColumn [
+
+	^ (SpMorphicColumnViewColumn on: aColumnViewColumn)
+		width: aColumnViewColumn width;
+		yourself
+]
+
+{ #category : 'private - factory' }
+SpMorphicColumnViewAdapter >> newDataSource [ 
+
+	^ SpMorphicColumnViewDataSource new
+		model: self presenter;
+		yourself
+]

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

@@ -0,0 +1,30 @@
+Class {
+	#name : 'SpMorphicColumnViewColumn',
+	#superclass : 'SpMorphicTableColumn',
+	#category : 'Spec2-Adapters-Morphic-ListView',
+	#package : 'Spec2-Adapters-Morphic-ListView'
+}
+
+{ #category : 'private' }
+SpMorphicColumnViewColumn >> bindAction [
+
+	^ self model bindAction
+]
+
+{ #category : 'testing' }
+SpMorphicColumnViewColumn >> isExpandable [
+
+	^ self model isExpand
+]
+
+{ #category : 'accessing' }
+SpMorphicColumnViewColumn >> model: aColumnViewColumn [
+
+	model := aColumnViewColumn
+]
+
+{ #category : 'private' }
+SpMorphicColumnViewColumn >> setupAction [
+
+	^ self model setupAction
+]

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

@@ -0,0 +1,45 @@
+Class {
+	#name : 'SpMorphicColumnViewDataSource',
+	#superclass : 'SpMorphicTableDataSource',
+	#instVars : [
+		'rowHeights'
+	],
+	#category : 'Spec2-Adapters-Morphic-ListView',
+	#package : 'Spec2-Adapters-Morphic-ListView'
+}
+
+{ #category : 'accessing' }
+SpMorphicColumnViewDataSource >> cellColumn: column row: rowIndex [
+	| cell contentPresenter contentMorph |
+
+	cell := FTCellMorph new.
+
+	contentPresenter := column setupAction value: self model.	
+	column bindAction 
+		value: contentPresenter
+		value: (self elementAt: rowIndex).
+
+	contentMorph := contentPresenter build.
+
+	"register for height"
+	rowHeights at: rowIndex put: contentMorph height.
+
+	self setHeaderColumnLazyProperties: column.
+
+	^ cell addMorphBack: contentMorph
+]
+
+{ #category : 'initialization' }
+SpMorphicColumnViewDataSource >> initialize [
+
+	super initialize.
+	rowHeights := Dictionary new
+]
+
+{ #category : 'accessing' }
+SpMorphicColumnViewDataSource >> rowHeight: index [
+
+	^ rowHeights 
+		at: index 
+		ifAbsent: [ super rowHeight: index ]
+]

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

@@ -14,8 +14,11 @@ SpMorphicListViewAdapter >> buildWidget [
 
 	datasource := self newDataSource.
 	datasource model: self model.
+
 	widget := self newTableWith: datasource.
-
+	"no search on list view (it has to be provided elsewhere)"
+	widget disableFunction. 
+
 	self presenter whenModelChangedDo: [ widget refresh ].
 	self presenter whenSelectionChangedDo: [ self refreshWidgetSelection ].
 	self presenter selection whenChangedDo: [ self refreshWidgetSelection ].
@@ -36,7 +39,6 @@ SpMorphicListViewAdapter >> newDataSource [
 SpMorphicListViewAdapter >> newTableWith: datasource [
 
 	^ SpFTTableMorph new
-		beRowNotHomogeneous;
 		disableFunction;
 		dataSource: datasource;
 		hideColumnHeaders;

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

@@ -24,7 +24,7 @@ SpMorphicListViewDataSource >> cellColumn: column row: rowIndex [
 
 	contentMorph := contentPresenter build.
 
-	"register wor height"
+	"register for height"
 	rowHeights at: rowIndex put: contentMorph height.
 
 	^ cell addMorphBack: contentMorph

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

@@ -0,0 +1,24 @@
+Class {
+	#name : 'SpMorphicTreeColumnViewAdapter',
+	#superclass : 'SpMorphicTreeTableAdapter',
+	#category : 'Spec2-Adapters-Morphic-ListView',
+	#package : 'Spec2-Adapters-Morphic-ListView'
+}
+
+{ #category : 'private - factory' }
+SpMorphicTreeColumnViewAdapter >> newColumnFrom: aTableColumn [
+
+	^ (SpMorphicColumnViewColumn on: aTableColumn)
+		width: aTableColumn width;
+		yourself
+]
+
+{ #category : 'private - factory' }
+SpMorphicTreeColumnViewAdapter >> newDataSource [ 
+
+	^ SpMorphicTreeColumnViewDataSource new
+		model: self model; 
+		rootItem: (self rootForItems: self model roots);
+		childrenBlock: [ :data :item | self model childrenFor: data ];
+		yourself
+]

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

@@ -0,0 +1,57 @@
+Class {
+	#name : 'SpMorphicTreeColumnViewDataSource',
+	#superclass : 'SpMorphicTreeTableDataSource',
+	#instVars : [
+		'rowHeights'
+	],
+	#category : 'Spec2-Adapters-Morphic-ListView',
+	#package : 'Spec2-Adapters-Morphic-ListView'
+}
+
+{ #category : 'accessing' }
+SpMorphicTreeColumnViewDataSource >> cellColumn: column row: rowIndex [
+	| cell item contentPresenter contentMorph |
+
+	item := self elementAt: rowIndex.
+
+	cell := FTIndentedCellMorph new.
+	(self isFirstColumn: column) ifTrue: [
+		cell indentBy: (self cellIndentFor: item).
+		cell addMorphBack: (self buttonFor: item) ].
+
+	contentPresenter := column setupAction value: self model.	
+	column bindAction 
+		value: contentPresenter
+		value: item data.
+
+	contentMorph := contentPresenter build.
+
+	"register for height"
+	rowHeights at: rowIndex put: contentMorph height.
+
+	self setHeaderColumnLazyProperties: column.
+
+	^ cell addMorphBack: contentMorph
+]
+
+{ #category : 'initialization' }
+SpMorphicTreeColumnViewDataSource >> initialize [
+
+	super initialize.
+	rowHeights := Dictionary new
+]
+
+{ #category : 'accessing' }
+SpMorphicTreeColumnViewDataSource >> rowHeight: index [
+
+	^ rowHeights 
+		at: index 
+		ifAbsent: [ super rowHeight: index ]
+]
+
+{ #category : 'testing' }
+SpMorphicTreeColumnViewDataSource >> shouldDisplayExpandableArrowFor: item [
+
+	^ (self canDisplayChildrenOf: item) 
+		and: [ item hasChildren ]
+]

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

@@ -0,0 +1,85 @@
+Class {
+	#name : 'SpMorphicTreeListViewAdapter',
+	#superclass : 'SpMorphicTreeAdapter',
+	#category : 'Spec2-Adapters-Morphic-ListView',
+	#package : 'Spec2-Adapters-Morphic-ListView'
+}
+
+{ #category : 'factory' }
+SpMorphicTreeListViewAdapter >> addModelTo: tableMorph [
+
+	tableMorph addColumn: (self newColumnFrom: self defaultColumn).
+
+	self presenter selection isMultipleSelection ifTrue: [  
+		tableMorph beMultipleSelection ].
+
+	self isShowingColumnHeaders 
+		ifTrue: [ tableMorph showColumnHeaders ] 
+		ifFalse: [ tableMorph hideColumnHeaders ].
+
+	self isSearchEnabled
+		ifTrue: [ tableMorph enableSearch ]
+		ifFalse: [ tableMorph disableFunction ].
+
+	tableMorph setBalloonText: self model help.
+
+	tableMorph dataSource: self newDataSource.
+
+	self presenter selection isEmpty 
+		ifFalse: [ self updateSelectionOf: tableMorph ].
+
+	self presenter whenSelectionChangedDo: [ 
+		self updateSelectionOf: tableMorph ].
+
+	self presenter whenRootsChangedDo: [ 
+		tableMorph selectIndexes: #().
+		tableMorph dataSource: self newDataSource ].
+
+	tableMorph
+		onAnnouncement: FTSelectionChanged
+			send: #selectionChanged:
+			to: self;
+		onAnnouncement: FTStrongSelectionChanged
+			send: #strongSelectionChanged:
+			to: self
+]
+
+{ #category : 'factory' }
+SpMorphicTreeListViewAdapter >> defaultColumn [
+
+	^ SpColumnViewColumn new
+		title: self presenter headerTitle;
+		setup: self presenter setupAction;
+		bind: self presenter bindAction;
+		yourself
+]
+
+{ #category : 'testing' }
+SpMorphicTreeListViewAdapter >> isResizable [
+
+	^ false
+]
+
+{ #category : 'testing' }
+SpMorphicTreeListViewAdapter >> isShowingColumnHeaders [
+
+	^ self presenter hasHeaderTitle
+]
+
+{ #category : 'private - factory' }
+SpMorphicTreeListViewAdapter >> newColumnFrom: aTableColumn [
+
+	^ (SpMorphicColumnViewColumn on: aTableColumn)
+		width: aTableColumn width;
+		yourself
+]
+
+{ #category : 'private - factory' }
+SpMorphicTreeListViewAdapter >> newDataSource [ 
+
+	^ SpMorphicTreeColumnViewDataSource new
+		model: self model; 
+		rootItem: (self rootForItems: self model roots);
+		childrenBlock: [ :data :item | self model childrenFor: data ];
+		yourself
+]

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

@@ -658,10 +658,9 @@ SpAbstractMorphicAdapter >> takeKeyboardFocus [
 { #category : 'drag and drop' }
 SpAbstractMorphicAdapter >> transferFor: passenger from: source [
 
-	^ SpTransferPresenter new
-		transfer: passenger;
-		from: source;
-		yourself
+	^ self presenter 
+		dragTransferFor: passenger
+		from: source
 ]
 
 { #category : 'emulating' }

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

@@ -61,6 +61,12 @@ SpAbstractMorphicListAdapter >> elementAt: index [
 	^ self widget dataSource elementAt: index
 ]
 
+{ #category : 'private' }
+SpAbstractMorphicListAdapter >> hasHeaderTitle [
+
+	^ self presenter hasHeaderTitle
+]
+
 { #category : 'widget API' }
 SpAbstractMorphicListAdapter >> itemFilter [
 	^ self model itemFilter

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

@@ -17,6 +17,13 @@ SpFTTableMorph >> acceptDroppingMorph: aTransferMorph event: anEvent [
 		event: anEvent
 ]
 
+{ #category : 'api' }
+SpFTTableMorph >> disableFunction [
+
+	super disableFunction
+
+]
+
 { #category : 'drawing' }
 SpFTTableMorph >> drawKeyboardFocusOn: aCanvas [