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

win32: fix submenus and other menu operations

Browse Source
This commit is contained in:
Matthew Flatt 2010-10-10 10:59:04 -06:00
parent 54fc1e2766
commit 22e7cb437d
2 changed files with 26 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
collects/mred/private/wx/win32/menu-item.rkt
View File

@ -39,6 +39,7 @@
(set! parent p) (set! parent p)
(set! label lbl) (set! label lbl)
(set! checkable? chkbl?) (set! checkable? chkbl?)
(set! submenu subm)
id) id)
(define/public (set-label hmenu pos str) (define/public (set-label hmenu pos str)

33
collects/mred/private/wx/win32/menu.rkt
View File

@ -1,6 +1,7 @@
#lang scheme/base #lang scheme/base
(require scheme/class (require scheme/class
ffi/unsafe ffi/unsafe
(only-in racket/list drop take)
"../../lock.rkt" "../../lock.rkt"
"../../syntax.rkt" "../../syntax.rkt"
"utils.rkt" "utils.rkt"
@ -26,6 +27,8 @@
(define hmenu (CreatePopupMenu)) (define hmenu (CreatePopupMenu))
(define/public (get-hmenu) hmenu)
(define/public (set-parent p lbl parent-hmenu) (define/public (set-parent p lbl parent-hmenu)
(set! label lbl) (set! label lbl)
(set! parent p) (set! parent p)
@ -60,8 +63,10 @@
(lambda (i pos) (lambda (i pos)
(send i set-label hmenu pos str)))) (send i set-label hmenu pos str))))
(def/public-unimplemented set-help-string) (define/public (set-help-string id str)
(def/public-unimplemented number) (void))
(define/public (number) (length items))
(define/public (enable id on?) (define/public (enable id on?)
(with-item (with-item
@ -84,25 +89,37 @@
(lambda (i pos) (lambda (i pos)
(send i get-check hmenu pos)))) (send i get-check hmenu pos))))
(define/private (remove-item! pos)
(set! items
(append (take items pos)
(drop items (add1 pos)))))
(define/public (delete-by-position pos) (define/public (delete-by-position pos)
(RemoveMenu hmenu pos MF_BYPOSITION)) (atomically
(remove-item! pos)
(RemoveMenu hmenu pos MF_BYPOSITION)))
(define/public (delete id) (define/public (delete id)
(with-item (with-item
id id
(lambda (i pos) (lambda (i pos)
(RemoveMenu hmenu pos MF_BYPOSITION)))) (atomically
(remove-item! pos)
(RemoveMenu hmenu pos MF_BYPOSITION)))))
(public [append-item append]) (public [append-item append])
(define (append-item id label help-str-or-submenu chckable?) (define (append-item id label help-str-or-submenu chckable?)
(let ([i (id-to-menu-item id)]) (let ([i (id-to-menu-item id)])
(when i (when i
(let ([id (send i set-parent this label chckable? (let* ([submenu (and (help-str-or-submenu . is-a? . menu%)
(and (help-str-or-submenu . is-a? . menu%) help-str-or-submenu)]
help-str-or-submenu))]) [id (send i set-parent this label chckable?
submenu)])
(atomically (atomically
(set! items (append items (list i))) (set! items (append items (list i)))
(AppendMenuW hmenu (bitwise-ior MF_STRING) (cast id _long _pointer) label)))))) (if submenu
(AppendMenuW hmenu (bitwise-ior MF_POPUP MF_STRING) (send submenu get-hmenu) label)
(AppendMenuW hmenu (bitwise-ior MF_STRING) (cast id _long _pointer) label)))))))
(define/public (append-separator) (define/public (append-separator)
(atomically (atomically