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, 45 insertions, 2 deletions

diff --git a/ChangeLog b/ChangeLog
index 44b0198..2f67e74 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -132,6 +132,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-13  Jan Nijtmans  <nijtmans@users.sf.net>
 
 	* win/tkWinTest.c: [Bug 3585396]: winDialog.test requires user
diff --git a/doc/bind.n b/doc/bind.n
index 47ed178..0055909 100644
--- a/doc/bind.n
+++ b/doc/bind.n
@@ -548,6 +548,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 8d20fa9..d7c8c04 100644
--- a/generic/tkBind.c
+++ b/generic/tkBind.c
@@ -660,7 +660,8 @@ static int		DeleteVirtualEvent(Tcl_Interp *interp,
 			    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 void		FreeTclBinding(ClientData clientData);
 static PatSeq *		FindSequence(Tcl_Interp *interp,
 			    Tcl_HashTable *patternTablePtr, ClientData object,
@@ -1415,6 +1416,7 @@ Tk_BindEvent(
     PatSeq *vMatchDetailList, *vMatchNoDetailList;
     int flags, oldScreen, i, deferModal;
     unsigned int matchCount, matchSpace;
+    unsigned int scriptCount;
     Tcl_Interp *interp;
     Tcl_DString scripts, savedResult;
     Detail detail;
@@ -1571,6 +1573,7 @@ Tk_BindEvent(
 
     pendingPtr = &staticPending;
     matchCount = 0;
+    scriptCount = 0;
     matchSpace = sizeof(staticPending.matchArray) / sizeof(PatSeq *);
     Tcl_DStringInit(&scripts);
 
@@ -1628,7 +1631,7 @@ Tk_BindEvent(
 	    }
 	    if (sourcePtr->eventProc == EvalTclBinding) {
 		ExpandPercents(winPtr, (char *) sourcePtr->clientData,
-			eventPtr, detail.keySym, &scripts);
+			eventPtr, detail.keySym, scriptCount++, &scripts);
 	    } else {
 		if (matchCount >= matchSpace) {
 		    PendingBinding *newPtr;
@@ -2259,6 +2262,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. */
 {
@@ -2540,6 +2545,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 85372f8..de9da70 100644
--- a/tests/bind.test
+++ b/tests/bind.test
@@ -25,6 +25,14 @@ proc setup {} {
     foreach p [event info] {event delete $p}    
     update
 }
+proc setup2 {} {
+    catch {destroy .b.e}
+    entry .b.e
+    pack .b.e
+    focus -force .b.e
+    foreach p [event info] {event delete $p}
+    update
+}
 setup
 
 foreach i [bind Test] {
@@ -1565,6 +1573,24 @@ test bind-16.44 {ExpandPercents procedure} {
     event gen .b.f <Gravity>
     set x
 } {?? ??}
+test bind-16.45 {ExpandPercents procedure} {
+    setup2
+    bind .b.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 .b.e <Key-a>
+    list $x $y $z
+} {0 1 2}
+test bind-16.46 {ExpandPercents procedure} {
+    setup2
+    bind all <Key> {set z "%M"}
+    bind Entry <Key> {set y "%M"}
+    bind .b.e <Key> {set x "%M"}
+    set x none; set y none; set z none
+    event gen .b.e <Key-a>
+    list $x $y $z
+} {0 1 2}
 
 
 test bind-17.1 {event command} {