Tcl Source Code

is specified as an interval (how long to wait), not an absolute
time (when to wakeup).  If the pointer passed to \fBTcl_WaitForEvent\fR
is NULL, it means there is no maximum wait time:  wait forever if
necessary.
.AP Tcl_Event *evPtr in
An event to add to the event queue.  The storage for the event must
have been allocated by the caller using \fBTcl_Alloc\fR or \fBckalloc\fR.
.AP int flags in
Where to add the new event in the queue:  \fBTCL_QUEUE_TAIL\fR,
\fBTCL_QUEUE_HEAD\fR, \fBTCL_QUEUE_MARK\fR, and whether to do
an alert if the queue is empty: \fBTCL_QUEUE_ALERT_IF_EMPTY\fR.
.AP Tcl_ThreadId threadId in
A unique identifier for a thread.
.AP Tcl_EventDeleteProc *deleteProc in
Procedure to invoke for each queued event in \fBTcl_DeleteEvents\fR.
.AP int flags in
What types of events to service.  These flags are the same as those
passed to \fBTcl_DoOneEvent\fR.

The event source must fill in the \fIproc\fR field of
the event before calling \fBTcl_QueueEvent\fR.
The \fInextPtr\fR is used to link together the events in the queue
and should not be modified by the event source.
.PP
An event may be added to the queue at any of three positions, depending
on the \fIposition\fR argument to \fBTcl_QueueEvent\fR:
.IP \fBTCL_QUEUE_TAIL\fR 32
Add the event at the back of the queue, so that all other pending
events will be serviced first.  This is almost always the right
place for new events.
.IP \fBTCL_QUEUE_HEAD\fR 32
Add the event at the front of the queue, so that it will be serviced
before all other queued events.
.IP \fBTCL_QUEUE_MARK\fR 32
Add the event at the front of the queue, unless there are other
events at the front whose position is \fBTCL_QUEUE_MARK\fR;  if so,
add the new event just after all other \fBTCL_QUEUE_MARK\fR events.
This value of \fIposition\fR is used to insert an ordered sequence of
events at the front of the queue, such as a series of
Enter and Leave events synthesized during a grab or ungrab operation
in Tk.
.IP \fBTCL_QUEUE_ALERT_IF_EMPTY\fR 32
When used in \fBTcl_ThreadQueueEvent\fR
arranges for an automatic call of \fBTcl_ThreadAlert\fR when the queue was
empty.
.PP
When it is time to handle an event from the queue (steps 1 and 4
above) \fBTcl_ServiceEvent\fR will invoke the \fIproc\fR specified
in the first queued \fBTcl_Event\fR structure.
\fIProc\fR must match the following prototype:
.PP
.CS

declare 203 {
    int Tcl_PutEnv(const char *assignment)
}
declare 204 {
    const char *Tcl_PosixError(Tcl_Interp *interp)
}
declare 205 {
    void Tcl_QueueEvent(Tcl_Event *evPtr, int flags)
}
declare 206 {
    int Tcl_Read(Tcl_Channel chan, char *bufPtr, int toRead)
}
declare 207 {
    void Tcl_ReapDetachedProcs(void)
}

	    const char *part2, Tcl_Obj *newValuePtr, int flags)
}
declare 318 {
    void Tcl_ThreadAlert(Tcl_ThreadId threadId)
}
declare 319 {
    void Tcl_ThreadQueueEvent(Tcl_ThreadId threadId, Tcl_Event *evPtr,
	    int flags)
}
declare 320 {
    int Tcl_UniCharAtIndex(const char *src, int index)
}
declare 321 {
    int Tcl_UniCharToLower(int ch)
}

struct Tcl_Event {
    Tcl_EventProc *proc;	/* Function to call to service this event. */
    struct Tcl_Event *nextPtr;	/* Next in list of pending events, or NULL. */
};

/*
 * Positions to pass to Tcl_QueueEvent/Tcl_ThreadQueueEvent:
 */

typedef enum {
    TCL_QUEUE_TAIL, TCL_QUEUE_HEAD, TCL_QUEUE_MARK,
	    TCL_QUEUE_ALERT_IF_EMPTY=4
} Tcl_QueuePosition;

/*
 * Values to pass to Tcl_SetServiceMode to specify the behavior of notifier
 * event routines.
 */

