From f20590a5bfc2935ada0a9ce044fd8cecb2615fc2 Mon Sep 17 00:00:00 2001
From: Joe Mistachkin <joe@mistachkin.com>
Date: Fri, 16 Nov 2012 21:21:54 +0000
Subject: Add support for an 'M' binding substitution that is replaced with the
 number of script-based binding patterns matched so far for the event.

---
 ChangeLog        |  6 ++++++
 generic/tkBind.c | 12 ++++++++++--
 2 files changed, 16 insertions(+), 2 deletions(-)

diff --git a/ChangeLog b/ChangeLog
index 8237eed..3f58f0b 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,9 @@
+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/generic/tkBind.c b/generic/tkBind.c
index 21bfb5c..dbbaaf4 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;
-- 
cgit v0.12


From 07f85cd3c1b4934fb746ea36516ba2944b4eea11 Mon Sep 17 00:00:00 2001
From: Joe Mistachkin <joe@mistachkin.com>
Date: Fri, 16 Nov 2012 22:09:07 +0000
Subject: Add docs and tests.

---
 doc/bind.n      |  3 +++
 tests/bind.test | 26 ++++++++++++++++++++++++++
 2 files changed, 29 insertions(+)

diff --git a/doc/bind.n b/doc/bind.n
index cd556e7..7fb847d 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/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} {
-- 
cgit v0.12