win32: support MinGW build

A MinGW build is the same shape as a MSVC build (but without
MzCOM), unlike a Cygwin build.

original commit: 5b016b4c32b3fc4ca5439f98b80d73b10ea8d346
This commit is contained in:
Matthew Flatt 2012-12-07 07:58:40 -06:00
parent 6e2e51aae7
commit 8107903727

View File

@ -119,19 +119,21 @@
(define wind-proc-ptr (function-ptr wind-proc _WndProc)) (define wind-proc-ptr (function-ptr wind-proc _WndProc))
(define-user32 CallWindowProcW (_wfun _fpointer _HWND _UINT _WPARAM _LPARAM -> _LRESULT))
(define (control-proc w msg wParam lParam) (define (control-proc w msg wParam lParam)
(let ([default-ctlproc (hwnd->ctlproc w)]) (let ([default-ctlproc (hwnd->ctlproc-fptr w)])
(if (= msg WM_DESTROY) (if (= msg WM_DESTROY)
(begin (begin
(SetWindowLongPtrW 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)) (CallWindowProcW default-ctlproc w msg wParam lParam))
(let ([wx (hwnd->wx w)]) (let ([wx (hwnd->wx w)])
(if wx (if wx
(send wx ctlproc w msg wParam lParam (send wx ctlproc w msg wParam lParam
(lambda (w msg wParam lParam) (lambda (w msg wParam lParam)
(default-ctlproc w msg wParam lParam))) (CallWindowProcW default-ctlproc w msg wParam lParam)))
(default-ctlproc w msg wParam lParam)))))) (CallWindowProcW default-ctlproc w msg wParam lParam))))))
(define control_proc (function-ptr control-proc _WndProc)) (define control_proc (function-ptr control-proc _WndProc))