From ad1a55ae792295c7c096e61c6d2148ce1551ddd4 Mon Sep 17 00:00:00 2001 From: Esteban Lorenzano Date: Fri, 24 Nov 2023 11:37:34 +0100 Subject: [PATCH 1/7] fixes https://github.com/pharo-project/pharo/issues/14868 --- .../SpMorphicTableCellBuilder.class.st | 44 ++++++++++++++++--- .../SpTablePresenter.extension.st | 17 +++++++ 2 files changed, 55 insertions(+), 6 deletions(-) diff --git a/src/Spec2-Adapters-Morphic/SpMorphicTableCellBuilder.class.st b/src/Spec2-Adapters-Morphic/SpMorphicTableCellBuilder.class.st index 0d175c1b..fc0d568b 100644 --- a/src/Spec2-Adapters-Morphic/SpMorphicTableCellBuilder.class.st +++ b/src/Spec2-Adapters-Morphic/SpMorphicTableCellBuilder.class.st @@ -22,12 +22,31 @@ SpMorphicTableCellBuilder class >> on: aDataSource [ { #category : 'private' } SpMorphicTableCellBuilder >> addAlignmentColumn: aTableColumn item: item to: content [ + | block containerMorph alignment | - aTableColumn displayAlignment ifNotNil: [ :block | - ^ content asText addAttribute: (block cull: item) asTextAlignment ]. - - ^ content + (block := aTableColumn displayAlignment) ifNil: [ ^ content ]. + + alignment := (block cull: item) asTextAlignment. + containerMorph := Morph new + color: Color transparent; + layoutPolicy: TableLayout new; + hResizing: #spaceFill; + vResizing: #spaceFill; + borderWidth: 0; + yourself. + + alignment = TextAlignment rightFlush ifTrue: [ + containerMorph listDirection: #rightToLeft ]. + alignment = TextAlignment leftFlush ifTrue: [ + containerMorph listDirection: #leftToRight ]. + + alignment = TextAlignment centered + ifTrue: [ containerMorph addMorphBack: self newFillerMorph ]. + containerMorph addMorphBack: content asMorph asReadOnlyMorph. + alignment = TextAlignment centered + ifTrue: [ containerMorph addMorphBack: self newFillerMorph ]. + ^ containerMorph ] { #category : 'private' } @@ -146,6 +165,17 @@ SpMorphicTableCellBuilder >> item [ ^ self dataSource elementAt: self rowIndex ] +{ #category : 'private' } +SpMorphicTableCellBuilder >> newFillerMorph [ + "This is used as a helper to center text when applying alignment=centered" + + ^ Morph new + color: Color transparent; + hResizing: #spaceFill; + vResizing: #spaceFill; + yourself +] + { #category : 'accessing' } SpMorphicTableCellBuilder >> rowIndex [ ^ rowIndex @@ -268,7 +298,6 @@ SpMorphicTableCellBuilder >> visitStringColumn: aTableColumn [ content := aTableColumn readObject: item. "add properties" - content := self addAlignmentColumn: aTableColumn item: item to: content. content := self addColorColumn: aTableColumn item: item to: content. content := self addItalicColumn: aTableColumn item: item to: content. content := self addBoldColumn: aTableColumn item: item to: content. @@ -277,9 +306,12 @@ SpMorphicTableCellBuilder >> visitStringColumn: aTableColumn [ aTableColumn isEditable ifTrue: [ self visitStringColumnEditable: aTableColumn on: content ] ifFalse: [ "add cell" + "I need to calculate here alignement because I will wrap the content + into a container morph, so it needs to be the last one before applying" + content := self addAlignmentColumn: aTableColumn item: item to: content. self addCell: content column: aTableColumn. "add background (this is a special case of properties, - since background needs to be applied to the cell and not to the text)" + since background needs to be applied to the cell and not to the text)" self addBackgroundColorColumn: aTableColumn item: item toMorph: cell ] ] diff --git a/src/Spec2-Examples/SpTablePresenter.extension.st b/src/Spec2-Examples/SpTablePresenter.extension.st index 2d863414..c05797a8 100644 --- a/src/Spec2-Examples/SpTablePresenter.extension.st +++ b/src/Spec2-Examples/SpTablePresenter.extension.st @@ -96,6 +96,23 @@ SpTablePresenter class >> exampleSorting [ open ] +{ #category : '*Spec2-Examples' } +SpTablePresenter class >> exampleWithColumnAlignment [ + "Shows how we can align columns" + | column | + + column := SpStringTableColumn new + title: 'Alignments'; + evaluated: [ :object | object ]; + displayAlignment: [ :object | SpColumnAlignment perform: object ]; + yourself. + + SpTablePresenter new + items: { #right. #center. #left }; + addColumn: column; + open +] + { #category : '*Spec2-Examples' } SpTablePresenter class >> exampleWithColumnHeaders [ From 1eb572194b130d99aded1a25c73ca1888d443375 Mon Sep 17 00:00:00 2001 From: Pablo Tesone Date: Fri, 24 Nov 2023 12:09:49 +0100 Subject: [PATCH 2/7] Fix #1477 Fixing the SpApplication>>#informUser:during: was calling twice openModal and running the during block twice --- src/Spec2-Dialogs-Tests/SpDialogTest.class.st | 22 +++++++++++++++++++ src/Spec2-Dialogs/SpApplication.extension.st | 3 +-- 2 files changed, 23 insertions(+), 2 deletions(-) diff --git a/src/Spec2-Dialogs-Tests/SpDialogTest.class.st b/src/Spec2-Dialogs-Tests/SpDialogTest.class.st index 46c9d955..4c0adc34 100644 --- a/src/Spec2-Dialogs-Tests/SpDialogTest.class.st +++ b/src/Spec2-Dialogs-Tests/SpDialogTest.class.st @@ -20,6 +20,28 @@ SpDialogTest >> testInformUserDuringExecutesItsBlock [ self assert: executed. ] +{ #category : 'tests - progress bar' } +SpDialogTest >> testInformUserDuringExecutesTheBlockOnlyOnce [ + + | count | + count := 0. + SpInformUserDialog new + informUser: 'I am a text' during: [ count := count + 1 ]. + + self assert: count equals: 1 +] + +{ #category : 'tests - progress bar' } +SpDialogTest >> testInformUserDuringInSpApplicationExecutesTheBlockOnlyOnce [ + + | count | + count := 0. + SpApplication new + informUser: 'I am a text' during: [ count := count + 1 ]. + + self assert: count equals: 1 +] + { #category : 'tests - informUserDuring' } SpDialogTest >> testInformUserDuringViaApplication [ diff --git a/src/Spec2-Dialogs/SpApplication.extension.st b/src/Spec2-Dialogs/SpApplication.extension.st index 59115c33..aa6f52ec 100644 --- a/src/Spec2-Dialogs/SpApplication.extension.st +++ b/src/Spec2-Dialogs/SpApplication.extension.st @@ -36,8 +36,7 @@ SpApplication >> informUser: aString during: aBlock [ ^ self newInformUser title: aString; - informUserDuring: aBlock; - openModal + informUserDuring: aBlock ] { #category : '*Spec2-Dialogs' } From 643189c07443750b1c2006cc9a6f47838b69cd79 Mon Sep 17 00:00:00 2001 From: Marcus Denker Date: Wed, 29 Nov 2023 11:42:34 +0100 Subject: [PATCH 3/7] use valueWithReceiver: --- src/Spec2-Examples/SpExampleBrowser.class.st | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/src/Spec2-Examples/SpExampleBrowser.class.st b/src/Spec2-Examples/SpExampleBrowser.class.st index 5513c110..8cb03701 100644 --- a/src/Spec2-Examples/SpExampleBrowser.class.st +++ b/src/Spec2-Examples/SpExampleBrowser.class.st @@ -137,9 +137,7 @@ SpExampleBrowser >> runSelectedExample [ | method | method := list selectedItem entity. - method - valueWithReceiver: method methodClass instanceSide - arguments: #() + method valueWithReceiver: method methodClass instanceSide ] { #category : 'updating' } From d43a294604e1b037dfb4e5cfa4cbe9cd33ada8ad Mon Sep 17 00:00:00 2001 From: Marcus Denker Date: Wed, 29 Nov 2023 12:07:33 +0100 Subject: [PATCH 4/7] fix deprecated send --- .../SpCodeDebugItCommand.class.st | 20 +++++++++---------- 1 file changed, 10 insertions(+), 10 deletions(-) diff --git a/src/Spec2-Code-Commands/SpCodeDebugItCommand.class.st b/src/Spec2-Code-Commands/SpCodeDebugItCommand.class.st index 549c77d3..16e76eef 100644 --- a/src/Spec2-Code-Commands/SpCodeDebugItCommand.class.st +++ b/src/Spec2-Code-Commands/SpCodeDebugItCommand.class.st @@ -38,20 +38,20 @@ SpCodeDebugItCommand class >> defaultShortcutKey [ { #category : 'private' } SpCodeDebugItCommand >> compile: aStream for: anObject in: evalContext [ - | methodClass | + | methodClass | methodClass := evalContext - ifNil: [ anObject class ] - ifNotNil: [ evalContext methodClass ]. + ifNil: [ anObject class ] + ifNotNil: [ evalContext methodClass ]. ^ context class compiler - source: aStream; - class: methodClass; - context: evalContext; - requestor: context; "it should enable a visibility of current tool variables in new debugger" - noPattern: true; - failBlock: [ ^ nil ]; - compile + source: aStream; + class: methodClass; + context: evalContext; + requestor: context; "it should enable a visibility of current tool variables in new debugger" + isScripting: true; + failBlock: [ ^ nil ]; + compile ] { #category : 'private' } From cfcc509c8ad9dc19b6ff7962f0bdf372da6be127 Mon Sep 17 00:00:00 2001 From: Marcus Denker Date: Thu, 30 Nov 2023 11:29:54 +0100 Subject: [PATCH 5/7] fixes #1468 fixes #1460 --- .../SpNotebookAdapterTest.class.st | 11 +++++++---- src/Spec2-Core/SpAbstractPresenter.class.st | 4 +--- src/Spec2-Core/SpJob.class.st | 4 ++-- src/Spec2-Core/SpWindowPresenter.class.st | 5 +++-- 4 files changed, 13 insertions(+), 11 deletions(-) diff --git a/src/Spec2-Backend-Tests/SpNotebookAdapterTest.class.st b/src/Spec2-Backend-Tests/SpNotebookAdapterTest.class.st index 99e34002..25c7e90b 100644 --- a/src/Spec2-Backend-Tests/SpNotebookAdapterTest.class.st +++ b/src/Spec2-Backend-Tests/SpNotebookAdapterTest.class.st @@ -91,13 +91,16 @@ SpNotebookAdapterTest >> testSelectedPage [ { #category : 'tests' } SpNotebookAdapterTest >> testSelectingPageShouldAnnounceChangeEvent [ - | change | + | change | self adapter widget tabSelectorMorph selectedIndex: 1. - self adapter widget announcer when: SpNotebookPageChanged do: [ :ann | change := ann ]. - + self adapter widget announcer + when: SpNotebookPageChanged + do: [ :ann | change := ann ] + for: self. + self adapter widget tabSelectorMorph selectedIndex: 2. - + self assert: change oldPage model title equals: 'Mock'. self assert: change page model title equals: 'Mock2' ] diff --git a/src/Spec2-Core/SpAbstractPresenter.class.st b/src/Spec2-Core/SpAbstractPresenter.class.st index 4e56b633..eaca4d40 100644 --- a/src/Spec2-Core/SpAbstractPresenter.class.st +++ b/src/Spec2-Core/SpAbstractPresenter.class.st @@ -518,9 +518,7 @@ SpAbstractPresenter >> validateInto: aValidationReport [ { #category : 'events' } SpAbstractPresenter >> whenBuiltDo: aBlock [ - self announcer - when: SpWidgetBuilt - do: aBlock + self announcer when: SpWidgetBuilt do: aBlock for: aBlock receiver ] { #category : 'events' } diff --git a/src/Spec2-Core/SpJob.class.st b/src/Spec2-Core/SpJob.class.st index bad6dd43..60d61fb3 100644 --- a/src/Spec2-Core/SpJob.class.st +++ b/src/Spec2-Core/SpJob.class.st @@ -331,11 +331,11 @@ SpJob >> whenChangedDo: aBlock [ { #category : 'events' } SpJob >> whenEndDo: aBlock [ - self announcer when: JobEnd do: aBlock + self announcer when: JobEnd do: aBlock for: aBlock receiver ] { #category : 'events' } SpJob >> whenStartDo: aBlock [ - self announcer when: JobStart do: aBlock + self announcer when: JobStart do: aBlock for: aBlock receiver ] diff --git a/src/Spec2-Core/SpWindowPresenter.class.st b/src/Spec2-Core/SpWindowPresenter.class.st index 15b70259..fdc23372 100644 --- a/src/Spec2-Core/SpWindowPresenter.class.st +++ b/src/Spec2-Core/SpWindowPresenter.class.st @@ -689,10 +689,11 @@ SpWindowPresenter >> whenWillCloseDo: aBlock [ "Inform when window will close, allowing process before the close happen. Note that user cannot cancel the close operation using this event. `aBlock` receives one optional argument (an instance of the announcement `SpWindowWillClose`)." - - self announcer + + self announcer when: SpWindowWillClose do: aBlock + for: aBlock receiver ] { #category : 'private' } From c23dac0e91cace84e5fd21bf11f4a4796ecbfc1d Mon Sep 17 00:00:00 2001 From: Pablo Tesone Date: Fri, 1 Dec 2023 10:09:00 +0100 Subject: [PATCH 6/7] - informDuring: should return the value of the block. - Adding test --- src/Spec2-Dialogs-Tests/SpDialogTest.class.st | 8 ++++++ src/Spec2-Dialogs/SpInformUserDialog.class.st | 28 +++++++++---------- 2 files changed, 22 insertions(+), 14 deletions(-) diff --git a/src/Spec2-Dialogs-Tests/SpDialogTest.class.st b/src/Spec2-Dialogs-Tests/SpDialogTest.class.st index 4c0adc34..81c7ba77 100644 --- a/src/Spec2-Dialogs-Tests/SpDialogTest.class.st +++ b/src/Spec2-Dialogs-Tests/SpDialogTest.class.st @@ -56,6 +56,14 @@ SpDialogTest >> testInformUserDuringViaPresenter [ self shouldnt: [ SpPresenter new informUser: 'hello' during: [ (Delay forMilliseconds: 100) wait] ] raise: Error ] +{ #category : 'tests - progress bar' } +SpDialogTest >> testInformUserReturnsValueOfTheBlock [ + + | returned | + returned := SpInformUserDialog new informUser: 'hello' during: [ 42 ]. + self assert: returned equals: 42. +] + { #category : 'tests - progress bar' } SpDialogTest >> testProgressInformUserDuringExecutesItsBlock [ diff --git a/src/Spec2-Dialogs/SpInformUserDialog.class.st b/src/Spec2-Dialogs/SpInformUserDialog.class.st index bd5d5b27..a57cce3f 100644 --- a/src/Spec2-Dialogs/SpInformUserDialog.class.st +++ b/src/Spec2-Dialogs/SpInformUserDialog.class.st @@ -8,7 +8,8 @@ Class { 'title', 'label', 'progressBar', - 'openAction' + 'openAction', + 'returnValue' ], #category : 'Spec2-Dialogs', #package : 'Spec2-Dialogs' @@ -46,27 +47,24 @@ SpInformUserDialog class >> extent [ { #category : 'private - actions' } SpInformUserDialog >> afterOpenAction [ - + openAction ifNil: [ ^ self ]. - [ - [ - openAction value. - self accept ] - on: Error - fork: [ :e | - self cancel. - e pass ]. - ] fork + [ + [ + returnValue := openAction value. + self accept ] on: Error fork: [ :e | + self cancel. + e pass ] ] fork ] -{ #category : 'api' } +{ #category : 'simple dialog helpers' } SpInformUserDialog >> informUser: aString during: aBlock [ "Pay attention that the aBlock argument does not expect an argument representing the bar. Check class side example." title := aString. - self informUserDuring: [ + ^ self informUserDuring: [ aBlock value ] ] @@ -79,7 +77,9 @@ SpInformUserDialog >> informUserDuring: aBlock [ openAction := aBlock. self openModal. parentWindow ifNotNil: [ - parentWindow takeKeyboardFocus ] + parentWindow takeKeyboardFocus ]. + + ^ returnValue ] { #category : 'initialization' } From dbcbecaa85c56404b2b5de973530fce48b091a23 Mon Sep 17 00:00:00 2001 From: Marcus Denker Date: Mon, 4 Dec 2023 17:34:11 +0100 Subject: [PATCH 7/7] Do not use slotsFromString: --- src/Spec2-Backend-Tests/SpScrollableLayoutAdapterTest.class.st | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Spec2-Backend-Tests/SpScrollableLayoutAdapterTest.class.st b/src/Spec2-Backend-Tests/SpScrollableLayoutAdapterTest.class.st index c0050d1e..23163e84 100644 --- a/src/Spec2-Backend-Tests/SpScrollableLayoutAdapterTest.class.st +++ b/src/Spec2-Backend-Tests/SpScrollableLayoutAdapterTest.class.st @@ -56,7 +56,7 @@ SpScrollableLayoutAdapterTest >> testAddWithSymbolWorks [ presenterClass := classFactory make: [ :aBuilder | aBuilder superclass: SpPresenter; - slotsFromString: 'textInput'; + slots: #(textInput); package: self class package name ]. presenter := presenterClass new.