/* 

  * 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(&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;

 }