util/src/TclTk/tk8.6.12/tests/event.test

   1 # This file is a Tcl script to test the code in tkEvent.c.  It is
   2 # organized in the standard fashion for Tcl tests.
   3 #
   4 # Copyright (c) 1994 The Regents of the University of California.
   5 # Copyright (c) 1994-1995 Sun Microsystems, Inc.
   6 # Copyright (c) 1998-1999 by Scriptics Corporation.
   7 # All rights reserved.
   8
   9 package require tcltest 2.2
  10 eval tcltest::configure $argv
  11 tcltest::loadTestedCommands
  12 namespace import -force tcltest::test
  13
  14 # XXX This test file is woefully incomplete.  Right now it only tests
  15 # a few of the procedures in tkEvent.c.  Please add more tests whenever
  16 # possible.
  17
  18 # Setup table used to query key events.
  19
  20 proc _init_keypress_lookup {} {
  21     global keypress_lookup
  22
  23     scan A %c start
  24     scan Z %c finish
  25
  26     for {set i $start} {$i <= $finish} {incr i} {
  27         set l [format %c $i]
  28         set keypress_lookup($l) $l
  29     }
  30
  31     scan a %c start
  32     scan z %c finish
  33
  34     for {set i $start} {$i <= $finish} {incr i} {
  35         set l [format %c $i]
  36         set keypress_lookup($l) $l
  37     }
  38
  39     scan 0 %c start
  40     scan 9 %c finish
  41
  42     for {set i $start} {$i <= $finish} {incr i} {
  43         set l [format %c $i]
  44         set keypress_lookup($l) $l
  45     }
  46
  47     # Most punctuation
  48     array set keypress_lookup {
  49         ! exclam
  50         % percent
  51         & ampersand
  52         ( parenleft
  53         ) parenright
  54         * asterisk
  55         + plus
  56         , comma
  57         - minus
  58         . period
  59         / slash
  60         : colon
  61         < less
  62         = equal
  63         > greater
  64         ? question
  65         @ at
  66         ^ asciicircum
  67         _ underscore
  68         | bar
  69         ~ asciitilde
  70         ' apostrophe
  71     }
  72     # Characters with meaning to Tcl...
  73     array set keypress_lookup [list \
  74             \"   quotedbl \
  75             \#   numbersign \
  76             \$   dollar \
  77             \;   semicolon \
  78             \[   bracketleft \
  79             \\   backslash \
  80             \]   bracketright \
  81             \{   braceleft \
  82             \}   braceright \
  83             " "  space \
  84             "\n" Return \
  85             "\t" Tab]
  86 }
  87
  88 # Lookup an event in the keypress table.
  89 # For example:
  90 # Q -> Q
  91 # . -> period
  92 # / -> slash
  93 # Delete -> Delete
  94 # Escape -> Escape
  95
  96 proc _keypress_lookup {char} {
  97     global keypress_lookup
  98
  99     if {! [info exists keypress_lookup]} {
 100         _init_keypress_lookup
 101     }
 102
 103     if {$char == ""} {
 104         error "empty char"
 105     }
 106
 107     if {[info exists keypress_lookup($char)]} {
 108         return $keypress_lookup($char)
 109     } else {
 110         return $char
 111     }
 112 }
 113
 114 # Lookup and generate a pair of KeyPress and KeyRelease events
 115
 116 proc _keypress {win key} {
 117     set keysym [_keypress_lookup $key]
 118
 119     # Force focus to the window before delivering
 120     # each event so that a window manager using
 121     # a focus follows mouse will not steal away
 122     # the focus if the mouse is moved around.
 123
 124     if {[focus] != $win} {
 125         focus -force $win
 126     }
 127     event generate $win <KeyPress-$keysym>
 128     _pause 50
 129     if {[focus] != $win} {
 130         focus -force $win
 131     }
 132     event generate $win <KeyRelease-$keysym>
 133     _pause 50
 134 }
 135
 136 # Call _keypress for each character in the given string
 137
 138 proc _keypress_string {win string} {
 139     foreach letter [split $string ""] {
 140         _keypress $win $letter
 141     }
 142 }
 143
 144 # Delay script execution for a given amount of time
 145
 146 proc _pause {{msecs 1000}} {
 147     global _pause
 148
 149     if {! [info exists _pause(number)]} {
 150         set _pause(number) 0
 151     }
 152
 153     set num [incr _pause(number)]
 154     set _pause($num) 0
 155
 156     after $msecs "set _pause($num) 1"
 157     vwait _pause($num)
 158     unset _pause($num)
 159 }
 160
 161 # Helper proc to convert index to x y position
 162
 163 proc _text_ind_to_x_y {text ind} {
 164     set bbox [$text bbox $ind]
 165     if {[llength $bbox] != 4} {
 166         error "got bbox \{$bbox\} from $text, index $ind"
 167     }
 168     foreach {x1 y1 width height} $bbox break
 169     set middle_y [expr {$y1 + ($height / 2)}]
 170     return [list $x1 $middle_y]
 171 }
 172
 173 # Return selection only if owned by the given widget
 174
 175 proc _get_selection {widget} {
 176     if {[string compare $widget [selection own]] != 0} {
 177         return ""
 178     }
 179     if {[catch {selection get} sel]} {
 180         return ""
 181     }
 182     return $sel
 183 }
 184
 185 # Begining of the actual tests
 186
 187 test event-1.1 {Tk_HandleEvent procedure, filter events for dead windows} -setup {
 188         deleteWindows
 189     set x {}
 190 } -body {
 191     button .b -text Test
 192     pack .b
 193     bindtags .b .b
 194     update
 195     bind .b <Destroy> {
 196             lappend x destroy
 197             event generate .b <1>
 198             event generate .b <ButtonRelease-1>
 199     }
 200     bind .b <1> {
 201             lappend x button
 202     }
 203
 204     destroy .b
 205     return $x
 206 } -cleanup {
 207     deleteWindows
 208 } -result {destroy}
 209 test event-1.2 {event generate <Alt-z>} -setup {
 210         deleteWindows
 211     catch {unset ::event12result}
 212 } -body {
 213         set ::event12result 0
 214         pack [entry .e]
 215         update
 216         bind .e <Alt-z> {set ::event12result "1"}
 217
 218         focus -force .e
 219      event generate .e <Alt-z>
 220         destroy .e
 221         set ::event12result
 222 } -cleanup {
 223     deleteWindows
 224 } -result 1
 225
 226
 227 test event-2.1(keypress) {type into entry widget and hit Return} -setup {
 228         deleteWindows
 229 } -body {
 230     set t [toplevel .t]
 231     set e [entry $t.e]
 232     pack $e
 233     set return_binding 0
 234     bind $e <Return> {set return_binding 1}
 235     tkwait visibility $e
 236     _keypress_string $e HELLO\n
 237     list [$e get] $return_binding
 238 } -cleanup {
 239     deleteWindows
 240 } -result {HELLO 1}
 241 test event-2.2(keypress) {type into entry widget and then delete some text} -setup {
 242         deleteWindows
 243 } -body {
 244     set t [toplevel .t]
 245     set e [entry $t.e]
 246     pack $e
 247     tkwait visibility $e
 248     # Avoid a hang when macOS puts the mouse pointer on the green button
 249     wm geometry .t +200+100
 250     _keypress_string $e MELLO
 251     _keypress $e BackSpace
 252     _keypress $e BackSpace
 253     $e get
 254 } -cleanup {
 255     deleteWindows
 256 } -result {MEL}
 257 test event-2.3(keypress) {type into entry widget, triple click, hit Delete key,
 258         and then type some more} -setup {
 259     deleteWindows
 260 } -body {
 261     set t [toplevel .t]
 262     set e [entry $t.e]
 263     pack $e
 264     tkwait visibility $e
 265     _keypress_string $e JUMP
 266
 267     set result [$e get]
 268
 269     event generate $e <Enter>
 270     for {set i 0} {$i < 3} {incr i} {
 271         _pause 100
 272         event generate $e <ButtonPress-1>
 273         _pause 100
 274         event generate $e <ButtonRelease-1>
 275     }
 276
 277     _keypress $e Delete
 278     _keypress_string $e UP
 279     lappend result [$e get]
 280 } -cleanup {
 281     deleteWindows
 282 } -result {JUMP UP}
 283 test event-2.4(keypress) {type into text widget and hit Return} -setup {
 284         deleteWindows
 285 } -body {
 286     set t [toplevel .t]
 287     set e [text $t.e]
 288     pack $e
 289     set return_binding 0
 290     bind $e <Return> {set return_binding 1}
 291     tkwait visibility $e
 292     _keypress_string $e HELLO\n
 293     list [$e get 1.0 end] $return_binding
 294 } -cleanup {
 295     deleteWindows
 296 } -result [list "HELLO\n\n" 1]
 297 test event-2.5(keypress) {type into text widget and then delete some text} -setup {
 298         deleteWindows
 299 } -body {
 300     set t [toplevel .t]
 301     set e [text $t.e]
 302     pack $e
 303     tkwait visibility $e
 304     _keypress_string $e MELLO
 305     _keypress $e BackSpace
 306     _keypress $e BackSpace
 307     $e get 1.0 1.end
 308 } -cleanup {
 309     deleteWindows
 310 } -result {MEL}
 311 test event-2.6(keypress) {type into text widget, triple click,
 312     hit Delete key, and then type some more} -setup {
 313         deleteWindows
 314 } -body {
 315     set t [toplevel .t]
 316     set e [text $t.e]
 317     pack $e
 318     tkwait visibility $e
 319     _keypress_string $e JUMP
 320
 321     set result [$e get 1.0 1.end]
 322
 323     event generate $e <Enter>
 324     for {set i 0} {$i < 3} {incr i} {
 325         _pause 100
 326         event generate $e <ButtonPress-1>
 327         _pause 100
 328         event generate $e <ButtonRelease-1>
 329     }
 330
 331     _keypress $e Delete
 332     _keypress_string $e UP
 333     lappend result [$e get 1.0 1.end]
 334 } -cleanup {
 335     deleteWindows
 336 } -result {JUMP UP}
 337
 338 test event-3.1(click-drag) {click and drag in a text widget, this tests
 339     tkTextSelectTo in text.tcl} -setup {
 340         deleteWindows
 341 } -body {
 342     set t [toplevel .t]
 343     set e [text $t.e]
 344     pack $e
 345     tkwait visibility $e
 346     _keypress_string $e "A Tcl/Tk selection test!"
 347     set anchor 1.6
 348     set selend 1.18
 349
 350     set result [list]
 351     lappend result [$e get 1.0 1.end]
 352
 353     # Get the x,y coords of the second T in "Tcl/Tk"
 354     foreach {anchor_x anchor_y} [_text_ind_to_x_y $e $anchor] break
 355
 356     # Click down to set the insert cursor position
 357     event generate $e <Enter>
 358     event generate $e <ButtonPress-1> -x $anchor_x -y $anchor_y
 359
 360     # Save the position of the insert cursor
 361     lappend result [$e index insert]
 362
 363     # Now drag until selend is highlighted, then click up
 364
 365     set current $anchor
 366     while {[$e compare $current <= $selend]} {
 367         foreach {current_x current_y} [_text_ind_to_x_y $e $current] break
 368         event generate $e <B1-Motion> -x $current_x -y $current_y
 369         set current [$e index [list $current + 1 char]]
 370         _pause 50
 371     }
 372
 373     event generate $e <ButtonRelease-1> -x $current_x -y $current_y
 374     _pause 200
 375
 376     # Save the position of the insert cursor
 377     lappend result [$e index insert]
 378
 379     # Save the highlighted text
 380     lappend result [_get_selection $e]
 381
 382     # Now click and click and drag to the left, over "Tcl/Tk selection"
 383
 384     event generate $e <ButtonPress-1> -x $current_x -y $current_y
 385
 386     while {[$e compare $current >= [list $anchor - 4 char]]} {
 387         foreach {current_x current_y} [_text_ind_to_x_y $e $current] break
 388         event generate $e <B1-Motion> -x $current_x -y $current_y
 389         set current [$e index [list $current - 1 char]]
 390         _pause 50
 391     }
 392
 393     event generate $e <ButtonRelease-1> -x $current_x -y $current_y
 394     _pause 200
 395
 396     # Save the position of the insert cursor
 397     lappend result [$e index insert]
 398
 399     # Save the highlighted text
 400     lappend result [_get_selection $e]
 401
 402 } -cleanup {
 403     deleteWindows
 404 } -result {{A Tcl/Tk selection test!} 1.6 1.18 {Tk selection} 1.2 {Tcl/Tk selection}}
 405  test event-3.2(click-drag) {click and drag in an entry widget, this
 406     tests tkEntryMouseSelect in entry.tcl} -setup {
 407         deleteWindows
 408 } -body {
 409     set t [toplevel .t]
 410     set e [entry $t.e]
 411     pack $e
 412     tkwait visibility $e
 413     _keypress_string $e "A Tcl/Tk selection!"
 414     set anchor 6
 415     set selend 18
 416
 417     set result [list]
 418     lappend result [$e get]
 419
 420     # Get the x,y coords of the second T in "Tcl/Tk"
 421     foreach {anchor_x anchor_y} [_text_ind_to_x_y $e $anchor] break
 422
 423     # Click down to set the insert cursor position
 424     event generate $e <Enter>
 425     event generate $e <ButtonPress-1> -x $anchor_x -y $anchor_y
 426
 427     # Save the position of the insert cursor
 428     lappend result [$e index insert]
 429
 430     # Now drag until selend is highlighted, then click up
 431
 432     set current $anchor
 433     while {$current <= $selend} {
 434         foreach {current_x current_y} [_text_ind_to_x_y $e $current] break
 435         event generate $e <B1-Motion> -x $current_x -y $current_y
 436         incr current
 437         _pause 50
 438     }
 439
 440     event generate $e <ButtonRelease-1> -x $current_x -y $current_y
 441     _pause 200
 442
 443     # Save the position of the insert cursor
 444     lappend result [$e index insert]
 445
 446     # Save the highlighted text
 447     lappend result [_get_selection $e]
 448
 449     # Now click and click and drag to the left, over "Tcl/Tk selection"
 450
 451     event generate $e <ButtonPress-1> -x $current_x -y $current_y
 452
 453     while {$current >= ($anchor - 4)} {
 454         foreach {current_x current_y} [_text_ind_to_x_y $e $current] break
 455         event generate $e <B1-Motion> -x $current_x -y $current_y
 456         incr current -1
 457         _pause 50
 458     }
 459
 460     event generate $e <ButtonRelease-1> -x $current_x -y $current_y
 461     _pause 200
 462
 463     # Save the position of the insert cursor
 464     lappend result [$e index insert]
 465
 466     # Save the highlighted text
 467     lappend result [_get_selection $e]
 468
 469 } -cleanup {
 470     deleteWindows
 471 } -result {{A Tcl/Tk selection!} 6 18 {Tk selection} 2 {Tcl/Tk selection}}
 472
 473
 474 test event-4.1(double-click-drag) {click down, click up, click down again,
 475     then drag in a text widget} -setup {
 476         deleteWindows
 477 } -body {
 478     set t [toplevel .t]
 479     set e [text $t.e]
 480     pack $e
 481     tkwait visibility $e
 482     _keypress_string $e "Word select test"
 483     set anchor 1.8
 484
 485     # Get the x,y coords of the second e in "select"
 486     foreach {anchor_x anchor_y} [_text_ind_to_x_y $e $anchor] break
 487
 488     # Click down, release, then click down again
 489     event generate $e <Enter>
 490     event generate $e <ButtonPress-1> -x $anchor_x -y $anchor_y
 491     _pause 50
 492     event generate $e <ButtonRelease-1> -x $anchor_x -y $anchor_y
 493     _pause 50
 494     event generate $e <ButtonPress-1> -x $anchor_x -y $anchor_y
 495     _pause 50
 496
 497     # Save the highlighted text
 498     set result [list]
 499     lappend result [_get_selection $e]
 500
 501     # Insert cursor should be at beginning of "select"
 502     lappend result [$e index insert]
 503
 504     # Move mouse one character to the left
 505     set current [$e index [list $anchor - 1 char]]
 506     foreach {current_x current_y} [_text_ind_to_x_y $e $current] break
 507
 508     event generate $e <B1-Motion> -x $current_x -y $current_y
 509     _pause 50
 510
 511     # Insert cursor should be before the l in "select"
 512     lappend result [$e index insert]
 513
 514     # Selection should still be the word "select"
 515     lappend result [_get_selection $e]
 516
 517     # Move mouse to the space before the word "select"
 518     set current [$e index [list $current - 3 char]]
 519
 520     foreach {current_x current_y} [_text_ind_to_x_y $e $current] break
 521     event generate $e <B1-Motion> -x $current_x -y $current_y
 522     _pause 200
 523
 524     lappend result [$e index insert]
 525     lappend result [_get_selection $e]
 526
 527     # Move mouse to the r in "Word"
 528     set current 1.2
 529     foreach {current_x current_y} [_text_ind_to_x_y $e $current] break
 530
 531     event generate $e <B1-Motion> -x $current_x -y $current_y
 532     _pause 50
 533
 534     # Selection should now be "Word select"
 535     lappend result [_get_selection $e]
 536
 537     # Insert cursor should be before the r in "Word"
 538     lappend result [$e index insert]
 539
 540     return $result
 541 } -cleanup {
 542     deleteWindows
 543 } -result {select 1.5 1.7 select 1.4 { select} {Word select} 1.2}
 544 test event-4.2(double-click-drag) {click down, click up, click down again,
 545     then drag in an entry widget} -setup {
 546         deleteWindows
 547 } -body {
 548     set t [toplevel .t]
 549     set e [entry $t.e]
 550     pack $e
 551     tkwait visibility $e
 552     _keypress_string $e "Word select test"
 553
 554     set anchor 8
 555
 556     # Get the x,y coords of the second e in "select"
 557     foreach {anchor_x anchor_y} [_text_ind_to_x_y $e $anchor] break
 558
 559     # Click down, release, then click down again
 560     event generate $e <Enter>
 561     event generate $e <ButtonPress-1> -x $anchor_x -y $anchor_y
 562     _pause 50
 563     event generate $e <ButtonRelease-1> -x $anchor_x -y $anchor_y
 564     _pause 50
 565     event generate $e <ButtonPress-1> -x $anchor_x -y $anchor_y
 566     _pause 50
 567
 568     set result [list]
 569     lappend result [_get_selection $e]
 570
 571     # Insert cursor should be at the end of "select"
 572     lappend result [$e index insert]
 573
 574     # Move mouse one character to the left
 575     set current [expr {$anchor - 1}]
 576     foreach {current_x current_y} [_text_ind_to_x_y $e $current] break
 577
 578     event generate $e <B1-Motion> -x $current_x -y $current_y
 579     _pause 50
 580
 581     # Insert cursor should be before the l in "select"
 582     lappend result [$e index insert]
 583
 584     # Selection should still be the word "select"
 585     lappend result [_get_selection $e]
 586
 587     # Move mouse to the space before the word "select"
 588     set current [expr {$current - 3}]
 589     foreach {current_x current_y} [_text_ind_to_x_y $e $current] break
 590
 591     event generate $e <B1-Motion> -x $current_x -y $current_y
 592     _pause 50
 593
 594     lappend result [$e index insert]
 595     lappend result [_get_selection $e]
 596
 597     # Move mouse to the r in "Word"
 598     set current [expr {$current - 2}]
 599     foreach {current_x current_y} [_text_ind_to_x_y $e $current] break
 600
 601     event generate $e <B1-Motion> -x $current_x -y $current_y
 602     _pause 50
 603
 604     # Selection should now be "Word select"
 605     lappend result [_get_selection $e]
 606
 607     # Insert cursor should be before the r in "Word"
 608     lappend result [$e index insert]
 609
 610     return $result
 611 } -cleanup {
 612     deleteWindows
 613 } -result {select 11 7 select 4 { select} {Word select} 2}
 614
 615 test event-5.1(triple-click-drag) {Triple click and drag across lines in a
 616         text widget, this should extend the selection to the new line} -setup {
 617         deleteWindows
 618 } -body {
 619     set t [toplevel .t]
 620     set e [text $t.e]
 621     pack $e
 622     tkwait visibility $e
 623     _keypress_string $e "LINE ONE\nLINE TWO\nLINE THREE"
 624
 625     set anchor 3.2
 626
 627     # Triple click one third line leaving mouse down
 628
 629     foreach {anchor_x anchor_y} [_text_ind_to_x_y $e $anchor] break
 630
 631     event generate $e <Enter>
 632
 633     event generate $e <ButtonPress-1> -x $anchor_x -y $anchor_y
 634     _pause 50
 635     event generate $e <ButtonRelease-1> -x $anchor_x -y $anchor_y
 636     _pause 50
 637
 638     event generate $e <ButtonPress-1> -x $anchor_x -y $anchor_y
 639     _pause 50
 640     event generate $e <ButtonRelease-1> -x $anchor_x -y $anchor_y
 641     _pause 50
 642
 643     event generate $e <ButtonPress-1> -x $anchor_x -y $anchor_y
 644     _pause 50
 645
 646     set result [list]
 647     lappend result [_get_selection $e]
 648
 649     # Drag up to second line
 650
 651     set current [$e index [list $anchor - 1 line]]
 652     foreach {current_x current_y} [_text_ind_to_x_y $e $current] break
 653
 654     event generate $e <B1-Motion> -x $current_x -y $current_y
 655     _pause 50
 656
 657     lappend result [_get_selection $e]
 658
 659     # Drag up to first line
 660
 661     set current [$e index [list $current - 1 line]]
 662     foreach {current_x current_y} [_text_ind_to_x_y $e $current] break
 663
 664     event generate $e <B1-Motion> -x $current_x -y $current_y
 665     _pause 50
 666
 667     lappend result [_get_selection $e]
 668
 669     return $result
 670 } -cleanup {
 671     deleteWindows
 672 } -result [list "LINE THREE\n" "LINE TWO\nLINE THREE\n" \
 673         "LINE ONE\nLINE TWO\nLINE THREE\n"]
 674
 675 test event-6.1(button-state) {button press in a window that is then
 676         destroyed, when the mouse is moved into another window it
 677         should not generate a <B1-motion> event since the mouse
 678         was not pressed down in that window} -setup {
 679         deleteWindows
 680 } -body {
 681     set t [toplevel .t]
 682
 683     event generate $t <ButtonPress-1>
 684     destroy $t
 685     set t [toplevel .t]
 686     set motion nomotion
 687     bind $t <B1-Motion> {set motion inmotion}
 688     event generate $t <Motion>
 689     return $motion
 690 } -cleanup {
 691     deleteWindows
 692 } -result {nomotion}
 693
 694 test event-7.1(double-click) {A double click on a lone character
 695     in a text widget should select that character} -setup {
 696         deleteWindows
 697 } -body {
 698     set t [toplevel .t]
 699     set e [text $t.e]
 700     pack $e
 701     tkwait visibility $e
 702     focus -force $e
 703     _keypress_string $e "On A letter"
 704
 705     set anchor 1.3
 706
 707     # Get x,y coords just inside the left
 708     # and right hand side of the letter A
 709     foreach {x1 y1 width height} [$e bbox $anchor] break
 710
 711     set middle_y [expr {$y1 + ($height / 2)}]
 712
 713     set left_x [expr {$x1 + 2}]
 714     set left_y $middle_y
 715
 716     set right_x [expr {($x1 + $width) - 2}]
 717     set right_y $middle_y
 718
 719     # Double click near left hand egde of the letter A
 720
 721     event generate $e <Enter>
 722     event generate $e <ButtonPress-1> -x $left_x -y $left_y
 723     _pause 50
 724     event generate $e <ButtonRelease-1> -x $left_x -y $left_y
 725     _pause 50
 726     event generate $e <ButtonPress-1> -x $left_x -y $left_y
 727     _pause 50
 728     event generate $e <ButtonRelease-1> -x $left_x -y $left_y
 729     _pause 50
 730
 731     set result [list]
 732     lappend result [$e index insert]
 733     lappend result [_get_selection $e]
 734
 735     # Clear selection by clicking at 0,0
 736
 737     event generate $e <ButtonPress-1> -x 0 -y 0
 738     _pause 50
 739     event generate $e <ButtonRelease-1> -x 0 -y 0
 740     _pause 50
 741
 742     # Double click near right hand edge of the letter A
 743
 744     event generate $e <ButtonPress-1> -x $right_x -y $right_y
 745     _pause 50
 746     event generate $e <ButtonRelease-1> -x $right_x -y $right_y
 747     _pause 50
 748     event generate $e <ButtonPress-1> -x $right_x -y $right_y
 749     _pause 50
 750     event generate $e <ButtonRelease-1> -x $right_x -y $right_y
 751     _pause 50
 752
 753     lappend result [$e index insert]
 754     lappend result [_get_selection $e]
 755
 756     return $result
 757 } -cleanup {
 758     deleteWindows
 759 } -result {1.3 A 1.3 A}
 760 test event-7.2(double-click) {A double click on a lone character
 761     in an entry widget should select that character} -setup {
 762         deleteWindows
 763 } -body {
 764     set t [toplevel .t]
 765     set e [entry $t.e]
 766     pack $e
 767     tkwait visibility $e
 768     focus -force $e
 769     _keypress_string $e "On A letter"
 770
 771     set anchor 3
 772
 773     # Get x,y coords just inside the left
 774     # and right hand side of the letter A
 775     foreach {x1 y1 width height} [$e bbox $anchor] break
 776
 777     set middle_y [expr {$y1 + ($height / 2)}]
 778
 779     set left_x [expr {$x1 + 2}]
 780     set left_y $middle_y
 781
 782     set right_x [expr {($x1 + $width) - 2}]
 783     set right_y $middle_y
 784
 785     # Double click near left hand egde of the letter A
 786
 787     event generate $e <Enter>
 788     event generate $e <ButtonPress-1> -x $left_x -y $left_y
 789     _pause 50
 790     event generate $e <ButtonRelease-1> -x $left_x -y $left_y
 791     _pause 50
 792     event generate $e <ButtonPress-1> -x $left_x -y $left_y
 793     _pause 50
 794     event generate $e <ButtonRelease-1> -x $left_x -y $left_y
 795     _pause 50
 796
 797     set result [list]
 798     lappend result [$e index insert]
 799     lappend result [_get_selection $e]
 800
 801     # Clear selection by clicking at 0,0
 802
 803     event generate $e <ButtonPress-1> -x 0 -y 0
 804     _pause 50
 805     event generate $e <ButtonRelease-1> -x 0 -y 0
 806     _pause 50
 807
 808     # Double click near right hand edge of the letter A
 809
 810     event generate $e <ButtonPress-1> -x $right_x -y $right_y
 811     _pause 50
 812     event generate $e <ButtonRelease-1> -x $right_x -y $right_y
 813     _pause 50
 814     event generate $e <ButtonPress-1> -x $right_x -y $right_y
 815     _pause 50
 816     event generate $e <ButtonRelease-1> -x $right_x -y $right_y
 817     _pause 50
 818
 819     lappend result [$e index insert]
 820     lappend result [_get_selection $e]
 821
 822     return $result
 823 } -cleanup {
 824     deleteWindows
 825 } -result {4 A 4 A}
 826
 827 test event-8 {event generate with keysyms corresponding to
 828               multi-byte virtual keycodes - bug
 829               e36963bfe8df9f5e528134707a91b9c0051de723} -constraints nonPortable -setup {
 830     deleteWindows
 831     set res [list ]
 832 } -body {
 833     set t [toplevel .t]
 834     set e [entry $t.e]
 835     pack $e
 836     tkwait visibility $e
 837     bind $e <KeyPress> {lappend res keycode: %k keysym: %K}
 838     focus -force $e
 839     update
 840     event generate $e <diaeresis>
 841     # The value now contained in $res depends on the actual
 842     # physical keyboard layout and keycode generated, from
 843     # the hardware on which the test suite happens to run.
 844     # We don't need (and we can't really) check correctness
 845     # of the (system-dependent) keycode received, however
 846     # Tk should be able to associate this keycode to a
 847     # (system-independent) known keysym, unless the system
 848     # running the test does not have a keyboard with a
 849     # diaeresis key.
 850     if {[expr {[lindex $res 3] ne "??"}]} {
 851         # keyboard has a physical diaeresis key and bug is fixed
 852         return "OK"
 853     } else  {
 854         return "Test failed, unless the keyboard tied to the system \
 855                 on which this test is run does NOT have a diaeresis \
 856                 physical key - in this case, test is actually void."
 857     }
 858 } -cleanup {
 859     deleteWindows
 860 } -result {OK}
 861
 862 test event-9 {no <Enter> event is generated for the container window when its
 863               managed window in which the mouse pointer was inside gets
 864               destroyed - bug 9e1312f32c} -setup {
 865     set res [list ]
 866     set iconified false
 867     if {[winfo ismapped .]} {
 868         wm iconify .
 869         update
 870         set iconified true
 871     }
 872 } -body {
 873     toplevel .top
 874     pack propagate .top 0
 875     bind .top <Enter> {lappend res %W}
 876     pack [frame .top.f -bg green -width 50 -height 50] -anchor se -side bottom
 877     tkwait visibility .top.f
 878     after 50
 879     update
 880     focus -force .top.f
 881     event generate .top.f <Motion> -warp 1 -x 25 -y 25  ; # <Enter> sent to .top and .top.f
 882     controlPointerWarpTiming
 883     update  ; # idletasks not enough
 884     destroy .top.f  ; # no <Enter> event sent
 885     update
 886     set res
 887 } -cleanup {
 888     deleteWindows
 889     if {$iconified} {
 890         wm deiconify .
 891         update
 892     }
 893 } -result {.top .top.f}
 894
 895 # cleanup
 896 update
 897 unset -nocomplain keypress_lookup
 898 rename _init_keypress_lookup {}
 899 rename _keypress_lookup {}
 900 rename _keypress {}
 901 rename _pause {}
 902 rename _text_ind_to_x_y {}
 903 rename _get_selection {}
 904
 905 cleanupTests
 906 return
 907
 908