tclXtNotify.c
上传用户:rrhhcc
上传日期:2015-12-11
资源大小:54129k
文件大小:17k
- /*
- * 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.
- *
- * RCS: @(#) $Id: tclXtNotify.c,v 1.4 1999/07/02 06:05:34 welch Exp $
- */
- #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));
- void InitNotifier _ANSI_ARGS_((void));
- static void NotifierExitHandler _ANSI_ARGS_((
- ClientData clientData));
- static void TimerProc _ANSI_ARGS_((caddr_t clientData,
- XtIntervalId *id));
- static void CreateFileHandler _ANSI_ARGS_((int fd, int mask,
- Tcl_FileProc * proc, ClientData clientData));
- static void DeleteFileHandler _ANSI_ARGS_((int fd));
- static void SetTimer _ANSI_ARGS_((Tcl_Time * timePtr));
- static int WaitForEvent _ANSI_ARGS_((Tcl_Time * timePtr));
- /*
- * 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.
- *
- *----------------------------------------------------------------------
- */
- void
- InitNotifier()
- {
- Tcl_NotifierProcs notifier;
- /*
- * 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;
- }
- notifier.createFileHandlerProc = CreateFileHandler;
- notifier.deleteFileHandlerProc = DeleteFileHandler;
- notifier.setTimerProc = SetTimer;
- notifier.waitForEventProc = WaitForEvent;
- Tcl_SetNotifier(¬ifier);
- /*
- * 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;
- }
- /*
- *----------------------------------------------------------------------
- *
- * SetTimer --
- *
- * This procedure sets the current notifier timeout value.
- *
- * Results:
- * None.
- *
- * Side effects:
- * Replaces any previous timer.
- *
- *----------------------------------------------------------------------
- */
- static void
- 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();
- }
- /*
- *----------------------------------------------------------------------
- *
- * 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.
- *
- *----------------------------------------------------------------------
- */
- static void
- 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;
- }
- /*
- *----------------------------------------------------------------------
- *
- * DeleteFileHandler --
- *
- * Cancel a previously-arranged callback arrangement for
- * a file.
- *
- * Results:
- * None.
- *
- * Side effects:
- * If a callback was previously registered on file, remove it.
- *
- *----------------------------------------------------------------------
- */
- static void
- 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;
- }
- /*
- *----------------------------------------------------------------------
- *
- * 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.
- *
- *----------------------------------------------------------------------
- */
- static int
- 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;
- }