diff options
| author | welch <welch> | 1998-07-07 17:23:48 (GMT) |
|---|---|---|
| committer | welch <welch> | 1998-07-07 17:23:48 (GMT) |
| commit | f77adfd021cff1247654b34114be697888051f82 (patch) | |
| tree | 5975aa9b17fbf4a0dfde9c1b4236abed440efbdc | |
| parent | f43eaabfa3fe16454544ea9a6e0c4393670c6bb0 (diff) | |
| download | tcl-f77adfd021cff1247654b34114be697888051f82.zip tcl-f77adfd021cff1247654b34114be697888051f82.tar.gz tcl-f77adfd021cff1247654b34114be697888051f82.tar.bz2 | |
Initial revision
| -rw-r--r-- | unix/tclXtNotify.c | 656 |
1 files changed, 656 insertions, 0 deletions
diff --git a/unix/tclXtNotify.c b/unix/tclXtNotify.c new file mode 100644 index 0000000..1082786 --- /dev/null +++ b/unix/tclXtNotify.c @@ -0,0 +1,656 @@ +/*
+ * tclXtNotify.c --
+ *
+ * This file contains the notifier driver implementation for the
+ * Xt intrinsics.
+ *
+ * Copyright (c) 1997 by Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * SCCS: @(#) tclXtNotify.c 1.10 97/09/15 13:24:21
+ */
+
+#include <X11/Intrinsic.h>
+#include <tclInt.h>
+
+/*
+ * This structure is used to keep track of the notifier info for a
+ * a registered file.
+ */
+
+typedef struct FileHandler {
+ int fd;
+ int mask; /* Mask of desired events: TCL_READABLE, etc. */
+ int readyMask; /* Events that have been seen since the
+ last time FileHandlerEventProc was called
+ for this file. */
+ XtInputId read; /* Xt read callback handle. */
+ XtInputId write; /* Xt write callback handle. */
+ XtInputId except; /* Xt exception callback handle. */
+ Tcl_FileProc *proc; /* Procedure to call, in the style of
+ * Tcl_CreateFileHandler. */
+ ClientData clientData; /* Argument to pass to proc. */
+ struct FileHandler *nextPtr;/* Next in list of all files we care about. */
+} FileHandler;
+
+/*
+ * The following structure is what is added to the Tcl event queue when
+ * file handlers are ready to fire.
+ */
+
+typedef struct FileHandlerEvent {
+ Tcl_Event header; /* Information that is standard for
+ * all events. */
+ int fd; /* File descriptor that is ready. Used
+ * to find the FileHandler structure for
+ * the file (can't point directly to the
+ * FileHandler structure because it could
+ * go away while the event is queued). */
+} FileHandlerEvent;
+
+/*
+ * The following static structure contains the state information for the
+ * Xt based implementation of the Tcl notifier.
+ */
+
+static struct NotifierState {
+ XtAppContext appContext; /* The context used by the Xt
+ * notifier. Can be set with
+ * TclSetAppContext. */
+ int appContextCreated; /* Was it created by us? */
+ XtIntervalId currentTimeout; /* Handle of current timer. */
+ FileHandler *firstFileHandlerPtr; /* Pointer to head of file handler
+ * list. */
+} notifier;
+
+/*
+ * The following static indicates whether this module has been initialized.
+ */
+
+static int initialized = 0;
+
+/*
+ * Static routines defined in this file.
+ */
+
+static int FileHandlerEventProc _ANSI_ARGS_((Tcl_Event *evPtr,
+ int flags));
+static void FileProc _ANSI_ARGS_((caddr_t clientData,
+ int *source, XtInputId *id));
+static void InitNotifier _ANSI_ARGS_((void));
+static void NotifierExitHandler _ANSI_ARGS_((
+ ClientData clientData));
+static void TimerProc _ANSI_ARGS_((caddr_t clientData,
+ XtIntervalId *id));
+
+/*
+ * Functions defined in this file for use by users of the Xt Notifier:
+ */
+
+EXTERN XtAppContext TclSetAppContext _ANSI_ARGS_((XtAppContext ctx));
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclSetAppContext --
+ *
+ * Set the notifier application context.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Sets the application context used by the notifier. Panics if
+ * the context is already set when called.
+ *
+ *----------------------------------------------------------------------
+ */
+
+XtAppContext
+TclSetAppContext(appContext)
+ XtAppContext appContext;
+{
+ if (!initialized) {
+ InitNotifier();
+ }
+
+ /*
+ * If we already have a context we check whether we were asked to set a
+ * new context. If so, we panic because we try to prevent switching
+ * contexts by mistake. Otherwise, we return the one we have.
+ */
+
+ if (notifier.appContext != NULL) {
+ if (appContext != NULL) {
+
+ /*
+ * We already have a context. We do not allow switching contexts
+ * after initialization, so we panic.
+ */
+
+ panic("TclSetAppContext: multiple application contexts");
+
+ }
+ } else {
+
+ /*
+ * If we get here we have not yet gotten a context, so either create
+ * one or use the one supplied by our caller.
+ */
+
+ if (appContext == NULL) {
+
+ /*
+ * We must create a new context and tell our caller what it is, so
+ * she can use it too.
+ */
+
+ notifier.appContext = XtCreateApplicationContext();
+ notifier.appContextCreated = 1;
+ } else {
+
+ /*
+ * Otherwise we remember the context that our caller gave us
+ * and use it.
+ */
+
+ notifier.appContextCreated = 0;
+ notifier.appContext = appContext;
+ }
+ }
+
+ return notifier.appContext;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * InitNotifier --
+ *
+ * Initializes the notifier state.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Creates a new exit handler.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+InitNotifier(void)
+{
+ /*
+ * Only reinitialize if we are not in exit handling. The notifier
+ * can get reinitialized after its own exit handler has run, because
+ * of exit handlers for the I/O and timer sub-systems (order dependency).
+ */
+
+ if (TclInExit()) {
+ return;
+ }
+
+ /*
+ * DO NOT create the application context yet; doing so would prevent
+ * external applications from setting it for us to their own ones.
+ */
+
+ initialized = 1;
+ memset(¬ifier, 0, sizeof(notifier));
+ Tcl_CreateExitHandler(NotifierExitHandler, NULL);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * NotifierExitHandler --
+ *
+ * This function is called to cleanup the notifier state before
+ * Tcl is unloaded.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Destroys the notifier window.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+NotifierExitHandler(
+ ClientData clientData) /* Not used. */
+{
+ if (notifier.currentTimeout != 0) {
+ XtRemoveTimeOut(notifier.currentTimeout);
+ }
+ for (; notifier.firstFileHandlerPtr != NULL; ) {
+ Tcl_DeleteFileHandler(notifier.firstFileHandlerPtr->fd);
+ }
+ if (notifier.appContextCreated) {
+ XtDestroyApplicationContext(notifier.appContext);
+ notifier.appContextCreated = 0;
+ notifier.appContext = NULL;
+ }
+ initialized = 0;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_SetTimer --
+ *
+ * This procedure sets the current notifier timeout value.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Replaces any previous timer.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_SetTimer(timePtr)
+ Tcl_Time *timePtr; /* Timeout value, may be NULL. */
+{
+ long timeout;
+
+ if (!initialized) {
+ InitNotifier();
+ }
+
+ TclSetAppContext(NULL);
+ if (notifier.currentTimeout != 0) {
+ XtRemoveTimeOut(notifier.currentTimeout);
+ }
+ if (timePtr) {
+ timeout = timePtr->sec * 1000 + timePtr->usec / 1000;
+ notifier.currentTimeout =
+ XtAppAddTimeOut(notifier.appContext, (unsigned long) timeout,
+ TimerProc, NULL);
+ } else {
+ notifier.currentTimeout = 0;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TimerProc --
+ *
+ * This procedure is the XtTimerCallbackProc used to handle
+ * timeouts.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Processes all queued events.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+TimerProc(data, id)
+ caddr_t data; /* Not used. */
+ XtIntervalId *id;
+{
+ if (*id != notifier.currentTimeout) {
+ return;
+ }
+ notifier.currentTimeout = 0;
+
+ Tcl_ServiceAll();
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_CreateFileHandler --
+ *
+ * This procedure registers a file handler with the Xt notifier.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Creates a new file handler structure and registers one or more
+ * input procedures with Xt.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_CreateFileHandler(fd, mask, proc, clientData)
+ int fd; /* Handle of stream to watch. */
+ int mask; /* OR'ed combination of TCL_READABLE,
+ * TCL_WRITABLE, and TCL_EXCEPTION:
+ * indicates conditions under which
+ * proc should be called. */
+ Tcl_FileProc *proc; /* Procedure to call for each
+ * selected event. */
+ ClientData clientData; /* Arbitrary data to pass to proc. */
+{
+ FileHandler *filePtr;
+
+ if (!initialized) {
+ InitNotifier();
+ }
+
+ TclSetAppContext(NULL);
+
+ for (filePtr = notifier.firstFileHandlerPtr; filePtr != NULL;
+ filePtr = filePtr->nextPtr) {
+ if (filePtr->fd == fd) {
+ break;
+ }
+ }
+ if (filePtr == NULL) {
+ filePtr = (FileHandler*) ckalloc(sizeof(FileHandler));
+ filePtr->fd = fd;
+ filePtr->read = 0;
+ filePtr->write = 0;
+ filePtr->except = 0;
+ filePtr->readyMask = 0;
+ filePtr->mask = 0;
+ filePtr->nextPtr = notifier.firstFileHandlerPtr;
+ notifier.firstFileHandlerPtr = filePtr;
+ }
+ filePtr->proc = proc;
+ filePtr->clientData = clientData;
+
+ /*
+ * Register the file with the Xt notifier, if it hasn't been done yet.
+ */
+
+ if (mask & TCL_READABLE) {
+ if (!(filePtr->mask & TCL_READABLE)) {
+ filePtr->read =
+ XtAppAddInput(notifier.appContext, fd, XtInputReadMask,
+ FileProc, filePtr);
+ }
+ } else {
+ if (filePtr->mask & TCL_READABLE) {
+ XtRemoveInput(filePtr->read);
+ }
+ }
+ if (mask & TCL_WRITABLE) {
+ if (!(filePtr->mask & TCL_WRITABLE)) {
+ filePtr->write =
+ XtAppAddInput(notifier.appContext, fd, XtInputWriteMask,
+ FileProc, filePtr);
+ }
+ } else {
+ if (filePtr->mask & TCL_WRITABLE) {
+ XtRemoveInput(filePtr->write);
+ }
+ }
+ if (mask & TCL_EXCEPTION) {
+ if (!(filePtr->mask & TCL_EXCEPTION)) {
+ filePtr->except =
+ XtAppAddInput(notifier.appContext, fd, XtInputExceptMask,
+ FileProc, filePtr);
+ }
+ } else {
+ if (filePtr->mask & TCL_EXCEPTION) {
+ XtRemoveInput(filePtr->except);
+ }
+ }
+ filePtr->mask = mask;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_DeleteFileHandler --
+ *
+ * Cancel a previously-arranged callback arrangement for
+ * a file.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * If a callback was previously registered on file, remove it.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_DeleteFileHandler(fd)
+ int fd; /* Stream id for which to remove
+ * callback procedure. */
+{
+ FileHandler *filePtr, *prevPtr;
+
+ if (!initialized) {
+ InitNotifier();
+ }
+
+ TclSetAppContext(NULL);
+
+ /*
+ * Find the entry for the given file (and return if there
+ * isn't one).
+ */
+
+ for (prevPtr = NULL, filePtr = notifier.firstFileHandlerPtr; ;
+ prevPtr = filePtr, filePtr = filePtr->nextPtr) {
+ if (filePtr == NULL) {
+ return;
+ }
+ if (filePtr->fd == fd) {
+ break;
+ }
+ }
+
+ /*
+ * Clean up information in the callback record.
+ */
+
+ if (prevPtr == NULL) {
+ notifier.firstFileHandlerPtr = filePtr->nextPtr;
+ } else {
+ prevPtr->nextPtr = filePtr->nextPtr;
+ }
+ if (filePtr->mask & TCL_READABLE) {
+ XtRemoveInput(filePtr->read);
+ }
+ if (filePtr->mask & TCL_WRITABLE) {
+ XtRemoveInput(filePtr->write);
+ }
+ if (filePtr->mask & TCL_EXCEPTION) {
+ XtRemoveInput(filePtr->except);
+ }
+ ckfree((char *) filePtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FileProc --
+ *
+ * These procedures are called by Xt when a file becomes readable,
+ * writable, or has an exception.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Makes an entry on the Tcl event queue if the event is
+ * interesting.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+FileProc(clientData, fd, id)
+ caddr_t clientData;
+ int *fd;
+ XtInputId *id;
+{
+ FileHandler *filePtr = (FileHandler *)clientData;
+ FileHandlerEvent *fileEvPtr;
+ int mask = 0;
+
+ /*
+ * Determine which event happened.
+ */
+
+ if (*id == filePtr->read) {
+ mask = TCL_READABLE;
+ } else if (*id == filePtr->write) {
+ mask = TCL_WRITABLE;
+ } else if (*id == filePtr->except) {
+ mask = TCL_EXCEPTION;
+ }
+
+ /*
+ * Ignore unwanted or duplicate events.
+ */
+
+ if (!(filePtr->mask & mask) || (filePtr->readyMask & mask)) {
+ return;
+ }
+
+ /*
+ * This is an interesting event, so put it onto the event queue.
+ */
+
+ filePtr->readyMask |= mask;
+ fileEvPtr = (FileHandlerEvent *) ckalloc(sizeof(FileHandlerEvent));
+ fileEvPtr->header.proc = FileHandlerEventProc;
+ fileEvPtr->fd = filePtr->fd;
+ Tcl_QueueEvent((Tcl_Event *) fileEvPtr, TCL_QUEUE_TAIL);
+
+ /*
+ * Process events on the Tcl event queue before returning to Xt.
+ */
+
+ Tcl_ServiceAll();
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FileHandlerEventProc --
+ *
+ * This procedure is called by Tcl_ServiceEvent when a file event
+ * reaches the front of the event queue. This procedure is
+ * responsible for actually handling the event by invoking the
+ * callback for the file handler.
+ *
+ * Results:
+ * Returns 1 if the event was handled, meaning it should be removed
+ * from the queue. Returns 0 if the event was not handled, meaning
+ * it should stay on the queue. The only time the event isn't
+ * handled is if the TCL_FILE_EVENTS flag bit isn't set.
+ *
+ * Side effects:
+ * Whatever the file handler's callback procedure does.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+FileHandlerEventProc(evPtr, flags)
+ Tcl_Event *evPtr; /* Event to service. */
+ int flags; /* Flags that indicate what events to
+ * handle, such as TCL_FILE_EVENTS. */
+{
+ FileHandler *filePtr;
+ FileHandlerEvent *fileEvPtr = (FileHandlerEvent *) evPtr;
+ int mask;
+
+ if (!(flags & TCL_FILE_EVENTS)) {
+ return 0;
+ }
+
+ /*
+ * Search through the file handlers to find the one whose handle matches
+ * the event. We do this rather than keeping a pointer to the file
+ * handler directly in the event, so that the handler can be deleted
+ * while the event is queued without leaving a dangling pointer.
+ */
+
+ for (filePtr = notifier.firstFileHandlerPtr; filePtr != NULL;
+ filePtr = filePtr->nextPtr) {
+ if (filePtr->fd != fileEvPtr->fd) {
+ continue;
+ }
+
+ /*
+ * The code is tricky for two reasons:
+ * 1. The file handler's desired events could have changed
+ * since the time when the event was queued, so AND the
+ * ready mask with the desired mask.
+ * 2. The file could have been closed and re-opened since
+ * the time when the event was queued. This is why the
+ * ready mask is stored in the file handler rather than
+ * the queued event: it will be zeroed when a new
+ * file handler is created for the newly opened file.
+ */
+
+ mask = filePtr->readyMask & filePtr->mask;
+ filePtr->readyMask = 0;
+ if (mask != 0) {
+ (*filePtr->proc)(filePtr->clientData, mask);
+ }
+ break;
+ }
+ return 1;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_WaitForEvent --
+ *
+ * This function is called by Tcl_DoOneEvent to wait for new
+ * events on the message queue. If the block time is 0, then
+ * Tcl_WaitForEvent just polls without blocking.
+ *
+ * Results:
+ * Returns 1 if an event was found, else 0. This ensures that
+ * Tcl_DoOneEvent will return 1, even if the event is handled
+ * by non-Tcl code.
+ *
+ * Side effects:
+ * Queues file events that are detected by the select.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_WaitForEvent(
+ Tcl_Time *timePtr) /* Maximum block time, or NULL. */
+{
+ int timeout;
+
+ if (!initialized) {
+ InitNotifier();
+ }
+
+ TclSetAppContext(NULL);
+
+ if (timePtr) {
+ timeout = timePtr->sec * 1000 + timePtr->usec / 1000;
+ if (timeout == 0) {
+ if (XtAppPending(notifier.appContext)) {
+ goto process;
+ } else {
+ return 0;
+ }
+ } else {
+ Tcl_SetTimer(timePtr);
+ }
+ }
+process:
+ XtAppProcessEvent(notifier.appContext, XtIMAll);
+ return 1;
+}
|