Add support for an 'M' binding substitution that is replaced with the number of script-based binding patterns matched so far for the event.

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