more tests

src/Toplo-Tests/ToElementTest.class.st

@@ -146,7 +146,7 @@ ToElementTest >> testDefaultSkin [
 	" no change "
 	self assert: e defaultSkin identicalTo: sk.
 	self assert: e installedSkin isNil.
-	self assert: sk installCpt equals: 0.
+	self assert: (sk receivedCountForClass: ToInstallLookEvent) equals: 0.
 	e applySkinInstaller.
 	self assert: e defaultSkin identicalTo: sk.
 	self assert: e installedSkin identicalTo: sk.
@@ -155,18 +155,16 @@ ToElementTest >> testDefaultSkin [
 		(e eventDispatcher handlers select: [ :h | h isKindOf: ToSkin ])
 			size
 		equals: 1.
-	self assert: sk installCpt equals: 1.
-	self assert: sk initialCpt equals: 1.
-	self assert: sk uninstallCpt equals: 0.
+	self assert: (sk receivedCountForClass: ToInstallLookEvent) equals: 1.
+	self assert: (sk receivedCountForClass: ToUninstallLookEvent) equals: 0.
 
 	e defaultSkin: sk.
 	e requestInstallSkin.
 	e applySkinInstaller.
 	e applyEnqueuedStates.
 	" no change since same skin "
-	self assert: sk installCpt equals: 1.
-	self assert: sk initialCpt equals: 1.
-	self assert: sk uninstallCpt equals: 0.
+	self assert: (sk receivedCountForClass: ToInstallLookEvent) equals: 1.
+	self assert: (sk receivedCountForClass: ToUninstallLookEvent) equals: 0.
 
 	self
 		assert:
@@ -184,12 +182,10 @@ ToElementTest >> testDefaultSkin [
 			size
 		equals: 1.
 
-	self assert: sk installCpt equals: 1.
-	self assert: sk initialCpt equals: 1.
-	self assert: sk uninstallCpt equals: 1.
-	self assert: sk2 installCpt equals: 1.
-	self assert: sk2 initialCpt equals: 1.
-	self assert: sk2 uninstallCpt equals: 0
+	self assert: (sk receivedCountForClass: ToInstallLookEvent) equals: 1.
+	self assert: (sk receivedCountForClass: ToUninstallLookEvent) equals: 1.
+	self assert: (sk2 receivedCountForClass: ToInstallLookEvent) equals: 1.
+	self assert: (sk2 receivedCountForClass: ToUninstallLookEvent) equals: 0
 ]
 
 { #category : 'test initialize' }
@@ -314,13 +310,12 @@ ToElementTest >> testSetSkin [
 	" no change "
 	self assert: e defaultSkin identicalTo: sk.
 	self assert: e installedSkin isNil.
-	self assert: sk installCpt equals: 0.
+	self assert: (sk receivedCountForClass: ToInstallLookEvent) equals: 0.
 	e applySkinInstaller.
 	self assert: e defaultSkin identicalTo: sk.
 	self assert: e installedSkin identicalTo: sk.
-	self assert: sk installCpt equals: 1.
-	self assert: sk initialCpt equals: 1.
-	self assert: sk uninstallCpt equals: 0.
+	self assert: (sk receivedCountForClass: ToInstallLookEvent) equals: 1.
+	self assert: (sk receivedCountForClass: ToUninstallLookEvent) equals: 0.
 
 	self
 		assert:
@@ -331,9 +326,8 @@ ToElementTest >> testSetSkin [
 	" force uninstall->install->initial states "
 	e setSkin: sk.
 	e applySkinInstaller.
-	self assert: sk uninstallCpt equals: 1.
-	self assert: sk installCpt equals: 2.
-	self assert: sk initialCpt equals: 2.
+	self assert: (sk receivedCountForClass: ToUninstallLookEvent) equals: 1.
+	self assert: (sk receivedCountForClass: ToInstallLookEvent) equals: 2.
 
 	self
 		assert:
@@ -351,12 +345,10 @@ ToElementTest >> testSetSkin [
 			size
 		equals: 1.
 
-	self assert: sk installCpt equals: 2.
-	self assert: sk initialCpt equals: 2.
-	self assert: sk uninstallCpt equals: 2.
-	self assert: sk2 installCpt equals: 1.
-	self assert: sk2 initialCpt equals: 1.
-	self assert: sk2 uninstallCpt equals: 0
+	self assert: (sk receivedCountForClass: ToInstallLookEvent) equals: 2.
+	self assert: (sk receivedCountForClass: ToUninstallLookEvent) equals: 2.
+	self assert: (sk2 receivedCountForClass: ToInstallLookEvent) equals: 1.
+	self assert: (sk2 receivedCountForClass: ToUninstallLookEvent) equals: 0
 ]
 
 { #category : 'test initialize' }

src/Toplo-Tests/ToIntrinsicLookEventForTest.class.st

@@ -1,6 +1,6 @@
 Class {
 	#name : 'ToIntrinsicLookEventForTest',
-	#superclass : 'ToIntrasicStateLookEvent',
+	#superclass : 'BlEvent',
 	#category : 'Toplo-Tests-Core-States',
 	#package : 'Toplo-Tests',
 	#tag : 'Core-States'

src/Toplo-Tests/ToRawSkinForTest.class.st

@@ -2,51 +2,200 @@ Class {
 	#name : 'ToRawSkinForTest',
 	#superclass : 'ToRawSkin',
 	#instVars : [
-		'initialCpt',
-		'installCpt',
-		'uninstallCpt'
+		'receivedEvents'
 	],
-	#category : 'Toplo-Tests-Core',
+	#category : 'Toplo-Tests-Core-Theme',
 	#package : 'Toplo-Tests',
-	#tag : 'Core'
+	#tag : 'Core-Theme'
 }
 
 { #category : 'accessing' }
-ToRawSkinForTest >> initialCpt [
+ToRawSkinForTest >> addReceivedEvent: anEvent [
+
+	self receivedEvents at: anEvent class ifAbsentPut: [ OrderedCollection new ].
+	(self receivedEvents at: anEvent class) add: anEvent
+]
+
+{ #category : 'event handling' }
+ToRawSkinForTest >> checkedLookEvent: anEvent [
+
+	super checkedLookEvent: anEvent.
+	self addReceivedEvent: anEvent
+]
+
+{ #category : 'event handling' }
+ToRawSkinForTest >> clickedLookEvent: anEvent [
+
+	super clickedLookEvent: anEvent.
+	self addReceivedEvent: anEvent
+
+]
+
+{ #category : 'event handling' }
+ToRawSkinForTest >> closedLookEvent: anEvent [
+
+	super closedLookEvent: anEvent.
+	self addReceivedEvent: anEvent
+]
+
+{ #category : 'event handling' }
+ToRawSkinForTest >> disabledLookEvent: anEvent [
+
+	super disabledLookEvent: anEvent.
+	self addReceivedEvent: anEvent
+
+]
+
+{ #category : 'event handling' }
+ToRawSkinForTest >> dragStartedLookEvent: anEvent [
+
+	super dragStartedLookEvent: anEvent.
+	self addReceivedEvent: anEvent
+
+]
+
+{ #category : 'event handling' }
+ToRawSkinForTest >> draggedLookEvent: anEvent [
+
+	super draggedLookEvent: anEvent.
+	self addReceivedEvent: anEvent
+]
+
+{ #category : 'event handling' }
+ToRawSkinForTest >> droppedLookEvent: anEvent [
+
+	super droppedLookEvent: anEvent.
+	self addReceivedEvent: anEvent
+
+]
+
+{ #category : 'event handling' }
+ToRawSkinForTest >> enabledLookEvent: anEvent [
+
+	super enabledLookEvent: anEvent.
+	self addReceivedEvent: anEvent
+
+]
+
+{ #category : 'event handling' }
+ToRawSkinForTest >> focusedLookEvent: anEvent [
+
+	super focusedLookEvent: anEvent.
+	self addReceivedEvent: anEvent
+
+]
+
+{ #category : 'event handling' }
+ToRawSkinForTest >> hoveredLookEvent: anEvent [
+
+	super hoveredLookEvent: anEvent.
+	self addReceivedEvent: anEvent
+
+]
+
+{ #category : 'event handling' }
+ToRawSkinForTest >> indeterminateLookEvent: anEvent [
+
+	super indeterminateLookEvent: anEvent.
+	self addReceivedEvent: anEvent
 
-	^ initialCpt
 ]
 
 { #category : 'initialization' }
 ToRawSkinForTest >> initialize [ 
 
 	super initialize.
-	initialCpt := 0.
-	installCpt := 0.
-	uninstallCpt := 0
+	receivedEvents := IdentityDictionary new.
 ]
 
-{ #category : 'accessing' }
-ToRawSkinForTest >> installCpt [
+{ #category : 'event handling' }
+ToRawSkinForTest >> installLookEvent: anEvent [
+
+	super installLookEvent: anEvent.
+	self addReceivedEvent: anEvent
 
-	^ installCpt
 ]
 
 { #category : 'event handling' }
-ToRawSkinForTest >> installLookEvent: anEvent [
+ToRawSkinForTest >> leavedLookEvent: anEvent [
+
+	super leavedLookEvent: anEvent.
+	self addReceivedEvent: anEvent
+
+]
+
+{ #category : 'event handling' }
+ToRawSkinForTest >> openedLookEvent: anEvent [
+
+	super openedLookEvent: anEvent.
+	self addReceivedEvent: anEvent
+
+]
+
+{ #category : 'event handling' }
+ToRawSkinForTest >> pressedLookEvent: anEvent [
+
+	super pressedLookEvent: anEvent.
+	self addReceivedEvent: anEvent
+
+]
+
+{ #category : 'accessing' }
+ToRawSkinForTest >> receivedCountForClass: anEventClass [
 
-	installCpt := installCpt + 1.
-	initialCpt := initialCpt + 1
+	^ self receivedEvents
+		  at: anEventClass
+		  ifPresent: [ :found | found size ]
+		  ifAbsent: [ 0 ]
 ]
 
 { #category : 'accessing' }
-ToRawSkinForTest >> uninstallCpt [
+ToRawSkinForTest >> receivedEvents [
+
+	^ receivedEvents ifNil: [ receivedEvents := OrderedCollection new ]
+]
+
+{ #category : 'event handling' }
+ToRawSkinForTest >> releasedLookEvent: anEvent [
+
+	super releasedLookEvent: anEvent.
+	self addReceivedEvent: anEvent
+
+]
+
+{ #category : 'event handling' }
+ToRawSkinForTest >> stillHoveredLookEvent: anEvent [
+
+	super stillHoveredLookEvent: anEvent.
+	self addReceivedEvent: anEvent
+]
+
+{ #category : 'event handling' }
+ToRawSkinForTest >> stillPressedLookEvent: anEvent [
+
+	super stillPressedLookEvent: anEvent.
+	self addReceivedEvent: anEvent
+]
+
+{ #category : 'event handling' }
+ToRawSkinForTest >> uncheckedLookEvent: anEvent [
+
+	super uncheckedLookEvent: anEvent.
+	self addReceivedEvent: anEvent
+
+]
+
+{ #category : 'event handling' }
+ToRawSkinForTest >> unfocusedLookEvent: anEvent [
+
+	super unfocusedLookEvent: anEvent.
+	self addReceivedEvent: anEvent
 
-	^ uninstallCpt
 ]
 
 { #category : 'event handling' }
 ToRawSkinForTest >> uninstallLookEvent: anEvent [
 
-	uninstallCpt := uninstallCpt + 1
+	super uninstallLookEvent: anEvent.
+	self addReceivedEvent: anEvent
 ]

src/Toplo-Tests/ToRawSkinTest.class.st

@@ -12,10 +12,27 @@ Class {
 { #category : 'tests' }
 ToRawSkinTest >> testHasAllNecessaryLookEventHandlingMethods [
 
-	| instanciableLookEventClasses lookEventHandlingMethods |
-	instanciableLookEventClasses := ToElementLookEvent allSubclasses select: [ :c | c allSubclasses isEmpty ].
-	lookEventHandlingMethods := Array streamContents: [:str | 
-		instanciableLookEventClasses do: [ :cls | cls localMethods  ] ]
+	| instanciableLookEventClasses lookEventClasses lookEventSelectors |
+	" collect all look event classes "
+	instanciableLookEventClasses := ToElementLookEvent allSubclasses.
+	" collect all look event classes that implement #sendTo: "
+	lookEventClasses := Array streamContents: [ :str |
+		                    instanciableLookEventClasses do: [ :cls |
+			                    cls localMethods do: [ :cm |
+				                    cm selector asSymbol = #sendTo: ifTrue: [
+					                    str nextPut: cls ] ] ] ].
+	" collect all selectors that a raw skin class must implement "
+	lookEventSelectors := lookEventClasses collect: [ :cls |
+		                      | n |
+		                      n := (cls name asString
+			                            copyFrom: 3
+			                            to: cls name size) asSymbol asMutator.
+		                      n asString
+			                      at: 1 put: n first asLowercase;
+			                      yourself ].
+	" check that ToRawSkin has all necessary methods "
+	lookEventSelectors do: [ :s |
+		self assert: (ToRawSkin canUnderstand: s asSymbol) ]
 ]
 
 { #category : 'tests' }

src/Toplo-Tests/ToRawThemeTest.class.st

@@ -8,3 +8,30 @@ Class {
 	#package : 'Toplo-Tests',
 	#tag : 'Core-Theme'
 }
+
+{ #category : 'tests' }
+ToRawThemeTest >> testName [
+	| theme |
+	theme := ToRawTheme new.
+	theme name
+]
+
+{ #category : 'tests' }
+ToRawThemeTest >> testNewRootSkinInstance [
+
+	| space e theme |
+	theme := ToRawTheme new.
+	space := BlSpace new.
+	e := space root.
+	self assert: ((theme newSkinInstanceFor: e) isKindOf: ToRawSkin).
+	self assert: (theme newSkinInstanceFor: e) class identicalTo: theme newRootSkinInstance class
+]
+
+{ #category : 'tests' }
+ToRawThemeTest >> testNewSkinInstanceFor [
+
+	| e |
+	e := BlElement new.
+	self assert: ((ToRawTheme new newSkinInstanceFor: e) isKindOf: ToRawSkin).
+	self assert: (ToRawTheme new newSkinInstanceFor: e) class identicalTo: e newRawSkin class
+]

src/Toplo/ToRawSkin.class.st

@@ -46,12 +46,6 @@ ToRawSkin >> draggedLookEvent: anEvent [
 ToRawSkin >> droppedLookEvent: anEvent [
 
 
-]
-
-{ #category : 'event handling' }
-ToRawSkin >> elementLookEvent: anEvent [
-
-
 ]
 
 { #category : 'event handling' }