Merge pull request #1820 from juliendelplanque/22478-ButtonPresenter-…

…does-not-take-into-account-its-color

22478 button presenter does not take into account its color

src/Spec-MorphicAdapters/MorphicButtonAdapter.class.st

@@ -39,7 +39,7 @@ MorphicButtonAdapter >> buildLabel: text withIcon: icon [
 { #category : #factory }
 MorphicButtonAdapter >> buildWidget [
 
-	| button | 
+	| button normalColorBlock clickedColorBlock | 
 	button := PluggableButtonMorph
 				on: self 
 				getState: #state 
@@ -56,6 +56,17 @@ MorphicButtonAdapter >> buildWidget [
 		dragEnabled: self dragEnabled;
 		dropEnabled: self dropEnabled ;	
 		eventHandler: (MorphicEventHandler new on: #keyStroke send: #keyStroke:fromMorph: to: self).
+
+	normalColorBlock := [ :aButton |
+							(aButton valueOfProperty: #noFill ifAbsent: [false]) 
+								ifTrue: [ SolidFillStyle color: Color transparent ]
+								ifFalse: [ SolidFillStyle color: self color ] ].
+	clickedColorBlock := [ :aButton | SolidFillStyle color: self color muchDarker ].
+	button theme: ((UIThemeDecorator theme: button theme)
+							property: #buttonNormalFillStyleFor: returnsValueOf: normalColorBlock;
+							property: #buttonMouseOverFillStyleFor: returnsValueOf: normalColorBlock;
+							property: #buttonPressedFillStyleFor: returnsValueOf: clickedColorBlock;
+							yourself).
 	^ button
 ]
 

src/Spec-MorphicAdapters/UIThemeDecorator.class.st

@@ -0,0 +1,83 @@
+"
+I decorate a UITheme allowing to override desired properties.
+
+See #example on class side.
+"
+Class {
+	#name : #UIThemeDecorator,
+	#superclass : #Object,
+	#instVars : [
+		'theme',
+		'themeOverrideDict'
+	],
+	#category : #'Spec-MorphicAdapters-Support'
+}
+
+{ #category : #examples }
+UIThemeDecorator class >> exampleDecoratorToMakePluggableButtonRed [
+	| normalColorBlock clickedColorBlock |
+	normalColorBlock := [ :aButton |
+							(aButton valueOfProperty: #noFill ifAbsent: [false]) 
+								ifTrue: [ SolidFillStyle color: Color transparent ]
+								ifFalse: [ SolidFillStyle color: Color red ] ].
+	clickedColorBlock := [ :aButton | SolidFillStyle color: Color red muchDarker ].
+	^ (UIThemeDecorator theme: Smalltalk ui theme)
+			property: #buttonNormalFillStyleFor: returnsValueOf: normalColorBlock;
+			property: #buttonMouseOverFillStyleFor: returnsValueOf: normalColorBlock;
+			property: #buttonPressedFillStyleFor: returnsValueOf: clickedColorBlock;
+			yourself
+]
+
+{ #category : #'instance creation' }
+UIThemeDecorator class >> theme: aUITheme [
+	^ self new
+		theme: aUITheme;
+		yourself
+]
+
+{ #category : #'reflective operations' }
+UIThemeDecorator >> doesNotUnderstand: aMessage [
+	(self hasProperty: aMessage selector)
+		ifTrue: [ |objOrBlock|
+			objOrBlock := self objectAtProperty: aMessage selector.
+			^ objOrBlock isBlock
+				ifTrue: [ objOrBlock valueWithPossibleArgs: aMessage arguments ]
+				ifFalse: [ objOrBlock value ] ].
+
+	self theme
+		ifNotNil: [ :t | ^ t perform: aMessage selector withArguments: aMessage arguments ].
+
+	^ super doesNotUnderstand: aMessage
+]
+
+{ #category : #testing }
+UIThemeDecorator >> hasProperty: aSymbol [
+	^ themeOverrideDict includesKey: aSymbol
+]
+
+{ #category : #initialization }
+UIThemeDecorator >> initialize [
+	super initialize.
+	themeOverrideDict := Dictionary new
+]
+
+{ #category : #accessing }
+UIThemeDecorator >> objectAtProperty: aSymbol [
+	^ themeOverrideDict at: aSymbol
+]
+
+{ #category : #accessing }
+UIThemeDecorator >> property: aSymbol returnsValueOf: anObject [
+	themeOverrideDict
+		at: aSymbol put: anObject
+]
+
+{ #category : #accessing }
+UIThemeDecorator >> theme [
+	^ theme
+]
+
+{ #category : #accessing }
+UIThemeDecorator >> theme: anObject [
+	theme := anObject
+]

src/Spec-MorphicAdapters/UIThemeDecoratorTest.class.st

@@ -0,0 +1,66 @@
+"
+I hold tests for UIThemeDecorator.
+"
+Class {
+	#name : #UIThemeDecoratorTest,
+	#superclass : #TestCase,
+	#instVars : [
+		'themeDecorator'
+	],
+	#category : #'Spec-MorphicAdapters-Tests'
+}
+
+{ #category : #running }
+UIThemeDecoratorTest >> setUp [
+	super setUp.
+	themeDecorator := UIThemeDecorator exampleDecoratorToMakePluggableButtonRed
+]
+
+{ #category : #tests }
+UIThemeDecoratorTest >> testDoesNotUnderstand [
+	| block |
+	themeDecorator
+		property: #foo returnsValueOf: 42.
+
+	self assert: (themeDecorator foo) equals: 42.
+
+	block := [ 42 ].
+	themeDecorator
+		property: #fooBlock returnsValueOf: block.
+	"Returns the result of the block evaluation."
+	self assert: (themeDecorator fooBlock) equals: 42.
+
+	block := [ :x | x + 42 ].
+
+	themeDecorator
+		property: #fooBlock: returnsValueOf: block.
+	"Returns the result of the block evaluation."
+	self assert: (themeDecorator fooBlock: 3) equals: 45.
+]
+
+{ #category : #tests }
+UIThemeDecoratorTest >> testHasProperty [
+	self
+		assert: (themeDecorator hasProperty: #buttonNormalFillStyleFor:);
+		assert: (themeDecorator hasProperty: #buttonMouseOverFillStyleFor:);
+		assert: (themeDecorator hasProperty: #buttonPressedFillStyleFor:);
+		deny: (themeDecorator hasProperty: #controlButtonSelectedDisabledFillStyleFor:);
+		deny: (themeDecorator hasProperty: #scrollbarMouseOverBorderStyleFor:);
+		deny: (themeDecorator hasProperty: #scrollbarThumbCornerStyleIn:)
+]
+
+{ #category : #tests }
+UIThemeDecoratorTest >> testPropertyReturnsValueOf [
+	| block |
+	themeDecorator
+		property: #foo returnsValueOf: 42.
+
+	self assert: (themeDecorator objectAtProperty: #foo) equals: 42.
+
+	block := [ 42 ].
+
+	themeDecorator
+		property: #fooBlock returnsValueOf: block.
+	"Returns the block, not its value."
+	self assert: (themeDecorator objectAtProperty: #fooBlock) equals: block.
+]