EXTERN void		Tcl_PrintDouble(Tcl_Interp *interp, double value,
				char *dst);
/* 203 */
EXTERN int		Tcl_PutEnv(const char *assignment);
/* 204 */
EXTERN const char *	Tcl_PosixError(Tcl_Interp *interp);
/* 205 */
EXTERN void		Tcl_QueueEvent(Tcl_Event *evPtr, int flags);

/* 206 */
EXTERN int		Tcl_Read(Tcl_Channel chan, char *bufPtr, int toRead);
/* 207 */
EXTERN void		Tcl_ReapDetachedProcs(void);
/* 208 */
EXTERN int		Tcl_RecordAndEval(Tcl_Interp *interp,
				const char *cmd, int flags);

EXTERN Tcl_Obj *	Tcl_SetVar2Ex(Tcl_Interp *interp, const char *part1,
				const char *part2, Tcl_Obj *newValuePtr,
				int flags);
/* 318 */
EXTERN void		Tcl_ThreadAlert(Tcl_ThreadId threadId);
/* 319 */
EXTERN void		Tcl_ThreadQueueEvent(Tcl_ThreadId threadId,
				Tcl_Event *evPtr, int flags);
/* 320 */
EXTERN int		Tcl_UniCharAtIndex(const char *src, int index);
/* 321 */
EXTERN int		Tcl_UniCharToLower(int ch);
/* 322 */
EXTERN int		Tcl_UniCharToTitle(int ch);
/* 323 */

    Tcl_Channel (*tcl_OpenFileChannel) (Tcl_Interp *interp, const char *fileName, const char *modeString, int permissions); /* 198 */
    Tcl_Channel (*tcl_OpenTcpClient) (Tcl_Interp *interp, int port, const char *address, const char *myaddr, int myport, int async); /* 199 */
    Tcl_Channel (*tcl_OpenTcpServer) (Tcl_Interp *interp, int port, const char *host, Tcl_TcpAcceptProc *acceptProc, ClientData callbackData); /* 200 */
    void (*tcl_Preserve) (ClientData data); /* 201 */
    void (*tcl_PrintDouble) (Tcl_Interp *interp, double value, char *dst); /* 202 */
    int (*tcl_PutEnv) (const char *assignment); /* 203 */
    const char * (*tcl_PosixError) (Tcl_Interp *interp); /* 204 */
    void (*tcl_QueueEvent) (Tcl_Event *evPtr, int flags); /* 205 */
    int (*tcl_Read) (Tcl_Channel chan, char *bufPtr, int toRead); /* 206 */
    void (*tcl_ReapDetachedProcs) (void); /* 207 */
    int (*tcl_RecordAndEval) (Tcl_Interp *interp, const char *cmd, int flags); /* 208 */
    int (*tcl_RecordAndEvalObj) (Tcl_Interp *interp, Tcl_Obj *cmdPtr, int flags); /* 209 */
    void (*tcl_RegisterChannel) (Tcl_Interp *interp, Tcl_Channel chan); /* 210 */
    void (*tcl_RegisterObjType) (const Tcl_ObjType *typePtr); /* 211 */
    Tcl_RegExp (*tcl_RegExpCompile) (Tcl_Interp *interp, const char *pattern); /* 212 */

    int (*tcl_NumUtfChars) (const char *src, int length); /* 312 */
    int (*tcl_ReadChars) (Tcl_Channel channel, Tcl_Obj *objPtr, int charsToRead, int appendFlag); /* 313 */
    void (*tcl_RestoreResult) (Tcl_Interp *interp, Tcl_SavedResult *statePtr); /* 314 */
    void (*tcl_SaveResult) (Tcl_Interp *interp, Tcl_SavedResult *statePtr); /* 315 */
    int (*tcl_SetSystemEncoding) (Tcl_Interp *interp, const char *name); /* 316 */
    Tcl_Obj * (*tcl_SetVar2Ex) (Tcl_Interp *interp, const char *part1, const char *part2, Tcl_Obj *newValuePtr, int flags); /* 317 */
    void (*tcl_ThreadAlert) (Tcl_ThreadId threadId); /* 318 */
    void (*tcl_ThreadQueueEvent) (Tcl_ThreadId threadId, Tcl_Event *evPtr, int flags); /* 319 */
    int (*tcl_UniCharAtIndex) (const char *src, int index); /* 320 */
    int (*tcl_UniCharToLower) (int ch); /* 321 */
    int (*tcl_UniCharToTitle) (int ch); /* 322 */
    int (*tcl_UniCharToUpper) (int ch); /* 323 */
    int (*tcl_UniCharToUtf) (int ch, char *buf); /* 324 */
    const char * (*tcl_UtfAtIndex) (const char *src, int index); /* 325 */
    int (*tclUtfCharComplete) (const char *src, int length); /* 326 */

         * XXX Race condition !!
         * XXX The destination thread may not exist anymore already.
         * XXX (Delayed postevent executed after channel got removed).
         * XXX Can we detect this ? (check the validity of the owner threadid ?)
         * XXX Actually, in that case the channel should be dead also !
         */

        Tcl_ThreadQueueEvent(rcPtr->owner, (Tcl_Event *) ev,
		TCL_QUEUE_TAIL|TCL_QUEUE_ALERT_IF_EMPTY);
    }
