Tk Source Code

Check-in [263b9cde]
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:Tweaked comments
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | bug6e8afe516d
Files: files | file ages | folders
SHA3-256:263b9cde6a8e02ef9d3b4d109e3b26177d0fdc67ad0d11c6a02016eee108c676
User & Date: fvogel 2019-02-03 17:18:25
Context
2019-02-03
20:22
Propagate the call to TkpInitKeymapInfo in TkpOpenDisplay from Linux to Windows. check-in: a2d9055c user: fvogel tags: bug6e8afe516d
17:23
Create a derivated version of TIP #532 targeting trunk (8.7), with PREFER_MOST_SPECIALIZED_EVENT=1 and SUPPORT_ADDITIONAL_MOTION_SYNTAX=1 check-in: 361f2173 user: fvogel tags: bug6e8afe516d-87
17:18
Tweaked comments check-in: 263b9cde user: fvogel tags: bug6e8afe516d
17:04
Fix ultra-minor formatting issue in the rules for electing the matching sequence check-in: 8b49b98b user: fvogel tags: bug6e8afe516d
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to generic/tkBind.c.

68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94






95
96
97
98
99
100
101
 *
 * Package-specific common helpers.
 *
 * Non-package-specific helpers.
 */

/*
 * In old implementation <Double-1> and <1><1> are equivalent sequences. This is not logical,
 * in my opinion <Double-1> should have higher precedence, but we will keep the new implementation
 * conform. If the decision about this point will change then PREFER_MOST_SPECIALIZED_EVENT
 * should be set to 1.
 */

#ifndef PREFER_MOST_SPECIALIZED_EVENT
# define PREFER_MOST_SPECIALIZED_EVENT 0
#endif

/*
 * Traditionally motion events can be combined with buttons in this way: <B1-B2-Motion>.
 * I think it should be allowed to express this as <Motion-1-2>. The latter syntax form
 * is already implemented, but still commented out.
 */

#ifndef SUPPORT_ADDITIONAL_MOTION_SYNTAX
# define SUPPORT_ADDITIONAL_MOTION_SYNTAX 0 /* set to 1 if wanted */
#endif







#ifndef PRINT_SHORT_MOTION_SYNTAX
# define PRINT_SHORT_MOTION_SYNTAX 0 /* set to 1 if wanted */
#endif

#if !SUPPORT_ADDITIONAL_MOTION_SYNTAX
# undef PRINT_SHORT_MOTION_SYNTAX
# define PRINT_SHORT_MOTION_SYNTAX 0






|
|
|
<








|
|






>
>
>
>
>
>







68
69
70
71
72
73
74
75
76
77

78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
 *
 * Package-specific common helpers.
 *
 * Non-package-specific helpers.
 */

/*
 * In old implementation (the one that used an event ring), <Double-1> and <1><1> were
 * equivalent sequences. However it is logical to give <Double-1> higher precedence.
 * This can be achieved by setting PREFER_MOST_SPECIALIZED_EVENT to 1.

 */

#ifndef PREFER_MOST_SPECIALIZED_EVENT
# define PREFER_MOST_SPECIALIZED_EVENT 0
#endif

/*
 * Traditionally motion events can be combined with buttons in this way: <B1-B2-Motion>.
 * However it should be allowed to express this as <Motion-1-2> in addition. This can be
 * achieved by setting SUPPORT_ADDITIONAL_MOTION_SYNTAX to 1.
 */

#ifndef SUPPORT_ADDITIONAL_MOTION_SYNTAX
# define SUPPORT_ADDITIONAL_MOTION_SYNTAX 0 /* set to 1 if wanted */
#endif

/*
 * The output for motion events is of the type <B1-Motion>. This can be changed to become
 * <Motion-1> instead by setting PRINT_SHORT_MOTION_SYNTAX to 1, however this would be a
 * backwards incompatibility.
 */

