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

racket/gui: internal cleanup

Browse Source 
As suggested by Robby.
This commit is contained in:
Matthew Flatt 2012-08-13 10:51:52 -06:00
parent 32ae484c72
commit 0648556bea
2 changed files with 14 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

24
collects/mred/private/wx/win32/key.rkt
View File

@ -7,7 +7,7 @@
"../common/event.rkt")
(provide
(protect-out make-key-event
(protect-out maybe-make-key-event
generates-key-event?
reset-key-mapping
key-symbol-to-menu-key))
@ -18,15 +18,17 @@
(define (generates-key-event? msg)
(let ([message (MSG-message msg)])
(and (memq message (list WM_KEYDOWN WM_SYSKEYDOWN
WM_KEYUP WM_SYSKEYUP))
(make-key-event #t
(MSG-wParam msg)
(MSG-lParam msg)
#f
(or (= message WM_KEYUP)
(= message WM_SYSKEYUP))
(MSG-hwnd msg)))))
(and (or (eq? message WM_KEYDOWN)
(eq? message WM_SYSKEYDOWN)
(eq? message WM_KEYUP)
(eq? message WM_SYSKEYUP))
(maybe-make-key-event #t
(MSG-wParam msg)
(MSG-lParam msg)
#f
(or (= message WM_KEYUP)
(= message WM_SYSKEYUP))
(MSG-hwnd msg)))))
(define (THE_SCAN_CODE lParam)
(bitwise-and (arithmetic-shift lParam -16) #x1FF))
@ -126,7 +128,7 @@
VK_SCROLL 'scroll))
(define (make-key-event just-check? wParam lParam is-char? is-up? hwnd)
(define (maybe-make-key-event just-check? wParam lParam is-char? is-up? hwnd)
(let* ([control-down? (not (zero? (arithmetic-shift (GetKeyState VK_CONTROL) -1)))]
[rcontrol-down? (and control-down?
(not (zero? (arithmetic-shift (GetKeyState VK_RCONTROL) -1))))]

2
collects/mred/private/wx/win32/window.rkt
View File

@ -523,7 +523,7 @@
(loop (sub1 delta))))))
(define/private (do-key w msg wParam lParam is-char? is-up? default)
(let ([e (make-key-event #f wParam lParam is-char? is-up? hwnd)])
(let ([e (maybe-make-key-event #f wParam lParam is-char? is-up? hwnd)])
(if (and e
(if (definitely-wants-event? w msg wParam e)
(begin