Tk Source Code

Check-in [ad032ed7]
Login
Bounty program for improvements to Tcl and certain Tcl packages.
Tcl 2019 Conference, Houston/TX, US, Nov 4-8
Send your abstracts to [email protected]
or submit via the online form by Sep 9.

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:Add support for an 'M' binding substitution that is replaced with the number of script-based binding patterns matched so far for the event.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | core-8-5-branch
Files: files | file ages | folders
SHA1: ad032ed70ee1c5bed90542f1561cc3fc8fd9531e
User & Date: mistachkin 2015-02-06 18:08:50
Context
2015-02-06
21:30
Merged text-elided branch check-in: 02912e40 user: fvogel tags: core-8-5-branch
20:22
Add support for an 'M' binding substitution that is replaced with the number of script-based binding patterns matched so far for the event. check-in: 8b098230 user: mistachkin tags: trunk
18:08
Add support for an 'M' binding substitution that is replaced with the number of script-based binding patterns matched so far for the event. check-in: ad032ed7 user: mistachkin tags: core-8-5-branch
16:57
Merge bug fixes from fvogel's text-elided branch check-in: 6c3ad48c user: dgp tags: core-8-5-branch
2015-02-05
22:26
Merge updates from core-8-5-branch. Closed-Leaf check-in: 5e405150 user: mistachkin tags: bindScriptCount
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to ChangeLog.

127
128
129
130
131
132
133






134
135
136
137
138
139
140
	* win/tcl.m4:	 More flexible search for win32 tclConfig.sh,
	* win/configure: backported from TEA.

2012-12-03  Fran├žois Vogel  <[email protected]>

	* generic/tkTextIndex.c: [Bug 3588824]: bug in image index handling
	* tests/textIndex.test:  for weird image names







2012-11-13  Jan Nijtmans  <[email protected]>

	* win/tkWinTest.c: [Bug 3585396]: winDialog.test requires user
	* tests/winDialog.test: interaction. Renumber test-cases as in Tk 8.6,
	and convert various to tcltest-2 style.







>
>
>
>
>
>







127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
	* win/tcl.m4:	 More flexible search for win32 tclConfig.sh,
	* win/configure: backported from TEA.

2012-12-03  Fran├žois Vogel  <[email protected]>

	* generic/tkTextIndex.c: [Bug 3588824]: bug in image index handling
	* tests/textIndex.test:  for weird image names

2012-11-16  Joe Mistachkin  <[email protected]>

	* 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  <[email protected]>

	* win/tkWinTest.c: [Bug 3585396]: winDialog.test requires user
	* tests/winDialog.test: interaction. Renumber test-cases as in Tk 8.6,
	and convert various to tcltest-2 style.

Changes to doc/bind.n.

544
545
546
547
548
549
550



551
552
553
554
555
556
557
.QW normal
event, \fB1\fR indicates that it is a
.QW synthetic
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%N\fR 5
The keysym corresponding to the event, substituted as a decimal
number.  Valid only for \fBKeyPress\fR and \fBKeyRelease\fR events.
.IP \fB%P\fR 5
The name of the property being updated or deleted (which
may be converted to an XAtom using \fBwinfo atom\fR.) Valid
only for \fBProperty\fR events.






>
>
>







544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
.QW normal
event, \fB1\fR indicates that it is a
.QW synthetic
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.
.IP \fB%P\fR 5
The name of the property being updated or deleted (which
may be converted to an XAtom using \fBwinfo atom\fR.) Valid
only for \fBProperty\fR events.

Changes to generic/tkBind.c.

656
657
658
659
660
661
662
663

664
665
666
667
668
669
670
....
1411
1412
1413
1414
1415
1416
1417

1418
1419
1420
1421
1422
1423
1424
....
1567
1568
1569
1570
1571
1572
1573

1574
1575
1576
1577
1578
1579
1580
....
1624
1625
1626
1627
1628
1629
1630
1631
1632
1633
1634
1635
1636
1637
1638
....
2255
2256
2257
2258
2259
2260
2261


2262
2263
2264
2265
2266
2267
2268
....
2536
2537
2538
2539
2540
2541
2542



2543
2544
2545
2546
2547
2548
2549
			    VirtualEventTable *vetPtr, char *virtString,
			    char *eventString);
static int		DeleteVirtualEvent(Tcl_Interp *interp,
			    VirtualEventTable *vetPtr, char *virtString,
			    char *eventString);
