From 8b0817c5ff3553c35d243c6ed17108fb423971ee Mon Sep 17 00:00:00 2001 From: jenglish Date: Sat, 19 Jun 2010 16:18:41 +0000 Subject: [Patch 3009998]: Replace binding procedures with ordinary event handlers in win/tkWinScrlbr.c and carbon/tkMacOSXScrlbr.c. Simplifications enabled by previous change: * TkCreateBindingProcedure() and associated machinery no longer needed. * TkBindDeadWindow() no longer needed. * TK_DEFER_MODAL_LOOP and associated machinery no longer needed. * Tests related to C binding procedures no longer needed. --- ChangeLog | 14 ++ carbon/tkMacOSXScrlbr.c | 209 ++++++++++------------ generic/tk.h | 6 +- generic/tkBind.c | 465 +++++------------------------------------------- generic/tkInt.decls | 17 +- generic/tkInt.h | 10 +- generic/tkIntDecls.h | 33 +--- generic/tkStubInit.c | 6 +- generic/tkTest.c | 123 +------------ generic/tkWindow.c | 3 +- tests/bind.test | 355 ++---------------------------------- win/tkWinScrlbr.c | 87 +++------ 12 files changed, 202 insertions(+), 1126 deletions(-) diff --git a/ChangeLog b/ChangeLog index 16e1f0b..d28853a 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,17 @@ +2010-06-19 Joe English + + * win/tkWinScrlbr.c, carbon/tkMacOSXScrlbr.c: Replace binding + procedures with ordinary event handlers [Patch 3009998]. + * generic/tkBind.c, generic/tk.h, generic/tkInt.h, + generic/tkInt.decls: Simplifications enabled by previous change: + TkCreateBindingProcedure() and associated machinery + no longer needed; TkBindDeadWindow() no longer needed; + TK_DEFER_MODAL_LOOP and associated machinery no longer needed. + * generic/tkTest.c, tests/bind.test: Tests related to C binding + procedures no longer needed. + * generic/tkWindow.c: TkBindDeadWindow() no longer needed. + * generic/tkIntDecls.h, generic/tkStubInit.c: Regenerated. + 2010-06-15 Joe English * library/ttk/ttk.tcl: Bump dummy [package ifneeded tile] version diff --git a/carbon/tkMacOSXScrlbr.c b/carbon/tkMacOSXScrlbr.c index 21c5083..8c83965 100644 --- a/carbon/tkMacOSXScrlbr.c +++ b/carbon/tkMacOSXScrlbr.c @@ -12,7 +12,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkMacOSXScrlbr.c,v 1.3 2010/02/17 19:21:17 nijtmans Exp $ + * RCS: @(#) $Id: tkMacOSXScrlbr.c,v 1.4 2010/06/19 16:18:41 jenglish Exp $ */ #include "tkMacOSXPrivate.h" @@ -77,9 +77,7 @@ static pascal void ScrollbarActionProc(ControlRef theControl, ControlPartCode partCode); static pascal void ThumbActionProc(ControlRef theControl, ControlPartCode partCode); -static int ScrollbarBindProc(ClientData clientData, - Tcl_Interp *interp, XEvent *eventPtr, - Tk_Window tkwin, KeySym keySym); +static int ScrollbarPress(MacScrollbar *, XEvent *); static void ScrollbarEventProc(ClientData clientData, XEvent *eventPtr); static void UpdateControlValues(MacScrollbar *macScrollPtr); @@ -165,7 +163,6 @@ TkpCreateScrollbar( { static int initialized = 0; MacScrollbar * macScrollPtr; - TkWindow *winPtr = (TkWindow *)tkwin; if (scrollActionProc == NULL) { scrollActionProc = NewControlActionUPP(ScrollbarActionProc); @@ -181,17 +178,9 @@ TkpCreateScrollbar( SetRect(&macScrollPtr->eraseRect, 0, 0, 0, 0); Tk_CreateEventHandler(tkwin, ActivateMask|ExposureMask| - StructureNotifyMask|FocusChangeMask, + StructureNotifyMask|FocusChangeMask|ButtonPressMask, ScrollbarEventProc, (ClientData) macScrollPtr); - if (!Tcl_GetAssocData(winPtr->mainPtr->interp, "TkScrollbar", NULL)) { - Tcl_SetAssocData(winPtr->mainPtr->interp, "TkScrollbar", NULL, - (ClientData)1); - TkCreateBindingProcedure(winPtr->mainPtr->interp, - winPtr->mainPtr->bindingTable, - (ClientData)Tk_GetUid("Scrollbar"), "", - ScrollbarBindProc, NULL, NULL); - } return (TkScrollbar *) macScrollPtr; } @@ -719,134 +708,118 @@ ScrollbarActionProc( /* *-------------------------------------------------------------- * - * ScrollbarBindProc -- - * - * This procedure is invoked when the default binding on - * the Scrollbar bind tag fires. + * ScrollbarPress -- * - * Results: - * None. - * - * Side effects: - * The event enters a modal loop. + * This procedure is invoked in response to events. + * Enters a modal loop to handle scrollbar interactions. * *-------------------------------------------------------------- */ static int -ScrollbarBindProc( - ClientData clientData, /* Not used. */ - Tcl_Interp *interp, /* Interp with binding. */ - XEvent *eventPtr, /* X event that triggered binding. */ - Tk_Window tkwin, /* Target window for event. */ - KeySym keySym) /* The KeySym if a key event. */ +ScrollbarPress(MacScrollbar *macScrollPtr, XEvent *eventPtr) { - TkWindow *winPtr = (TkWindow *) tkwin; - TkScrollbar *scrollPtr = (TkScrollbar *) winPtr->instanceData; - MacScrollbar *macScrollPtr = (MacScrollbar *) winPtr->instanceData; + TkScrollbar *scrollPtr = &macScrollPtr->info; + Point where; + Rect bounds; + ControlPartCode part; + CGrafPtr destPort, savePort; + Boolean portChanged; + Window window; Tcl_Preserve(scrollPtr); macScrollPtr->macFlags |= IN_MODAL_LOOP; - if (eventPtr->type == ButtonPress) { - Point where; - Rect bounds; - ControlPartCode part; - CGrafPtr destPort, savePort; - Boolean portChanged; - Window window; + /* + * To call Macintosh control routines we must have the port set to the + * window containing the control. We will then test which part of the + * control was hit and act accordingly. + */ + destPort = TkMacOSXGetDrawablePort(Tk_WindowId(scrollPtr->tkwin)); + portChanged = QDSwapPort(destPort, &savePort); + TkMacOSXSetUpClippingRgn(Tk_WindowId(scrollPtr->tkwin)); + + TkMacOSXWinBounds((TkWindow *) scrollPtr->tkwin, &bounds); + where.h = eventPtr->xbutton.x + bounds.left; + where.v = eventPtr->xbutton.y + bounds.top; + part = TestControl(macScrollPtr->sbHandle, where); + TkMacOSXTrackingLoop(1); + if (part == kAppearancePartIndicator && scrollPtr->jump == false) { /* - * To call Macintosh control routines we must have the port set to the - * window containing the control. We will then test which part of the - * control was hit and act accordingly. + * Case 1: In thumb, no jump scrolling. Call track control with + * the thumb action proc which will do most of the work. */ - destPort = TkMacOSXGetDrawablePort(Tk_WindowId(scrollPtr->tkwin)); - portChanged = QDSwapPort(destPort, &savePort); - TkMacOSXSetUpClippingRgn(Tk_WindowId(scrollPtr->tkwin)); - - TkMacOSXWinBounds((TkWindow *) scrollPtr->tkwin, &bounds); - where.h = eventPtr->xbutton.x + bounds.left; - where.v = eventPtr->xbutton.y + bounds.top; - part = TestControl(macScrollPtr->sbHandle, where); - TkMacOSXTrackingLoop(1); - if (part == kAppearancePartIndicator && scrollPtr->jump == false) { - /* - * Case 1: In thumb, no jump scrolling. Call track control with - * the thumb action proc which will do most of the work. - */ - - mouseDownPoint.h = where.h; - mouseDownPoint.v = where.v; - HandleControlClick(macScrollPtr->sbHandle, where, - TkMacOSXModifierState(), thumbActionProc); - } else if (part == kAppearancePartIndicator) { - /* - * Case 2: in thumb with jump scrolling. Call HandleControlClick - * with a NULL action proc. Use the new value of the control to - * set update the control. - */ - - part = HandleControlClick(macScrollPtr->sbHandle, where, - TkMacOSXModifierState(), NULL); - if (part == kAppearancePartIndicator) { - Tcl_DString cmdString; - char valueString[TCL_DOUBLE_SPACE]; - - Tcl_PrintDouble(NULL, - (GetControl32BitValue(macScrollPtr->sbHandle) - - MIN_SCROLLBAR_VALUE) / SCROLLBAR_SCALING_VALUE, - valueString); - Tcl_DStringInit(&cmdString); - Tcl_DStringAppend(&cmdString, scrollPtr->command, - strlen(scrollPtr->command)); - Tcl_DStringAppendElement(&cmdString, "moveto"); - Tcl_DStringAppendElement(&cmdString, valueString); - - interp = scrollPtr->interp; - Tcl_Preserve(interp); - Tcl_EvalEx(interp, Tcl_DStringValue(&cmdString), - Tcl_DStringLength(&cmdString), TCL_EVAL_GLOBAL); - Tcl_Release(interp); - Tcl_DStringFree(&cmdString); - TkMacOSXRunTclEventLoop(); - } - } else if (part != 0) { - /* - * Case 3: in any other part of the scrollbar. We call - * HandleControlClick with the scrollActionProc which will do most - * all the work. - */ - - HandleControlClick(macScrollPtr->sbHandle, where, - TkMacOSXModifierState(), scrollActionProc); + mouseDownPoint.h = where.h; + mouseDownPoint.v = where.v; + HandleControlClick(macScrollPtr->sbHandle, where, + TkMacOSXModifierState(), thumbActionProc); + } else if (part == kAppearancePartIndicator) { + /* + * Case 2: in thumb with jump scrolling. Call HandleControlClick + * with a NULL action proc. Use the new value of the control to + * set update the control. + */ - /* - * Workaround for Carbon bug where the scrollbar down arrow - * sometimes gets "stuck" after the mousebutton has been released. - */ + part = HandleControlClick(macScrollPtr->sbHandle, where, + TkMacOSXModifierState(), NULL); + if (part == kAppearancePartIndicator) { + Tcl_Interp *interp = scrollPtr->interp; + Tcl_DString cmdString; + char valueString[TCL_DOUBLE_SPACE]; + + Tcl_PrintDouble(NULL, + (GetControl32BitValue(macScrollPtr->sbHandle) - + MIN_SCROLLBAR_VALUE) / SCROLLBAR_SCALING_VALUE, + valueString); + Tcl_DStringInit(&cmdString); + Tcl_DStringAppend(&cmdString, scrollPtr->command, + strlen(scrollPtr->command)); + Tcl_DStringAppendElement(&cmdString, "moveto"); + Tcl_DStringAppendElement(&cmdString, valueString); - if (scrollPtr->tkwin) { - TkMacOSXSetUpClippingRgn(Tk_WindowId(scrollPtr->tkwin)); - } - Draw1Control(macScrollPtr->sbHandle); + Tcl_Preserve(interp); + Tcl_EvalEx(interp, Tcl_DStringValue(&cmdString), + Tcl_DStringLength(&cmdString), TCL_EVAL_GLOBAL); + Tcl_Release(interp); + Tcl_DStringFree(&cmdString); + TkMacOSXRunTclEventLoop(); } - TkMacOSXTrackingLoop(0); + } else if (part != 0) { + /* + * Case 3: in any other part of the scrollbar. We call + * HandleControlClick with the scrollActionProc which will do most + * all the work. + */ + + HandleControlClick(macScrollPtr->sbHandle, where, + TkMacOSXModifierState(), scrollActionProc); /* - * The HandleControlClick call will "eat" the ButtonUp event. We now - * generate a ButtonUp event so Tk will unset implicit grabs etc. + * Workaround for Carbon bug where the scrollbar down arrow + * sometimes gets "stuck" after the mousebutton has been released. */ if (scrollPtr->tkwin) { - window = Tk_WindowId(scrollPtr->tkwin); - TkGenerateButtonEventForXPointer(window); + TkMacOSXSetUpClippingRgn(Tk_WindowId(scrollPtr->tkwin)); } + Draw1Control(macScrollPtr->sbHandle); + } + TkMacOSXTrackingLoop(0); - if (portChanged) { - QDSwapPort(savePort, NULL); - } + /* + * The HandleControlClick call will "eat" the ButtonUp event. We now + * generate a ButtonUp event so Tk will unset implicit grabs etc. + */ + + if (scrollPtr->tkwin) { + window = Tk_WindowId(scrollPtr->tkwin); + TkGenerateButtonEventForXPointer(window); + } + + if (portChanged) { + QDSwapPort(savePort, NULL); } if (macScrollPtr->sbHandle && (macScrollPtr->macFlags & ALREADY_DEAD)) { @@ -893,6 +866,8 @@ ScrollbarEventProc( } else if (eventPtr->type == DeactivateNotify) { macScrollPtr->macFlags &= ~ACTIVE; TkScrollbarEventuallyRedraw((ClientData) scrollPtr); + } else if (eventPtr->type == ButtonPress) { + ScrollbarPress(macScrollPtr, eventPtr); } else { TkScrollbarEventProc(clientData, eventPtr); } diff --git a/generic/tk.h b/generic/tk.h index 5937296..10db9a7 100644 --- a/generic/tk.h +++ b/generic/tk.h @@ -12,7 +12,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tk.h,v 1.134 2010/05/03 16:30:15 dgp Exp $ + * RCS: @(#) $Id: tk.h,v 1.135 2010/06/19 16:18:41 jenglish Exp $ */ #ifndef _TK @@ -833,9 +833,6 @@ typedef struct Tk_FakeWin { * embedded application), and both the containing * and embedded halves are associated with * windows in this particular process. - * TK_DEFER_MODAL: 1 means that this window has deferred a modal - * loop until all of the bindings for the current - * event have been invoked. * TK_WRAPPER: 1 means that this window is the extra wrapper * window created around a toplevel to hold the * menubar under Unix. See tkUnixWm.c for more @@ -872,7 +869,6 @@ typedef struct Tk_FakeWin { #define TK_EMBEDDED 0x100 #define TK_CONTAINER 0x200 #define TK_BOTH_HALVES 0x400 -#define TK_DEFER_MODAL 0x800 #define TK_WRAPPER 0x1000 #define TK_REPARENTED 0x2000 #define TK_ANONYMOUS_WINDOW 0x4000 diff --git a/generic/tkBind.c b/generic/tkBind.c index c610330..bf21e59 100644 --- a/generic/tkBind.c +++ b/generic/tkBind.c @@ -11,7 +11,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkBind.c,v 1.66 2010/05/31 17:35:29 jenglish Exp $ + * RCS: @(#) $Id: tkBind.c,v 1.67 2010/06/19 16:18:41 jenglish Exp $ */ #include "tkInt.h" @@ -78,7 +78,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). */ @@ -112,7 +112,7 @@ typedef struct BindingTable { * 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 @@ -139,7 +139,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 @@ -155,7 +155,7 @@ typedef struct PatternTableKey { * events as part of the process of converting X events into Tcl commands. */ -typedef struct Pattern { +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). */ @@ -192,21 +192,10 @@ typedef struct Pattern { 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. */ @@ -237,16 +226,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 @@ -274,7 +256,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 @@ -297,44 +279,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; @@ -660,7 +615,6 @@ static int DeleteVirtualEvent(Tcl_Interp *interp, static void DeleteVirtualEventTable(VirtualEventTable *vetPtr); static void ExpandPercents(TkWindow *winPtr, const char *before, XEvent *eventPtr,KeySym keySym,Tcl_DString *dsPtr); -static void FreeTclBinding(ClientData clientData); static PatSeq * FindSequence(Tcl_Interp *interp, Tcl_HashTable *patternTablePtr, ClientData object, const char *eventString, int create, @@ -686,15 +640,6 @@ static int ParseEventDescription(Tcl_Interp *interp, const char **eventStringPtr, Pattern *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) /* *--------------------------------------------------------------------------- @@ -775,9 +720,8 @@ TkBindInit( 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); } @@ -808,7 +752,7 @@ TkBindFree( Tk_DeleteBindingTable(mainPtr->bindingTable); mainPtr->bindingTable = NULL; - bindInfoPtr = (BindInfo *) mainPtr->bindInfo; + bindInfoPtr = mainPtr->bindInfo; DeleteVirtualEventTable(&bindInfoPtr->virtualEventTable); bindInfoPtr->deleted = 1; Tcl_EventuallyFree(bindInfoPtr, TCL_DYNAMIC); @@ -854,7 +798,7 @@ Tk_CreateBindingTable( sizeof(PatternTableKey)/sizeof(int)); Tcl_InitHashTable(&bindPtr->objectTable, TCL_ONE_WORD_KEYS); bindPtr->interp = interp; - return (Tk_BindingTable) bindPtr; + return bindPtr; } /* @@ -876,10 +820,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,13 +834,8 @@ Tk_DeleteBindingTable( hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) { 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((char *) psPtr); } } @@ -938,13 +875,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 *script, /* Contains Tcl script 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 @@ -953,7 +889,6 @@ Tk_CreateBinding( * string, the existing binding will always be * replaced. */ { - BindingTable *bindPtr = (BindingTable *) bindingTable; PatSeq *psPtr; unsigned long eventMask; char *newStr, *oldStr; @@ -967,7 +902,7 @@ Tk_CreateBinding( if (psPtr == NULL) { return 0; } - if (psPtr->eventProc == NULL) { + if (psPtr->script == NULL) { int isNew; Tcl_HashEntry *hPtr; @@ -985,19 +920,9 @@ Tk_CreateBinding( 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 = psPtr->clientData; + oldStr = psPtr->script; if ((append != 0) && (oldStr != NULL)) { size_t length1 = strlen(oldStr), length2 = strlen(script); @@ -1014,91 +939,7 @@ Tk_CreateBinding( if (oldStr != NULL) { ckfree(oldStr); } - psPtr->eventProc = EvalTclBinding; - psPtr->freeProc = FreeTclBinding; - psPtr->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 = 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 +964,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; @@ -1184,13 +1023,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((char *) psPtr); return TCL_OK; } @@ -1218,14 +1052,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 +1066,7 @@ Tk_GetBinding( if (psPtr == NULL) { return NULL; } - if (psPtr->eventProc == EvalTclBinding) { - return (const char *) psPtr->clientData; - } - return ""; + return psPtr->script; } /* @@ -1263,11 +1092,9 @@ 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; @@ -1310,11 +1137,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; @@ -1351,14 +1176,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((char *) psPtr); } Tcl_DeleteHashEntry(hPtr); } @@ -1384,21 +1203,13 @@ Tk_DeleteAllBindings( * 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,23 +1218,19 @@ 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, i; Tcl_Interp *interp; Tcl_DString scripts, savedResult; 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 @@ -1454,9 +1261,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. @@ -1566,13 +1372,9 @@ 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; - matchSpace = sizeof(staticPending.matchArray) / sizeof(PatSeq *); Tcl_DStringInit(&scripts); for ( ; numObjects > 0; numObjects--, objectPtr++) { @@ -1618,39 +1420,11 @@ Tk_BindEvent( 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, sourcePtr->clientData, eventPtr, - detail.keySym, &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(newPtr, pendingPtr, oldSize); - if (pendingPtr != &staticPending) { - ckfree((char *) pendingPtr); - } - pendingPtr = newPtr; - } - sourcePtr->refCount++; - pendingPtr->matchArray[matchCount] = sourcePtr; - matchCount++; - } + ExpandPercents(winPtr, sourcePtr->script, eventPtr, + detail.keySym, &scripts); /* * A "" is added to the scripts string to separate the various @@ -1700,28 +1474,6 @@ 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; @@ -1734,6 +1486,7 @@ Tk_BindEvent( Tcl_Preserve(bindInfoPtr); while (p < end) { + int len = (int) strlen(p); int code; if (!bindInfoPtr->deleted) { @@ -1741,31 +1494,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--; @@ -1785,23 +1515,6 @@ Tk_BindEvent( } } - 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))) { @@ -1817,74 +1530,10 @@ Tk_BindEvent( Tcl_DStringResult(interp, &savedResult); 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(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; - } -} - -/* *---------------------------------------------------------------------- * * MatchPatterns -- @@ -2704,8 +2353,8 @@ Tk_EventObjCmd( char *name; const char *event; Tk_Window tkwin = clientData; - VirtualEventTable *vetPtr; - TkBindInfo bindInfo; + TkBindInfo bindInfo = ((TkWindow *) tkwin)->mainPtr->bindInfo; + VirtualEventTable *vetPtr = &bindInfo->virtualEventTable; static const char *const optionStrings[] = { "add", "delete", "generate", "info", NULL @@ -2714,8 +2363,6 @@ Tk_EventObjCmd( EVENT_ADD, EVENT_DELETE, EVENT_GENERATE, EVENT_INFO }; - bindInfo = ((TkWindow *) tkwin)->mainPtr->bindInfo; - vetPtr = &((BindInfo *) bindInfo)->virtualEventTable; if (objc < 2) { Tcl_WrongNumArgs(interp, 1, objv, "option ?arg?"); @@ -4095,11 +3742,8 @@ FindSequence( psPtr = (PatSeq *) ckalloc((unsigned) (sizeof(PatSeq) + (numPats-1)*sizeof(Pattern))); psPtr->numPats = numPats; - psPtr->eventProc = NULL; - psPtr->freeProc = NULL; - psPtr->clientData = NULL; + psPtr->script = NULL; psPtr->flags = flags; - psPtr->refCount = 0; psPtr->nextSeqPtr = Tcl_GetHashValue(hPtr); psPtr->hPtr = hPtr; psPtr->voPtr = NULL; @@ -4523,31 +4167,6 @@ GetPatternString( } /* - *--------------------------------------------------------------------------- - * - * 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); -} - -/* *---------------------------------------------------------------------- * * TkStringToKeysym -- @@ -4678,7 +4297,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]); } diff --git a/generic/tkInt.decls b/generic/tkInt.decls index eea2ea4..6dd4d35 100644 --- a/generic/tkInt.decls +++ b/generic/tkInt.decls @@ -10,7 +10,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: tkInt.decls,v 1.61 2010/05/10 20:58:18 nijtmans Exp $ +# RCS: @(#) $Id: tkInt.decls,v 1.62 2010/06/19 16:18:41 jenglish Exp $ library tk @@ -36,9 +36,9 @@ declare 2 generic { void TkBezierScreenPoints(Tk_Canvas canvas, double control[], int numSteps, XPoint *xPointPtr) } -declare 3 generic { - void TkBindDeadWindow(TkWindow *winPtr) -} +# +# Slot 3 unused (WAS: TkBindDeadWindow) +# declare 4 generic { void TkBindEventProc(TkWindow *winPtr, XEvent *eventPtr) } @@ -61,12 +61,9 @@ declare 9 generic { declare 10 generic { int TkCopyAndGlobalEval(Tcl_Interp *interp, const char *script) } -declare 11 generic { - unsigned long TkCreateBindingProcedure(Tcl_Interp *interp, - Tk_BindingTable bindingTable, ClientData object, - const char *eventString, TkBindEvalProc *evalProc, - TkBindFreeProc *freeProc, ClientData clientData) -} +# +# Slot 11 unused (WAS: TkCreateBindingProcedure) +# declare 12 generic { TkCursor *TkCreateCursorFromData(Tk_Window tkwin, const char *source, const char *mask, int width, int height, diff --git a/generic/tkInt.h b/generic/tkInt.h index 0f8b4f1..7722da3 100644 --- a/generic/tkInt.h +++ b/generic/tkInt.h @@ -11,7 +11,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: $Id: tkInt.h,v 1.122 2010/04/23 08:32:56 nijtmans Exp $ + * RCS: $Id: tkInt.h,v 1.123 2010/06/19 16:18:41 jenglish Exp $ */ #ifndef _TKINT @@ -100,14 +100,6 @@ typedef struct TkBindInfo_ *TkBindInfo; typedef struct Busy *TkBusy; /* - * Function types. - */ - -typedef int (TkBindEvalProc)(ClientData clientData, Tcl_Interp *interp, - XEvent *eventPtr, Tk_Window tkwin, KeySym keySym); -typedef void (TkBindFreeProc)(ClientData clientData); - -/* * One of the following structures is maintained for each cursor in use in the * system. This structure is used by tkCursor.c and the various system- * specific cursor files. diff --git a/generic/tkIntDecls.h b/generic/tkIntDecls.h index 020b584..a486843 100644 --- a/generic/tkIntDecls.h +++ b/generic/tkIntDecls.h @@ -11,7 +11,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkIntDecls.h,v 1.50 2010/05/10 20:58:18 nijtmans Exp $ + * RCS: @(#) $Id: tkIntDecls.h,v 1.51 2010/06/19 16:18:41 jenglish Exp $ */ #ifndef _TKINTDECLS @@ -60,11 +60,7 @@ EXTERN void TkBezierScreenPoints(Tk_Canvas canvas, double control[], int numSteps, XPoint *xPointPtr); #endif -#ifndef TkBindDeadWindow_TCL_DECLARED -#define TkBindDeadWindow_TCL_DECLARED -/* 3 */ -EXTERN void TkBindDeadWindow(TkWindow *winPtr); -#endif +/* Slot 3 is reserved */ #ifndef TkBindEventProc_TCL_DECLARED #define TkBindEventProc_TCL_DECLARED /* 4 */ @@ -104,16 +100,7 @@ EXTERN void TkComputeAnchor(Tk_Anchor anchor, Tk_Window tkwin, EXTERN int TkCopyAndGlobalEval(Tcl_Interp *interp, const char *script); #endif -#ifndef TkCreateBindingProcedure_TCL_DECLARED -#define TkCreateBindingProcedure_TCL_DECLARED -/* 11 */ -EXTERN unsigned long TkCreateBindingProcedure(Tcl_Interp *interp, - Tk_BindingTable bindingTable, - ClientData object, const char *eventString, - TkBindEvalProc *evalProc, - TkBindFreeProc *freeProc, - ClientData clientData); -#endif +/* Slot 11 is reserved */ #ifndef TkCreateCursorFromData_TCL_DECLARED #define TkCreateCursorFromData_TCL_DECLARED /* 12 */ @@ -1120,7 +1107,7 @@ typedef struct TkIntStubs { TkWindow * (*tkAllocWindow) (TkDisplay *dispPtr, int screenNum, TkWindow *parentPtr); /* 0 */ void (*tkBezierPoints) (double control[], int numSteps, double *coordPtr); /* 1 */ void (*tkBezierScreenPoints) (Tk_Canvas canvas, double control[], int numSteps, XPoint *xPointPtr); /* 2 */ - void (*tkBindDeadWindow) (TkWindow *winPtr); /* 3 */ + void *reserved3; void (*tkBindEventProc) (TkWindow *winPtr, XEvent *eventPtr); /* 4 */ void (*tkBindFree) (TkMainInfo *mainPtr); /* 5 */ void (*tkBindInit) (TkMainInfo *mainPtr); /* 6 */ @@ -1128,7 +1115,7 @@ typedef struct TkIntStubs { int (*tkClipInit) (Tcl_Interp *interp, TkDisplay *dispPtr); /* 8 */ void (*tkComputeAnchor) (Tk_Anchor anchor, Tk_Window tkwin, int padX, int padY, int innerWidth, int innerHeight, int *xPtr, int *yPtr); /* 9 */ int (*tkCopyAndGlobalEval) (Tcl_Interp *interp, const char *script); /* 10 */ - unsigned long (*tkCreateBindingProcedure) (Tcl_Interp *interp, Tk_BindingTable bindingTable, ClientData object, const char *eventString, TkBindEvalProc *evalProc, TkBindFreeProc *freeProc, ClientData clientData); /* 11 */ + void *reserved11; TkCursor * (*tkCreateCursorFromData) (Tk_Window tkwin, const char *source, const char *mask, int width, int height, int xHot, int yHot, XColor fg, XColor bg); /* 12 */ int (*tkCreateFrame) (ClientData clientData, Tcl_Interp *interp, int argc, const char *const *argv, int toplevel, const char *appName); /* 13 */ Tk_Window (*tkCreateMainWindow) (Tcl_Interp *interp, const char *screenName, const char *baseName); /* 14 */ @@ -1421,10 +1408,7 @@ extern const TkIntStubs *tkIntStubsPtr; #define TkBezierScreenPoints \ (tkIntStubsPtr->tkBezierScreenPoints) /* 2 */ #endif -#ifndef TkBindDeadWindow -#define TkBindDeadWindow \ - (tkIntStubsPtr->tkBindDeadWindow) /* 3 */ -#endif +/* Slot 3 is reserved */ #ifndef TkBindEventProc #define TkBindEventProc \ (tkIntStubsPtr->tkBindEventProc) /* 4 */ @@ -1453,10 +1437,7 @@ extern const TkIntStubs *tkIntStubsPtr; #define TkCopyAndGlobalEval \ (tkIntStubsPtr->tkCopyAndGlobalEval) /* 10 */ #endif -#ifndef TkCreateBindingProcedure -#define TkCreateBindingProcedure \ - (tkIntStubsPtr->tkCreateBindingProcedure) /* 11 */ -#endif +/* Slot 11 is reserved */ #ifndef TkCreateCursorFromData #define TkCreateCursorFromData \ (tkIntStubsPtr->tkCreateCursorFromData) /* 12 */ diff --git a/generic/tkStubInit.c b/generic/tkStubInit.c index 92925c2..af5beed 100644 --- a/generic/tkStubInit.c +++ b/generic/tkStubInit.c @@ -8,7 +8,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkStubInit.c,v 1.73 2010/02/16 21:12:56 nijtmans Exp $ + * RCS: @(#) $Id: tkStubInit.c,v 1.74 2010/06/19 16:18:41 jenglish Exp $ */ #include "tkInt.h" @@ -57,7 +57,7 @@ static const TkIntStubs tkIntStubs = { TkAllocWindow, /* 0 */ TkBezierPoints, /* 1 */ TkBezierScreenPoints, /* 2 */ - TkBindDeadWindow, /* 3 */ + NULL, /* 3 */ TkBindEventProc, /* 4 */ TkBindFree, /* 5 */ TkBindInit, /* 6 */ @@ -65,7 +65,7 @@ static const TkIntStubs tkIntStubs = { TkClipInit, /* 8 */ TkComputeAnchor, /* 9 */ TkCopyAndGlobalEval, /* 10 */ - TkCreateBindingProcedure, /* 11 */ + NULL, /* 11 */ TkCreateCursorFromData, /* 12 */ TkCreateFrame, /* 13 */ TkCreateMainWindow, /* 14 */ diff --git a/generic/tkTest.c b/generic/tkTest.c index 4b693f0..58093c2 100644 --- a/generic/tkTest.c +++ b/generic/tkTest.c @@ -13,7 +13,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkTest.c,v 1.48 2010/06/15 11:16:03 nijtmans Exp $ + * RCS: @(#) $Id: tkTest.c,v 1.49 2010/06/19 16:18:41 jenglish Exp $ */ #undef STATIC_BUILD @@ -114,12 +114,6 @@ typedef struct NewApp { static NewApp *newAppPtr = NULL;/* First in list of all new interpreters. */ -typedef struct CBinding { - Tcl_Interp *interp; - char *command; - char *delete; -} CBinding; - /* * Header for trivial configuration command items. */ @@ -147,14 +141,8 @@ typedef struct TrivialCommandHeader { * Forward declarations for functions defined later in this file: */ -static int CBindingEvalProc(ClientData clientData, - Tcl_Interp *interp, XEvent *eventPtr, - Tk_Window tkwin, KeySym keySym); -static void CBindingFreeProc(ClientData clientData); static int ImageCmd(ClientData dummy, Tcl_Interp *interp, int argc, const char **argv); -static int TestcbindCmd(ClientData dummy, - Tcl_Interp *interp, int argc, const char **argv); static int TestbitmapObjCmd(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj * const objv[]); @@ -250,8 +238,6 @@ Tktest_Init( } Tcl_CreateObjCommand(interp, "square", SquareObjCmd, NULL, NULL); - Tcl_CreateCommand(interp, "testcbind", TestcbindCmd, - (ClientData) Tk_MainWindow(interp), NULL); Tcl_CreateObjCommand(interp, "testbitmap", TestbitmapObjCmd, (ClientData) Tk_MainWindow(interp), NULL); Tcl_CreateObjCommand(interp, "testborder", TestborderObjCmd, @@ -314,113 +300,6 @@ Tktest_Init( /* *---------------------------------------------------------------------- * - * TestcbindCmd -- - * - * This function implements the "testcbinding" command. It provides a set - * of functions for testing C bindings in tkBind.c. - * - * Results: - * A standard Tcl result. - * - * Side effects: - * Depends on option; see below. - * - *---------------------------------------------------------------------- - */ - -static int -TestcbindCmd( - ClientData clientData, /* Main window for application. */ - Tcl_Interp *interp, /* Current interpreter. */ - int argc, /* Number of arguments. */ - const char **argv) /* Argument strings. */ -{ - TkWindow *winPtr; - Tk_Window tkwin; - ClientData object; - CBinding *cbindPtr; - - - if (argc < 4 || argc > 5) { - Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], - " bindtag pattern command ?deletecommand?", NULL); - return TCL_ERROR; - } - - tkwin = (Tk_Window) clientData; - - if (argv[1][0] == '.') { - winPtr = (TkWindow *) Tk_NameToWindow(interp, argv[1], tkwin); - if (winPtr == NULL) { - return TCL_ERROR; - } - object = (ClientData) winPtr->pathName; - } else { - winPtr = (TkWindow *) clientData; - object = (ClientData) Tk_GetUid(argv[1]); - } - - if (argv[3][0] == '\0') { - return Tk_DeleteBinding(interp, winPtr->mainPtr->bindingTable, - object, argv[2]); - } - - cbindPtr = (CBinding *) ckalloc(sizeof(CBinding)); - cbindPtr->interp = interp; - cbindPtr->command = - strcpy((char *) ckalloc(strlen(argv[3]) + 1), argv[3]); - if (argc == 4) { - cbindPtr->delete = NULL; - } else { - cbindPtr->delete = - strcpy((char *) ckalloc(strlen(argv[4]) + 1), argv[4]); - } - - if (TkCreateBindingProcedure(interp, winPtr->mainPtr->bindingTable, - object, argv[2], CBindingEvalProc, CBindingFreeProc, - (ClientData) cbindPtr) == 0) { - ckfree((char *) cbindPtr->command); - if (cbindPtr->delete != NULL) { - ckfree((char *) cbindPtr->delete); - } - ckfree((char *) cbindPtr); - return TCL_ERROR; - } - return TCL_OK; -} - -static int -CBindingEvalProc( - ClientData clientData, - Tcl_Interp *interp, - XEvent *eventPtr, - Tk_Window tkwin, - KeySym keySym) -{ - CBinding *cbindPtr; - - cbindPtr = (CBinding *) clientData; - - return Tcl_GlobalEval(interp, cbindPtr->command); -} - -static void -CBindingFreeProc( - ClientData clientData) -{ - CBinding *cbindPtr = (CBinding *) clientData; - - if (cbindPtr->delete != NULL) { - Tcl_GlobalEval(cbindPtr->interp, cbindPtr->delete); - ckfree((char *) cbindPtr->delete); - } - ckfree((char *) cbindPtr->command); - ckfree((char *) cbindPtr); -} - -/* - *---------------------------------------------------------------------- - * * TestbitmapObjCmd -- * * This function implements the "testbitmap" command, which is used to diff --git a/generic/tkWindow.c b/generic/tkWindow.c index 2c9f0e3..e2f6f61 100644 --- a/generic/tkWindow.c +++ b/generic/tkWindow.c @@ -11,7 +11,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkWindow.c,v 1.111 2010/02/16 21:12:56 nijtmans Exp $ + * RCS: @(#) $Id: tkWindow.c,v 1.112 2010/06/19 16:18:41 jenglish Exp $ */ #include "tkInt.h" @@ -1470,7 +1470,6 @@ Tk_DestroyWindow( } UnlinkWindow(winPtr); TkEventDeadWindow(winPtr); - TkBindDeadWindow(winPtr); #ifdef TK_USE_INPUT_METHODS if (winPtr->inputContext != NULL) { XDestroyIC(winPtr->inputContext); diff --git a/tests/bind.test b/tests/bind.test index b3b82b1..a4d8d6b 100644 --- a/tests/bind.test +++ b/tests/bind.test @@ -7,7 +7,7 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. # -# RCS: @(#) $Id: bind.test,v 1.27 2009/01/11 23:08:58 patthoyts Exp $ +# RCS: @(#) $Id: bind.test,v 1.28 2010/06/19 16:18:41 jenglish Exp $ package require tcltest 2.2 namespace import ::tcltest::* @@ -299,55 +299,12 @@ test bind-6.1 {Tk_DeleteBindTable procedure} -body { } -cleanup { destroy .t.c } -result {} -test bind-6.2 {Tk_DeleteBindTable procedure: pending bindings deleted later} -constraints { - testcbind -} -body { - catch {interp delete foo} - interp create foo - foo eval { - load {} Tk - tk useinputmethods 0 - load {} Tktest - wm geometry . +0+0 - frame .g -width 50 -height 50 - bindtags .g {a b c d} - pack .g - update - set x {} - testcbind a <1> "lappend x a1; destroy ." "lappend x bye.a1" - bind b <1> "lappend x b1" - testcbind c <1> "lappend x c1" "lappend x bye.c1" - testcbind c <2> "lappend x all2" "lappend x bye.all2" - event generate .g <1> - } - set x [foo eval set x] - return $x -} -cleanup { - interp delete foo - bind a <1> {} - bind b <1> {} - bind c <1> {} - bind c <2> {} - destroy .g -} -result {a1 bye.all2 bye.a1 b1 bye.c1} - test bind-7.1 {Tk_CreateBinding procedure: bad binding} -body { canvas .t.c .t.c bind foo < } -cleanup { destroy .t.c } -returnCodes error -result {no event type or button # or keysym} -test bind-7.2 {Tk_CreateBinding procedure: replace existing C binding} -constraints { - testcbind -} -body { - frame .t.f - set x {} - testcbind .t.f <1> "xyz" "lappend x bye.1" - bind .t.f <1> "abc" - return $x -} -cleanup { - destroy .t.f -} -result {bye.1} test bind-7.3 {Tk_CreateBinding procedure: append} -body { canvas .t.c .t.c bind foo <1> "button 1" @@ -365,52 +322,9 @@ test bind-7.4 {Tk_CreateBinding procedure: append to non-existing} -body { destroy .t.c } -result {button 1} -test bind-8.1 {TkCreateBindingProcedure: error} -constraints { - testcbind -} -body { - testcbind . "xyz" +test bind-8.1 {Tk_CreateBinding: error} -body { + bind . "xyz" } -returnCodes error -result {bad event type or keysym "xyz"} -test bind-8.2 {TkCreateBindingProcedure: new binding} -constraints { - testcbind -} -setup { - frame .t.f - set x {} -} -body { - testcbind .t.f <1> "lappend x 1" "lappend x bye.1" - event generate .t.f <1> - destroy .t.f - return $x -} -result {bye.1} -test bind-8.3 {TkCreateBindingProcedure: replace existing} -constraints { - testcbind -} -setup { - frame .t.f - pack .t.f - set x {} -} -body { - testcbind .t.f <1> "lappend x old1" "lappend x bye.old1" - testcbind .t.f <1> "lappend x new1" "lappend x bye.new1" - return $x -} -cleanup { - destroy .t.f -} -result {bye.old1} -test bind-8.4 {TkCreateBindingProcedure: replace existing while pending} -constraints { - testcbind -} -setup { - frame .t.f - pack .t.f - update - set x {} -} -body { - testcbind .t.f <1> "lappend x .t.f; testcbind Frame <1> {lappend x Frame}" - testcbind Frame <1> "lappend x never" - event generate .t.f <1> - bind .t.f <1> {} - return $x -} -cleanup { - destroy .t.f - bind Frame <1> {} -} -result {.t.f Frame} test bind-9.1 {Tk_DeleteBinding procedure} -body { frame .t.f -class Test -width 150 -height 100 @@ -448,28 +362,6 @@ test bind-9.3 {Tk_DeleteBinding procedure} -setup { } -cleanup { destroy .t.f } -result {{ } { } {}} -test bind-9.4 {Tk_DeleteBinding procedure: pending bindings delete later} -constraints { - testcbind -} -setup { - frame .t.f - pack .t.f - update - set x {} -} -body { - bindtags .t.f {a b c} - testcbind a <1> {lappend x a1; bind c <1> {}; bind c <2> {}} {lappend x bye.a1} - bind b <1> {lappend x b1} - testcbind c <1> {lappend x c1} {lappend x bye.c1} - testcbind c <2> {lappend x c2} {lappend x bye.c2} - event generate .t.f <1> - bind a <1> {} - bind b <1> {} - return $x -} -cleanup { - destroy .t.f - bind c <1> {} - bind c <2> {} -} -result {a1 bye.c2 b1 bye.c1 bye.a1} test bind-10.1 {Tk_GetBinding procedure} -body { canvas .t.c @@ -484,16 +376,6 @@ test bind-10.2 {Tk_GetBinding procedure} -body { } -cleanup { destroy .t.c } -result {Test} -test bind-10.3 {Tk_GetBinding procedure: C binding} -constraints { - testcbind -} -body { - frame .t.f - testcbind .t.f <1> "foo" - list [bind .t.f] [bind .t.f <1>] -} -cleanup { - destroy .t.f -} -result { {}} - test bind-11.1 {Tk_GetAllBindings procedure} -body { frame .t.f @@ -535,23 +417,6 @@ test bind-12.2 {Tk_DeleteAllBindings procedure} -body { } destroy .t.f } -result {} -test bind-12.3 {Tk_DeleteAllBindings procedure: pending bindings deleted later} -constraints { - testcbind -} -setup { - frame .t.f - pack .t.f - update - set x {} -} -body { - testcbind .t.f <1> {lappend x before; event generate .t.f <2>; lappend x after} {lappend x bye.f1} - testcbind .t.f <2> {destroy .t.f} {lappend x bye.f2} - bind .t.f {lappend x fDestroy} - testcbind .t.f <3> {foo} {lappend x bye.f3} - event generate .t.f <1> - return $x -} -cleanup { - destroy .t.f -} -result {before fDestroy bye.f3 bye.f2 after bye.f1} test bind-13.1 {Tk_BindEvent procedure} -setup { frame .t.f -class Test -width 150 -height 100 @@ -1056,9 +921,8 @@ test bind-13.32 {Tk_BindEvent procedure: match} -setup { } -cleanup { destroy .t.f } -result {Button-2} -test bind-13.33 {Tk_BindEvent procedure: many C bindings cause realloc} -constraints { - testcbind -} -setup { +test bind-13.33 {Tk_BindEvent procedure: many C bindings cause realloc} -setup { + # this test might not be useful anymore [#3009998] frame .t.f -class Test -width 150 -height 100 pack .t.f focus -force .t.f @@ -1067,7 +931,7 @@ test bind-13.33 {Tk_BindEvent procedure: many C bindings cause realloc} -constra } -body { bindtags .t.f {a b c d e f g h i j k l m n o p} foreach p [bindtags .t.f] { - testcbind $p <1> "lappend x $p" + bind $p <1> "lappend x $p" } event generate .t.f <1> return $x @@ -1090,66 +954,27 @@ test bind-13.34 {Tk_BindEvent procedure: multiple tags} -setup { destroy .t.f bind Test {} } -result {.t.f Button} -test bind-13.35 {Tk_BindEvent procedure: execute C binding} -constraints { - testcbind -} -setup { +test bind-13.35 {Tk_BindEvent procedure: execute binding} -setup { frame .t.f -class Test -width 150 -height 100 pack .t.f focus -force .t.f update set x {} } -body { - testcbind .t.f <1> {lappend x 1} + bind .t.f <1> {lappend x 1} event generate .t.f <1> return $x } -cleanup { destroy .t.f } -result {1} -test bind-13.36 {Tk_BindEvent procedure: pending list marked deleted} -constraints { - testcbind -} -setup { +test bind-13.38 {Tk_BindEvent procedure: binding gets to run} -setup { frame .t.f -class Test -width 150 -height 100 pack .t.f focus -force .t.f update set x {} } -body { - testcbind Test <1> {lappend x Test} {lappend x Deleted} - bind .t.f <1> {lappend x .t.f; destroy .t.f} - event generate .t.f <1> - set y [list $x [bind Test]] - return $y -} -cleanup { - destroy .t.f - bind Test <1> {} -} -result {.t.f } -test bind-13.37 {Tk_BindEvent procedure: C binding marked deleted} -constraints { - testcbind -} -setup { - frame .t.f -class Test -width 150 -height 100 - pack .t.f - focus -force .t.f - update - set x {} -} -body { - testcbind Test <1> {lappend x Test} {lappend x Deleted} - bind .t.f <1> {lappend x .t.f; bind Test <1> {}; lappend x after} - event generate .t.f <1> - return $x -} -cleanup { - destroy .t.f - bind Test <1> {} -} -result {.t.f after Deleted} -test bind-13.38 {Tk_BindEvent procedure: C binding gets to run} -constraints { - testcbind -} -setup { - frame .t.f -class Test -width 150 -height 100 - pack .t.f - focus -force .t.f - update - set x {} -} -body { - testcbind Test <1> {lappend x Test} + bind Test <1> {lappend x Test} bind .t.f <1> {lappend x .t.f} event generate .t.f <1> return $x @@ -1157,46 +982,6 @@ test bind-13.38 {Tk_BindEvent procedure: C binding gets to run} -constraints { destroy .t.f bind Test <1> {} } -result {.t.f Test} -test bind-13.39 {Tk_BindEvent procedure: C binding deleted, refcount == 0} -constraints { - testcbind -} -setup { - frame .t.f -class Test -width 150 -height 100 - pack .t.f - focus -force .t.f - update - set x {} -} -body { - testcbind .t.f <1> {lappend x hi; bind .t.f <1> {}} {lappend x bye} - event generate .t.f <1> - return $x -} -cleanup { - destroy .t.f -} -result {hi bye} -test bind-13.40 {Tk_BindEvent procedure: C binding deleted, refcount != 0} -constraints { - testcbind -} -setup { - frame .t.f -class Test -width 150 -height 100 - pack .t.f - focus -force .t.f - update - set x {} -} -body { - testcbind .t.f <1> { - lappend x before$n - if {$n==0} { - bind .t.f <1> {} - } else { - set n [expr $n-1] - event generate .t.f <1> - } - lappend x after$n - } {lappend x Deleted} - set n 3 - event generate .t.f <1> - return $x -} -cleanup { - destroy .t.f -} -result {before3 before2 before1 before0 after0 after0 after0 after0 Deleted} test bind-13.41 {Tk_BindEvent procedure: continue in script} -setup { frame .t.f -class Test -width 150 -height 100 pack .t.f @@ -1212,23 +997,6 @@ test bind-13.41 {Tk_BindEvent procedure: continue in script} -setup { destroy .t.f bind Test {} } -result {b1 B1} -test bind-13.42 {Tk_BindEvent procedure: continue in script} -constraints { - testcbind -} -setup { - frame .t.f -class Test -width 150 -height 100 - pack .t.f - focus -force .t.f - update - set x {} -} -body { - testcbind .t.f {lappend x b1; continue; lappend x b2} - testcbind Test {lappend x B1; continue; lappend x B2} - event generate .t.f - return $x -} -cleanup { - destroy .t.f - bind Test {} -} -result {b1 B1} test bind-13.43 {Tk_BindEvent procedure: break in script} -setup { frame .t.f -class Test -width 150 -height 100 pack .t.f @@ -1244,25 +1012,6 @@ test bind-13.43 {Tk_BindEvent procedure: break in script} -setup { destroy .t.f bind Test {} } -result {b1} -test bind-13.44 {Tk_BindEvent procedure: break in script} -constraints { - testcbind -} -setup { - frame .t.f -class Test -width 150 -height 100 - pack .t.f - focus -force .t.f - update - set x {} -} -body { - testcbind .t.f {lappend x b1; break; lappend x b2} - testcbind Test {lappend x B1; break; lappend x B2} - event generate .t.f - return $x -} -cleanup { - destroy .t.f - bind Test {} -} -result {b1} - - test bind-13.45 {Tk_BindEvent procedure: error in script} -setup { proc bgerror msg { global x @@ -1284,91 +1033,7 @@ test bind-13.45 {Tk_BindEvent procedure: error in script} -setup { bind Test {} proc bgerror args {} } -result {b1 {invalid command name "blap"}} -test bind-13.46 {Tk_BindEvent procedure: error in script} -constraints { - testcbind -} -setup { - proc bgerror msg { - global x - lappend x $msg - } - frame .t.f -class Test -width 150 -height 100 - pack .t.f - focus -force .t.f - update - set x {} -} -body { - testcbind .t.f {lappend x b1; blap} - testcbind Test {lappend x B1} - event generate .t.f - update - return $x -} -cleanup { - destroy .t.f - bind Test {} - proc bgerror args {} -} -result {b1 {invalid command name "blap"}} -test bind-14.1 {TkBindDeadWindow: no C bindings pending} -constraints { - testcbind -} -setup { - frame .t.f -class Test -width 150 -height 100 - pack .t.f - focus -force .t.f - update - set x {} -} -body { - bind .t.f <1> x - testcbind .t.f <2> y - destroy .t.f -} -cleanup { - destroy .t.f -} -result {} -test bind-14.2 {TkBindDeadWindow: is called after } -constraints { - testcbind -} -setup { - frame .t.f -class Test -width 150 -height 100 - pack .t.f - focus -force .t.f - update - set x {} -} -body { - testcbind .t.f "lappend x .t.f" - testcbind Test "lappend x Test" - set x {} - destroy .t.f - bind Test {} - set x -} -result {.t.f Test} -test bind-14.3 {TkBindDeadWindow: pending C bindings} -constraints { - testcbind -} -setup { - frame .t.f -class Test -width 150 -height 100 - pack .t.f - focus -force .t.f - update - set x {} -} -body { - bindtags .t.f {a b c d} - testcbind a <1> "lappend x a1" "lappend x bye.a1" - testcbind b <1> "destroy .t.f; lappend x b1" "lappend x bye.t1" - testcbind c <1> "lappend x c1" "lappend x bye.c1" - testcbind d <1> "lappend x d1" "lappend x bye.d1" - bind a <2> "event generate .t.f <1>" - testcbind b <2> "lappend x b2" "lappend x bye.t2" - testcbind c <2> "lappend x c2" "lappend x bye.d2" - bind d <2> "lappend x d2" - testcbind a <3> "event generate .t.f <2>" - event generate .t.f <3> - return $x -} -cleanup { - destroy .t.f - foreach tag {a b c d} { - foreach event {<1> <2> <3>} { - bind $tag $event {} - } - } -} -result {a1 b1 d2} - test bind-15.1 {MatchPatterns procedure, ignoring type mismatches} -setup { frame .t.f -class Test -width 150 -height 100 pack .t.f diff --git a/win/tkWinScrlbr.c b/win/tkWinScrlbr.c index 98a4178..f5f691d 100644 --- a/win/tkWinScrlbr.c +++ b/win/tkWinScrlbr.c @@ -9,7 +9,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkWinScrlbr.c,v 1.21 2010/04/29 15:28:04 nijtmans Exp $ + * RCS: @(#) $Id: tkWinScrlbr.c,v 1.22 2010/06/19 16:18:41 jenglish Exp $ */ #include "tkWinInt.h" @@ -64,10 +64,7 @@ TCL_DECLARE_MUTEX(winScrlbrMutex) static Window CreateProc(Tk_Window tkwin, Window parent, ClientData instanceData); -static void ModalLoopProc(Tk_Window tkwin, XEvent *eventPtr); -static int ScrollbarBindProc(ClientData clientData, - Tcl_Interp *interp, XEvent *eventPtr, - Tk_Window tkwin, KeySym keySym); +static void ModalLoop(WinScrollbar *, XEvent *eventPtr); static LRESULT CALLBACK ScrollbarProc(HWND hwnd, UINT message, WPARAM wParam, LPARAM lParam); static void UpdateScrollbar(WinScrollbar *scrollPtr); @@ -81,9 +78,21 @@ const Tk_ClassProcs tkpScrollbarProcs = { sizeof(Tk_ClassProcs), /* size */ NULL, /* worldChangedProc */ CreateProc, /* createProc */ - ModalLoopProc /* modalProc */ + NULL /* modalProc */ }; +static void +WinScrollbarEventProc(ClientData clientData, XEvent *eventPtr) +{ + WinScrollbar *scrollPtr = clientData; + + if (eventPtr->type == ButtonPress) { + ModalLoop(scrollPtr, eventPtr); + } else { + TkScrollbarEventProc(clientData, eventPtr); + } +} + /* *---------------------------------------------------------------------- @@ -106,7 +115,6 @@ TkpCreateScrollbar( Tk_Window tkwin) { WinScrollbar *scrollPtr; - TkWindow *winPtr = (TkWindow *)tkwin; if (!initialized) { Tcl_MutexLock(&winScrlbrMutex); @@ -120,17 +128,8 @@ TkpCreateScrollbar( scrollPtr->hwnd = NULL; Tk_CreateEventHandler(tkwin, - ExposureMask|StructureNotifyMask|FocusChangeMask, - TkScrollbarEventProc, (ClientData) scrollPtr); - - if (!Tcl_GetAssocData(winPtr->mainPtr->interp, "TkScrollbar", NULL)) { - Tcl_SetAssocData(winPtr->mainPtr->interp, "TkScrollbar", NULL, - (ClientData)1); - TkCreateBindingProcedure(winPtr->mainPtr->interp, - winPtr->mainPtr->bindingTable, - (ClientData)Tk_GetUid("Scrollbar"), "", - ScrollbarBindProc, NULL, NULL); - } + ExposureMask|StructureNotifyMask|FocusChangeMask|ButtonPressMask, + WinScrollbarEventProc, scrollPtr); return (TkScrollbar *) scrollPtr; } @@ -601,62 +600,22 @@ TkpConfigureScrollbar( } /* - *-------------------------------------------------------------- - * - * ScrollbarBindProc -- - * - * This procedure is invoked when the default binding on - * the Scrollbar bind tag fires. - * - * Results: - * None. - * - * Side effects: - * The event enters a modal loop. - * - *-------------------------------------------------------------- - */ - -static int -ScrollbarBindProc( - ClientData clientData, - Tcl_Interp *interp, - XEvent *eventPtr, - Tk_Window tkwin, - KeySym keySym) -{ - TkWindow *winPtr = (TkWindow *) tkwin; - - if (eventPtr->type == ButtonPress) { - winPtr->flags |= TK_DEFER_MODAL; - } - return TCL_OK; -} - -/* *---------------------------------------------------------------------- * - * ModalLoopProc -- - * - * This function is invoked at the end of the event processing whenever - * the ScrollbarBindProc has been invoked for a ButtonPress event. + * ModalLoop -- * - * Results: - * None. - * - * Side effects: - * Enters a modal loop. + * This function is invoked in response to a ButtonPress event. + * It resends the event to the Scrollbar window procedure, + * which in turn enters a modal loop. * *---------------------------------------------------------------------- */ static void -ModalLoopProc( - Tk_Window tkwin, +ModalLoop( + WinScrollbar *scrollPtr, XEvent *eventPtr) { - TkWindow *winPtr = (TkWindow*)tkwin; - WinScrollbar *scrollPtr = (WinScrollbar *) winPtr->instanceData; int oldMode; if (scrollPtr->hwnd) { -- cgit v0.12