diff --git a/collects/mred/private/const.ss b/collects/mred/private/const.ss index 0ac55430..d19fee21 100644 --- a/collects/mred/private/const.ss +++ b/collects/mred/private/const.ss @@ -1,5 +1,6 @@ (module const mzscheme (require (lib "class.ss") + (lib "file.ss") (prefix wx: "kernel.ss")) (provide (protect (all-defined))) @@ -36,6 +37,18 @@ (define ibeam (make-object wx:cursor% 'ibeam)) (define arrow-cursor (make-object wx:cursor% 'arrow)) + (define default-x-prefix (if (eq? 'unix (system-type)) + (let ([v (get-preference '|MrEd:defaultMenuPrefix| (lambda () 'ctl))]) + (if (memq v '(meta ctl alt ctl-m)) + v + 'ctl)) + 'ctl)) + + (define (menu-shortcut-in-label?) + (case (system-type) + [(unix) (not (memq default-x-prefix '(alt meta)))] + [else (wx:shortcut-visible-in-label? #t)])) + (define bg-color (wx:get-panel-background)) (define (scale-color c f) diff --git a/collects/mred/private/mrmenu.ss b/collects/mred/private/mrmenu.ss index 8c494b44..0566935e 100644 --- a/collects/mred/private/mrmenu.ss +++ b/collects/mred/private/mrmenu.ss @@ -65,7 +65,14 @@ (super-init wx))) (restore)))) - (define (strip-tab s) (car (regexp-match #rx"^[^\t]*" s))) + (define strip-tab + (if (menu-shortcut-in-label?) + (lambda (s) + (car (regexp-match #rx"^[^\t]*" s))) + (lambda (s) + (regexp-replace* "&" + (regexp-replace* "&(.)" (car (regexp-match #rx"^[^\t]*" s)) "\\1") + "\\&\\&")))) (define basic-labelled-menu-item% (class100* mred% (labelled-menu-item<%>) (prnt lbl help-str wx-sub chkble? keymap set-wx demand-callback) @@ -122,7 +129,7 @@ (send wx-parent append (send wx id) label wx-submenu help-string) (send wx-parent append (send wx id) label help-string checkable?)) (send wx-parent append-item this wx)) - (send wx-parent append-item this wx-submenu label)) + (send wx-parent append-item this wx-submenu (strip-tab label))) (set! shown? #t) (do-enable enabled?))))] [delete (entry-point @@ -173,7 +180,7 @@ (check-instance '(method selectable-menu-item<%> command) wx:control-event% 'control-event% #f e) (void (callback this e)))]) (private-field - [x-prefix 'meta]) + [x-prefix default-x-prefix]) (private [calc-labels (lambda (label) (let* ([new-label (if shortcut diff --git a/collects/mred/private/wxmenu.ss b/collects/mred/private/wxmenu.ss index b881f93e..dd06f528 100644 --- a/collects/mred/private/wxmenu.ss +++ b/collects/mred/private/wxmenu.ss @@ -54,7 +54,7 @@ (as-exit (lambda () (or (send keymap handle-key-event this event) - (and (wx:shortcut-visible-in-label? #t) + (and (menu-shortcut-in-label?) (send event get-meta-down) (char? (send event get-key-code)) (let ([c (send event get-key-code)]) @@ -68,7 +68,7 @@ [menu (cdr data)]) (if (regexp-match re label) (begin - (send menu select) + (send menu select this) #t) #f))) items)))))))))]