tclNotify.c
上传用户:rrhhcc
上传日期:2015-12-11
资源大小:54129k
文件大小:31k
源码类别:

通讯编程

开发平台:

Visual C++

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