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

win64: fix GetWindowLong to use Ptr variant

Browse Source 
original commit: 6d1db909c4f08728f2aab3928473eabc4f628c3d
This commit is contained in:
Matthew Flatt 2010-12-04 16:57:22 -07:00
parent 426a181f85
commit 4323d16f95
2 changed files with 15 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
collects/mred/private/wx/win32/utils.rkt
View File

@ -19,8 +19,8 @@
GetLastError GetLastError
GetWindowLongW GetWindowLongPtrW
SetWindowLongW SetWindowLongPtrW
SendMessageW SendMessageW/str SendMessageW SendMessageW/str
GetSysColor GetRValue GetGValue GetBValue make-COLORREF GetSysColor GetRValue GetGValue GetBValue make-COLORREF
CreateBitmap CreateBitmap
@ -67,8 +67,8 @@
(error who "call failed (~s)" (error who "call failed (~s)"
(GetLastError))) (GetLastError)))
(define-user32 GetWindowLongW (_wfun _HWND _int -> _pointer)) (define-user32 GetWindowLongPtrW (_wfun _HWND _int -> _pointer))
(define-user32 SetWindowLongW (_wfun _HWND _int _pointer -> _pointer)) (define-user32 SetWindowLongPtrW (_wfun _HWND _int _pointer -> _pointer))
(define-user32 SendMessageW (_wfun _HWND _UINT _WPARAM _LPARAM -> _LRESULT)) (define-user32 SendMessageW (_wfun _HWND _UINT _WPARAM _LPARAM -> _LRESULT))
(define-user32 SendMessageW/str (_wfun _HWND _UINT _WPARAM _string/utf-16 -> _LRESULT) (define-user32 SendMessageW/str (_wfun _HWND _UINT _WPARAM _string/utf-16 -> _LRESULT)

22
collects/mred/private/wx/win32/wndclass.rkt
View File

@ -37,21 +37,21 @@
(define (register-hwnd! hwnd) (define (register-hwnd! hwnd)
(hash-set! all-hwnds (cast hwnd _pointer _intptr) #t) (hash-set! all-hwnds (cast hwnd _pointer _intptr) #t)
(let ([c (malloc-immobile-cell (vector #f #f #f))]) (let ([c (malloc-immobile-cell (vector #f #f #f))])
(void (SetWindowLongW hwnd GWLP_USERDATA c)))) (void (SetWindowLongPtrW hwnd GWLP_USERDATA c))))
(define (set-hwnd-wx! hwnd wx) (define (set-hwnd-wx! hwnd wx)
(let* ([c (GetWindowLongW hwnd GWLP_USERDATA)] (let* ([c (GetWindowLongPtrW hwnd GWLP_USERDATA)]
[v (ptr-ref c _racket)]) [v (ptr-ref c _racket)])
(vector-set! v 0 (make-weak-box wx)))) (vector-set! v 0 (make-weak-box wx))))
(define (set-hwnd-ctlproc! hwnd save-ptr ctlproc) (define (set-hwnd-ctlproc! hwnd save-ptr ctlproc)
(let* ([c (GetWindowLongW hwnd GWLP_USERDATA)] (let* ([c (GetWindowLongPtrW hwnd GWLP_USERDATA)]
[v (ptr-ref c _racket)]) [v (ptr-ref c _racket)])
(vector-set! v 1 ctlproc) (vector-set! v 1 ctlproc)
(vector-set! v 2 save-ptr))) (vector-set! v 2 save-ptr)))
(define (hwnd->wx hwnd) (define (hwnd->wx hwnd)
(let ([c (GetWindowLongW hwnd GWLP_USERDATA)]) (let ([c (GetWindowLongPtrW hwnd GWLP_USERDATA)])
(and c (let ([v (ptr-ref c _racket)]) (and c (let ([v (ptr-ref c _racket)])
(and v (and v
(let ([wb (vector-ref v 0)]) (let ([wb (vector-ref v 0)])
@ -67,12 +67,12 @@
wx)))) wx))))
(define (hwnd->ctlproc hwnd) (define (hwnd->ctlproc hwnd)
(let ([c (GetWindowLongW hwnd GWLP_USERDATA)]) (let ([c (GetWindowLongPtrW hwnd GWLP_USERDATA)])
(and c (let ([v (ptr-ref c _racket)]) (and c (let ([v (ptr-ref c _racket)])
(and v (vector-ref v 1)))))) (and v (vector-ref v 1))))))
(define (hwnd->ctlproc-fptr hwnd) (define (hwnd->ctlproc-fptr hwnd)
(let ([c (GetWindowLongW hwnd GWLP_USERDATA)]) (let ([c (GetWindowLongPtrW hwnd GWLP_USERDATA)])
(and c (let ([v (ptr-ref c _racket)]) (and c (let ([v (ptr-ref c _racket)])
(and v (vector-ref v 2)))))) (and v (vector-ref v 2))))))
@ -82,10 +82,10 @@
;; call in atomic mode: ;; call in atomic mode:
(define (unregister-hwnd! hwnd) (define (unregister-hwnd! hwnd)
(let ([c (GetWindowLongW hwnd GWLP_USERDATA)]) (let ([c (GetWindowLongPtrW hwnd GWLP_USERDATA)])
(when c (when c
(free-immobile-cell c) (free-immobile-cell c)
(SetWindowLongW hwnd GWLP_USERDATA #f)) (SetWindowLongPtrW hwnd GWLP_USERDATA #f))
(hash-remove! all-hwnds (cast hwnd _pointer _intptr)))) (hash-remove! all-hwnds (cast hwnd _pointer _intptr))))
;; ---------------------------------------- ;; ----------------------------------------
@ -122,7 +122,7 @@
(let ([default-ctlproc (hwnd->ctlproc w)]) (let ([default-ctlproc (hwnd->ctlproc w)])
(if (= msg WM_DESTROY) (if (= msg WM_DESTROY)
(begin (begin
(SetWindowLongW w GWLP_WNDPROC (hwnd->ctlproc-fptr w)) (SetWindowLongPtrW w GWLP_WNDPROC (hwnd->ctlproc-fptr w))
(unregister-hwnd! w) (unregister-hwnd! w)
(default-ctlproc w msg wParam lParam)) (default-ctlproc w msg wParam lParam))
(let ([wx (hwnd->wx w)]) (let ([wx (hwnd->wx w)])
@ -135,10 +135,10 @@
(define control_proc (function-ptr control-proc _WndProc)) (define control_proc (function-ptr control-proc _WndProc))
(define (subclass-control hwnd) (define (subclass-control hwnd)
(let* ([fptr (GetWindowLongW hwnd GWLP_WNDPROC)] (let* ([fptr (GetWindowLongPtrW hwnd GWLP_WNDPROC)]
[old-control-proc (function-ptr fptr _WndProc)]) [old-control-proc (function-ptr fptr _WndProc)])
(set-hwnd-ctlproc! hwnd fptr old-control-proc) (set-hwnd-ctlproc! hwnd fptr old-control-proc)
(SetWindowLongW hwnd GWLP_WNDPROC control_proc))) (SetWindowLongPtrW hwnd GWLP_WNDPROC control_proc)))
(define _DialogProc (_wfun _HWND _UINT _WPARAM _LPARAM -> _INT_PTR)) (define _DialogProc (_wfun _HWND _UINT _WPARAM _LPARAM -> _INT_PTR))