From d95a6b02b04b764d7009a2712424c64d8f54f8ee Mon Sep 17 00:00:00 2001 From: Robby Findler Date: Thu, 28 Nov 2013 20:24:40 -0600 Subject: [PATCH] add support for alt-as-meta to the mac os x drracket --- .../scribblings/drracket/keybindings.scrbl | 7 +- pkgs/gui-pkgs/gui-lib/framework/main.rkt | 14 ++- .../gui-lib/framework/private/keymap.rkt | 105 ++++++++++++------ .../gui-lib/framework/private/preferences.rkt | 3 + .../private/english-string-constants.rkt | 1 + 5 files changed, 90 insertions(+), 40 deletions(-) diff --git a/pkgs/drracket-pkgs/drracket/scribblings/drracket/keybindings.scrbl b/pkgs/drracket-pkgs/drracket/scribblings/drracket/keybindings.scrbl index 17a4c5b952..2712610a11 100644 --- a/pkgs/drracket-pkgs/drracket/scribblings/drracket/keybindings.scrbl +++ b/pkgs/drracket-pkgs/drracket/scribblings/drracket/keybindings.scrbl @@ -37,8 +37,11 @@ key. Depending on your keyboard, Meta may be called ``Left,'' ``Right,'' or have a diamond symbol, but it's usually on the bottom row next to the space bar. M-@nonterm{key} can also be performed as a two-character sequence: first, strike and release the Escape key, then -strike @nonterm{key}. On Windows and Mac OS X, Meta is only -available through the Escape key. +strike @nonterm{key}. On Mac OS X, Meta is, by default, +available only through the Escape key. But the preferences dialog +(in the @onscreen{General} sub-panel of the @onscreen{Editing} panel) +has check boxes that adjust the handling of the Alt key or the Command +key to be meta. DEL is the Delete key. diff --git a/pkgs/gui-pkgs/gui-lib/framework/main.rkt b/pkgs/gui-pkgs/gui-lib/framework/main.rkt index ddf5a327d7..a2902760e5 100644 --- a/pkgs/gui-pkgs/gui-lib/framework/main.rkt +++ b/pkgs/gui-pkgs/gui-lib/framework/main.rkt @@ -1187,9 +1187,12 @@ (proc-doc/names keymap:send-map-function-meta - (->* ((is-a?/c keymap%) string? string?) (boolean?) void?) + (->* ((is-a?/c keymap%) string? string?) + (boolean? #:alt-as-meta-keymap (or/c (is-a?/c keymap%) #f)) + void?) ((keymap key func) - ((mask-control? #f))) + ((mask-control? #f) + (alt-as-meta-keymap #f))) @{@index{Meta} Most keyboard and mouse mappings are inserted into a keymap by calling the keymap's @method[keymap% map-function] method. However, ``meta'' combinations require special attention. The @racket["m:"] prefix @@ -1200,6 +1203,13 @@ This procedure binds all of the key-bindings obtained by prefixing @racket[key] with a meta-prefix to @racket[func] in @racket[keymap]. + If @racket[alt-as-meta-keymap] is a @racket[keymap%] object, then the + the key binding @racket[(string-append "?:a:" key)] is bound to + @racket[func] in @racket[alt-as-meta-keymap]. Additionally, if + @racket[func] has not been added (via @method[add-function keymap%]) + to @racket[alt-as-meta-keymap], then @racket[keymap:send-map-function-meta] + signals an error. + If @racket[mask-control?] is @racket[#t], then the result strings include @racket["~c:"] in them. This is important under Windows where international keyboards diff --git a/pkgs/gui-pkgs/gui-lib/framework/private/keymap.rkt b/pkgs/gui-pkgs/gui-lib/framework/private/keymap.rkt index d6b6cc27fd..362b18f74b 100644 --- a/pkgs/gui-pkgs/gui-lib/framework/private/keymap.rkt +++ b/pkgs/gui-pkgs/gui-lib/framework/private/keymap.rkt @@ -213,12 +213,12 @@ ;; if two key bindings refer to the same key. ;; Assumes a well-formed keystring. (define (canonicalize-keybinding-string str) - (let* ([chars (map char-downcase (string->list str))] - [separated-keys - (map - canonicalize-single-keybinding-string - (split-out #\; chars))]) - (join-strings ";" separated-keys))) + (define chars (map char-downcase (string->list str))) + (define separated-keys + (map + canonicalize-single-keybinding-string + (split-out #\; chars))) + (join-strings ";" separated-keys)) ;; join-strings : string (listof string) -> string ;; concatenates strs with sep between each of them @@ -334,9 +334,16 @@ (string-append "~c:m:" key)) (string-append "ESC;" key))) - (define (send-map-function-meta keymap key func [mask-control? #f]) + (define (send-map-function-meta keymap key func [mask-control? #f] + #:alt-as-meta-keymap [alt-as-meta-keymap #f]) (for ([key (in-list (make-meta-prefix-list key mask-control?))]) - (send keymap map-function key func))) + (send keymap map-function key func)) + (when alt-as-meta-keymap + (unless (send alt-as-meta-keymap is-function-added? func) + (error 'send-map-function-meta + "expected to find ~s mapped in alt-as-meta-keymap" + func)) + (send alt-as-meta-keymap map-function (string-append "?:a:" key) func))) (define has-control-regexp #rx"(?:^|:)c:") @@ -1045,16 +1052,19 @@ (when (= start (send txt get-end-position)) (center-in-unicode-ascii-art-box txt start)))]) - (λ (kmap) + (λ (kmap #:alt-as-meta-keymap [alt-as-meta-keymap #f]) (let* ([map (λ (key func) (send kmap map-function key func))] [map-meta (λ (key func) (send-map-function-meta kmap key func - (regexp-match has-control-regexp key)))] + (regexp-match has-control-regexp key) + #:alt-as-meta-keymap alt-as-meta-keymap))] [add (λ (name func) (send kmap add-function name func))] [add-m (λ (name func) - (send kmap add-function name func))]) + (send kmap add-function name func) + (when alt-as-meta-keymap + (send alt-as-meta-keymap add-function name func)))]) ; Map names to keyboard functions @@ -1073,12 +1083,12 @@ (add "TeX compress" TeX-compress) (add "newline" newline) - (add "down-into-embedded-editor" down-into-embedded-editor) - (add "up-out-of-embedded-editor" up-out-of-embedded-editor) - (add "forward-to-next-embedded-editor" forward-to-next-embedded-editor) - (add "back-to-prev-embedded-editor" back-to-prev-embedded-editor) + (add-m "down-into-embedded-editor" down-into-embedded-editor) + (add-m "up-out-of-embedded-editor" up-out-of-embedded-editor) + (add-m "forward-to-next-embedded-editor" forward-to-next-embedded-editor) + (add-m "back-to-prev-embedded-editor" back-to-prev-embedded-editor) - (add "toggle-overwrite (when enabled in prefs)" toggle-overwrite) + (add-m "toggle-overwrite (when enabled in prefs)" toggle-overwrite) (add "exit" (λ (edit event) (let ([frame (send edit get-frame)]) @@ -1092,23 +1102,23 @@ (add "toggle-anchor" toggle-anchor) (add "center-view-on-line" center-view-on-line) - (add "collapse-space" collapse-space) + (add-m "collapse-space" collapse-space) (add "remove-space" remove-space) (add "collapse-newline" collapse-newline) (add "open-line" open-line) (add "transpose-chars" transpose-chars) - (add "transpose-words" transpose-words) - (add "capitalize-word" capitalize-word) - (add "upcase-word" upcase-word) - (add "downcase-word" downcase-word) - (add "kill-word" kill-word) - (add "backward-kill-word" backward-kill-word) + (add-m "transpose-words" transpose-words) + (add-m "capitalize-word" capitalize-word) + (add-m "upcase-word" upcase-word) + (add-m "downcase-word" downcase-word) + (add-m "kill-word" kill-word) + (add-m "backward-kill-word" backward-kill-word) (let loop ([n 9]) (unless (negative? n) (let ([s (number->string n)]) - (add (string-append "command-repeat-" s) - (make-make-repeater n)) + (add-m (string-append "command-repeat-" s) + (make-make-repeater n)) (loop (sub1 n))))) (add "keyboard-macro-run-saved" do-macro) @@ -1125,7 +1135,7 @@ (add-m "select-click-word" select-click-word) (add-m "select-click-line" select-click-line) - (add "goto-line" goto-line) + (add-m "goto-line" goto-line) (add "delete-key" delete-key) @@ -1353,16 +1363,19 @@ (invoke-method frame) (bell))) #t))]) - (λ (kmap) + (λ (kmap #:alt-as-meta-keymap [alt-as-meta-keymap #f]) (let* ([map (λ (key func) (send kmap map-function key func))] [map-meta (λ (key func) (send-map-function-meta kmap key func - (regexp-match has-control-regexp key)))] + (regexp-match has-control-regexp key) + #:alt-as-meta-keymap alt-as-meta-keymap))] [add (λ (name func) (send kmap add-function name func))] [add-m (λ (name func) - (send kmap add-function name func))]) + (send kmap add-function name func) + (when alt-as-meta-keymap + (send alt-as-meta-keymap add-function name func)))]) (add "search forward" (send-frame (λ (f) (send f search 'forward)))) @@ -1420,16 +1433,19 @@ (let-values ([(base name dir) (split-path fn)]) base)))) #t)]) - (λ (kmap) + (λ (kmap #:alt-as-meta-keymap [alt-as-meta-keymap #f]) (let* ([map (λ (key func) (send kmap map-function key func))] [map-meta (λ (key func) (send-map-function-meta kmap key func - (regexp-match has-control-regexp key)))] + (regexp-match has-control-regexp key) + #:alt-as-meta-keymap alt-as-meta-keymap))] [add (λ (name func) (send kmap add-function name func))] [add-m (λ (name func) - (send kmap add-function name func))]) + (send kmap add-function name func) + (when alt-as-meta-keymap + (send alt-as-meta-keymap add-function name func)))]) (add "save-file" save-file) (add "save-file-as" save-file-as) @@ -1457,7 +1473,7 @@ func))]) (add/map "editor-undo" 'undo "z") (unless (eq? (system-type) 'macosx) - (add/map "editor-redo" 'redo "y")) + (add/map "editor-redo" 'redo "y")) (add/map "editor-cut" 'cut "x") (add/map "editor-copy" 'copy "c") (add/map "editor-paste" 'paste "v") @@ -1473,25 +1489,42 @@ (define global (make-object aug-keymap%)) (define global-main (make-object aug-keymap%)) + (define global-alt-as-meta (make-object aug-keymap%)) (send global chain-to-keymap global-main #f) (generic-setup global-main) - (setup-global global-main) + (generic-setup global-alt-as-meta) + (setup-global global-main #:alt-as-meta-keymap global-alt-as-meta) (define (get-global) global) (define file (make-object aug-keymap%)) + (define file-alt-as-meta (make-object aug-keymap%)) (generic-setup file) - (setup-file file) + (setup-file file #:alt-as-meta-keymap file-alt-as-meta) (define (-get-file) file) (define search (make-object aug-keymap%)) + (define search-alt-as-meta (make-object aug-keymap%)) (generic-setup search) - (setup-search search) + (setup-search search #:alt-as-meta-keymap search-alt-as-meta) (define (get-search) search) (define editor (make-object aug-keymap%)) (setup-editor editor) (define (get-editor) editor) + (preferences:set-default 'framework:alt-as-meta #f boolean?) + (define (adjust-alt-as-meta on?) + (send global-main remove-chained-keymap global-alt-as-meta) + (send file remove-chained-keymap file-alt-as-meta) + (send search remove-chained-keymap search-alt-as-meta) + (when on? + (send global-main chain-to-keymap global-alt-as-meta #f) + (send file chain-to-keymap file-alt-as-meta #f) + (send search chain-to-keymap search-alt-as-meta #f))) + (preferences:add-callback 'framework:alt-as-meta + (λ (p v) (adjust-alt-as-meta v))) + (adjust-alt-as-meta (preferences:get 'framework:alt-as-meta)) + (define (call/text-keymap-initializer thunk) (let ([ctki (current-text-keymap-initializer)]) (parameterize ([current-text-keymap-initializer diff --git a/pkgs/gui-pkgs/gui-lib/framework/private/preferences.rkt b/pkgs/gui-pkgs/gui-lib/framework/private/preferences.rkt index 2b38e75313..18b242b2ec 100644 --- a/pkgs/gui-pkgs/gui-lib/framework/private/preferences.rkt +++ b/pkgs/gui-pkgs/gui-lib/framework/private/preferences.rkt @@ -467,6 +467,9 @@ the state transitions / contracts are: 'framework:menu-bindings (string-constant enable-keybindings-in-menus)) (when (memq (system-type) '(macosx)) + (add-check editor-panel + 'framework:alt-as-meta + (string-constant alt-as-meta)) (add-check editor-panel 'framework:special-meta-key (string-constant command-as-meta))) diff --git a/pkgs/string-constants-pkgs/string-constants-lib/string-constants/private/english-string-constants.rkt b/pkgs/string-constants-pkgs/string-constants-lib/string-constants/private/english-string-constants.rkt index c32093af6c..9fa39cb8e1 100644 --- a/pkgs/string-constants-pkgs/string-constants-lib/string-constants/private/english-string-constants.rkt +++ b/pkgs/string-constants-pkgs/string-constants-lib/string-constants/private/english-string-constants.rkt @@ -531,6 +531,7 @@ please adhere to these guidelines: (print-to-ps "Print to PostScript File") (print-to-pdf "Print to PDF File") (command-as-meta "Treat command key as meta") ;; macos/macos x only + (alt-as-meta "Treat alt key as meta") (reuse-existing-frames "Reuse existing frames when opening new files") (default-fonts "Default Fonts") (basic-gray-paren-match-color "Basic gray parenthesis highlight color") ; in prefs dialog