text: /* 
   * 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.
   */
  
  #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(&notifier);
  
      /*
       * 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(&notifier, 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;
  }
  