#ifndef PRINT_SHORT_MOTION_SYNTAX
# define PRINT_SHORT_MOTION_SYNTAX 0 /* set to 1 if wanted */
#endif

#if !SUPPORT_ADDITIONAL_MOTION_SYNTAX
# undef PRINT_SHORT_MOTION_SYNTAX
# define PRINT_SHORT_MOTION_SYNTAX 0

Changes to tests/bind.test.

2561
2562
2563
2564
2565
2566
2567
2568
2569
2570
2571
2572
2573
2574
2575
....
2598
2599
2600
2601
2602
2603
2604
2605
2606
2607
2608
2609
2610
2611
2612
....
2635
2636
2637
2638
2639
2640
2641
2642
2643
2644
2645
2646
2647
2648
2649
....
6125
6126
6127
6128
6129
6130
6131
6132
6133
6134
6135
6136
6137
6138
6139
6140
....
6175
6176
6177
6178
6179
6180
6181
6182
6183
6184
6185
6186
6187
6188
6189
6190
....
6191
6192
6193
6194
6195
6196
6197
6198
6199
6200
6201
6202
6203
6204
6205
....
6368
6369
6370
6371
6372
6373
6374
6375
6376
6377
6378
6379
6380
6381
6382
....
6405
6406
6407
6408
6409
6410
6411
6412
6413
6414
6415
6416
6417
6418
6419
6420
6421
6422
6423
6424
6425
6426
6427
6428
6429
6430
6431
6432
6433
6434
6435
6436
6437
....
6441
6442
6443
6444
6445
6446
6447
6448
6449
6450
6451
6452
6453
6454
6455
6456
6457
6458
6459
6460
6461
6462
6463
6464
6465
6466
6467
6468
6469
....
6525
6526
6527
6528
6529
6530
6531
6532
6533
6534
6535
6536
6537
6538
6539
....
6556
6557
6558
6559
6560
6561
6562
6563
6564
6565
6566
6567
6568
6569
6570
6571
6572
....
6591
6592
6593
6594
6595
6596
6597
6598
6599
6600
6601
6602
6603
6604
6605
6606
6607
6608
6609
6610
6611
    event delete <<def>>
    event delete <<abc>>
} -result {{xyz abc def abc def} {} <Control-Button-2> <Shift-Button-2>}
test bind-19.15 {DeleteVirtualEvent procedure: owned by many, first} -setup {
    pack [frame .t.f -class Test -width 150 -height 100]
    pack [frame .t.g -class Test -width 150 -height 100]
    pack [frame .t.h -class Test -width 150 -height 100]
    after 250 ;# we need a bit time to ensure that .t.h is mapped
    focus -force .t.f
    update
    set x {}
    event delete <<def>>
    event delete <<xyz>>
    event delete <<abc>>
} -body {
................................................................................
    event delete <<def>>
    event delete <<abc>>
} -result {{xyz abc def abc def} {} <Button-2> <Button-2>}
test bind-19.16 {DeleteVirtualEvent procedure: owned by many, middle} -setup {
    pack [frame .t.f -class Test -width 150 -height 100]
    pack [frame .t.g -class Test -width 150 -height 100]
    pack [frame .t.h -class Test -width 150 -height 100]
    after 250 ;# we need a bit time to ensure that .t.h is mapped
    focus -force .t.f
    update
    set x {}
    event delete <<def>>
    event delete <<xyz>>
    event delete <<abc>>
} -body {
................................................................................
    event delete <<def>>
    event delete <<xyz>>
} -result {{xyz abc def xyz def} <Button-2> {} <Button-2>}
test bind-19.17 {DeleteVirtualEvent procedure: owned by many, last} -setup {
    pack [frame .t.f -class Test -width 150 -height 100]
    pack [frame .t.g -class Test -width 150 -height 100]
    pack [frame .t.h -class Test -width 150 -height 100]
    after 250 ;# we need a bit time to ensure that .t.h is mapped
    focus -force .t.f
    update
    set x {}
    event delete <<def>>
    event delete <<xyz>>
    event delete <<abc>>
} -body {
................................................................................
    focus -force .t.f
    bind .t.f <Double-Button-1> { set x "Double" }
    update
    set x {}
} -body {
    event generate .t.f <ButtonPress-1>
    event generate .t.f <ButtonRelease-1>
    # Simulate a lot of intervening exposure events, with old implementation
    # the event loop overflows, and the double click will not be detected.
    # But new implementation should work properly.
    for {set i 0} {$i < 1000} {incr i} {
        event generate .t.f <Expose>
    }
    event generate .t.f <ButtonPress-1>
    event generate .t.f <ButtonRelease-1>
    set x
................................................................................
    update
    set x {}
} -body {
    bind .t.f <Quadruple-1> { set x "Quadruple" }
    bind .t.f <Triple-1> { set x "Triple" }
    bind .t.f <Double-1> { set x "Double" }
    bind .t.f <1> { set x "Single" }
    # Old implementation triggers "Double", but new implementation will
    # trigger "Quadruple", the latter behavior conforms to other toolkits.
    event generate .t.f <Button-1> -time 0
    event generate .t.f <Button-1> -time 400
    event generate .t.f <Button-1> -time 800
    event generate .t.f <Button-1> -time 1200
    set x
} -cleanup {
    destroy .t.f
................................................................................
} -result {Quadruple}
test bind-32.6 {problem with sendevent} -setup {
    pack [frame .t.f]
    focus -force .t.f
    update
    set x {}
} -body {
    # old implementation is losing sendevent value
    bind .t.f <FocusIn> { set x "sendevent=%E" }
    event generate .t.f <FocusIn> -sendevent 1
    set x
} -cleanup {
    destroy .t.f
} -result {sendevent=1}
test bind-32.7 {test sequences} -setup {
................................................................................
    bind .t.f <1><1> { lappend x "11" }
    event generate .t.f <1>
    event generate .t.f <1>
    set x
} -cleanup {
    destroy .t.f
    # This test case shows that old implementation has an issue, because
    # in my opinion it is expected that <Double-1> is matching, this binding
    # is more specific. But new implementation will be conform to old,
    # and so "11" is the expected result.
} -result {11}
test bind-33.3 {should prefer most specific event} -setup {
    pack [frame .t.f]
    focus -force .t.f
    update
................................................................................
    bind .t.f <1><1> { lappend x "11" }
    bind .t.f <Double-1> { lappend x "Double" }
    event generate .t.f <1> -time 0
    event generate .t.f <1> -time 1000
    set x
} -cleanup {
    destroy .t.f
    # This test case also shows that old implementation has an issue, because
    # here <1><1> will be triggered correctly, but this is not consistent with
    # test case 33.2.
} -result {11}
test bind-33.5 {prefer most specific} -setup {
    pack [frame .t.f]
    focus -force .t.f
    update
    set x {}
} -body {
    bind .t.f <1><1> { lappend x "11" }
    bind .t.f <Double-ButtonPress> { lappend x "Double" }
    event generate .t.f <1>
    event generate .t.f <1>
    set x
} -cleanup {
    destroy .t.f
} -result {11}
test bind-33.6 {prefer most specific} -setup {
    pack [frame .t.f]
    focus -force .t.f
    update
    set x {}
} -body {
    bind .t.f <a><1><1><1><1><a> { lappend x "1111" }
    bind .t.f <a><ButtonPress><Double-ButtonPress><ButtonPress><a> { lappend x "Any-Double-Any" }
................................................................................
    event generate .t.f <1>
    event generate .t.f <1>
    event generate .t.f <a>
    set x
} -cleanup {
    destroy .t.f
} -result {1111}
test bind-33.7 {prefer most specific} -setup {
    pack [frame .t.f]
    focus -force .t.f
    update
    set x {}
} -body {
    bind .t.f <ButtonPress-1><a> { lappend x "1" }
    bind .t.f <ButtonPress><a> { lappend x "Any" }
    event generate .t.f <1>
    event generate .t.f <a>
    set x
} -cleanup {
    destroy .t.f
} -result {1}
test bind-33.8 {prefer most specific} -setup {
    pack [frame .t.f]
    focus -force .t.f
    update
    set x {}
} -body {
    bind .t.f <Double-ButtonPress-1><a> { lappend x "1" }
    bind .t.f <ButtonPress><ButtonPress><a> { lappend x "Any" }
................................................................................
    event generate .t.f <1>
    event generate .t.f <2>
    event generate .t.f <2>
    set x
} -cleanup {
    destroy .t.f
    # This test case shows that old implementation has an issue, because
    # in my opinion it is expected that first one is matching, this binding
    # is more specific. But new implementation will be conform to old,
    # and so "last" is the expected result.
} -result {last}
test bind-33.12 {prefer last in case of homogeneous equal patterns} -setup {
    pack [frame .t.f]
    focus -force .t.f
    update
................................................................................
    bind .t.f <1><Control-1> { lappend x "first" }
    bind .t.f <Control-1><1> { lappend x "last" }
    event generate .t.f <Control-1>
    event generate .t.f <Control-1>
    set x
} -cleanup {
    destroy .t.f
    # Old implementation fails, and returns "first", but this is wrong,
    # because both bindings are homogeneous equal, so the latter must
    # be preferred.
} -result {last}
test bind-33.14 {prefer last in case of homogeneous equal patterns} -setup {
    pack [frame .t.f]
    focus -force .t.f
    update
    set x {}
} -body {
................................................................................
    event generate .t.f <1>
    event generate .t.f <1>
    event generate .t.f <1>
    event generate .t.f <1>
    set x
} -cleanup {
    destroy .t.f
    # Old implementation fails, and returns "first", but this is wrong,
    # because both bindings are homogeneous equal, so the latter must
    # be preferred.
} -result {last}


