Tcl Source Code

View Ticket
Login
Ticket UUID: 219286
Title: Compile Xttest as Stub-enhanced loadable library
Type: Patch Version: None
Submitter: nobody Created on: 2000-10-26 05:10:01
Subsystem: 01. Notifier Assigned To: kennykb
Priority: 5 Medium Severity:
Status: Open Last Modified: 2001-08-25 00:58:28
Resolution: None Closed By:
    Closed on:
Description:
OriginalBugID: 2059 RFE
Version: 8.1
SubmitDate: '1999-05-13'
LastModified: '2000-04-03'
Severity: SER
Status: UnAssn
Submitter: pat
ChangedBy: hobbs
RelatedBugIDs: 1524
OS: Linux-Red Hat
OSVersion: 4.2
Machine: Other
FixedDate: '2000-10-25'
ClosedDate: '2000-10-25'


Name:

Jan Nijtmans



DesiredBehavior:

This request is basically the same as BugID 1524, only it

    is upgraded to Tcl8.1. Besides, Xttest is now used as a

    demonstration why this feature is useful.

    

    This patch allows Xttest to be compiled as a loadable

    extension (Xttest.so). The UNIX notifier is modified

    such that the 4 most important functions can be

    replaced at run-time. Xttest uses this feature.

    

    For the Tcl plugin this feature would be very

    useful because it would allow the plugin to

    use libtcl8.1.so and libtk8.1.so without the

    need to compile everything together in a

    big shared library. I already have that working

    on Linux, using Tcl/Tk 8.0.4 in combination

    with the plus-patches.

    

    It would be better if tclXtNotify.c and tclXtTest.c

    would move to Tk. The Xt notifier needs X11 to

    be installed, and the Tcl configure script doesn't

    have support to search where the Xt library is

    located. Inside Tk that would be a lot easier.



Patch:

*** unix/tclUnixNotfy.c.origThu Apr 29 03:13:13 1999

--- unix/tclUnixNotfy.cThu May 13 13:28:32 1999

***************

*** 18,23 ****

--- 18,25 ----

  #include "tclPort.h"

  #include <signal.h> 

  

+ extern TclStubs tclStubs;

+ 

  /*

   * This structure is used to keep track of the notifier info for a 

   * a registered file.

***************

*** 336,341 ****

--- 338,347 ----

       * because the only event loop is via Tcl_DoOneEvent, which passes

       * timeout values to Tcl_WaitForEvent.

       */

+ 

+     if (tclStubs.tcl_SetTimer != Tcl_SetTimer) {

+ tclStubs.tcl_SetTimer(timePtr);

+     }

  }

  

  /*

***************

*** 393,398 ****

--- 399,409 ----

      FileHandler *filePtr;

      int index, bit;

  

+     if (tclStubs.tcl_CreateFileHandler != Tcl_CreateFileHandler) {

+ tclStubs.tcl_CreateFileHandler(fd, mask, proc, clientData);

+ return;

+     }

+ 

      for (filePtr = tsdPtr->firstFileHandlerPtr; filePtr != NULL;

   filePtr = filePtr->nextPtr) {

  if (filePtr->fd == fd) {

***************

*** 462,467 ****

--- 473,483 ----

      unsigned long flags;

      ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

  

+     if (tclStubs.tcl_DeleteFileHandler != Tcl_DeleteFileHandler) {

+ tclStubs.tcl_DeleteFileHandler(fd);

+ return;

+     }

+ 

      /*

       * Find the entry for the given file (and return if there isn't one).

       */

***************

*** 632,637 ****

--- 648,657 ----

      int numFound;

  #endif

      ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

+ 

+     if (tclStubs.tcl_WaitForEvent != Tcl_WaitForEvent) {

+ return tclStubs.tcl_WaitForEvent(timePtr);

+     }

  

      /*

       * Set up the timeout structure.  Note that if there are no events to

*** unix/tclXtNotify.c.origThu Apr 29 03:13:14 1999

--- unix/tclXtNotify.cWed May 12 19:22:43 1999

***************

*** 79,89 ****

      int flags));

  static voidFileProc _ANSI_ARGS_((caddr_t clientData,

      int *source, XtInputId *id));

! static voidInitNotifier _ANSI_ARGS_((void));

  static voidNotifierExitHandler _ANSI_ARGS_((

      ClientData clientData));

  static voidTimerProc _ANSI_ARGS_((caddr_t clientData,

      XtIntervalId *id));

  

  /*

   * Functions defined in this file for use by users of the Xt Notifier:

--- 79,94 ----

      int flags));

  static voidFileProc _ANSI_ARGS_((caddr_t clientData,

      int *source, XtInputId *id));

! voidInitNotifier _ANSI_ARGS_((void));

  static voidNotifierExitHandler _ANSI_ARGS_((

      ClientData clientData));

  static voidTimerProc _ANSI_ARGS_((caddr_t clientData,

      XtIntervalId *id));

+ static voidCreateFileHandler _ANSI_ARGS_((int fd, int mask, 

+ Tcl_FileProc * proc, ClientData clientData));

+ static voidDeleteFileHandler _ANSI_ARGS_((int fd));

+ static voidSetTimer _ANSI_ARGS_((Tcl_Time * timePtr));

+ static intWaitForEvent _ANSI_ARGS_((Tcl_Time * timePtr));

  

  /*

   * Functions defined in this file for use by users of the Xt Notifier:

***************

*** 180,187 ****

   *----------------------------------------------------------------------

   */

  

! static void

