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

gtk menu-bar fixes

Browse Source
This commit is contained in:
Matthew Flatt 2010-10-15 12:39:11 -06:00
parent 4d8497b985
commit c57c84721f
1 changed files with 14 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -114,20 +114,22 @@
(gtk_label_set_text_with_mnemonic (gtk_bin_get_child item-gtk) (gtk_label_set_text_with_mnemonic (gtk_bin_get_child item-gtk)
(fixup-mneumonic str))))) (fixup-mneumonic str)))))
(def/public-unimplemented enable-top) (define/public (enable-top pos on?)
(gtk_widget_set_sensitive (car (list-ref menus pos)) on?))
(define/public (delete which pos) (define/public (delete which pos)
(set! menus (let loop ([menus menus] (atomically
[pos pos]) (set! menus (let loop ([menus menus]
(cond [pos pos])
[(null? menus) menus] (cond
[(zero? pos) [(null? menus) menus]
(gtk_container_remove gtk (caar menus)) [(zero? pos)
(gtk_menu_item_set_submenu (caar menus) #f) (gtk_container_remove gtk (caar menus))
(cdr menus)] (gtk_menu_item_set_submenu (caar menus) #f)
[else (cons (car menus) (cdr menus)]
(loop (cdr menus) [else (cons (car menus)
pos))])))) (loop (cdr menus)
(sub1 pos)))])))))
(public [append-menu append]) (public [append-menu append])
(define (append-menu menu title) (define (append-menu menu title)