diff options
Diffstat (limited to 'generic/tkBind.c')
| -rw-r--r-- | generic/tkBind.c | 1079 |
1 files changed, 358 insertions, 721 deletions
diff --git a/generic/tkBind.c b/generic/tkBind.c index c4f8226..567c51f 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,18 @@ Tk_BindEvent( } } - bindPtr = (BindingTable *) bindingTable; + /* + * Ignore event types which are not in flagArray and all zeroes there. + * Most notably, NoExpose events can fill the ring buffer and disturb + * (thus masking out) event sequences of interest. + */ + + if ((eventPtr->type >= TK_LASTEVENT) || !flagArray[eventPtr->type]) { + return; + } + 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 +1331,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 +1365,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 +1381,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 +1404,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 +1423,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 +1466,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 +1483,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 +1502,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 +1517,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 +1535,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 +1577,7 @@ TkBindDeadWindow( * *---------------------------------------------------------------------- */ + static PatSeq * MatchPatterns( TkDisplay *dispPtr, /* Display from which the event came. */ @@ -2147,7 +1801,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 +2192,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 +2243,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 +2310,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 +2348,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 +2362,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 +2387,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 +2403,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 +2415,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 +2478,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 +2519,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 +2555,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 +2572,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 +2585,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 +2627,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 +2646,7 @@ DeleteVirtualEvent( if (vhPtr == NULL) { return TCL_OK; } - poPtr = (PhysicalsOwned *) Tcl_GetHashValue(vhPtr); + poPtr = Tcl_GetHashValue(vhPtr); eventPSPtr = NULL; if (eventString != NULL) { @@ -3016,7 +2661,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 +2695,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 +2715,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 +2753,7 @@ DeleteVirtualEvent( * itself should be deleted. */ - ckfree((char *) poPtr); + ckfree(poPtr); Tcl_DeleteHashEntry(vhPtr); } return TCL_OK; @@ -3140,15 +2785,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 +2803,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 +2839,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 +2894,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 +2902,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 +2934,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 +2952,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 +3004,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 +3024,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 +3036,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 +3174,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 +3366,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 +3420,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 +3444,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 +3467,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(dispPtr->display, + 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 +3489,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,15 +3538,27 @@ NameToWindow( * *------------------------------------------------------------------------- */ + static void DoWarp( ClientData clientData) { - TkDisplay *dispPtr = (TkDisplay *) clientData; + TkDisplay *dispPtr = clientData; + + /* + * DoWarp was scheduled only if the window was mapped. It needs to be + * still mapped at the time the present idle callback is executed. Also + * one needs to guard against window destruction in the meantime. + * Finally, the case warpWindow == NULL is special in that it means + * the whole screen. + */ - XWarpPointer(dispPtr->display, (Window) None, (Window) dispPtr->warpWindow, - 0, 0, 0, 0, (int) dispPtr->warpX, (int) dispPtr->warpY); - XForceScreenSaver(dispPtr->display, ScreenSaverReset); + if ((dispPtr->warpWindow == NULL) || + (Tk_IsMapped(dispPtr->warpWindow) + && (Tk_WindowId(dispPtr->warpWindow) != None))) { + TkpWarpPointer(dispPtr); + XForceScreenSaver(dispPtr->display, ScreenSaverReset); + } dispPtr->flags &= ~TK_DISPLAY_IN_WARP; } @@ -3908,8 +3594,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 +3688,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 +3718,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 +3739,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 +3763,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 +3845,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 +3888,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 +3930,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 +3948,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 +3965,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 +3979,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 +4012,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 +4076,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 +4113,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 +4130,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 +4140,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 +4167,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 +4184,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 +4219,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 +4255,7 @@ TkStringToKeysym( *---------------------------------------------------------------------- */ -char * +const char * TkKeysymToString( KeySym keysym) { @@ -4591,7 +4263,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 +4273,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 +4294,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]); } |