diff --git a/collects/mred/private/wx/cocoa/procs.rkt b/collects/mred/private/wx/cocoa/procs.rkt index ecf789e1..7210efd2 100644 --- a/collects/mred/private/wx/cocoa/procs.rkt +++ b/collects/mred/private/wx/cocoa/procs.rkt @@ -10,8 +10,6 @@ "../common/handlers.rkt") (provide - special-control-key - special-option-key application-file-handler application-quit-handler application-about-handler @@ -62,8 +60,6 @@ (import-class NSScreen NSCursor) -(define-unimplemented special-control-key) -(define (special-option-key on?) (void)) (define-unimplemented get-color-from-user) (define-unimplemented get-font-from-user) (define (get-panel-background) (make-object color% "gray")) diff --git a/collects/mred/private/wx/cocoa/window.rkt b/collects/mred/private/wx/cocoa/window.rkt index b1e703b5..5440658b 100644 --- a/collects/mred/private/wx/cocoa/window.rkt +++ b/collects/mred/private/wx/cocoa/window.rkt @@ -29,12 +29,29 @@ queue-window*-event request-flush-delay cancel-flush-delay - make-init-point) + make-init-point + + special-control-key + special-option-key) (define-local-member-name flip-client) ;; ---------------------------------------- +(define special-control-key? #f) +(define special-control-key + (case-lambda + [() special-control-key?] + [(on?) (set! special-control-key? (and on? #t))])) + +(define special-option-key? #f) +(define special-option-key + (case-lambda + [() special-option-key?] + [(on?) (set! special-option-key? (and on? #t))])) + +;; ---------------------------------------- + (define-objc-mixin (FocusResponder Superclass) [wxb] [-a _BOOL (acceptsFirstResponder) @@ -170,7 +187,8 @@ [bit? (lambda (m b) (positive? (bitwise-and m b)))] [pos (tell #:type _NSPoint event locationInWindow)] [str (tell #:type _NSString event characters)] - [control? (bit? modifiers NSControlKeyMask)]) + [control? (bit? modifiers NSControlKeyMask)] + [option? (bit? modifiers NSAlternateKeyMask)]) (let-values ([(x y) (send wx window-point-to-view pos)]) (let ([k (new key-event% [key-code (or @@ -188,7 +206,7 @@ [shift-down (bit? modifiers NSShiftKeyMask)] [control-down control?] [meta-down (bit? modifiers NSCommandKeyMask)] - [alt-down (bit? modifiers NSAlternateKeyMask)] + [alt-down option?] [x (->long x)] [y (->long y)] [time-stamp (->long (* (tell #:type _double event timestamp) 1000.0))] @@ -199,6 +217,13 @@ (let ([alt-code (string-ref alt-str 0)]) (unless (equal? alt-code (send k get-key-code)) (send k set-other-altgr-key-code alt-code))))) + (when (and option? + special-option-key? + (send k get-other-altgr-key-code)) + ;; swap altenate with main + (let ([other (send k get-other-altgr-key-code)]) + (send k set-other-altgr-key-code (send k get-key-code)) + (send k set-key-code other))) (if (send wx definitely-wants-event? k) (begin (queue-window-event wx (lambda () diff --git a/collects/tests/gracket/showkey.rkt b/collects/tests/gracket/showkey.rkt index 64de9155..124c4323 100644 --- a/collects/tests/gracket/showkey.rkt +++ b/collects/tests/gracket/showkey.rkt @@ -1,6 +1,14 @@ #lang racket/base (require racket/gui/base - racket/class) + racket/class + racket/cmdline) + +(command-line + #:once-each + [("--option") "set special Option key" + (special-option-key #t)] + [("--control") "set special Control key" + (special-control-key #t)]) (let () (define iter 0)