util/src/TclTk/tcl8.6.12/generic/tclNotify.c

   1 /*
   2  * tclNotify.c --
   3  *
   4  *      This file implements the generic portion of the Tcl notifier. The
   5  *      notifier is lowest-level part of the event system. It manages an event
   6  *      queue that holds Tcl_Event structures. The platform specific portion
   7  *      of the notifier is defined in the tcl*Notify.c files in each platform
   8  *      directory.
   9  *
  10  * Copyright (c) 1995-1997 Sun Microsystems, Inc.
  11  * Copyright (c) 1998 by Scriptics Corporation.
  12  * Copyright (c) 2003 by Kevin B. Kenny.  All rights reserved.
  13  *
  14  * See the file "license.terms" for information on usage and redistribution of
  15  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  16  */
  17
  18 #include "tclInt.h"
  19
  20 /*
  21  * Module-scope struct of notifier hooks that are checked in the default
  22  * notifier functions (for overriding via Tcl_SetNotifier).
  23  */
  24
  25 Tcl_NotifierProcs tclNotifierHooks = {
  26     NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL
  27 };
  28
  29 /*
  30  * For each event source (created with Tcl_CreateEventSource) there is a
  31  * structure of the following type:
  32  */
  33
  34 typedef struct EventSource {
  35     Tcl_EventSetupProc *setupProc;
  36     Tcl_EventCheckProc *checkProc;
  37     ClientData clientData;
  38     struct EventSource *nextPtr;
  39 } EventSource;
  40
  41 /*
  42  * The following structure keeps track of the state of the notifier on a
  43  * per-thread basis. The first three elements keep track of the event queue.
  44  * In addition to the first (next to be serviced) and last events in the
  45  * queue, we keep track of a "marker" event. This provides a simple priority
  46  * mechanism whereby events can be inserted at the front of the queue but
  47  * behind all other high-priority events already in the queue (this is used
  48  * for things like a sequence of Enter and Leave events generated during a
  49  * grab in Tk). These elements are protected by the queueMutex so that any
  50  * thread can queue an event on any notifier. Note that all of the values in
  51  * this structure will be initialized to 0.
  52  */
  53
  54 typedef struct ThreadSpecificData {
  55     Tcl_Event *firstEventPtr;   /* First pending event, or NULL if none. */
  56     Tcl_Event *lastEventPtr;    /* Last pending event, or NULL if none. */
  57     Tcl_Event *markerEventPtr;  /* Last high-priority event in queue, or NULL
  58                                  * if none. */
  59     Tcl_Mutex queueMutex;       /* Mutex to protect access to the previous
  60                                  * three fields. */
  61     int serviceMode;            /* One of TCL_SERVICE_NONE or
  62                                  * TCL_SERVICE_ALL. */
  63     int blockTimeSet;           /* 0 means there is no maximum block time:
  64                                  * block forever. */
  65     Tcl_Time blockTime;         /* If blockTimeSet is 1, gives the maximum
  66                                  * elapsed time for the next block. */
  67     int inTraversal;            /* 1 if Tcl_SetMaxBlockTime is being called
  68                                  * during an event source traversal. */
  69     EventSource *firstEventSourcePtr;
  70                                 /* Pointer to first event source in list of
  71                                  * event sources for this thread. */
  72     Tcl_ThreadId threadId;      /* Thread that owns this notifier instance. */
  73     ClientData clientData;      /* Opaque handle for platform specific
  74                                  * notifier. */
  75     int initialized;            /* 1 if notifier has been initialized. */
  76     struct ThreadSpecificData *nextPtr;
  77                                 /* Next notifier in global list of notifiers.
  78                                  * Access is controlled by the listLock global
  79                                  * mutex. */
  80 } ThreadSpecificData;
  81
  82 static Tcl_ThreadDataKey dataKey;
  83
  84 /*
  85  * Global list of notifiers. Access to this list is controlled by the listLock
  86  * mutex. If this becomes a performance bottleneck, this could be replaced
  87  * with a hashtable.
  88  */
  89
  90 static ThreadSpecificData *firstNotifierPtr = NULL;
  91 TCL_DECLARE_MUTEX(listLock)
  92
  93 /*
  94  * Declarations for routines used only in this file.
  95  */
  96
  97 static void             QueueEvent(ThreadSpecificData *tsdPtr,
  98                             Tcl_Event *evPtr, Tcl_QueuePosition position);
  99 \f
 100 /*
 101  *----------------------------------------------------------------------
 102  *
 103  * TclInitNotifier --
 104  *
 105  *      Initialize the thread local data structures for the notifier
 106  *      subsystem.
 107  *
 108  * Results:
 109  *      None.
 110  *
 111  * Side effects:
 112  *      Adds the current thread to the global list of notifiers.
 113  *
 114  *----------------------------------------------------------------------
 115  */
 116
 117 void
 118 TclInitNotifier(void)
 119 {
 120     ThreadSpecificData *tsdPtr;
 121     Tcl_ThreadId threadId = Tcl_GetCurrentThread();
 122
 123     Tcl_MutexLock(&listLock);
 124     for (tsdPtr = firstNotifierPtr; tsdPtr && tsdPtr->threadId != threadId;
 125             tsdPtr = tsdPtr->nextPtr) {
 126         /* Empty loop body. */
 127     }
 128
 129     if (NULL == tsdPtr) {
 130         /*
 131          * Notifier not yet initialized in this thread.
 132          */
 133
 134         tsdPtr = TCL_TSD_INIT(&dataKey);
 135         tsdPtr->threadId = threadId;
 136         tsdPtr->clientData = Tcl_InitNotifier();
 137         tsdPtr->initialized = 1;
 138         tsdPtr->nextPtr = firstNotifierPtr;
 139         firstNotifierPtr = tsdPtr;
 140     }
 141     Tcl_MutexUnlock(&listLock);
 142 }
 143 \f
 144 /*
 145  *----------------------------------------------------------------------
 146  *
 147  * TclFinalizeNotifier --
 148  *
 149  *      Finalize the thread local data structures for the notifier subsystem.
 150  *
 151  * Results:
 152  *      None.
 153  *
 154  * Side effects:
 155  *      Removes the notifier associated with the current thread from the
 156  *      global notifier list. This is done only if the notifier was
 157  *      initialized for this thread by call to TclInitNotifier(). This is
 158  *      always true for threads which have been seeded with an Tcl
 159  *      interpreter, since the call to Tcl_CreateInterp will, among other
 160  *      things, call TclInitializeSubsystems() and this one will, in turn,
 161  *      call the TclInitNotifier() for the thread. For threads created without
 162  *      the Tcl interpreter, though, nobody is explicitly nor implicitly
 163  *      calling the TclInitNotifier hence, TclFinalizeNotifier should not be
 164  *      performed at all.
 165  *
 166  *----------------------------------------------------------------------
 167  */
 168
 169 void
 170 TclFinalizeNotifier(void)
 171 {
 172     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
 173     ThreadSpecificData **prevPtrPtr;
 174     Tcl_Event *evPtr, *hold;
 175
 176     if (!tsdPtr->initialized) {
 177         return;         /* Notifier not initialized for the current thread */
 178     }
 179
 180     Tcl_MutexLock(&(tsdPtr->queueMutex));
 181     for (evPtr = tsdPtr->firstEventPtr; evPtr != NULL; ) {
 182         hold = evPtr;
 183         evPtr = evPtr->nextPtr;
 184         ckfree(hold);
 185     }
 186     tsdPtr->firstEventPtr = NULL;
 187     tsdPtr->lastEventPtr = NULL;
 188     Tcl_MutexUnlock(&(tsdPtr->queueMutex));
 189
 190     Tcl_MutexLock(&listLock);
 191
 192     Tcl_FinalizeNotifier(tsdPtr->clientData);
 193     Tcl_MutexFinalize(&(tsdPtr->queueMutex));
 194     for (prevPtrPtr = &firstNotifierPtr; *prevPtrPtr != NULL;
 195             prevPtrPtr = &((*prevPtrPtr)->nextPtr)) {
 196         if (*prevPtrPtr == tsdPtr) {
 197             *prevPtrPtr = tsdPtr->nextPtr;
 198             break;
 199         }
 200     }
 201     tsdPtr->initialized = 0;
 202
 203     Tcl_MutexUnlock(&listLock);
 204 }
 205 \f
 206 /*
 207  *----------------------------------------------------------------------
 208  *
 209  * Tcl_SetNotifier --
 210  *
 211  *      Install a set of alternate functions for use with the notifier. In
 212  *      particular, this can be used to install the Xt-based notifier for use
 213  *      with the Browser plugin.
 214  *
 215  * Results:
 216  *      None.
 217  *
 218  * Side effects:
 219  *      Set the tclNotifierHooks global, which is checked in the default
 220  *      notifier functions.
 221  *
 222  *----------------------------------------------------------------------
 223  */
 224
 225 void
 226 Tcl_SetNotifier(
 227     Tcl_NotifierProcs *notifierProcPtr)
 228 {
 229     tclNotifierHooks = *notifierProcPtr;
 230 }
 231 \f
 232 /*
 233  *----------------------------------------------------------------------
 234  *
 235  * Tcl_CreateEventSource --
 236  *
 237  *      This function is invoked to create a new source of events. The source
 238  *      is identified by a function that gets invoked during Tcl_DoOneEvent to
 239  *      check for events on that source and queue them.
 240  *
 241  *
 242  * Results:
 243  *      None.
 244  *
 245  * Side effects:
 246  *      SetupProc and checkProc will be invoked each time that Tcl_DoOneEvent
 247  *      runs out of things to do. SetupProc will be invoked before
 248  *      Tcl_DoOneEvent calls select or whatever else it uses to wait for
 249  *      events. SetupProc typically calls functions like Tcl_SetMaxBlockTime
 250  *      to indicate what to wait for.
 251  *
 252  *      CheckProc is called after select or whatever operation was actually
 253  *      used to wait. It figures out whether anything interesting actually
 254  *      happened (e.g. by calling Tcl_AsyncReady), and then calls
 255  *      Tcl_QueueEvent to queue any events that are ready.
 256  *
 257  *      Each of these functions is passed two arguments, e.g.
 258  *              (*checkProc)(ClientData clientData, int flags));
 259  *      ClientData is the same as the clientData argument here, and flags is a
 260  *      combination of things like TCL_FILE_EVENTS that indicates what events
 261  *      are of interest: setupProc and checkProc use flags to figure out
 262  *      whether their events are relevant or not.
 263  *
 264  *----------------------------------------------------------------------
 265  */
 266
 267 void
 268 Tcl_CreateEventSource(
 269     Tcl_EventSetupProc *setupProc,
 270                                 /* Function to invoke to figure out what to
 271                                  * wait for. */
 272     Tcl_EventCheckProc *checkProc,
 273                                 /* Function to call after waiting to see what
 274                                  * happened. */
 275     ClientData clientData)      /* One-word argument to pass to setupProc and
 276                                  * checkProc. */
 277 {
 278     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
 279     EventSource *sourcePtr = ckalloc(sizeof(EventSource));
 280
 281     sourcePtr->setupProc = setupProc;
 282     sourcePtr->checkProc = checkProc;
 283     sourcePtr->clientData = clientData;
 284     sourcePtr->nextPtr = tsdPtr->firstEventSourcePtr;
 285     tsdPtr->firstEventSourcePtr = sourcePtr;
 286 }
 287 \f
 288 /*
 289  *----------------------------------------------------------------------
 290  *
 291  * Tcl_DeleteEventSource --
 292  *
 293  *      This function is invoked to delete the source of events given by proc
 294  *      and clientData.
 295  *
 296  * Results:
 297  *      None.
 298  *
 299  * Side effects:
 300  *      The given event source is canceled, so its function will never again
 301  *      be called. If no such source exists, nothing happens.
 302  *
 303  *----------------------------------------------------------------------
 304  */
 305
 306 void
 307 Tcl_DeleteEventSource(
 308     Tcl_EventSetupProc *setupProc,
 309                                 /* Function to invoke to figure out what to
 310                                  * wait for. */
 311     Tcl_EventCheckProc *checkProc,
 312                                 /* Function to call after waiting to see what
 313                                  * happened. */
 314     ClientData clientData)      /* One-word argument to pass to setupProc and
 315                                  * checkProc. */
 316 {
 317     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
 318     EventSource *sourcePtr, *prevPtr;
 319
 320     for (sourcePtr = tsdPtr->firstEventSourcePtr, prevPtr = NULL;
 321             sourcePtr != NULL;
 322             prevPtr = sourcePtr, sourcePtr = sourcePtr->nextPtr) {
 323         if ((sourcePtr->setupProc != setupProc)
 324                 || (sourcePtr->checkProc != checkProc)
 325                 || (sourcePtr->clientData != clientData)) {
 326             continue;
 327         }
 328         if (prevPtr == NULL) {
 329             tsdPtr->firstEventSourcePtr = sourcePtr->nextPtr;
 330         } else {
 331             prevPtr->nextPtr = sourcePtr->nextPtr;
 332         }
 333         ckfree(sourcePtr);
 334         return;
 335     }
 336 }
 337 \f
 338 /*
 339  *----------------------------------------------------------------------
 340  *
 341  * Tcl_QueueEvent --
 342  *
 343  *      Queue an event on the event queue associated with the current thread.
 344  *
 345  * Results:
 346  *      None.
 347  *
 348  * Side effects:
 349  *      None.
 350  *
 351  *----------------------------------------------------------------------
 352  */
 353
 354 void
 355 Tcl_QueueEvent(
 356     Tcl_Event *evPtr,           /* Event to add to queue. The storage space
 357                                  * must have been allocated the caller with
 358                                  * malloc (ckalloc), and it becomes the
 359                                  * property of the event queue. It will be
 360                                  * freed after the event has been handled. */
 361     Tcl_QueuePosition position) /* One of TCL_QUEUE_TAIL, TCL_QUEUE_HEAD,
 362                                  * TCL_QUEUE_MARK. */
 363 {
 364     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
 365
 366     QueueEvent(tsdPtr, evPtr, position);
 367 }
 368 \f
 369 /*
 370  *----------------------------------------------------------------------
 371  *
 372  * Tcl_ThreadQueueEvent --
 373  *
 374  *      Queue an event on the specified thread's event queue.
 375  *
 376  * Results:
 377  *      None.
 378  *
 379  * Side effects:
 380  *      None.
 381  *
 382  *----------------------------------------------------------------------
 383  */
 384
 385 void
 386 Tcl_ThreadQueueEvent(
 387     Tcl_ThreadId threadId,      /* Identifier for thread to use. */
 388     Tcl_Event *evPtr,           /* Event to add to queue. The storage space
 389                                  * must have been allocated the caller with
 390                                  * malloc (ckalloc), and it becomes the
 391                                  * property of the event queue. It will be
 392                                  * freed after the event has been handled. */
 393     Tcl_QueuePosition position) /* One of TCL_QUEUE_TAIL, TCL_QUEUE_HEAD,
 394                                  * TCL_QUEUE_MARK. */
 395 {
 396     ThreadSpecificData *tsdPtr;
 397
 398     /*
 399      * Find the notifier associated with the specified thread.
 400      */
 401
 402     Tcl_MutexLock(&listLock);
 403     for (tsdPtr = firstNotifierPtr; tsdPtr && tsdPtr->threadId != threadId;
 404             tsdPtr = tsdPtr->nextPtr) {
 405         /* Empty loop body. */
 406     }
 407
 408     /*
 409      * Queue the event if there was a notifier associated with the thread.
 410      */
 411
 412     if (tsdPtr) {
 413         QueueEvent(tsdPtr, evPtr, position);
 414     } else {
 415         ckfree(evPtr);
 416     }
 417     Tcl_MutexUnlock(&listLock);
 418 }
 419 \f
 420 /*
 421  *----------------------------------------------------------------------
 422  *
 423  * QueueEvent --
 424  *
 425  *      Insert an event into the specified thread's event queue at one of
 426  *      three positions: the head, the tail, or before a floating marker.
 427  *      Events inserted before the marker will be processed in first-in-
 428  *      first-out order, but before any events inserted at the tail of the
 429  *      queue. Events inserted at the head of the queue will be processed in
 430  *      last-in-first-out order.
 431  *
 432  * Results:
 433  *      None.
 434  *
 435  * Side effects:
 436  *      None.
 437  *
 438  *----------------------------------------------------------------------
 439  */
 440
 441 static void
 442 QueueEvent(
 443     ThreadSpecificData *tsdPtr, /* Handle to thread local data that indicates
 444                                  * which event queue to use. */
 445     Tcl_Event *evPtr,           /* Event to add to queue.  The storage space
 446                                  * must have been allocated the caller with
 447                                  * malloc (ckalloc), and it becomes the
 448                                  * property of the event queue. It will be
 449                                  * freed after the event has been handled. */
 450     Tcl_QueuePosition position) /* One of TCL_QUEUE_TAIL, TCL_QUEUE_HEAD,
 451                                  * TCL_QUEUE_MARK. */
 452 {
 453     Tcl_MutexLock(&(tsdPtr->queueMutex));
 454     if (position == TCL_QUEUE_TAIL) {
 455         /*
 456          * Append the event on the end of the queue.
 457          */
 458
 459         evPtr->nextPtr = NULL;
 460         if (tsdPtr->firstEventPtr == NULL) {
 461             tsdPtr->firstEventPtr = evPtr;
 462         } else {
 463             tsdPtr->lastEventPtr->nextPtr = evPtr;
 464         }
 465         tsdPtr->lastEventPtr = evPtr;
 466     } else if (position == TCL_QUEUE_HEAD) {
 467         /*
 468          * Push the event on the head of the queue.
 469          */
 470
 471         evPtr->nextPtr = tsdPtr->firstEventPtr;
 472         if (tsdPtr->firstEventPtr == NULL) {
 473             tsdPtr->lastEventPtr = evPtr;
 474         }
 475         tsdPtr->firstEventPtr = evPtr;
 476     } else if (position == TCL_QUEUE_MARK) {
 477         /*
 478          * Insert the event after the current marker event and advance the
 479          * marker to the new event.
 480          */
 481
 482         if (tsdPtr->markerEventPtr == NULL) {
 483             evPtr->nextPtr = tsdPtr->firstEventPtr;
 484             tsdPtr->firstEventPtr = evPtr;
 485         } else {
 486             evPtr->nextPtr = tsdPtr->markerEventPtr->nextPtr;
 487             tsdPtr->markerEventPtr->nextPtr = evPtr;
 488         }
 489         tsdPtr->markerEventPtr = evPtr;
 490         if (evPtr->nextPtr == NULL) {
 491             tsdPtr->lastEventPtr = evPtr;
 492         }
 493     }
 494     Tcl_MutexUnlock(&(tsdPtr->queueMutex));
 495 }
 496 \f
 497 /*
 498  *----------------------------------------------------------------------
 499  *
 500  * Tcl_DeleteEvents --
 501  *
 502  *      Calls a function for each event in the queue and deletes those for
 503  *      which the function returns 1. Events for which the function returns 0
 504  *      are left in the queue. Operates on the queue associated with the
 505  *      current thread.
 506  *
 507  * Results:
 508  *      None.
 509  *
 510  * Side effects:
 511  *      Potentially removes one or more events from the event queue.
 512  *
 513  *----------------------------------------------------------------------
 514  */
 515
 516 void
 517 Tcl_DeleteEvents(
 518     Tcl_EventDeleteProc *proc,  /* The function to call. */
 519     ClientData clientData)      /* The type-specific data. */
 520 {
 521     Tcl_Event *evPtr;           /* Pointer to the event being examined */
 522     Tcl_Event *prevPtr;         /* Pointer to evPtr's predecessor, or NULL if
 523                                  * evPtr designates the first event in the
 524                                  * queue for the thread. */
 525     Tcl_Event *hold;
 526     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
 527
 528     Tcl_MutexLock(&(tsdPtr->queueMutex));
 529
 530     /*
 531      * Walk the queue of events for the thread, applying 'proc' to each to
 532      * decide whether to eliminate the event.
 533      */
 534
 535     prevPtr = NULL;
 536     evPtr = tsdPtr->firstEventPtr;
 537     while (evPtr != NULL) {
 538         if (proc(evPtr, clientData) == 1) {
 539             /*
 540              * This event should be deleted. Unlink it.
 541              */
 542
 543             if (prevPtr == NULL) {
 544                 tsdPtr->firstEventPtr = evPtr->nextPtr;
 545             } else {
 546                 prevPtr->nextPtr = evPtr->nextPtr;
 547             }
 548
 549             /*
 550              * Update 'last' and 'marker' events if either has been deleted.
 551              */
 552
 553             if (evPtr->nextPtr == NULL) {
 554                 tsdPtr->lastEventPtr = prevPtr;
 555             }
 556             if (tsdPtr->markerEventPtr == evPtr) {
 557                 tsdPtr->markerEventPtr = prevPtr;
 558             }
 559
 560             /*
 561              * Delete the event data structure.
 562              */
 563
 564             hold = evPtr;
 565             evPtr = evPtr->nextPtr;
 566             ckfree(hold);
 567         } else {
 568             /*
 569              * Event is to be retained.
 570              */
 571
 572             prevPtr = evPtr;
 573             evPtr = evPtr->nextPtr;
 574         }
 575     }
 576     Tcl_MutexUnlock(&(tsdPtr->queueMutex));
 577 }
 578 \f
 579 /*
 580  *----------------------------------------------------------------------
 581  *
 582  * Tcl_ServiceEvent --
 583  *
 584  *      Process one event from the event queue, or invoke an asynchronous
 585  *      event handler. Operates on event queue for current thread.
 586  *
 587  * Results:
 588  *      The return value is 1 if the function actually found an event to
 589  *      process. If no processing occurred, then 0 is returned.
 590  *
 591  * Side effects:
 592  *      Invokes all of the event handlers for the highest priority event in
 593  *      the event queue. May collapse some events into a single event or
 594  *      discard stale events.
 595  *
 596  *----------------------------------------------------------------------
 597  */
 598
 599 int
 600 Tcl_ServiceEvent(
 601     int flags)                  /* Indicates what events should be processed.
 602                                  * May be any combination of TCL_WINDOW_EVENTS
 603                                  * TCL_FILE_EVENTS, TCL_TIMER_EVENTS, or other
 604                                  * flags defined elsewhere. Events not
 605                                  * matching this will be skipped for
 606                                  * processing later. */
 607 {
 608     Tcl_Event *evPtr, *prevPtr;
 609     Tcl_EventProc *proc;
 610     int result;
 611     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
 612
 613     /*
 614      * Asynchronous event handlers are considered to be the highest priority
 615      * events, and so must be invoked before we process events on the event
 616      * queue.
 617      */
 618
 619     if (Tcl_AsyncReady()) {
 620         (void) Tcl_AsyncInvoke(NULL, 0);
 621         return 1;
 622     }
 623
 624     /*
 625      * No event flags is equivalent to TCL_ALL_EVENTS.
 626      */
 627
 628     if ((flags & TCL_ALL_EVENTS) == 0) {
 629         flags |= TCL_ALL_EVENTS;
 630     }
 631
 632     /*
 633      * Loop through all the events in the queue until we find one that can
 634      * actually be handled.
 635      */
 636
 637     Tcl_MutexLock(&(tsdPtr->queueMutex));
 638     for (evPtr = tsdPtr->firstEventPtr; evPtr != NULL;
 639             evPtr = evPtr->nextPtr) {
 640         /*
 641          * Call the handler for the event. If it actually handles the event
 642          * then free the storage for the event. There are two tricky things
 643          * here, both stemming from the fact that the event code may be
 644          * re-entered while servicing the event:
 645          *
 646          * 1. Set the "proc" field to NULL.  This is a signal to ourselves
 647          *    that we shouldn't reexecute the handler if the event loop is
 648          *    re-entered.
 649          * 2. When freeing the event, must search the queue again from the
 650          *    front to find it. This is because the event queue could change
 651          *    almost arbitrarily while handling the event, so we can't depend
 652          *    on pointers found now still being valid when the handler
 653          *    returns.
 654          */
 655
 656         proc = evPtr->proc;
 657         if (proc == NULL) {
 658             continue;
 659         }
 660         evPtr->proc = NULL;
 661
 662         /*
 663          * Release the lock before calling the event function. This allows
 664          * other threads to post events if we enter a recursive event loop in
 665          * this thread. Note that we are making the assumption that if the
 666          * proc returns 0, the event is still in the list.
 667          */
 668
 669         Tcl_MutexUnlock(&(tsdPtr->queueMutex));
 670         result = proc(evPtr, flags);
 671         Tcl_MutexLock(&(tsdPtr->queueMutex));
 672
 673         if (result) {
 674             /*
 675              * The event was processed, so remove it from the queue.
 676              */
 677
 678             if (tsdPtr->firstEventPtr == evPtr) {
 679                 tsdPtr->firstEventPtr = evPtr->nextPtr;
 680                 if (evPtr->nextPtr == NULL) {
 681                     tsdPtr->lastEventPtr = NULL;
 682                 }
 683                 if (tsdPtr->markerEventPtr == evPtr) {
 684                     tsdPtr->markerEventPtr = NULL;
 685                 }
 686             } else {
 687                 for (prevPtr = tsdPtr->firstEventPtr;
 688                         prevPtr && prevPtr->nextPtr != evPtr;
 689                         prevPtr = prevPtr->nextPtr) {
 690                     /* Empty loop body. */
 691                 }
 692                 if (prevPtr) {
 693                     prevPtr->nextPtr = evPtr->nextPtr;
 694                     if (evPtr->nextPtr == NULL) {
 695                         tsdPtr->lastEventPtr = prevPtr;
 696                     }
 697                     if (tsdPtr->markerEventPtr == evPtr) {
 698                         tsdPtr->markerEventPtr = prevPtr;
 699                     }
 700                 } else {
 701                     evPtr = NULL;
 702                 }
 703             }
 704             if (evPtr) {
 705                 ckfree(evPtr);
 706             }
 707             Tcl_MutexUnlock(&(tsdPtr->queueMutex));
 708             return 1;
 709         } else {
 710             /*
 711              * The event wasn't actually handled, so we have to restore the
 712              * proc field to allow the event to be attempted again.
 713              */
 714
 715             evPtr->proc = proc;
 716         }
 717     }
 718     Tcl_MutexUnlock(&(tsdPtr->queueMutex));
 719     return 0;
 720 }
 721 \f
 722 /*
 723  *----------------------------------------------------------------------
 724  *
 725  * Tcl_GetServiceMode --
 726  *
 727  *      This routine returns the current service mode of the notifier.
 728  *
 729  * Results:
 730  *      Returns either TCL_SERVICE_ALL or TCL_SERVICE_NONE.
 731  *
 732  * Side effects:
 733  *      None.
 734  *
 735  *----------------------------------------------------------------------
 736  */
 737
 738 int
 739 Tcl_GetServiceMode(void)
 740 {
 741     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
 742
 743     return tsdPtr->serviceMode;
 744 }
 745 \f
 746 /*
 747  *----------------------------------------------------------------------
 748  *
 749  * Tcl_SetServiceMode --
 750  *
 751  *      This routine sets the current service mode of the tsdPtr->
 752  *
 753  * Results:
 754  *      Returns the previous service mode.
 755  *
 756  * Side effects:
 757  *      Invokes the notifier service mode hook function.
 758  *
 759  *----------------------------------------------------------------------
 760  */
 761
 762 int
 763 Tcl_SetServiceMode(
 764     int mode)                   /* New service mode: TCL_SERVICE_ALL or
 765                                  * TCL_SERVICE_NONE */
 766 {
 767     int oldMode;
 768     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
 769
 770     oldMode = tsdPtr->serviceMode;
 771     tsdPtr->serviceMode = mode;
 772     Tcl_ServiceModeHook(mode);
 773     return oldMode;
 774 }
 775 \f
 776 /*
 777  *----------------------------------------------------------------------
 778  *
 779  * Tcl_SetMaxBlockTime --
 780  *
 781  *      This function is invoked by event sources to tell the notifier how
 782  *      long it may block the next time it blocks. The timePtr argument gives
 783  *      a maximum time; the actual time may be less if some other event source
 784  *      requested a smaller time.
 785  *
 786  * Results:
 787  *      None.
 788  *
 789  * Side effects:
 790  *      May reduce the length of the next sleep in the tsdPtr->
 791  *
 792  *----------------------------------------------------------------------
 793  */
 794
 795 void
 796 Tcl_SetMaxBlockTime(
 797     const Tcl_Time *timePtr)            /* Specifies a maximum elapsed time for the
 798                                  * next blocking operation in the event
 799                                  * tsdPtr-> */
 800 {
 801     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
 802
 803     if (!tsdPtr->blockTimeSet || (timePtr->sec < tsdPtr->blockTime.sec)
 804             || ((timePtr->sec == tsdPtr->blockTime.sec)
 805             && (timePtr->usec < tsdPtr->blockTime.usec))) {
 806         tsdPtr->blockTime = *timePtr;
 807         tsdPtr->blockTimeSet = 1;
 808     }
 809
 810     /*
 811      * If we are called outside an event source traversal, set the timeout
 812      * immediately.
 813      */
 814
 815     if (!tsdPtr->inTraversal) {
 816         Tcl_SetTimer(&tsdPtr->blockTime);
 817     }
 818 }
 819 \f
 820 /*
 821  *----------------------------------------------------------------------
 822  *
 823  * Tcl_DoOneEvent --
 824  *
 825  *      Process a single event of some sort. If there's no work to do, wait
 826  *      for an event to occur, then process it.
 827  *
 828  * Results:
 829  *      The return value is 1 if the function actually found an event to
 830  *      process. If no processing occurred, then 0 is returned (this can
 831  *      happen if the TCL_DONT_WAIT flag is set or if there are no event
 832  *      handlers to wait for in the set specified by flags).
 833  *
 834  * Side effects:
 835  *      May delay execution of process while waiting for an event, unless
 836  *      TCL_DONT_WAIT is set in the flags argument. Event sources are invoked
 837  *      to check for and queue events. Event handlers may produce arbitrary
 838  *      side effects.
 839  *
 840  *----------------------------------------------------------------------
 841  */
 842
 843 int
 844 Tcl_DoOneEvent(
 845     int flags)                  /* Miscellaneous flag values: may be any
 846                                  * combination of TCL_DONT_WAIT,
 847                                  * TCL_WINDOW_EVENTS, TCL_FILE_EVENTS,
 848                                  * TCL_TIMER_EVENTS, TCL_IDLE_EVENTS, or
 849                                  * others defined by event sources. */
 850 {
 851     int result = 0, oldMode;
 852     EventSource *sourcePtr;
 853     Tcl_Time *timePtr;
 854     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
 855
 856     /*
 857      * The first thing we do is to service any asynchronous event handlers.
 858      */
 859
 860     if (Tcl_AsyncReady()) {
 861         (void) Tcl_AsyncInvoke(NULL, 0);
 862         return 1;
 863     }
 864
 865     /*
 866      * No event flags is equivalent to TCL_ALL_EVENTS.
 867      */
 868
 869     if ((flags & TCL_ALL_EVENTS) == 0) {
 870         flags |= TCL_ALL_EVENTS;
 871     }
 872
 873     /*
 874      * Set the service mode to none so notifier event routines won't try to
 875      * service events recursively.
 876      */
 877
 878     oldMode = tsdPtr->serviceMode;
 879     tsdPtr->serviceMode = TCL_SERVICE_NONE;
 880
 881     /*
 882      * The core of this function is an infinite loop, even though we only
 883      * service one event. The reason for this is that we may be processing
 884      * events that don't do anything inside of Tcl.
 885      */
 886
 887     while (1) {
 888         /*
 889          * If idle events are the only things to service, skip the main part
 890          * of the loop and go directly to handle idle events (i.e. don't wait
 891          * even if TCL_DONT_WAIT isn't set).
 892          */
 893
 894         if ((flags & TCL_ALL_EVENTS) == TCL_IDLE_EVENTS) {
 895             flags = TCL_IDLE_EVENTS | TCL_DONT_WAIT;
 896             goto idleEvents;
 897         }
 898
 899         /*
 900          * Ask Tcl to service a queued event, if there are any.
 901          */
 902
 903         if (Tcl_ServiceEvent(flags)) {
 904             result = 1;
 905             break;
 906         }
 907
 908         /*
 909          * If TCL_DONT_WAIT is set, be sure to poll rather than blocking,
 910          * otherwise reset the block time to infinity.
 911          */
 912
 913         if (flags & TCL_DONT_WAIT) {
 914             tsdPtr->blockTime.sec = 0;
 915             tsdPtr->blockTime.usec = 0;
 916             tsdPtr->blockTimeSet = 1;
 917         } else {
 918             tsdPtr->blockTimeSet = 0;
 919         }
 920
 921         /*
 922          * Set up all the event sources for new events. This will cause the
 923          * block time to be updated if necessary.
 924          */
 925
 926         tsdPtr->inTraversal = 1;
 927         for (sourcePtr = tsdPtr->firstEventSourcePtr; sourcePtr != NULL;
 928                 sourcePtr = sourcePtr->nextPtr) {
 929             if (sourcePtr->setupProc) {
 930                 sourcePtr->setupProc(sourcePtr->clientData, flags);
 931             }
 932         }
 933         tsdPtr->inTraversal = 0;
 934
 935         if ((flags & TCL_DONT_WAIT) || tsdPtr->blockTimeSet) {
 936             timePtr = &tsdPtr->blockTime;
 937         } else {
 938             timePtr = NULL;
 939         }
 940
 941         /*
 942          * Wait for a new event or a timeout. If Tcl_WaitForEvent returns -1,
 943          * we should abort Tcl_DoOneEvent.
 944          */
 945
 946         result = Tcl_WaitForEvent(timePtr);
 947         if (result < 0) {
 948             result = 0;
 949             break;
 950         }
 951
 952         /*
 953          * Check all the event sources for new events.
 954          */
 955
 956         for (sourcePtr = tsdPtr->firstEventSourcePtr; sourcePtr != NULL;
 957                 sourcePtr = sourcePtr->nextPtr) {
 958             if (sourcePtr->checkProc) {
 959                 sourcePtr->checkProc(sourcePtr->clientData, flags);
 960             }
 961         }
 962
 963         /*
 964          * Check for events queued by the notifier or event sources.
 965          */
 966
 967         if (Tcl_ServiceEvent(flags)) {
 968             result = 1;
 969             break;
 970         }
 971
 972         /*
 973          * We've tried everything at this point, but nobody we know about had
 974          * anything to do. Check for idle events. If none, either quit or go
 975          * back to the top and try again.
 976          */
 977
 978     idleEvents:
 979         if (flags & TCL_IDLE_EVENTS) {
 980             if (TclServiceIdle()) {
 981                 result = 1;
 982                 break;
 983             }
 984         }
 985         if (flags & TCL_DONT_WAIT) {
 986             break;
 987         }
 988
 989         /*
 990          * If Tcl_WaitForEvent has returned 1, indicating that one system
 991          * event has been dispatched (and thus that some Tcl code might have
 992          * been indirectly executed), we break out of the loop. We do this to
 993          * give VwaitCmd for instance a chance to check if that system event
 994          * had the side effect of changing the variable (so the vwait can
 995          * return and unwind properly).
 996          *
 997          * NB: We will process idle events if any first, because otherwise we
 998          *     might never do the idle events if the notifier always gets
 999          *     system events.
1000          */
1001
1002         if (result) {
1003             break;
1004         }
1005     }
1006
1007     tsdPtr->serviceMode = oldMode;
1008     return result;
1009 }
1010 \f
1011 /*
1012  *----------------------------------------------------------------------
1013  *
1014  * Tcl_ServiceAll --
1015  *
1016  *      This routine checks all of the event sources, processes events that
1017  *      are on the Tcl event queue, and then calls the any idle handlers.
1018  *      Platform specific notifier callbacks that generate events should call
1019  *      this routine before returning to the system in order to ensure that
1020  *      Tcl gets a chance to process the new events.
1021  *
1022  * Results:
1023  *      Returns 1 if an event or idle handler was invoked, else 0.
1024  *
1025  * Side effects:
1026  *      Anything that an event or idle handler may do.
1027  *
1028  *----------------------------------------------------------------------
1029  */
1030
1031 int
1032 Tcl_ServiceAll(void)
1033 {
1034     int result = 0;
1035     EventSource *sourcePtr;
1036     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
1037
1038     if (tsdPtr->serviceMode == TCL_SERVICE_NONE) {
1039         return result;
1040     }
1041
1042     /*
1043      * We need to turn off event servicing like we to in Tcl_DoOneEvent, to
1044      * avoid recursive calls.
1045      */
1046
1047     tsdPtr->serviceMode = TCL_SERVICE_NONE;
1048
1049     /*
1050      * Check async handlers first.
1051      */
1052
1053     if (Tcl_AsyncReady()) {
1054         (void) Tcl_AsyncInvoke(NULL, 0);
1055     }
1056
1057     /*
1058      * Make a single pass through all event sources, queued events, and idle
1059      * handlers. Note that we wait to update the notifier timer until the end
1060      * so we can avoid multiple changes.
1061      */
1062
1063     tsdPtr->inTraversal = 1;
1064     tsdPtr->blockTimeSet = 0;
1065
1066     for (sourcePtr = tsdPtr->firstEventSourcePtr; sourcePtr != NULL;
1067             sourcePtr = sourcePtr->nextPtr) {
1068         if (sourcePtr->setupProc) {
1069             sourcePtr->setupProc(sourcePtr->clientData, TCL_ALL_EVENTS);
1070         }
1071     }
1072     for (sourcePtr = tsdPtr->firstEventSourcePtr; sourcePtr != NULL;
1073             sourcePtr = sourcePtr->nextPtr) {
1074         if (sourcePtr->checkProc) {
1075             sourcePtr->checkProc(sourcePtr->clientData, TCL_ALL_EVENTS);
1076         }
1077     }
1078
1079     while (Tcl_ServiceEvent(0)) {
1080         result = 1;
1081     }
1082     if (TclServiceIdle()) {
1083         result = 1;
1084     }
1085
1086     if (!tsdPtr->blockTimeSet) {
1087         Tcl_SetTimer(NULL);
1088     } else {
1089         Tcl_SetTimer(&tsdPtr->blockTime);
1090     }
1091     tsdPtr->inTraversal = 0;
1092     tsdPtr->serviceMode = TCL_SERVICE_ALL;
1093     return result;
1094 }
1095 \f
1096 /*
1097  *----------------------------------------------------------------------
1098  *
1099  * Tcl_ThreadAlert --
1100  *
1101  *      This function wakes up the notifier associated with the specified
1102  *      thread (if there is one).
1103  *
1104  * Results:
1105  *      None.
1106  *
1107  * Side effects:
1108  *      None.
1109  *
1110  *----------------------------------------------------------------------
1111  */
1112
1113 void
1114 Tcl_ThreadAlert(
1115     Tcl_ThreadId threadId)      /* Identifier for thread to use. */
1116 {
1117     ThreadSpecificData *tsdPtr;
1118
1119     /*
1120      * Find the notifier associated with the specified thread. Note that we
1121      * need to hold the listLock while calling Tcl_AlertNotifier to avoid a
1122      * race condition where the specified thread might destroy its notifier.
1123      */
1124
1125     Tcl_MutexLock(&listLock);
1126     for (tsdPtr = firstNotifierPtr; tsdPtr; tsdPtr = tsdPtr->nextPtr) {
1127         if (tsdPtr->threadId == threadId) {
1128             Tcl_AlertNotifier(tsdPtr->clientData);
1129             break;
1130         }
1131     }
1132     Tcl_MutexUnlock(&listLock);
1133 }
1134 \f
1135 /*
1136  * Local Variables:
1137  * mode: c
1138  * c-basic-offset: 4
1139  * fill-column: 78
1140  * End:
1141  */