1163 lines
34 KiB
C
1163 lines
34 KiB
C
/*
|
||
* tkTest.c --
|
||
*
|
||
* This file contains C command procedures for a bunch of additional
|
||
* Tcl commands that are used for testing out Tcl's C interfaces.
|
||
* These commands are not normally included in Tcl applications;
|
||
* they're only used for testing.
|
||
*
|
||
* Copyright (c) 1993-1994 The Regents of the University of California.
|
||
* Copyright (c) 1994-1996 Sun Microsystems, Inc.
|
||
*
|
||
* See the file "license.terms" for information on usage and redistribution
|
||
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
|
||
*
|
||
* SCCS: @(#) tkTest.c 1.35 96/10/03 11:22:26
|
||
*/
|
||
|
||
#include "tkInt.h"
|
||
#include "tkPort.h"
|
||
|
||
#ifdef __WIN32__
|
||
#include "tkWinInt.h"
|
||
#endif
|
||
|
||
/*
|
||
* The table below describes events and is used by the "testevent"
|
||
* command.
|
||
*/
|
||
|
||
typedef struct {
|
||
char *name; /* Name of event. */
|
||
int type; /* Event type for X, such as
|
||
* ButtonPress. */
|
||
} EventInfo;
|
||
|
||
static EventInfo eventArray[] = {
|
||
{"Motion", MotionNotify},
|
||
{"Button", ButtonPress},
|
||
{"ButtonPress", ButtonPress},
|
||
{"ButtonRelease", ButtonRelease},
|
||
{"Colormap", ColormapNotify},
|
||
{"Enter", EnterNotify},
|
||
{"Leave", LeaveNotify},
|
||
{"Expose", Expose},
|
||
{"FocusIn", FocusIn},
|
||
{"FocusOut", FocusOut},
|
||
{"Keymap", KeymapNotify},
|
||
{"Key", KeyPress},
|
||
{"KeyPress", KeyPress},
|
||
{"KeyRelease", KeyRelease},
|
||
{"Property", PropertyNotify},
|
||
{"ResizeRequest", ResizeRequest},
|
||
{"Circulate", CirculateNotify},
|
||
{"Configure", ConfigureNotify},
|
||
{"Destroy", DestroyNotify},
|
||
{"Gravity", GravityNotify},
|
||
{"Map", MapNotify},
|
||
{"Reparent", ReparentNotify},
|
||
{"Unmap", UnmapNotify},
|
||
{"Visibility", VisibilityNotify},
|
||
{"CirculateRequest",CirculateRequest},
|
||
{"ConfigureRequest",ConfigureRequest},
|
||
{"MapRequest", MapRequest},
|
||
{(char *) NULL, 0}
|
||
};
|
||
|
||
/*
|
||
* The defines and table below are used to classify events into
|
||
* various groups. The reason for this is that logically identical
|
||
* fields (e.g. "state") appear at different places in different
|
||
* types of events. The classification masks can be used to figure
|
||
* out quickly where to extract information from events.
|
||
*/
|
||
|
||
#define KEY_BUTTON_MOTION 0x1
|
||
#define CROSSING 0x2
|
||
#define FOCUS 0x4
|
||
#define EXPOSE 0x8
|
||
#define VISIBILITY 0x10
|
||
#define CREATE 0x20
|
||
#define MAP 0x40
|
||
#define REPARENT 0x80
|
||
#define CONFIG 0x100
|
||
#define CONFIG_REQ 0x200
|
||
#define RESIZE_REQ 0x400
|
||
#define GRAVITY 0x800
|
||
#define PROP 0x1000
|
||
#define SEL_CLEAR 0x2000
|
||
#define SEL_REQ 0x4000
|
||
#define SEL_NOTIFY 0x8000
|
||
#define COLORMAP 0x10000
|
||
#define MAPPING 0x20000
|
||
|
||
static int flagArray[LASTEvent] = {
|
||
/* Not used */ 0,
|
||
/* Not used */ 0,
|
||
/* KeyPress */ KEY_BUTTON_MOTION,
|
||
/* KeyRelease */ KEY_BUTTON_MOTION,
|
||
/* ButtonPress */ KEY_BUTTON_MOTION,
|
||
/* ButtonRelease */ KEY_BUTTON_MOTION,
|
||
/* MotionNotify */ KEY_BUTTON_MOTION,
|
||
/* EnterNotify */ CROSSING,
|
||
/* LeaveNotify */ CROSSING,
|
||
/* FocusIn */ FOCUS,
|
||
/* FocusOut */ FOCUS,
|
||
/* KeymapNotify */ 0,
|
||
/* Expose */ EXPOSE,
|
||
/* GraphicsExpose */ EXPOSE,
|
||
/* NoExpose */ 0,
|
||
/* VisibilityNotify */ VISIBILITY,
|
||
/* CreateNotify */ CREATE,
|
||
/* DestroyNotify */ 0,
|
||
/* UnmapNotify */ 0,
|
||
/* MapNotify */ MAP,
|
||
/* MapRequest */ 0,
|
||
/* ReparentNotify */ REPARENT,
|
||
/* ConfigureNotify */ CONFIG,
|
||
/* ConfigureRequest */ CONFIG_REQ,
|
||
/* GravityNotify */ 0,
|
||
/* ResizeRequest */ RESIZE_REQ,
|
||
/* CirculateNotify */ 0,
|
||
/* CirculateRequest */ 0,
|
||
/* PropertyNotify */ PROP,
|
||
/* SelectionClear */ SEL_CLEAR,
|
||
/* SelectionRequest */ SEL_REQ,
|
||
/* SelectionNotify */ SEL_NOTIFY,
|
||
/* ColormapNotify */ COLORMAP,
|
||
/* ClientMessage */ 0,
|
||
/* MappingNotify */ MAPPING
|
||
};
|
||
|
||
/*
|
||
* The following data structure represents the master for a test
|
||
* image:
|
||
*/
|
||
|
||
typedef struct TImageMaster {
|
||
Tk_ImageMaster master; /* Tk's token for image master. */
|
||
Tcl_Interp *interp; /* Interpreter for application. */
|
||
int width, height; /* Dimensions of image. */
|
||
char *imageName; /* Name of image (malloc-ed). */
|
||
char *varName; /* Name of variable in which to log
|
||
* events for image (malloc-ed). */
|
||
} TImageMaster;
|
||
|
||
/*
|
||
* The following data structure represents a particular use of a
|
||
* particular test image.
|
||
*/
|
||
|
||
typedef struct TImageInstance {
|
||
TImageMaster *masterPtr; /* Pointer to master for image. */
|
||
XColor *fg; /* Foreground color for drawing in image. */
|
||
GC gc; /* Graphics context for drawing in image. */
|
||
} TImageInstance;
|
||
|
||
/*
|
||
* The type record for test images:
|
||
*/
|
||
|
||
static int ImageCreate _ANSI_ARGS_((Tcl_Interp *interp,
|
||
char *name, int argc, char **argv,
|
||
Tk_ImageType *typePtr, Tk_ImageMaster master,
|
||
ClientData *clientDataPtr));
|
||
static ClientData ImageGet _ANSI_ARGS_((Tk_Window tkwin,
|
||
ClientData clientData));
|
||
static void ImageDisplay _ANSI_ARGS_((ClientData clientData,
|
||
Display *display, Drawable drawable,
|
||
int imageX, int imageY, int width,
|
||
int height, int drawableX,
|
||
int drawableY));
|
||
static void ImageFree _ANSI_ARGS_((ClientData clientData,
|
||
Display *display));
|
||
static void ImageDelete _ANSI_ARGS_((ClientData clientData));
|
||
|
||
static Tk_ImageType imageType = {
|
||
"test", /* name */
|
||
ImageCreate, /* createProc */
|
||
ImageGet, /* getProc */
|
||
ImageDisplay, /* displayProc */
|
||
ImageFree, /* freeProc */
|
||
ImageDelete, /* deleteProc */
|
||
(Tk_ImageType *) NULL /* nextPtr */
|
||
};
|
||
|
||
/*
|
||
* One of the following structures describes each of the interpreters
|
||
* created by the "testnewapp" command. This information is used by
|
||
* the "testdeleteinterps" command to destroy all of those interpreters.
|
||
*/
|
||
|
||
typedef struct NewApp {
|
||
Tcl_Interp *interp; /* Token for interpreter. */
|
||
struct NewApp *nextPtr; /* Next in list of new interpreters. */
|
||
} NewApp;
|
||
|
||
static NewApp *newAppPtr = NULL;
|
||
/* First in list of all new interpreters. */
|
||
|
||
/*
|
||
* Declaration for the square widget's class command procedure:
|
||
*/
|
||
|
||
extern int SquareCmd _ANSI_ARGS_((ClientData clientData,
|
||
Tcl_Interp *interp, int argc, char *argv[]));
|
||
|
||
/*
|
||
* Forward declarations for procedures defined later in this file:
|
||
*/
|
||
|
||
int Tktest_Init _ANSI_ARGS_((Tcl_Interp *interp));
|
||
static int ImageCmd _ANSI_ARGS_((ClientData dummy,
|
||
Tcl_Interp *interp, int argc, char **argv));
|
||
#ifdef __WIN32__
|
||
static int TestclipboardCmd _ANSI_ARGS_((ClientData dummy,
|
||
Tcl_Interp *interp, int argc, char **argv));
|
||
#endif
|
||
static int TestdeleteappsCmd _ANSI_ARGS_((ClientData dummy,
|
||
Tcl_Interp *interp, int argc, char **argv));
|
||
static int TesteventCmd _ANSI_ARGS_((ClientData dummy,
|
||
Tcl_Interp *interp, int argc, char **argv));
|
||
static int TestmakeexistCmd _ANSI_ARGS_((ClientData dummy,
|
||
Tcl_Interp *interp, int argc, char **argv));
|
||
static int TestsendCmd _ANSI_ARGS_((ClientData dummy,
|
||
Tcl_Interp *interp, int argc, char **argv));
|
||
|
||
/*
|
||
*----------------------------------------------------------------------
|
||
*
|
||
* Tktest_Init --
|
||
*
|
||
* This procedure performs intialization for the Tk test
|
||
* suite exensions.
|
||
*
|
||
* Results:
|
||
* Returns a standard Tcl completion code, and leaves an error
|
||
* message in interp->result if an error occurs.
|
||
*
|
||
* Side effects:
|
||
* Creates several test commands.
|
||
*
|
||
*----------------------------------------------------------------------
|
||
*/
|
||
|
||
int
|
||
Tktest_Init(interp)
|
||
Tcl_Interp *interp; /* Interpreter for application. */
|
||
{
|
||
static int initialized = 0;
|
||
|
||
/*
|
||
* Create additional commands for testing Tk.
|
||
*/
|
||
|
||
if (Tcl_PkgProvide(interp, "Tktest", TK_VERSION) == TCL_ERROR) {
|
||
return TCL_ERROR;
|
||
}
|
||
|
||
Tcl_CreateCommand(interp, "square", SquareCmd,
|
||
(ClientData) Tk_MainWindow(interp), (Tcl_CmdDeleteProc *) NULL);
|
||
#ifdef __WIN32__
|
||
Tcl_CreateCommand(interp, "testclipboard", TestclipboardCmd,
|
||
(ClientData) Tk_MainWindow(interp), (Tcl_CmdDeleteProc *) NULL);
|
||
#endif
|
||
Tcl_CreateCommand(interp, "testdeleteapps", TestdeleteappsCmd,
|
||
(ClientData) Tk_MainWindow(interp), (Tcl_CmdDeleteProc *) NULL);
|
||
Tcl_CreateCommand(interp, "testevent", TesteventCmd,
|
||
(ClientData) Tk_MainWindow(interp), (Tcl_CmdDeleteProc *) NULL);
|
||
Tcl_CreateCommand(interp, "testmakeexist", TestmakeexistCmd,
|
||
(ClientData) Tk_MainWindow(interp), (Tcl_CmdDeleteProc *) NULL);
|
||
Tcl_CreateCommand(interp, "testsend", TestsendCmd,
|
||
(ClientData) Tk_MainWindow(interp), (Tcl_CmdDeleteProc *) NULL);
|
||
|
||
/*
|
||
* Create test image type.
|
||
*/
|
||
|
||
if (!initialized) {
|
||
initialized = 1;
|
||
Tk_CreateImageType(&imageType);
|
||
}
|
||
return TCL_OK;
|
||
}
|
||
|
||
/*
|
||
*----------------------------------------------------------------------
|
||
*
|
||
* TestclipboardCmd --
|
||
*
|
||
* This procedure implements the testclipboard command. It provides
|
||
* a way to determine the actual contents of the Windows clipboard.
|
||
*
|
||
* Results:
|
||
* A standard Tcl result.
|
||
*
|
||
* Side effects:
|
||
* None.
|
||
*
|
||
*----------------------------------------------------------------------
|
||
*/
|
||
|
||
#ifdef __WIN32__
|
||
static int
|
||
TestclipboardCmd(clientData, interp, argc, argv)
|
||
ClientData clientData; /* Main window for application. */
|
||
Tcl_Interp *interp; /* Current interpreter. */
|
||
int argc; /* Number of arguments. */
|
||
char **argv; /* Argument strings. */
|
||
{
|
||
TkWindow *winPtr = (TkWindow *) clientData;
|
||
HGLOBAL handle;
|
||
char *data;
|
||
|
||
if (OpenClipboard(NULL)) {
|
||
handle = GetClipboardData(CF_TEXT);
|
||
if (handle != NULL) {
|
||
data = GlobalLock(handle);
|
||
Tcl_AppendResult(interp, data, (char *) NULL);
|
||
GlobalUnlock(handle);
|
||
}
|
||
CloseClipboard();
|
||
}
|
||
return TCL_OK;
|
||
}
|
||
#endif
|
||
|
||
/*
|
||
*----------------------------------------------------------------------
|
||
*
|
||
* TestdeleteappsCmd --
|
||
*
|
||
* This procedure implements the "testdeleteapps" command. It cleans
|
||
* up all the interpreters left behind by the "testnewapp" command.
|
||
*
|
||
* Results:
|
||
* A standard Tcl result.
|
||
*
|
||
* Side effects:
|
||
* All the intepreters created by previous calls to "testnewapp"
|
||
* get deleted.
|
||
*
|
||
*----------------------------------------------------------------------
|
||
*/
|
||
|
||
/* ARGSUSED */
|
||
static int
|
||
TestdeleteappsCmd(clientData, interp, argc, argv)
|
||
ClientData clientData; /* Main window for application. */
|
||
Tcl_Interp *interp; /* Current interpreter. */
|
||
int argc; /* Number of arguments. */
|
||
char **argv; /* Argument strings. */
|
||
{
|
||
NewApp *nextPtr;
|
||
|
||
while (newAppPtr != NULL) {
|
||
nextPtr = newAppPtr->nextPtr;
|
||
Tcl_DeleteInterp(newAppPtr->interp);
|
||
ckfree((char *) newAppPtr);
|
||
newAppPtr = nextPtr;
|
||
}
|
||
return TCL_OK;
|
||
}
|
||
|
||
/*
|
||
*----------------------------------------------------------------------
|
||
*
|
||
* TesteventCmd --
|
||
*
|
||
* This procedure implements the "testevent" command. It allows
|
||
* events to be generated on the fly, for testing event-handling.
|
||
*
|
||
* Results:
|
||
* A standard Tcl result.
|
||
*
|
||
* Side effects:
|
||
* Creates and handles events.
|
||
*
|
||
*----------------------------------------------------------------------
|
||
*/
|
||
|
||
/* ARGSUSED */
|
||
static int
|
||
TesteventCmd(clientData, interp, argc, argv)
|
||
ClientData clientData; /* Main window for application. */
|
||
Tcl_Interp *interp; /* Current interpreter. */
|
||
int argc; /* Number of arguments. */
|
||
char **argv; /* Argument strings. */
|
||
{
|
||
Tk_Window main = (Tk_Window) clientData;
|
||
Tk_Window tkwin, tkwin2;
|
||
XEvent event;
|
||
EventInfo *eiPtr;
|
||
char *field, *value;
|
||
int i, number, flags;
|
||
KeySym keysym;
|
||
|
||
if ((argc < 3) || !(argc & 1)) {
|
||
Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
|
||
" window type ?field value field value ...?\"",
|
||
(char *) NULL);
|
||
return TCL_ERROR;
|
||
}
|
||
tkwin = Tk_NameToWindow(interp, argv[1], main);
|
||
if (tkwin == NULL) {
|
||
return TCL_ERROR;
|
||
}
|
||
|
||
/*
|
||
* Get the type of the event.
|
||
*/
|
||
|
||
memset((VOID *) &event, 0, sizeof(event));
|
||
for (eiPtr = eventArray; ; eiPtr++) {
|
||
if (eiPtr->name == NULL) {
|
||
Tcl_AppendResult(interp, "bad event type \"", argv[2],
|
||
"\"", (char *) NULL);
|
||
return TCL_ERROR;
|
||
}
|
||
if (strcmp(eiPtr->name, argv[2]) == 0) {
|
||
event.xany.type = eiPtr->type;
|
||
break;
|
||
}
|
||
}
|
||
|
||
/*
|
||
* Fill in fields that are common to all events.
|
||
*/
|
||
|
||
event.xany.serial = NextRequest(Tk_Display(tkwin));
|
||
event.xany.send_event = False;
|
||
event.xany.window = Tk_WindowId(tkwin);
|
||
event.xany.display = Tk_Display(tkwin);
|
||
|
||
/*
|
||
* Process the remaining arguments to fill in additional fields
|
||
* of the event.
|
||
*/
|
||
|
||
flags = flagArray[event.xany.type];
|
||
for (i = 3; i < argc; i += 2) {
|
||
field = argv[i];
|
||
value = argv[i+1];
|
||
if (strcmp(field, "-above") == 0) {
|
||
tkwin2 = Tk_NameToWindow(interp, value, main);
|
||
if (tkwin2 == NULL) {
|
||
return TCL_ERROR;
|
||
}
|
||
event.xconfigure.above = Tk_WindowId(tkwin2);
|
||
} else if (strcmp(field, "-borderwidth") == 0) {
|
||
if (Tcl_GetInt(interp, value, &number) != TCL_OK) {
|
||
return TCL_ERROR;
|
||
}
|
||
event.xcreatewindow.border_width = number;
|
||
} else if (strcmp(field, "-button") == 0) {
|
||
if (Tcl_GetInt(interp, value, &number) != TCL_OK) {
|
||
return TCL_ERROR;
|
||
}
|
||
event.xbutton.button = number;
|
||
} else if (strcmp(field, "-count") == 0) {
|
||
if (Tcl_GetInt(interp, value, &number) != TCL_OK) {
|
||
return TCL_ERROR;
|
||
}
|
||
if (flags & EXPOSE) {
|
||
event.xexpose.count = number;
|
||
} else if (flags & MAPPING) {
|
||
event.xmapping.count = number;
|
||
}
|
||
} else if (strcmp(field, "-detail") == 0) {
|
||
if (flags & (CROSSING|FOCUS)) {
|
||
if (strcmp(value, "NotifyAncestor") == 0) {
|
||
number = NotifyAncestor;
|
||
} else if (strcmp(value, "NotifyVirtual") == 0) {
|
||
number = NotifyVirtual;
|
||
} else if (strcmp(value, "NotifyInferior") == 0) {
|
||
number = NotifyInferior;
|
||
} else if (strcmp(value, "NotifyNonlinear") == 0) {
|
||
number = NotifyNonlinear;
|
||
} else if (strcmp(value, "NotifyNonlinearVirtual") == 0) {
|
||
number = NotifyNonlinearVirtual;
|
||
} else if (strcmp(value, "NotifyPointer") == 0) {
|
||
number = NotifyPointer;
|
||
} else if (strcmp(value, "NotifyPointerRoot") == 0) {
|
||
number = NotifyPointerRoot;
|
||
} else if (strcmp(value, "NotifyDetailNone") == 0) {
|
||
number = NotifyDetailNone;
|
||
} else {
|
||
Tcl_AppendResult(interp, "bad detail \"", value, "\"",
|
||
(char *) NULL);
|
||
return TCL_ERROR;
|
||
}
|
||
if (flags & FOCUS) {
|
||
event.xfocus.detail = number;
|
||
} else {
|
||
event.xcrossing.detail = number;
|
||
}
|
||
} else if (flags & CONFIG_REQ) {
|
||
if (strcmp(value, "Above") == 0) {
|
||
number = Above;
|
||
} else if (strcmp(value, "Below") == 0) {
|
||
number = Below;
|
||
} else if (strcmp(value, "TopIf") == 0) {
|
||
number = TopIf;
|
||
} else if (strcmp(value, "BottomIf") == 0) {
|
||
number = BottomIf;
|
||
} else if (strcmp(value, "Opposite") == 0) {
|
||
number = Opposite;
|
||
} else {
|
||
Tcl_AppendResult(interp, "bad detail \"", value, "\"",
|
||
(char *) NULL);
|
||
return TCL_ERROR;
|
||
}
|
||
event.xconfigurerequest.detail = number;
|
||
}
|
||
} else if (strcmp(field, "-focus") == 0) {
|
||
if (Tcl_GetInt(interp, value, &number) != TCL_OK) {
|
||
return TCL_ERROR;
|
||
}
|
||
event.xcrossing.focus = number;
|
||
} else if (strcmp(field, "-height") == 0) {
|
||
if (Tcl_GetInt(interp, value, &number) != TCL_OK) {
|
||
return TCL_ERROR;
|
||
}
|
||
if (flags & EXPOSE) {
|
||
event.xexpose.height = number;
|
||
} else if (flags & (CONFIG|CONFIG_REQ)) {
|
||
event.xconfigure.height = number;
|
||
} else if (flags & RESIZE_REQ) {
|
||
event.xresizerequest.height = number;
|
||
}
|
||
} else if (strcmp(field, "-keycode") == 0) {
|
||
if (Tcl_GetInt(interp, value, &number) != TCL_OK) {
|
||
return TCL_ERROR;
|
||
}
|
||
event.xkey.keycode = number;
|
||
} else if (strcmp(field, "-keysym") == 0) {
|
||
keysym = TkStringToKeysym(value);
|
||
if (keysym == NoSymbol) {
|
||
Tcl_AppendResult(interp, "unknown keysym \"", value,
|
||
"\"", (char *) NULL);
|
||
return TCL_ERROR;
|
||
}
|
||
number = XKeysymToKeycode(event.xany.display, keysym);
|
||
if (number == 0) {
|
||
Tcl_AppendResult(interp, "no keycode for keysym \"", value,
|
||
"\"", (char *) NULL);
|
||
return TCL_ERROR;
|
||
}
|
||
event.xkey.keycode = number;
|
||
} else if (strcmp(field, "-mode") == 0) {
|
||
if (strcmp(value, "NotifyNormal") == 0) {
|
||
number = NotifyNormal;
|
||
} else if (strcmp(value, "NotifyGrab") == 0) {
|
||
number = NotifyGrab;
|
||
} else if (strcmp(value, "NotifyUngrab") == 0) {
|
||
number = NotifyUngrab;
|
||
} else if (strcmp(value, "NotifyWhileGrabbed") == 0) {
|
||
number = NotifyWhileGrabbed;
|
||
} else {
|
||
Tcl_AppendResult(interp, "bad mode \"", value, "\"",
|
||
(char *) NULL);
|
||
return TCL_ERROR;
|
||
}
|
||
if (flags & CROSSING) {
|
||
event.xcrossing.mode = number;
|
||
} else if (flags & FOCUS) {
|
||
event.xfocus.mode = number;
|
||
}
|
||
} else if (strcmp(field, "-override") == 0) {
|
||
if (Tcl_GetInt(interp, value, &number) != TCL_OK) {
|
||
return TCL_ERROR;
|
||
}
|
||
if (flags & CREATE) {
|
||
event.xcreatewindow.override_redirect = number;
|
||
} else if (flags & MAP) {
|
||
event.xmap.override_redirect = number;
|
||
} else if (flags & REPARENT) {
|
||
event.xreparent.override_redirect = number;
|
||
} else if (flags & CONFIG) {
|
||
event.xconfigure.override_redirect = number;
|
||
}
|
||
} else if (strcmp(field, "-place") == 0) {
|
||
if (strcmp(value, "PlaceOnTop") == 0) {
|
||
event.xcirculate.place = PlaceOnTop;
|
||
} else if (strcmp(value, "PlaceOnBottom") == 0) {
|
||
event.xcirculate.place = PlaceOnBottom;
|
||
} else if (strcmp(value, "bogus") == 0) {
|
||
event.xcirculate.place = 147;
|
||
} else {
|
||
Tcl_AppendResult(interp, "bad place \"", value, "\"",
|
||
(char *) NULL);
|
||
return TCL_ERROR;
|
||
}
|
||
} else if (strcmp(field, "-root") == 0) {
|
||
if (Tcl_GetInt(interp, value, &number) != TCL_OK) {
|
||
return TCL_ERROR;
|
||
}
|
||
event.xkey.root = number;
|
||
} else if (strcmp(field, "-rootx") == 0) {
|
||
if (Tcl_GetInt(interp, value, &number) != TCL_OK) {
|
||
return TCL_ERROR;
|
||
}
|
||
event.xkey.x_root = number;
|
||
} else if (strcmp(field, "-rooty") == 0) {
|
||
if (Tcl_GetInt(interp, value, &number) != TCL_OK) {
|
||
return TCL_ERROR;
|
||
}
|
||
event.xkey.y_root = number;
|
||
} else if (strcmp(field, "-sendevent") == 0) {
|
||
if (Tcl_GetInt(interp, value, &number) != TCL_OK) {
|
||
return TCL_ERROR;
|
||
}
|
||
event.xany.send_event = number;
|
||
} else if (strcmp(field, "-serial") == 0) {
|
||
if (Tcl_GetInt(interp, value, &number) != TCL_OK) {
|
||
return TCL_ERROR;
|
||
}
|
||
event.xany.serial = number;
|
||
} else if (strcmp(field, "-state") == 0) {
|
||
if (flags & KEY_BUTTON_MOTION) {
|
||
if (Tcl_GetInt(interp, value, &number) != TCL_OK) {
|
||
return TCL_ERROR;
|
||
}
|
||
event.xkey.state = number;
|
||
} else if (flags & CROSSING) {
|
||
if (Tcl_GetInt(interp, value, &number) != TCL_OK) {
|
||
return TCL_ERROR;
|
||
}
|
||
event.xcrossing.state = number;
|
||
} else if (flags & VISIBILITY) {
|
||
if (strcmp(value, "VisibilityUnobscured") == 0) {
|
||
number = VisibilityUnobscured;
|
||
} else if (strcmp(value, "VisibilityPartiallyObscured") == 0) {
|
||
number = VisibilityPartiallyObscured;
|
||
} else if (strcmp(value, "VisibilityFullyObscured") == 0) {
|
||
number = VisibilityFullyObscured;
|
||
} else {
|
||
Tcl_AppendResult(interp, "bad state \"", value, "\"",
|
||
(char *) NULL);
|
||
return TCL_ERROR;
|
||
}
|
||
event.xvisibility.state = number;
|
||
}
|
||
} else if (strcmp(field, "-subwindow") == 0) {
|
||
tkwin2 = Tk_NameToWindow(interp, value, main);
|
||
if (tkwin2 == NULL) {
|
||
return TCL_ERROR;
|
||
}
|
||
event.xkey.subwindow = Tk_WindowId(tkwin2);
|
||
} else if (strcmp(field, "-time") == 0) {
|
||
if (Tcl_GetInt(interp, value, &number) != TCL_OK) {
|
||
return TCL_ERROR;
|
||
}
|
||
if (flags & (KEY_BUTTON_MOTION|PROP|SEL_CLEAR)) {
|
||
event.xkey.time = (Time) number;
|
||
} else if (flags & SEL_REQ) {
|
||
event.xselectionrequest.time = (Time) number;
|
||
} else if (flags & SEL_NOTIFY) {
|
||
event.xselection.time = (Time) number;
|
||
}
|
||
} else if (strcmp(field, "-valueMask") == 0) {
|
||
if (Tcl_GetInt(interp, value, &number) != TCL_OK) {
|
||
return TCL_ERROR;
|
||
}
|
||
event.xconfigurerequest.value_mask = number;
|
||
} else if (strcmp(field, "-width") == 0) {
|
||
if (Tcl_GetInt(interp, value, &number) != TCL_OK) {
|
||
return TCL_ERROR;
|
||
}
|
||
if (flags & EXPOSE) {
|
||
event.xexpose.width = number;
|
||
} else if (flags & (CONFIG|CONFIG_REQ)) {
|
||
event.xconfigure.width = number;
|
||
} else if (flags & RESIZE_REQ) {
|
||
event.xresizerequest.width = number;
|
||
}
|
||
} else if (strcmp(field, "-window") == 0) {
|
||
tkwin2 = Tk_NameToWindow(interp, value, main);
|
||
if (tkwin2 == NULL) {
|
||
return TCL_ERROR;
|
||
}
|
||
event.xmap.window = Tk_WindowId(tkwin2);
|
||
} else if (strcmp(field, "-x") == 0) {
|
||
int rootX, rootY;
|
||
if (Tcl_GetInt(interp, value, &number) != TCL_OK) {
|
||
return TCL_ERROR;
|
||
}
|
||
Tk_GetRootCoords(tkwin, &rootX, &rootY);
|
||
rootX += number;
|
||
if (flags & KEY_BUTTON_MOTION) {
|
||
event.xkey.x = number;
|
||
event.xkey.x_root = rootX;
|
||
} else if (flags & EXPOSE) {
|
||
event.xexpose.x = number;
|
||
} else if (flags & (CREATE|CONFIG|GRAVITY|CONFIG_REQ)) {
|
||
event.xcreatewindow.x = number;
|
||
} else if (flags & REPARENT) {
|
||
event.xreparent.x = number;
|
||
} else if (flags & CROSSING) {
|
||
event.xcrossing.x = number;
|
||
event.xcrossing.x_root = rootY;
|
||
}
|
||
} else if (strcmp(field, "-y") == 0) {
|
||
int rootX, rootY;
|
||
if (Tcl_GetInt(interp, value, &number) != TCL_OK) {
|
||
return TCL_ERROR;
|
||
}
|
||
Tk_GetRootCoords(tkwin, &rootX, &rootY);
|
||
rootY += number;
|
||
if (flags & KEY_BUTTON_MOTION) {
|
||
event.xkey.y = number;
|
||
event.xkey.y_root = rootY;
|
||
} else if (flags & EXPOSE) {
|
||
event.xexpose.y = number;
|
||
} else if (flags & (CREATE|CONFIG|GRAVITY|CONFIG_REQ)) {
|
||
event.xcreatewindow.y = number;
|
||
} else if (flags & REPARENT) {
|
||
event.xreparent.y = number;
|
||
} else if (flags & CROSSING) {
|
||
event.xcrossing.y = number;
|
||
event.xcrossing.y_root = rootY;
|
||
}
|
||
} else {
|
||
Tcl_AppendResult(interp, "bad option \"", field, "\"",
|
||
(char *) NULL);
|
||
return TCL_ERROR;
|
||
}
|
||
}
|
||
Tk_HandleEvent(&event);
|
||
return TCL_OK;
|
||
}
|
||
|
||
/*
|
||
*----------------------------------------------------------------------
|
||
*
|
||
* TestmakeexistCmd --
|
||
*
|
||
* This procedure implements the "testmakeexist" command. It calls
|
||
* Tk_MakeWindowExist on each of its arguments to force the windows
|
||
* to be created.
|
||
*
|
||
* Results:
|
||
* A standard Tcl result.
|
||
*
|
||
* Side effects:
|
||
* Forces windows to be created.
|
||
*
|
||
*----------------------------------------------------------------------
|
||
*/
|
||
|
||
/* ARGSUSED */
|
||
static int
|
||
TestmakeexistCmd(clientData, interp, argc, argv)
|
||
ClientData clientData; /* Main window for application. */
|
||
Tcl_Interp *interp; /* Current interpreter. */
|
||
int argc; /* Number of arguments. */
|
||
char **argv; /* Argument strings. */
|
||
{
|
||
Tk_Window main = (Tk_Window) clientData;
|
||
int i;
|
||
Tk_Window tkwin;
|
||
|
||
for (i = 1; i < argc; i++) {
|
||
tkwin = Tk_NameToWindow(interp, argv[i], main);
|
||
if (tkwin == NULL) {
|
||
return TCL_ERROR;
|
||
}
|
||
Tk_MakeWindowExist(tkwin);
|
||
}
|
||
|
||
return TCL_OK;
|
||
}
|
||
|
||
/*
|
||
*----------------------------------------------------------------------
|
||
*
|
||
* ImageCreate --
|
||
*
|
||
* This procedure is called by the Tk image code to create "test"
|
||
* images.
|
||
*
|
||
* Results:
|
||
* A standard Tcl result.
|
||
*
|
||
* Side effects:
|
||
* The data structure for a new image is allocated.
|
||
*
|
||
*----------------------------------------------------------------------
|
||
*/
|
||
|
||
/* ARGSUSED */
|
||
static int
|
||
ImageCreate(interp, name, argc, argv, typePtr, master, clientDataPtr)
|
||
Tcl_Interp *interp; /* Interpreter for application containing
|
||
* image. */
|
||
char *name; /* Name to use for image. */
|
||
int argc; /* Number of arguments. */
|
||
char **argv; /* Argument strings for options (doesn't
|
||
* include image name or type). */
|
||
Tk_ImageType *typePtr; /* Pointer to our type record (not used). */
|
||
Tk_ImageMaster master; /* Token for image, to be used by us in
|
||
* later callbacks. */
|
||
ClientData *clientDataPtr; /* Store manager's token for image here;
|
||
* it will be returned in later callbacks. */
|
||
{
|
||
TImageMaster *timPtr;
|
||
char *varName;
|
||
int i;
|
||
|
||
varName = "log";
|
||
for (i = 0; i < argc; i += 2) {
|
||
if (strcmp(argv[i], "-variable") != 0) {
|
||
Tcl_AppendResult(interp, "bad option name \"", argv[i],
|
||
"\"", (char *) NULL);
|
||
return TCL_ERROR;
|
||
}
|
||
if ((i+1) == argc) {
|
||
Tcl_AppendResult(interp, "no value given for \"", argv[i],
|
||
"\" option", (char *) NULL);
|
||
return TCL_ERROR;
|
||
}
|
||
varName = argv[i+1];
|
||
}
|
||
timPtr = (TImageMaster *) ckalloc(sizeof(TImageMaster));
|
||
timPtr->master = master;
|
||
timPtr->interp = interp;
|
||
timPtr->width = 30;
|
||
timPtr->height = 15;
|
||
timPtr->imageName = (char *) ckalloc((unsigned) (strlen(name) + 1));
|
||
strcpy(timPtr->imageName, name);
|
||
timPtr->varName = (char *) ckalloc((unsigned) (strlen(varName) + 1));
|
||
strcpy(timPtr->varName, varName);
|
||
Tcl_CreateCommand(interp, name, ImageCmd, (ClientData) timPtr,
|
||
(Tcl_CmdDeleteProc *) NULL);
|
||
*clientDataPtr = (ClientData) timPtr;
|
||
Tk_ImageChanged(master, 0, 0, 30, 15, 30, 15);
|
||
return TCL_OK;
|
||
}
|
||
|
||
/*
|
||
*----------------------------------------------------------------------
|
||
*
|
||
* ImageCmd --
|
||
*
|
||
* This procedure implements the commands corresponding to individual
|
||
* images.
|
||
*
|
||
* Results:
|
||
* A standard Tcl result.
|
||
*
|
||
* Side effects:
|
||
* Forces windows to be created.
|
||
*
|
||
*----------------------------------------------------------------------
|
||
*/
|
||
|
||
/* ARGSUSED */
|
||
static int
|
||
ImageCmd(clientData, interp, argc, argv)
|
||
ClientData clientData; /* Main window for application. */
|
||
Tcl_Interp *interp; /* Current interpreter. */
|
||
int argc; /* Number of arguments. */
|
||
char **argv; /* Argument strings. */
|
||
{
|
||
TImageMaster *timPtr = (TImageMaster *) clientData;
|
||
int x, y, width, height;
|
||
|
||
if (argc < 2) {
|
||
Tcl_AppendResult(interp, "wrong # args: should be \"",
|
||
argv[0], "option ?arg arg ...?", (char *) NULL);
|
||
return TCL_ERROR;
|
||
}
|
||
if (strcmp(argv[1], "changed") == 0) {
|
||
if (argc != 8) {
|
||
Tcl_AppendResult(interp, "wrong # args: should be \"",
|
||
argv[0], " changed x y width height imageWidth imageHeight",
|
||
(char *) NULL);
|
||
return TCL_ERROR;
|
||
}
|
||
if ((Tcl_GetInt(interp, argv[2], &x) != TCL_OK)
|
||
|| (Tcl_GetInt(interp, argv[3], &y) != TCL_OK)
|
||
|| (Tcl_GetInt(interp, argv[4], &width) != TCL_OK)
|
||
|| (Tcl_GetInt(interp, argv[5], &height) != TCL_OK)
|
||
|| (Tcl_GetInt(interp, argv[6], &timPtr->width) != TCL_OK)
|
||
|| (Tcl_GetInt(interp, argv[7], &timPtr->height) != TCL_OK)) {
|
||
return TCL_ERROR;
|
||
}
|
||
Tk_ImageChanged(timPtr->master, x, y, width, height, timPtr->width,
|
||
timPtr->height);
|
||
} else {
|
||
Tcl_AppendResult(interp, "bad option \"", argv[1],
|
||
"\": must be changed", (char *) NULL);
|
||
return TCL_ERROR;
|
||
}
|
||
return TCL_OK;
|
||
}
|
||
|
||
/*
|
||
*----------------------------------------------------------------------
|
||
*
|
||
* ImageGet --
|
||
*
|
||
* This procedure is called by Tk to set things up for using a
|
||
* test image in a particular widget.
|
||
*
|
||
* Results:
|
||
* The return value is a token for the image instance, which is
|
||
* used in future callbacks to ImageDisplay and ImageFree.
|
||
*
|
||
* Side effects:
|
||
* None.
|
||
*
|
||
*----------------------------------------------------------------------
|
||
*/
|
||
|
||
static ClientData
|
||
ImageGet(tkwin, clientData)
|
||
Tk_Window tkwin; /* Token for window in which image will
|
||
* be used. */
|
||
ClientData clientData; /* Pointer to TImageMaster for image. */
|
||
{
|
||
TImageMaster *timPtr = (TImageMaster *) clientData;
|
||
TImageInstance *instPtr;
|
||
char buffer[100];
|
||
XGCValues gcValues;
|
||
|
||
sprintf(buffer, "%s get", timPtr->imageName);
|
||
Tcl_SetVar(timPtr->interp, timPtr->varName, buffer,
|
||
TCL_GLOBAL_ONLY|TCL_APPEND_VALUE|TCL_LIST_ELEMENT);
|
||
|
||
instPtr = (TImageInstance *) ckalloc(sizeof(TImageInstance));
|
||
instPtr->masterPtr = timPtr;
|
||
instPtr->fg = Tk_GetColor(timPtr->interp, tkwin, "#ff0000");
|
||
gcValues.foreground = instPtr->fg->pixel;
|
||
instPtr->gc = Tk_GetGC(tkwin, GCForeground, &gcValues);
|
||
return (ClientData) instPtr;
|
||
}
|
||
|
||
/*
|
||
*----------------------------------------------------------------------
|
||
*
|
||
* ImageDisplay --
|
||
*
|
||
* This procedure is invoked to redisplay part or all of an
|
||
* image in a given drawable.
|
||
*
|
||
* Results:
|
||
* None.
|
||
*
|
||
* Side effects:
|
||
* The image gets partially redrawn, as an "X" that shows the
|
||
* exact redraw area.
|
||
*
|
||
*----------------------------------------------------------------------
|
||
*/
|
||
|
||
static void
|
||
ImageDisplay(clientData, display, drawable, imageX, imageY, width, height,
|
||
drawableX, drawableY)
|
||
ClientData clientData; /* Pointer to TImageInstance for image. */
|
||
Display *display; /* Display to use for drawing. */
|
||
Drawable drawable; /* Where to redraw image. */
|
||
int imageX, imageY; /* Origin of area to redraw, relative to
|
||
* origin of image. */
|
||
int width, height; /* Dimensions of area to redraw. */
|
||
int drawableX, drawableY; /* Coordinates in drawable corresponding to
|
||
* imageX and imageY. */
|
||
{
|
||
TImageInstance *instPtr = (TImageInstance *) clientData;
|
||
char buffer[200];
|
||
|
||
sprintf(buffer, "%s display %d %d %d %d %d %d",
|
||
instPtr->masterPtr->imageName, imageX, imageY, width, height,
|
||
drawableX, drawableY);
|
||
Tcl_SetVar(instPtr->masterPtr->interp, instPtr->masterPtr->varName, buffer,
|
||
TCL_GLOBAL_ONLY|TCL_APPEND_VALUE|TCL_LIST_ELEMENT);
|
||
if (width > (instPtr->masterPtr->width - imageX)) {
|
||
width = instPtr->masterPtr->width - imageX;
|
||
}
|
||
if (height > (instPtr->masterPtr->height - imageY)) {
|
||
height = instPtr->masterPtr->height - imageY;
|
||
}
|
||
XDrawRectangle(display, drawable, instPtr->gc, drawableX, drawableY,
|
||
(unsigned) (width-1), (unsigned) (height-1));
|
||
XDrawLine(display, drawable, instPtr->gc, drawableX, drawableY,
|
||
(int) (drawableX + width - 1), (int) (drawableY + height - 1));
|
||
XDrawLine(display, drawable, instPtr->gc, drawableX,
|
||
(int) (drawableY + height - 1),
|
||
(int) (drawableX + width - 1), drawableY);
|
||
}
|
||
|
||
/*
|
||
*----------------------------------------------------------------------
|
||
*
|
||
* ImageFree --
|
||
*
|
||
* This procedure is called when an instance of an image is
|
||
* no longer used.
|
||
*
|
||
* Results:
|
||
* None.
|
||
*
|
||
* Side effects:
|
||
* Information related to the instance is freed.
|
||
*
|
||
*----------------------------------------------------------------------
|
||
*/
|
||
|
||
static void
|
||
ImageFree(clientData, display)
|
||
ClientData clientData; /* Pointer to TImageInstance for instance. */
|
||
Display *display; /* Display where image was to be drawn. */
|
||
{
|
||
TImageInstance *instPtr = (TImageInstance *) clientData;
|
||
char buffer[200];
|
||
|
||
sprintf(buffer, "%s free", instPtr->masterPtr->imageName);
|
||
Tcl_SetVar(instPtr->masterPtr->interp, instPtr->masterPtr->varName, buffer,
|
||
TCL_GLOBAL_ONLY|TCL_APPEND_VALUE|TCL_LIST_ELEMENT);
|
||
Tk_FreeColor(instPtr->fg);
|
||
Tk_FreeGC(display, instPtr->gc);
|
||
ckfree((char *) instPtr);
|
||
}
|
||
|
||
/*
|
||
*----------------------------------------------------------------------
|
||
*
|
||
* ImageDelete --
|
||
*
|
||
* This procedure is called to clean up a test image when
|
||
* an application goes away.
|
||
*
|
||
* Results:
|
||
* None.
|
||
*
|
||
* Side effects:
|
||
* Information about the image is deleted.
|
||
*
|
||
*----------------------------------------------------------------------
|
||
*/
|
||
|
||
static void
|
||
ImageDelete(clientData)
|
||
ClientData clientData; /* Pointer to TImageMaster for image. When
|
||
* this procedure is called, no more
|
||
* instances exist. */
|
||
{
|
||
TImageMaster *timPtr = (TImageMaster *) clientData;
|
||
char buffer[100];
|
||
|
||
sprintf(buffer, "%s delete", timPtr->imageName);
|
||
Tcl_SetVar(timPtr->interp, timPtr->varName, buffer,
|
||
TCL_GLOBAL_ONLY|TCL_APPEND_VALUE|TCL_LIST_ELEMENT);
|
||
|
||
Tcl_DeleteCommand(timPtr->interp, timPtr->imageName);
|
||
ckfree(timPtr->imageName);
|
||
ckfree(timPtr->varName);
|
||
ckfree((char *) timPtr);
|
||
}
|
||
|
||
/*
|
||
*----------------------------------------------------------------------
|
||
*
|
||
* TestsendCmd --
|
||
*
|
||
* This procedure implements the "testsend" command. It provides
|
||
* a set of functions for testing the "send" command and support
|
||
* procedure in tkSend.c.
|
||
*
|
||
* Results:
|
||
* A standard Tcl result.
|
||
*
|
||
* Side effects:
|
||
* Depends on option; see below.
|
||
*
|
||
*----------------------------------------------------------------------
|
||
*/
|
||
|
||
/* ARGSUSED */
|
||
static int
|
||
TestsendCmd(clientData, interp, argc, argv)
|
||
ClientData clientData; /* Main window for application. */
|
||
Tcl_Interp *interp; /* Current interpreter. */
|
||
int argc; /* Number of arguments. */
|
||
char **argv; /* Argument strings. */
|
||
{
|
||
TkWindow *winPtr = (TkWindow *) clientData;
|
||
|
||
if (argc < 2) {
|
||
Tcl_AppendResult(interp, "wrong # args; must be \"", argv[0],
|
||
" option ?arg ...?\"", (char *) NULL);
|
||
return TCL_ERROR;
|
||
}
|
||
|
||
#ifndef __WIN32__
|
||
if (strcmp(argv[1], "bogus") == 0) {
|
||
XChangeProperty(winPtr->dispPtr->display,
|
||
RootWindow(winPtr->dispPtr->display, 0),
|
||
winPtr->dispPtr->registryProperty, XA_INTEGER, 32,
|
||
PropModeReplace,
|
||
(unsigned char *) "This is bogus information", 6);
|
||
} else if (strcmp(argv[1], "prop") == 0) {
|
||
int result, actualFormat, length;
|
||
unsigned long bytesAfter;
|
||
Atom actualType, propName;
|
||
char *property, *p, *end;
|
||
Window w;
|
||
|
||
if ((argc != 4) && (argc != 5)) {
|
||
Tcl_AppendResult(interp, "wrong # args; must be \"", argv[0],
|
||
" prop window name ?value ?\"", (char *) NULL);
|
||
return TCL_ERROR;
|
||
}
|
||
if (strcmp(argv[2], "root") == 0) {
|
||
w = RootWindow(winPtr->dispPtr->display, 0);
|
||
} else if (strcmp(argv[2], "comm") == 0) {
|
||
w = Tk_WindowId(winPtr->dispPtr->commTkwin);
|
||
} else {
|
||
w = strtoul(argv[2], &end, 0);
|
||
}
|
||
propName = Tk_InternAtom((Tk_Window) winPtr, argv[3]);
|
||
if (argc == 4) {
|
||
property = NULL;
|
||
result = XGetWindowProperty(winPtr->dispPtr->display,
|
||
w, propName, 0, 100000, False, XA_STRING,
|
||
&actualType, &actualFormat, (unsigned long *) &length,
|
||
&bytesAfter, (unsigned char **) &property);
|
||
if ((result == Success) && (actualType != None)
|
||
&& (actualFormat == 8) && (actualType == XA_STRING)) {
|
||
for (p = property; (p-property) < length; p++) {
|
||
if (*p == 0) {
|
||
*p = '\n';
|
||
}
|
||
}
|
||
Tcl_SetResult(interp, property, TCL_VOLATILE);
|
||
}
|
||
if (property != NULL) {
|
||
XFree(property);
|
||
}
|
||
} else {
|
||
if (argv[4][0] == 0) {
|
||
XDeleteProperty(winPtr->dispPtr->display, w, propName);
|
||
} else {
|
||
for (p = argv[4]; *p != 0; p++) {
|
||
if (*p == '\n') {
|
||
*p = 0;
|
||
}
|
||
}
|
||
XChangeProperty(winPtr->dispPtr->display,
|
||
w, propName, XA_STRING, 8, PropModeReplace,
|
||
(unsigned char *) argv[4], p-argv[4]);
|
||
}
|
||
}
|
||
} else if (strcmp(argv[1], "serial") == 0) {
|
||
sprintf(interp->result, "%d", tkSendSerial+1);
|
||
} else {
|
||
Tcl_AppendResult(interp, "bad option \"", argv[1],
|
||
"\": must be bogus, prop, or serial", (char *) NULL);
|
||
return TCL_ERROR;
|
||
}
|
||
#endif
|
||
return TCL_OK;
|
||
}
|