git: fix "&" and "_" handling in labels

original commit: ff49859c800cff72f662308475aafda098f20950

collects/mred/private/wx/gtk/menu-bar.rkt

@@ -14,7 +14,7 @@
  (protect-out menu-bar%
               gtk_menu_item_new_with_mnemonic
               gtk_menu_shell_append
-              fixup-mneumonic))
+              fixup-mnemonic))
 
 (define-gtk gtk_menu_bar_new (_fun -> _GtkWidget))
 (define-gtk gtk_menu_shell_append (_fun _GtkWidget _GtkWidget -> _void))
@@ -26,17 +26,8 @@
 
 (define-gtk gtk_widget_set_usize (_fun _GtkWidget _int _int -> _void))
 
-(define (fixup-mneumonic title)
+(define (fixup-mnemonic title)
-  (regexp-replace*
+  (mnemonic-string (regexp-replace #rx"\t.*$" title "")))
-   "&&"
-   (regexp-replace*
-    #rx"&([^&])"
-    (regexp-replace*
-     #rx"_" 
-     (regexp-replace #rx"\t.*$" title "")
-     "__")
-    "_\\1")
-   "&"))
 
 (define-signal-handler connect-select "select"
   (_fun _GtkWidget -> _void)
@@ -136,7 +127,7 @@
     (let ([l (list-ref menus pos)])
       (let ([item-gtk (car l)])
 	(gtk_label_set_text_with_mnemonic (gtk_bin_get_child item-gtk) 
-                                          (fixup-mneumonic str)))))
+                                          (fixup-mnemonic str)))))
     
   (define/public (enable-top pos on?)
     (gtk_widget_set_sensitive (car (list-ref menus pos)) on?))
@@ -159,7 +150,7 @@
   (define (append-menu menu title)
     (send menu set-parent this)
     (atomically
-     (let* ([item (let ([title (fixup-mneumonic title)])
+     (let* ([item (let ([title (fixup-mnemonic title)])
                     (as-gtk-allocation
                      (gtk_menu_item_new_with_mnemonic title)))]
             [item-wx (new top-menu% [parent this] [gtk item])])

collects/mred/private/wx/gtk/menu.rkt

@@ -204,7 +204,7 @@
   (public [append-item append])
   (define (append-item i label help-str-or-submenu chckable?)
     (atomically
-     (let ([item-gtk (let ([label (fixup-mneumonic label)])
+     (let ([item-gtk (let ([label (fixup-mnemonic label)])
                        (as-gtk-allocation
                         ((if (and chckable?
                                   (not (help-str-or-submenu . is-a? . menu%)))
@@ -258,7 +258,7 @@
     (let ([gtk (find-gtk item)])
       (when gtk
         (gtk_label_set_text_with_mnemonic (gtk_bin_get_child gtk) 
-                                          (fixup-mneumonic str)))))
+                                          (fixup-mnemonic str)))))
 
   (define/public (enable item on?)
     (let ([gtk (find-gtk item)])

collects/mred/private/wx/gtk/message.rkt

@@ -13,8 +13,7 @@
  (protect-out message%
               
               gtk_label_new_with_mnemonic
-              gtk_label_set_text_with_mnemonic
+              gtk_label_set_text_with_mnemonic))
-              mnemonic-string))
 
 ;; ----------------------------------------
 
@@ -25,17 +24,6 @@
 (define-gtk gtk_misc_set_alignment (_fun _GtkWidget _float _float -> _void))
 (define-gtk gtk_image_set_from_pixbuf (_fun _GtkWidget _GdkPixbuf -> _void))
 
-(define (mnemonic-string s)
-  (if (regexp-match? #rx"&" s)
-      (regexp-replace*
-       #rx"_&"
-       (regexp-replace*
-        #rx"&(.)"
-        (regexp-replace* #rx"_" s "__")
-        "_\\1")
-       "\\&")
-      (regexp-replace* #rx"_" s "__")))
-
 (define (gtk_label_new_with_mnemonic s)
   (let ([l (gtk_label_new s)])
     (when (regexp-match? #rx"&" s)

collects/mred/private/wx/gtk/utils.rkt

@@ -2,6 +2,7 @@
 (require ffi/unsafe
          ffi/unsafe/define
          ffi/unsafe/alloc
+         racket/string
          racket/draw/unsafe/glib
          (only-in '#%foreign ctype-c->scheme)
          "../common/utils.rkt"
@@ -47,7 +48,8 @@
               gdk_screen_get_default
 
               ;; for declaring derived structures:
-              _GtkObject))
+              _GtkObject)
+ mnemonic-string)
 
 (define gdk-lib 
   (case (system-type)
@@ -182,3 +184,16 @@
                  (g_slist_free gl)))))
 
 (define-gdk gdk_screen_get_default (_fun -> _GdkScreen))
+
+
+(define (mnemonic-string orig-s)
+  (string-join
+   (for/list ([s (in-list (regexp-split #rx"&&" orig-s))])
+     (regexp-replace*
+      #rx"&(.)"
+      (regexp-replace*
+       #rx"_" 
+       s
+       "__")
+      "_\\1"))
+   "&"))

collects/tests/gracket/item.rkt

@@ -270,6 +270,10 @@
 					 "6 && Half-D&ozen"
 					 m
 					 void)
+			    (make-object menu-item%
+					 "&&_A"
+					 m
+					 void)
 			    (let mloop ([m m][sub-at-50? #t])
 			      (let ([sm (if (and sub-at-50?
 						 (send e button-down? 'middle))