win32: fix alt vs. meta; fix alt-<char> menu dropdown

This commit is contained in:
Matthew Flatt 2010-12-09 18:05:51 -07:00
parent 3aad886019
commit e929f62d11
4 changed files with 16 additions and 4 deletions

View File

@ -500,6 +500,9 @@
(define/public (set-title s)
(atomically
(set! saved-title s)
(SetWindowTextW (get-hwnd) (string-append s (if modified? "*" ""))))))
(SetWindowTextW (get-hwnd) (string-append s (if modified? "*" "")))))
(define/public (popup-menu-with-char c)
(DefWindowProcW hwnd WM_SYSKEYDOWN (char->integer c) (arithmetic-shift 1 29))
(DefWindowProcW hwnd WM_SYSCHAR (char->integer c) (arithmetic-shift 1 29))))

View File

@ -224,8 +224,8 @@
key-id)]
[shift-down shift-down?]
[control-down control-down?]
[meta-down #f]
[alt-down alt-down?]
[meta-down alt-down?]
[alt-down #f]
[x 0]
[y 0]
[time-stamp 0]

View File

@ -55,6 +55,10 @@
(send m set-parent this lbl hmenu)))
(refresh))
(define/public (popup-menu-with-char c)
(when parent
(send parent popup-menu-with-char c)))
(define/public (set-parent f)
(SetMenu (send f get-hwnd) hmenu)
(set! parent f)

View File

@ -49,7 +49,12 @@
hmenu
lbl))
(def/public-unimplemented select)
(define/public (select mb)
(when parent
(let ([m (regexp-match #rx"&[^&]" label)])
(when m
(send parent popup-menu-with-char (string-ref (car m) 1))))))
(def/public-unimplemented get-font)
(def/public-unimplemented set-width)
(def/public-unimplemented set-title)