summaryrefslogtreecommitdiffstats
path: root/generic/tkBind.c
diff options
context:
space:
mode:
Diffstat (limited to 'generic/tkBind.c')
-rw-r--r--generic/tkBind.c1055
1 files changed, 335 insertions, 720 deletions
diff --git a/generic/tkBind.c b/generic/tkBind.c
index c4f8226..9cd3b7b 100644
--- a/generic/tkBind.c
+++ b/generic/tkBind.c
@@ -14,7 +14,7 @@
#include "tkInt.h"
-#ifdef __WIN32__
+#ifdef _WIN32
#include "tkWinInt.h"
#elif defined(MAC_OSX_TK)
#include "tkMacOSXInt.h"
@@ -29,13 +29,10 @@
*
* Init/Free this package.
*
- * Tcl "bind" command (actually located in tkCmds.c).
- * "bind" command implementation.
- * "bind" implementation helpers.
+ * Tcl "bind" command (actually located in tkCmds.c) core implementation, plus
+ * helpers.
*
- * Tcl "event" command.
- * "event" command implementation.
- * "event" implementation helpers.
+ * Tcl "event" command implementation, plus helpers.
*
* Package-specific common helpers.
*
@@ -79,7 +76,7 @@ typedef union {
*/
#define EVENT_BUFFER_SIZE 30
-typedef struct BindingTable {
+typedef struct Tk_BindingTable_ {
XEvent eventRing[EVENT_BUFFER_SIZE];
/* Circular queue of recent events (higher
* indices are for more recent events). */
@@ -108,12 +105,12 @@ typedef struct BindingTable {
*
* A virtual event is usually never part of the event stream, but instead is
* synthesized inline by matching low-level events. However, a virtual event
- * may be generated by platform-specific code or by Tcl scripts. In that case,
+ * may be generated by platform-specific code or by Tcl commands. In that case,
* no lookup of the virtual event will need to be done using this table,
* because the virtual event is actually in the event stream.
*/
-typedef struct VirtualEventTable {
+typedef struct {
Tcl_HashTable patternTable; /* Used to map from a physical event to a list
* of patterns that may match that event. Keys
* are PatternTableKey structs, values are
@@ -140,7 +137,7 @@ typedef struct VirtualEventTable {
* tables and virtual event tables.
*/
-typedef struct PatternTableKey {
+typedef struct {
ClientData object; /* For binding table, identifies the binding
* tag of the object (or class of objects)
* relative to which the event occurred. For
@@ -156,7 +153,7 @@ typedef struct PatternTableKey {
* events as part of the process of converting X events into Tcl commands.
*/
-typedef struct TkPattern {
+typedef struct {
int eventType; /* Type of X event, e.g. ButtonPress. */
int needMods; /* Mask of modifiers that must be present (0
* means no modifiers are required). */
@@ -193,21 +190,10 @@ typedef struct TkPattern {
typedef struct PatSeq {
int numPats; /* Number of patterns in sequence (usually
* 1). */
- TkBindEvalProc *eventProc; /* The function that will be invoked on the
- * clientData when this pattern sequence
- * matches. */
- TkBindFreeProc *freeProc; /* The function that will be invoked to
- * release the clientData when this pattern
- * sequence is freed. */
- ClientData clientData; /* Arbitray data passed to eventProc and
- * freeProc when sequence matches. */
+ char *script; /* Binding script to evaluate when sequence
+ * matches (ckalloc()ed) */
int flags; /* Miscellaneous flag values; see below for
* definitions. */
- int refCount; /* Number of times that this binding is in the
- * midst of executing. If greater than 1, then
- * a recursive invocation is happening. Only
- * when this is zero can the binding actually
- * be freed. */
struct PatSeq *nextSeqPtr; /* Next in list of all pattern sequences that
* have the same initial pattern. NULL means
* end of list. */
@@ -238,16 +224,9 @@ typedef struct PatSeq {
* must occur with nearby X and Y mouse coordinates and
* close in time. This is typically used to restrict
* multiple button presses.
- * MARKED_DELETED 1 means that this binding has been marked as deleted
- * and removed from the binding table, but its memory
- * could not be released because it was already queued
- * for execution. When the binding is actually about to
- * be executed, this flag will be checked and the binding
- * skipped if set.
*/
#define PAT_NEARBY 0x1
-#define MARKED_DELETED 0x2
/*
* Constants that define how close together two events must be in milliseconds
@@ -275,7 +254,7 @@ typedef struct VirtualOwners {
* to associate a virtual event with all the physical events that can trigger
* it.
*/
-typedef struct PhysicalsOwned {
+typedef struct {
int numOwned; /* Number of physical events owned. */
PatSeq *patSeqs[1]; /* Array of pointers to physical event
* patterns. Enough space will actually be
@@ -285,7 +264,7 @@ typedef struct PhysicalsOwned {
/*
* One of the following structures exists for each interpreter. This structure
* keeps track of the current display and screen in the interpreter, so that a
- * script can be invoked whenever the display/screen changes (the script does
+ * command can be invoked whenever the display/screen changes (the command does
* things like point tk::Priv at a display-specific structure).
*/
@@ -298,44 +277,17 @@ typedef struct {
} ScreenInfo;
/*
- * The following structure is used to keep track of all the C bindings that
- * are awaiting invocation and whether the window they refer to has been
- * destroyed. If the window is destroyed, then all pending callbacks for that
- * window will be cancelled. The Tcl bindings will still all be invoked,
- * however.
- */
-
-typedef struct PendingBinding {
- struct PendingBinding *nextPtr;
- /* Next in chain of pending bindings, in case
- * a recursive binding evaluation is in
- * progress. */
- Tk_Window tkwin; /* The window that the following bindings
- * depend upon. */
- int deleted; /* Set to non-zero by window cleanup code if
- * tkwin is deleted. */
- PatSeq *matchArray[5]; /* Array of pending C bindings. The actual
- * size of this depends on how many C bindings
- * matched the event passed to Tk_BindEvent.
- * THIS FIELD MUST BE THE LAST IN THE
- * STRUCTURE. */
-} PendingBinding;
-
-/*
* The following structure keeps track of all the information local to the
* binding package on a per interpreter basis.
*/
-typedef struct BindInfo {
+typedef struct TkBindInfo_ {
VirtualEventTable virtualEventTable;
/* The virtual events that exist in this
* interpreter. */
ScreenInfo screenInfo; /* Keeps track of the current display and
* screen, so it can be restored after a
* binding has executed. */
- 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;
@@ -352,10 +304,10 @@ typedef struct BindInfo {
#ifdef REDO_KEYSYM_LOOKUP
typedef struct {
- char *name; /* Name of keysym. */
+ const char *name; /* Name of keysym. */
KeySym value; /* Numeric identifier for keysym. */
} KeySymInfo;
-static KeySymInfo keyArray[] = {
+static const KeySymInfo keyArray[] = {
#ifndef lint
#include "ks_names.h"
#endif
@@ -381,7 +333,7 @@ TCL_DECLARE_MUTEX(bindMutex)
*/
typedef struct {
- char *name; /* Name of modifier. */
+ const char *name; /* Name of modifier. */
int mask; /* Button/modifier mask value, such as
* Button1Mask. */
int flags; /* Various flags; see below for
@@ -405,7 +357,7 @@ typedef struct {
#define QUADRUPLE 4
#define MULT_CLICKS 7
-static ModInfo modArray[] = {
+static const ModInfo modArray[] = {
{"Control", ControlMask, 0},
{"Shift", ShiftMask, 0},
{"Lock", LockMask, 0},
@@ -450,7 +402,7 @@ static Tcl_HashTable modTable;
*/
typedef struct {
- char *name; /* Name of event. */
+ const char *name; /* Name of event. */
int type; /* Event type for X, such as ButtonPress. */
int eventMask; /* Mask bits (for XSelectInput) for this event
* type. */
@@ -463,7 +415,7 @@ typedef struct {
* unless you've asked about button events.
*/
-static EventInfo eventArray[] = {
+static const EventInfo eventArray[] = {
{"Key", KeyPress, KeyPressMask},
{"KeyPress", KeyPress, KeyPressMask},
{"KeyRelease", KeyRelease, KeyPressMask|KeyReleaseMask},
@@ -535,7 +487,7 @@ static Tcl_HashTable eventTable;
#define KEY_BUTTON_MOTION_VIRTUAL (KEY|BUTTON|MOTION|VIRTUAL)
#define KEY_BUTTON_MOTION_CROSSING (KEY|BUTTON|MOTION|VIRTUAL|CROSSING)
-static int flagArray[TK_LASTEVENT] = {
+static const int flagArray[TK_LASTEVENT] = {
/* Not used */ 0,
/* Not used */ 0,
/* KeyPress */ KEY,
@@ -654,15 +606,14 @@ static void ChangeScreen(Tcl_Interp *interp, char *dispName,
int screenIndex);
static int CreateVirtualEvent(Tcl_Interp *interp,
VirtualEventTable *vetPtr, char *virtString,
- char *eventString);
+ const char *eventString);
static int DeleteVirtualEvent(Tcl_Interp *interp,
VirtualEventTable *vetPtr, char *virtString,
- char *eventString);
+ const char *eventString);
static void DeleteVirtualEventTable(VirtualEventTable *vetPtr);
static void ExpandPercents(TkWindow *winPtr, const char *before,
XEvent *eventPtr,KeySym keySym,
unsigned int scriptCount, Tcl_DString *dsPtr);
-static void FreeTclBinding(ClientData clientData);
static PatSeq * FindSequence(Tcl_Interp *interp,
Tcl_HashTable *patternTablePtr, ClientData object,
const char *eventString, int create,
@@ -670,9 +621,9 @@ static PatSeq * FindSequence(Tcl_Interp *interp,
static void GetAllVirtualEvents(Tcl_Interp *interp,
VirtualEventTable *vetPtr);
static char * GetField(char *p, char *copy, int size);
-static void GetPatternString(PatSeq *psPtr, Tcl_DString *dsPtr);
+static Tcl_Obj * GetPatternObj(PatSeq *psPtr);
static int GetVirtualEvent(Tcl_Interp *interp,
- VirtualEventTable *vetPtr, char *virtString);
+ VirtualEventTable *vetPtr, Tcl_Obj *virtName);
static Tk_Uid GetVirtualEventUid(Tcl_Interp *interp,
char *virtString);
static int HandleEventGenerate(Tcl_Interp *interp, Tk_Window main,
@@ -688,15 +639,6 @@ static int ParseEventDescription(Tcl_Interp *interp,
const char **eventStringPtr, TkPattern *patPtr,
unsigned long *eventMaskPtr);
static void DoWarp(ClientData clientData);
-
-/*
- * The following define is used as a short circuit for the callback function
- * to evaluate a TclBinding. The actual evaluation of the binding is handled
- * inline, because special things have to be done with a Tcl binding before
- * evaluation time.
- */
-
-#define EvalTclBinding ((TkBindEvalProc *) 1)
/*
*---------------------------------------------------------------------------
@@ -735,11 +677,11 @@ TkBindInit(
Tcl_MutexLock(&bindMutex);
if (!initialized) {
Tcl_HashEntry *hPtr;
- ModInfo *modPtr;
- EventInfo *eiPtr;
+ const ModInfo *modPtr;
+ const EventInfo *eiPtr;
int newEntry;
#ifdef REDO_KEYSYM_LOOKUP
- KeySymInfo *kPtr;
+ const KeySymInfo *kPtr;
Tcl_InitHashTable(&keySymTable, TCL_STRING_KEYS);
Tcl_InitHashTable(&nameTable, TCL_ONE_WORD_KEYS);
@@ -772,14 +714,13 @@ TkBindInit(
mainPtr->bindingTable = Tk_CreateBindingTable(mainPtr->interp);
- bindInfoPtr = (BindInfo *) ckalloc(sizeof(BindInfo));
+ bindInfoPtr = ckalloc(sizeof(BindInfo));
InitVirtualEventTable(&bindInfoPtr->virtualEventTable);
bindInfoPtr->screenInfo.curDispPtr = NULL;
bindInfoPtr->screenInfo.curScreenIndex = -1;
bindInfoPtr->screenInfo.bindingDepth = 0;
- bindInfoPtr->pendingList = NULL;
bindInfoPtr->deleted = 0;
- mainPtr->bindInfo = (TkBindInfo) bindInfoPtr;
+ mainPtr->bindInfo = bindInfoPtr;
TkpInitializeMenuBindings(mainPtr->interp, mainPtr->bindingTable);
}
@@ -810,10 +751,10 @@ TkBindFree(
Tk_DeleteBindingTable(mainPtr->bindingTable);
mainPtr->bindingTable = NULL;
- bindInfoPtr = (BindInfo *) mainPtr->bindInfo;
+ bindInfoPtr = mainPtr->bindInfo;
DeleteVirtualEventTable(&bindInfoPtr->virtualEventTable);
bindInfoPtr->deleted = 1;
- Tcl_EventuallyFree((ClientData) bindInfoPtr, TCL_DYNAMIC);
+ Tcl_EventuallyFree(bindInfoPtr, TCL_DYNAMIC);
mainPtr->bindInfo = NULL;
}
@@ -840,14 +781,13 @@ Tk_CreateBindingTable(
* table: commands are executed in this
* interpreter. */
{
- BindingTable *bindPtr;
+ BindingTable *bindPtr = ckalloc(sizeof(BindingTable));
int i;
/*
* Create and initialize a new binding table.
*/
- bindPtr = (BindingTable *) ckalloc(sizeof(BindingTable));
for (i = 0; i < EVENT_BUFFER_SIZE; i++) {
bindPtr->eventRing[i].type = -1;
}
@@ -856,7 +796,7 @@ Tk_CreateBindingTable(
sizeof(PatternTableKey)/sizeof(int));
Tcl_InitHashTable(&bindPtr->objectTable, TCL_ONE_WORD_KEYS);
bindPtr->interp = interp;
- return (Tk_BindingTable) bindPtr;
+ return bindPtr;
}
/*
@@ -878,10 +818,8 @@ Tk_CreateBindingTable(
void
Tk_DeleteBindingTable(
- Tk_BindingTable bindingTable)
- /* Token for the binding table to destroy. */
+ Tk_BindingTable bindPtr) /* Token for the binding table to destroy. */
{
- BindingTable *bindPtr = (BindingTable *) bindingTable;
PatSeq *psPtr, *nextPtr;
Tcl_HashEntry *hPtr;
Tcl_HashSearch search;
@@ -892,16 +830,10 @@ Tk_DeleteBindingTable(
for (hPtr = Tcl_FirstHashEntry(&bindPtr->patternTable, &search);
hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
- for (psPtr = (PatSeq *) Tcl_GetHashValue(hPtr);
- psPtr != NULL; psPtr = nextPtr) {
+ for (psPtr = Tcl_GetHashValue(hPtr); psPtr != NULL; psPtr = nextPtr) {
nextPtr = psPtr->nextSeqPtr;
- psPtr->flags |= MARKED_DELETED;
- if (psPtr->refCount == 0) {
- if (psPtr->freeProc != NULL) {
- (*psPtr->freeProc)(psPtr->clientData);
- }
- ckfree((char *) psPtr);
- }
+ ckfree(psPtr->script);
+ ckfree(psPtr);
}
}
@@ -911,7 +843,7 @@ Tk_DeleteBindingTable(
Tcl_DeleteHashTable(&bindPtr->patternTable);
Tcl_DeleteHashTable(&bindPtr->objectTable);
- ckfree((char *) bindPtr);
+ ckfree(bindPtr);
}
/*
@@ -941,13 +873,12 @@ Tk_DeleteBindingTable(
unsigned long
Tk_CreateBinding(
Tcl_Interp *interp, /* Used for error reporting. */
- Tk_BindingTable bindingTable,
- /* Table in which to create binding. */
+ Tk_BindingTable bindPtr, /* Table in which to create binding. */
ClientData object, /* Token for object with which binding is
* associated. */
const char *eventString, /* String describing event sequence that
* triggers binding. */
- const char *command, /* Contains Tcl command to execute when
+ const char *script, /* Contains Tcl script to execute when
* binding triggers. */
int append) /* 0 means replace any existing binding for
* eventString; 1 means append to that
@@ -956,12 +887,11 @@ Tk_CreateBinding(
* string, the existing binding will always be
* replaced. */
{
- BindingTable *bindPtr = (BindingTable *) bindingTable;
PatSeq *psPtr;
unsigned long eventMask;
char *newStr, *oldStr;
- if (!*command) {
+ if (!*script) {
/* Silently ignore empty scripts -- see SF#3006842 */
return 1;
}
@@ -970,7 +900,7 @@ Tk_CreateBinding(
if (psPtr == NULL) {
return 0;
}
- if (psPtr->eventProc == NULL) {
+ if (psPtr->script == NULL) {
int isNew;
Tcl_HashEntry *hPtr;
@@ -985,120 +915,29 @@ Tk_CreateBinding(
if (isNew) {
psPtr->nextObjPtr = NULL;
} else {
- psPtr->nextObjPtr = (PatSeq *) Tcl_GetHashValue(hPtr);
+ psPtr->nextObjPtr = Tcl_GetHashValue(hPtr);
}
Tcl_SetHashValue(hPtr, psPtr);
- } else if (psPtr->eventProc != EvalTclBinding) {
- /*
- * Free existing procedural binding.
- */
-
- if (psPtr->freeProc != NULL) {
- (*psPtr->freeProc)(psPtr->clientData);
- }
- psPtr->clientData = NULL;
- append = 0;
}
- oldStr = (char *) psPtr->clientData;
+ oldStr = psPtr->script;
if ((append != 0) && (oldStr != NULL)) {
- size_t length;
+ size_t length1 = strlen(oldStr), length2 = strlen(script);
- length = strlen(oldStr) + strlen(command) + 2;
- newStr = (char *) ckalloc((unsigned) length);
- sprintf(newStr, "%s\n%s", oldStr, command);
+ newStr = ckalloc(length1 + length2 + 2);
+ memcpy(newStr, oldStr, length1);
+ newStr[length1] = '\n';
+ memcpy(newStr+length1+1, script, length2+1);
} else {
- newStr = (char *) ckalloc((unsigned) strlen(command) + 1);
- strcpy(newStr, command);
+ size_t length = strlen(script);
+
+ newStr = ckalloc(length + 1);
+ memcpy(newStr, script, length+1);
}
if (oldStr != NULL) {
ckfree(oldStr);
}
- psPtr->eventProc = EvalTclBinding;
- psPtr->freeProc = FreeTclBinding;
- psPtr->clientData = (ClientData) newStr;
- return eventMask;
-}
-
-/*
- *---------------------------------------------------------------------------
- *
- * TkCreateBindingProcedure --
- *
- * Add a C binding to a binding table, so that future calls to
- * Tk_BindEvent may callback the function in the binding.
- *
- * 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 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
- * what events to select for in a window, for example.
- *
- * Side effects:
- * Any existing binding on the same event sequence will be replaced.
- *
- *---------------------------------------------------------------------------
- */
-
-unsigned long
-TkCreateBindingProcedure(
- Tcl_Interp *interp, /* Used for error reporting. */
- Tk_BindingTable bindingTable,
- /* Table in which to create binding. */
- ClientData object, /* Token for object with which binding is
- * associated. */
- const char *eventString, /* String describing event sequence that
- * triggers binding. */
- TkBindEvalProc *eventProc, /* Function to invoke when binding triggers.
- * Must not be NULL. */
- TkBindFreeProc *freeProc, /* Function to invoke when binding is freed.
- * May be NULL for no function. */
- ClientData clientData) /* Arbitrary ClientData to pass to eventProc
- * and freeProc. */
-{
- BindingTable *bindPtr = (BindingTable *) bindingTable;
- PatSeq *psPtr;
- unsigned long eventMask;
-
- psPtr = FindSequence(interp, &bindPtr->patternTable, object, eventString,
- 1, 1, &eventMask);
- if (psPtr == NULL) {
- return 0;
- }
- if (psPtr->eventProc == NULL) {
- int isNew;
- Tcl_HashEntry *hPtr;
-
- /*
- * This pattern sequence was just created. Link the pattern into the
- * list associated with the object, so that if the object goes away,
- * these bindings will all automatically be deleted.
- */
-
- hPtr = Tcl_CreateHashEntry(&bindPtr->objectTable, (char *) object,
- &isNew);
- if (isNew) {
- psPtr->nextObjPtr = NULL;
- } else {
- psPtr->nextObjPtr = (PatSeq *) Tcl_GetHashValue(hPtr);
- }
- Tcl_SetHashValue(hPtr, psPtr);
- } else {
- /*
- * Free existing callback.
- */
-
- if (psPtr->freeProc != NULL) {
- (*psPtr->freeProc)(psPtr->clientData);
- }
- }
-
- psPtr->eventProc = eventProc;
- psPtr->freeProc = freeProc;
- psPtr->clientData = clientData;
+ psPtr->script = newStr;
return eventMask;
}
@@ -1123,14 +962,12 @@ TkCreateBindingProcedure(
int
Tk_DeleteBinding(
Tcl_Interp *interp, /* Used for error reporting. */
- Tk_BindingTable bindingTable,
- /* Table in which to delete binding. */
+ Tk_BindingTable bindPtr, /* Table in which to delete binding. */
ClientData object, /* Token for object with which binding is
* associated. */
const char *eventString) /* String describing event sequence that
* triggers binding. */
{
- BindingTable *bindPtr = (BindingTable *) bindingTable;
PatSeq *psPtr, *prevPtr;
unsigned long eventMask;
Tcl_HashEntry *hPtr;
@@ -1151,7 +988,7 @@ Tk_DeleteBinding(
if (hPtr == NULL) {
Tcl_Panic("Tk_DeleteBinding couldn't find object table entry");
}
- prevPtr = (PatSeq *) Tcl_GetHashValue(hPtr);
+ prevPtr = Tcl_GetHashValue(hPtr);
if (prevPtr == psPtr) {
Tcl_SetHashValue(hPtr, psPtr->nextObjPtr);
} else {
@@ -1165,7 +1002,7 @@ Tk_DeleteBinding(
}
}
}
- prevPtr = (PatSeq *) Tcl_GetHashValue(psPtr->hPtr);
+ prevPtr = Tcl_GetHashValue(psPtr->hPtr);
if (prevPtr == psPtr) {
if (psPtr->nextSeqPtr == NULL) {
Tcl_DeleteHashEntry(psPtr->hPtr);
@@ -1184,13 +1021,8 @@ Tk_DeleteBinding(
}
}
- psPtr->flags |= MARKED_DELETED;
- if (psPtr->refCount == 0) {
- if (psPtr->freeProc != NULL) {
- (*psPtr->freeProc)(psPtr->clientData);
- }
- ckfree((char *) psPtr);
- }
+ ckfree(psPtr->script);
+ ckfree(psPtr);
return TCL_OK;
}
@@ -1199,10 +1031,10 @@ Tk_DeleteBinding(
*
* Tk_GetBinding --
*
- * Return the command associated with a given event string.
+ * Return the script associated with a given event string.
*
* Results:
- * The return value is a pointer to the command string associated with
+ * The return value is a pointer to the script associated with
* eventString for object in the domain 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 the interp's
@@ -1218,14 +1050,12 @@ Tk_DeleteBinding(
const char *
Tk_GetBinding(
Tcl_Interp *interp, /* Interpreter for error reporting. */
- Tk_BindingTable bindingTable,
- /* Table in which to look for binding. */
+ Tk_BindingTable bindPtr, /* Table in which to look for binding. */
ClientData object, /* Token for object with which binding is
* associated. */
const char *eventString) /* String describing event sequence that
* triggers binding. */
{
- BindingTable *bindPtr = (BindingTable *) bindingTable;
PatSeq *psPtr;
unsigned long eventMask;
@@ -1234,10 +1064,7 @@ Tk_GetBinding(
if (psPtr == NULL) {
return NULL;
}
- if (psPtr->eventProc == EvalTclBinding) {
- return (const char *) psPtr->clientData;
- }
- return "";
+ return psPtr->script;
}
/*
@@ -1263,32 +1090,29 @@ Tk_GetBinding(
void
Tk_GetAllBindings(
Tcl_Interp *interp, /* Interpreter returning result or error. */
- Tk_BindingTable bindingTable,
- /* Table in which to look for bindings. */
+ Tk_BindingTable bindPtr, /* Table in which to look for bindings. */
ClientData object) /* Token for object. */
{
- BindingTable *bindPtr = (BindingTable *) bindingTable;
PatSeq *psPtr;
Tcl_HashEntry *hPtr;
- Tcl_DString ds;
+ Tcl_Obj *resultObj;
hPtr = Tcl_FindHashEntry(&bindPtr->objectTable, (char *) object);
if (hPtr == NULL) {
return;
}
- Tcl_DStringInit(&ds);
- for (psPtr = (PatSeq *) Tcl_GetHashValue(hPtr); psPtr != NULL;
+
+ resultObj = Tcl_NewObj();
+ for (psPtr = Tcl_GetHashValue(hPtr); psPtr != NULL;
psPtr = psPtr->nextObjPtr) {
/*
* For each binding, output information about each of the patterns in
* its sequence.
*/
- Tcl_DStringSetLength(&ds, 0);
- GetPatternString(psPtr, &ds);
- Tcl_AppendElement(interp, Tcl_DStringValue(&ds));
+ Tcl_ListObjAppendElement(NULL, resultObj, GetPatternObj(psPtr));
}
- Tcl_DStringFree(&ds);
+ Tcl_SetObjResult(interp, resultObj);
}
/*
@@ -1310,11 +1134,9 @@ Tk_GetAllBindings(
void
Tk_DeleteAllBindings(
- Tk_BindingTable bindingTable,
- /* Table in which to delete bindings. */
+ Tk_BindingTable bindPtr, /* Table in which to delete bindings. */
ClientData object) /* Token for object. */
{
- BindingTable *bindPtr = (BindingTable *) bindingTable;
PatSeq *psPtr, *prevPtr;
PatSeq *nextPtr;
Tcl_HashEntry *hPtr;
@@ -1323,7 +1145,7 @@ Tk_DeleteAllBindings(
if (hPtr == NULL) {
return;
}
- for (psPtr = (PatSeq *) Tcl_GetHashValue(hPtr); psPtr != NULL;
+ for (psPtr = Tcl_GetHashValue(hPtr); psPtr != NULL;
psPtr = nextPtr) {
nextPtr = psPtr->nextObjPtr;
@@ -1333,7 +1155,7 @@ Tk_DeleteAllBindings(
* hash entry too.
*/
- prevPtr = (PatSeq *) Tcl_GetHashValue(psPtr->hPtr);
+ prevPtr = Tcl_GetHashValue(psPtr->hPtr);
if (prevPtr == psPtr) {
if (psPtr->nextSeqPtr == NULL) {
Tcl_DeleteHashEntry(psPtr->hPtr);
@@ -1351,14 +1173,8 @@ Tk_DeleteAllBindings(
}
}
}
- psPtr->flags |= MARKED_DELETED;
-
- if (psPtr->refCount == 0) {
- if (psPtr->freeProc != NULL) {
- (*psPtr->freeProc)(psPtr->clientData);
- }
- ckfree((char *) psPtr);
- }
+ ckfree(psPtr->script);
+ ckfree(psPtr);
}
Tcl_DeleteHashEntry(hPtr);
}
@@ -1378,27 +1194,19 @@ Tk_DeleteAllBindings(
* None.
*
* Side effects:
- * Depends on the command associated with the matching binding.
+ * Depends on the script associated with the matching binding.
*
- * All Tcl bindings scripts for each object are accumulated before the
+ * All Tcl binding scripts for each object are accumulated before the
* first binding is evaluated. If the action of a Tcl binding is to
* change or delete a binding, or delete the window associated with the
* binding, all the original Tcl binding scripts will still fire.
- * Contrast this with C binding functions. If a pending C binding (one
- * that hasn't fired yet, but is queued to be fired for this window) is
- * deleted, it will not be called, and if it is changed, then the new
- * binding function will be called. If the window itself is deleted, no
- * further C binding functions will be called for this window. When both
- * Tcl binding scripts and C binding functions are interleaved, the above
- * rules still apply.
*
*---------------------------------------------------------------------------
*/
void
Tk_BindEvent(
- Tk_BindingTable bindingTable,
- /* Table in which to look for bindings. */
+ Tk_BindingTable bindPtr, /* Table in which to look for bindings. */
XEvent *eventPtr, /* What actually happened. */
Tk_Window tkwin, /* Window on display where event occurred
* (needed in order to locate display
@@ -1407,24 +1215,21 @@ Tk_BindEvent(
ClientData *objectPtr) /* Array of one or more objects to check for a
* matching binding. */
{
- BindingTable *bindPtr;
TkDisplay *dispPtr;
ScreenInfo *screenPtr;
BindInfo *bindInfoPtr;
TkDisplay *oldDispPtr;
XEvent *ringPtr;
PatSeq *vMatchDetailList, *vMatchNoDetailList;
- int flags, oldScreen, i, deferModal;
- unsigned int matchCount, matchSpace;
+ int flags, oldScreen;
unsigned int scriptCount;
Tcl_Interp *interp;
- Tcl_DString scripts, savedResult;
+ Tcl_DString scripts;
+ Tcl_InterpState interpState;
Detail detail;
char *p, *end;
- PendingBinding staticPending, *pendingPtr;
TkWindow *winPtr = (TkWindow *) tkwin;
PatternTableKey key;
- Tk_ClassModalProc *modalProc;
/*
* Ignore events on windows that don't have names: these are windows like
@@ -1455,9 +1260,8 @@ Tk_BindEvent(
}
}
- bindPtr = (BindingTable *) bindingTable;
dispPtr = ((TkWindow *) tkwin)->dispPtr;
- bindInfoPtr = (BindInfo *) winPtr->mainPtr->bindInfo;
+ bindInfoPtr = winPtr->mainPtr->bindInfo;
/*
* Add the new event to the ring of saved events for the binding table.
@@ -1517,7 +1321,7 @@ Tk_BindEvent(
}
}
ringPtr = &bindPtr->eventRing[bindPtr->curEvent];
- memcpy((void *) ringPtr, (void *) eventPtr, sizeof(XEvent));
+ memcpy(ringPtr, eventPtr, sizeof(XEvent));
detail.clientData = 0;
flags = flagArray[ringPtr->type];
if (flags & KEY) {
@@ -1551,14 +1355,14 @@ Tk_BindEvent(
hPtr = Tcl_FindHashEntry(veptPtr, (char *) &key);
if (hPtr != NULL) {
- vMatchDetailList = (PatSeq *) Tcl_GetHashValue(hPtr);
+ vMatchDetailList = Tcl_GetHashValue(hPtr);
}
if (key.detail.clientData != 0) {
key.detail.clientData = 0;
hPtr = Tcl_FindHashEntry(veptPtr, (char *) &key);
if (hPtr != NULL) {
- vMatchNoDetailList = (PatSeq *) Tcl_GetHashValue(hPtr);
+ vMatchNoDetailList = Tcl_GetHashValue(hPtr);
}
}
}
@@ -1567,14 +1371,10 @@ Tk_BindEvent(
* Loop over all the binding tags, finding the binding script or callback
* for each one. Append all of the binding scripts, with %-sequences
* expanded, to "scripts", with null characters separating the scripts for
- * each object. Append all the callbacks to the array of pending
- * callbacks.
+ * each object.
*/
- pendingPtr = &staticPending;
- matchCount = 0;
scriptCount = 0;
- matchSpace = sizeof(staticPending.matchArray) / sizeof(PatSeq *);
Tcl_DStringInit(&scripts);
for ( ; numObjects > 0; numObjects--, objectPtr++) {
@@ -1594,9 +1394,8 @@ Tk_BindEvent(
key.detail = detail;
hPtr = Tcl_FindHashEntry(&bindPtr->patternTable, (char *) &key);
if (hPtr != NULL) {
- matchPtr = MatchPatterns(dispPtr, bindPtr,
- (PatSeq *) Tcl_GetHashValue(hPtr), matchPtr, NULL,
- &sourcePtr);
+ matchPtr = MatchPatterns(dispPtr, bindPtr, Tcl_GetHashValue(hPtr),
+ matchPtr, NULL, &sourcePtr);
}
if (vMatchDetailList != NULL) {
@@ -1614,47 +1413,18 @@ Tk_BindEvent(
hPtr = Tcl_FindHashEntry(&bindPtr->patternTable, (char *) &key);
if (hPtr != NULL) {
matchPtr = MatchPatterns(dispPtr, bindPtr,
- (PatSeq *) Tcl_GetHashValue(hPtr), matchPtr, NULL,
- &sourcePtr);
+ Tcl_GetHashValue(hPtr), matchPtr, NULL, &sourcePtr);
}
if (vMatchNoDetailList != NULL) {
matchPtr = MatchPatterns(dispPtr, bindPtr, vMatchNoDetailList,
matchPtr, objectPtr, &sourcePtr);
}
-
}
if (matchPtr != NULL) {
- if (sourcePtr->eventProc == NULL) {
- Tcl_Panic("Tk_BindEvent: missing command");
- }
- if (sourcePtr->eventProc == EvalTclBinding) {
- ExpandPercents(winPtr, (char *) sourcePtr->clientData,
- eventPtr, detail.keySym, scriptCount++, &scripts);
- } else {
- if (matchCount >= matchSpace) {
- PendingBinding *newPtr;
- unsigned int oldSize, newSize;
-
- oldSize = sizeof(staticPending)
- - sizeof(staticPending.matchArray)
- + matchSpace * sizeof(PatSeq*);
- matchSpace *= 2;
- newSize = sizeof(staticPending)
- - sizeof(staticPending.matchArray)
- + matchSpace * sizeof(PatSeq*);
- newPtr = (PendingBinding *) ckalloc(newSize);
- memcpy((void *) newPtr, (void *) pendingPtr, oldSize);
- if (pendingPtr != &staticPending) {
- ckfree((char *) pendingPtr);
- }
- pendingPtr = newPtr;
- }
- sourcePtr->refCount++;
- pendingPtr->matchArray[matchCount] = sourcePtr;
- matchCount++;
- }
+ ExpandPercents(winPtr, sourcePtr->script, eventPtr,
+ detail.keySym, scriptCount++, &scripts);
/*
* A "" is added to the scripts string to separate the various
@@ -1686,14 +1456,13 @@ Tk_BindEvent(
*/
interp = bindPtr->interp;
- Tcl_DStringInit(&savedResult);
/*
* Save information about the current screen, then invoke a script if the
* screen has changed.
*/
- Tcl_DStringGetResult(interp, &savedResult);
+ interpState = Tcl_SaveInterpState(interp, TCL_OK);
screenPtr = &bindInfoPtr->screenInfo;
oldDispPtr = screenPtr->curDispPtr;
oldScreen = screenPtr->curScreenIndex;
@@ -1704,40 +1473,18 @@ Tk_BindEvent(
ChangeScreen(interp, dispPtr->name, screenPtr->curScreenIndex);
}
- 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;
- bindInfoPtr->pendingList = pendingPtr;
- }
-
- /*
- * Save the current value of the TK_DEFER_MODAL flag so we can restore it
- * at the end of the loop. Clear the flag so we can detect any recursive
- * requests for a modal loop.
- */
-
- flags = winPtr->flags;
- winPtr->flags &= ~TK_DEFER_MODAL;
-
p = Tcl_DStringValue(&scripts);
end = p + Tcl_DStringLength(&scripts);
- i = 0;
/*
- * Be carefule when dereferencing screenPtr or bindInfoPtr. If we evaluate
+ * Be careful 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);
+ Tcl_Preserve(bindInfoPtr);
while (p < end) {
+ int len = (int) strlen(p);
int code;
if (!bindInfoPtr->deleted) {
@@ -1745,31 +1492,8 @@ Tk_BindEvent(
}
Tcl_AllowExceptions(interp);
- if (*p == '\0') {
- PatSeq *psPtr;
-
- psPtr = pendingPtr->matchArray[i];
- i++;
- code = TCL_OK;
- if ((pendingPtr->deleted == 0)
- && ((psPtr->flags & MARKED_DELETED) == 0)) {
- code = (*psPtr->eventProc)(psPtr->clientData, interp, eventPtr,
- tkwin, detail.keySym);
- }
- psPtr->refCount--;
- if ((psPtr->refCount == 0) && (psPtr->flags & MARKED_DELETED)) {
- if (psPtr->freeProc != NULL) {
- (*psPtr->freeProc)(psPtr->clientData);
- }
- ckfree((char *) psPtr);
- }
- } else {
- int len = (int) strlen(p);
-
- code = Tcl_EvalEx(interp, p, len, TCL_EVAL_GLOBAL);
- p += len;
- }
- p++;
+ code = Tcl_EvalEx(interp, p, len, TCL_EVAL_GLOBAL);
+ p += len + 1;
if (!bindInfoPtr->deleted) {
screenPtr->bindingDepth--;
@@ -1783,29 +1507,12 @@ Tk_BindEvent(
break;
} else {
Tcl_AddErrorInfo(interp, "\n (command bound to event)");
- Tcl_BackgroundError(interp);
+ Tcl_BackgroundException(interp, code);
break;
}
}
}
- if (matchCount > 0 && !pendingPtr->deleted) {
- /*
- * Restore the original modal flag value and invoke the modal loop if
- * needed.
- */
-
- deferModal = winPtr->flags & TK_DEFER_MODAL;
- winPtr->flags = (winPtr->flags & (unsigned int) ~TK_DEFER_MODAL)
- | (flags & TK_DEFER_MODAL);
- if (deferModal) {
- modalProc = Tk_GetClassProc(winPtr->classProcsPtr, modalProc);
- if (modalProc != NULL) {
- (*modalProc)(tkwin, eventPtr);
- }
- }
- }
-
if (!bindInfoPtr->deleted && (screenPtr->bindingDepth != 0)
&& ((oldDispPtr != screenPtr->curDispPtr)
|| (oldScreen != screenPtr->curScreenIndex))) {
@@ -1818,74 +1525,10 @@ Tk_BindEvent(
screenPtr->curScreenIndex = oldScreen;
ChangeScreen(interp, oldDispPtr->name, oldScreen);
}
- Tcl_DStringResult(interp, &savedResult);
+ (void) Tcl_RestoreInterpState(interp, interpState);
Tcl_DStringFree(&scripts);
- if (matchCount > 0) {
- 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;
- }
- curPtrPtr = &(*curPtrPtr)->nextPtr;
- }
- }
- if (pendingPtr != &staticPending) {
- ckfree((char *) pendingPtr);
- }
- }
- Tcl_Release((ClientData) bindInfoPtr);
-}
-
-/*
- *---------------------------------------------------------------------------
- *
- * TkBindDeadWindow --
- *
- * This function is invoked when it is determined that a window is dead.
- * It cleans up bind-related information about the window
- *
- * Results:
- * None.
- *
- * Side effects:
- * Any pending C bindings for this window are cancelled.
- *
- *---------------------------------------------------------------------------
- */
-
-void
-TkBindDeadWindow(
- TkWindow *winPtr) /* The window that is being deleted. */
-{
- BindInfo *bindInfoPtr;
- PendingBinding *curPtr;
-
- /*
- * Certain special windows like those used for send and clipboard have no
- * mainPtr.
- */
-
- if (winPtr->mainPtr == NULL) {
- return;
- }
-
- bindInfoPtr = (BindInfo *) winPtr->mainPtr->bindInfo;
- curPtr = bindInfoPtr->pendingList;
- while (curPtr != NULL) {
- if (curPtr->tkwin == (Tk_Window) winPtr) {
- curPtr->deleted = 1;
- }
- curPtr = curPtr->nextPtr;
- }
+ Tcl_Release(bindInfoPtr);
}
/*
@@ -1924,6 +1567,7 @@ TkBindDeadWindow(
*
*----------------------------------------------------------------------
*/
+
static PatSeq *
MatchPatterns(
TkDisplay *dispPtr, /* Display from which the event came. */
@@ -2147,7 +1791,7 @@ MatchPatterns(
* virtual event's definition.
*/
- PatSeq *virtMatchPtr = (PatSeq *) Tcl_GetHashValue(hPtr);
+ PatSeq *virtMatchPtr = Tcl_GetHashValue(hPtr);
if ((virtMatchPtr->numPats != 1)
|| (virtMatchPtr->nextSeqPtr != NULL)) {
@@ -2538,7 +2182,7 @@ ExpandPercents(
goto doNumber;
case 'K':
if ((flags & KEY) && (eventPtr->type != MouseWheelEvent)) {
- char *name = TkKeysymToString(keySym);
+ const char *name = TkKeysymToString(keySym);
if (name != NULL) {
string = name;
@@ -2589,13 +2233,19 @@ ExpandPercents(
}
case 'X':
if (flags & KEY_BUTTON_MOTION_CROSSING) {
+
number = eventPtr->xkey.x_root;
+ Tk_IdToWindow(eventPtr->xany.display,
+ eventPtr->xany.window);
goto doNumber;
}
goto doString;
case 'Y':
if (flags & KEY_BUTTON_MOTION_CROSSING) {
+
number = eventPtr->xkey.y_root;
+ Tk_IdToWindow(eventPtr->xany.display,
+ eventPtr->xany.window);
goto doNumber;
}
goto doString;
@@ -2650,23 +2300,18 @@ ChangeScreen(
char *dispName, /* Name of new display. */
int screenIndex) /* Index of new screen. */
{
- Tcl_DString cmd;
+ Tcl_Obj *cmdObj = Tcl_ObjPrintf("::tk::ScreenChanged %s.%d",
+ dispName, screenIndex);
int code;
- char screen[TCL_INTEGER_SPACE];
-
- Tcl_DStringInit(&cmd);
- Tcl_DStringAppend(&cmd, "tk::ScreenChanged ", 18);
- Tcl_DStringAppend(&cmd, dispName, -1);
- sprintf(screen, ".%d", screenIndex);
- Tcl_DStringAppend(&cmd, screen, -1);
- code = Tcl_EvalEx(interp, Tcl_DStringValue(&cmd), Tcl_DStringLength(&cmd),
- TCL_EVAL_GLOBAL);
- Tcl_DStringFree(&cmd);
+
+ Tcl_IncrRefCount(cmdObj);
+ code = Tcl_EvalObjEx(interp, cmdObj, TCL_EVAL_GLOBAL);
if (code != TCL_OK) {
Tcl_AddErrorInfo(interp,
"\n (changing screen in event binding)");
- Tcl_BackgroundError(interp);
+ Tcl_BackgroundException(interp, code);
}
+ Tcl_DecrRefCount(cmdObj);
}
/*
@@ -2693,11 +2338,13 @@ Tk_EventObjCmd(
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
- int index;
- Tk_Window tkwin;
- VirtualEventTable *vetPtr;
- TkBindInfo bindInfo;
- static const char *optionStrings[] = {
+ int index, i;
+ char *name;
+ const char *event;
+ Tk_Window tkwin = clientData;
+ TkBindInfo bindInfo = ((TkWindow *) tkwin)->mainPtr->bindInfo;
+ VirtualEventTable *vetPtr = &bindInfo->virtualEventTable;
+ static const char *const optionStrings[] = {
"add", "delete", "generate", "info",
NULL
};
@@ -2705,24 +2352,18 @@ Tk_EventObjCmd(
EVENT_ADD, EVENT_DELETE, EVENT_GENERATE, EVENT_INFO
};
- tkwin = (Tk_Window) clientData;
- bindInfo = ((TkWindow *) tkwin)->mainPtr->bindInfo;
- vetPtr = &((BindInfo *) bindInfo)->virtualEventTable;
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) {
+ if (Tcl_GetIndexFromObjStruct(interp, objv[1], optionStrings,
+ sizeof(char *), "option", 0, &index) != TCL_OK) {
return TCL_ERROR;
}
switch ((enum options) index) {
- case EVENT_ADD: {
- int i;
- char *name, *event;
-
+ case EVENT_ADD:
if (objc < 4) {
Tcl_WrongNumArgs(interp, 2, objv,
"virtual sequence ?sequence ...?");
@@ -2736,14 +2377,9 @@ Tk_EventObjCmd(
}
}
break;
- }
- case EVENT_DELETE: {
- int i;
- char *name, *event;
-
+ case EVENT_DELETE:
if (objc < 3) {
- Tcl_WrongNumArgs(interp, 2, objv,
- "virtual ?sequence sequence ...?");
+ Tcl_WrongNumArgs(interp, 2, objv, "virtual ?sequence ...?");
return TCL_ERROR;
}
name = Tcl_GetString(objv[2]);
@@ -2757,10 +2393,10 @@ Tk_EventObjCmd(
}
}
break;
- }
case EVENT_GENERATE:
if (objc < 4) {
- Tcl_WrongNumArgs(interp, 2, objv, "window event ?options?");
+ Tcl_WrongNumArgs(interp, 2, objv,
+ "window event ?-option value ...?");
return TCL_ERROR;
}
return HandleEventGenerate(interp, tkwin, objc - 2, objv + 2);
@@ -2769,7 +2405,7 @@ Tk_EventObjCmd(
GetAllVirtualEvents(interp, vetPtr);
return TCL_OK;
} else if (objc == 3) {
- return GetVirtualEvent(interp, vetPtr, Tcl_GetString(objv[2]));
+ return GetVirtualEvent(interp, vetPtr, objv[2]);
} else {
Tcl_WrongNumArgs(interp, 2, objv, "?virtual?");
return TCL_ERROR;
@@ -2832,18 +2468,18 @@ DeleteVirtualEventTable(
hPtr = Tcl_FirstHashEntry(&vetPtr->patternTable, &search);
for ( ; hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
- psPtr = (PatSeq *) Tcl_GetHashValue(hPtr);
+ psPtr = Tcl_GetHashValue(hPtr);
for ( ; psPtr != NULL; psPtr = nextPtr) {
nextPtr = psPtr->nextSeqPtr;
- ckfree((char *) psPtr->voPtr);
- ckfree((char *) psPtr);
+ ckfree(psPtr->voPtr);
+ ckfree(psPtr);
}
}
Tcl_DeleteHashTable(&vetPtr->patternTable);
hPtr = Tcl_FirstHashEntry(&vetPtr->nameTable, &search);
for ( ; hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
- ckfree((char *) Tcl_GetHashValue(hPtr));
+ ckfree(Tcl_GetHashValue(hPtr));
}
Tcl_DeleteHashTable(&vetPtr->nameTable);
}
@@ -2873,7 +2509,7 @@ CreateVirtualEvent(
Tcl_Interp *interp, /* Used for error reporting. */
VirtualEventTable *vetPtr, /* Table in which to augment virtual event. */
char *virtString, /* Name of new virtual event. */
- char *eventString) /* String describing physical event that
+ const char *eventString) /* String describing physical event that
* triggers virtual event. */
{
PatSeq *psPtr;
@@ -2909,9 +2545,9 @@ CreateVirtualEvent(
* Make virtual event own the physical event.
*/
- poPtr = (PhysicalsOwned *) Tcl_GetHashValue(vhPtr);
+ poPtr = Tcl_GetHashValue(vhPtr);
if (poPtr == NULL) {
- poPtr = (PhysicalsOwned *) ckalloc(sizeof(PhysicalsOwned));
+ poPtr = ckalloc(sizeof(PhysicalsOwned));
poPtr->numOwned = 0;
} else {
/*
@@ -2926,10 +2562,10 @@ CreateVirtualEvent(
return TCL_OK;
}
}
- poPtr = (PhysicalsOwned *) ckrealloc((char *) poPtr,
- sizeof(PhysicalsOwned) + poPtr->numOwned * sizeof(PatSeq *));
+ poPtr = ckrealloc(poPtr, sizeof(PhysicalsOwned)
+ + poPtr->numOwned * sizeof(PatSeq *));
}
- Tcl_SetHashValue(vhPtr, (ClientData) poPtr);
+ Tcl_SetHashValue(vhPtr, poPtr);
poPtr->patSeqs[poPtr->numOwned] = psPtr;
poPtr->numOwned++;
@@ -2939,11 +2575,10 @@ CreateVirtualEvent(
voPtr = psPtr->voPtr;
if (voPtr == NULL) {
- voPtr = (VirtualOwners *) ckalloc(sizeof(VirtualOwners));
+ voPtr = ckalloc(sizeof(VirtualOwners));
voPtr->numOwners = 0;
} else {
- voPtr = (VirtualOwners *) ckrealloc((char *) voPtr,
- sizeof(VirtualOwners)
+ voPtr = ckrealloc(voPtr, sizeof(VirtualOwners)
+ voPtr->numOwners * sizeof(Tcl_HashEntry *));
}
psPtr->voPtr = voPtr;
@@ -2982,7 +2617,7 @@ DeleteVirtualEvent(
VirtualEventTable *vetPtr, /* Table in which to delete event. */
char *virtString, /* String describing event sequence that
* triggers binding. */
- char *eventString) /* The event sequence that should be deleted,
+ const char *eventString) /* The event sequence that should be deleted,
* or NULL to delete all event sequences for
* the entire virtual event. */
{
@@ -3001,7 +2636,7 @@ DeleteVirtualEvent(
if (vhPtr == NULL) {
return TCL_OK;
}
- poPtr = (PhysicalsOwned *) Tcl_GetHashValue(vhPtr);
+ poPtr = Tcl_GetHashValue(vhPtr);
eventPSPtr = NULL;
if (eventString != NULL) {
@@ -3016,7 +2651,7 @@ DeleteVirtualEvent(
eventPSPtr = FindSequence(interp, &vetPtr->patternTable, NULL,
eventString, 0, 0, &eventMask);
if (eventPSPtr == NULL) {
- const char *string = Tcl_GetStringResult(interp);
+ const char *string = Tcl_GetString(Tcl_GetObjResult(interp));
return (string[0] != '\0') ? TCL_ERROR : TCL_OK;
}
@@ -3050,7 +2685,7 @@ DeleteVirtualEvent(
* from physical->virtual map.
*/
- PatSeq *prevPtr = (PatSeq *) Tcl_GetHashValue(psPtr->hPtr);
+ PatSeq *prevPtr = Tcl_GetHashValue(psPtr->hPtr);
if (prevPtr == psPtr) {
if (psPtr->nextSeqPtr == NULL) {
@@ -3070,8 +2705,8 @@ DeleteVirtualEvent(
}
}
}
- ckfree((char *) psPtr->voPtr);
- ckfree((char *) psPtr);
+ ckfree(psPtr->voPtr);
+ ckfree(psPtr);
} else {
/*
* This physical event still triggers some other virtual
@@ -3108,7 +2743,7 @@ DeleteVirtualEvent(
* itself should be deleted.
*/
- ckfree((char *) poPtr);
+ ckfree(poPtr);
Tcl_DeleteHashEntry(vhPtr);
}
return TCL_OK;
@@ -3140,15 +2775,15 @@ static int
GetVirtualEvent(
Tcl_Interp *interp, /* Interpreter for reporting. */
VirtualEventTable *vetPtr, /* Table in which to look for event. */
- char *virtString) /* String describing virtual event. */
+ Tcl_Obj *virtName) /* String describing virtual event. */
{
Tcl_HashEntry *vhPtr;
- Tcl_DString ds;
int iPhys;
PhysicalsOwned *poPtr;
Tk_Uid virtUid;
+ Tcl_Obj *resultObj;
- virtUid = GetVirtualEventUid(interp, virtString);
+ virtUid = GetVirtualEventUid(interp, Tcl_GetString(virtName));
if (virtUid == NULL) {
return TCL_ERROR;
}
@@ -3158,15 +2793,13 @@ GetVirtualEvent(
return TCL_OK;
}
- Tcl_DStringInit(&ds);
-
- poPtr = (PhysicalsOwned *) Tcl_GetHashValue(vhPtr);
+ resultObj = Tcl_NewObj();
+ poPtr = Tcl_GetHashValue(vhPtr);
for (iPhys = 0; iPhys < poPtr->numOwned; iPhys++) {
- Tcl_DStringSetLength(&ds, 0);
- GetPatternString(poPtr->patSeqs[iPhys], &ds);
- Tcl_AppendElement(interp, Tcl_DStringValue(&ds));
+ Tcl_ListObjAppendElement(NULL, resultObj,
+ GetPatternObj(poPtr->patSeqs[iPhys]));
}
- Tcl_DStringFree(&ds);
+ Tcl_SetObjResult(interp, resultObj);
return TCL_OK;
}
@@ -3196,20 +2829,15 @@ GetAllVirtualEvents(
{
Tcl_HashEntry *hPtr;
Tcl_HashSearch search;
- Tcl_DString ds;
-
- Tcl_DStringInit(&ds);
+ Tcl_Obj *resultObj;
+ resultObj = Tcl_NewObj();
hPtr = Tcl_FirstHashEntry(&vetPtr->nameTable, &search);
for ( ; hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
- Tcl_DStringSetLength(&ds, 0);
- Tcl_DStringAppend(&ds, "<<", 2);
- Tcl_DStringAppend(&ds, Tcl_GetHashKey(hPtr->tablePtr, hPtr), -1);
- Tcl_DStringAppend(&ds, ">>", 2);
- Tcl_AppendElement(interp, Tcl_DStringValue(&ds));
+ Tcl_ListObjAppendElement(NULL, resultObj, Tcl_ObjPrintf(
+ "<<%s>>", (char *) Tcl_GetHashKey(hPtr->tablePtr, hPtr)));
}
-
- Tcl_DStringFree(&ds);
+ Tcl_SetObjResult(interp, resultObj);
}
/*
@@ -3256,7 +2884,7 @@ HandleEventGenerate(
{
union {XEvent general; XVirtualEvent virtual;} event;
const char *p;
- char *name, *windowName;
+ const char *name, *windowName;
int count, flags, synch, i, number, warp;
Tcl_QueuePosition pos;
TkPattern pat;
@@ -3264,7 +2892,8 @@ HandleEventGenerate(
TkWindow *mainPtr;
unsigned long eventMask;
Tcl_Obj *userDataObj;
- static const char *fieldStrings[] = {
+
+ static const char *const fieldStrings[] = {
"-when", "-above", "-borderwidth", "-button",
"-count", "-data", "-delta", "-detail",
"-focus", "-height",
@@ -3295,8 +2924,11 @@ HandleEventGenerate(
mainPtr = (TkWindow *) mainWin;
if ((tkwin == NULL)
|| (mainPtr->mainPtr != ((TkWindow *) tkwin)->mainPtr)) {
- Tcl_AppendResult(interp, "window id \"", Tcl_GetString(objv[0]),
- "\" doesn't exist in this application", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "window id \"%s\" doesn't exist in this application",
+ Tcl_GetString(objv[0])));
+ Tcl_SetErrorCode(interp, "TK", "LOOKUP", "WINDOW",
+ Tcl_GetString(objv[0]), NULL);
return TCL_ERROR;
}
@@ -3310,17 +2942,19 @@ HandleEventGenerate(
return TCL_ERROR;
}
if (count != 1) {
- Tcl_SetResult(interp, "Double or Triple modifier not allowed",
- TCL_STATIC);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "Double or Triple modifier not allowed", -1));
+ Tcl_SetErrorCode(interp, "TK", "EVENT", "BAD_MODIFIER", NULL);
return TCL_ERROR;
}
if (*p != '\0') {
- Tcl_SetResult(interp, "only one event specification allowed",
- TCL_STATIC);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "only one event specification allowed", -1));
+ Tcl_SetErrorCode(interp, "TK", "EVENT", "MULTIPLE", NULL);
return TCL_ERROR;
}
- memset((void *) &event, 0, sizeof(event));
+ memset(&event, 0, sizeof(event));
event.general.xany.type = pat.eventType;
event.general.xany.serial = NextRequest(Tk_Display(tkwin));
event.general.xany.send_event = False;
@@ -3360,6 +2994,11 @@ HandleEventGenerate(
event.general.xkey.y_root = -1;
}
+ if (event.general.xany.type == FocusIn
+ || event.general.xany.type == FocusOut) {
+ event.general.xany.send_event = GENERATED_FOCUS_EVENT_MAGIC;
+ }
+
/*
* Process the remaining arguments to fill in additional fields of the
* event.
@@ -3375,8 +3014,8 @@ HandleEventGenerate(
optionPtr = objv[i];
valuePtr = objv[i + 1];
- if (Tcl_GetIndexFromObj(interp, optionPtr, fieldStrings, "option",
- TCL_EXACT, &index) != TCL_OK) {
+ if (Tcl_GetIndexFromObjStruct(interp, optionPtr, fieldStrings,
+ sizeof(char *), "option", TCL_EXACT, &index) != TCL_OK) {
return TCL_ERROR;
}
if (objc & 1) {
@@ -3387,8 +3026,9 @@ HandleEventGenerate(
* is missing.
*/
- Tcl_AppendResult(interp, "value for \"", Tcl_GetString(optionPtr),
- "\" missing", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "value for \"%s\" missing", Tcl_GetString(optionPtr)));
+ Tcl_SetErrorCode(interp, "TK", "EVENT", "MISSING_VALUE", NULL);
return TCL_ERROR;
}
@@ -3524,20 +3164,24 @@ HandleEventGenerate(
break;
case EVENT_KEYSYM: {
KeySym keysym;
- char *value;
+ const char *value;
value = Tcl_GetString(valuePtr);
keysym = TkStringToKeysym(value);
if (keysym == NoSymbol) {
- Tcl_AppendResult(interp, "unknown keysym \"", value, "\"",
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "unknown keysym \"%s\"", value));
+ Tcl_SetErrorCode(interp, "TK", "LOOKUP", "KEYSYM", value,
NULL);
return TCL_ERROR;
}
TkpSetKeycodeAndState(tkwin, keysym, &event.general);
if (event.general.xkey.keycode == 0) {
- Tcl_AppendResult(interp, "no keycode for keysym \"", value,
- "\"", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "no keycode for keysym \"%s\"", value));
+ Tcl_SetErrorCode(interp, "TK", "LOOKUP", "KEYCODE", value,
+ NULL);
return TCL_ERROR;
}
if (!(flags & KEY)
@@ -3712,7 +3356,7 @@ HandleEventGenerate(
if (Tk_GetPixelsFromObj(interp,tkwin,valuePtr,&number) != TCL_OK) {
return TCL_ERROR;
}
- if (flags & (KEY_BUTTON_MOTION_VIRTUAL|CROSSING)) {
+ if (flags & KEY_BUTTON_MOTION_CROSSING) {
event.general.xkey.x = number;
/*
@@ -3766,12 +3410,22 @@ HandleEventGenerate(
continue;
badopt:
- Tcl_AppendResult(interp, name, " event doesn't accept \"",
- Tcl_GetString(optionPtr), "\" option", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "%s event doesn't accept \"%s\" option",
+ name, Tcl_GetString(optionPtr)));
+ Tcl_SetErrorCode(interp, "TK", "EVENT", "BAD_OPTION", NULL);
return TCL_ERROR;
}
+
+ /*
+ * Don't generate events for windows that don't exist yet.
+ */
+
+ if (!event.general.xany.window) {
+ goto done;
+ }
+
if (userDataObj != NULL) {
- XVirtualEvent *vePtr = (XVirtualEvent *) &event;
/*
* Must be virtual event to set that variable to non-NULL. Now we want
@@ -3780,7 +3434,7 @@ HandleEventGenerate(
* refcount will be decremented once the event has been processed.
*/
- vePtr->user_data = userDataObj;
+ event.virtual.user_data = userDataObj;
Tcl_IncrRefCount(userDataObj);
}
@@ -3803,13 +3457,17 @@ HandleEventGenerate(
TkDisplay *dispPtr = TkGetDisplay(event.general.xmotion.display);
if (!(dispPtr->flags & TK_DISPLAY_IN_WARP)) {
- Tcl_DoWhenIdle(DoWarp, (ClientData) dispPtr);
+ Tcl_DoWhenIdle(DoWarp, dispPtr);
dispPtr->flags |= TK_DISPLAY_IN_WARP;
}
- dispPtr->warpWindow = event.general.xany.window;
- dispPtr->warpX = event.general.xkey.x;
- dispPtr->warpY = event.general.xkey.y;
+ dispPtr->warpWindow = Tk_IdToWindow(Tk_Display(mainWin),
+ event.general.xmotion.window);
+ dispPtr->warpMainwin = mainWin;
+ dispPtr->warpX = event.general.xmotion.x;
+ dispPtr->warpY = event.general.xmotion.y;
}
+
+ done:
Tcl_ResetResult(interp);
return TCL_OK;
}
@@ -3821,32 +3479,38 @@ NameToWindow(
Tcl_Obj *objPtr, /* Contains name or id string of window. */
Tk_Window *tkwinPtr) /* Filled with token for window. */
{
- char *name;
+ const char *name = Tcl_GetString(objPtr);
Tk_Window tkwin;
- Window id;
- name = Tcl_GetString(objPtr);
if (name[0] == '.') {
tkwin = Tk_NameToWindow(interp, name, mainWin);
if (tkwin == NULL) {
return TCL_ERROR;
}
- *tkwinPtr = tkwin;
} else {
+ Window id;
+
/*
* Check for the winPtr being valid, even if it looks ok to
* TkpScanWindowId. [Bug #411307]
*/
- if ((TkpScanWindowId(NULL, name, &id) != TCL_OK) ||
- ((*tkwinPtr = Tk_IdToWindow(Tk_Display(mainWin), id))
- == NULL)) {
- Tcl_AppendResult(interp, "bad window name/identifier \"",
- name, "\"", NULL);
- return TCL_ERROR;
+ if (TkpScanWindowId(NULL, name, &id) != TCL_OK) {
+ goto badWindow;
+ }
+ tkwin = Tk_IdToWindow(Tk_Display(mainWin), id);
+ if (tkwin == NULL) {
+ goto badWindow;
}
}
+ *tkwinPtr = tkwin;
return TCL_OK;
+
+ badWindow:
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "bad window name/identifier \"%s\"", name));
+ Tcl_SetErrorCode(interp, "TK", "LOOKUP", "WINDOW_ID", name, NULL);
+ return TCL_ERROR;
}
/*
@@ -3864,14 +3528,14 @@ NameToWindow(
*
*-------------------------------------------------------------------------
*/
+
static void
DoWarp(
ClientData clientData)
{
- TkDisplay *dispPtr = (TkDisplay *) clientData;
+ TkDisplay *dispPtr = clientData;
- XWarpPointer(dispPtr->display, (Window) None, (Window) dispPtr->warpWindow,
- 0, 0, 0, 0, (int) dispPtr->warpX, (int) dispPtr->warpY);
+ TkpWarpPointer(dispPtr);
XForceScreenSaver(dispPtr->display, ScreenSaverReset);
dispPtr->flags &= ~TK_DISPLAY_IN_WARP;
}
@@ -3908,8 +3572,9 @@ GetVirtualEventUid(
if (length < 5 || virtString[0] != '<' || virtString[1] != '<' ||
virtString[length - 2] != '>' || virtString[length - 1] != '>') {
- Tcl_AppendResult(interp, "virtual event \"", virtString,
- "\" is badly formed", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "virtual event \"%s\" is badly formed", virtString));
+ Tcl_SetErrorCode(interp, "TK", "EVENT", "VIRTUAL", "MALFORMED", NULL);
return NULL;
}
virtString[length - 2] = '\0';
@@ -4001,9 +3666,11 @@ FindSequence(
if (eventMask & VirtualEventMask) {
if (allowVirtual == 0) {
- Tcl_SetResult(interp,
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
"virtual event not allowed in definition of another virtual event",
- TCL_STATIC);
+ -1));
+ Tcl_SetErrorCode(interp, "TK", "EVENT", "VIRTUAL", "INNER",
+ NULL);
return NULL;
}
virtualFound = 1;
@@ -4029,12 +3696,16 @@ FindSequence(
*/
if (numPats == 0) {
- Tcl_SetResult(interp, "no events specified in binding", TCL_STATIC);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "no events specified in binding", -1));
+ Tcl_SetErrorCode(interp, "TK", "EVENT", "NO_EVENTS", NULL);
return NULL;
}
if ((numPats > 1) && (virtualFound != 0)) {
- Tcl_SetResult(interp, "virtual events may not be composed",
- TCL_STATIC);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "virtual events may not be composed", -1));
+ Tcl_SetErrorCode(interp, "TK", "EVENT", "VIRTUAL", "COMPOSITION",
+ NULL);
return NULL;
}
@@ -4046,12 +3717,11 @@ FindSequence(
hPtr = Tcl_CreateHashEntry(patternTablePtr, (char *) &key, &isNew);
sequenceSize = numPats*sizeof(TkPattern);
if (!isNew) {
- for (psPtr = (PatSeq *) Tcl_GetHashValue(hPtr); psPtr != NULL;
+ for (psPtr = Tcl_GetHashValue(hPtr); psPtr != NULL;
psPtr = psPtr->nextSeqPtr) {
if ((numPats == psPtr->numPats)
&& ((flags & PAT_NEARBY) == (psPtr->flags & PAT_NEARBY))
- && (memcmp((char *) patPtr, (char *) psPtr->pats,
- sequenceSize) == 0)) {
+ && (memcmp(patPtr, psPtr->pats, sequenceSize) == 0)) {
goto done;
}
}
@@ -4071,21 +3741,17 @@ FindSequence(
return NULL;
}
- psPtr = (PatSeq *) ckalloc((unsigned) (sizeof(PatSeq)
- + (numPats-1)*sizeof(TkPattern)));
+ psPtr = ckalloc(sizeof(PatSeq) + (numPats-1)*sizeof(TkPattern));
psPtr->numPats = numPats;
- psPtr->eventProc = NULL;
- psPtr->freeProc = NULL;
- psPtr->clientData = NULL;
+ psPtr->script = NULL;
psPtr->flags = flags;
- psPtr->refCount = 0;
- psPtr->nextSeqPtr = (PatSeq *) Tcl_GetHashValue(hPtr);
+ psPtr->nextSeqPtr = Tcl_GetHashValue(hPtr);
psPtr->hPtr = hPtr;
psPtr->voPtr = NULL;
psPtr->nextObjPtr = NULL;
Tcl_SetHashValue(hPtr, psPtr);
- memcpy((void *) psPtr->pats, (void *) patPtr, sequenceSize);
+ memcpy(psPtr->pats, patPtr, sequenceSize);
done:
*maskPtr = eventMask;
@@ -4157,10 +3823,9 @@ ParseEventDescription(
if (isprint(UCHAR(*p))) {
patPtr->detail.keySym = *p;
} else {
- char buf[64];
-
- sprintf(buf, "bad ASCII character 0x%x", (unsigned char) *p);
- Tcl_SetResult(interp, buf, TCL_VOLATILE);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "bad ASCII character 0x%x", UCHAR(*p)));
+ Tcl_SetErrorCode(interp, "TK", "EVENT", "BAD_CHAR", NULL);
count = 0;
goto done;
}
@@ -4201,14 +3866,18 @@ ParseEventDescription(
p = strchr(field, '>');
if (p == field) {
- Tcl_SetResult(interp, "virtual event \"<<>>\" is badly formed",
- TCL_STATIC);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "virtual event \"<<>>\" is badly formed", -1));
+ Tcl_SetErrorCode(interp, "TK", "EVENT", "VIRTUAL", "MALFORMED",
+ NULL);
count = 0;
goto done;
}
if ((p == NULL) || (p[1] != '>')) {
- Tcl_SetResult(interp, "missing \">\" in virtual binding",
- TCL_STATIC);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "missing \">\" in virtual binding", -1));
+ Tcl_SetErrorCode(interp, "TK", "EVENT", "VIRTUAL", "MALFORMED",
+ NULL);
count = 0;
goto done;
}
@@ -4239,7 +3908,7 @@ ParseEventDescription(
if (hPtr == NULL) {
break;
}
- modPtr = (ModInfo *) Tcl_GetHashValue(hPtr);
+ modPtr = Tcl_GetHashValue(hPtr);
patPtr->needMods |= modPtr->mask;
if (modPtr->flags & MULT_CLICKS) {
int i = modPtr->flags & MULT_CLICKS;
@@ -4257,7 +3926,7 @@ ParseEventDescription(
eventFlags = 0;
hPtr = Tcl_FindHashEntry(&eventTable, field);
if (hPtr != NULL) {
- EventInfo *eiPtr = (EventInfo *) Tcl_GetHashValue(hPtr);
+ const EventInfo *eiPtr = Tcl_GetHashValue(hPtr);
patPtr->eventType = eiPtr->type;
eventFlags = flagArray[eiPtr->type];
@@ -4274,9 +3943,11 @@ ParseEventDescription(
eventMask = ButtonPressMask;
} else if (eventFlags & KEY) {
goto getKeysym;
- } else if ((eventFlags & BUTTON) == 0) {
- Tcl_AppendResult(interp, "specified button \"", field,
- "\" for non-button event", NULL);
+ } else if (!(eventFlags & BUTTON)) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "specified button \"%s\" for non-button event",
+ field));
+ Tcl_SetErrorCode(interp, "TK", "EVENT", "NON_BUTTON", NULL);
count = 0;
goto done;
}
@@ -4286,24 +3957,28 @@ ParseEventDescription(
getKeysym:
patPtr->detail.keySym = TkStringToKeysym(field);
if (patPtr->detail.keySym == NoSymbol) {
- Tcl_AppendResult(interp, "bad event type or keysym \"",
- field, "\"", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "bad event type or keysym \"%s\"", field));
+ Tcl_SetErrorCode(interp, "TK", "LOOKUP", "KEYSYM", field,
+ NULL);
count = 0;
goto done;
}
if (eventFlags == 0) {
patPtr->eventType = KeyPress;
eventMask = KeyPressMask;
- } else if ((eventFlags & KEY) == 0) {
- Tcl_AppendResult(interp, "specified keysym \"", field,
- "\" for non-key event", NULL);
+ } else if (!(eventFlags & KEY)) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "specified keysym \"%s\" for non-key event", field));
+ Tcl_SetErrorCode(interp, "TK", "EVENT", "NON_KEY", NULL);
count = 0;
goto done;
}
}
} else if (eventFlags == 0) {
- Tcl_SetResult(interp, "no event type or button # or keysym",
- TCL_STATIC);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "no event type or button # or keysym", -1));
+ Tcl_SetErrorCode(interp, "TK", "EVENT", "UNMODIFIABLE", NULL);
count = 0;
goto done;
}
@@ -4315,14 +3990,16 @@ ParseEventDescription(
while (*p != '\0') {
p++;
if (*p == '>') {
- Tcl_SetResult(interp,
- "extra characters after detail in binding",
- TCL_STATIC);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "extra characters after detail in binding", -1));
+ Tcl_SetErrorCode(interp, "TK", "EVENT", "PAST_DETAIL", NULL);
count = 0;
goto done;
}
}
- Tcl_SetResult(interp, "missing \">\" in binding", TCL_STATIC);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "missing \">\" in binding", -1));
+ Tcl_SetErrorCode(interp, "TK", "EVENT", "MALFORMED", NULL);
count = 0;
goto done;
}
@@ -4377,31 +4054,30 @@ GetField(
/*
*---------------------------------------------------------------------------
*
- * GetPatternString --
+ * GetPatternObj --
*
* Produce a string version of the given event, for displaying to the
* user.
*
* Results:
- * The string is left in dsPtr.
+ * The string is returned as a Tcl_Obj.
*
* Side effects:
- * It is the caller's responsibility to initialize the DString before and
- * to free it after calling this function.
+ * It is the caller's responsibility to arrange for the object to be
+ * released; it starts with a refCount of zero.
*
*---------------------------------------------------------------------------
*/
-static void
-GetPatternString(
- PatSeq *psPtr,
- Tcl_DString *dsPtr)
+static Tcl_Obj *
+GetPatternObj(
+ PatSeq *psPtr)
{
TkPattern *patPtr;
- char c, buffer[TCL_INTEGER_SPACE];
int patsLeft, needMods;
- ModInfo *modPtr;
- EventInfo *eiPtr;
+ const ModInfo *modPtr;
+ const EventInfo *eiPtr;
+ Tcl_Obj *patternObj = Tcl_NewObj();
/*
* The order of the patterns in the sequence is backwards from the order
@@ -4415,14 +4091,15 @@ GetPatternString(
*/
if ((patPtr->eventType == KeyPress)
- && ((psPtr->flags & PAT_NEARBY) == 0)
+ && !(psPtr->flags & PAT_NEARBY)
&& (patPtr->needMods == 0)
&& (patPtr->detail.keySym < 128)
&& isprint(UCHAR(patPtr->detail.keySym))
&& (patPtr->detail.keySym != '<')
&& (patPtr->detail.keySym != ' ')) {
- c = (char) patPtr->detail.keySym;
- Tcl_DStringAppend(dsPtr, &c, 1);
+ char c = (char) patPtr->detail.keySym;
+
+ Tcl_AppendToObj(patternObj, &c, 1);
continue;
}
@@ -4431,9 +4108,7 @@ GetPatternString(
*/
if (patPtr->eventType == VirtualEvent) {
- Tcl_DStringAppend(dsPtr, "<<", 2);
- Tcl_DStringAppend(dsPtr, patPtr->detail.name, -1);
- Tcl_DStringAppend(dsPtr, ">>", 2);
+ Tcl_AppendPrintfToObj(patternObj, "<<%s>>", patPtr->detail.name);
continue;
}
@@ -4443,27 +4118,26 @@ GetPatternString(
* or button detail.
*/
- Tcl_DStringAppend(dsPtr, "<", 1);
+ Tcl_AppendToObj(patternObj, "<", 1);
if ((psPtr->flags & PAT_NEARBY) && (patsLeft > 1)
- && (memcmp((char *) patPtr, (char *) (patPtr-1),
- sizeof(TkPattern)) == 0)) {
+ && (memcmp(patPtr, patPtr-1, sizeof(TkPattern)) == 0)) {
patsLeft--;
patPtr--;
- if ((patsLeft > 1) && (memcmp((char *) patPtr,
- (char *) (patPtr-1), sizeof(TkPattern)) == 0)) {
+ if ((patsLeft > 1) &&
+ (memcmp(patPtr, patPtr-1, sizeof(TkPattern)) == 0)) {
patsLeft--;
patPtr--;
- if ((patsLeft > 1) && (memcmp((char *) patPtr,
- (char *) (patPtr-1), sizeof(TkPattern)) == 0)) {
- patsLeft--;
- patPtr--;
- Tcl_DStringAppend(dsPtr, "Quadruple-", 10);
- } else {
- Tcl_DStringAppend(dsPtr, "Triple-", 7);
- }
+ if ((patsLeft > 1) &&
+ (memcmp(patPtr, patPtr-1, sizeof(TkPattern)) == 0)) {
+ patsLeft--;
+ patPtr--;
+ Tcl_AppendToObj(patternObj, "Quadruple-", 10);
+ } else {
+ Tcl_AppendToObj(patternObj, "Triple-", 7);
+ }
} else {
- Tcl_DStringAppend(dsPtr, "Double-", 7);
+ Tcl_AppendToObj(patternObj, "Double-", 7);
}
}
@@ -4471,16 +4145,15 @@ GetPatternString(
needMods != 0; modPtr++) {
if (modPtr->mask & needMods) {
needMods &= ~modPtr->mask;
- Tcl_DStringAppend(dsPtr, modPtr->name, -1);
- Tcl_DStringAppend(dsPtr, "-", 1);
+ Tcl_AppendPrintfToObj(patternObj, "%s-", modPtr->name);
}
}
for (eiPtr = eventArray; eiPtr->name != NULL; eiPtr++) {
if (eiPtr->type == patPtr->eventType) {
- Tcl_DStringAppend(dsPtr, eiPtr->name, -1);
+ Tcl_AppendToObj(patternObj, eiPtr->name, -1);
if (patPtr->detail.clientData != 0) {
- Tcl_DStringAppend(dsPtr, "-", 1);
+ Tcl_AppendToObj(patternObj, "-", 1);
}
break;
}
@@ -4489,43 +4162,20 @@ GetPatternString(
if (patPtr->detail.clientData != 0) {
if ((patPtr->eventType == KeyPress)
|| (patPtr->eventType == KeyRelease)) {
- char *string = TkKeysymToString(patPtr->detail.keySym);
+ const char *string = TkKeysymToString(patPtr->detail.keySym);
+
if (string != NULL) {
- Tcl_DStringAppend(dsPtr, string, -1);
+ Tcl_AppendToObj(patternObj, string, -1);
}
} else {
- sprintf(buffer, "%d", patPtr->detail.button);
- Tcl_DStringAppend(dsPtr, buffer, -1);
+ Tcl_AppendPrintfToObj(patternObj, "%d", patPtr->detail.button);
}
}
- Tcl_DStringAppend(dsPtr, ">", 1);
+ Tcl_AppendToObj(patternObj, ">", 1);
}
-}
-
-/*
- *---------------------------------------------------------------------------
- *
- * EvalTclBinding --
- *
- * The function that is invoked by Tk_BindEvent when a Tcl binding is
- * fired.
- *
- * Results:
- * A standard Tcl result code, the result of globally evaluating the
- * percent-substitued binding string.
- *
- * Side effects:
- * Normal side effects due to eval.
- *
- *---------------------------------------------------------------------------
- */
-static void
-FreeTclBinding(
- ClientData clientData)
-{
- ckfree((char *) clientData);
+ return patternObj;
}
/*
@@ -4547,7 +4197,7 @@ FreeTclBinding(
KeySym
TkStringToKeysym(
- char *name) /* Name of a keysym. */
+ const char *name) /* Name of a keysym. */
{
#ifdef REDO_KEYSYM_LOOKUP
Tcl_HashEntry *hPtr = Tcl_FindHashEntry(&keySymTable, name);
@@ -4583,7 +4233,7 @@ TkStringToKeysym(
*----------------------------------------------------------------------
*/
-char *
+const char *
TkKeysymToString(
KeySym keysym)
{
@@ -4591,7 +4241,7 @@ TkKeysymToString(
Tcl_HashEntry *hPtr = Tcl_FindHashEntry(&nameTable, (char *)keysym);
if (hPtr != NULL) {
- return (char *) Tcl_GetHashValue(hPtr);
+ return Tcl_GetHashValue(hPtr);
}
#endif /* REDO_KEYSYM_LOOKUP */
@@ -4601,41 +4251,6 @@ TkKeysymToString(
/*
*----------------------------------------------------------------------
*
- * TkCopyAndGlobalEval --
- *
- * This function makes a copy of a script then calls Tcl_EvalEx to
- * evaluate it. It's used in situations where the execution of a command
- * may cause the original command string to be reallocated.
- *
- * Results:
- * Returns the result of evaluating script, including both a standard Tcl
- * completion code and a string in the interp's result.
- *
- * Side effects:
- * Any; depends on script.
- *
- *----------------------------------------------------------------------
- */
-
-int
-TkCopyAndGlobalEval(
- Tcl_Interp *interp, /* Interpreter in which to evaluate script. */
- char *script) /* Script to evaluate. */
-{
- Tcl_DString buffer;
- int code;
-
- Tcl_DStringInit(&buffer);
- Tcl_DStringAppend(&buffer, script, -1);
- code = Tcl_EvalEx(interp, Tcl_DStringValue(&buffer),
- Tcl_DStringLength(&buffer), TCL_EVAL_GLOBAL);
- Tcl_DStringFree(&buffer);
- return code;
-}
-
-/*
- *----------------------------------------------------------------------
- *
* TkpGetBindingXEvent --
*
* This function returns the XEvent associated with the currently
@@ -4657,7 +4272,7 @@ TkpGetBindingXEvent(
Tcl_Interp *interp) /* Interpreter. */
{
TkWindow *winPtr = (TkWindow *) Tk_MainWindow(interp);
- BindingTable *bindPtr = (BindingTable *) winPtr->mainPtr->bindingTable;
+ BindingTable *bindPtr = winPtr->mainPtr->bindingTable;
return &(bindPtr->eventRing[bindPtr->curEvent]);
}