summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--ChangeLog6
-rw-r--r--doc/bind.n3
-rw-r--r--generic/tkBind.c12
-rw-r--r--tests/bind.test33
4 files changed, 51 insertions, 3 deletions
diff --git a/ChangeLog b/ChangeLog
index 0527b19..94cabc1 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -156,6 +156,12 @@ a better first place to look now.
* generic/tkTextIndex.c: [Bug 3588824]: bug in image index handling
* tests/textIndex.test: for weird image names
+2012-11-16 Joe Mistachkin <joe@mistachkin.com>
+
+ * generic/tkBind.c: Add support for an 'M' binding substitution
+ that is replaced with the number of script-based binding patterns
+ matched so far for the event.
+
2012-11-14 Jan Nijtmans <nijtmans@users.sf.net>
* win/tkWinDialog.c: [Bug 3500545]: tk_getOpenFile -multiple 1 wrong
diff --git a/doc/bind.n b/doc/bind.n
index 17acb52..de4502e 100644
--- a/doc/bind.n
+++ b/doc/bind.n
@@ -541,6 +541,9 @@ event generated by \fBSendEvent\fR.
.IP \fB%K\fR 5
The keysym corresponding to the event, substituted as a textual
string. Valid only for \fBKeyPress\fR and \fBKeyRelease\fR events.
+.IP \fB%M\fR 5
+The number of script-based binding patterns matched so far for the
+event. Valid for all event types.
.IP \fB%N\fR 5
The keysym corresponding to the event, substituted as a decimal
number. Valid only for \fBKeyPress\fR and \fBKeyRelease\fR events.
diff --git a/generic/tkBind.c b/generic/tkBind.c
index fbac56d..35f2795 100644
--- a/generic/tkBind.c
+++ b/generic/tkBind.c
@@ -612,7 +612,8 @@ static int DeleteVirtualEvent(Tcl_Interp *interp,
const char *eventString);
static void DeleteVirtualEventTable(VirtualEventTable *vetPtr);
static void ExpandPercents(TkWindow *winPtr, const char *before,
- XEvent *eventPtr,KeySym keySym,Tcl_DString *dsPtr);
+ XEvent *eventPtr,KeySym keySym,
+ unsigned int scriptCount, Tcl_DString *dsPtr);
static PatSeq * FindSequence(Tcl_Interp *interp,
Tcl_HashTable *patternTablePtr, ClientData object,
const char *eventString, int create,
@@ -1221,6 +1222,7 @@ Tk_BindEvent(
XEvent *ringPtr;
PatSeq *vMatchDetailList, *vMatchNoDetailList;
int flags, oldScreen;
+ unsigned int scriptCount;
Tcl_Interp *interp;
Tcl_DString scripts;
Tcl_InterpState interpState;
@@ -1372,6 +1374,7 @@ Tk_BindEvent(
* each object.
*/
+ scriptCount = 0;
Tcl_DStringInit(&scripts);
for ( ; numObjects > 0; numObjects--, objectPtr++) {
@@ -1421,7 +1424,7 @@ Tk_BindEvent(
if (matchPtr != NULL) {
ExpandPercents(winPtr, sourcePtr->script, eventPtr,
- detail.keySym, &scripts);
+ detail.keySym, scriptCount++, &scripts);
/*
* A "" is added to the scripts string to separate the various
@@ -1903,6 +1906,8 @@ ExpandPercents(
* in % replacements. */
KeySym keySym, /* KeySym: only relevant for KeyPress and
* KeyRelease events). */
+ unsigned int scriptCount, /* The number of script-based binding patterns
+ * matched so far for this event. */
Tcl_DString *dsPtr) /* Dynamic string in which to append new
* command. */
{
@@ -2184,6 +2189,9 @@ ExpandPercents(
}
}
goto doString;
+ case 'M':
+ number = scriptCount;
+ goto doNumber;
case 'N':
if ((flags & KEY) && (eventPtr->type != MouseWheelEvent)) {
number = (int) keySym;
diff --git a/tests/bind.test b/tests/bind.test
index c777d66..77f944c 100644
--- a/tests/bind.test
+++ b/tests/bind.test
@@ -25,7 +25,6 @@ foreach event [bind all] {
bind all $event {}
}
-
proc unsetBindings {} {
bind all <Enter> {}
bind Test <Enter> {}
@@ -2172,6 +2171,38 @@ test bind-16.44 {ExpandPercents procedure} -setup {
destroy .t.f
} -result {?? ??}
+test bind-16.45 {ExpandPercents procedure} -setup {
+ entry .t.e
+ pack .t.e
+ focus -force .t.e
+ foreach p [event info] {event delete $p}
+ update
+} -body {
+ bind .t.e <Key> {set x "%M"}
+ bind Entry <Key> {set y "%M"}
+ bind all <Key> {set z "%M"}
+ set x none; set y none; set z none
+ event gen .t.e <Key-a>
+ list $x $y $z
+} -cleanup {
+ destroy .t.e
+} -result {0 1 2}
+test bind-16.46 {ExpandPercents procedure} -setup {
+ entry .t.e
+ pack .t.e
+ focus -force .t.e
+ foreach p [event info] {event delete $p}
+ update
+} -body {
+ bind all <Key> {set z "%M"}
+ bind Entry <Key> {set y "%M"}
+ bind .t.e <Key> {set x "%M"}
+ set x none; set y none; set z none
+ event gen .t.e <Key-a>
+ list $x $y $z
+} -cleanup {
+ destroy .t.e
+} -result {0 1 2}
test bind-17.1 {event command} -body {
event