From 461753f2cf4b097b4122d0b70ffcfa64b8c0075b Mon Sep 17 00:00:00 2001 From: Guille Polito Date: Fri, 27 Sep 2024 11:16:20 +0200 Subject: [PATCH 1/7] Remove senders of scaledByDisplayScaleFactor and displayScaleFactor, superseeded by new scale factor support --- .../SpMorphicListAdapterTest.class.st | 2 +- src/Spec2-Adapters-Morphic/SpFontStyle.class.st | 4 ++-- .../SpMorphicButtonBarAdapter.class.st | 6 +++--- src/Spec2-Adapters-Morphic/SpStyleVariable.class.st | 2 +- 4 files changed, 7 insertions(+), 7 deletions(-) diff --git a/src/Spec2-Adapters-Morphic-Tests/SpMorphicListAdapterTest.class.st b/src/Spec2-Adapters-Morphic-Tests/SpMorphicListAdapterTest.class.st index 5f5eb6ab..75eac385 100644 --- a/src/Spec2-Adapters-Morphic-Tests/SpMorphicListAdapterTest.class.st +++ b/src/Spec2-Adapters-Morphic-Tests/SpMorphicListAdapterTest.class.st @@ -41,7 +41,7 @@ SpMorphicListAdapterTest >> testScrollToIndexVisibleScrollbars [ self configureList: 100. presenter open; - withWindowDo: [ : w | w resize: (200 @ 400) scaledByDisplayScaleFactor ]. + withWindowDo: [ : w | w resize: (200 @ 400) ]. self assert: presenter scrollIndex equals: 1. diff --git a/src/Spec2-Adapters-Morphic/SpFontStyle.class.st b/src/Spec2-Adapters-Morphic/SpFontStyle.class.st index cfa8e1c9..d08713b4 100644 --- a/src/Spec2-Adapters-Morphic/SpFontStyle.class.st +++ b/src/Spec2-Adapters-Morphic/SpFontStyle.class.st @@ -178,9 +178,9 @@ SpFontStyle >> calculateFontSize [ aVariable value ifNotNil: [ ^ self scaledSize ] ]. self nameVariable isEnvironmentVariable ifTrue: [ - ^ self nameVariable pointSize * self displayScaleFactor ]. + ^ self nameVariable pointSize ]. self hasPredefinedFont ifTrue: [ - ^ self obtainPredefinedFont pointSize * self displayScaleFactor ]. + ^ self obtainPredefinedFont pointSize ]. ^ nil ] diff --git a/src/Spec2-Adapters-Morphic/SpMorphicButtonBarAdapter.class.st b/src/Spec2-Adapters-Morphic/SpMorphicButtonBarAdapter.class.st index 9d1d86e9..d1bc23b9 100644 --- a/src/Spec2-Adapters-Morphic/SpMorphicButtonBarAdapter.class.st +++ b/src/Spec2-Adapters-Morphic/SpMorphicButtonBarAdapter.class.st @@ -12,13 +12,13 @@ Class { { #category : 'accessing' } SpMorphicButtonBarAdapter class >> defaultHeight [ - ^ 30 scaledByDisplayScaleFactor + ^ 30 ] { #category : 'accessing' } SpMorphicButtonBarAdapter class >> defaultItemSeparation [ - ^ (3@0) scaledByDisplayScaleFactor + ^ (3@0) ] { #category : 'factory' } @@ -27,7 +27,7 @@ SpMorphicButtonBarAdapter >> addModelTo: panelMorph [ self model items do: [ :each | self model focusOrder add: each. panelMorph addMorph: (each build - width: 100 scaledByDisplayScaleFactor; + width: 100; hResizing: #rigid; yourself) ] ] diff --git a/src/Spec2-Adapters-Morphic/SpStyleVariable.class.st b/src/Spec2-Adapters-Morphic/SpStyleVariable.class.st index 665bdcf4..baaa6beb 100644 --- a/src/Spec2-Adapters-Morphic/SpStyleVariable.class.st +++ b/src/Spec2-Adapters-Morphic/SpStyleVariable.class.st @@ -52,7 +52,7 @@ SpStyleVariable >> preferredValueWith: anObject [ { #category : 'evaluating' } SpStyleVariable >> scaledValue [ - ^ self nonscaledValue * self currentWorld displayScaleFactor + ^ self nonscaledValue ] { #category : 'private' } From 58fa2afcde1329d187c7995f9a332b2a515083c7 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?St=C3=A9phaneDucasse?= Date: Sat, 5 Oct 2024 18:43:22 +0200 Subject: [PATCH 2/7] Guess what Migrating Gx -> x icon names --- src/Spec2-Morphic/SpSelectEntity.class.st | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Spec2-Morphic/SpSelectEntity.class.st b/src/Spec2-Morphic/SpSelectEntity.class.st index 16f4a5b5..de5fdff5 100644 --- a/src/Spec2-Morphic/SpSelectEntity.class.st +++ b/src/Spec2-Morphic/SpSelectEntity.class.st @@ -108,7 +108,7 @@ SpSelectEntity >> initializePresenters [ entryCompletion: self entitiesEntryCompletion; yourself. selectEntity := self newButton - icon: (self iconNamed: #glamorousSearch); + icon: (self iconNamed: #search); help: 'Open a selection dialog'. self focusOrder add: entityText; From d9f708bf56487513fd34d77f930c52d3b535e7b2 Mon Sep 17 00:00:00 2001 From: Martin Dias Date: Mon, 7 Oct 2024 19:07:12 -0300 Subject: [PATCH 3/7] Fixes in slider's Morphic adapter - Value: presenter and widget were not syncing correctly - Horizontal slider didn't work except when min=0 and max=1. - Vertical slider was wrong (not it becomes an ignored presenter property) - Value was supporting (unexpectedly) parsing from string, with special adhoc support for fractions - Label didn't update when change after opened --- .../SpMorphicSliderAdapter.class.st | 120 ++++++++---------- 1 file changed, 55 insertions(+), 65 deletions(-) diff --git a/src/Spec2-Adapters-Morphic/SpMorphicSliderAdapter.class.st b/src/Spec2-Adapters-Morphic/SpMorphicSliderAdapter.class.st index 089d6587..8c370ba8 100644 --- a/src/Spec2-Adapters-Morphic/SpMorphicSliderAdapter.class.st +++ b/src/Spec2-Adapters-Morphic/SpMorphicSliderAdapter.class.st @@ -9,90 +9,80 @@ Class { #tag : 'Base' } -{ #category : 'widget API' } -SpMorphicSliderAdapter >> absoluteValue [ - - ^ self presenter absoluteValue -] - -{ #category : 'widget API' } -SpMorphicSliderAdapter >> absoluteValue: aFloat [ - - ^ self presenter absoluteValue: aFloat -] - { #category : 'factory' } SpMorphicSliderAdapter >> buildWidget [ - | preWidget | - preWidget := PluggableSliderMorph new - model: self; - getValueSelector: #value; - setValueSelector: #value:; - value: self absoluteValue; - getLabelSelector: #label; - max: self max; - min: self min; - quantum: self quantum; - setBalloonText: self help; - vResizing: #spaceFill; - hResizing: #spaceFill; - yourself. - self presenter isHorizontal ifFalse: [ - preWidget := TransformationMorph new asFlexOf: preWidget. - preWidget transform withAngle: 90 degreesToRadians negated ]. - - self presenter whenMinChangedDo: [ :newValue | - preWidget min: newValue ]. - self presenter whenMaxChangedDo: [ :newValue | - preWidget max: newValue ]. - self presenter whenQuantumChangedDo: [ :newValue | - preWidget quantum: newValue ]. - self presenter whenValueChangedDo: [ :newValue | - preWidget value: newValue ]. - - ^ preWidget + | aSliderMorph | + aSliderMorph := + (PluggableSliderMorph + on: self + getValue: #presenterValue + setValue: #presenterValue: + min: self presenter min + max: self presenter max + quantum: self presenter quantum) + getLabelSelector: #presenterLabel; + setBalloonText: self help; + vResizing: #spaceFill; + hResizing: #spaceFill; + yourself. + + self presenter whenMinChangedDo: [ :newValue | + aSliderMorph min: newValue ]. + self presenter whenMaxChangedDo: [ :newValue | + aSliderMorph max: newValue ]. + self presenter whenQuantumChangedDo: [ :newValue | + aSliderMorph quantum: newValue ]. + self presenter whenLabelChangedDo: [ :newLabel | + aSliderMorph label: newLabel ]. + self presenter whenAbsoluteValueChangedDo: [ :newValue | + aSliderMorph setValue: newValue ]. + + ^ aSliderMorph ] -{ #category : 'widget API' } -SpMorphicSliderAdapter >> label [ - +{ #category : 'accessing' } +SpMorphicSliderAdapter >> presenterLabel [ + ^ self presenter label ] -{ #category : 'widget API' } -SpMorphicSliderAdapter >> max [ +{ #category : 'accessing' } +SpMorphicSliderAdapter >> presenterValue [ - ^ self presenter max + ^ self presenter value ] -{ #category : 'widget API' } -SpMorphicSliderAdapter >> min [ +{ #category : 'accessing' } +SpMorphicSliderAdapter >> presenterValue: aValue [ - ^ self presenter min + self presenter value: aValue ] -{ #category : 'widget API' } -SpMorphicSliderAdapter >> quantum [ +{ #category : 'debug' } +SpMorphicSliderAdapter >> widgetAbsoluteValue [ - ^ self model quantum + ^ widget value asFloat ] -{ #category : 'widget API' } -SpMorphicSliderAdapter >> value [ - ^ self presenter value +{ #category : 'debug' } +SpMorphicSliderAdapter >> widgetLabel [ + + ^ widget label ] -{ #category : 'widget API' } -SpMorphicSliderAdapter >> value: aValue [ +{ #category : 'debug' } +SpMorphicSliderAdapter >> widgetValue [ + + ^ widget scaledValue +] - | value | - value := aValue isNumber - ifTrue: [ aValue ] - ifFalse: [ - (aValue includes: $/) - ifTrue: [ (NumberParser on: aValue) nextFraction ] - ifFalse: [ aValue asNumber ] ]. +{ #category : 'debug' } +SpMorphicSliderAdapter >> widgetValue: aNumber [ + "Emulate a change in the widget value, as if there was a scroll. + Note: We intentionally use #setValue: instead of #value: due to a bug in + the widget, that doesn't perform the setValue selector with the new value + when using #value:, and we need it." - ^ self presenter value: value asFloat + widget setValue: (self presenter valueToAbsoluteValue: aNumber) ] From cc0945885dc99c0acf512aaf39a58cde022d1a29 Mon Sep 17 00:00:00 2001 From: Martin Dias Date: Mon, 7 Oct 2024 19:12:34 -0300 Subject: [PATCH 4/7] Fixes on test case for slider's adapter - Rename SpSliderPresenterBackendTest -> SpSliderAdapterTest - Add tests (only 2 smoke tests before) --- .../SpBoxLayoutAdapterTest.class.st | 39 ---- .../SpSliderAdapterTest.class.st | 175 ++++++++++++++++++ .../SpSliderPresenterBackendTest.class.st | 32 ---- 3 files changed, 175 insertions(+), 71 deletions(-) create mode 100644 src/Spec2-Backend-Tests/SpSliderAdapterTest.class.st delete mode 100644 src/Spec2-Backend-Tests/SpSliderPresenterBackendTest.class.st diff --git a/src/Spec2-Backend-Tests/SpBoxLayoutAdapterTest.class.st b/src/Spec2-Backend-Tests/SpBoxLayoutAdapterTest.class.st index f83fefe2..521bcfd6 100644 --- a/src/Spec2-Backend-Tests/SpBoxLayoutAdapterTest.class.st +++ b/src/Spec2-Backend-Tests/SpBoxLayoutAdapterTest.class.st @@ -89,42 +89,3 @@ SpBoxLayoutAdapterTest >> testReplaceElementAfterOpen [ replacement adapter widget. p2 adapter widget } ] - -{ #category : 'tests' } -SpBoxLayoutAdapterTest >> testReplaceElementAppliesStyle [ - | p1 toReplace p2 replacement | - - layout add: (p1 := SpLabelPresenter new). - layout add: (toReplace := SpLabelPresenter new). - layout add: (p2 := SpLabelPresenter new). - self openInstance. - - replacement := SpLabelPresenter new. - replacement addStyle: 'code'. "code assigns code fonts" - layout replace: toReplace with: replacement. - - self assert: self adapter children size equals: 3. - self - assert: replacement adapter widget font - equals: StandardFonts codeFont -] - -{ #category : 'tests' } -SpBoxLayoutAdapterTest >> testReplaceElementBeforeOpenAppliesStyle [ - | p1 toReplace p2 replacement | - - layout add: (p1 := SpLabelPresenter new). - layout add: (toReplace := SpLabelPresenter new). - layout add: (p2 := SpLabelPresenter new). - - replacement := SpLabelPresenter new. - replacement addStyle: 'code'. "code assigns code fonts" - layout replace: toReplace with: replacement. - - self openInstance. - - self assert: self adapter children size equals: 3. - self - assert: replacement adapter widget font - equals: StandardFonts codeFont -] diff --git a/src/Spec2-Backend-Tests/SpSliderAdapterTest.class.st b/src/Spec2-Backend-Tests/SpSliderAdapterTest.class.st new file mode 100644 index 00000000..a3ca0484 --- /dev/null +++ b/src/Spec2-Backend-Tests/SpSliderAdapterTest.class.st @@ -0,0 +1,175 @@ +Class { + #name : 'SpSliderAdapterTest', + #superclass : 'SpAbstractWidgetAdapterTest', + #category : 'Spec2-Backend-Tests-Base', + #package : 'Spec2-Backend-Tests', + #tag : 'Base' +} + +{ #category : 'accessing' } +SpSliderAdapterTest >> classToTest [ + ^ SpSliderPresenter +] + +{ #category : 'tests' } +SpSliderAdapterTest >> testChangeInLabelUpdatesWidget [ + + self + assert: self adapter widgetLabel + closeTo: ''. + + presenter label: 'test'. + + self + assert: self adapter widgetLabel + equals: 'test' +] + +{ #category : 'tests' } +SpSliderAdapterTest >> testChangeInMaxUpdatesWidget [ + + presenter value: 80. + + "Default max is 100" + self + assert: self adapter widgetAbsoluteValue + closeTo: 0.8. + self + assert: self adapter widgetValue + equals: 80. + + "Changing max updates the slider value" + presenter max: 1000. + self + assert: self adapter widgetAbsoluteValue + closeTo: 0.8. + self + assert: self adapter widgetValue + equals: 800 +] + +{ #category : 'tests' } +SpSliderAdapterTest >> testChangeInMinUpdatesWidget [ + + presenter value: 80. + + "Default min is 0" + self + assert: self adapter widgetAbsoluteValue + closeTo: 0.8. + self + assert: self adapter widgetValue + equals: 80. + + "Changing min updates the slider value" + presenter min: 50. + self + assert: self adapter widgetAbsoluteValue + closeTo: 0.8. + self + assert: self adapter widgetValue + equals: 90 +] + +{ #category : 'tests' } +SpSliderAdapterTest >> testChangeInQuantumUpdatesWidget [ + + presenter + min: -50; + max: 150. + + "By default, quantum is 1, which means round Floats to Integer" + presenter value: 49.1. + self assert: self adapter widgetValue closeTo: 49. + + presenter value: -49.1. + self assert: self adapter widgetValue closeTo: -49. + + "Quantum is disabled when nil is set" + presenter quantum: nil. + + presenter value: 49.1. + self assert: self adapter widgetValue closeTo: 49.1. + + presenter value: -49.1. + self assert: self adapter widgetValue closeTo: -49.1. + + "Set 50 as quantum" + presenter quantum: 10. + + "Current value is automatically rounded acording to the new quamtum" + self assert: self adapter widgetValue equals: -50. + + "It also works with new values" + presenter value: 49. + self assert: self adapter widgetValue equals: 50 +] + +{ #category : 'tests' } +SpSliderAdapterTest >> testChangeInValueUpdatesWidget [ + + presenter + min: -50; + max: 150. + + presenter value: 50. + self assert: self adapter widgetValue equals: 50. + + presenter value: -50. + self assert: self adapter widgetValue equals: -50 +] + +{ #category : 'tests' } +SpSliderAdapterTest >> testPresenterUpdatesWidget [ + + presenter + min: -50; + max: 150. + + presenter value: 50. + self assert: self adapter widgetValue equals: 50. + + presenter value: -50. + self assert: self adapter widgetValue equals: -50. + + "By default, quantum is 1, which means round Floats to Integer" + presenter value: 49.1. + self assert: self adapter widgetValue closeTo: 49. + + presenter value: -49.1. + self assert: self adapter widgetValue closeTo: -49. + + "Quantum is disabled when nil is set" + presenter quantum: nil. + + presenter value: 49.1. + self assert: self adapter widgetValue closeTo: 49.1. + + presenter value: -49.1. + self assert: self adapter widgetValue closeTo: -49.1. + + "Set 50 as quantum" + presenter quantum: 10. + + "Current value is automatically rounded acording to the new quamtum" + self assert: self adapter widgetValue equals: -50. + + "It also works with new values" + presenter value: 49. + self assert: self adapter widgetValue equals: 50 +] + +{ #category : 'tests' } +SpSliderAdapterTest >> testWidgetUpdatesPresenter [ + + presenter + min: -50; + max: 150; + quantum: 10. + + "Emulate a change on the widget" + self adapter widgetValue: 54. + + self assert: presenter value equals: 50. + self assert: presenter absoluteValue equals: 0.5 +] diff --git a/src/Spec2-Backend-Tests/SpSliderPresenterBackendTest.class.st b/src/Spec2-Backend-Tests/SpSliderPresenterBackendTest.class.st deleted file mode 100644 index e6cefd05..00000000 --- a/src/Spec2-Backend-Tests/SpSliderPresenterBackendTest.class.st +++ /dev/null @@ -1,32 +0,0 @@ -Class { - #name : 'SpSliderPresenterBackendTest', - #superclass : 'SpAbstractWidgetAdapterTest', - #category : 'Spec2-Backend-Tests-Base', - #package : 'Spec2-Backend-Tests', - #tag : 'Base' -} - -{ #category : 'accessing' } -SpSliderPresenterBackendTest >> classToTest [ - ^ SpSliderPresenter -] - -{ #category : 'initialization' } -SpSliderPresenterBackendTest >> initializeTestedInstance [ - presenter - min: 1; - max: 100; - quantum: 1; - value: 20 -] - -{ #category : 'tests' } -SpSliderPresenterBackendTest >> testSmokeHorizontalTest [ - self presenter beHorizontal. -] - -{ #category : 'tests' } -SpSliderPresenterBackendTest >> testSmokeVerticalTest [ - self presenter beVertical. - -] From 5134345e903487857a111ba69c4899d59e695d53 Mon Sep 17 00:00:00 2001 From: Martin Dias Date: Tue, 8 Oct 2024 13:11:31 -0300 Subject: [PATCH 5/7] Delete color: override from slider presenter. - This kind of visual property needs to be defined through styles. - It does not work (self does not understand #widget), so there are no users --- src/Spec2-Core/SpSliderPresenter.class.st | 7 ------- src/Spec2-Core/SpStringTableColumn.class.st | 6 +++--- 2 files changed, 3 insertions(+), 10 deletions(-) diff --git a/src/Spec2-Core/SpSliderPresenter.class.st b/src/Spec2-Core/SpSliderPresenter.class.st index 65e022ca..3044caf6 100644 --- a/src/Spec2-Core/SpSliderPresenter.class.st +++ b/src/Spec2-Core/SpSliderPresenter.class.st @@ -73,13 +73,6 @@ SpSliderPresenter >> beVertical [ isHorizontal := false ] -{ #category : 'api' } -SpSliderPresenter >> color: aColor [ - - "Hack because during the interpretation, the state is slightly inconistent" - self widget ifNotNil: [:w | w == self ifFalse: [ super color: aColor ]] -] - { #category : 'initialization' } SpSliderPresenter >> initialize [ | isChanging | diff --git a/src/Spec2-Core/SpStringTableColumn.class.st b/src/Spec2-Core/SpStringTableColumn.class.st index 730826b5..d68995f7 100644 --- a/src/Spec2-Core/SpStringTableColumn.class.st +++ b/src/Spec2-Core/SpStringTableColumn.class.st @@ -125,7 +125,7 @@ SpStringTableColumn >> onAcceptEdition: aBlock [ acceptAction := aBlock ] -{ #category : #api } +{ #category : 'api' } SpStringTableColumn >> onTextChanged: aBlock [ "Set the block to execute when cell edition is edited. `aBlock` receives two arguments: @@ -135,7 +135,7 @@ SpStringTableColumn >> onTextChanged: aBlock [ textChanged := aBlock ] -{ #category : #api } +{ #category : 'api' } SpStringTableColumn >> sortFunction [ ^ super sortFunction ifNil: [ self evaluation ascending ] @@ -156,7 +156,7 @@ SpStringTableColumn >> sortFunction: aBlockOrSortFunction [ self isSortable: aBlockOrSortFunction isNotNil ] -{ #category : #accessing } +{ #category : 'accessing' } SpStringTableColumn >> textChanged [ ^ textChanged From 87d29fad87973d8b0adb064baa9625b04bd06f0c Mon Sep 17 00:00:00 2001 From: Koen De Hondt Date: Tue, 8 Oct 2024 21:26:52 +0200 Subject: [PATCH 6/7] Set enablement of button in SpCommand>>#configureAsButtonOfClass: --- .../SpCommandTest.class.st | 25 +++++++++++++++++++ src/Spec2-Commander2/SpCommand.class.st | 1 + 2 files changed, 26 insertions(+) diff --git a/src/Spec2-Commander2-Tests/SpCommandTest.class.st b/src/Spec2-Commander2-Tests/SpCommandTest.class.st index e67988d0..2b32563b 100644 --- a/src/Spec2-Commander2-Tests/SpCommandTest.class.st +++ b/src/Spec2-Commander2-Tests/SpCommandTest.class.st @@ -141,6 +141,7 @@ SpCommandTest >> testConfigureAsToolBarButton [ self assert: button label equals: command name. self assert: button help equals: command description. self assert: button icon isNil. + self assert: button isEnabled. self assert: button action value equals: command execute ] @@ -231,3 +232,27 @@ SpCommandTest >> testShortcutKey [ self assert: command shortcutKey equals: $a asKeyCombination ] + +{ #category : 'tests' } +SpCommandTest >> testToolBarButtonEnablement [ + + | button context | + context := OrderedCollection new. + command := (CmBlockCommand new + name: 'foo'; + description: 'bar'; + canBeExecutedBlock: [:collection | collection isNotEmpty ]; + context: context; + yourself) asSpecCommand. + + button := command + configureAsToolbarButton; + buildPresenter. + self deny: button isEnabled. + + context add: 1. + button := command + configureAsToolbarButton; + buildPresenter. + self assert: button isEnabled. +] diff --git a/src/Spec2-Commander2/SpCommand.class.st b/src/Spec2-Commander2/SpCommand.class.st index acee0a9a..22b2c760 100644 --- a/src/Spec2-Commander2/SpCommand.class.st +++ b/src/Spec2-Commander2/SpCommand.class.st @@ -58,6 +58,7 @@ SpCommand >> configureAsButtonOfClass: aButtonClass [ specCommand hasIcon ifTrue: [ button icon: specCommand icon ] ]; action: [ specCommand execute ]; + enabled: specCommand canBeExecuted; yourself ] ] From 885a1d76bd25373e36ba7a9433fb85b494e2deda Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Hern=C3=A1n=20Morales=20Durand?= Date: Sun, 13 Oct 2024 12:15:17 +0200 Subject: [PATCH 7/7] Add single missing `selectedItems` method. --- src/Spec2-CommonWidgets/SpFilteringListPresenter.class.st | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/src/Spec2-CommonWidgets/SpFilteringListPresenter.class.st b/src/Spec2-CommonWidgets/SpFilteringListPresenter.class.st index f4adc918..9f510998 100644 --- a/src/Spec2-CommonWidgets/SpFilteringListPresenter.class.st +++ b/src/Spec2-CommonWidgets/SpFilteringListPresenter.class.st @@ -235,6 +235,13 @@ SpFilteringListPresenter >> selectedItem [ ^ listPresenter selectedItem ] +{ #category : 'accessing' } +SpFilteringListPresenter >> selectedItems [ + "Answer a of receiver's selected objects" + + ^ listPresenter selectedItems +] + { #category : 'accessing' } SpFilteringListPresenter >> sortingBlock: aBlockOrNil [