Merge pull request #8318 from guillep/fix/events

Make Old events work as new ones in SDL2

src/Glamour-Morphic-Brick/GLMTabSelectorBrick.class.st

@@ -80,10 +80,12 @@ GLMTabSelectorBrick >> keyDown: event [
 	"Process keys navigation and space to toggle."
 
 	(self navigationKey: event) ifTrue: [ ^ self ].
-	event keyCharacter = Character arrowLeft
-		ifTrue: [ self selectPreviousTab ].
-	event keyCharacter = Character arrowRight
-		ifTrue: [ self selectNextTab ]
+	({KeyboardKey left . KeyboardKey keypadLeft}
+		includes: event key)
+			ifTrue: [ self selectPreviousTab ].
+	({KeyboardKey right . KeyboardKey keypadRight}
+		includes: event key)
+			ifTrue: [ self selectNextTab ]
 ]
 
 { #category : #'event handling' }

src/Glamour-Tests-Core/GLMActionTest.class.st

@@ -24,9 +24,9 @@ GLMActionTest >> testShortcutAsString [
 	modifier := Smalltalk os menuShortcutModifierString.
 	action := GLMAction new.
 	action shortcut: $i.
-	self assert: action shortcutAsString equals: modifier , '+i'.
+	self assert: action shortcutAsString equals: modifier , '+I'.
 	action shortcut: $I.
-	self assert: action shortcutAsString equals: modifier , '+shift+i'.
+	self assert: action shortcutAsString equals: modifier , '+shift+I'.
 	action shortcut: nil.
 	self assertEmpty: action shortcutAsString
 ]

src/Keymapping-Core/KMShortcutPrinter.class.st

@@ -51,17 +51,18 @@ KMShortcutPrinter class >> toString: aShortcut [
 { #category : #visiting }
 KMShortcutPrinter >> genericSpecialCharacter: char [ 
 
-	char = Character cr ifTrue: [ ^ 'Enter' ].
-	char = Character space ifTrue: [ ^ 'Space' ].
-	^ char	 asUppercase
+	char = KeyboardKey enter ifTrue: [ ^ 'Enter' ].
+	char = (KeyboardKey fromCharacter: Character space) ifTrue: [ ^ 'Space' ].
+	^ char	 name
 ]
 
 { #category : #visiting }
 KMShortcutPrinter >> macSpecialCharacter: char [ 
 
-	char = Character cr ifTrue: [ ^ self class symbolTableAt: #Enter ifAbsent: [ 'Enter' ] ].	
-	char = Character space ifTrue: [ ^ self class symbolTableAt: #Space ifAbsent: [ 'Space' ] ].	
-	^ char	asUppercase
+	char = KeyboardKey enter ifTrue: [ ^ self class symbolTableAt: #Enter ifAbsent: [ 'Enter' ] ].	
+	(char = (KeyboardKey fromCharacter: Character space))
+		ifTrue: [ ^ self class symbolTableAt: #Space ifAbsent: [ 'Space' ] ].	
+	^ char name asUppercase
 ]
 
 { #category : #accessing }
@@ -87,7 +88,7 @@ KMShortcutPrinter >> shortcutModifiers [
 KMShortcutPrinter >> visitGeneric: aPlatform [
 	| char |
 
-	char := self genericSpecialCharacter: shortcut platformCharacter asUppercase.	
+	char := self genericSpecialCharacter: shortcut platformCharacter.	
 	^ String streamContents: [ :stream |
 		self shortcutModifiers
 			do: [ :each | stream << each ]

src/Keymapping-KeyCombinations/KMKeyCombination.class.st

@@ -27,7 +27,7 @@ KMKeyCombination class >> fromKeyboardEvent: evt [
 	shift := evt shiftPressed.
 	alt := evt altKeyPressed.
 	(shift | command | control | alt)
-		ifFalse: [^ KMSingleKeyCombination from: evt modifiedCharacter ].
+		ifFalse: [^ evt key asKeyCombination ].
 	modifier := KMNoShortcut new.
 	control
 		ifTrue: [ modifier := modifier + KMModifier ctrl ].
@@ -37,7 +37,7 @@ KMKeyCombination class >> fromKeyboardEvent: evt [
 		ifTrue: [ modifier := modifier + KMModifier shift ].
 	alt
 		ifTrue: [ modifier := modifier + KMModifier alt ].
-	^ modifier + evt modifiedCharacter
+	^ modifier + evt key asKeyCombination
 ]
 
 { #category : #combining }
@@ -128,7 +128,7 @@ KMKeyCombination >> platformModifier [
 KMKeyCombination >> prettyPrintOn: aStream [
 
 	aStream << self shortcut modifier symbol.
-	self shortcut character printOn: aStream
+	self shortcut character name printOn: aStream
 ]
 
 { #category : #printing }

src/Keymapping-KeyCombinations/KMSingleKeyCombination.class.st

@@ -24,14 +24,7 @@ KMSingleKeyCombination class >> from: aCharacterOrInteger [
 	| aCharacter |
 	aCharacter := aCharacterOrInteger asCharacter.
 
-	KMUntypeableSingleKeyCombination 
-		ifSpecialKey: aCharacter do: [ :keyCombination | ^ keyCombination ]. 
-	KMNamedCharKeyCombination
-		ifSpecialKey: aCharacter do: [ :keyCombination | ^ keyCombination ]. 
-
-	^ self new
-		key: aCharacter;
-		yourself
+	^ (KeyboardKey fromCharacter: aCharacter) asKeyCombination
 ]
 
 { #category : #accessing }
@@ -56,7 +49,7 @@ KMSingleKeyCombination class >> specialKeys [
 
 { #category : #comparing }
 KMSingleKeyCombination >> = aShortcut [
-	^ super = aShortcut and: [ aShortcut key sameAs: key ]
+	^ super = aShortcut and: [ aShortcut key = key ]
 ]
 
 { #category : #comparing }
@@ -92,7 +85,7 @@ KMSingleKeyCombination >> modifier [
 
 { #category : #accessing }
 KMSingleKeyCombination >> name [
-	^ self key asString
+	^ self key name
 ]
 
 { #category : #'accessing platform' }

src/Keymapping-KeyCombinations/KeyboardKey.extension.st

@@ -0,0 +1,45 @@
+Extension { #name : #KeyboardKey }
+
+{ #category : #'*Keymapping-KeyCombinations' }
+KeyboardKey >> alt [
+
+	^ KMModifier alt + self
+]
+
+{ #category : #'*Keymapping-KeyCombinations' }
+KeyboardKey >> asKeyCombination [
+
+	^ KMSingleKeyCombination new
+		  key: self;
+		  yourself
+]
+
+{ #category : #'*Keymapping-KeyCombinations' }
+KeyboardKey >> command [
+
+	^ KMModifier command + self
+]
+
+{ #category : #'*Keymapping-KeyCombinations' }
+KeyboardKey >> control [
+
+	^ KMModifier control + self
+]
+
+{ #category : #'*Keymapping-KeyCombinations' }
+KeyboardKey >> ctrl [
+
+	^ KMModifier ctrl + self
+]
+
+{ #category : #'*Keymapping-KeyCombinations' }
+KeyboardKey >> meta [
+
+	^ KMModifier meta + self
+]
+
+{ #category : #'*Keymapping-KeyCombinations' }
+KeyboardKey >> shift [
+
+	^ KMModifier shift + self
+]

src/Keymapping-Tests/AbstractKeymappingTest.class.st

@@ -65,6 +65,7 @@ AbstractKeymappingTest >> eventKey: character alt: useAlt ctrl: useCtrl command:
 		charCode: code
 		hand: nil 
 		stamp: Time now.
+	event key: (KeyboardKey fromCharacter: character).
 	^ event 	
 ]
 

src/Keymapping-Tests/CharacterKeyCombinationTest.class.st

@@ -8,14 +8,14 @@ Class {
 CharacterKeyCombinationTest >> testLowercaseKeyCombination [
 	| combination |
 	combination := $a asKeyCombination.
-	self assert: combination key equals: $a.
+	self assert: combination key equals: KeyboardKey A.
 	self assert: combination modifier equals: KMNoModifier new.
 ]
 
 { #category : #tests }
 CharacterKeyCombinationTest >> testUppercaseKeyCombination [
 	| combination |
 	combination := $A asKeyCombination.
-	self assert: combination key equals: $a.
+	self assert: combination key equals: KeyboardKey A.
 	self assert: combination modifier equals: KMModifier shift.
 ]

src/Keymapping-Tests/KMShortcutTest.class.st

@@ -9,16 +9,16 @@ Class {
 
 { #category : #tests }
 KMShortcutTest >> testAsString [
-	self assert: $a asShortcut asString equals: 'a'.
-	self assert: $A asShortcut asString equals: 'Shift + a'.
-	self assert: $a ctrl asString equals: 'Ctrl + a'.
-	self assert: $A ctrl asString equals: 'Shift + Ctrl + a'.
-	self assert: $A command asString equals: 'Shift + Cmd + a'.
-	self assert: $A alt asString equals: 'Shift + Alt + a'.
-	self assert: $b command asString equals: 'Cmd + b'.
-	self assert: $c shift asString equals: 'Shift + c'.
-	self assert: $d alt asString equals: 'Alt + d'.
-	self assert: $e ctrl command asString equals: (KMCtrlModifier new asString ,' + ' , KMCommandModifier new asString,' + e')
+	self assert: $a asShortcut asString equals: 'A'.
+	self assert: $A asShortcut asString equals: 'Shift + A'.
+	self assert: $a ctrl asString equals: 'Ctrl + A'.
+	self assert: $A ctrl asString equals: 'Shift + Ctrl + A'.
+	self assert: $A command asString equals: 'Shift + Cmd + A'.
+	self assert: $A alt asString equals: 'Shift + Alt + A'.
+	self assert: $b command asString equals: 'Cmd + B'.
+	self assert: $c shift asString equals: 'Shift + C'.
+	self assert: $d alt asString equals: 'Alt + D'.
+	self assert: $e ctrl command asString equals: (KMCtrlModifier new asString ,' + ' , KMCommandModifier new asString,' + E')
 
 
 

src/Morphic-Base/EmbeddedMenuMorph.class.st

@@ -48,18 +48,42 @@ EmbeddedMenuMorph >> handlesKeyboard: evt [
 EmbeddedMenuMorph >> keyDown: evt [
 	"Handle tabbing and arrows and cr/space."
 
-	| char |
-	(self navigationKey: evt) ifTrue: [ ^ self ].
-	char := evt keyCharacter.
-	(char = Character arrowLeft or: [ char = Character arrowRight ])
+	| key |
+		
+	key := evt key.
+	(key isArrowLeft or: [ key isArrowRight ])
 		ifTrue: [ (selectedItem notNil and: [ selectedItem hasSubMenu ])
 				ifTrue: [ evt hand newMouseFocus: selectedItem subMenu.
 					selectedItem subMenu moveSelectionDown: 1 event: evt.
 					^ evt hand newKeyboardFocus: selectedItem subMenu ] ].
-	char = Character arrowUp ifTrue: [ ^ self moveSelectionDown: -1 event: evt ].	"up arrow key"
-	char = Character arrowDown ifTrue: [ ^ self moveSelectionDown: 1 event: evt ].	"down arrow key"
-	char = Character pageUp ifTrue: [ ^ self moveSelectionDown: -5 event: evt ].	"page up key"
-	char = Character pageDown ifTrue: [ ^ self moveSelectionDown: 5 event: evt ]	"page down key"
+
+	key isArrowUp ifTrue: [ ^ self moveSelectionDown: -1 event: evt ].	"up arrow key"
+	key isArrowDown ifTrue: [ ^ self moveSelectionDown: 1 event: evt ].	"down arrow key"
+	key = KeyboardKey pageUp ifTrue: [ ^ self moveSelectionDown: -5 event: evt ].	"page up key"
+	key = KeyboardKey pageDown ifTrue: [ ^ self moveSelectionDown: 5 event: evt ].	"page down key"
+
+	self window ifNotNil: [:win |
+		(win handlesKeyDown: evt) ifTrue: [
+			(win keyDown: evt) ifTrue: [^true]]].
+]
+
+{ #category : #events }
+EmbeddedMenuMorph >> keyStroke: event [
+	"Handle tabbing and arrows and cr/space."
+
+	| selectable |
+
+	self window ifNotNil: [:win |
+		(win handlesKeyStroke: event) ifTrue: [
+			(win keyStroke: event) ifTrue: [^true]]].
+	event key = KeyboardKey space
+		ifTrue: [ selectedItem
+			ifNotNil: [ ^ selectedItem hasSubMenu
+					ifTrue: [ event hand newMouseFocus: selectedItem subMenu.
+						selectedItem subMenu takeKeyboardFocus ]
+					ifFalse: [ selectedItem invokeWithEvent: event ] ].
+		(selectable := self items) size = 1 ifTrue: [ ^ selectable first invokeWithEvent: event ].
+		^ self ].
 ]
 
 { #category : #'keyboard control' }
@@ -73,23 +97,6 @@ EmbeddedMenuMorph >> keyboardFocusChange: aBoolean [
 		ifFalse: [self selectItem: nil event: nil]
 ]
 
-{ #category : #events }
-EmbeddedMenuMorph >> keystroke: evt [
-	"Handle tabbing and arrows and cr/space."
-
-	| char selectable |
-	char := evt keyCharacter.
-	char = Character space
-		ifTrue: [ selectedItem
-				ifNotNil: [ ^ selectedItem hasSubMenu
-						ifTrue: [ evt hand newMouseFocus: selectedItem subMenu.
-							selectedItem subMenu takeKeyboardFocus ]
-						ifFalse: [ selectedItem invokeWithEvent: evt ] ].
-			(selectable := self items) size = 1 ifTrue: [ ^ selectable first invokeWithEvent: evt ].
-			^ true ].
-	^ false
-]
-
 { #category : #'keyboard control' }
 EmbeddedMenuMorph >> moveSelectionDown: anInteger event: anEvent [
 	"Move the selection down or up (negative number) by (at least)

src/Morphic-Base/MenuMorph.class.st

@@ -946,18 +946,17 @@ MenuMorph >> justDroppedInto: aMorph event: evt [
 MenuMorph >> keyDown: evt [
 	"Handle keboard item matching."
 
-	| matchString char asc selectable |
-	char := evt keyCharacter.
-	asc := char asciiValue.
-	char = Character cr
+	| matchString key selectable |
+	key := evt key.
+	key = KeyboardKey enter
 		ifTrue: [ selectedItem
 				ifNotNil: [ ^ selectedItem hasSubMenu
 						ifTrue: [ evt hand newMouseFocus: selectedItem subMenu.
 							evt hand newKeyboardFocus: selectedItem subMenu ]
 						ifFalse: [ "self delete." selectedItem invokeWithEvent: evt ] ].
 			(selectable := self items) size = 1 ifTrue: [ ^ selectable first invokeWithEvent: evt ].
 			^ self ].
-	asc = 27
+	key = KeyboardKey escape
 		ifTrue: [ "escape key"
 			self
 				valueOfProperty: #matchString
@@ -973,21 +972,21 @@ MenuMorph >> keyDown: evt [
 			^ self deselectAndFocusOutermenuOn: evt ].
 
 	"Left arrow key - If we are in a submenu, then we remove myself (i.e., the current morph) and move the focus to the owner popup"
-	asc = 28 ifTrue: [ ^ self leftArrowStroked: evt ].
+	key isArrowLeft ifTrue: [ ^ self leftArrowStroked: evt ].
 
 	"Right arrow key - If the selected menu item has a submenu, then we move the focus to the submenu "
-	asc = 29 ifTrue: [ (self rightArrowStroked: evt) ifTrue: [ ^ self ] ].
-	asc = 30 ifTrue: [ ^ self moveSelectionDown: -1 event: evt ].	"up arrow key"
-	asc = 31 ifTrue: [ ^ self moveSelectionDown: 1 event: evt ].	"down arrow key"
-	asc = 11 ifTrue: [ ^ self moveSelectionDown: -5 event: evt ].	"page up key"
-	asc = 12 ifTrue: [ ^ self moveSelectionDown: 5 event: evt ].	"page down key"
+	key isArrowRight ifTrue: [ (self rightArrowStroked: evt) ifTrue: [ ^ self ] ].
+	key isArrowUp ifTrue: [ ^ self moveSelectionDown: -1 event: evt ].	"up arrow key"
+	key isArrowDown ifTrue: [ ^ self moveSelectionDown: 1 event: evt ].	"down arrow key"
+	key = KeyboardKey pageUp ifTrue: [ ^ self moveSelectionDown: -5 event: evt ].	"page up key"
+	key = KeyboardKey pageDown ifTrue: [ ^ self moveSelectionDown: 5 event: evt ].	"page down key"
 
 	"If we reach this point, it means that we are editing the filter associated to each menu. "
 	"In case ther eis no filter associated to the menu, we simply create one"
 	matchString := self valueOfProperty: #matchString ifAbsentPut: [ String new ].
 
 	"If we press the backspace, then we simply remove the last character from matchString"
-	(char = Character backspace and: [ matchString notEmpty ])
+	(key = KeyboardKey backspace and: [ matchString notEmpty ])
 		ifTrue: [ matchString := matchString allButLast.
 			self recordFiltering: matchString.
 			self displayFiltered: evt ].