util/src/TclTk/tcl8.6.12/unix/tclXtNotify.c

   1 /*
   2  * tclXtNotify.c --
   3  *
   4  *      This file contains the notifier driver implementation for the Xt
   5  *      intrinsics.
   6  *
   7  * Copyright (c) 1997 by Sun Microsystems, Inc.
   8  *
   9  * See the file "license.terms" for information on usage and redistribution of
  10  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  11  */
  12
  13 #ifndef USE_TCL_STUBS
  14 #   define USE_TCL_STUBS
  15 #endif
  16 #include <X11/Intrinsic.h>
  17 #include "tclInt.h"
  18
  19 /*
  20  * This structure is used to keep track of the notifier info for a a
  21  * registered file.
  22  */
  23
  24 typedef struct FileHandler {
  25     int fd;
  26     int mask;                   /* Mask of desired events: TCL_READABLE,
  27                                  * etc. */
  28     int readyMask;              /* Events that have been seen since the last
  29                                  * time FileHandlerEventProc was called for
  30                                  * this file. */
  31     XtInputId read;             /* Xt read callback handle. */
  32     XtInputId write;            /* Xt write callback handle. */
  33     XtInputId except;           /* Xt exception callback handle. */
  34     Tcl_FileProc *proc;         /* Procedure to call, in the style of
  35                                  * Tcl_CreateFileHandler. */
  36     ClientData clientData;      /* Argument to pass to proc. */
  37     struct FileHandler *nextPtr;/* Next in list of all files we care about. */
  38 } FileHandler;
  39
  40 /*
  41  * The following structure is what is added to the Tcl event queue when file
  42  * handlers are ready to fire.
  43  */
  44
  45 typedef struct FileHandlerEvent {
  46     Tcl_Event header;           /* Information that is standard for all
  47                                  * events. */
  48     int fd;                     /* File descriptor that is ready. Used to find
  49                                  * the FileHandler structure for the file
  50                                  * (can't point directly to the FileHandler
  51                                  * structure because it could go away while
  52                                  * the event is queued). */
  53 } FileHandlerEvent;
  54
  55 /*
  56  * The following static structure contains the state information for the Xt
  57  * based implementation of the Tcl notifier.
  58  */
  59
  60 static struct NotifierState {
  61     XtAppContext appContext;    /* The context used by the Xt notifier. Can be
  62                                  * set with TclSetAppContext. */
  63     int appContextCreated;      /* Was it created by us? */
  64     XtIntervalId currentTimeout;/* Handle of current timer. */
  65     FileHandler *firstFileHandlerPtr;
  66                                 /* Pointer to head of file handler list. */
  67 } notifier;
  68
  69 /*
  70  * The following static indicates whether this module has been initialized.
  71  */
  72
  73 static int initialized = 0;
  74
  75 /*
  76  * Static routines defined in this file.
  77  */
  78
  79 static int              FileHandlerEventProc(Tcl_Event *evPtr, int flags);
  80 static void             FileProc(XtPointer clientData, int *source,
  81                             XtInputId *id);
  82 static void             NotifierExitHandler(ClientData clientData);
  83 static void             TimerProc(XtPointer clientData, XtIntervalId *id);
  84 static void             CreateFileHandler(int fd, int mask,
  85                             Tcl_FileProc *proc, ClientData clientData);
  86 static void             DeleteFileHandler(int fd);
  87 static void             SetTimer(const Tcl_Time * timePtr);
  88 static int              WaitForEvent(const Tcl_Time * timePtr);
  89
  90 /*
  91  * Functions defined in this file for use by users of the Xt Notifier:
  92  */
  93
  94 MODULE_SCOPE void InitNotifier(void);
  95 MODULE_SCOPE XtAppContext TclSetAppContext(XtAppContext ctx);
  96 \f
  97 /*
  98  *----------------------------------------------------------------------
  99  *
 100  * TclSetAppContext --
 101  *
 102  *      Set the notifier application context.
 103  *
 104  * Results:
 105  *      None.
 106  *
 107  * Side effects:
 108  *      Sets the application context used by the notifier. Panics if the
 109  *      context is already set when called.
 110  *
 111  *----------------------------------------------------------------------
 112  */
 113
 114 XtAppContext
 115 TclSetAppContext(
 116     XtAppContext appContext)
 117 {
 118     if (!initialized) {
 119         InitNotifier();
 120     }
 121
 122     /*
 123      * If we already have a context we check whether we were asked to set a
 124      * new context. If so, we panic because we try to prevent switching
 125      * contexts by mistake. Otherwise, we return the one we have.
 126      */
 127
 128     if (notifier.appContext != NULL) {
 129         if (appContext != NULL) {
 130             /*
 131              * We already have a context. We do not allow switching contexts
 132              * after initialization, so we panic.
 133              */
 134
 135             Tcl_Panic("TclSetAppContext:  multiple application contexts");
 136         }
 137     } else {
 138         /*
 139          * If we get here we have not yet gotten a context, so either create
 140          * one or use the one supplied by our caller.
 141          */
 142
 143         if (appContext == NULL) {
 144             /*
 145              * We must create a new context and tell our caller what it is, so
 146              * she can use it too.
 147              */
 148
 149             notifier.appContext = XtCreateApplicationContext();
 150             notifier.appContextCreated = 1;
 151         } else {
 152             /*
 153              * Otherwise we remember the context that our caller gave us and
 154              * use it.
 155              */
 156
 157             notifier.appContextCreated = 0;
 158             notifier.appContext = appContext;
 159         }
 160     }
 161
 162     return notifier.appContext;
 163 }
 164 \f
 165 /*
 166  *----------------------------------------------------------------------
 167  *
 168  * InitNotifier --
 169  *
 170  *      Initializes the notifier state.
 171  *
 172  * Results:
 173  *      None.
 174  *
 175  * Side effects:
 176  *      Creates a new exit handler.
 177  *
 178  *----------------------------------------------------------------------
 179  */
 180
 181 void
 182 InitNotifier(void)
 183 {
 184     Tcl_NotifierProcs np;
 185
 186     /*
 187      * Only reinitialize if we are not in exit handling. The notifier can get
 188      * reinitialized after its own exit handler has run, because of exit
 189      * handlers for the I/O and timer sub-systems (order dependency).
 190      */
 191
 192     if (TclInExit()) {
 193         return;
 194     }
 195
 196     np.createFileHandlerProc = CreateFileHandler;
 197     np.deleteFileHandlerProc = DeleteFileHandler;
 198     np.setTimerProc = SetTimer;
 199     np.waitForEventProc = WaitForEvent;
 200     np.initNotifierProc = Tcl_InitNotifier;
 201     np.finalizeNotifierProc = Tcl_FinalizeNotifier;
 202     np.alertNotifierProc = Tcl_AlertNotifier;
 203     np.serviceModeHookProc = Tcl_ServiceModeHook;
 204     Tcl_SetNotifier(&np);
 205
 206     /*
 207      * DO NOT create the application context yet; doing so would prevent
 208      * external applications from setting it for us to their own ones.
 209      */
 210
 211     initialized = 1;
 212     memset(&np, 0, sizeof(np));
 213     Tcl_CreateExitHandler(NotifierExitHandler, NULL);
 214 }
 215 \f
 216 /*
 217  *----------------------------------------------------------------------
 218  *
 219  * NotifierExitHandler --
 220  *
 221  *      This function is called to cleanup the notifier state before Tcl is
 222  *      unloaded.
 223  *
 224  * Results:
 225  *      None.
 226  *
 227  * Side effects:
 228  *      Destroys the notifier window.
 229  *
 230  *----------------------------------------------------------------------
 231  */
 232
 233 static void
 234 NotifierExitHandler(
 235     ClientData clientData)      /* Not used. */
 236 {
 237     if (notifier.currentTimeout != 0) {
 238         XtRemoveTimeOut(notifier.currentTimeout);
 239     }
 240     for (; notifier.firstFileHandlerPtr != NULL; ) {
 241         Tcl_DeleteFileHandler(notifier.firstFileHandlerPtr->fd);
 242     }
 243     if (notifier.appContextCreated) {
 244         XtDestroyApplicationContext(notifier.appContext);
 245         notifier.appContextCreated = 0;
 246         notifier.appContext = NULL;
 247     }
 248     initialized = 0;
 249 }
 250 \f
 251 /*
 252  *----------------------------------------------------------------------
 253  *
 254  * SetTimer --
 255  *
 256  *      This procedure sets the current notifier timeout value.
 257  *
 258  * Results:
 259  *      None.
 260  *
 261  * Side effects:
 262  *      Replaces any previous timer.
 263  *
 264  *----------------------------------------------------------------------
 265  */
 266
 267 static void
 268 SetTimer(
 269     const Tcl_Time *timePtr)            /* Timeout value, may be NULL. */
 270 {
 271     long timeout;
 272
 273     if (!initialized) {
 274         InitNotifier();
 275     }
 276
 277     TclSetAppContext(NULL);
 278     if (notifier.currentTimeout != 0) {
 279         XtRemoveTimeOut(notifier.currentTimeout);
 280     }
 281     if (timePtr) {
 282         timeout = timePtr->sec * 1000 + timePtr->usec / 1000;
 283         notifier.currentTimeout = XtAppAddTimeOut(notifier.appContext,
 284                 (unsigned long) timeout, TimerProc, NULL);
 285     } else {
 286         notifier.currentTimeout = 0;
 287     }
 288 }
 289 \f
 290 /*
 291  *----------------------------------------------------------------------
 292  *
 293  * TimerProc --
 294  *
 295  *      This procedure is the XtTimerCallbackProc used to handle timeouts.
 296  *
 297  * Results:
 298  *      None.
 299  *
 300  * Side effects:
 301  *      Processes all queued events.
 302  *
 303  *----------------------------------------------------------------------
 304  */
 305
 306 static void
 307 TimerProc(
 308     XtPointer clientData, /* Not used. */
 309     XtIntervalId *id)
 310 {
 311     if (*id != notifier.currentTimeout) {
 312         return;
 313     }
 314     notifier.currentTimeout = 0;
 315
 316     Tcl_ServiceAll();
 317 }
 318 \f
 319 /*
 320  *----------------------------------------------------------------------
 321  *
 322  * CreateFileHandler --
 323  *
 324  *      This procedure registers a file handler with the Xt notifier.
 325  *
 326  * Results:
 327  *      None.
 328  *
 329  * Side effects:
 330  *      Creates a new file handler structure and registers one or more input
 331  *      procedures with Xt.
 332  *
 333  *----------------------------------------------------------------------
 334  */
 335
 336 static void
 337 CreateFileHandler(
 338     int fd,                     /* Handle of stream to watch. */
 339     int mask,                   /* OR'ed combination of TCL_READABLE,
 340                                  * TCL_WRITABLE, and TCL_EXCEPTION: indicates
 341                                  * conditions under which proc should be
 342                                  * called. */
 343     Tcl_FileProc *proc,         /* Procedure to call for each selected
 344                                  * event. */
 345     ClientData clientData)      /* Arbitrary data to pass to proc. */
 346 {
 347     FileHandler *filePtr;
 348
 349     if (!initialized) {
 350         InitNotifier();
 351     }
 352
 353     TclSetAppContext(NULL);
 354
 355     for (filePtr = notifier.firstFileHandlerPtr; filePtr != NULL;
 356             filePtr = filePtr->nextPtr) {
 357         if (filePtr->fd == fd) {
 358             break;
 359         }
 360     }
 361     if (filePtr == NULL) {
 362         filePtr = ckalloc(sizeof(FileHandler));
 363         filePtr->fd = fd;
 364         filePtr->read = 0;
 365         filePtr->write = 0;
 366         filePtr->except = 0;
 367         filePtr->readyMask = 0;
 368         filePtr->mask = 0;
 369         filePtr->nextPtr = notifier.firstFileHandlerPtr;
 370         notifier.firstFileHandlerPtr = filePtr;
 371     }
 372     filePtr->proc = proc;
 373     filePtr->clientData = clientData;
 374
 375     /*
 376      * Register the file with the Xt notifier, if it hasn't been done yet.
 377      */
 378
 379     if (mask & TCL_READABLE) {
 380         if (!(filePtr->mask & TCL_READABLE)) {
 381             filePtr->read = XtAppAddInput(notifier.appContext, fd,
 382                     INT2PTR(XtInputReadMask), FileProc, filePtr);
 383         }
 384     } else {
 385         if (filePtr->mask & TCL_READABLE) {
 386             XtRemoveInput(filePtr->read);
 387         }
 388     }
 389     if (mask & TCL_WRITABLE) {
 390         if (!(filePtr->mask & TCL_WRITABLE)) {
 391             filePtr->write = XtAppAddInput(notifier.appContext, fd,
 392                     INT2PTR(XtInputWriteMask), FileProc, filePtr);
 393         }
 394     } else {
 395         if (filePtr->mask & TCL_WRITABLE) {
 396             XtRemoveInput(filePtr->write);
 397         }
 398     }
 399     if (mask & TCL_EXCEPTION) {
 400         if (!(filePtr->mask & TCL_EXCEPTION)) {
 401             filePtr->except = XtAppAddInput(notifier.appContext, fd,
 402                     INT2PTR(XtInputExceptMask), FileProc, filePtr);
 403         }
 404     } else {
 405         if (filePtr->mask & TCL_EXCEPTION) {
 406             XtRemoveInput(filePtr->except);
 407         }
 408     }
 409     filePtr->mask = mask;
 410 }
 411 \f
 412 /*
 413  *----------------------------------------------------------------------
 414  *
 415  * DeleteFileHandler --
 416  *
 417  *      Cancel a previously-arranged callback arrangement for a file.
 418  *
 419  * Results:
 420  *      None.
 421  *
 422  * Side effects:
 423  *      If a callback was previously registered on file, remove it.
 424  *
 425  *----------------------------------------------------------------------
 426  */
 427
 428 static void
 429 DeleteFileHandler(
 430     int fd)                     /* Stream id for which to remove callback
 431                                  * procedure. */
 432 {
 433     FileHandler *filePtr, *prevPtr;
 434
 435     if (!initialized) {
 436         InitNotifier();
 437     }
 438
 439     TclSetAppContext(NULL);
 440
 441     /*
 442      * Find the entry for the given file (and return if there isn't one).
 443      */
 444
 445     for (prevPtr = NULL, filePtr = notifier.firstFileHandlerPtr; ;
 446             prevPtr = filePtr, filePtr = filePtr->nextPtr) {
 447         if (filePtr == NULL) {
 448             return;
 449         }
 450         if (filePtr->fd == fd) {
 451             break;
 452         }
 453     }
 454
 455     /*
 456      * Clean up information in the callback record.
 457      */
 458
 459     if (prevPtr == NULL) {
 460         notifier.firstFileHandlerPtr = filePtr->nextPtr;
 461     } else {
 462         prevPtr->nextPtr = filePtr->nextPtr;
 463     }
 464     if (filePtr->mask & TCL_READABLE) {
 465         XtRemoveInput(filePtr->read);
 466     }
 467     if (filePtr->mask & TCL_WRITABLE) {
 468         XtRemoveInput(filePtr->write);
 469     }
 470     if (filePtr->mask & TCL_EXCEPTION) {
 471         XtRemoveInput(filePtr->except);
 472     }
 473     ckfree(filePtr);
 474 }
 475 \f
 476 /*
 477  *----------------------------------------------------------------------
 478  *
 479  * FileProc --
 480  *
 481  *      These procedures are called by Xt when a file becomes readable,
 482  *      writable, or has an exception.
 483  *
 484  * Results:
 485  *      None.
 486  *
 487  * Side effects:
 488  *      Makes an entry on the Tcl event queue if the event is interesting.
 489  *
 490  *----------------------------------------------------------------------
 491  */
 492
 493 static void
 494 FileProc(
 495     XtPointer clientData,
 496     int *fd,
 497     XtInputId *id)
 498 {
 499     FileHandler *filePtr = (FileHandler *)clientData;
 500     FileHandlerEvent *fileEvPtr;
 501     int mask = 0;
 502
 503     /*
 504      * Determine which event happened.
 505      */
 506
 507     if (*id == filePtr->read) {
 508         mask = TCL_READABLE;
 509     } else if (*id == filePtr->write) {
 510         mask = TCL_WRITABLE;
 511     } else if (*id == filePtr->except) {
 512         mask = TCL_EXCEPTION;
 513     }
 514
 515     /*
 516      * Ignore unwanted or duplicate events.
 517      */
 518
 519     if (!(filePtr->mask & mask) || (filePtr->readyMask & mask)) {
 520         return;
 521     }
 522
 523     /*
 524      * This is an interesting event, so put it onto the event queue.
 525      */
 526
 527     filePtr->readyMask |= mask;
 528     fileEvPtr = ckalloc(sizeof(FileHandlerEvent));
 529     fileEvPtr->header.proc = FileHandlerEventProc;
 530     fileEvPtr->fd = filePtr->fd;
 531     Tcl_QueueEvent((Tcl_Event *) fileEvPtr, TCL_QUEUE_TAIL);
 532
 533     /*
 534      * Process events on the Tcl event queue before returning to Xt.
 535      */
 536
 537     Tcl_ServiceAll();
 538 }
 539 \f
 540 /*
 541  *----------------------------------------------------------------------
 542  *
 543  * FileHandlerEventProc --
 544  *
 545  *      This procedure is called by Tcl_ServiceEvent when a file event reaches
 546  *      the front of the event queue. This procedure is responsible for
 547  *      actually handling the event by invoking the callback for the file
 548  *      handler.
 549  *
 550  * Results:
 551  *      Returns 1 if the event was handled, meaning it should be removed from
 552  *      the queue. Returns 0 if the event was not handled, meaning it should
 553  *      stay on the queue. The only time the event isn't handled is if the
 554  *      TCL_FILE_EVENTS flag bit isn't set.
 555  *
 556  * Side effects:
 557  *      Whatever the file handler's callback procedure does.
 558  *
 559  *----------------------------------------------------------------------
 560  */
 561
 562 static int
 563 FileHandlerEventProc(
 564     Tcl_Event *evPtr,           /* Event to service. */
 565     int flags)                  /* Flags that indicate what events to handle,
 566                                  * such as TCL_FILE_EVENTS. */
 567 {
 568     FileHandler *filePtr;
 569     FileHandlerEvent *fileEvPtr = (FileHandlerEvent *) evPtr;
 570     int mask;
 571
 572     if (!(flags & TCL_FILE_EVENTS)) {
 573         return 0;
 574     }
 575
 576     /*
 577      * Search through the file handlers to find the one whose handle matches
 578      * the event. We do this rather than keeping a pointer to the file handler
 579      * directly in the event, so that the handler can be deleted while the
 580      * event is queued without leaving a dangling pointer.
 581      */
 582
 583     for (filePtr = notifier.firstFileHandlerPtr; filePtr != NULL;
 584             filePtr = filePtr->nextPtr) {
 585         if (filePtr->fd != fileEvPtr->fd) {
 586             continue;
 587         }
 588
 589         /*
 590          * The code is tricky for two reasons:
 591          * 1. The file handler's desired events could have changed since the
 592          *    time when the event was queued, so AND the ready mask with the
 593          *    desired mask.
 594          * 2. The file could have been closed and re-opened since the time
 595          *    when the event was queued. This is why the ready mask is stored
 596          *    in the file handler rather than the queued event: it will be
 597          *    zeroed when a new file handler is created for the newly opened
 598          *    file.
 599          */
 600
 601         mask = filePtr->readyMask & filePtr->mask;
 602         filePtr->readyMask = 0;
 603         if (mask != 0) {
 604             filePtr->proc(filePtr->clientData, mask);
 605         }
 606         break;
 607     }
 608     return 1;
 609 }
 610 \f
 611 /*
 612  *----------------------------------------------------------------------
 613  *
 614  * WaitForEvent --
 615  *
 616  *      This function is called by Tcl_DoOneEvent to wait for new events on
 617  *      the message queue. If the block time is 0, then Tcl_WaitForEvent just
 618  *      polls without blocking.
 619  *
 620  * Results:
 621  *      Returns 1 if an event was found, else 0. This ensures that
 622  *      Tcl_DoOneEvent will return 1, even if the event is handled by non-Tcl
 623  *      code.
 624  *
 625  * Side effects:
 626  *      Queues file events that are detected by the select.
 627  *
 628  *----------------------------------------------------------------------
 629  */
 630
 631 static int
 632 WaitForEvent(
 633     const Tcl_Time *timePtr)            /* Maximum block time, or NULL. */
 634 {
 635     int timeout;
 636
 637     if (!initialized) {
 638         InitNotifier();
 639     }
 640
 641     TclSetAppContext(NULL);
 642
 643     if (timePtr) {
 644         timeout = timePtr->sec * 1000 + timePtr->usec / 1000;
 645         if (timeout == 0) {
 646             if (XtAppPending(notifier.appContext)) {
 647                 goto process;
 648             } else {
 649                 return 0;
 650             }
 651         } else {
 652             Tcl_SetTimer(timePtr);
 653         }
 654     }
 655
 656   process:
 657     XtAppProcessEvent(notifier.appContext, XtIMAll);
 658     return 1;
 659 }
 660 \f
 661 /*
 662  * Local Variables:
 663  * mode: c
 664  * c-basic-offset: 4
 665  * fill-column: 78
 666  * End:
 667  */