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