static void		DeleteVirtualEventTable(VirtualEventTable *vetPtr);
static void		ExpandPercents(TkWindow *winPtr, const char *before,
			    XEvent *eventPtr,KeySym keySym,Tcl_DString *dsPtr);

static void		FreeTclBinding(ClientData clientData);
static PatSeq *		FindSequence(Tcl_Interp *interp,
			    Tcl_HashTable *patternTablePtr, ClientData object,
			    const char *eventString, int create,
			    int allowVirtual, unsigned long *maskPtr);
static void		GetAllVirtualEvents(Tcl_Interp *interp,
			    VirtualEventTable *vetPtr);
................................................................................
    ScreenInfo *screenPtr;
    BindInfo *bindInfoPtr;
    TkDisplay *oldDispPtr;
    XEvent *ringPtr;
    PatSeq *vMatchDetailList, *vMatchNoDetailList;
    int flags, oldScreen, i, deferModal;
    unsigned int matchCount, matchSpace;

    Tcl_Interp *interp;
    Tcl_DString scripts, savedResult;
    Detail detail;
    char *p, *end;
    PendingBinding staticPending, *pendingPtr;
    TkWindow *winPtr = (TkWindow *) tkwin;
    PatternTableKey key;
................................................................................
     * expanded, to "scripts", with null characters separating the scripts for
     * each object. Append all the callbacks to the array of pending
     * callbacks.
     */

    pendingPtr = &staticPending;
    matchCount = 0;

    matchSpace = sizeof(staticPending.matchArray) / sizeof(PatSeq *);
    Tcl_DStringInit(&scripts);

    for ( ; numObjects > 0; numObjects--, objectPtr++) {
	PatSeq *matchPtr = NULL, *sourcePtr = NULL;
	Tcl_HashEntry *hPtr;

................................................................................

	if (matchPtr != NULL) {
	    if (sourcePtr->eventProc == NULL) {
		Tcl_Panic("Tk_BindEvent: missing command");
	    }
	    if (sourcePtr->eventProc == EvalTclBinding) {
		ExpandPercents(winPtr, (char *) sourcePtr->clientData,
			eventPtr, detail.keySym, &scripts);
	    } else {
		if (matchCount >= matchSpace) {
		    PendingBinding *newPtr;
		    unsigned int oldSize, newSize;

		    oldSize = sizeof(staticPending)
			    - sizeof(staticPending.matchArray)
................................................................................
				 * input context. */
    const char *before,		/* Command containing percent expressions to
				 * be replaced. */
    XEvent *eventPtr,		/* X event containing information to be used
				 * in % replacements. */
    KeySym keySym,		/* KeySym: only relevant for KeyPress and
				 * KeyRelease events). */


    Tcl_DString *dsPtr)		/* Dynamic string in which to append new
				 * command. */
{
    int spaceNeeded, cvtFlags;	/* Used to substitute string as proper Tcl
				 * list element. */
    int number, flags, length;
#define NUM_SIZE 40
................................................................................
		char *name = TkKeysymToString(keySym);

		if (name != NULL) {
		    string = name;
		}
	    }
	    goto doString;



	case 'N':
	    if ((flags & KEY) && (eventPtr->type != MouseWheelEvent)) {
		number = (int) keySym;
		goto doNumber;
	    }
	    goto doString;
	case 'P':






|
>







 







>







 







>







 







|







 







>
>







 







>
>
>







656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
....
1412
1413
1414
1415
1416
1417
1418
1419
1420
1421
1422
1423
1424
1425
1426
....
1569
1570
1571
1572
1573
1574
1575
1576
1577
1578
1579
1580
1581
1582
1583
....
1627
1628
1629
1630
1631
1632
1633
1634
1635
1636
1637
1638
1639
1640
1641
....
2258
2259
2260
2261
2262
2263
2264
2265
2266
2267
2268
2269
2270
2271
2272
2273
....
2541
2542
2543
2544
2545
2546
2547
2548
2549
2550
2551
2552
2553
2554
2555
2556
2557
			    VirtualEventTable *vetPtr, char *virtString,
			    char *eventString);
static int		DeleteVirtualEvent(Tcl_Interp *interp,
			    VirtualEventTable *vetPtr, char *virtString,
			    char *eventString);
static void		DeleteVirtualEventTable(VirtualEventTable *vetPtr);
static void		ExpandPercents(TkWindow *winPtr, const char *before,
			    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,
			    const char *eventString, int create,
			    int allowVirtual, unsigned long *maskPtr);
static void		GetAllVirtualEvents(Tcl_Interp *interp,
			    VirtualEventTable *vetPtr);
................................................................................
    ScreenInfo *screenPtr;
    BindInfo *bindInfoPtr;
    TkDisplay *oldDispPtr;
    XEvent *ringPtr;
    PatSeq *vMatchDetailList, *vMatchNoDetailList;
    int flags, oldScreen, i, deferModal;
    unsigned int matchCount, matchSpace;
    unsigned int scriptCount;
    Tcl_Interp *interp;
    Tcl_DString scripts, savedResult;
    Detail detail;
    char *p, *end;
    PendingBinding staticPending, *pendingPtr;
    TkWindow *winPtr = (TkWindow *) tkwin;
    PatternTableKey key;
................................................................................
     * expanded, to "scripts", with null characters separating the scripts for
     * each object. Append all the callbacks to the array of pending
     * callbacks.
     */

    pendingPtr = &staticPending;
    matchCount = 0;
    scriptCount = 0;
    matchSpace = sizeof(staticPending.matchArray) / sizeof(PatSeq *);
    Tcl_DStringInit(&scripts);

    for ( ; numObjects > 0; numObjects--, objectPtr++) {
	PatSeq *matchPtr = NULL, *sourcePtr = NULL;
	Tcl_HashEntry *hPtr;

................................................................................

	if (matchPtr != NULL) {
	    if (sourcePtr->eventProc == NULL) {
		Tcl_Panic("Tk_BindEvent: missing command");
	    }
	    if (sourcePtr->eventProc == EvalTclBinding) {
		ExpandPercents(winPtr, (char *) sourcePtr->clientData,
			eventPtr, detail.keySym, scriptCount++, &scripts);
	    } else {
		if (matchCount >= matchSpace) {
		    PendingBinding *newPtr;
		    unsigned int oldSize, newSize;

		    oldSize = sizeof(staticPending)
			    - sizeof(staticPending.matchArray)
................................................................................
				 * input context. */
    const char *before,		/* Command containing percent expressions to
				 * be replaced. */
    XEvent *eventPtr,		/* X event containing information to be used
				 * 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. */
{
    int spaceNeeded, cvtFlags;	/* Used to substitute string as proper Tcl
				 * list element. */
    int number, flags, length;
#define NUM_SIZE 40
................................................................................
		char *name = TkKeysymToString(keySym);

		if (name != NULL) {
		    string = name;
		}
	    }
	    goto doString;
	case 'M':
	    number = scriptCount;
	    goto doNumber;
	case 'N':
	    if ((flags & KEY) && (eventPtr->type != MouseWheelEvent)) {
		number = (int) keySym;
		goto doNumber;
	    }
	    goto doString;
	case 'P':

Changes to tests/bind.test.

21
22
23
24
25
26
27








28
29
30
31
32
33
34
....
1561
1562
1563
1564
1565
1566
1567


















1568
1569
1570
1571
1572
1573
1574
    catch {destroy .b.f}
    frame .b.f -class Test -width 150 -height 100
    pack .b.f
    focus -force .b.f
    foreach p [event info] {event delete $p}    
    update
}








setup

foreach i [bind Test] {
    bind Test $i {}
}
foreach i [bind all] {
    bind all $i {}
................................................................................
test bind-16.44 {ExpandPercents procedure} {
    setup
    bind .b.f <Gravity> {set x "%R %S"}
    set x none
    event gen .b.f <Gravity>
    set x
} {?? ??}




















test bind-17.1 {event command} {
    list [catch {event} msg] $msg
} {1 {wrong # args: should be "event option ?arg?"}}
test bind-17.2 {event command} {
    list [catch {event xyz} msg] $msg






>
>
>
>
>
>
>
>







 







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
....
1569
1570
1571
1572
1573
1574
1575
1576
1577
1578
1579
1580
1581
1582
1583
1584
1585
1586
1587
1588
1589
1590
1591
1592
1593
1594
1595
1596
1597
1598
1599
1600
    catch {destroy .b.f}
    frame .b.f -class Test -width 150 -height 100
    pack .b.f
    focus -force .b.f
    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] {
    bind Test $i {}
}
foreach i [bind all] {
    bind all $i {}
................................................................................
test bind-16.44 {ExpandPercents procedure} {
    setup
    bind .b.f <Gravity> {set x "%R %S"}
    set x none
    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} {
    list [catch {event} msg] $msg
} {1 {wrong # args: should be "event option ?arg?"}}
test bind-17.2 {event command} {
    list [catch {event xyz} msg] $msg