! InitNotifier(void)

  {

      /*

       * Only reinitialize if we are not in exit handling. The notifier

--- 185,192 ----

   *----------------------------------------------------------------------

   */

  

! void

! InitNotifier()

  {

      /*

       * Only reinitialize if we are not in exit handling. The notifier

***************

*** 193,198 ****

--- 198,208 ----

          return;

      }

  

+     Tcl_CreateFileHandler = CreateFileHandler;

+     Tcl_DeleteFileHandler = DeleteFileHandler;

+     Tcl_SetTimer = SetTimer;

+     Tcl_WaitForEvent = WaitForEvent;

+ 

      /*

       * DO NOT create the application context yet; doing so would prevent

       * external applications from setting it for us to their own ones.

***************

*** 241,247 ****

  /*

   *----------------------------------------------------------------------

   *

!  * Tcl_SetTimer --

   *

   *This procedure sets the current notifier timeout value.

   *

--- 251,257 ----

  /*

   *----------------------------------------------------------------------

   *

!  * SetTimer --

   *

   *This procedure sets the current notifier timeout value.

   *

***************

*** 254,261 ****

   *----------------------------------------------------------------------

   */

  

! void

! Tcl_SetTimer(timePtr)

      Tcl_Time *timePtr;/* Timeout value, may be NULL. */

  {

      long timeout;

--- 264,271 ----

   *----------------------------------------------------------------------

   */

  

! static void

! SetTimer(timePtr)

      Tcl_Time *timePtr;/* Timeout value, may be NULL. */

  {

      long timeout;

***************

*** 311,317 ****

  /*

   *----------------------------------------------------------------------

   *

!  * Tcl_CreateFileHandler --

   *

   *This procedure registers a file handler with the Xt notifier.

   *

--- 321,327 ----

  /*

   *----------------------------------------------------------------------

   *

!  * CreateFileHandler --

   *

   *This procedure registers a file handler with the Xt notifier.

   *

***************

*** 325,332 ****

   *----------------------------------------------------------------------

   */

  

! 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:

--- 335,342 ----

   *----------------------------------------------------------------------

   */

  

! 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:

***************

*** 407,413 ****

  /*

   *----------------------------------------------------------------------

   *

!  * Tcl_DeleteFileHandler --

   *

   *Cancel a previously-arranged callback arrangement for

   *a file.

--- 417,423 ----

  /*

   *----------------------------------------------------------------------

   *

!  * DeleteFileHandler --

   *

   *Cancel a previously-arranged callback arrangement for

   *a file.

***************

*** 421,428 ****

   *----------------------------------------------------------------------

   */

  

! void

! Tcl_DeleteFileHandler(fd)

      int fd;/* Stream id for which to remove

   * callback procedure. */

  {

--- 431,438 ----

   *----------------------------------------------------------------------

   */

  

! static void

! DeleteFileHandler(fd)

      int fd;/* Stream id for which to remove

   * callback procedure. */

  {

***************

*** 609,615 ****

  /*

   *----------------------------------------------------------------------

   *

!  * 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

--- 619,625 ----

  /*

   *----------------------------------------------------------------------

   *

!  * WaitForEvent --

   *

   *This function is called by Tcl_DoOneEvent to wait for new

   *events on the message queue.  If the block time is 0, then

***************

*** 626,633 ****

   *----------------------------------------------------------------------

   */

  

! int

! Tcl_WaitForEvent(

      Tcl_Time *timePtr)/* Maximum block time, or NULL. */

  {

      int timeout;

--- 636,643 ----

   *----------------------------------------------------------------------

   */

  

! static int

! WaitForEvent(

      Tcl_Time *timePtr)/* Maximum block time, or NULL. */

  {

      int timeout;

*** unix/tclXtTest.c.origThu Apr 29 03:13:14 1999

--- unix/tclXtTest.cWed May 12 19:22:43 1999

***************

*** 16,26 ****

  

  static intTesteventloopCmd _ANSI_ARGS_((ClientData clientData,

      Tcl_Interp *interp, int argc, char **argv));

  

  /*

   *----------------------------------------------------------------------

   *

!  * Tclxttest_Init --

   *

   *This procedure performs application-specific initialization.

   *Most applications, especially those that incorporate additional

--- 16,28 ----

  

  static intTesteventloopCmd _ANSI_ARGS_((ClientData clientData,

      Tcl_Interp *interp, int argc, char **argv));

+ extern voidInitNotifier _ANSI_ARGS_((void));

+ 

  

  /*

   *----------------------------------------------------------------------

   *

!  * Xttest_Init --

   *

   *This procedure performs application-specific initialization.

   *Most applications, especially those that incorporate additional

***************

*** 37,45 ****

   */

  

  int

! Tclxttest_Init(interp)

      Tcl_Interp *interp;/* Interpreter for application. */

  {

      Tcl_CreateCommand(interp, "testeventloop", TesteventloopCmd,

              (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);

      return TCL_OK;

--- 39,52 ----

   */

  

  int

! Xttest_Init(interp)

      Tcl_Interp *interp;/* Interpreter for application. */

  {

+     if (Tcl_InitStubs(interp, TCL_VERSION, 0) == NULL) {

+ return TCL_ERROR;

+     }

+     XtToolkitInitialize();

+     InitNotifier();

      Tcl_CreateCommand(interp, "testeventloop", TesteventloopCmd,

              (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);

      return TCL_OK;



PatchFiles:

tclUnixNotfy.c tclXtNotify.c tclXtTest.c





Related to: Replacement of UNIX Notifier at run-time [BugID: 1524] 
-- 01/29/2000 hobbs