sl@0: /* 
sl@0:  * tclWinNotify.c --
sl@0:  *
sl@0:  *	This file contains Windows-specific procedures for the notifier,
sl@0:  *	which is the lowest-level part of the Tcl event loop.  This file
sl@0:  *	works together with ../generic/tclNotify.c.
sl@0:  *
sl@0:  * Copyright (c) 1995-1997 Sun Microsystems, Inc.
sl@0:  *
sl@0:  * See the file "license.terms" for information on usage and redistribution
sl@0:  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
sl@0:  *
sl@0:  * RCS: @(#) $Id: tclWinNotify.c,v 1.11.2.1 2003/03/21 03:24:09 dgp Exp $
sl@0:  */
sl@0: 
sl@0: #include "tclWinInt.h"
sl@0: 
sl@0: /*
sl@0:  * The follwing static indicates whether this module has been initialized.
sl@0:  */
sl@0: 
sl@0: #define INTERVAL_TIMER 1	/* Handle of interval timer. */
sl@0: 
sl@0: #define WM_WAKEUP WM_USER	/* Message that is send by
sl@0: 				 * Tcl_AlertNotifier. */
sl@0: /*
sl@0:  * The following static structure contains the state information for the
sl@0:  * Windows implementation of the Tcl notifier.  One of these structures
sl@0:  * is created for each thread that is using the notifier.  
sl@0:  */
sl@0: 
sl@0: typedef struct ThreadSpecificData {
sl@0:     CRITICAL_SECTION crit;	/* Monitor for this notifier. */
sl@0:     DWORD thread;		/* Identifier for thread associated with this
sl@0: 				 * notifier. */
sl@0:     HANDLE event;		/* Event object used to wake up the notifier
sl@0: 				 * thread. */
sl@0:     int pending;		/* Alert message pending, this field is
sl@0: 				 * locked by the notifierMutex. */
sl@0:     HWND hwnd;			/* Messaging window. */
sl@0:     int timeout;		/* Current timeout value. */
sl@0:     int timerActive;		/* 1 if interval timer is running. */
sl@0: } ThreadSpecificData;
sl@0: 
sl@0: static Tcl_ThreadDataKey dataKey;
sl@0: 
sl@0: extern TclStubs tclStubs;
sl@0: extern Tcl_NotifierProcs tclOriginalNotifier;
sl@0: 
sl@0: /*
sl@0:  * The following static indicates the number of threads that have
sl@0:  * initialized notifiers.  It controls the lifetime of the TclNotifier
sl@0:  * window class.
sl@0:  *
sl@0:  * You must hold the notifierMutex lock before accessing this variable.
sl@0:  */
sl@0: 
sl@0: static int notifierCount = 0;
sl@0: TCL_DECLARE_MUTEX(notifierMutex)
sl@0: 
sl@0: /*
sl@0:  * Static routines defined in this file.
sl@0:  */
sl@0: 
sl@0: static LRESULT CALLBACK	NotifierProc(HWND hwnd, UINT message,
sl@0: 			    WPARAM wParam, LPARAM lParam);
sl@0: 
sl@0: 
sl@0: /*
sl@0:  *----------------------------------------------------------------------
sl@0:  *
sl@0:  * Tcl_InitNotifier --
sl@0:  *
sl@0:  *	Initializes the platform specific notifier state.
sl@0:  *
sl@0:  * Results:
sl@0:  *	Returns a handle to the notifier state for this thread..
sl@0:  *
sl@0:  * Side effects:
sl@0:  *	None.
sl@0:  *
sl@0:  *----------------------------------------------------------------------
sl@0:  */
sl@0: 
sl@0: ClientData
sl@0: Tcl_InitNotifier()
sl@0: {
sl@0:     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
sl@0:     WNDCLASS class;
sl@0: 
sl@0:     /*
sl@0:      * Register Notifier window class if this is the first thread to
sl@0:      * use this module.
sl@0:      */
sl@0: 
sl@0:     Tcl_MutexLock(&notifierMutex);
sl@0:     if (notifierCount == 0) {
sl@0: 	class.style = 0;
sl@0: 	class.cbClsExtra = 0;
sl@0: 	class.cbWndExtra = 0;
sl@0: 	class.hInstance = TclWinGetTclInstance();
sl@0: 	class.hbrBackground = NULL;
sl@0: 	class.lpszMenuName = NULL;
sl@0: 	class.lpszClassName = "TclNotifier";
sl@0: 	class.lpfnWndProc = NotifierProc;
sl@0: 	class.hIcon = NULL;
sl@0: 	class.hCursor = NULL;
sl@0: 
sl@0: 	if (!RegisterClassA(&class)) {
sl@0: 	    panic("Unable to register TclNotifier window class");
sl@0: 	}
sl@0:     }
sl@0:     notifierCount++;
sl@0:     Tcl_MutexUnlock(&notifierMutex);
sl@0: 
sl@0:     tsdPtr->pending = 0;
sl@0:     tsdPtr->timerActive = 0;
sl@0: 
sl@0:     InitializeCriticalSection(&tsdPtr->crit);
sl@0: 
sl@0:     tsdPtr->hwnd = NULL;
sl@0:     tsdPtr->thread = GetCurrentThreadId();
sl@0:     tsdPtr->event = CreateEvent(NULL, TRUE /* manual */,
sl@0: 	    FALSE /* !signaled */, NULL);
sl@0: 
sl@0:     return (ClientData) tsdPtr;
sl@0: }
sl@0: 
sl@0: /*
sl@0:  *----------------------------------------------------------------------
sl@0:  *
sl@0:  * Tcl_FinalizeNotifier --
sl@0:  *
sl@0:  *	This function is called to cleanup the notifier state before
sl@0:  *	a thread is terminated.
sl@0:  *
sl@0:  * Results:
sl@0:  *	None.
sl@0:  *
sl@0:  * Side effects:
sl@0:  *	May dispose of the notifier window and class.
sl@0:  *
sl@0:  *----------------------------------------------------------------------
sl@0:  */
sl@0: 
sl@0: void
sl@0: Tcl_FinalizeNotifier(clientData)
sl@0:     ClientData clientData;	/* Pointer to notifier data. */
sl@0: {
sl@0:     ThreadSpecificData *tsdPtr = (ThreadSpecificData *) clientData;
sl@0: 
sl@0:     /*
sl@0:      * Only finalize the notifier if a notifier was installed in the
sl@0:      * current thread; there is a route in which this is not
sl@0:      * guaranteed to be true (when tclWin32Dll.c:DllMain() is called
sl@0:      * with the flag DLL_PROCESS_DETACH by the OS, which could be
sl@0:      * doing so from a thread that's never previously been involved
sl@0:      * with Tcl, e.g. the task manager) so this check is important.
sl@0:      *
sl@0:      * Fixes Bug #217982 reported by Hugh Vu and Gene Leache.
sl@0:      */
sl@0:     if (tsdPtr == NULL) {
sl@0: 	return;
sl@0:     }
sl@0: 
sl@0:     DeleteCriticalSection(&tsdPtr->crit);
sl@0:     CloseHandle(tsdPtr->event);
sl@0: 
sl@0:     /*
sl@0:      * Clean up the timer and messaging window for this thread.
sl@0:      */
sl@0: 
sl@0:     if (tsdPtr->hwnd) {
sl@0: 	KillTimer(tsdPtr->hwnd, INTERVAL_TIMER);
sl@0: 	DestroyWindow(tsdPtr->hwnd);
sl@0:     }
sl@0: 
sl@0:     /*
sl@0:      * If this is the last thread to use the notifier, unregister
sl@0:      * the notifier window class.
sl@0:      */
sl@0: 
sl@0:     Tcl_MutexLock(&notifierMutex);
sl@0:     notifierCount--;
sl@0:     if (notifierCount == 0) {
sl@0: 	UnregisterClassA("TclNotifier", TclWinGetTclInstance());
sl@0:     }
sl@0:     Tcl_MutexUnlock(&notifierMutex);
sl@0: }
sl@0: 
sl@0: /*
sl@0:  *----------------------------------------------------------------------
sl@0:  *
sl@0:  * Tcl_AlertNotifier --
sl@0:  *
sl@0:  *	Wake up the specified notifier from any thread. This routine
sl@0:  *	is called by the platform independent notifier code whenever
sl@0:  *	the Tcl_ThreadAlert routine is called.  This routine is
sl@0:  *	guaranteed not to be called on a given notifier after
sl@0:  *	Tcl_FinalizeNotifier is called for that notifier.  This routine
sl@0:  *	is typically called from a thread other than the notifier's
sl@0:  *	thread.
sl@0:  *
sl@0:  * Results:
sl@0:  *	None.
sl@0:  *
sl@0:  * Side effects:
sl@0:  *	Sends a message to the messaging window for the notifier
sl@0:  *	if there isn't already one pending.
sl@0:  *
sl@0:  *----------------------------------------------------------------------
sl@0:  */
sl@0: 
sl@0: void
sl@0: Tcl_AlertNotifier(clientData)
sl@0:     ClientData clientData;	/* Pointer to thread data. */
sl@0: {
sl@0:     ThreadSpecificData *tsdPtr = (ThreadSpecificData *) clientData;
sl@0: 
sl@0:     /*
sl@0:      * Note that we do not need to lock around access to the hwnd
sl@0:      * because the race condition has no effect since any race condition
sl@0:      * implies that the notifier thread is already awake.
sl@0:      */
sl@0: 
sl@0:     if (tsdPtr->hwnd) {
sl@0: 	/*
sl@0: 	 * We do need to lock around access to the pending flag.
sl@0: 	 */
sl@0: 
sl@0: 	EnterCriticalSection(&tsdPtr->crit);
sl@0: 	if (!tsdPtr->pending) {
sl@0: 	    PostMessage(tsdPtr->hwnd, WM_WAKEUP, 0, 0);
sl@0: 	}
sl@0: 	tsdPtr->pending = 1;
sl@0: 	LeaveCriticalSection(&tsdPtr->crit);
sl@0:     } else {
sl@0: 	SetEvent(tsdPtr->event);
sl@0:     }
sl@0: }
sl@0: 
sl@0: /*
sl@0:  *----------------------------------------------------------------------
sl@0:  *
sl@0:  * Tcl_SetTimer --
sl@0:  *
sl@0:  *	This procedure sets the current notifier timer value.  The
sl@0:  *	notifier will ensure that Tcl_ServiceAll() is called after
sl@0:  *	the specified interval, even if no events have occurred.
sl@0:  *
sl@0:  * Results:
sl@0:  *	None.
sl@0:  *
sl@0:  * Side effects:
sl@0:  *	Replaces any previous timer.
sl@0:  *
sl@0:  *----------------------------------------------------------------------
sl@0:  */
sl@0: 
sl@0: void
sl@0: Tcl_SetTimer(
sl@0:     Tcl_Time *timePtr)		/* Maximum block time, or NULL. */
sl@0: {
sl@0:     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
sl@0:     UINT timeout;
sl@0: 
sl@0:     /*
sl@0:      * Allow the notifier to be hooked.  This may not make sense
sl@0:      * on Windows, but mirrors the UNIX hook.
sl@0:      */
sl@0: 
sl@0:     if (tclStubs.tcl_SetTimer != tclOriginalNotifier.setTimerProc) {
sl@0: 	tclStubs.tcl_SetTimer(timePtr);
sl@0: 	return;
sl@0:     }
sl@0: 
sl@0:     /*
sl@0:      * We only need to set up an interval timer if we're being called
sl@0:      * from an external event loop.  If we don't have a window handle
sl@0:      * then we just return immediately and let Tcl_WaitForEvent handle
sl@0:      * timeouts.
sl@0:      */
sl@0: 
sl@0:     if (!tsdPtr->hwnd) {
sl@0: 	return;
sl@0:     }
sl@0: 
sl@0:     if (!timePtr) {
sl@0: 	timeout = 0;
sl@0:     } else {
sl@0: 	/*
sl@0: 	 * Make sure we pass a non-zero value into the timeout argument.
sl@0: 	 * Windows seems to get confused by zero length timers.
sl@0: 	 */
sl@0: 
sl@0: 	timeout = timePtr->sec * 1000 + timePtr->usec / 1000;
sl@0: 	if (timeout == 0) {
sl@0: 	    timeout = 1;
sl@0: 	}
sl@0:     }
sl@0:     tsdPtr->timeout = timeout;
sl@0:     if (timeout != 0) {
sl@0: 	tsdPtr->timerActive = 1;
sl@0: 	SetTimer(tsdPtr->hwnd, INTERVAL_TIMER,
sl@0: 		    (unsigned long) tsdPtr->timeout, NULL);
sl@0:     } else {
sl@0: 	tsdPtr->timerActive = 0;
sl@0: 	KillTimer(tsdPtr->hwnd, INTERVAL_TIMER);
sl@0:     }
sl@0: }
sl@0: 
sl@0: /*
sl@0:  *----------------------------------------------------------------------
sl@0:  *
sl@0:  * Tcl_ServiceModeHook --
sl@0:  *
sl@0:  *	This function is invoked whenever the service mode changes.
sl@0:  *
sl@0:  * Results:
sl@0:  *	None.
sl@0:  *
sl@0:  * Side effects:
sl@0:  *	If this is the first time the notifier is set into
sl@0:  *	TCL_SERVICE_ALL, then the communication window is created.
sl@0:  *
sl@0:  *----------------------------------------------------------------------
sl@0:  */
sl@0: 
sl@0: void
sl@0: Tcl_ServiceModeHook(mode)
sl@0:     int mode;			/* Either TCL_SERVICE_ALL, or
sl@0: 				 * TCL_SERVICE_NONE. */
sl@0: {
sl@0:     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
sl@0: 
sl@0:     /*
sl@0:      * If this is the first time that the notifier has been used from a
sl@0:      * modal loop, then create a communication window.  Note that after
sl@0:      * this point, the application needs to service events in a timely
sl@0:      * fashion or Windows will hang waiting for the window to respond
sl@0:      * to synchronous system messages.  At some point, we may want to
sl@0:      * consider destroying the window if we leave the modal loop, but
sl@0:      * for now we'll leave it around.
sl@0:      */
sl@0: 
sl@0:     if (mode == TCL_SERVICE_ALL && !tsdPtr->hwnd) {
sl@0: 	tsdPtr->hwnd = CreateWindowA("TclNotifier", "TclNotifier", WS_TILED,
sl@0: 		0, 0, 0, 0, NULL, NULL, TclWinGetTclInstance(), NULL);
sl@0: 	/*
sl@0: 	 * Send an initial message to the window to ensure that we wake up the
sl@0: 	 * notifier once we get into the modal loop.  This will force the
sl@0: 	 * notifier to recompute the timeout value and schedule a timer
sl@0: 	 * if one is needed.
sl@0: 	 */
sl@0: 
sl@0: 	Tcl_AlertNotifier((ClientData)tsdPtr);
sl@0:     }
sl@0: }
sl@0: 
sl@0: /*
sl@0:  *----------------------------------------------------------------------
sl@0:  *
sl@0:  * NotifierProc --
sl@0:  *
sl@0:  *	This procedure is invoked by Windows to process events on
sl@0:  *	the notifier window.  Messages will be sent to this window
sl@0:  *	in response to external timer events or calls to
sl@0:  *	TclpAlertTsdPtr->
sl@0:  *
sl@0:  * Results:
sl@0:  *	A standard windows result.
sl@0:  *
sl@0:  * Side effects:
sl@0:  *	Services any pending events.
sl@0:  *
sl@0:  *----------------------------------------------------------------------
sl@0:  */
sl@0: 
sl@0: static LRESULT CALLBACK
sl@0: NotifierProc(
sl@0:     HWND hwnd,
sl@0:     UINT message,
sl@0:     WPARAM wParam,
sl@0:     LPARAM lParam)
sl@0: {
sl@0:     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
sl@0: 
sl@0:     if (message == WM_WAKEUP) {
sl@0: 	EnterCriticalSection(&tsdPtr->crit);
sl@0: 	tsdPtr->pending = 0;
sl@0: 	LeaveCriticalSection(&tsdPtr->crit);
sl@0:     } else if (message != WM_TIMER) {
sl@0: 	return DefWindowProc(hwnd, message, wParam, lParam);
sl@0:     }
sl@0: 	
sl@0:     /*
sl@0:      * Process all of the runnable events.
sl@0:      */
sl@0: 
sl@0:     Tcl_ServiceAll();
sl@0:     return 0;
sl@0: }
sl@0: 
sl@0: /*
sl@0:  *----------------------------------------------------------------------
sl@0:  *
sl@0:  * Tcl_WaitForEvent --
sl@0:  *
sl@0:  *	This function is called by Tcl_DoOneEvent to wait for new
sl@0:  *	events on the message queue.  If the block time is 0, then
sl@0:  *	Tcl_WaitForEvent just polls the event queue without blocking.
sl@0:  *
sl@0:  * Results:
sl@0:  *	Returns -1 if a WM_QUIT message is detected, returns 1 if
sl@0:  *	a message was dispatched, otherwise returns 0.
sl@0:  *
sl@0:  * Side effects:
sl@0:  *	Dispatches a message to a window procedure, which could do
sl@0:  *	anything.
sl@0:  *
sl@0:  *----------------------------------------------------------------------
sl@0:  */
sl@0: 
sl@0: int
sl@0: Tcl_WaitForEvent(
sl@0:     Tcl_Time *timePtr)		/* Maximum block time, or NULL. */
sl@0: {
sl@0:     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
sl@0:     MSG msg;
sl@0:     DWORD timeout, result;
sl@0:     int status;
sl@0: 
sl@0:     /*
sl@0:      * Allow the notifier to be hooked.  This may not make
sl@0:      * sense on windows, but mirrors the UNIX hook.
sl@0:      */
sl@0: 
sl@0:     if (tclStubs.tcl_WaitForEvent != tclOriginalNotifier.waitForEventProc) {
sl@0: 	return tclStubs.tcl_WaitForEvent(timePtr);
sl@0:     }
sl@0: 
sl@0:     /*
sl@0:      * Compute the timeout in milliseconds.
sl@0:      */
sl@0: 
sl@0:     if (timePtr) {
sl@0: 	timeout = timePtr->sec * 1000 + timePtr->usec / 1000;
sl@0:     } else {
sl@0: 	timeout = INFINITE;
sl@0:     }
sl@0: 
sl@0:     /*
sl@0:      * Check to see if there are any messages in the queue before waiting
sl@0:      * because MsgWaitForMultipleObjects will not wake up if there are events
sl@0:      * currently sitting in the queue.
sl@0:      */
sl@0: 
sl@0:     if (!PeekMessage(&msg, NULL, 0, 0, PM_NOREMOVE)) {
sl@0: 	/*
sl@0: 	 * Wait for something to happen (a signal from another thread, a
sl@0: 	 * message, or timeout).
sl@0: 	 */
sl@0: 
sl@0: 	result = MsgWaitForMultipleObjects(1, &tsdPtr->event, FALSE, timeout,
sl@0: 		QS_ALLINPUT);
sl@0:     }
sl@0: 
sl@0:     /*
sl@0:      * Check to see if there are any messages to process.
sl@0:      */
sl@0: 
sl@0:     if (PeekMessage(&msg, NULL, 0, 0, PM_NOREMOVE)) {
sl@0: 	/*
sl@0: 	 * Retrieve and dispatch the first message.
sl@0: 	 */
sl@0: 
sl@0: 	result = GetMessage(&msg, NULL, 0, 0);
sl@0: 	if (result == 0) {
sl@0: 	    /*
sl@0: 	     * We received a request to exit this thread (WM_QUIT), so
sl@0: 	     * propagate the quit message and start unwinding.
sl@0: 	     */
sl@0: 
sl@0: 	    PostQuitMessage((int) msg.wParam);
sl@0: 	    status = -1;
sl@0: 	} else if (result == -1) {
sl@0: 	    /*
sl@0: 	     * We got an error from the system.  I have no idea why this would
sl@0: 	     * happen, so we'll just unwind.
sl@0: 	     */
sl@0: 
sl@0: 	    status = -1;
sl@0: 	} else {
sl@0: 	    TranslateMessage(&msg);
sl@0: 	    DispatchMessage(&msg);
sl@0: 	    status = 1;
sl@0: 	}
sl@0:     } else {
sl@0: 	status = 0;
sl@0:     }
sl@0: 
sl@0:     ResetEvent(tsdPtr->event);
sl@0:     return status;
sl@0: }
sl@0: 
sl@0: /*
sl@0:  *----------------------------------------------------------------------
sl@0:  *
sl@0:  * Tcl_Sleep --
sl@0:  *
sl@0:  *	Delay execution for the specified number of milliseconds.
sl@0:  *
sl@0:  * Results:
sl@0:  *	None.
sl@0:  *
sl@0:  * Side effects:
sl@0:  *	Time passes.
sl@0:  *
sl@0:  *----------------------------------------------------------------------
sl@0:  */
sl@0: 
sl@0: void
sl@0: Tcl_Sleep(ms)
sl@0:     int ms;			/* Number of milliseconds to sleep. */
sl@0: {
sl@0:     /*
sl@0:      * Simply calling 'Sleep' for the requisite number of milliseconds
sl@0:      * can make the process appear to wake up early because it isn't
sl@0:      * synchronized with the CPU performance counter that is used in
sl@0:      * tclWinTime.c.  This behavior is probably benign, but messes
sl@0:      * up some of the corner cases in the test suite.  We get around
sl@0:      * this problem by repeating the 'Sleep' call as many times
sl@0:      * as necessary to make the clock advance by the requisite amount.
sl@0:      */
sl@0: 
sl@0:     Tcl_Time now;		/* Current wall clock time */
sl@0:     Tcl_Time desired;		/* Desired wakeup time */
sl@0:     DWORD sleepTime = ms;	/* Time to sleep */
sl@0: 
sl@0:     Tcl_GetTime( &now );
sl@0:     desired.sec = now.sec + ( ms / 1000 );
sl@0:     desired.usec = now.usec + 1000 * ( ms % 1000 );
sl@0:     if ( desired.usec > 1000000 ) {
sl@0: 	++desired.sec;
sl@0: 	desired.usec -= 1000000;
sl@0:     }
sl@0: 	
sl@0:     for ( ; ; ) {
sl@0: 	Sleep( sleepTime );
sl@0: 	Tcl_GetTime( &now );
sl@0: 	if ( now.sec > desired.sec ) {
sl@0: 	    break;
sl@0: 	} else if ( ( now.sec == desired.sec )
sl@0: 	     && ( now.usec >= desired.usec ) ) {
sl@0: 	    break;
sl@0: 	}
sl@0: 	sleepTime = ( ( 1000 * ( desired.sec - now.sec ) )
sl@0: 		      + ( ( desired.usec - now.usec ) / 1000 ) );
sl@0:     }
sl@0: 
sl@0: }