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") "../common/event.rkt")
(provide (provide
(protect-out make-key-event (protect-out maybe-make-key-event
generates-key-event? generates-key-event?
reset-key-mapping reset-key-mapping
key-symbol-to-menu-key)) key-symbol-to-menu-key))
@ -18,15 +18,17 @@
(define (generates-key-event? msg) (define (generates-key-event? msg)
(let ([message (MSG-message msg)]) (let ([message (MSG-message msg)])
(and (memq message (list WM_KEYDOWN WM_SYSKEYDOWN (and (or (eq? message WM_KEYDOWN)
WM_KEYUP WM_SYSKEYUP)) (eq? message WM_SYSKEYDOWN)
(make-key-event #t (eq? message WM_KEYUP)
(MSG-wParam msg) (eq? message WM_SYSKEYUP))
(MSG-lParam msg) (maybe-make-key-event #t
#f (MSG-wParam msg)
(or (= message WM_KEYUP) (MSG-lParam msg)
(= message WM_SYSKEYUP)) #f
(MSG-hwnd msg))))) (or (= message WM_KEYUP)
(= message WM_SYSKEYUP))
(MSG-hwnd msg)))))
(define (THE_SCAN_CODE lParam) (define (THE_SCAN_CODE lParam)
(bitwise-and (arithmetic-shift lParam -16) #x1FF)) (bitwise-and (arithmetic-shift lParam -16) #x1FF))
@ -126,7 +128,7 @@
VK_SCROLL 'scroll)) 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)))] (let* ([control-down? (not (zero? (arithmetic-shift (GetKeyState VK_CONTROL) -1)))]
[rcontrol-down? (and control-down? [rcontrol-down? (and control-down?
(not (zero? (arithmetic-shift (GetKeyState VK_RCONTROL) -1))))] (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)))))) (loop (sub1 delta))))))
(define/private (do-key w msg wParam lParam is-char? is-up? default) (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 (and e
(if (definitely-wants-event? w msg wParam e) (if (definitely-wants-event? w msg wParam e)
(begin (begin