summaryrefslogtreecommitdiffstats
path: root/generic/tkBind.c
diff options
context:
space:
mode:
Diffstat (limited to 'generic/tkBind.c')
-rw-r--r--generic/tkBind.c1267
1 files changed, 713 insertions, 554 deletions
diff --git a/generic/tkBind.c b/generic/tkBind.c
index 72bcd2e..e0daec8 100644
--- a/generic/tkBind.c
+++ b/generic/tkBind.c
@@ -5,13 +5,13 @@
* with X events or sequences of X events.
*
* Copyright (c) 1989-1994 The Regents of the University of California.
- * Copyright (c) 1994-1996 Sun Microsystems, Inc.
+ * Copyright (c) 1994-1997 Sun Microsystems, Inc.
* Copyright (c) 1998 by Scriptics Corporation.
*
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tkBind.c,v 1.5 1999/03/10 07:04:38 stanton Exp $
+ * RCS: @(#) $Id: tkBind.c,v 1.6 1999/04/16 01:51:10 stanton Exp $
*/
#include "tkPort.h"
@@ -344,6 +344,8 @@ typedef struct BindInfo {
PendingBinding *pendingList;/* The list of pending C bindings, kept in
* case a C or Tcl binding causes the target
* window to be deleted. */
+ int deleted; /* 1 the application has been deleted but
+ * the structure has been preserved. */
} BindInfo;
/*
@@ -378,6 +380,7 @@ static Tcl_HashTable nameTable; /* keyArray hashed by keysym name. */
*/
static int initialized = 0;
+TCL_DECLARE_MUTEX(bindMutex)
/*
* A hash table is kept to map from the string names of event
@@ -578,6 +581,20 @@ static int flagArray[TK_LASTEVENT] = {
};
/*
+ * The following table is used to map between the location where an
+ * generated event should be queued and the string used to specify the
+ * location.
+ */
+
+static TkStateMap queuePosition[] = {
+ {-1, "now"},
+ {TCL_QUEUE_HEAD, "head"},
+ {TCL_QUEUE_MARK, "mark"},
+ {TCL_QUEUE_TAIL, "tail"},
+ {-2, NULL}
+};
+
+/*
* The following tables are used as a two-way map between X's internal
* numeric values for fields in an XEvent and the strings used in Tcl. The
* tables are used both when constructing an XEvent from user input and
@@ -651,7 +668,8 @@ static int GetVirtualEvent _ANSI_ARGS_((Tcl_Interp *interp,
static Tk_Uid GetVirtualEventUid _ANSI_ARGS_((Tcl_Interp *interp,
char *virtString));
static int HandleEventGenerate _ANSI_ARGS_((Tcl_Interp *interp,
- Tk_Window main, int argc, char **argv));
+ Tk_Window main, int objc,
+ Tcl_Obj *CONST objv[]));
static void InitKeymapInfo _ANSI_ARGS_((TkDisplay *dispPtr));
static void InitVirtualEventTable _ANSI_ARGS_((
VirtualEventTable *vetPtr));
@@ -659,9 +677,14 @@ static PatSeq * MatchPatterns _ANSI_ARGS_((TkDisplay *dispPtr,
BindingTable *bindPtr, PatSeq *psPtr,
PatSeq *bestPtr, ClientData *objectPtr,
PatSeq **sourcePtrPtr));
+static int NameToWindow _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Window main, Tcl_Obj *objPtr,
+ Tk_Window *tkwinPtr));
static int ParseEventDescription _ANSI_ARGS_((Tcl_Interp *interp,
char **eventStringPtr, Pattern *patPtr,
unsigned long *eventMaskPtr));
+static void SetKeycodeAndState _ANSI_ARGS_((Tk_Window tkwin,
+ KeySym keySym, XEvent *eventPtr));
/*
* The following define is used as a short circuit for the callback
@@ -709,37 +732,41 @@ TkBindInit(mainPtr)
*/
if (!initialized) {
- Tcl_HashEntry *hPtr;
- ModInfo *modPtr;
- EventInfo *eiPtr;
- int dummy;
+ Tcl_MutexLock(&bindMutex);
+ if (!initialized) {
+ Tcl_HashEntry *hPtr;
+ ModInfo *modPtr;
+ EventInfo *eiPtr;
+ int dummy;
#ifdef REDO_KEYSYM_LOOKUP
- KeySymInfo *kPtr;
-
- Tcl_InitHashTable(&keySymTable, TCL_STRING_KEYS);
- Tcl_InitHashTable(&nameTable, TCL_ONE_WORD_KEYS);
- for (kPtr = keyArray; kPtr->name != NULL; kPtr++) {
- hPtr = Tcl_CreateHashEntry(&keySymTable, kPtr->name, &dummy);
- Tcl_SetHashValue(hPtr, kPtr->value);
- hPtr = Tcl_CreateHashEntry(&nameTable, (char *) kPtr->value,
- &dummy);
- Tcl_SetHashValue(hPtr, kPtr->name);
- }
+ KeySymInfo *kPtr;
+
+ Tcl_InitHashTable(&keySymTable, TCL_STRING_KEYS);
+ Tcl_InitHashTable(&nameTable, TCL_ONE_WORD_KEYS);
+ for (kPtr = keyArray; kPtr->name != NULL; kPtr++) {
+ hPtr = Tcl_CreateHashEntry(&keySymTable, kPtr->name, &dummy);
+ Tcl_SetHashValue(hPtr, kPtr->value);
+ hPtr = Tcl_CreateHashEntry(&nameTable, (char *) kPtr->value,
+ &dummy);
+ Tcl_SetHashValue(hPtr, kPtr->name);
+ }
#endif /* REDO_KEYSYM_LOOKUP */
- Tcl_InitHashTable(&modTable, TCL_STRING_KEYS);
- for (modPtr = modArray; modPtr->name != NULL; modPtr++) {
- hPtr = Tcl_CreateHashEntry(&modTable, modPtr->name, &dummy);
- Tcl_SetHashValue(hPtr, modPtr);
- }
+ Tcl_InitHashTable(&modTable, TCL_STRING_KEYS);
+ for (modPtr = modArray; modPtr->name != NULL; modPtr++) {
+ hPtr = Tcl_CreateHashEntry(&modTable, modPtr->name, &dummy);
+ Tcl_SetHashValue(hPtr, modPtr);
+ }
- Tcl_InitHashTable(&eventTable, TCL_STRING_KEYS);
- for (eiPtr = eventArray; eiPtr->name != NULL; eiPtr++) {
- hPtr = Tcl_CreateHashEntry(&eventTable, eiPtr->name, &dummy);
- Tcl_SetHashValue(hPtr, eiPtr);
+ Tcl_InitHashTable(&eventTable, TCL_STRING_KEYS);
+ for (eiPtr = eventArray; eiPtr->name != NULL; eiPtr++) {
+ hPtr = Tcl_CreateHashEntry(&eventTable, eiPtr->name, &dummy);
+ Tcl_SetHashValue(hPtr, eiPtr);
+ }
+ initialized = 1;
}
- initialized = 1;
+ Tcl_MutexUnlock(&bindMutex);
}
mainPtr->bindingTable = Tk_CreateBindingTable(mainPtr->interp);
@@ -750,6 +777,7 @@ TkBindInit(mainPtr)
bindInfoPtr->screenInfo.curScreenIndex = -1;
bindInfoPtr->screenInfo.bindingDepth = 0;
bindInfoPtr->pendingList = NULL;
+ bindInfoPtr->deleted = 0;
mainPtr->bindInfo = (TkBindInfo) bindInfoPtr;
TkpInitializeMenuBindings(mainPtr->interp, mainPtr->bindingTable);
@@ -783,6 +811,8 @@ TkBindFree(mainPtr)
bindInfoPtr = (BindInfo *) mainPtr->bindInfo;
DeleteVirtualEventTable(&bindInfoPtr->virtualEventTable);
+ bindInfoPtr->deleted = 1;
+ Tcl_EventuallyFree((ClientData) bindInfoPtr, Tcl_Free);
mainPtr->bindInfo = NULL;
}
@@ -897,7 +927,7 @@ Tk_DeleteBindingTable(bindingTable)
* Results:
* The return value is 0 if an error occurred while setting
* up the binding. In this case, an error message will be
- * left in interp->result. If all went well then the return
+ * left in the interp's result. If all went well then the return
* value is a mask of the event types that must be made
* available to Tk_BindEvent in order to properly detect when
* this binding triggers. This value can be used to determine
@@ -1002,7 +1032,7 @@ Tk_CreateBinding(interp, bindingTable, object, eventString, command, append)
* Results:
* The return value is 0 if an error occurred while setting
* up the binding. In this case, an error message will be
- * left in interp->result. If all went well then the return
+ * left in the interp's result. If all went well then the return
* value is a mask of the event types that must be made
* available to Tk_BindEvent in order to properly detect when
* this binding triggers. This value can be used to determine
@@ -1086,7 +1116,7 @@ TkCreateBindingProcedure(interp, bindingTable, object, eventString,
*
* Results:
* The result is a standard Tcl return value. If an error
- * occurs then interp->result will contain an error message.
+ * occurs then the interp's result will contain an error message.
*
* Side effects:
* The binding given by object and eventString is removed
@@ -1181,7 +1211,7 @@ Tk_DeleteBinding(interp, bindingTable, object, eventString)
* given by bindingTable. If there is no binding for
* eventString, or if eventString is improperly formed,
* then NULL is returned and an error message is left in
- * interp->result. The return value is semi-static: it
+ * the interp's result. The return value is semi-static: it
* will persist until the binding is changed or deleted.
*
* Side effects:
@@ -1224,7 +1254,7 @@ Tk_GetBinding(interp, bindingTable, object, eventString)
* associated with a given object.
*
* Results:
- * There is no return value. Interp->result is modified to
+ * There is no return value. The interp's result is modified to
* hold a Tcl list with one entry for each binding associated
* with object in bindingTable. Each entry in the list
* contains the event string associated with one binding.
@@ -1388,9 +1418,9 @@ Tk_BindEvent(bindingTable, eventPtr, tkwin, numObjects, objectPtr)
{
BindingTable *bindPtr;
TkDisplay *dispPtr;
+ ScreenInfo *screenPtr;
BindInfo *bindInfoPtr;
TkDisplay *oldDispPtr;
- ScreenInfo *screenPtr;
XEvent *ringPtr;
PatSeq *vMatchDetailList, *vMatchNoDetailList;
int flags, oldScreen, i, deferModal;
@@ -1621,12 +1651,12 @@ Tk_BindEvent(bindingTable, eventPtr, tkwin, numObjects, objectPtr)
unsigned int oldSize, newSize;
oldSize = sizeof(staticPending)
- - sizeof(staticPending.matchArray)
- + matchSpace * sizeof(PatSeq*);
+ - sizeof(staticPending.matchArray)
+ + matchSpace * sizeof(PatSeq*);
matchSpace *= 2;
newSize = sizeof(staticPending)
- - sizeof(staticPending.matchArray)
- + matchSpace * sizeof(PatSeq*);
+ - sizeof(staticPending.matchArray)
+ + matchSpace * sizeof(PatSeq*);
new = (PendingBinding *) ckalloc(newSize);
memcpy((VOID *) new, (VOID *) pendingPtr, oldSize);
if (pendingPtr != &staticPending) {
@@ -1657,7 +1687,7 @@ Tk_BindEvent(bindingTable, eventPtr, tkwin, numObjects, objectPtr)
*
* There are two tricks here:
* 1. Bindings can be invoked from in the middle of Tcl commands,
- * where interp->result is significant (for example, a widget
+ * where the interp's result is significant (for example, a widget
* might be deleted because of an error in creating it, so the
* result contains an error message that is eventually going to
* be returned by the creating command). To preserve the result,
@@ -1688,6 +1718,13 @@ Tk_BindEvent(bindingTable, eventPtr, tkwin, numObjects, objectPtr)
}
if (matchCount > 0) {
+ /*
+ * Remember the list of pending C binding callbacks, so we can mark
+ * them as deleted and not call them if the act of evaluating a C
+ * or Tcl binding deletes a C binding callback or even the whole
+ * window.
+ */
+
pendingPtr->nextPtr = bindInfoPtr->pendingList;
pendingPtr->tkwin = tkwin;
pendingPtr->deleted = 0;
@@ -1707,10 +1744,20 @@ Tk_BindEvent(bindingTable, eventPtr, tkwin, numObjects, objectPtr)
end = p + Tcl_DStringLength(&scripts);
i = 0;
+ /*
+ * Be carefule when dereferencing screenPtr or bindInfoPtr. If we
+ * evaluate something that destroys ".", bindInfoPtr would have been
+ * freed, but we can tell that by first checking to see if
+ * winPtr->mainPtr == NULL.
+ */
+
+ Tcl_Preserve((ClientData) bindInfoPtr);
while (p < end) {
int code;
- screenPtr->bindingDepth++;
+ if (!bindInfoPtr->deleted) {
+ screenPtr->bindingDepth++;
+ }
Tcl_AllowExceptions(interp);
if (*p == '\0') {
@@ -1736,7 +1783,10 @@ Tk_BindEvent(bindingTable, eventPtr, tkwin, numObjects, objectPtr)
p += strlen(p);
}
p++;
- screenPtr->bindingDepth--;
+
+ if (!bindInfoPtr->deleted) {
+ screenPtr->bindingDepth--;
+ }
if (code != TCL_OK) {
if (code == TCL_CONTINUE) {
/*
@@ -1766,8 +1816,8 @@ Tk_BindEvent(bindingTable, eventPtr, tkwin, numObjects, objectPtr)
}
}
- if ((screenPtr->bindingDepth != 0) &&
- ((oldDispPtr != screenPtr->curDispPtr)
+ if (!bindInfoPtr->deleted && (screenPtr->bindingDepth != 0)
+ && ((oldDispPtr != screenPtr->curDispPtr)
|| (oldScreen != screenPtr->curScreenIndex))) {
/*
@@ -1784,19 +1834,27 @@ Tk_BindEvent(bindingTable, eventPtr, tkwin, numObjects, objectPtr)
Tcl_DStringFree(&scripts);
if (matchCount > 0) {
- PendingBinding **curPtrPtr;
+ if (!bindInfoPtr->deleted) {
+ /*
+ * Delete the pending list from the list of pending scripts
+ * for this window.
+ */
+
+ PendingBinding **curPtrPtr;
- for (curPtrPtr = &bindInfoPtr->pendingList; ; ) {
- if (*curPtrPtr == pendingPtr) {
- *curPtrPtr = pendingPtr->nextPtr;
- break;
+ for (curPtrPtr = &bindInfoPtr->pendingList; ; ) {
+ if (*curPtrPtr == pendingPtr) {
+ *curPtrPtr = pendingPtr->nextPtr;
+ break;
+ }
+ curPtrPtr = &(*curPtrPtr)->nextPtr;
}
- curPtrPtr = &(*curPtrPtr)->nextPtr;
}
if (pendingPtr != &staticPending) {
ckfree((char *) pendingPtr);
}
}
+ Tcl_Release((ClientData) bindInfoPtr);
}
/*
@@ -2171,7 +2229,8 @@ MatchPatterns(dispPtr, bindPtr, psPtr, bestPtr, objectPtr, sourcePtrPtr)
bestPtr = matchPtr;
bestSourcePtr = sourcePtr;
- nextSequence: continue;
+ nextSequence:
+ continue;
}
*sourcePtrPtr = bestSourcePtr;
@@ -2215,8 +2274,11 @@ ExpandPercents(winPtr, before, eventPtr, keySym, dsPtr)
int number, flags, length;
#define NUM_SIZE 40
char *string;
+ Tcl_DString buf;
char numStorage[NUM_SIZE+1];
+ Tcl_DStringInit(&buf);
+
if (eventPtr->type < TK_LASTEVENT) {
flags = flagArray[eventPtr->type];
} else {
@@ -2250,8 +2312,10 @@ ExpandPercents(winPtr, before, eventPtr, keySym, dsPtr)
number = eventPtr->xany.serial;
goto doNumber;
case 'a':
- TkpPrintWindowId(numStorage, eventPtr->xconfigure.above);
- string = numStorage;
+ if (flags & CONFIG) {
+ TkpPrintWindowId(numStorage, eventPtr->xconfigure.above);
+ string = numStorage;
+ }
goto doString;
case 'b':
number = eventPtr->xbutton.button;
@@ -2365,37 +2429,8 @@ ExpandPercents(winPtr, before, eventPtr, keySym, dsPtr)
goto doNumber;
case 'A':
if (flags & KEY) {
- int numChars;
-
- /*
- * If we're using input methods and this is a keypress
- * event, invoke XmbTkFindStateString. Otherwise just use
- * the older XTkFindStateString.
- */
-
-#ifdef TK_USE_INPUT_METHODS
- Status status;
- if ((winPtr->inputContext != NULL)
- && (eventPtr->type == KeyPress)) {
- numChars = XmbLookupString(winPtr->inputContext,
- &eventPtr->xkey, numStorage, NUM_SIZE,
- (KeySym *) NULL, &status);
- if ((status != XLookupChars)
- && (status != XLookupBoth)) {
- numChars = 0;
- }
- } else {
- numChars = XLookupString(&eventPtr->xkey, numStorage,
- NUM_SIZE, (KeySym *) NULL,
- (XComposeStatus *) NULL);
- }
-#else /* TK_USE_INPUT_METHODS */
- numChars = XLookupString(&eventPtr->xkey, numStorage,
- NUM_SIZE, (KeySym *) NULL,
- (XComposeStatus *) NULL);
-#endif /* TK_USE_INPUT_METHODS */
- numStorage[numChars] = '\0';
- string = numStorage;
+ Tcl_DStringFree(&buf);
+ string = TkpGetString(winPtr, eventPtr, &buf);
}
goto doString;
case 'B':
@@ -2496,6 +2531,7 @@ ExpandPercents(winPtr, before, eventPtr, keySym, dsPtr)
Tcl_DStringSetLength(dsPtr, length + spaceNeeded);
before += 2;
}
+ Tcl_DStringFree(&buf);
}
/*
@@ -2528,7 +2564,7 @@ ChangeScreen(interp, dispName, screenIndex)
{
Tcl_DString cmd;
int code;
- char screen[30];
+ char screen[TCL_INTEGER_SPACE];
Tcl_DStringInit(&cmd);
Tcl_DStringAppend(&cmd, "tkScreenChanged ", 16);
@@ -2562,87 +2598,96 @@ ChangeScreen(interp, dispName, screenIndex)
*/
int
-Tk_EventCmd(clientData, interp, argc, argv)
- ClientData clientData; /* Main window associated with
- * interpreter. */
+Tk_EventObjCmd(clientData, interp, objc, objv)
+ ClientData clientData; /* Main window associated with interpreter. */
Tcl_Interp *interp; /* Current interpreter. */
- int argc; /* Number of arguments. */
- char **argv; /* Argument strings. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
{
- int i;
- size_t length;
- char *option;
+ int index;
Tk_Window tkwin;
VirtualEventTable *vetPtr;
TkBindInfo bindInfo;
-
- if (argc < 2) {
- Tcl_AppendResult(interp, "wrong # args: should be \"",
- argv[0], " option ?arg1?\"", (char *) NULL);
- return TCL_ERROR;
- }
-
- option = argv[1];
- length = strlen(option);
- if (length == 0) {
- goto badopt;
- }
+ static char *optionStrings[] = {
+ "add", "delete", "generate", "info",
+ NULL
+ };
+ enum options {
+ EVENT_ADD, EVENT_DELETE, EVENT_GENERATE, EVENT_INFO
+ };
tkwin = (Tk_Window) clientData;
bindInfo = ((TkWindow *) tkwin)->mainPtr->bindInfo;
vetPtr = &((BindInfo *) bindInfo)->virtualEventTable;
- if (strncmp(option, "add", length) == 0) {
- if (argc < 4) {
- Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
- " add virtual sequence ?sequence ...?\"", (char *) NULL);
- return TCL_ERROR;
- }
- for (i = 3; i < argc; i++) {
- if (CreateVirtualEvent(interp, vetPtr, argv[2], argv[i])
- != TCL_OK) {
+ if (objc < 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "option ?arg?");
+ return TCL_ERROR;
+ }
+ if (Tcl_GetIndexFromObj(interp, objv[1], optionStrings, "option", 0,
+ &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ switch ((enum options) index) {
+ case EVENT_ADD: {
+ int i;
+ char *name, *event;
+
+ if (objc < 4) {
+ Tcl_WrongNumArgs(interp, 2, objv,
+ "virtual sequence ?sequence ...?");
return TCL_ERROR;
}
+ name = Tcl_GetStringFromObj(objv[2], NULL);
+ for (i = 3; i < objc; i++) {
+ event = Tcl_GetStringFromObj(objv[i], NULL);
+ if (CreateVirtualEvent(interp, vetPtr, name, event) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ }
+ break;
}
- } else if (strncmp(option, "delete", length) == 0) {
- if (argc < 3) {
- Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
- " delete virtual ?sequence sequence ...?\"",
- (char *) NULL);
- return TCL_ERROR;
- }
- if (argc == 3) {
- return DeleteVirtualEvent(interp, vetPtr, argv[2], NULL);
- }
- for (i = 3; i < argc; i++) {
- if (DeleteVirtualEvent(interp, vetPtr, argv[2], argv[i])
- != TCL_OK) {
+ case EVENT_DELETE: {
+ int i;
+ char *name, *event;
+
+ if (objc < 3) {
+ Tcl_WrongNumArgs(interp, 2, objv,
+ "virtual ?sequence sequence ...?");
return TCL_ERROR;
}
+ name = Tcl_GetStringFromObj(objv[2], NULL);
+ if (objc == 3) {
+ return DeleteVirtualEvent(interp, vetPtr, name, NULL);
+ }
+ for (i = 3; i < objc; i++) {
+ event = Tcl_GetStringFromObj(objv[i], NULL);
+ if (DeleteVirtualEvent(interp, vetPtr, name, event) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ }
+ break;
}
- } else if (strncmp(option, "generate", length) == 0) {
- if (argc < 4) {
- Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
- " generate window event ?options?\"", (char *) NULL);
- return TCL_ERROR;
+ case EVENT_GENERATE: {
+ if (objc < 4) {
+ Tcl_WrongNumArgs(interp, 2, objv, "window event ?options?");
+ return TCL_ERROR;
+ }
+ return HandleEventGenerate(interp, tkwin, objc - 2, objv + 2);
}
- return HandleEventGenerate(interp, tkwin, argc - 2, argv + 2);
- } else if (strncmp(option, "info", length) == 0) {
- if (argc == 2) {
- GetAllVirtualEvents(interp, vetPtr);
- return TCL_OK;
- } else if (argc == 3) {
- return GetVirtualEvent(interp, vetPtr, argv[2]);
- } else {
- Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
- " info ?virtual?\"", (char *) NULL);
- return TCL_ERROR;
+ case EVENT_INFO: {
+ if (objc == 2) {
+ GetAllVirtualEvents(interp, vetPtr);
+ return TCL_OK;
+ } else if (objc == 3) {
+ return GetVirtualEvent(interp, vetPtr,
+ Tcl_GetStringFromObj(objv[2], NULL));
+ } else {
+ Tcl_WrongNumArgs(interp, 2, objv, "?virtual?");
+ return TCL_ERROR;
+ }
}
- } else {
- badopt:
- Tcl_AppendResult(interp, "bad option \"", argv[1],
- "\": should be add, delete, generate, info", (char *) NULL);
- return TCL_ERROR;
}
return TCL_OK;
}
@@ -2729,8 +2774,8 @@ DeleteVirtualEventTable(vetPtr)
* Results:
* The return value is TCL_ERROR if an error occured while
* creating the virtual binding. In this case, an error message
- * will be left in interp->result. If all went well then the return
- * value is TCL_OK.
+ * will be left in the interp's result. If all went well then the
+ * return value is TCL_OK.
*
* Side effects:
* The virtual event may cause future calls to Tk_BindEvent to
@@ -2835,7 +2880,7 @@ CreateVirtualEvent(interp, vetPtr, virtString, eventString)
*
* Results:
* The result is a standard Tcl return value. If an error
- * occurs then interp->result will contain an error message.
+ * occurs then the interp's result will contain an error message.
* It is not an error to attempt to delete a virtual event that
* does not exist or a definition that does not exist.
*
@@ -2887,7 +2932,10 @@ DeleteVirtualEvent(interp, vetPtr, virtString, eventString)
eventPSPtr = FindSequence(interp, &vetPtr->patternTable, NULL,
eventString, 0, 0, &eventMask);
if (eventPSPtr == NULL) {
- return (interp->result[0] != '\0') ? TCL_ERROR : TCL_OK;
+ char *string;
+
+ string = Tcl_GetStringResult(interp);
+ return (string[0] != '\0') ? TCL_ERROR : TCL_OK;
}
}
@@ -2989,12 +3037,12 @@ DeleteVirtualEvent(interp, vetPtr, virtString, eventString)
* given virtual event.
*
* Results:
- * The return value is TCL_OK and interp->result is filled with the
+ * The return value is TCL_OK and the interp's result is filled with the
* string representation of the physical events associated with the
* virtual event; if there are no physical events for the given virtual
- * event, interp->result is filled with and empty string. If the
+ * event, the interp's result is filled with and empty string. If the
* virtual event string is improperly formed, then TCL_ERROR is
- * returned and an error message is left in interp->result.
+ * returned and an error message is left in the interp's result.
*
* Side effects:
* None.
@@ -3046,7 +3094,7 @@ GetVirtualEvent(interp, vetPtr, virtString)
* event defined.
*
* Results:
- * There is no return value. Interp->result is modified to
+ * There is no return value. The interp's result is modified to
* hold a Tcl list with one entry for each virtual event in
* nameTable.
*
@@ -3115,56 +3163,72 @@ GetAllVirtualEvents(interp, vetPtr)
*---------------------------------------------------------------------------
*/
static int
-HandleEventGenerate(interp, mainwin, argc, argv)
- Tcl_Interp *interp; /* Interp for error messages and name lookup. */
- Tk_Window mainwin; /* Main window associated with interp. */
- int argc; /* Number of arguments. */
- char **argv; /* Argument strings. */
+HandleEventGenerate(interp, mainWin, objc, objv)
+ Tcl_Interp *interp; /* Interp for errors return and name lookup. */
+ Tk_Window mainWin; /* Main window associated with interp. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
{
+ XEvent event;
+ char *name, *p;
+ int count, flags, synch, i, number;
+ Tcl_QueuePosition pos;
Pattern pat;
- Tk_Window tkwin;
- char *p;
+ Tk_Window tkwin, tkwin2;
+ TkWindow *mainPtr;
unsigned long eventMask;
- int count, i, state, flags, synch;
- Tcl_QueuePosition pos;
- XEvent event;
+ static char *fieldStrings[] = {
+ "-when", "-above", "-borderwidth", "-button",
+ "-count", "-delta", "-detail", "-focus",
+ "-height",
+ "-keycode", "-keysym", "-mode", "-override",
+ "-place", "-root", "-rootx", "-rooty",
+ "-sendevent", "-serial", "-state", "-subwindow",
+ "-time", "-width", "-window", "-x",
+ "-y", NULL
+ };
+ enum field {
+ EVENT_WHEN, EVENT_ABOVE, EVENT_BORDER, EVENT_BUTTON,
+ EVENT_COUNT, EVENT_DELTA, EVENT_DETAIL, EVENT_FOCUS,
+ EVENT_HEIGHT,
+ EVENT_KEYCODE, EVENT_KEYSYM, EVENT_MODE, EVENT_OVERRIDE,
+ EVENT_PLACE, EVENT_ROOT, EVENT_ROOTX, EVENT_ROOTY,
+ EVENT_SEND, EVENT_SERIAL, EVENT_STATE, EVENT_SUBWINDOW,
+ EVENT_TIME, EVENT_WIDTH, EVENT_WINDOW, EVENT_X,
+ EVENT_Y
+ };
+
+ if (NameToWindow(interp, mainWin, objv[0], &tkwin) != TCL_OK) {
+ return TCL_ERROR;
+ }
- if (argv[0][0] == '.') {
- tkwin = Tk_NameToWindow(interp, argv[0], mainwin);
- if (tkwin == NULL) {
- return TCL_ERROR;
- }
- } else {
- if (TkpScanWindowId(NULL, argv[0], &i) != TCL_OK) {
- Tcl_AppendResult(interp, "bad window name/identifier \"",
- argv[0], "\"", (char *) NULL);
- return TCL_ERROR;
- }
- tkwin = Tk_IdToWindow(Tk_Display(mainwin), (Window) i);
- if ((tkwin == NULL) || (((TkWindow *) mainwin)->mainPtr
- != ((TkWindow *) tkwin)->mainPtr)) {
- Tcl_AppendResult(interp, "window id \"", argv[0],
- "\" doesn't exist in this application", (char *) NULL);
- return TCL_ERROR;
- }
+ mainPtr = (TkWindow *) mainWin;
+ if ((tkwin == NULL)
+ || (mainPtr->mainPtr != ((TkWindow *) tkwin)->mainPtr)) {
+ char *name;
+
+ name = Tcl_GetStringFromObj(objv[0], NULL);
+ Tcl_AppendResult(interp, "window id \"", name,
+ "\" doesn't exist in this application", (char *) NULL);
+ return TCL_ERROR;
}
- p = argv[1];
+ name = Tcl_GetStringFromObj(objv[1], NULL);
+
+ p = name;
+ eventMask = 0;
count = ParseEventDescription(interp, &p, &pat, &eventMask);
if (count == 0) {
return TCL_ERROR;
}
if (count != 1) {
- interp->result = "Double or Triple modifier not allowed";
+ Tcl_SetResult(interp, "Double or Triple modifier not allowed",
+ TCL_STATIC);
return TCL_ERROR;
}
if (*p != '\0') {
- interp->result = "only one event specification allowed";
- return TCL_ERROR;
- }
- if (argc & 1) {
- Tcl_AppendResult(interp, "value for \"", argv[argc - 1],
- "\" missing", (char *) NULL);
+ Tcl_SetResult(interp, "only one event specification allowed",
+ TCL_STATIC);
return TCL_ERROR;
}
@@ -3179,34 +3243,7 @@ HandleEventGenerate(interp, mainwin, argc, argv)
if (flags & (KEY_BUTTON_MOTION_VIRTUAL)) {
event.xkey.state = pat.needMods;
if ((flags & KEY) && (event.xany.type != MouseWheelEvent)) {
- /*
- * When mapping from a keysym to a keycode, need information about
- * the modifier state that should be used so that when they call
- * XKeycodeToKeysym taking into account the xkey.state, they will
- * get back the original keysym.
- */
-
- if (pat.detail.keySym == NoSymbol) {
- event.xkey.keycode = 0;
- } else {
- event.xkey.keycode = XKeysymToKeycode(event.xany.display,
- pat.detail.keySym);
- }
- if (event.xkey.keycode != 0) {
- for (state = 0; state < 4; state++) {
- if (XKeycodeToKeysym(event.xany.display,
- event.xkey.keycode, state) == pat.detail.keySym) {
- if (state & 1) {
- event.xkey.state |= ShiftMask;
- }
- if (state & 2) {
- TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr;
- event.xkey.state |= dispPtr->modeModMask;
- }
- break;
- }
- }
- }
+ SetKeycodeAndState(tkwin, pat.detail.keySym, &event);
} else if (flags & BUTTON) {
event.xbutton.button = pat.detail.button;
} else if (flags & VIRTUAL) {
@@ -3224,375 +3261,407 @@ HandleEventGenerate(interp, mainwin, argc, argv)
synch = 1;
pos = TCL_QUEUE_TAIL;
- for (i = 2; i < argc; i += 2) {
- char *field, *value;
- Tk_Window tkwin2;
- int number;
- KeySym keysym;
+ for (i = 2; i < objc; i += 2) {
+ Tcl_Obj *optionPtr, *valuePtr;
+ int index;
- field = argv[i];
- value = argv[i+1];
-
- if (strcmp(field, "-when") == 0) {
- if (strcmp(value, "now") == 0) {
- synch = 1;
- } else if (strcmp(value, "head") == 0) {
- pos = TCL_QUEUE_HEAD;
- synch = 0;
- } else if (strcmp(value, "mark") == 0) {
- pos = TCL_QUEUE_MARK;
- synch = 0;
- } else if (strcmp(value, "tail") == 0) {
- pos = TCL_QUEUE_TAIL;
+ optionPtr = objv[i];
+ valuePtr = objv[i + 1];
+
+ if (Tcl_GetIndexFromObj(interp, optionPtr, fieldStrings, "option",
+ TCL_EXACT, &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (objc & 1) {
+ /*
+ * This test occurs after Tcl_GetIndexFromObj() so that
+ * "event generate <Button> -xyz" will return the error message
+ * that "-xyz" is a bad option, rather than that the value
+ * for "-xyz" is missing.
+ */
+
+ Tcl_AppendResult(interp, "value for \"",
+ Tcl_GetStringFromObj(optionPtr, NULL), "\" missing",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ switch ((enum field) index) {
+ case EVENT_WHEN: {
+ pos = (Tcl_QueuePosition) TkFindStateNumObj(interp, optionPtr,
+ queuePosition, valuePtr);
+ if ((int) pos < -1) {
+ return TCL_ERROR;
+ }
synch = 0;
- } else {
- Tcl_AppendResult(interp, "bad position \"", value,
- "\": should be now, head, mark, tail", (char *) NULL);
- return TCL_ERROR;
+ if ((int) pos == -1) {
+ synch = 1;
+ }
+ break;
}
- } else if (strcmp(field, "-above") == 0) {
- if (value[0] == '.') {
- tkwin2 = Tk_NameToWindow(interp, value, mainwin);
- if (tkwin2 == NULL) {
+ case EVENT_ABOVE: {
+ if (NameToWindow(interp, tkwin, valuePtr, &tkwin2) != TCL_OK) {
return TCL_ERROR;
}
- number = Tk_WindowId(tkwin2);
- } else if (TkpScanWindowId(interp, value, &number)
- != TCL_OK) {
- return TCL_ERROR;
- }
- if (flags & CONFIG) {
- event.xconfigure.above = number;
- } else {
- goto badopt;
- }
- } else if (strcmp(field, "-borderwidth") == 0) {
- if (Tk_GetPixels(interp, tkwin, value, &number) != TCL_OK) {
- return TCL_ERROR;
- }
- if (flags & (CREATE|CONFIG)) {
- event.xcreatewindow.border_width = number;
- } else {
- goto badopt;
+ if (flags & CONFIG) {
+ event.xconfigure.above = Tk_WindowId(tkwin2);
+ } else {
+ goto badopt;
+ }
+ break;
}
- } else if (strcmp(field, "-button") == 0) {
- if (Tcl_GetInt(interp, value, &number) != TCL_OK) {
- return TCL_ERROR;
+ case EVENT_BORDER: {
+ if (Tk_GetPixelsFromObj(interp, tkwin, valuePtr, &number) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (flags & (CREATE|CONFIG)) {
+ event.xcreatewindow.border_width = number;
+ } else {
+ goto badopt;
+ }
+ break;
}
- if (flags & BUTTON) {
- event.xbutton.button = number;
- } else {
- goto badopt;
+ case EVENT_BUTTON: {
+ if (Tcl_GetIntFromObj(interp, valuePtr, &number) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (flags & BUTTON) {
+ event.xbutton.button = number;
+ } else {
+ goto badopt;
+ }
+ break;
}
- } else if (strcmp(field, "-count") == 0) {
- if (Tcl_GetInt(interp, value, &number) != TCL_OK) {
- return TCL_ERROR;
+ case EVENT_COUNT: {
+ if (Tcl_GetIntFromObj(interp, valuePtr, &number) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (flags & EXPOSE) {
+ event.xexpose.count = number;
+ } else {
+ goto badopt;
+ }
+ break;
}
- if (flags & EXPOSE) {
- event.xexpose.count = number;
- } else {
- goto badopt;
+ case EVENT_DELTA: {
+ if (Tcl_GetIntFromObj(interp, valuePtr, &number) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if ((flags & KEY) && (event.xkey.type == MouseWheelEvent)) {
+ event.xkey.keycode = number;
+ } else {
+ goto badopt;
+ }
+ break;
}
- } else if (strcmp(field, "-delta") == 0) {
- if (Tcl_GetInt(interp, value, &number) != TCL_OK) {
- return TCL_ERROR;
+ case EVENT_DETAIL: {
+ number = TkFindStateNumObj(interp, optionPtr, notifyDetail,
+ valuePtr);
+ if (number < 0) {
+ return TCL_ERROR;
+ }
+ if (flags & FOCUS) {
+ event.xfocus.detail = number;
+ } else if (flags & CROSSING) {
+ event.xcrossing.detail = number;
+ } else {
+ goto badopt;
+ }
+ break;
}
- if ((flags & KEY) && (event.xkey.type == MouseWheelEvent)) {
- event.xkey.keycode = number;
- } else {
- goto badopt;
+ case EVENT_FOCUS: {
+ if (Tcl_GetBooleanFromObj(interp, valuePtr, &number) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (flags & CROSSING) {
+ event.xcrossing.focus = number;
+ } else {
+ goto badopt;
+ }
+ break;
}
- } else if (strcmp(field, "-detail") == 0) {
- number = TkFindStateNum(interp, field, notifyDetail, value);
- if (number < 0) {
- return TCL_ERROR;
+ case EVENT_HEIGHT: {
+ if (Tk_GetPixelsFromObj(interp, tkwin, valuePtr, &number) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (flags & EXPOSE) {
+ event.xexpose.height = number;
+ } else if (flags & CONFIG) {
+ event.xconfigure.height = number;
+ } else {
+ goto badopt;
+ }
+ break;
}
- if (flags & FOCUS) {
- event.xfocus.detail = number;
- } else if (flags & CROSSING) {
- event.xcrossing.detail = number;
- } else {
- goto badopt;
+ case EVENT_KEYCODE: {
+ if (Tcl_GetIntFromObj(interp, valuePtr, &number) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if ((flags & KEY) && (event.xkey.type != MouseWheelEvent)) {
+ event.xkey.keycode = number;
+ } else {
+ goto badopt;
+ }
+ break;
}
- } else if (strcmp(field, "-focus") == 0) {
- if (Tcl_GetBoolean(interp, value, &number) != TCL_OK) {
- return TCL_ERROR;
+ case EVENT_KEYSYM: {
+ KeySym keysym;
+ char *value;
+
+ value = Tcl_GetStringFromObj(valuePtr, NULL);
+ keysym = TkStringToKeysym(value);
+ if (keysym == NoSymbol) {
+ Tcl_AppendResult(interp, "unknown keysym \"", value, "\"",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ SetKeycodeAndState(tkwin, keysym, &event);
+ if (event.xkey.keycode == 0) {
+ Tcl_AppendResult(interp, "no keycode for keysym \"", value,
+ "\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ if (!(flags & KEY) || (event.xkey.type == MouseWheelEvent)) {
+ goto badopt;
+ }
+ break;
}
- if (flags & CROSSING) {
- event.xcrossing.focus = number;
- } else {
- goto badopt;
+ case EVENT_MODE: {
+ number = TkFindStateNumObj(interp, optionPtr, notifyMode,
+ valuePtr);
+ if (number < 0) {
+ return TCL_ERROR;
+ }
+ if (flags & CROSSING) {
+ event.xcrossing.mode = number;
+ } else if (flags & FOCUS) {
+ event.xfocus.mode = number;
+ } else {
+ goto badopt;
+ }
+ break;
}
- } else if (strcmp(field, "-height") == 0) {
- if (Tk_GetPixels(interp, tkwin, value, &number) != TCL_OK) {
- return TCL_ERROR;
+ case EVENT_OVERRIDE: {
+ if (Tcl_GetBooleanFromObj(interp, valuePtr, &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 {
+ goto badopt;
+ }
+ break;
}
- if (flags & EXPOSE) {
- event.xexpose.height = number;
- } else if (flags & CONFIG) {
- event.xconfigure.height = number;
- } else {
- goto badopt;
+ case EVENT_PLACE: {
+ number = TkFindStateNumObj(interp, optionPtr, circPlace,
+ valuePtr);
+ if (number < 0) {
+ return TCL_ERROR;
+ }
+ if (flags & CIRC) {
+ event.xcirculate.place = number;
+ } else {
+ goto badopt;
+ }
+ break;
}
- } else if (strcmp(field, "-keycode") == 0) {
- if (Tcl_GetInt(interp, value, &number) != TCL_OK) {
- return TCL_ERROR;
+ case EVENT_ROOT: {
+ if (NameToWindow(interp, tkwin, valuePtr, &tkwin2) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (flags & (KEY_BUTTON_MOTION_VIRTUAL|CROSSING)) {
+ event.xkey.root = Tk_WindowId(tkwin2);
+ } else {
+ goto badopt;
+ }
+ break;
}
- if ((flags & KEY) && (event.xkey.type != MouseWheelEvent)) {
- event.xkey.keycode = number;
- } else {
- goto badopt;
+ case EVENT_ROOTX: {
+ if (Tk_GetPixelsFromObj(interp, tkwin, valuePtr, &number) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (flags & (KEY_BUTTON_MOTION_VIRTUAL|CROSSING)) {
+ event.xkey.x_root = number;
+ } else {
+ goto badopt;
+ }
+ break;
}
- } else if (strcmp(field, "-keysym") == 0) {
- keysym = TkStringToKeysym(value);
- if (keysym == NoSymbol) {
- Tcl_AppendResult(interp, "unknown keysym \"", value,
- "\"", (char *) NULL);
- return TCL_ERROR;
+ case EVENT_ROOTY: {
+ if (Tk_GetPixelsFromObj(interp, tkwin, valuePtr, &number) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (flags & (KEY_BUTTON_MOTION_VIRTUAL|CROSSING)) {
+ event.xkey.y_root = number;
+ } else {
+ goto badopt;
+ }
+ break;
}
- /*
- * When mapping from a keysym to a keycode, need information about
- * the modifier state that should be used so that when they call
- * XKeycodeToKeysym taking into account the xkey.state, they will
- * get back the original keysym.
- */
+ case EVENT_SEND: {
+ CONST char *value;
- number = XKeysymToKeycode(event.xany.display, keysym);
- if (number == 0) {
- Tcl_AppendResult(interp, "no keycode for keysym \"", value,
- "\"", (char *) NULL);
- return TCL_ERROR;
- }
- for (state = 0; state < 4; state++) {
- if (XKeycodeToKeysym(event.xany.display, (unsigned) number,
- state) == keysym) {
- if (state & 1) {
- event.xkey.state |= ShiftMask;
+ value = Tcl_GetStringFromObj(valuePtr, NULL);
+ if (isdigit(UCHAR(value[0]))) {
+ /*
+ * Allow arbitrary integer values for the field; they
+ * are needed by a few of the tests in the Tk test suite.
+ */
+
+ if (Tcl_GetIntFromObj(interp, valuePtr, &number)
+ != TCL_OK) {
+ return TCL_ERROR;
}
- if (state & 2) {
- TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr;
- event.xkey.state |= dispPtr->modeModMask;
+ } else {
+ if (Tcl_GetBooleanFromObj(interp, valuePtr, &number)
+ != TCL_OK) {
+ return TCL_ERROR;
}
- break;
}
- }
- if ((flags & KEY) && (event.xkey.type != MouseWheelEvent)) {
- event.xkey.keycode = number;
- } else {
- goto badopt;
- }
- } else if (strcmp(field, "-mode") == 0) {
- number = TkFindStateNum(interp, field, notifyMode, value);
- if (number < 0) {
- return TCL_ERROR;
- }
- if (flags & CROSSING) {
- event.xcrossing.mode = number;
- } else if (flags & FOCUS) {
- event.xfocus.mode = number;
- } else {
- goto badopt;
- }
- } else if (strcmp(field, "-override") == 0) {
- if (Tcl_GetBoolean(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 {
- goto badopt;
- }
- } else if (strcmp(field, "-place") == 0) {
- number = TkFindStateNum(interp, field, circPlace, value);
- if (number < 0) {
- return TCL_ERROR;
- }
- if (flags & CIRC) {
- event.xcirculate.place = number;
- } else {
- goto badopt;
+ event.xany.send_event = number;
+ break;
}
- } else if (strcmp(field, "-root") == 0) {
- if (value[0] == '.') {
- tkwin2 = Tk_NameToWindow(interp, value, mainwin);
- if (tkwin2 == NULL) {
+ case EVENT_SERIAL: {
+ if (Tcl_GetIntFromObj(interp, valuePtr, &number) != TCL_OK) {
return TCL_ERROR;
}
- number = Tk_WindowId(tkwin2);
- } else if (TkpScanWindowId(interp, value, &number)
- != TCL_OK) {
- return TCL_ERROR;
- }
- if (flags & (KEY_BUTTON_MOTION_VIRTUAL|CROSSING)) {
- event.xkey.root = number;
- } else {
- goto badopt;
- }
- } else if (strcmp(field, "-rootx") == 0) {
- if (Tk_GetPixels(interp, tkwin, value, &number) != TCL_OK) {
- return TCL_ERROR;
- }
- if (flags & (KEY_BUTTON_MOTION_VIRTUAL|CROSSING)) {
- event.xkey.x_root = number;
- } else {
- goto badopt;
- }
- } else if (strcmp(field, "-rooty") == 0) {
- if (Tk_GetPixels(interp, tkwin, value, &number) != TCL_OK) {
- return TCL_ERROR;
+ event.xany.serial = number;
+ break;
}
- if (flags & (KEY_BUTTON_MOTION_VIRTUAL|CROSSING)) {
- event.xkey.y_root = number;
- } else {
- goto badopt;
+ case EVENT_STATE: {
+ if (flags & (KEY_BUTTON_MOTION_VIRTUAL|CROSSING)) {
+ if (Tcl_GetIntFromObj(interp, valuePtr, &number)
+ != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (flags & (KEY_BUTTON_MOTION_VIRTUAL)) {
+ event.xkey.state = number;
+ } else {
+ event.xcrossing.state = number;
+ }
+ } else if (flags & VISIBILITY) {
+ number = TkFindStateNumObj(interp, optionPtr, visNotify,
+ valuePtr);
+ if (number < 0) {
+ return TCL_ERROR;
+ }
+ event.xvisibility.state = number;
+ } else {
+ goto badopt;
+ }
+ break;
}
- } else if (strcmp(field, "-sendevent") == 0) {
- if (isdigit(UCHAR(value[0]))) {
- /*
- * Allow arbitrary integer values for the field; they
- * are needed by a few of the tests in the Tk test suite.
- */
-
- if (Tcl_GetInt(interp, value, &number) != TCL_OK) {
+ case EVENT_SUBWINDOW: {
+ if (NameToWindow(interp, tkwin, valuePtr, &tkwin2) != TCL_OK) {
return TCL_ERROR;
}
- } else {
- if (Tcl_GetBoolean(interp, value, &number) != TCL_OK) {
- return TCL_ERROR;
+ if (flags & (KEY_BUTTON_MOTION_VIRTUAL|CROSSING)) {
+ event.xkey.subwindow = Tk_WindowId(tkwin2);
+ } else {
+ goto badopt;
}
+ break;
}
- 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_VIRTUAL|CROSSING)) {
- if (Tcl_GetInt(interp, value, &number) != TCL_OK) {
+ case EVENT_TIME: {
+ if (Tcl_GetIntFromObj(interp, valuePtr, &number) != TCL_OK) {
return TCL_ERROR;
}
- if (flags & (KEY_BUTTON_MOTION_VIRTUAL)) {
- event.xkey.state = number;
+ if (flags & (KEY_BUTTON_MOTION_VIRTUAL|CROSSING)) {
+ event.xkey.time = (Time) number;
+ } else if (flags & PROP) {
+ event.xproperty.time = (Time) number;
} else {
- event.xcrossing.state = number;
+ goto badopt;
}
- } else if (flags & VISIBILITY) {
- number = TkFindStateNum(interp, field, visNotify, value);
- if (number < 0) {
+ break;
+ }
+ case EVENT_WIDTH: {
+ if (Tk_GetPixelsFromObj(interp, tkwin, valuePtr, &number)
+ != TCL_OK) {
return TCL_ERROR;
}
- event.xvisibility.state = number;
- } else {
- goto badopt;
- }
- } else if (strcmp(field, "-subwindow") == 0) {
- if (value[0] == '.') {
- tkwin2 = Tk_NameToWindow(interp, value, mainwin);
- if (tkwin2 == NULL) {
- return TCL_ERROR;
+ if (flags & EXPOSE) {
+ event.xexpose.width = number;
+ } else if (flags & (CREATE|CONFIG)) {
+ event.xcreatewindow.width = number;
+ } else {
+ goto badopt;
}
- number = Tk_WindowId(tkwin2);
- } else if (TkpScanWindowId(interp, value, &number)
- != TCL_OK) {
- return TCL_ERROR;
- }
- if (flags & (KEY_BUTTON_MOTION_VIRTUAL|CROSSING)) {
- event.xkey.subwindow = number;
- } else {
- goto badopt;
- }
- } else if (strcmp(field, "-time") == 0) {
- if (Tcl_GetInt(interp, value, &number) != TCL_OK) {
- return TCL_ERROR;
- }
- if (flags & (KEY_BUTTON_MOTION_VIRTUAL|CROSSING)) {
- event.xkey.time = (Time) number;
- } else if (flags & PROP) {
- event.xproperty.time = (Time) number;
- } else {
- goto badopt;
- }
- } else if (strcmp(field, "-width") == 0) {
- if (Tk_GetPixels(interp, tkwin, value, &number) != TCL_OK) {
- return TCL_ERROR;
- }
- if (flags & EXPOSE) {
- event.xexpose.width = number;
- } else if (flags & (CREATE|CONFIG)) {
- event.xcreatewindow.width = number;
- } else {
- goto badopt;
+ break;
}
- } else if (strcmp(field, "-window") == 0) {
- if (value[0] == '.') {
- tkwin2 = Tk_NameToWindow(interp, value, mainwin);
- if (tkwin2 == NULL) {
+ case EVENT_WINDOW: {
+ if (NameToWindow(interp, tkwin, valuePtr, &tkwin2) != TCL_OK) {
return TCL_ERROR;
}
- number = Tk_WindowId(tkwin2);
- } else if (TkpScanWindowId(interp, value, &number)
- != TCL_OK) {
- return TCL_ERROR;
- }
- if (flags & (CREATE|DESTROY|UNMAP|MAP|REPARENT|CONFIG
- |GRAVITY|CIRC)) {
- event.xcreatewindow.window = number;
- } else {
- goto badopt;
- }
- } else if (strcmp(field, "-x") == 0) {
- int rootX, rootY;
- if (Tk_GetPixels(interp, tkwin, value, &number) != TCL_OK) {
- return TCL_ERROR;
- }
- Tk_GetRootCoords(tkwin, &rootX, &rootY);
- rootX += number;
- if (flags & (KEY_BUTTON_MOTION_VIRTUAL|CROSSING)) {
- event.xkey.x = number;
- event.xkey.x_root = rootX;
- } else if (flags & EXPOSE) {
- event.xexpose.x = number;
- } else if (flags & (CREATE|CONFIG|GRAVITY)) {
- event.xcreatewindow.x = number;
- } else if (flags & REPARENT) {
- event.xreparent.x = number;
- } else {
- goto badopt;
+ if (flags & (CREATE|DESTROY|UNMAP|MAP|REPARENT|CONFIG
+ |GRAVITY|CIRC)) {
+ event.xcreatewindow.window = Tk_WindowId(tkwin2);
+ } else {
+ goto badopt;
+ }
+ break;
}
- } else if (strcmp(field, "-y") == 0) {
- int rootX, rootY;
- if (Tk_GetPixels(interp, tkwin, value, &number) != TCL_OK) {
- return TCL_ERROR;
+ case EVENT_X: {
+ int rootX, rootY;
+
+ if (Tk_GetPixelsFromObj(interp, tkwin, valuePtr, &number)
+ != TCL_OK) {
+ return TCL_ERROR;
+ }
+ Tk_GetRootCoords(tkwin, &rootX, &rootY);
+ rootX += number;
+ if (flags & (KEY_BUTTON_MOTION_VIRTUAL|CROSSING)) {
+ event.xkey.x = number;
+ event.xkey.x_root = rootX;
+ } else if (flags & EXPOSE) {
+ event.xexpose.x = number;
+ } else if (flags & (CREATE|CONFIG|GRAVITY)) {
+ event.xcreatewindow.x = number;
+ } else if (flags & REPARENT) {
+ event.xreparent.x = number;
+ } else {
+ goto badopt;
+ }
+ break;
}
- Tk_GetRootCoords(tkwin, &rootX, &rootY);
- rootY += number;
- if (flags & (KEY_BUTTON_MOTION_VIRTUAL|CROSSING)) {
- event.xkey.y = number;
- event.xkey.y_root = rootY;
- } else if (flags & EXPOSE) {
- event.xexpose.y = number;
- } else if (flags & (CREATE|CONFIG|GRAVITY)) {
- event.xcreatewindow.y = number;
- } else if (flags & REPARENT) {
- event.xreparent.y = number;
- } else {
- goto badopt;
+ case EVENT_Y: {
+ int rootX, rootY;
+
+ if (Tk_GetPixelsFromObj(interp, tkwin, valuePtr, &number)
+ != TCL_OK) {
+ return TCL_ERROR;
+ }
+ Tk_GetRootCoords(tkwin, &rootX, &rootY);
+ rootY += number;
+ if (flags & (KEY_BUTTON_MOTION_VIRTUAL|CROSSING)) {
+ event.xkey.y = number;
+ event.xkey.y_root = rootY;
+ } else if (flags & EXPOSE) {
+ event.xexpose.y = number;
+ } else if (flags & (CREATE|CONFIG|GRAVITY)) {
+ event.xcreatewindow.y = number;
+ } else if (flags & REPARENT) {
+ event.xreparent.y = number;
+ } else {
+ goto badopt;
+ }
+ break;
}
- } else {
- badopt:
- Tcl_AppendResult(interp, "bad option to ", argv[1],
- " event: \"", field, "\"", (char *) NULL);
- return TCL_ERROR;
}
+ continue;
+
+ badopt:
+ Tcl_AppendResult(interp, name, " event doesn't accept \"",
+ Tcl_GetStringFromObj(optionPtr, NULL), "\" option", NULL);
+ return TCL_ERROR;
}
-
if (synch != 0) {
Tk_HandleEvent(&event);
} else {
@@ -3600,6 +3669,79 @@ HandleEventGenerate(interp, mainwin, argc, argv)
}
Tcl_ResetResult(interp);
return TCL_OK;
+
+}
+static int
+NameToWindow(interp, mainWin, objPtr, tkwinPtr)
+ Tcl_Interp *interp; /* Interp for error return and name lookup. */
+ Tk_Window mainWin; /* Main window of application. */
+ Tcl_Obj *objPtr; /* Contains name or id string of window. */
+ Tk_Window *tkwinPtr; /* Filled with token for window. */
+{
+ char *name;
+ Tk_Window tkwin;
+ int id;
+
+ name = Tcl_GetStringFromObj(objPtr, NULL);
+ if (name[0] == '.') {
+ tkwin = Tk_NameToWindow(interp, name, mainWin);
+ if (tkwin == NULL) {
+ return TCL_ERROR;
+ }
+ *tkwinPtr = tkwin;
+ } else {
+ if (TkpScanWindowId(NULL, name, &id) != TCL_OK) {
+ Tcl_AppendResult(interp, "bad window name/identifier \"",
+ name, "\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ *tkwinPtr = Tk_IdToWindow(Tk_Display(mainWin), (Window) id);
+ }
+ return TCL_OK;
+}
+
+/*
+ * When mapping from a keysym to a keycode, need
+ * information about the modifier state that should be used
+ * so that when they call XKeycodeToKeysym taking into
+ * account the xkey.state, they will get back the original
+ * keysym.
+ */
+
+static void
+SetKeycodeAndState(tkwin, keySym, eventPtr)
+ Tk_Window tkwin;
+ KeySym keySym;
+ XEvent *eventPtr;
+{
+ Display *display;
+ int state;
+ KeyCode keycode;
+
+ display = Tk_Display(tkwin);
+
+ if (keySym == NoSymbol) {
+ keycode = 0;
+ } else {
+ keycode = XKeysymToKeycode(display, keySym);
+ }
+ if (keycode != 0) {
+ for (state = 0; state < 4; state++) {
+ if (XKeycodeToKeysym(display, keycode, state) == keySym) {
+ if (state & 1) {
+ eventPtr->xkey.state |= ShiftMask;
+ }
+ if (state & 2) {
+ TkDisplay *dispPtr;
+
+ dispPtr = ((TkWindow *) tkwin)->dispPtr;
+ eventPtr->xkey.state |= dispPtr->modeModMask;
+ }
+ break;
+ }
+ }
+ }
+ eventPtr->xkey.keycode = keycode;
}
/*
@@ -3613,7 +3755,7 @@ HandleEventGenerate(interp, mainwin, argc, argv)
* Results:
* The return value is NULL if the virtual event string was
* not in the proper format. In this case, an error message
- * will be left in interp->result. Otherwise the return
+ * will be left in the interp's result. Otherwise the return
* value is a Tk_Uid that represents the virtual event.
*
* Side effects:
@@ -3659,7 +3801,7 @@ GetVirtualEventUid(interp, virtString)
* in patternTable that corresponds to eventString. If an error
* was found while parsing eventString, or if "create" is 0 and
* no pattern sequence previously existed, then NULL is returned
- * and interp->result contains a message describing the problem.
+ * and the interp's result contains a message describing the problem.
* If no pattern sequence previously existed for eventString, then
* a new one is created with a NULL command field. In a successful
* return, *maskPtr is filled in with a mask of the event types
@@ -3735,8 +3877,9 @@ FindSequence(interp, patternTablePtr, object, eventString, create,
if (eventMask & VirtualEventMask) {
if (allowVirtual == 0) {
- interp->result =
- "virtual event not allowed in definition of another virtual event";
+ Tcl_SetResult(interp,
+ "virtual event not allowed in definition of another virtual event",
+ TCL_STATIC);
return NULL;
}
virtualFound = 1;
@@ -3767,11 +3910,12 @@ FindSequence(interp, patternTablePtr, object, eventString, create,
*/
if (numPats == 0) {
- interp->result = "no events specified in binding";
+ Tcl_SetResult(interp, "no events specified in binding", TCL_STATIC);
return NULL;
}
if ((numPats > 1) && (virtualFound != 0)) {
- interp->result = "virtual events may not be composed";
+ Tcl_SetResult(interp, "virtual events may not be composed",
+ TCL_STATIC);
return NULL;
}
@@ -3797,6 +3941,14 @@ FindSequence(interp, patternTablePtr, object, eventString, create,
if (new) {
Tcl_DeleteHashEntry(hPtr);
}
+ /*
+ * No binding exists for the sequence, so return an empty error.
+ * This is a special error that the caller will check for in order
+ * to silently ignore this case. This is a hack that maintains
+ * backward compatibility for Tk_GetBinding but the various "bind"
+ * commands silently ignore missing bindings.
+ */
+
return NULL;
}
psPtr = (PatSeq *) ckalloc((unsigned) (sizeof(PatSeq)
@@ -3886,8 +4038,10 @@ ParseEventDescription(interp, eventStringPtr, patPtr,
if (isprint(UCHAR(*p))) {
patPtr->detail.keySym = *p;
} else {
- sprintf(interp->result,
- "bad ASCII character 0x%x", (unsigned char) *p);
+ char buf[64];
+
+ sprintf(buf, "bad ASCII character 0x%x", (unsigned char) *p);
+ Tcl_SetResult(interp, buf, TCL_VOLATILE);
return 0;
}
}
@@ -3927,11 +4081,13 @@ ParseEventDescription(interp, eventStringPtr, patPtr,
char *field = p + 1;
p = strchr(field, '>');
if (p == field) {
- interp->result = "virtual event \"<<>>\" is badly formed";
+ Tcl_SetResult(interp, "virtual event \"<<>>\" is badly formed",
+ TCL_STATIC);
return 0;
}
if ((p == NULL) || (p[1] != '>')) {
- interp->result = "missing \">\" in virtual binding";
+ Tcl_SetResult(interp, "missing \">\" in virtual binding",
+ TCL_STATIC);
return 0;
}
*p = '\0';
@@ -4018,7 +4174,8 @@ ParseEventDescription(interp, eventStringPtr, patPtr,
}
}
} else if (eventFlags == 0) {
- interp->result = "no event type or button # or keysym";
+ Tcl_SetResult(interp, "no event type or button # or keysym",
+ TCL_STATIC);
return 0;
}
@@ -4029,11 +4186,13 @@ ParseEventDescription(interp, eventStringPtr, patPtr,
while (*p != '\0') {
p++;
if (*p == '>') {
- interp->result = "extra characters after detail in binding";
+ Tcl_SetResult(interp,
+ "extra characters after detail in binding",
+ TCL_STATIC);
return 0;
}
}
- interp->result = "missing \">\" in binding";
+ Tcl_SetResult(interp, "missing \">\" in binding", TCL_STATIC);
return 0;
}
p++;
@@ -4108,7 +4267,7 @@ GetPatternString(psPtr, dsPtr)
Tcl_DString *dsPtr;
{
Pattern *patPtr;
- char c, buffer[10];
+ char c, buffer[TCL_INTEGER_SPACE];
int patsLeft, needMods;
ModInfo *modPtr;
EventInfo *eiPtr;
@@ -4529,7 +4688,7 @@ TkKeysymToString(keysym)
*
* Results:
* Returns the result of evaluating script, including both a standard
- * Tcl completion code and a string in interp->result.
+ * Tcl completion code and a string in the interp's result.
*
* Side effects:
* None.
generated by cgit v0.12 at 2024-07-17 04:52:10 (GMT)