summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--ChangeLog14
-rw-r--r--carbon/tkMacOSXScrlbr.c209
-rw-r--r--generic/tk.h6
-rw-r--r--generic/tkBind.c465
-rw-r--r--generic/tkInt.decls17
-rw-r--r--generic/tkInt.h10
-rw-r--r--generic/tkIntDecls.h33
-rw-r--r--generic/tkStubInit.c6
-rw-r--r--generic/tkTest.c123
-rw-r--r--generic/tkWindow.c3
-rw-r--r--tests/bind.test355
-rw-r--r--win/tkWinScrlbr.c87
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 <jenglish@users.sourceforge.net>
+
+ * 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 <jenglish@users.sourceforge.net>
* 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"), "<ButtonPress>",
- ScrollbarBindProc, NULL, NULL);
- }
return (TkScrollbar *) macScrollPtr;
}
@@ -719,134 +708,118 @@ ScrollbarActionProc(
/*
*--------------------------------------------------------------
*
- * ScrollbarBindProc --
- *
- * This procedure is invoked when the default <ButtonPress> 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 <ButtonPress> 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> "xyz"
+test bind-8.1 {Tk_CreateBinding: error} -body {
+ bind . <xyz> "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 {{<Button-1> <Double-Alt-Button-1> <Meta-Button-1>} {<Button-1> <Meta-Button-1>} <Meta-Button-1> {}}
-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 {<Button-1> {}}
-
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 <Destroy> {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 <Button-2> {}
} -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 <Button-1>}
-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 <Button-2> {}
} -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 <Button-2> {lappend x b1; continue; lappend x b2}
- testcbind Test <Button-2> {lappend x B1; continue; lappend x B2}
- event generate .t.f <Button-2>
- return $x
-} -cleanup {
- destroy .t.f
- bind Test <Button-2> {}
-} -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 <Button-2> {}
} -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 <Button-2> {lappend x b1; break; lappend x b2}
- testcbind Test <Button-2> {lappend x B1; break; lappend x B2}
- event generate .t.f <Button-2>
- return $x
-} -cleanup {
- destroy .t.f
- bind Test <Button-2> {}
-} -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 <Button-2> {}
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 <Button-2> {lappend x b1; blap}
- testcbind Test <Button-2> {lappend x B1}
- event generate .t.f <Button-2>
- update
- return $x
-} -cleanup {
- destroy .t.f
- bind Test <Button-2> {}
- 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 <Destroy>} -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 <Destroy> "lappend x .t.f"
- testcbind Test <Destroy> "lappend x Test"
- set x {}
- destroy .t.f
- bind Test <Destroy> {}
- 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"), "<ButtonPress>",
- 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 <ButtonPress> 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) {
generated by cgit v0.12 at 2024-11-10 12:05:11 (GMT)