From a8473ec1aaa2b623b3ce622e4775ceddfbaecf07 Mon Sep 17 00:00:00 2001
From: Robby Findler <robby@racket-lang.org>
Date: Sat, 22 Jun 2013 15:28:21 -0500
Subject: [PATCH] adjust make-meta-prefix-list and
 keymap:send-map-function-meta to only add ~c: when asked to (and then asked
 them to do it a bunch)

---
 pkgs/gui-pkgs/gui-lib/framework/main.rkt      | 26 ++++++++++++++-----
 .../gui-lib/framework/private/keymap.rkt      | 24 ++++++++++-------
 2 files changed, 34 insertions(+), 16 deletions(-)

diff --git a/pkgs/gui-pkgs/gui-lib/framework/main.rkt b/pkgs/gui-pkgs/gui-lib/framework/main.rkt
index 6cb6d7e277..459a459ef2 100644
--- a/pkgs/gui-pkgs/gui-lib/framework/main.rkt
+++ b/pkgs/gui-pkgs/gui-lib/framework/main.rkt
@@ -1168,10 +1168,14 @@
 
  (proc-doc/names
   keymap:make-meta-prefix-list
-  (string? . -> . (listof string?))
-  (key)
+  (->* (string?) (boolean?) (listof string?))
+  ((key)
+   ((mask-control? #f)))
   @{This prefixes a key with all of the different meta prefixes and returns a
-    list of the prefixed strings.
+    list of the prefixed strings. If @racket[mask-control?] is @racket[#t],
+    then the result strings include @racket["~c:"] in them 
+    (see @racket[keymap:send-map-function-meta]) for a fuller discussion of this
+    boolean).
     
     Takes a keymap, a base key specification, and a function name; it prefixes
     the base key with all ``meta'' combination prefixes, and installs the new
@@ -1181,8 +1185,9 @@
 
  (proc-doc/names
   keymap:send-map-function-meta
-  ((is-a?/c keymap%) string? string? . -> . void?)
-  (keymap key func)
+  (->* ((is-a?/c keymap%) string? string?) (boolean?) void?)
+  ((keymap key func)
+   ((mask-control? #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
@@ -1191,7 +1196,16 @@
     combinations can also be accessed by using ``ESC'' as a prefix.
     
     This procedure binds all of the key-bindings obtained by prefixing
-    @racket[key] with a meta-prefix to @racket[func] in @racket[keymap].})
+    @racket[key] with a meta-prefix to @racket[func] in @racket[keymap].
+    
+    If @racket[mask-control?] is @racket[#t],
+    then the result strings include @racket["~c:"] in them.
+    This is important under Windows where international keyboards
+    often require characters that are unmodified on US keyboards to
+    be typed with the AltGr key; such keys come into the system as
+    having both the control and the meta modified applied to them and, 
+    generally speaking, keybindings should not change the behavior of
+    those keys.})
 
  (proc-doc/names
   keymap:setup-editor
diff --git a/pkgs/gui-pkgs/gui-lib/framework/private/keymap.rkt b/pkgs/gui-pkgs/gui-lib/framework/private/keymap.rkt
index 6bb3422937..d4c2981c6e 100644
--- a/pkgs/gui-pkgs/gui-lib/framework/private/keymap.rkt
+++ b/pkgs/gui-pkgs/gui-lib/framework/private/keymap.rkt
@@ -320,16 +320,17 @@
   ;;;;;;;                                                     ;;;;;;;;
   ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   
-  (define (make-meta-prefix-list key)
-    (list (if (regexp-match #rx"(?:^|:)c:" key)
+  (define (make-meta-prefix-list key [mask-control? #f])
+    (list (if mask-control?
               (string-append "m:" key)
               (string-append "~c:m:" key))
           (string-append "ESC;" key)))
   
-  (define send-map-function-meta
-    (λ (keymap key func)
-      (for-each (λ (key) (send keymap map-function key func))
-                (make-meta-prefix-list key))))
+  (define (send-map-function-meta keymap key func [mask-control? #f])
+    (for ([key (in-list (make-meta-prefix-list key mask-control?))])
+      (send keymap map-function key func)))
+  
+  (define has-control-regexp #rx"(?:^|:)c:")
   
   (define add-to-right-button-menu (make-parameter void))
   (define add-to-right-button-menu/before (make-parameter void))
@@ -1041,7 +1042,8 @@
         (let* ([map (λ (key func) 
                       (send kmap map-function key func))]
                [map-meta (λ (key func)
-                           (send-map-function-meta kmap key func))]
+                           (send-map-function-meta kmap key func
+                                                   (regexp-match has-control-regexp key)))]
                [add (λ (name func)
                       (send kmap add-function name func))]
                [add-m (λ (name func)
@@ -1346,8 +1348,9 @@
       (λ (kmap)
         (let* ([map (λ (key func) 
                       (send kmap map-function key func))]
-               [map-meta (λ (key func)
-                           (send-map-function-meta kmap key func))]
+               [map-meta (λ (key func mask-control?)
+                           (send-map-function-meta kmap key func
+                                                   (regexp-match has-control-regexp key)))]
                [add (λ (name func)
                       (send kmap add-function name func))]
                [add-m (λ (name func)
@@ -1413,7 +1416,8 @@
         (let* ([map (λ (key func) 
                       (send kmap map-function key func))]
                [map-meta (λ (key func)
-                           (send-map-function-meta kmap key func))]
+                           (send-map-function-meta kmap key func 
+                                                   (regexp-match has-control-regexp key)))]
                [add (λ (name func)
                       (send kmap add-function name func))]
                [add-m (λ (name func)