diff --git a/collects/mred/private/wx/gtk/menu-bar.rkt b/collects/mred/private/wx/gtk/menu-bar.rkt index d2464823b2..250f9d22e3 100644 --- a/collects/mred/private/wx/gtk/menu-bar.rkt +++ b/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) - (regexp-replace* - "&&" - (regexp-replace* - #rx"&([^&])" - (regexp-replace* - #rx"_" - (regexp-replace #rx"\t.*$" title "") - "__") - "_\\1") - "&")) +(define (fixup-mnemonic title) + (mnemonic-string (regexp-replace #rx"\t.*$" title ""))) (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])]) diff --git a/collects/mred/private/wx/gtk/menu.rkt b/collects/mred/private/wx/gtk/menu.rkt index a2f2e09d0d..7402c4bbc6 100644 --- a/collects/mred/private/wx/gtk/menu.rkt +++ b/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)]) diff --git a/collects/mred/private/wx/gtk/message.rkt b/collects/mred/private/wx/gtk/message.rkt index c11673507c..7b72085e05 100644 --- a/collects/mred/private/wx/gtk/message.rkt +++ b/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 - mnemonic-string)) + gtk_label_set_text_with_mnemonic)) ;; ---------------------------------------- @@ -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) diff --git a/collects/mred/private/wx/gtk/utils.rkt b/collects/mred/private/wx/gtk/utils.rkt index ac35d2764e..f0a469f4f4 100644 --- a/collects/mred/private/wx/gtk/utils.rkt +++ b/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")) + "&")) diff --git a/collects/tests/gracket/item.rkt b/collects/tests/gracket/item.rkt index cb413abc37..83c08ac4f5 100644 --- a/collects/tests/gracket/item.rkt +++ b/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))