#endif

    /*
     * Squash interp results left by the event script.
     */

    Tcl_CreateThreadExitHandler(SrcExitProc, evPtr);

    /*
     * Queue the event and poke the other thread's notifier.
     */

    Tcl_ThreadQueueEvent(dst, (Tcl_Event *) evPtr,
	    TCL_QUEUE_TAIL|TCL_QUEUE_ALERT_IF_EMPTY);

    /*
     * (*) Block until the handler thread has either processed the transfer or
     * rejected it.
     */

    while (resultPtr->result < 0) {

    Tcl_CreateThreadExitHandler(SrcExitProc, evPtr);

    /*
     * Queue the event and poke the other thread's notifier.
     */

    Tcl_ThreadQueueEvent(dst, (Tcl_Event *) evPtr,
	    TCL_QUEUE_TAIL|TCL_QUEUE_ALERT_IF_EMPTY);

    /*
     * (*) Block until the other thread has either processed the transfer or
     * rejected it.
     */

    while (resultPtr->result < 0) {

static ThreadSpecificData *firstNotifierPtr = NULL;
TCL_DECLARE_MUTEX(listLock)

/*
 * Declarations for routines used only in this file.
 */

static int		QueueEvent(ThreadSpecificData *tsdPtr,
			    Tcl_Event *evPtr, int flags);

/*
 *----------------------------------------------------------------------
 *
 * TclInitNotifier --
 *
 *	Initialize the thread local data structures for the notifier

void
Tcl_QueueEvent(
    Tcl_Event *evPtr,		/* Event to add to queue. The storage space
				 * must have been allocated the caller with
				 * malloc (ckalloc), and it becomes the
				 * property of the event queue. It will be
				 * freed after the event has been handled. */
    int flags)	/* One of TCL_QUEUE_TAIL, TCL_QUEUE_HEAD,
				 * TCL_QUEUE_MARK, possibly combined with TCL_QUEUE_ALERT_IF_EMPTY. */
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    (void) QueueEvent(tsdPtr, evPtr, flags);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_ThreadQueueEvent --
 *

Tcl_ThreadQueueEvent(
    Tcl_ThreadId threadId,	/* Identifier for thread to use. */
    Tcl_Event *evPtr,		/* Event to add to queue. The storage space
				 * must have been allocated the caller with
				 * malloc (ckalloc), and it becomes the
				 * property of the event queue. It will be
				 * freed after the event has been handled. */
    int flags)	/* One of TCL_QUEUE_TAIL, TCL_QUEUE_HEAD,
				 * TCL_QUEUE_MARK, possibly combined with TCL_QUEUE_ALERT_IF_EMPTY. */
{
    ThreadSpecificData *tsdPtr;

    /*
     * Find the notifier associated with the specified thread.
     */

    Tcl_MutexLock(&listLock);
    for (tsdPtr = firstNotifierPtr; tsdPtr && tsdPtr->threadId != threadId;
	    tsdPtr = tsdPtr->nextPtr) {
	/* Empty loop body. */
    }

    /*
     * Queue the event if there was a notifier associated with the thread.
     */

    if (tsdPtr) {
	if (QueueEvent(tsdPtr, evPtr, flags)) {
	    Tcl_AlertNotifier(tsdPtr->clientData);
	}
    } else {
	ckfree(evPtr);
    }
    Tcl_MutexUnlock(&listLock);
}

/*
 *----------------------------------------------------------------------
 *
 * QueueEvent --
 *
 *	Insert an event into the specified thread's event queue at one of
 *	three positions: the head, the tail, or before a floating marker.
 *	Events inserted before the marker will be processed in first-in-
 *	first-out order, but before any events inserted at the tail of the
 *	queue. Events inserted at the head of the queue will be processed in
 *	last-in-first-out order.
 *
 * Results:
 *	For TCL_QUEUE_ALERT_IF_EMPTY the empty state before the
 *	operation is returned.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
QueueEvent(
    ThreadSpecificData *tsdPtr,	/* Handle to thread local data that indicates
				 * which event queue to use. */
    Tcl_Event *evPtr,		/* Event to add to queue.  The storage space
				 * must have been allocated the caller with
				 * malloc (ckalloc), and it becomes the
				 * property of the event queue. It will be
				 * freed after the event has been handled. */
    int flags)
				/* One of TCL_QUEUE_TAIL_EX,
				 * TCL_QUEUE_HEAD_EX, TCL_QUEUE_MARK_EX,
				 * possibly combined with TCL_QUEUE_ALERT_IF_EMPTY */
{
    int wasEmpty = 0;

    Tcl_MutexLock(&(tsdPtr->queueMutex));
    if ((flags & 3) == TCL_QUEUE_TAIL) {
	/*
	 * Append the event on the end of the queue.
	 */

	evPtr->nextPtr = NULL;
	if (tsdPtr->firstEventPtr == NULL) {
	    tsdPtr->firstEventPtr = evPtr;
	    wasEmpty = (flags & TCL_QUEUE_ALERT_IF_EMPTY) ? 1 : 0;
	} else {
	    tsdPtr->lastEventPtr->nextPtr = evPtr;
	}
	tsdPtr->lastEventPtr = evPtr;
    } else if ((flags & 3) == TCL_QUEUE_HEAD) {
	/*
	 * Push the event on the head of the queue.
	 */

	evPtr->nextPtr = tsdPtr->firstEventPtr;
	if (tsdPtr->firstEventPtr == NULL) {
	    tsdPtr->lastEventPtr = evPtr;
	    wasEmpty = (flags & TCL_QUEUE_ALERT_IF_EMPTY) ? 1 : 0;
	}
	tsdPtr->firstEventPtr = evPtr;
    } else if ((flags & 3) == TCL_QUEUE_MARK) {
	/*
	 * Insert the event after the current marker event and advance the
	 * marker to the new event.
	 */

	if (tsdPtr->markerEventPtr == NULL) {
	    evPtr->nextPtr = tsdPtr->firstEventPtr;
	    tsdPtr->firstEventPtr = evPtr;
	} else {
	    evPtr->nextPtr = tsdPtr->markerEventPtr->nextPtr;
	    tsdPtr->markerEventPtr->nextPtr = evPtr;
	}
	tsdPtr->markerEventPtr = evPtr;
	if (evPtr->nextPtr == NULL) {
	    tsdPtr->lastEventPtr = evPtr;
	}
    }
    Tcl_MutexUnlock(&(tsdPtr->queueMutex));
    return wasEmpty;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_DeleteEvents --
 *

	"queue", "delete", NULL
    };
    int subCmdIndex;		/* Index of the chosen subcommand */
    static const char *const positions[] = { /* Possible queue positions */
	"head", "tail", "mark", NULL
    };
    int posIndex;		/* Index of the chosen position */
    static const int posNum[] = {
				/* Interpretation of the chosen position */
	TCL_QUEUE_HEAD,
	TCL_QUEUE_TAIL,
	TCL_QUEUE_MARK
    };
    TestEvent *ev;		/* Event to be queued */

    /*
     * Queue the event and poke the other thread's notifier.
     */

    threadEventPtr->event.proc = ThreadEventProc;
    Tcl_ThreadQueueEvent(threadId, (Tcl_Event *) threadEventPtr,
	    TCL_QUEUE_TAIL|TCL_QUEUE_ALERT_IF_EMPTY);


    if (!wait) {
	Tcl_MutexUnlock(&threadMutex);
	return TCL_OK;
    }

    /*