# cleanup
cleanupTests
return

# vi:set ts=4 sw=4 et:
# Local Variables:
# mode: tcl
# End:






|







 







|







 







|







 







|
|







 







|
|







 







|







 







|







 







<
<
<

|













|







 







|













|







 







|







 







|
|
|







 







|
|
|











2561
2562
2563
2564
2565
2566
2567
2568
2569
2570
2571
2572
2573
2574
2575
....
2598
2599
2600
2601
2602
2603
2604
2605
2606
2607
2608
2609
2610
2611
2612
....
2635
2636
2637
2638
2639
2640
2641
2642
2643
2644
2645
2646
2647
2648
2649
....
6125
6126
6127
6128
6129
6130
6131
6132
6133
6134
6135
6136
6137
6138
6139
6140
....
6175
6176
6177
6178
6179
6180
6181
6182
6183
6184
6185
6186
6187
6188
6189
6190
....
6191
6192
6193
6194
6195
6196
6197
6198
6199
6200
6201
6202
6203
6204
6205
....
6368
6369
6370
6371
6372
6373
6374
6375
6376
6377
6378
6379
6380
6381
6382
....
6405
6406
6407
6408
6409
6410
6411



6412
6413
6414
6415
6416
6417
6418
6419
6420
6421
6422
6423
6424
6425
6426
6427
6428
6429
6430
6431
6432
6433
6434
....
6438
6439
6440
6441
6442
6443
6444
6445
6446
6447
6448
6449
6450
6451
6452
6453
6454
6455
6456
6457
6458
6459
6460
6461
6462
6463
6464
6465
6466
....
6522
6523
6524
6525
6526
6527
6528
6529
6530
6531
6532
6533
6534
6535
6536
....
6553
6554
6555
6556
6557
6558
6559
6560
6561
6562
6563
6564
6565
6566
6567
6568
6569
....
6588
6589
6590
6591
6592
6593
6594
6595
6596
6597
6598
6599
6600
6601
6602
6603
6604
6605
6606
6607
6608
    event delete <<def>>
    event delete <<abc>>
} -result {{xyz abc def abc def} {} <Control-Button-2> <Shift-Button-2>}
test bind-19.15 {DeleteVirtualEvent procedure: owned by many, first} -setup {
    pack [frame .t.f -class Test -width 150 -height 100]
    pack [frame .t.g -class Test -width 150 -height 100]
    pack [frame .t.h -class Test -width 150 -height 100]
    after 250 ;# we need a bit time to ensure that .t.h is mapped (<TODO>: fix this race condition)
    focus -force .t.f
    update
    set x {}
    event delete <<def>>
    event delete <<xyz>>
    event delete <<abc>>
} -body {
................................................................................
    event delete <<def>>
    event delete <<abc>>
} -result {{xyz abc def abc def} {} <Button-2> <Button-2>}
test bind-19.16 {DeleteVirtualEvent procedure: owned by many, middle} -setup {
    pack [frame .t.f -class Test -width 150 -height 100]
    pack [frame .t.g -class Test -width 150 -height 100]
    pack [frame .t.h -class Test -width 150 -height 100]
    after 250 ;# we need a bit time to ensure that .t.h is mapped (<TODO>: fix this race condition)
    focus -force .t.f
    update
    set x {}
    event delete <<def>>
    event delete <<xyz>>
    event delete <<abc>>
} -body {
................................................................................
    event delete <<def>>
    event delete <<xyz>>
} -result {{xyz abc def xyz def} <Button-2> {} <Button-2>}
test bind-19.17 {DeleteVirtualEvent procedure: owned by many, last} -setup {
    pack [frame .t.f -class Test -width 150 -height 100]
    pack [frame .t.g -class Test -width 150 -height 100]
    pack [frame .t.h -class Test -width 150 -height 100]
    after 250 ;# we need a bit time to ensure that .t.h is mapped (<TODO>: fix this race condition)
    focus -force .t.f
    update
    set x {}
    event delete <<def>>
    event delete <<xyz>>
    event delete <<abc>>
} -body {
................................................................................
    focus -force .t.f
    bind .t.f <Double-Button-1> { set x "Double" }
    update
    set x {}
} -body {
    event generate .t.f <ButtonPress-1>
    event generate .t.f <ButtonRelease-1>
    # Simulate a lot of intervening exposure events. The old implementation
    # that used an event ring overflowed, and the double click was not detected.
    # But new implementation should work properly.
    for {set i 0} {$i < 1000} {incr i} {
        event generate .t.f <Expose>
    }
    event generate .t.f <ButtonPress-1>
    event generate .t.f <ButtonRelease-1>
    set x
................................................................................
    update
    set x {}
} -body {
    bind .t.f <Quadruple-1> { set x "Quadruple" }
    bind .t.f <Triple-1> { set x "Triple" }
    bind .t.f <Double-1> { set x "Double" }
    bind .t.f <1> { set x "Single" }
    # Old implementation triggered "Double", but new implementation
    # triggers "Quadruple", the latter behavior conforms to other toolkits.
    event generate .t.f <Button-1> -time 0
    event generate .t.f <Button-1> -time 400
    event generate .t.f <Button-1> -time 800
    event generate .t.f <Button-1> -time 1200
    set x
} -cleanup {
    destroy .t.f
................................................................................
} -result {Quadruple}
test bind-32.6 {problem with sendevent} -setup {
    pack [frame .t.f]
    focus -force .t.f
    update
    set x {}
} -body {
    # Old implementation was losing sendevent value
    bind .t.f <FocusIn> { set x "sendevent=%E" }
    event generate .t.f <FocusIn> -sendevent 1
    set x
} -cleanup {
    destroy .t.f
} -result {sendevent=1}
test bind-32.7 {test sequences} -setup {
................................................................................
    bind .t.f <1><1> { lappend x "11" }
    event generate .t.f <1>
    event generate .t.f <1>
    set x
} -cleanup {
    destroy .t.f
    # This test case shows that old implementation has an issue, because
    # it is expected that <Double-1> is matching, this binding
    # is more specific. But new implementation will be conform to old,
    # and so "11" is the expected result.
} -result {11}
test bind-33.3 {should prefer most specific event} -setup {
    pack [frame .t.f]
    focus -force .t.f
    update
................................................................................
    bind .t.f <1><1> { lappend x "11" }
    bind .t.f <Double-1> { lappend x "Double" }
    event generate .t.f <1> -time 0
    event generate .t.f <1> -time 1000
    set x
} -cleanup {
    destroy .t.f



} -result {11}
test bind-33.5 {prefer most specific event} -setup {
    pack [frame .t.f]
    focus -force .t.f
    update
    set x {}
} -body {
    bind .t.f <1><1> { lappend x "11" }
    bind .t.f <Double-ButtonPress> { lappend x "Double" }
    event generate .t.f <1>
    event generate .t.f <1>
    set x
} -cleanup {
    destroy .t.f
} -result {11}
test bind-33.6 {prefer most specific event} -setup {
    pack [frame .t.f]
    focus -force .t.f
    update
    set x {}
} -body {
    bind .t.f <a><1><1><1><1><a> { lappend x "1111" }
    bind .t.f <a><ButtonPress><Double-ButtonPress><ButtonPress><a> { lappend x "Any-Double-Any" }
................................................................................
    event generate .t.f <1>
    event generate .t.f <1>
    event generate .t.f <a>
    set x
} -cleanup {
    destroy .t.f
} -result {1111}
test bind-33.7 {prefer most specific event} -setup {
    pack [frame .t.f]
    focus -force .t.f
    update
    set x {}
} -body {
    bind .t.f <ButtonPress-1><a> { lappend x "1" }
    bind .t.f <ButtonPress><a> { lappend x "Any" }
    event generate .t.f <1>
    event generate .t.f <a>
    set x
} -cleanup {
    destroy .t.f
} -result {1}
test bind-33.8 {prefer most specific event} -setup {
    pack [frame .t.f]
    focus -force .t.f
    update
    set x {}
} -body {
    bind .t.f <Double-ButtonPress-1><a> { lappend x "1" }
    bind .t.f <ButtonPress><ButtonPress><a> { lappend x "Any" }
................................................................................
    event generate .t.f <1>
    event generate .t.f <2>
    event generate .t.f <2>
    set x
} -cleanup {
    destroy .t.f
    # This test case shows that old implementation has an issue, because
    # it is expected that first one is matching, this binding
    # is more specific. But new implementation will be conform to old,
    # and so "last" is the expected result.
} -result {last}
test bind-33.12 {prefer last in case of homogeneous equal patterns} -setup {
    pack [frame .t.f]
    focus -force .t.f
    update
................................................................................
    bind .t.f <1><Control-1> { lappend x "first" }
    bind .t.f <Control-1><1> { lappend x "last" }
    event generate .t.f <Control-1>
    event generate .t.f <Control-1>
    set x
} -cleanup {
    destroy .t.f
    # Old implementation failed, and returned "first", but this was wrong,
    # because both bindings are homogeneous equal, so the most recently defined
    # must be preferred.
} -result {last}
test bind-33.14 {prefer last in case of homogeneous equal patterns} -setup {
    pack [frame .t.f]
    focus -force .t.f
    update
    set x {}
} -body {
................................................................................
    event generate .t.f <1>
    event generate .t.f <1>
    event generate .t.f <1>
    event generate .t.f <1>
    set x
} -cleanup {
    destroy .t.f
    # Old implementation failed, and returned "first", but this was wrong,
    # because both bindings are homogeneous equal, so the most recently defined
    # must be preferred.
} -result {last}


# cleanup
cleanupTests
return

# vi:set ts=4 sw=4 et:
# Local Variables:
# mode: tcl
# End: