Merge pull request #1565 from pharo-spec/dev-3.0

merge latest

src/BaselineOfSpecCore/BaselineOfSpecCore.class.st

@@ -55,13 +55,15 @@ BaselineOfSpecCore >> baseline: spec [
 		'Spec2-Core' 
 		'Spec2-Dialogs' 
 		'Spec2-CommandLine' 
-		'Spec2-Adapters-Stub' 
+		'Spec2-Adapters-Stub'
+		'Spec2-Adapters-Morphic-ListView'
+		'Spec2-ListView'  
 		'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').
+	spec group: 'Tests' with: #('Core' 'Spec2-Tests' 'Spec2-Commander2-Tests' 'Spec2-ListView-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

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

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

@@ -1,14 +1,16 @@
 Class {
-	#name : #SpMorphicAlexandrieAdapter,
-	#superclass : #SpAbstractMorphicAdapter,
-	#category : #'Spec2-Adapters-Morphic-Alexandrie-Base'
+	#name : 'SpMorphicAlexandrieAdapter',
+	#superclass : 'SpAbstractMorphicAdapter',
+	#category : 'Spec2-Adapters-Morphic-Alexandrie-Base',
+	#package : 'Spec2-Adapters-Morphic-Alexandrie',
+	#tag : 'Base'
 }
 
-{ #category : #factory }
+{ #category : 'factory' }
 SpMorphicAlexandrieAdapter >> buildWidget [
-
 	| instance |
-	instance := SpAthensMorph new.
+
+	instance := SpAlexandrieMorph new.
 	self presenter whenDrawBlockChangedDo: [ :newBlock | 
 		instance drawBlock: newBlock ].
 	self presenter whenExtentChangedDo: [ :newExtent | 
@@ -21,13 +23,13 @@ SpMorphicAlexandrieAdapter >> buildWidget [
 	^ instance
 ]
 
-{ #category : #drawing }
+{ #category : 'drawing' }
 SpMorphicAlexandrieAdapter >> redraw [
 
 	widget redraw
 ]
 
-{ #category : #accessing }
+{ #category : 'accessing' }
 SpMorphicAlexandrieAdapter >> surface [
 
 	^ widget surface

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

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

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

@@ -21,13 +21,3 @@ SpMorphicListViewDataSource >> cellColumn: column row: 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/SpDialogWindowMorph.class.st

@@ -6,7 +6,8 @@ Class {
 	#name : 'SpDialogWindowMorph',
 	#superclass : 'DialogWindowMorph',
 	#instVars : [
-		'toolbar'
+		'toolbar',
+		'toolbarMorph'
 	],
 	#category : 'Spec2-Adapters-Morphic-Support',
 	#package : 'Spec2-Adapters-Morphic',
@@ -75,6 +76,13 @@ 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 |
@@ -95,11 +103,18 @@ SpDialogWindowMorph >> toolbar: anObject [
 	| content |
 
 	toolbar := anObject.
-	self removeMorph: (content := self submorphs last).
-	self 
-		addMorph: (self newDialogPanel 
-			addMorphBack: content; 
-			addMorphBack: self newButtonRow; 
-			yourself) 
-		frame: (0 @ 0 corner: 1 @ 1)
+	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) ]
 ]

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

@@ -33,6 +33,41 @@ SpMorphicBackend >> defer: aBlock [
 	UIManager default defer: aBlock
 ]
 
+{ #category : 'accessing' }
+SpMorphicBackend >> dropListClass [
+
+	^ SpDropListPresenter
+]
+
+{ #category : 'private - dialogs' }
+SpMorphicBackend >> executeOpenDirectoryDialog: aFileDialog [
+
+	^ StOpenDirectoryPresenter new
+		defaultFolder: (aFileDialog path ifNil: [ StFileSystemModel defaultDirectory ]);
+		title: (aFileDialog title ifNil: [ 'Choose Directory' translated ]);
+		openModal;
+		selectedEntry
+]
+
+{ #category : 'private - dialogs' }
+SpMorphicBackend >> executeOpenFileDialog: aFileDialog [
+	| dialog |
+
+	dialog := self newFileDialogFor: aFileDialog.
+	^ dialog openModal answer 
+		ifNotNil: [ :aString | aString asFileReference ]
+]
+
+{ #category : 'private - dialogs' }
+SpMorphicBackend >> executeSaveFileDialog: aFileDialog [
+	| dialog |
+
+	dialog := self newFileDialogFor: aFileDialog.
+	dialog answerSaveFile.
+	^ dialog openModal answer 
+		ifNotNil: [ :aString | aString asFileReference ]
+]
+
 { #category : 'deferred message' }
 SpMorphicBackend >> forceDefer: aBlock [
 
@@ -48,6 +83,29 @@ SpMorphicBackend >> inform: aString [
 		contents: aString
 ]
 
+{ #category : 'accessing' }
+SpMorphicBackend >> listClass [
+
+	^ SpListPresenter
+]
+
+{ #category : 'private - dialogs' }
+SpMorphicBackend >> newFileDialogFor: aFileDialog [
+	| dialog dialogClass |
+
+	dialogClass := aFileDialog isOpenFile
+		ifTrue: [ StOpenFilePresenter ]
+		ifFalse: [ StOpenDirectoryPresenter ].
+	dialog := dialogClass for: aFileDialog.
+
+	aFileDialog path ifNotNil: [ :folder | dialog openFolder: folder ].
+	aFileDialog filters ifNotEmpty: [ :filters |
+		dialog fileNavigationSystem 
+			filter: (StCustomExtensionsFilter extensions: { filters }) ].
+
+	^ dialog
+]
+
 { #category : 'private - notifying' }
 SpMorphicBackend >> notifyError: aSpecNotification [
 
@@ -67,22 +125,34 @@ SpMorphicBackend >> notifyInfo: aSpecNotification [
 ]
 
 { #category : 'ui - dialogs' }
-SpMorphicBackend >> selectDirectoryTitle: aString [
-
-	^ UIManager default chooseDirectory: aString path: ''
-]
-
-{ #category : 'ui - dialogs' }
-SpMorphicBackend >> selectFileTitle: aString [
+SpMorphicBackend >> openFileDialog: aFileDialog [
 
-	^ UIManager default
-		  chooseExistingFileReference: aString
-		  extensions: nil
-		  path: ''
+	aFileDialog isOpenFile ifTrue: [ ^ self executeOpenFileDialog: aFileDialog ].
+	aFileDialog isOpenDirectory ifTrue: [ ^ self executeOpenDirectoryDialog: aFileDialog ].
+
+	^ self executeSaveFileDialog: aFileDialog
 ]
 
 { #category : 'display' }
 SpMorphicBackend >> showWaitCursorWhile: aBlock inApplication: anApplication [
 
 	Cursor wait showWhile: aBlock
 ]
+
+{ #category : 'accessing' }
+SpMorphicBackend >> tableClass [
+
+	^ SpTablePresenter
+]
+
+{ #category : 'accessing' }
+SpMorphicBackend >> treeClass [
+
+	^ SpTreePresenter	
+]
+
+{ #category : 'accessing' }
+SpMorphicBackend >> treeTableClass [
+
+	^ SpTreeTablePresenter
+]

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

@@ -147,9 +147,13 @@ SpMorphicButtonAdapter >> keyStroke: anEvent fromMorph: aMorph [
 
 { #category : 'widget API' }
 SpMorphicButtonAdapter >> label [
+	| labelString |
+
+	labelString := self presenter label 
+		ifNotNil: [ :aString | aString withAccentuatedCharacter: self presenter shortcutCharacter ].
 
 	^ self 
-		buildLabel: (self presenter label withAccentuatedCharacter: self presenter shortcutCharacter) 
+		buildLabel: labelString 
 		withIcon: self presenter icon
 ]
 

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

@@ -9,16 +9,27 @@ Class {
 	#tag : 'Base'
 }
 
+{ #category : 'private' }
+SpMorphicDialogWindowAdapter >> addButtonsDecorationTo: widgetToBuild [
+
+	widgetToBuild setToolbarFrom: [ self buildButtonBar ].
+	self model buttons ifNotEmpty: [ 
+		self presenter defaultButton 
+			ifNotNil: [ :aButton | aButton adapter setAsDefault ] ]
+]
+
 { #category : 'private' }
 SpMorphicDialogWindowAdapter >> addPresenterIn: widgetToBuild withSpecLayout: aSpec [
 	"I replace the mainPanel (which contains contents and button bar) because like that I get the 
 	 status bar at the end (where it belongs)"
 
 	super addPresenterIn: widgetToBuild withSpecLayout: aSpec.
-	self model buttons ifNotEmpty: [ 	
-		widgetToBuild setToolbarFrom: [ self buildButtonBar ].
-		self presenter defaultButton 
-			ifNotNil: [ :aButton | aButton adapter setAsDefault ] ]
+	self presenter hasButtonDecorations 
+		ifTrue: [ self addButtonsDecorationTo: widgetToBuild ].
+	self presenter whenButtonDecorationsChangedDo: [ :aBoolean |
+		aBoolean 
+			ifTrue: [ self addButtonsDecorationTo: widgetToBuild ]
+			ifFalse: [ widgetToBuild removeToolbar ] ]
 ]
 
 { #category : 'factory' }

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

@@ -88,6 +88,12 @@ SpMorphicDropListAdapter >> setIndex: anIndex [
 	self presenter selectIndex: anIndex
 ]
 
+{ #category : 'accessing' }
+SpMorphicDropListAdapter >> styleName: aString [ 
+
+	"for compatibility with tool buttons, but not used at the moment"
+]
+
 { #category : 'factory' }
 SpMorphicDropListAdapter >> verifyInitialStatus [