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
GetWindowLongW
SetWindowLongW
GetWindowLongPtrW
SetWindowLongPtrW
SendMessageW SendMessageW/str
GetSysColor GetRValue GetGValue GetBValue make-COLORREF
CreateBitmap
@ -67,8 +67,8 @@
(error who "call failed (~s)"
(GetLastError)))
(define-user32 GetWindowLongW (_wfun _HWND _int -> _pointer))
(define-user32 SetWindowLongW (_wfun _HWND _int _pointer -> _pointer))
(define-user32 GetWindowLongPtrW (_wfun _HWND _int -> _pointer))
(define-user32 SetWindowLongPtrW (_wfun _HWND _int _pointer -> _pointer))
(define-user32 SendMessageW (_wfun _HWND _UINT _WPARAM _LPARAM -> _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)
(hash-set! all-hwnds (cast hwnd _pointer _intptr) #t)
(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)
(let* ([c (GetWindowLongW hwnd GWLP_USERDATA)]
(let* ([c (GetWindowLongPtrW hwnd GWLP_USERDATA)]
[v (ptr-ref c _racket)])
(vector-set! v 0 (make-weak-box wx))))
(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)])
(vector-set! v 1 ctlproc)
(vector-set! v 2 save-ptr)))
(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 v
(let ([wb (vector-ref v 0)])
@ -67,12 +67,12 @@
wx))))
(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 v (vector-ref v 1))))))
(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 v (vector-ref v 2))))))
@ -82,10 +82,10 @@
;; call in atomic mode:
(define (unregister-hwnd! hwnd)
(let ([c (GetWindowLongW hwnd GWLP_USERDATA)])
(let ([c (GetWindowLongPtrW hwnd GWLP_USERDATA)])
(when c
(free-immobile-cell c)
(SetWindowLongW hwnd GWLP_USERDATA #f))
(SetWindowLongPtrW hwnd GWLP_USERDATA #f))
(hash-remove! all-hwnds (cast hwnd _pointer _intptr))))
;; ----------------------------------------
@ -122,7 +122,7 @@
(let ([default-ctlproc (hwnd->ctlproc w)])
(if (= msg WM_DESTROY)
(begin
(SetWindowLongW w GWLP_WNDPROC (hwnd->ctlproc-fptr w))
(SetWindowLongPtrW w GWLP_WNDPROC (hwnd->ctlproc-fptr w))
(unregister-hwnd! w)
(default-ctlproc w msg wParam lParam))
(let ([wx (hwnd->wx w)])
@ -135,10 +135,10 @@
(define control_proc (function-ptr control-proc _WndProc))
(define (subclass-control hwnd)
(let* ([fptr (GetWindowLongW hwnd GWLP_WNDPROC)]
(let* ([fptr (GetWindowLongPtrW hwnd GWLP_WNDPROC)]
[old-control-proc (function-ptr fptr _WndProc)])
(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))