--- win32.c.orig Tue Aug 29 12:09:46 2006 +++ win32.c Mon Jul 30 21:42:22 2007 @@ -105,6 +105,8 @@ static char * qualified_path(const char *cmd); static char * win32_get_xlib(const char *pl, const char *xlib, const char *libname); +/* TODO REM: is this the right place for this? */ +LRESULT win32_process_message(pTHX_ HWND hwnd, UINT msg, WPARAM wParam, LPARAM lParam); #ifdef USE_ITHREADS static void remove_dead_pseudo_process(long child); @@ -1907,68 +1909,53 @@ MSG msg; HWND hwnd = w32_message_hwnd; + /* Reset w32_poll_count before doing anything else, incase we dispatch + * messages that end up calling back into perl */ w32_poll_count = 0; - if (hwnd == INVALID_HANDLE_VALUE) { - /* Call PeekMessage() to mark all pending messages in the queue as "old". - * This is necessary when we are being called by win32_msgwait() to - * make sure MsgWaitForMultipleObjects() stops reporting the same waiting - * message over and over. An example how this can happen is when - * Perl is calling win32_waitpid() inside a GUI application and the GUI - * is generating messages before the process terminated. - */ - PeekMessage(&msg, NULL, 0, 0, PM_NOREMOVE|PM_NOYIELD); - if (PL_sig_pending) - despatch_signals(); - return 1; - } - - /* Passing PeekMessage -1 as HWND (2nd arg) only get PostThreadMessage() messages - * and ignores window messages - should co-exist better with windows apps e.g. Tk - */ - if (hwnd == NULL) - hwnd = (HWND)-1; - - while (PeekMessage(&msg, hwnd, WM_TIMER, WM_TIMER, PM_REMOVE|PM_NOYIELD) || - PeekMessage(&msg, hwnd, WM_USER_MIN, WM_USER_MAX, PM_REMOVE|PM_NOYIELD)) - { - switch (msg.message) { -#ifdef USE_ITHREADS - case WM_USER_MESSAGE: { - int child = find_pseudo_pid(msg.wParam); - if (child >= 0) - w32_pseudo_child_message_hwnds[child] = (HWND)msg.lParam; - break; - } -#endif - - case WM_USER_KILL: { - /* We use WM_USER to fake kill() with other signals */ - int sig = msg.wParam; - if (do_raise(aTHX_ sig)) - sig_terminate(aTHX_ sig); - break; - } - - case WM_TIMER: { - /* alarm() is a one-shot but SetTimer() repeats so kill it */ - if (w32_timerid && w32_timerid==msg.wParam) { - KillTimer(w32_message_hwnd, w32_timerid); - w32_timerid=0; + if (hwnd != INVALID_HANDLE_VALUE) { + /* Passing PeekMessage -1 as HWND (2nd arg) only get PostThreadMessage() messages + * and ignores window messages - should co-exist better with windows apps e.g. Tk + */ + if (hwnd == NULL) + hwnd = (HWND)-1; + + while (PeekMessage(&msg, hwnd, WM_TIMER, WM_TIMER, PM_REMOVE|PM_NOYIELD) || + PeekMessage(&msg, hwnd, WM_USER_MIN, WM_USER_MAX, PM_REMOVE|PM_NOYIELD)) + { + /* re-post a WM_QUIT message (we'll mark it as read later) */ + if(msg.message == WM_QUIT) { + PostQuitMessage((int)msg.wParam); + break; + } - /* Now fake a call to signal handler */ - if (do_raise(aTHX_ 14)) - sig_terminate(aTHX_ 14); + if(msg.hwnd == NULL) { + /* thread message - pass it to the WH_MSGFILTER hook, so that + * we process it - see win32_message_filter_proc */ + CallMsgFilter(&msg, 0x1100); /* 0x1100 is passed into any WH_MSGFILTER hook as our identifier */ } - break; - } - } /* switch */ + else { + /* TranslateMessage() is probably superfluous, but not harmful */ + TranslateMessage(&msg); + DispatchMessage(&msg); + } + } } + /* Call PeekMessage() to mark all pending messages in the queue as "old". + * This is necessary when we are being called by win32_msgwait() to + * make sure MsgWaitForMultipleObjects() stops reporting the same waiting + * message over and over. An example how this can happen is when + * Perl is calling win32_waitpid() inside a GUI application and the GUI + * is generating messages before the process terminated. + */ + while (PeekMessage(&msg, NULL, 0, 0, PM_NOREMOVE|PM_NOYIELD)) + /* keep going */ ; + /* Above or other stuff may have set a signal flag */ - if (PL_sig_pending) { - despatch_signals(); - } + if (PL_sig_pending) + despatch_signals(); + return 1; } @@ -1984,7 +1971,7 @@ timeout += ticks; } while (1) { - DWORD result = MsgWaitForMultipleObjects(count,handles,FALSE,timeout-ticks, QS_ALLEVENTS); + DWORD result = MsgWaitForMultipleObjects(count,handles,FALSE,timeout-ticks, QS_ALLEVENTS|QS_SENDMESSAGE); if (resultp) *resultp = result; if (result == WAIT_TIMEOUT) { @@ -5196,9 +5183,146 @@ /* Does nothing */ } +/* The PerlMessageWindow's WindowProc - find a thread context, and + * call win32_process_message() */ +/* TODO REM Are the ifdefs anything like right? MULTIPLICITY or + * PERL_IMPLICIT_CONTEXT or both? */ +LRESULT CALLBACK +win32_message_window_proc(HWND hwnd, UINT msg, WPARAM wParam, LPARAM lParam) +{ +#ifdef PERL_IMPLICIT_CONTEXT + PerlInterpreter *my_perl; + + if(msg == WM_NCCREATE) { + /* On perl's that pass an explicit context around we pass it in the + * lparam to CreateWindow, so that we can extract it here, and + * associate it with the window. This is safe, as a window proc only + * ever gets called in the context of the thread in which the + * CreateWindow call was made */ + my_perl = (PerlInterpreter *)(((LPCREATESTRUCT)lParam)->lpCreateParams); + SetWindowLongPtr(hwnd, GWLP_USERDATA, (LONG_PTR)my_perl); + } + else { + /* Extract perl context from window */ + my_perl = (PerlInterpreter *)GetWindowLongPtr(hwnd, GWLP_USERDATA); + /* WM_NCCREATE isn't the first message that we'll get, so we might + * not have set a context yet */ + if(!my_perl) + my_perl = ((PerlInterpreter *)PERL_GET_CONTEXT); + } +#endif + + return win32_process_message(aTHX_ hwnd, msg, wParam, lParam) ? + 0 : DefWindowProc(hwnd, msg, wParam, lParam); +} + +/* we use a message filter hook to process our thread messages, passing any + * messages that we don't process on to the rest of the hook chain + * Anyone else writing a message loop that wants to play nicely with perl + * should do + * callMsgFilter(&msg, MSGF_***); + * between their GetMessage and DispatchMessage calls. + */ +LRESULT CALLBACK +win32_message_filter_proc(int code, WPARAM wParam, LPARAM lParam) { + LPMSG pmsg = (LPMSG)lParam; + + /* we'll proces it if code says we're allowed, and it's a thread message */ + if (code >= 0 && pmsg->hwnd == NULL) { + dTHX; /* XXX it would be nice if there was a way to get a context passed in here */ + if (win32_process_message(aTHX_ pmsg->hwnd, pmsg->message, pmsg->wParam, pmsg->lParam)) { + return TRUE; + } + } + + /* XXX: MSDN says that hhk is ignored, but we should really use the + * return value from SetWindowsHookEx(). */ + return CallNextHookEx(NULL, code, wParam, lParam); +} + +/* The real message handler, with a perl context. Can be called with + * hwnd == NULL to process thread messages + * Returns TRUE if the message was processed */ +LRESULT +win32_process_message(pTHX_ HWND hwnd, UINT msg, WPARAM wParam, LPARAM lParam) +{ + LRESULT fProcessed = 0; + + switch(msg) { + +#ifdef USE_ITHREADS + case WM_USER_MESSAGE: { + long child = find_pseudo_pid((int)wParam); + if (child >= 0) + w32_pseudo_child_message_hwnds[child] = (HWND)lParam; + fProcessed = 1; + break; + } +#endif + + case WM_USER_KILL: { + /* We use WM_USER to fake kill() with other signals */ + int sig = (int)wParam; + if (do_raise(aTHX_ sig)) + sig_terminate(aTHX_ sig); + fProcessed = 1; + break; + } + + case WM_TIMER: { + /* alarm() is a one-shot but SetTimer() repeats so kill it */ + if (w32_timerid && w32_timerid==(UINT)wParam) { + KillTimer(w32_message_hwnd, w32_timerid); + w32_timerid=0; + + /* Now fake a call to signal handler */ + if (do_raise(aTHX_ 14)) + sig_terminate(aTHX_ 14); + } + fProcessed = 1; + break; + } + + default: + break; + + } /* switch */ + + /* Above or other stuff may have set a signal flag, and we may not have + * been called from win32_async_check() (e.g. some other GUI's message + * loop. BUT DON'T dispatch signals here: If someone has set a SIGALRM + * handler that die's, and the message loop that calls here is wrapped + * in an eval, then you may well end up with orphaned windows */ + /* + if (PL_sig_pending) + despatch_signals(); + */ + + return fProcessed; +} + +void +win32_create_message_window_class() +{ + /* create the window class for "message only" windows */ + WNDCLASS wc; + + Zero(&wc, 1, wc); + wc.lpfnWndProc = win32_message_window_proc; + wc.hInstance = (HINSTANCE)GetModuleHandle(NULL); + wc.lpszClassName = "PerlMessageWindowClass"; + + /* second and subsequent calls will fail, as class + * will already be registered */ + RegisterClass(&wc); +} + HWND win32_create_message_window() { + dTHX; /* TODO REM: pass context into here */ + HWND hwnd; + /* "message-only" windows have been implemented in Windows 2000 and later. * On earlier versions we'll continue to post messages to a specific * thread and use hwnd==NULL. This is brittle when either an embedding @@ -5207,10 +5331,40 @@ * "right" place with DispatchMessage() anymore, as there is no WindowProc * if there is no window handle. */ - if (g_osver.dwMajorVersion < 5) - return NULL; + /* Using HWND_MESSAGE appears to work under Win98, despite MSDN + * documentation to the contrary, however, there is some evidence that + * there may be problems with the implementation on Win98. As it is not + * officially support we take the cautious route and stick with thread + * messages on platforms prior to Win2k. + */ + if (g_osver.dwMajorVersion < 5) { + hwnd = NULL; + } + else { + + win32_create_message_window_class(); + + /* TODO REM: are the ifdefs right? */ +#ifdef PERL_IMPLICIT_CONTEXT + hwnd = CreateWindow("PerlMessageWindowClass", "PerlMessageWindow", + 0, 0, 0, 0, 0, HWND_MESSAGE, NULL, NULL, my_perl); +#else + hwnd = CreateWindow("PerlMessageWindowClass", "PerlMessageWindow", + 0, 0, 0, 0, 0, HWND_MESSAGE, NULL, NULL, NULL); +#endif + } + + /* If we din't create a window for any reason, then we'll use thread + * messages for our signalling, so we install a hook which + * is called by CallMsgFilter in win32_async_check(), or any other + * modal loop (e.g. Win32::MsgBox or any other GUI extention, or anything + * that use OLE, etc. */ + if(!hwnd) { + SetWindowsHookEx(WH_MSGFILTER, win32_message_filter_proc, + NULL, GetCurrentThreadId()); + } - return CreateWindow("Static", "", 0, 0, 0, 0, 0, HWND_MESSAGE, 0, 0, NULL); + return hwnd; } void