diff options
-rw-r--r-- | ChangeLog | 6 | ||||
-rw-r--r-- | doc/bind.n | 3 | ||||
-rw-r--r-- | generic/tkBind.c | 12 | ||||
-rw-r--r-- | tests/bind.test | 26 |
4 files changed, 45 insertions, 2 deletions
@@ -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 @@ -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} { |