home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / tk42r2s.zip / tk4.2 / os2 / tkTest.c < prev    next >
C/C++ Source or Header  |  1998-03-17  |  37KB  |  1,191 lines
  1. /* 
  2.  * tkTest.c --
  3.  *
  4.  *    This file contains C command procedures for a bunch of additional
  5.  *    Tcl commands that are used for testing out Tcl's C interfaces.
  6.  *    These commands are not normally included in Tcl applications;
  7.  *    they're only used for testing.
  8.  *
  9.  * Copyright (c) 1993-1994 The Regents of the University of California.
  10.  * Copyright (c) 1994-1996 Sun Microsystems, Inc.
  11.  * Copyright (c) 1998 Illya Vaes
  12.  *
  13.  * See the file "license.terms" for information on usage and redistribution
  14.  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  15.  *
  16.  * SCCS: @(#) tkTest.c 1.35 96/10/03 11:22:26
  17.  */
  18.  
  19. #include "tkInt.h"
  20. #include "tkPort.h"    
  21.  
  22. #ifdef __WIN32__
  23. #include "tkWinInt.h"
  24. #endif
  25.  
  26. #ifdef __EMX__
  27. #include "tkOS2Int.h"
  28. #endif
  29.  
  30. /*
  31.  * The table below describes events and is used by the "testevent"
  32.  * command.
  33.  */
  34.  
  35. typedef struct {
  36.     char *name;            /* Name of event. */
  37.     int type;            /* Event type for X, such as
  38.                  * ButtonPress. */
  39. } EventInfo;
  40.  
  41. static EventInfo eventArray[] = {
  42.     {"Motion",        MotionNotify},
  43.     {"Button",        ButtonPress},
  44.     {"ButtonPress",    ButtonPress},
  45.     {"ButtonRelease",    ButtonRelease},
  46.     {"Colormap",    ColormapNotify},
  47.     {"Enter",        EnterNotify},
  48.     {"Leave",        LeaveNotify},
  49.     {"Expose",        Expose},
  50.     {"FocusIn",        FocusIn},
  51.     {"FocusOut",    FocusOut},
  52.     {"Keymap",        KeymapNotify},
  53.     {"Key",        KeyPress},
  54.     {"KeyPress",    KeyPress},
  55.     {"KeyRelease",    KeyRelease},
  56.     {"Property",    PropertyNotify},
  57.     {"ResizeRequest",    ResizeRequest},
  58.     {"Circulate",    CirculateNotify},
  59.     {"Configure",    ConfigureNotify},
  60.     {"Destroy",        DestroyNotify},
  61.     {"Gravity",        GravityNotify},
  62.     {"Map",        MapNotify},
  63.     {"Reparent",    ReparentNotify},
  64.     {"Unmap",        UnmapNotify},
  65.     {"Visibility",    VisibilityNotify},
  66.     {"CirculateRequest",CirculateRequest},
  67.     {"ConfigureRequest",ConfigureRequest},
  68.     {"MapRequest",    MapRequest},
  69.     {(char *) NULL,    0}
  70. };
  71.  
  72. /*
  73.  * The defines and table below are used to classify events into
  74.  * various groups.  The reason for this is that logically identical
  75.  * fields (e.g. "state") appear at different places in different
  76.  * types of events.  The classification masks can be used to figure
  77.  * out quickly where to extract information from events.
  78.  */
  79.  
  80. #define KEY_BUTTON_MOTION    0x1
  81. #define CROSSING        0x2
  82. #define FOCUS            0x4
  83. #define EXPOSE            0x8
  84. #define VISIBILITY        0x10
  85. #define CREATE            0x20
  86. #define MAP            0x40
  87. #define REPARENT        0x80
  88. #define CONFIG            0x100
  89. #define CONFIG_REQ        0x200
  90. #define RESIZE_REQ        0x400
  91. #define GRAVITY            0x800
  92. #define PROP            0x1000
  93. #define SEL_CLEAR        0x2000
  94. #define SEL_REQ            0x4000
  95. #define SEL_NOTIFY        0x8000
  96. #define COLORMAP        0x10000
  97. #define MAPPING            0x20000
  98.  
  99. static int flagArray[LASTEvent] = {
  100.    /* Not used */        0,
  101.    /* Not used */        0,
  102.    /* KeyPress */        KEY_BUTTON_MOTION,
  103.    /* KeyRelease */        KEY_BUTTON_MOTION,
  104.    /* ButtonPress */        KEY_BUTTON_MOTION,
  105.    /* ButtonRelease */        KEY_BUTTON_MOTION,
  106.    /* MotionNotify */        KEY_BUTTON_MOTION,
  107.    /* EnterNotify */        CROSSING,
  108.    /* LeaveNotify */        CROSSING,
  109.    /* FocusIn */        FOCUS,
  110.    /* FocusOut */        FOCUS,
  111.    /* KeymapNotify */        0,
  112.    /* Expose */            EXPOSE,
  113.    /* GraphicsExpose */        EXPOSE,
  114.    /* NoExpose */        0,
  115.    /* VisibilityNotify */    VISIBILITY,
  116.    /* CreateNotify */        CREATE,
  117.    /* DestroyNotify */        0,
  118.    /* UnmapNotify */        0,
  119.    /* MapNotify */        MAP,
  120.    /* MapRequest */        0,
  121.    /* ReparentNotify */        REPARENT,
  122.    /* ConfigureNotify */    CONFIG,
  123.    /* ConfigureRequest */    CONFIG_REQ,
  124.    /* GravityNotify */        0,
  125.    /* ResizeRequest */        RESIZE_REQ,
  126.    /* CirculateNotify */    0,
  127.    /* CirculateRequest */    0,
  128.    /* PropertyNotify */        PROP,
  129.    /* SelectionClear */        SEL_CLEAR,
  130.    /* SelectionRequest */    SEL_REQ,
  131.    /* SelectionNotify */    SEL_NOTIFY,
  132.    /* ColormapNotify */        COLORMAP,
  133.    /* ClientMessage */        0,
  134.    /* MappingNotify */        MAPPING
  135. };
  136.  
  137. /*
  138.  * The following data structure represents the master for a test
  139.  * image:
  140.  */
  141.  
  142. typedef struct TImageMaster {
  143.     Tk_ImageMaster master;    /* Tk's token for image master. */
  144.     Tcl_Interp *interp;        /* Interpreter for application. */
  145.     int width, height;        /* Dimensions of image. */
  146.     char *imageName;        /* Name of image (malloc-ed). */
  147.     char *varName;        /* Name of variable in which to log
  148.                  * events for image (malloc-ed). */
  149. } TImageMaster;
  150.  
  151. /*
  152.  * The following data structure represents a particular use of a
  153.  * particular test image.
  154.  */
  155.  
  156. typedef struct TImageInstance {
  157.     TImageMaster *masterPtr;    /* Pointer to master for image. */
  158.     XColor *fg;            /* Foreground color for drawing in image. */
  159.     GC gc;            /* Graphics context for drawing in image. */
  160. } TImageInstance;
  161.  
  162. /*
  163.  * The type record for test images:
  164.  */
  165.  
  166. static int        ImageCreate _ANSI_ARGS_((Tcl_Interp *interp,
  167.                 char *name, int argc, char **argv,
  168.                 Tk_ImageType *typePtr, Tk_ImageMaster master,
  169.                 ClientData *clientDataPtr));
  170. static ClientData    ImageGet _ANSI_ARGS_((Tk_Window tkwin,
  171.                 ClientData clientData));
  172. static void        ImageDisplay _ANSI_ARGS_((ClientData clientData,
  173.                 Display *display, Drawable drawable, 
  174.                 int imageX, int imageY, int width,
  175.                 int height, int drawableX,
  176.                 int drawableY));
  177. static void        ImageFree _ANSI_ARGS_((ClientData clientData,
  178.                 Display *display));
  179. static void        ImageDelete _ANSI_ARGS_((ClientData clientData));
  180.  
  181. static Tk_ImageType imageType = {
  182.     "test",            /* name */
  183.     ImageCreate,        /* createProc */
  184.     ImageGet,            /* getProc */
  185.     ImageDisplay,        /* displayProc */
  186.     ImageFree,            /* freeProc */
  187.     ImageDelete,        /* deleteProc */
  188.     (Tk_ImageType *) NULL    /* nextPtr */
  189. };
  190.  
  191. /*
  192.  * One of the following structures describes each of the interpreters
  193.  * created by the "testnewapp" command.  This information is used by
  194.  * the "testdeleteinterps" command to destroy all of those interpreters.
  195.  */
  196.  
  197. typedef struct NewApp {
  198.     Tcl_Interp *interp;        /* Token for interpreter. */
  199.     struct NewApp *nextPtr;    /* Next in list of new interpreters. */
  200. } NewApp;
  201.  
  202. static NewApp *newAppPtr = NULL;
  203.                 /* First in list of all new interpreters. */
  204.  
  205. /*
  206.  * Declaration for the square widget's class command procedure:
  207.  */
  208.  
  209. extern int SquareCmd _ANSI_ARGS_((ClientData clientData,
  210.     Tcl_Interp *interp, int argc, char *argv[]));
  211.  
  212. /*
  213.  * Forward declarations for procedures defined later in this file:
  214.  */
  215.  
  216. int            Tktest_Init _ANSI_ARGS_((Tcl_Interp *interp));
  217. static int        ImageCmd _ANSI_ARGS_((ClientData dummy,
  218.                 Tcl_Interp *interp, int argc, char **argv));
  219. #if (defined(__WIN32__) || defined(__EMX__))
  220. static int        TestclipboardCmd _ANSI_ARGS_((ClientData dummy,
  221.                 Tcl_Interp *interp, int argc, char **argv));
  222. #endif
  223. static int        TestdeleteappsCmd _ANSI_ARGS_((ClientData dummy,
  224.                 Tcl_Interp *interp, int argc, char **argv));
  225. static int        TesteventCmd _ANSI_ARGS_((ClientData dummy,
  226.                 Tcl_Interp *interp, int argc, char **argv));
  227. static int        TestmakeexistCmd _ANSI_ARGS_((ClientData dummy,
  228.                 Tcl_Interp *interp, int argc, char **argv));
  229. static int        TestsendCmd _ANSI_ARGS_((ClientData dummy,
  230.                 Tcl_Interp *interp, int argc, char **argv));
  231.  
  232. /*
  233.  *----------------------------------------------------------------------
  234.  *
  235.  * Tktest_Init --
  236.  *
  237.  *    This procedure performs intialization for the Tk test
  238.  *    suite exensions.
  239.  *
  240.  * Results:
  241.  *    Returns a standard Tcl completion code, and leaves an error
  242.  *    message in interp->result if an error occurs.
  243.  *
  244.  * Side effects:
  245.  *    Creates several test commands.
  246.  *
  247.  *----------------------------------------------------------------------
  248.  */
  249.  
  250. int
  251. Tktest_Init(interp)
  252.     Tcl_Interp *interp;        /* Interpreter for application. */
  253. {
  254.     static int initialized = 0;
  255.  
  256.     /*
  257.      * Create additional commands for testing Tk.
  258.      */
  259.  
  260.     if (Tcl_PkgProvide(interp, "Tktest", TK_VERSION) == TCL_ERROR) {
  261.         return TCL_ERROR;
  262.     }
  263.     
  264.     Tcl_CreateCommand(interp, "square", SquareCmd,
  265.         (ClientData) Tk_MainWindow(interp), (Tcl_CmdDeleteProc *) NULL);
  266. #if (defined(__WIN32__) || defined(__EMX__))
  267.     Tcl_CreateCommand(interp, "testclipboard", TestclipboardCmd,
  268.         (ClientData) Tk_MainWindow(interp), (Tcl_CmdDeleteProc *) NULL);
  269. #endif
  270.     Tcl_CreateCommand(interp, "testdeleteapps", TestdeleteappsCmd,
  271.         (ClientData) Tk_MainWindow(interp), (Tcl_CmdDeleteProc *) NULL);
  272.     Tcl_CreateCommand(interp, "testevent", TesteventCmd,
  273.         (ClientData) Tk_MainWindow(interp), (Tcl_CmdDeleteProc *) NULL);
  274.     Tcl_CreateCommand(interp, "testmakeexist", TestmakeexistCmd,
  275.         (ClientData) Tk_MainWindow(interp), (Tcl_CmdDeleteProc *) NULL);
  276.     Tcl_CreateCommand(interp, "testsend", TestsendCmd,
  277.         (ClientData) Tk_MainWindow(interp), (Tcl_CmdDeleteProc *) NULL);
  278.  
  279.     /*
  280.      * Create test image type.
  281.      */
  282.  
  283.     if (!initialized) {
  284.     initialized = 1;
  285.     Tk_CreateImageType(&imageType);
  286.     }
  287.     return TCL_OK;
  288. }
  289.  
  290. /*
  291.  *----------------------------------------------------------------------
  292.  *
  293.  * TestclipboardCmd --
  294.  *
  295.  *    This procedure implements the testclipboard command. It provides
  296.  *    a way to determine the actual contents of the Windows / OS/2
  297.  *      clipboard.
  298.  *
  299.  * Results:
  300.  *    A standard Tcl result.
  301.  *
  302.  * Side effects:
  303.  *    None.
  304.  *
  305.  *----------------------------------------------------------------------
  306.  */
  307.  
  308. #ifdef __WIN32__
  309. static int
  310. TestclipboardCmd(clientData, interp, argc, argv)
  311.     ClientData clientData;        /* Main window for application. */
  312.     Tcl_Interp *interp;            /* Current interpreter. */
  313.     int argc;                /* Number of arguments. */
  314.     char **argv;            /* Argument strings. */
  315. {
  316.     TkWindow *winPtr = (TkWindow *) clientData;
  317.     HGLOBAL handle;
  318.     char *data;
  319.  
  320.     if (OpenClipboard(NULL)) {
  321.     handle = GetClipboardData(CF_TEXT);
  322.     if (handle != NULL) {
  323.         data = GlobalLock(handle);
  324.         Tcl_AppendResult(interp, data, (char *) NULL);
  325.         GlobalUnlock(handle);
  326.     }
  327.     CloseClipboard();
  328.     }
  329.     return TCL_OK;
  330. }
  331. #endif
  332. #ifdef __EMX__
  333. static int
  334. TestclipboardCmd(clientData, interp, argc, argv)
  335.     ClientData clientData;        /* Main window for application. */
  336.     Tcl_Interp *interp;            /* Current interpreter. */
  337.     int argc;                /* Number of arguments. */
  338.     char **argv;            /* Argument strings. */
  339. {
  340.     char *data;
  341.     HAB hab = TkOS2GetAppInstance();
  342.  
  343.     if (WinOpenClipbrd(hab)) {
  344.         if ((data= (char *)WinQueryClipbrdData(hab, CF_TEXT))) {
  345.         Tcl_AppendResult(interp, data, (char *) NULL);
  346.     }
  347.     WinCloseClipbrd(hab);
  348.     }
  349.     return TCL_OK;
  350. }
  351. #endif
  352.  
  353. /*
  354.  *----------------------------------------------------------------------
  355.  *
  356.  * TestdeleteappsCmd --
  357.  *
  358.  *    This procedure implements the "testdeleteapps" command.  It cleans
  359.  *    up all the interpreters left behind by the "testnewapp" command.
  360.  *
  361.  * Results:
  362.  *    A standard Tcl result.
  363.  *
  364.  * Side effects:
  365.  *    All the intepreters created by previous calls to "testnewapp"
  366.  *    get deleted.
  367.  *
  368.  *----------------------------------------------------------------------
  369.  */
  370.  
  371.     /* ARGSUSED */
  372. static int
  373. TestdeleteappsCmd(clientData, interp, argc, argv)
  374.     ClientData clientData;        /* Main window for application. */
  375.     Tcl_Interp *interp;            /* Current interpreter. */
  376.     int argc;                /* Number of arguments. */
  377.     char **argv;            /* Argument strings. */
  378. {
  379.     NewApp *nextPtr;
  380.  
  381.     while (newAppPtr != NULL) {
  382.     nextPtr = newAppPtr->nextPtr;
  383.     Tcl_DeleteInterp(newAppPtr->interp);
  384.     ckfree((char *) newAppPtr);
  385.     newAppPtr = nextPtr;
  386.     }
  387.     return TCL_OK;
  388. }
  389.  
  390. /*
  391.  *----------------------------------------------------------------------
  392.  *
  393.  * TesteventCmd --
  394.  *
  395.  *    This procedure implements the "testevent" command.  It allows
  396.  *    events to be generated on the fly, for testing event-handling.
  397.  *
  398.  * Results:
  399.  *    A standard Tcl result.
  400.  *
  401.  * Side effects:
  402.  *    Creates and handles events.
  403.  *
  404.  *----------------------------------------------------------------------
  405.  */
  406.  
  407.     /* ARGSUSED */
  408. static int
  409. TesteventCmd(clientData, interp, argc, argv)
  410.     ClientData clientData;        /* Main window for application. */
  411.     Tcl_Interp *interp;            /* Current interpreter. */
  412.     int argc;                /* Number of arguments. */
  413.     char **argv;            /* Argument strings. */
  414. {
  415.     Tk_Window main = (Tk_Window) clientData;
  416.     Tk_Window tkwin, tkwin2;
  417.     XEvent event;
  418.     EventInfo *eiPtr;
  419.     char *field, *value;
  420.     int i, number, flags;
  421.     KeySym keysym;
  422.  
  423.     if ((argc < 3) || !(argc & 1)) {
  424.     Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
  425.         " window type ?field value field value ...?\"",
  426.         (char *) NULL);
  427.     return TCL_ERROR;
  428.     }
  429.     tkwin = Tk_NameToWindow(interp, argv[1], main);
  430.     if (tkwin == NULL) {
  431.     return TCL_ERROR;
  432.     }
  433.  
  434.     /*
  435.      * Get the type of the event.
  436.      */
  437.  
  438.     memset((VOID *) &event, 0, sizeof(event));
  439.     for (eiPtr = eventArray; ; eiPtr++) {
  440.     if (eiPtr->name == NULL) {
  441.         Tcl_AppendResult(interp, "bad event type \"", argv[2],
  442.             "\"", (char *) NULL);
  443.         return TCL_ERROR;
  444.     }
  445.     if (strcmp(eiPtr->name, argv[2]) == 0) {
  446.         event.xany.type = eiPtr->type;
  447.         break;
  448.     }
  449.     }
  450.  
  451.     /*
  452.      * Fill in fields that are common to all events.
  453.      */
  454.  
  455.     event.xany.serial = NextRequest(Tk_Display(tkwin));
  456.     event.xany.send_event = False;
  457.     event.xany.window = Tk_WindowId(tkwin);
  458.     event.xany.display = Tk_Display(tkwin);
  459.  
  460.     /*
  461.      * Process the remaining arguments to fill in additional fields
  462.      * of the event.
  463.      */
  464.  
  465.     flags = flagArray[event.xany.type];
  466.     for (i = 3; i < argc; i += 2) {
  467.     field = argv[i];
  468.     value = argv[i+1];
  469.     if (strcmp(field, "-above") == 0) {
  470.         tkwin2 = Tk_NameToWindow(interp, value, main);
  471.         if (tkwin2 == NULL) {
  472.         return TCL_ERROR;
  473.         }
  474.         event.xconfigure.above = Tk_WindowId(tkwin2);
  475.     } else if (strcmp(field, "-borderwidth") == 0) {
  476.         if (Tcl_GetInt(interp, value, &number) != TCL_OK) {
  477.         return TCL_ERROR;
  478.         }
  479.         event.xcreatewindow.border_width = number;
  480.     } else if (strcmp(field, "-button") == 0) {
  481.         if (Tcl_GetInt(interp, value, &number) != TCL_OK) {
  482.         return TCL_ERROR;
  483.         }
  484.         event.xbutton.button = number;
  485.     } else if (strcmp(field, "-count") == 0) {
  486.         if (Tcl_GetInt(interp, value, &number) != TCL_OK) {
  487.         return TCL_ERROR;
  488.         }
  489.         if (flags & EXPOSE) {
  490.         event.xexpose.count = number;
  491.         } else if (flags & MAPPING) {
  492.         event.xmapping.count = number;
  493.         }
  494.     } else if (strcmp(field, "-detail") == 0) {
  495.         if (flags & (CROSSING|FOCUS)) {
  496.         if (strcmp(value, "NotifyAncestor") == 0) {
  497.             number = NotifyAncestor;
  498.         } else if (strcmp(value, "NotifyVirtual") == 0) {
  499.             number = NotifyVirtual;
  500.         } else if (strcmp(value, "NotifyInferior") == 0) {
  501.             number = NotifyInferior;
  502.         } else if (strcmp(value, "NotifyNonlinear") == 0) {
  503.             number = NotifyNonlinear;
  504.         } else if (strcmp(value, "NotifyNonlinearVirtual") == 0) {
  505.             number = NotifyNonlinearVirtual;
  506.         } else if (strcmp(value, "NotifyPointer") == 0) {
  507.             number = NotifyPointer;
  508.         } else if (strcmp(value, "NotifyPointerRoot") == 0) {
  509.             number = NotifyPointerRoot;
  510.         } else if (strcmp(value, "NotifyDetailNone") == 0) {
  511.             number = NotifyDetailNone;
  512.         } else {
  513.             Tcl_AppendResult(interp, "bad detail \"", value, "\"",
  514.                 (char *) NULL);
  515.             return TCL_ERROR;
  516.         }
  517.         if (flags & FOCUS) {
  518.             event.xfocus.detail = number;
  519.         } else {
  520.             event.xcrossing.detail = number;
  521.         }
  522.         } else if (flags & CONFIG_REQ) {
  523.         if (strcmp(value, "Above") == 0) {
  524.             number = Above;
  525.         } else if (strcmp(value, "Below") == 0) {
  526.             number = Below;
  527.         } else if (strcmp(value, "TopIf") == 0) {
  528.             number = TopIf;
  529.         } else if (strcmp(value, "BottomIf") == 0) {
  530.             number = BottomIf;
  531.         } else if (strcmp(value, "Opposite") == 0) {
  532.             number = Opposite;
  533.         } else {
  534.             Tcl_AppendResult(interp, "bad detail \"", value, "\"",
  535.                 (char *) NULL);
  536.             return TCL_ERROR;
  537.         }
  538.         event.xconfigurerequest.detail = number;
  539.         }
  540.     } else if (strcmp(field, "-focus") == 0) {
  541.         if (Tcl_GetInt(interp, value, &number) != TCL_OK) {
  542.         return TCL_ERROR;
  543.         }
  544.         event.xcrossing.focus = number;
  545.     } else if (strcmp(field, "-height") == 0) {
  546.         if (Tcl_GetInt(interp, value, &number) != TCL_OK) {
  547.         return TCL_ERROR;
  548.         }
  549.         if (flags & EXPOSE) {
  550.          event.xexpose.height = number;
  551.         } else if (flags & (CONFIG|CONFIG_REQ)) {
  552.         event.xconfigure.height = number;
  553.         } else if (flags & RESIZE_REQ) {
  554.         event.xresizerequest.height = number;
  555.         }
  556.     } else if (strcmp(field, "-keycode") == 0) {
  557.         if (Tcl_GetInt(interp, value, &number) != TCL_OK) {
  558.         return TCL_ERROR;
  559.         }
  560.         event.xkey.keycode = number;
  561.     } else if (strcmp(field, "-keysym") == 0) {
  562.         keysym = TkStringToKeysym(value);
  563.         if (keysym == NoSymbol) {
  564.         Tcl_AppendResult(interp, "unknown keysym \"", value,
  565.             "\"", (char *) NULL);
  566.         return TCL_ERROR;
  567.         }
  568.         number = XKeysymToKeycode(event.xany.display, keysym);
  569.         if (number == 0) {
  570.         Tcl_AppendResult(interp, "no keycode for keysym \"", value,
  571.             "\"", (char *) NULL);
  572.         return TCL_ERROR;
  573.         }
  574.         event.xkey.keycode = number;
  575.     } else if (strcmp(field, "-mode") == 0) {
  576.         if (strcmp(value, "NotifyNormal") == 0) {
  577.         number = NotifyNormal;
  578.         } else if (strcmp(value, "NotifyGrab") == 0) {
  579.         number = NotifyGrab;
  580.         } else if (strcmp(value, "NotifyUngrab") == 0) {
  581.         number = NotifyUngrab;
  582.         } else if (strcmp(value, "NotifyWhileGrabbed") == 0) {
  583.         number = NotifyWhileGrabbed;
  584.         } else {
  585.         Tcl_AppendResult(interp, "bad mode \"", value, "\"",
  586.             (char *) NULL);
  587.         return TCL_ERROR;
  588.         }
  589.         if (flags & CROSSING) {
  590.         event.xcrossing.mode = number;
  591.         } else if (flags & FOCUS) {
  592.         event.xfocus.mode = number;
  593.         }
  594.     } else if (strcmp(field, "-override") == 0) {
  595.         if (Tcl_GetInt(interp, value, &number) != TCL_OK) {
  596.         return TCL_ERROR;
  597.         }
  598.         if (flags & CREATE) {
  599.         event.xcreatewindow.override_redirect = number;
  600.         } else if (flags & MAP) {
  601.         event.xmap.override_redirect = number;
  602.         } else if (flags & REPARENT) {
  603.         event.xreparent.override_redirect = number;
  604.         } else if (flags & CONFIG) {
  605.         event.xconfigure.override_redirect = number;
  606.         }
  607.     } else if (strcmp(field, "-place") == 0) {
  608.         if (strcmp(value, "PlaceOnTop") == 0) {
  609.         event.xcirculate.place = PlaceOnTop;
  610.         } else if (strcmp(value, "PlaceOnBottom") == 0) {
  611.         event.xcirculate.place = PlaceOnBottom;
  612.         } else if (strcmp(value, "bogus") == 0) {
  613.         event.xcirculate.place = 147;
  614.         } else {
  615.         Tcl_AppendResult(interp, "bad place \"", value, "\"",
  616.             (char *) NULL);
  617.         return TCL_ERROR;
  618.         }
  619.     } else if (strcmp(field, "-root") == 0) {
  620.         if (Tcl_GetInt(interp, value, &number) != TCL_OK) {
  621.         return TCL_ERROR;
  622.         }
  623.         event.xkey.root = number;
  624.     } else if (strcmp(field, "-rootx") == 0) {
  625.         if (Tcl_GetInt(interp, value, &number) != TCL_OK) {
  626.         return TCL_ERROR;
  627.         }
  628.         event.xkey.x_root = number;
  629.     } else if (strcmp(field, "-rooty") == 0) {
  630.         if (Tcl_GetInt(interp, value, &number) != TCL_OK) {
  631.         return TCL_ERROR;
  632.         }
  633.         event.xkey.y_root = number;
  634.     } else if (strcmp(field, "-sendevent") == 0) {
  635.         if (Tcl_GetInt(interp, value, &number) != TCL_OK) {
  636.         return TCL_ERROR;
  637.         }
  638.         event.xany.send_event = number;
  639.     } else if (strcmp(field, "-serial") == 0) {
  640.         if (Tcl_GetInt(interp, value, &number) != TCL_OK) {
  641.         return TCL_ERROR;
  642.         }
  643.         event.xany.serial = number;
  644.     } else if (strcmp(field, "-state") == 0) {
  645.         if (flags & KEY_BUTTON_MOTION) {
  646.         if (Tcl_GetInt(interp, value, &number) != TCL_OK) {
  647.             return TCL_ERROR;
  648.         }
  649.         event.xkey.state = number;
  650.         } else if (flags & CROSSING) {
  651.         if (Tcl_GetInt(interp, value, &number) != TCL_OK) {
  652.             return TCL_ERROR;
  653.         }
  654.         event.xcrossing.state = number;
  655.         } else if (flags & VISIBILITY) {
  656.         if (strcmp(value, "VisibilityUnobscured") == 0) {
  657.             number = VisibilityUnobscured;
  658.         } else if (strcmp(value, "VisibilityPartiallyObscured") == 0) {
  659.             number = VisibilityPartiallyObscured;
  660.         } else if (strcmp(value, "VisibilityFullyObscured") == 0) {
  661.             number = VisibilityFullyObscured;
  662.         } else {
  663.             Tcl_AppendResult(interp, "bad state \"", value, "\"",
  664.                 (char *) NULL);
  665.             return TCL_ERROR;
  666.         }
  667.         event.xvisibility.state = number;
  668.         }
  669.     } else if (strcmp(field, "-subwindow") == 0) {
  670.         tkwin2 = Tk_NameToWindow(interp, value, main);
  671.         if (tkwin2 == NULL) {
  672.         return TCL_ERROR;
  673.         }
  674.         event.xkey.subwindow = Tk_WindowId(tkwin2);
  675.     } else if (strcmp(field, "-time") == 0) {
  676.         if (Tcl_GetInt(interp, value, &number) != TCL_OK) {
  677.         return TCL_ERROR;
  678.         }
  679.         if (flags & (KEY_BUTTON_MOTION|PROP|SEL_CLEAR)) {
  680.         event.xkey.time = (Time) number;
  681.         } else if (flags & SEL_REQ) {
  682.         event.xselectionrequest.time = (Time) number;
  683.         } else if (flags & SEL_NOTIFY) {
  684.         event.xselection.time = (Time) number;
  685.         }
  686.     } else if (strcmp(field, "-valueMask") == 0) {
  687.         if (Tcl_GetInt(interp, value, &number) != TCL_OK) {
  688.         return TCL_ERROR;
  689.         }
  690.         event.xconfigurerequest.value_mask = number;
  691.     } else if (strcmp(field, "-width") == 0) {
  692.         if (Tcl_GetInt(interp, value, &number) != TCL_OK) {
  693.         return TCL_ERROR;
  694.         }
  695.         if (flags & EXPOSE) {
  696.         event.xexpose.width = number;
  697.         } else if (flags & (CONFIG|CONFIG_REQ)) {
  698.         event.xconfigure.width = number;
  699.         } else if (flags & RESIZE_REQ) {
  700.         event.xresizerequest.width = number;
  701.         }
  702.     } else if (strcmp(field, "-window") == 0) {
  703.         tkwin2 = Tk_NameToWindow(interp, value, main);
  704.         if (tkwin2 == NULL) {
  705.         return TCL_ERROR;
  706.         }
  707.         event.xmap.window = Tk_WindowId(tkwin2);
  708.     } else if (strcmp(field, "-x") == 0) {
  709.         int rootX, rootY;
  710.         if (Tcl_GetInt(interp, value, &number) != TCL_OK) {
  711.         return TCL_ERROR;
  712.         }
  713.         Tk_GetRootCoords(tkwin, &rootX, &rootY);
  714.         rootX += number;
  715.         if (flags & KEY_BUTTON_MOTION) {
  716.         event.xkey.x = number;
  717.         event.xkey.x_root = rootX;
  718.         } else if (flags & EXPOSE) {
  719.         event.xexpose.x = number;
  720.         } else if (flags & (CREATE|CONFIG|GRAVITY|CONFIG_REQ)) {
  721.         event.xcreatewindow.x = number;
  722.         } else if (flags & REPARENT) {
  723.         event.xreparent.x = number;
  724.         } else if (flags & CROSSING) {
  725.         event.xcrossing.x = number;
  726.         event.xcrossing.x_root = rootY;
  727.         }
  728.     } else if (strcmp(field, "-y") == 0) {
  729.         int rootX, rootY;
  730.         if (Tcl_GetInt(interp, value, &number) != TCL_OK) {
  731.         return TCL_ERROR;
  732.         }
  733.         Tk_GetRootCoords(tkwin, &rootX, &rootY);
  734.         rootY += number;
  735.         if (flags & KEY_BUTTON_MOTION) {
  736.         event.xkey.y = number;
  737.         event.xkey.y_root = rootY;
  738.         } else if (flags & EXPOSE) {
  739.         event.xexpose.y = number;
  740.         } else if (flags & (CREATE|CONFIG|GRAVITY|CONFIG_REQ)) {
  741.         event.xcreatewindow.y = number;
  742.         } else if (flags & REPARENT) {
  743.         event.xreparent.y = number;
  744.         } else if (flags & CROSSING) {
  745.         event.xcrossing.y = number;
  746.         event.xcrossing.y_root = rootY;
  747.         }
  748.     } else {
  749.         Tcl_AppendResult(interp, "bad option \"", field, "\"",
  750.             (char *) NULL);
  751.         return TCL_ERROR;
  752.     }
  753.     }
  754.     Tk_HandleEvent(&event);
  755.     return TCL_OK;
  756. }
  757.  
  758. /*
  759.  *----------------------------------------------------------------------
  760.  *
  761.  * TestmakeexistCmd --
  762.  *
  763.  *    This procedure implements the "testmakeexist" command.  It calls
  764.  *    Tk_MakeWindowExist on each of its arguments to force the windows
  765.  *    to be created.
  766.  *
  767.  * Results:
  768.  *    A standard Tcl result.
  769.  *
  770.  * Side effects:
  771.  *    Forces windows to be created.
  772.  *
  773.  *----------------------------------------------------------------------
  774.  */
  775.  
  776.     /* ARGSUSED */
  777. static int
  778. TestmakeexistCmd(clientData, interp, argc, argv)
  779.     ClientData clientData;        /* Main window for application. */
  780.     Tcl_Interp *interp;            /* Current interpreter. */
  781.     int argc;                /* Number of arguments. */
  782.     char **argv;            /* Argument strings. */
  783. {
  784.     Tk_Window main = (Tk_Window) clientData;
  785.     int i;
  786.     Tk_Window tkwin;
  787.  
  788.     for (i = 1; i < argc; i++) {
  789.     tkwin = Tk_NameToWindow(interp, argv[i], main);
  790.     if (tkwin == NULL) {
  791.         return TCL_ERROR;
  792.     }
  793.     Tk_MakeWindowExist(tkwin);
  794.     }
  795.  
  796.     return TCL_OK;
  797. }
  798.  
  799. /*
  800.  *----------------------------------------------------------------------
  801.  *
  802.  * ImageCreate --
  803.  *
  804.  *    This procedure is called by the Tk image code to create "test"
  805.  *    images.
  806.  *
  807.  * Results:
  808.  *    A standard Tcl result.
  809.  *
  810.  * Side effects:
  811.  *    The data structure for a new image is allocated.
  812.  *
  813.  *----------------------------------------------------------------------
  814.  */
  815.  
  816.     /* ARGSUSED */
  817. static int
  818. ImageCreate(interp, name, argc, argv, typePtr, master, clientDataPtr)
  819.     Tcl_Interp *interp;        /* Interpreter for application containing
  820.                  * image. */
  821.     char *name;            /* Name to use for image. */
  822.     int argc;            /* Number of arguments. */
  823.     char **argv;        /* Argument strings for options (doesn't
  824.                  * include image name or type). */
  825.     Tk_ImageType *typePtr;    /* Pointer to our type record (not used). */
  826.     Tk_ImageMaster master;    /* Token for image, to be used by us in
  827.                  * later callbacks. */
  828.     ClientData *clientDataPtr;    /* Store manager's token for image here;
  829.                  * it will be returned in later callbacks. */
  830. {
  831.     TImageMaster *timPtr;
  832.     char *varName;
  833.     int i;
  834.  
  835.     varName = "log";
  836.     for (i = 0; i < argc; i += 2) {
  837.     if (strcmp(argv[i], "-variable") != 0) {
  838.         Tcl_AppendResult(interp, "bad option name \"", argv[i],
  839.             "\"", (char *) NULL);
  840.         return TCL_ERROR;
  841.     }
  842.     if ((i+1) == argc) {
  843.         Tcl_AppendResult(interp, "no value given for \"", argv[i],
  844.             "\" option", (char *) NULL);
  845.         return TCL_ERROR;
  846.     }
  847.     varName = argv[i+1];
  848.     }
  849.     timPtr = (TImageMaster *) ckalloc(sizeof(TImageMaster));
  850.     timPtr->master = master;
  851.     timPtr->interp = interp;
  852.     timPtr->width = 30;
  853.     timPtr->height = 15;
  854.     timPtr->imageName = (char *) ckalloc((unsigned) (strlen(name) + 1));
  855.     strcpy(timPtr->imageName, name);
  856.     timPtr->varName = (char *) ckalloc((unsigned) (strlen(varName) + 1));
  857.     strcpy(timPtr->varName, varName);
  858.     Tcl_CreateCommand(interp, name, ImageCmd, (ClientData) timPtr,
  859.         (Tcl_CmdDeleteProc *) NULL);
  860.     *clientDataPtr = (ClientData) timPtr;
  861.     Tk_ImageChanged(master, 0, 0, 30, 15, 30, 15);
  862.     return TCL_OK;
  863. }
  864.  
  865. /*
  866.  *----------------------------------------------------------------------
  867.  *
  868.  * ImageCmd --
  869.  *
  870.  *    This procedure implements the commands corresponding to individual
  871.  *    images. 
  872.  *
  873.  * Results:
  874.  *    A standard Tcl result.
  875.  *
  876.  * Side effects:
  877.  *    Forces windows to be created.
  878.  *
  879.  *----------------------------------------------------------------------
  880.  */
  881.  
  882.     /* ARGSUSED */
  883. static int
  884. ImageCmd(clientData, interp, argc, argv)
  885.     ClientData clientData;        /* Main window for application. */
  886.     Tcl_Interp *interp;            /* Current interpreter. */
  887.     int argc;                /* Number of arguments. */
  888.     char **argv;            /* Argument strings. */
  889. {
  890.     TImageMaster *timPtr = (TImageMaster *) clientData;
  891.     int x, y, width, height;
  892.  
  893.     if (argc < 2) {
  894.     Tcl_AppendResult(interp, "wrong # args: should be \"",
  895.         argv[0], "option ?arg arg ...?", (char *) NULL);
  896.     return TCL_ERROR;
  897.     }
  898.     if (strcmp(argv[1], "changed") == 0) {
  899.     if (argc != 8) {
  900.         Tcl_AppendResult(interp, "wrong # args: should be \"",
  901.             argv[0], " changed x y width height imageWidth imageHeight",
  902.             (char *) NULL);
  903.         return TCL_ERROR;
  904.     }
  905.     if ((Tcl_GetInt(interp, argv[2], &x) != TCL_OK)
  906.         || (Tcl_GetInt(interp, argv[3], &y) != TCL_OK)
  907.         || (Tcl_GetInt(interp, argv[4], &width) != TCL_OK)
  908.         || (Tcl_GetInt(interp, argv[5], &height) != TCL_OK)
  909.         || (Tcl_GetInt(interp, argv[6], &timPtr->width) != TCL_OK)
  910.         || (Tcl_GetInt(interp, argv[7], &timPtr->height) != TCL_OK)) {
  911.         return TCL_ERROR;
  912.     }
  913.     Tk_ImageChanged(timPtr->master, x, y, width, height, timPtr->width,
  914.         timPtr->height);
  915.     } else {
  916.     Tcl_AppendResult(interp, "bad option \"", argv[1],
  917.         "\": must be changed", (char *) NULL);
  918.     return TCL_ERROR;
  919.     }
  920.     return TCL_OK;
  921. }
  922.  
  923. /*
  924.  *----------------------------------------------------------------------
  925.  *
  926.  * ImageGet --
  927.  *
  928.  *    This procedure is called by Tk to set things up for using a
  929.  *    test image in a particular widget.
  930.  *
  931.  * Results:
  932.  *    The return value is a token for the image instance, which is
  933.  *    used in future callbacks to ImageDisplay and ImageFree.
  934.  *
  935.  * Side effects:
  936.  *    None.
  937.  *
  938.  *----------------------------------------------------------------------
  939.  */
  940.  
  941. static ClientData
  942. ImageGet(tkwin, clientData)
  943.     Tk_Window tkwin;        /* Token for window in which image will
  944.                  * be used. */
  945.     ClientData clientData;    /* Pointer to TImageMaster for image. */
  946. {
  947.     TImageMaster *timPtr = (TImageMaster *) clientData;
  948.     TImageInstance *instPtr;
  949.     char buffer[100];
  950.     XGCValues gcValues;
  951.  
  952.     sprintf(buffer, "%s get", timPtr->imageName);
  953.     Tcl_SetVar(timPtr->interp, timPtr->varName, buffer,
  954.         TCL_GLOBAL_ONLY|TCL_APPEND_VALUE|TCL_LIST_ELEMENT);
  955.  
  956.     instPtr = (TImageInstance *) ckalloc(sizeof(TImageInstance));
  957.     instPtr->masterPtr = timPtr;
  958.     instPtr->fg = Tk_GetColor(timPtr->interp, tkwin, "#ff0000");
  959.     gcValues.foreground = instPtr->fg->pixel;
  960.     instPtr->gc = Tk_GetGC(tkwin, GCForeground, &gcValues);
  961.     return (ClientData) instPtr;
  962. }
  963.  
  964. /*
  965.  *----------------------------------------------------------------------
  966.  *
  967.  * ImageDisplay --
  968.  *
  969.  *    This procedure is invoked to redisplay part or all of an
  970.  *    image in a given drawable.
  971.  *
  972.  * Results:
  973.  *    None.
  974.  *
  975.  * Side effects:
  976.  *    The image gets partially redrawn, as an "X" that shows the
  977.  *    exact redraw area.
  978.  *
  979.  *----------------------------------------------------------------------
  980.  */
  981.  
  982. static void
  983. ImageDisplay(clientData, display, drawable, imageX, imageY, width, height,
  984.     drawableX, drawableY)
  985.     ClientData clientData;    /* Pointer to TImageInstance for image. */
  986.     Display *display;        /* Display to use for drawing. */
  987.     Drawable drawable;        /* Where to redraw image. */
  988.     int imageX, imageY;        /* Origin of area to redraw, relative to
  989.                  * origin of image. */
  990.     int width, height;        /* Dimensions of area to redraw. */
  991.     int drawableX, drawableY;    /* Coordinates in drawable corresponding to
  992.                  * imageX and imageY. */
  993. {
  994.     TImageInstance *instPtr = (TImageInstance *) clientData;
  995.     char buffer[200];
  996.  
  997.     sprintf(buffer, "%s display %d %d %d %d %d %d",
  998.         instPtr->masterPtr->imageName, imageX, imageY, width, height,
  999.         drawableX, drawableY);
  1000.     Tcl_SetVar(instPtr->masterPtr->interp, instPtr->masterPtr->varName, buffer,
  1001.         TCL_GLOBAL_ONLY|TCL_APPEND_VALUE|TCL_LIST_ELEMENT);
  1002.     if (width > (instPtr->masterPtr->width - imageX)) {
  1003.     width = instPtr->masterPtr->width - imageX;
  1004.     }
  1005.     if (height > (instPtr->masterPtr->height - imageY)) {
  1006.     height = instPtr->masterPtr->height - imageY;
  1007.     }
  1008.     XDrawRectangle(display, drawable, instPtr->gc, drawableX, drawableY,
  1009.         (unsigned) (width-1), (unsigned) (height-1));
  1010.     XDrawLine(display, drawable, instPtr->gc, drawableX, drawableY,
  1011.         (int) (drawableX + width - 1), (int) (drawableY + height - 1));
  1012.     XDrawLine(display, drawable, instPtr->gc, drawableX,
  1013.         (int) (drawableY + height - 1),
  1014.         (int) (drawableX + width - 1), drawableY);
  1015. }
  1016.  
  1017. /*
  1018.  *----------------------------------------------------------------------
  1019.  *
  1020.  * ImageFree --
  1021.  *
  1022.  *    This procedure is called when an instance of an image is
  1023.  *     no longer used.
  1024.  *
  1025.  * Results:
  1026.  *    None.
  1027.  *
  1028.  * Side effects:
  1029.  *    Information related to the instance is freed.
  1030.  *
  1031.  *----------------------------------------------------------------------
  1032.  */
  1033.  
  1034. static void
  1035. ImageFree(clientData, display)
  1036.     ClientData clientData;    /* Pointer to TImageInstance for instance. */
  1037.     Display *display;        /* Display where image was to be drawn. */
  1038. {
  1039.     TImageInstance *instPtr = (TImageInstance *) clientData;
  1040.     char buffer[200];
  1041.  
  1042.     sprintf(buffer, "%s free", instPtr->masterPtr->imageName);
  1043.     Tcl_SetVar(instPtr->masterPtr->interp, instPtr->masterPtr->varName, buffer,
  1044.         TCL_GLOBAL_ONLY|TCL_APPEND_VALUE|TCL_LIST_ELEMENT);
  1045.     Tk_FreeColor(instPtr->fg);
  1046.     Tk_FreeGC(display, instPtr->gc);
  1047.     ckfree((char *) instPtr);
  1048. }
  1049.  
  1050. /*
  1051.  *----------------------------------------------------------------------
  1052.  *
  1053.  * ImageDelete --
  1054.  *
  1055.  *    This procedure is called to clean up a test image when
  1056.  *    an application goes away.
  1057.  *
  1058.  * Results:
  1059.  *    None.
  1060.  *
  1061.  * Side effects:
  1062.  *    Information about the image is deleted.
  1063.  *
  1064.  *----------------------------------------------------------------------
  1065.  */
  1066.  
  1067. static void
  1068. ImageDelete(clientData)
  1069.     ClientData clientData;    /* Pointer to TImageMaster for image.  When
  1070.                  * this procedure is called, no more
  1071.                  * instances exist. */
  1072. {
  1073.     TImageMaster *timPtr = (TImageMaster *) clientData;
  1074.     char buffer[100];
  1075.  
  1076.     sprintf(buffer, "%s delete", timPtr->imageName);
  1077.     Tcl_SetVar(timPtr->interp, timPtr->varName, buffer,
  1078.         TCL_GLOBAL_ONLY|TCL_APPEND_VALUE|TCL_LIST_ELEMENT);
  1079.  
  1080.     Tcl_DeleteCommand(timPtr->interp, timPtr->imageName);
  1081.     ckfree(timPtr->imageName);
  1082.     ckfree(timPtr->varName);
  1083.     ckfree((char *) timPtr);
  1084. }
  1085.  
  1086. /*
  1087.  *----------------------------------------------------------------------
  1088.  *
  1089.  * TestsendCmd --
  1090.  *
  1091.  *    This procedure implements the "testsend" command.  It provides
  1092.  *    a set of functions for testing the "send" command and support
  1093.  *    procedure in tkSend.c.
  1094.  *
  1095.  * Results:
  1096.  *    A standard Tcl result.
  1097.  *
  1098.  * Side effects:
  1099.  *    Depends on option;  see below.
  1100.  *
  1101.  *----------------------------------------------------------------------
  1102.  */
  1103.  
  1104.     /* ARGSUSED */
  1105. static int
  1106. TestsendCmd(clientData, interp, argc, argv)
  1107.     ClientData clientData;        /* Main window for application. */
  1108.     Tcl_Interp *interp;            /* Current interpreter. */
  1109.     int argc;                /* Number of arguments. */
  1110.     char **argv;            /* Argument strings. */
  1111. {
  1112. #if !(defined(__WIN32__) || defined(__EMX__))
  1113.     TkWindow *winPtr = (TkWindow *) clientData;
  1114. #endif
  1115.  
  1116.     if (argc < 2) {
  1117.     Tcl_AppendResult(interp, "wrong # args;  must be \"", argv[0],
  1118.         " option ?arg ...?\"", (char *) NULL);
  1119.     return TCL_ERROR;
  1120.     }
  1121.  
  1122. #if !(defined(__WIN32__) || defined(__EMX__))
  1123.     if (strcmp(argv[1], "bogus") == 0) {
  1124.     XChangeProperty(winPtr->dispPtr->display,
  1125.         RootWindow(winPtr->dispPtr->display, 0),
  1126.         winPtr->dispPtr->registryProperty, XA_INTEGER, 32,
  1127.         PropModeReplace,
  1128.         (unsigned char *) "This is bogus information", 6);
  1129.     } else if (strcmp(argv[1], "prop") == 0) {
  1130.     int result, actualFormat, length;
  1131.     unsigned long bytesAfter;
  1132.     Atom actualType, propName;
  1133.     char *property, *p, *end;
  1134.     Window w;
  1135.  
  1136.     if ((argc != 4) && (argc != 5)) {
  1137.         Tcl_AppendResult(interp, "wrong # args;  must be \"", argv[0],
  1138.             " prop window name ?value ?\"", (char *) NULL);
  1139.         return TCL_ERROR;
  1140.     }
  1141.     if (strcmp(argv[2], "root") == 0) {
  1142.         w = RootWindow(winPtr->dispPtr->display, 0);
  1143.     } else if (strcmp(argv[2], "comm") == 0) {
  1144.         w = Tk_WindowId(winPtr->dispPtr->commTkwin);
  1145.     } else {
  1146.         w = strtoul(argv[2], &end, 0);
  1147.     }
  1148.     propName = Tk_InternAtom((Tk_Window) winPtr, argv[3]);
  1149.     if (argc == 4) {
  1150.         property = NULL;
  1151.         result = XGetWindowProperty(winPtr->dispPtr->display,
  1152.             w, propName, 0, 100000, False, XA_STRING,
  1153.             &actualType, &actualFormat, (unsigned long *) &length,
  1154.             &bytesAfter, (unsigned char **) &property);
  1155.         if ((result == Success) && (actualType != None)
  1156.             && (actualFormat == 8) && (actualType == XA_STRING)) {
  1157.         for (p = property; (p-property) < length; p++) {
  1158.             if (*p == 0) {
  1159.             *p = '\n';
  1160.             }
  1161.         }
  1162.         Tcl_SetResult(interp, property, TCL_VOLATILE);
  1163.         }
  1164.         if (property != NULL) {
  1165.         XFree(property);
  1166.         }
  1167.     } else {
  1168.         if (argv[4][0] == 0) {
  1169.         XDeleteProperty(winPtr->dispPtr->display, w, propName);
  1170.         } else {
  1171.         for (p = argv[4]; *p != 0; p++) {
  1172.             if (*p == '\n') {
  1173.             *p = 0;
  1174.             }
  1175.         }
  1176.         XChangeProperty(winPtr->dispPtr->display,
  1177.             w, propName, XA_STRING, 8, PropModeReplace,
  1178.             (unsigned char *) argv[4], p-argv[4]);
  1179.         }
  1180.     }
  1181.     } else if (strcmp(argv[1], "serial") == 0) {
  1182.     sprintf(interp->result, "%d", tkSendSerial+1);
  1183.     } else {
  1184.     Tcl_AppendResult(interp, "bad option \"", argv[1],
  1185.         "\": must be bogus, prop, or serial", (char *) NULL);
  1186.     return TCL_ERROR;
  1187.     }
  1188. #endif
  1189.     return TCL_OK;
  1190. }
  1191.