suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

gtk: fix menu-item shortcut updating

Browse Source
This commit is contained in:
Matthew Flatt 2011-09-01 07:13:13 -06:00
parent 9d5f45a9d1
commit 459d2422e3
1 changed files with 22 additions and 19 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
collects/mred/private/wx/gtk/menu.rkt
View File

@ -181,10 +181,10 @@
(unless (unbox cnb) (unless (unbox cnb)
(cb this e))))))) (cb this e)))))))
(define/private (adjust-shortcut item-gtk title) (define/private (adjust-shortcut item-gtk title need-clear?)
(let ([m (regexp-match #rx"\t(Ctrl[+])?(Shift[+])?(Meta[+])?(Alt[+])?(.|[0-9]+)$" (let ([m (regexp-match #rx"\t(Ctrl[+])?(Shift[+])?(Meta[+])?(Alt[+])?(.|[0-9]+)$"
title)]) title)])
(when m (if m
(let ([mask (+ (if (list-ref m 1) GDK_CONTROL_MASK 0) (let ([mask (+ (if (list-ref m 1) GDK_CONTROL_MASK 0)
(if (list-ref m 2) GDK_SHIFT_MASK 0) (if (list-ref m 2) GDK_SHIFT_MASK 0)
(if (list-ref m 3) GDK_MOD1_MASK 0) (if (list-ref m 3) GDK_MOD1_MASK 0)
@ -199,7 +199,9 @@
(gtk_accel_map_add_entry accel-path (gtk_accel_map_add_entry accel-path
code code
mask) mask)
(gtk_menu_item_set_accel_path item-gtk accel-path))))))) (gtk_menu_item_set_accel_path item-gtk accel-path))))
(when need-clear?
(gtk_menu_item_set_accel_path item-gtk #f)))))
(public [append-item append]) (public [append-item append])
(define (append-item i label help-str-or-submenu chckable?) (define (append-item i label help-str-or-submenu chckable?)
@ -226,7 +228,7 @@
[menu-item i] [menu-item i]
[parent this])]) [parent this])])
(set! items (append items (list (list item item-gtk label chckable?)))) (set! items (append items (list (list item item-gtk label chckable?))))
(adjust-shortcut item-gtk label))) (adjust-shortcut item-gtk label #f)))
(gtk_menu_shell_append gtk item-gtk) (gtk_menu_shell_append gtk item-gtk)
(gtk_widget_show item-gtk)))) (gtk_widget_show item-gtk))))
@ -258,7 +260,8 @@
(let ([gtk (find-gtk item)]) (let ([gtk (find-gtk item)])
(when gtk (when gtk
(gtk_label_set_text_with_mnemonic (gtk_bin_get_child gtk) (gtk_label_set_text_with_mnemonic (gtk_bin_get_child gtk)
(fixup-mnemonic str))))) (fixup-mnemonic str))
(adjust-shortcut gtk str #t))))
(define/public (enable item on?) (define/public (enable item on?)
(let ([gtk (find-gtk item)]) (let ([gtk (find-gtk item)])