class: DeviceWorkstation
authorClaus Gittinger <cg@exept.de>
Fri, 01 Aug 2014 08:50:36 +0200
changeset 6557 0645e51b86c1
parent 6556 f2418ba5d1c5
child 6558 dc5220f2ce3b
class: DeviceWorkstation changed: #prependModifierToKey: also prepend Shift modifier, but only if there is a translation. Now, ShiftFx or ShiftReturn will be sent as key, iff there is a translation for that key, keyPress methods ought to be changed to deal with that.
DeviceWorkstation.st
--- a/DeviceWorkstation.st	Tue Jul 29 21:26:30 2014 +0200
+++ b/DeviceWorkstation.st	Fri Aug 01 08:50:36 2014 +0200
@@ -6886,16 +6886,16 @@
 !
 
 prependModifierToKey:untranslatedKey
-    |xlatedKey s modifier|
+    |xlatedKey s modifier k|
 
     (ctrlDown and:[ metaDown ]) ifTrue:[
-	"/ right-ALT: already xlated (I hope)
-	^ untranslatedKey
+        "/ right-ALT: already xlated (I hope)
+        ^ untranslatedKey
     ].
 
     xlatedKey := untranslatedKey.
     xlatedKey isCharacter ifFalse:[
-	xlatedKey := xlatedKey asSymbol
+        xlatedKey := xlatedKey asSymbol
     ].
 
     modifier := self modifierKeyTranslationFor:untranslatedKey.
@@ -6908,37 +6908,45 @@
     "/ only prepend, if this is not a modifier (otherwise, we get CmdCmd or CtrlCtrl)
     "/
     modifier isNil ifTrue:[
-	s := xlatedKey asString.
-
-	"/ NO, do not prepend the Shift modifier.
-	"/ although logical, this makes many keyPress methods incompatible.
-	"/ sigh.
+        s := xlatedKey asString.
+
+        "/ NO, do not prepend the Shift modifier.
+        "/ although logical, this makes many keyPress methods incompatible.
+        "/ sigh.
 "/        xlatedKey isSymbol ifTrue:[
 "/            shiftDown ifTrue:[
 "/                xlatedKey := 'Shift' , s
 "/            ].
 "/        ].
-	ctrlDown ifTrue:[
-	    xlatedKey := 'Ctrl' , s
-	].
-	metaDown ifTrue:[                     "/ sigh - new hp's have both CMD and META keys.
-	    xlatedKey := 'Cmd' , s
-	].
-	altDown ifTrue:[
-	    xlatedKey := 'Alt' , s
-	].
-	xlatedKey isCharacter ifFalse:[
-	    "/ no - breaks a lot of code which is not prepared for that
-	    "/ and checks shiftDown instead...
-	    "/ shiftDown ifTrue:[
-	    "/    xlatedKey := 'Shift' , s
-	    "/].
-
-	    "/ sigh: twoByteSymbols are not (yet) allowed
-	    xlatedKey isWideString ifFalse:[
-		xlatedKey := xlatedKey asSymbol
-	    ].
-	].
+        ctrlDown ifTrue:[
+            xlatedKey := 'Ctrl' , s
+        ].
+        metaDown ifTrue:[                     "/ sigh - new hp's have both CMD and META keys.
+            xlatedKey := 'Cmd' , s
+        ].
+        altDown ifTrue:[
+            xlatedKey := 'Alt' , s
+        ].
+        xlatedKey isCharacter ifFalse:[
+            "/ prepend Shift modifier
+            "/   if done unconditionally, this breaks a lot of code.
+            "/   which is not prepared for that and checks shiftDown instead.
+            "/   Therefore, this must be changed at the places where shiftDown is checked for!!
+            "/   In the meanwhile, only do it iff there is a translation.
+            Display shiftDown ifTrue:[
+                (k := ('Shift' , s) asSymbolIfInterned) notNil ifTrue:[
+                    (self keyboardMap hasBindingFor:k) ifTrue:[
+                        xlatedKey := k.
+                        "/ Transcript show:k ; show:' -> '; showCR:(self keyboardMap valueFor:k).
+                    ]
+                ].
+            ].
+
+            "/ sigh: twoByteSymbols are not (yet) allowed
+            xlatedKey isWideString ifFalse:[
+                xlatedKey := xlatedKey asSymbol
+            ].
+        ].
     ].
 
     ^ xlatedKey
@@ -8373,11 +8381,11 @@
 !DeviceWorkstation class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libview/DeviceWorkstation.st,v 1.620 2014-07-25 21:25:22 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/libview/DeviceWorkstation.st,v 1.621 2014-08-01 06:50:36 cg Exp $'
 !
 
 version_CVS
-    ^ '$Header: /cvs/stx/stx/libview/DeviceWorkstation.st,v 1.620 2014-07-25 21:25:22 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/libview/DeviceWorkstation.st,v 1.621 2014-08-01 06:50:36 cg Exp $'
 ! !