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

gtk: fix memory management for menus

Browse Source 
original commit: 3f28042517322ea4a7120e37e7a77c24a3d059f2
This commit is contained in:
Matthew Flatt 2010-10-16 10:22:46 -06:00
parent 790d5d1f01
commit dca0bd7385
2 changed files with 11 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
collects/mred/private/wx/gtk/menu-bar.rkt
View File

@ -135,7 +135,9 @@
(define (append-menu menu title)
(send menu set-parent this)
(atomically
(let* ([item (gtk_menu_item_new_with_mnemonic (fixup-mneumonic title))]
(let* ([item (let ([title (fixup-mneumonic title)])
(as-gtk-allocation
(gtk_menu_item_new_with_mnemonic title)))]
[item-wx (new top-menu% [parent this] [gtk item])])
(connect-select item)
(set! menus (append menus (list (list item menu item-wx))))

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

@ -182,11 +182,13 @@
(public [append-item append])
(define (append-item i label help-str-or-submenu chckable?)
(atomically
(let ([item-gtk ((if (and chckable?
(not (help-str-or-submenu . is-a? . menu%)))
gtk_check_menu_item_new_with_mnemonic
gtk_menu_item_new_with_mnemonic)
(fixup-mneumonic label))])
(let ([item-gtk (let ([label (fixup-mneumonic label)])
(as-gtk-allocation
((if (and chckable?
(not (help-str-or-submenu . is-a? . menu%)))
gtk_check_menu_item_new_with_mnemonic
gtk_menu_item_new_with_mnemonic)
label)))])
(if (help-str-or-submenu . is-a? . menu%)
(let ([submenu help-str-or-submenu])
(let ([gtk (send submenu get-gtk)])
@ -208,7 +210,7 @@
(define/public (append-separator)
(atomically
(let ([item-gtk (gtk_separator_menu_item_new)])
(let ([item-gtk (as-gtk-allocation (gtk_separator_menu_item_new))])
(set! items (append items (list (list (new separator-item-handler%) item-gtk #f #f))))
(gtk_menu_shell_append gtk item-gtk)
(gtk_widget_show item-gtk))))