1# This file is a Tcl script to test out Tk's "bind" and "bindtags" 2# commands plus the procedures in tkBind.c. It is organized in the 3# standard fashion for Tcl tests. 4# 5# Copyright (c) 1994 The Regents of the University of California. 6# Copyright (c) 1994-1995 Sun Microsystems, Inc. 7# Copyright (c) 1998-1999 by Scriptics Corporation. 8# All rights reserved. 9# 10# RCS: @(#) $Id: bind.test,v 1.11.2.1 2007/05/16 15:22:19 dgp Exp $ 11 12package require tcltest 2.1 13namespace import -force tcltest::configure 14namespace import -force tcltest::testsDirectory 15configure -testdir [file join [pwd] [file dirname [info script]]] 16configure -loadfile [file join [testsDirectory] constraints.tcl] 17tcltest::loadTestedCommands 18tk useinputmethods 0 19 20catch {destroy .b} 21toplevel .b -width 100 -height 50 22wm geom .b +0+0 23update idletasks 24 25proc setup {} { 26 catch {destroy .b.f} 27 frame .b.f -class Test -width 150 -height 100 28 pack .b.f 29 focus -force .b.f 30 foreach p [event info] {event delete $p} 31 update 32} 33setup 34 35foreach i [bind Test] { 36 bind Test $i {} 37} 38foreach i [bind all] { 39 bind all $i {} 40} 41 42test bind-1.1 {bind command} { 43 list [catch {bind} msg] $msg 44} {1 {wrong # args: should be "bind window ?pattern? ?command?"}} 45test bind-1.2 {bind command} { 46 list [catch {bind a b c d} msg] $msg 47} {1 {wrong # args: should be "bind window ?pattern? ?command?"}} 48test bind-1.3 {bind command} { 49 list [catch {bind .gorp} msg] $msg 50} {1 {bad window path name ".gorp"}} 51test bind-1.4 {bind command} { 52 list [catch {bind foo} msg] $msg 53} {0 {}} 54test bind-1.5 {bind command} { 55 list [catch {bind .b <gorp-> {}} msg] $msg 56} {0 {}} 57test bind-1.6 {bind command} { 58 catch {destroy .b.f} 59 frame .b.f 60 bind .b.f <Enter> {test script} 61 set result [bind .b.f <Enter>] 62 bind .b.f <Enter> {} 63 list $result [bind .b.f <Enter>] 64} {{test script} {}} 65test bind-1.7 {bind command} { 66 catch {destroy .b.f} 67 frame .b.f 68 bind .b.f <Enter> {test script} 69 bind .b.f <Enter> {+more text} 70 bind .b.f <Enter> 71} {test script 72more text} 73test bind-1.8 {bind command} { 74 list [catch {bind .b <gorp-> {test script}} msg] $msg [bind .b] 75} {1 {bad event type or keysym "gorp"} {}} 76test bind-1.9 {bind command} { 77 list [catch {bind .b <gorp->} msg] $msg 78} {0 {}} 79test bind-1.10 {bind command} { 80 catch {destroy .b.f} 81 frame .b.f 82 bind .b.f <Enter> {script 1} 83 bind .b.f <Leave> {script 2} 84 bind .b.f a {script for a} 85 bind .b.f b {script for b} 86 lsort [bind .b.f] 87} {<Enter> <Leave> a b} 88 89test bind-2.1 {bindtags command} { 90 list [catch {bindtags} msg] $msg 91} {1 {wrong # args: should be "bindtags window ?taglist?"}} 92test bind-2.2 {bindtags command} { 93 list [catch {bindtags a b c} msg] $msg 94} {1 {wrong # args: should be "bindtags window ?taglist?"}} 95test bind-2.3 {bindtags command} { 96 list [catch {bindtags .foo} msg] $msg 97} {1 {bad window path name ".foo"}} 98test bind-2.4 {bindtags command} { 99 bindtags .b 100} {.b Toplevel all} 101test bind-2.5 {bindtags command} { 102 catch {destroy .b.f} 103 frame .b.f 104 bindtags .b.f 105} {.b.f Frame .b all} 106test bind-2.6 {bindtags command} { 107 catch {destroy .b.f} 108 frame .b.f 109 bindtags .b.f {{x y z} b c d} 110 bindtags .b.f 111} {{x y z} b c d} 112test bind-2.7 {bindtags command} { 113 catch {destroy .b.f} 114 frame .b.f 115 bindtags .b.f {x y z} 116 bindtags .b.f {} 117 bindtags .b.f 118} {.b.f Frame .b all} 119test bind-2.8 {bindtags command} { 120 catch {destroy .b.f} 121 frame .b.f 122 bindtags .b.f {x y z} 123 bindtags .b.f {a b c d} 124 bindtags .b.f 125} {a b c d} 126test bind-2.9 {bindtags command} { 127 catch {destroy .b.f} 128 frame .b.f 129 bindtags .b.f {a b c} 130 list [catch {bindtags .b.f "\{"} msg] $msg [bindtags .b.f] 131} {1 {unmatched open brace in list} {.b.f Frame .b all}} 132test bind-2.10 {bindtags command} { 133 catch {destroy .b.f} 134 frame .b.f 135 bindtags .b.f {a b c} 136 list [catch {bindtags .b.f "a .gorp b"} msg] $msg [bindtags .b.f] 137} {0 {} {a .gorp b}} 138test bind-3.1 {TkFreeBindingTags procedure} { 139 catch {destroy .b.f} 140 frame .b.f 141 bindtags .b.f "a b c d" 142 destroy .b.f 143} {} 144test bind-3.2 {TkFreeBindingTags procedure} { 145 catch {destroy .b.f} 146 frame .b.f 147 catch {bindtags .b.f "a .gorp b .b.f"} 148 destroy .b.f 149} {} 150 151bind all <Enter> {lappend x "%W enter all"} 152bind Test <Enter> {lappend x "%W enter frame"} 153bind Toplevel <Enter> {lappend x "%W enter toplevel"} 154bind xyz <Enter> {lappend x "%W enter xyz"} 155bind {a b} <Enter> {lappend x "%W enter {a b}"} 156bind .b <Enter> {lappend x "%W enter .b"} 157test bind-4.1 {TkBindEventProc procedure} { 158 catch {destroy .b.f} 159 frame .b.f -class Test -width 150 -height 100 160 pack .b.f 161 update 162 bind .b.f <Enter> {lappend x "%W enter .b.f"} 163 set x {} 164 event gen .b.f <Enter> 165 set x 166} {{.b.f enter .b.f} {.b.f enter frame} {.b.f enter .b} {.b.f enter all}} 167test bind-4.2 {TkBindEventProc procedure} { 168 catch {destroy .b.f} 169 frame .b.f -class Test -width 150 -height 100 170 pack .b.f 171 update 172 bind .b.f <Enter> {lappend x "%W enter .b.f"} 173 bindtags .b.f {.b.f {a b} xyz} 174 set x {} 175 event gen .b.f <Enter> 176 set x 177} {{.b.f enter .b.f} {.b.f enter {a b}} {.b.f enter xyz}} 178test bind-4.3 {TkBindEventProc procedure} { 179 set x {} 180 event gen .b <Enter> 181 set x 182} {{.b enter .b} {.b enter toplevel} {.b enter all}} 183test bind-4.4 {TkBindEventProc procedure} { 184 catch {destroy .b.f} 185 frame .b.f -class Test -width 150 -height 100 186 pack .b.f 187 update 188 bindtags .b.f {.b.f .b.f2 .b.f3} 189 frame .b.f3 -width 50 -height 50 190 pack .b.f3 191 bind .b.f <Enter> {lappend x "%W enter .b.f"} 192 bind .b.f3 <Enter> {lappend x "%W enter .b.f3"} 193 set x {} 194 event gen .b.f <Enter> 195 destroy .b.f3 196 set x 197} {{.b.f enter .b.f} {.b.f enter .b.f3}} 198test bind-4.5 {TkBindEventProc procedure} { 199 # This tests memory allocation for objPtr; it won't serve any useful 200 # purpose unless run with some sort of allocation checker turned on. 201 catch {destroy .b.f} 202 frame .b.f -class Test -width 150 -height 100 203 pack .b.f 204 update 205 bindtags .b.f {a b c d e f g h i j k l m n o p q r s t u v w x y z} 206 event gen .b.f <Enter> 207} {} 208bind all <Enter> {} 209bind Test <Enter> {} 210bind Toplevel <Enter> {} 211bind xyz <Enter> {} 212bind {a b} <Enter> {} 213bind .b <Enter> {} 214 215test bind-5.1 {Tk_CreateBindingTable procedure} { 216 catch {destroy .b.c} 217 canvas .b.c 218 .b.c bind foo 219} {} 220 221testConstraint testcbind [llength [info commands testcbind]] 222 223test bind-6.1 {Tk_DeleteBindTable procedure} { 224 catch {destroy .b.c} 225 canvas .b.c 226 .b.c bind foo <1> {string 1} 227 .b.c create rectangle 0 0 100 100 228 .b.c bind 1 <2> {string 2} 229 destroy .b.c 230} {} 231test bind-6.2 {Tk_DeleteBindTable procedure: pending bindings deleted later} testcbind { 232 catch {interp delete foo} 233 interp create foo 234 foo eval { 235 load {} Tk 236 tk useinputmethods 0 237 load {} Tktest 238 wm geometry . +0+0 239 frame .t -width 50 -height 50 240 bindtags .t {a b c d} 241 pack .t 242 update 243 set x {} 244 testcbind a <1> "lappend x a1; destroy ." "lappend x bye.a1" 245 bind b <1> "lappend x b1" 246 testcbind c <1> "lappend x c1" "lappend x bye.c1" 247 testcbind c <2> "lappend x all2" "lappend x bye.all2" 248 event gen .t <1> 249 } 250 set x [foo eval set x] 251 interp delete foo 252 set x 253} {a1 bye.all2 bye.a1 b1 bye.c1} 254 255test bind-7.1 {Tk_CreateBinding procedure: bad binding} { 256 catch {destroy .b.c} 257 canvas .b.c 258 list [catch {.b.c bind foo <} msg] $msg 259} {1 {no event type or button # or keysym}} 260test bind-7.2 {Tk_CreateBinding procedure: replace existing C binding} testcbind { 261 catch {destroy .b.f} 262 frame .b.f 263 testcbind .b.f <1> "xyz" "lappend x bye.1" 264 set x {} 265 bind .b.f <1> "abc" 266 destroy .b.f 267 set x 268} {bye.1} 269test bind-7.3 {Tk_CreateBinding procedure: append} { 270 catch {destroy .b.c} 271 canvas .b.c 272 .b.c bind foo <1> "button 1" 273 .b.c bind foo <1> "+more button 1" 274 .b.c bind foo <1> 275} {button 1 276more button 1} 277test bind-7.4 {Tk_CreateBinding procedure: append to non-existing} { 278 catch {destroy .b.c} 279 canvas .b.c 280 .b.c bind foo <1> "+button 1" 281 .b.c bind foo <1> 282} {button 1} 283 284test bind-8.1 {TkCreateBindingProcedure: error} testcbind { 285 list [catch {testcbind . <xyz> "xyz"} msg] $msg 286} {1 {bad event type or keysym "xyz"}} 287test bind-8.2 {TkCreateBindingProcedure: new binding} testcbind { 288 catch {destroy .b.f} 289 frame .b.f 290 testcbind .b.f <1> "lappend x 1" "lappend x bye.1" 291 set x {} 292 event gen .b.f <1> 293 destroy .b.f 294 set x 295} {bye.1} 296test bind-8.3 {TkCreateBindingProcedure: replace existing} testcbind { 297 catch {destroy .b.f} 298 frame .b.f 299 pack .b.f 300 set x {} 301 testcbind .b.f <1> "lappend x old1" "lappend x bye.old1" 302 testcbind .b.f <1> "lappend x new1" "lappend x bye.new1" 303 set x 304} {bye.old1} 305test bind-8.4 {TkCreateBindingProcedure: replace existing while pending} testcbind { 306 catch {destroy .b.f} 307 frame .b.f 308 pack .b.f 309 update 310 testcbind .b.f <1> "lappend x .b.f; testcbind Frame <1> {lappend x Frame}" 311 testcbind Frame <1> "lappend x never" 312 set x {} 313 event gen .b.f <1> 314 bind .b.f <1> {} 315 set x 316} {.b.f Frame} 317 318test bind-9.1 {Tk_DeleteBinding procedure} { 319 catch {destroy .b.f} 320 frame .b.f -class Test -width 150 -height 100 321 list [catch {bind .b.f <} msg] $msg 322} {0 {}} 323test bind-9.2 {Tk_DeleteBinding procedure} { 324 catch {destroy .b.f} 325 frame .b.f -class Test -width 150 -height 100 326 foreach i {a b c d} { 327 bind .b.f $i "binding for $i" 328 } 329 set result {} 330 foreach i {b d a c} { 331 bind .b.f $i {} 332 lappend result [lsort [bind .b.f]] 333 } 334 set result 335} {{a c d} {a c} c {}} 336test bind-9.3 {Tk_DeleteBinding procedure} { 337 catch {destroy .b.f} 338 frame .b.f -class Test -width 150 -height 100 339 foreach i {<1> <Meta-1> <Control-1> <Double-Alt-1>} { 340 bind .b.f $i "binding for $i" 341 } 342 set result {} 343 foreach i {<Control-1> <Double-Alt-1> <1> <Meta-1>} { 344 bind .b.f $i {} 345 lappend result [lsort [bind .b.f]] 346 } 347 set result 348} {{<Button-1> <Double-Alt-Button-1> <Meta-Button-1>} {<Button-1> <Meta-Button-1>} <Meta-Button-1> {}} 349test bind-9.4 {Tk_DeleteBinding procedure: pending bindings delete later} testcbind { 350 catch {destroy .b.f} 351 frame .b.f 352 pack .b.f 353 update 354 bindtags .b.f {a b c} 355 testcbind a <1> {lappend x a1; bind c <1> {}; bind c <2> {}} {lappend x bye.a1} 356 bind b <1> {lappend x b1} 357 testcbind c <1> {lappend x c1} {lappend x bye.c1} 358 testcbind c <2> {lappend x c2} {lappend x bye.c2} 359 set x {} 360 event gen .b.f <1> 361 bind a <1> {} 362 bind b <1> {} 363 set x 364} {a1 bye.c2 b1 bye.c1 bye.a1} 365 366test bind-10.1 {Tk_GetBinding procedure} { 367 catch {destroy .b.c} 368 canvas .b.c 369 list [catch {.b.c bind foo <} msg] $msg 370} {1 {no event type or button # or keysym}} 371test bind-10.2 {Tk_GetBinding procedure} { 372 catch {destroy .b.c} 373 canvas .b.c 374 .b.c bind foo a Test 375 .b.c bind foo a 376} {Test} 377test bind-10.3 {Tk_GetBinding procedure: C binding} testcbind { 378 catch {destroy .b.f} 379 frame .b.f 380 testcbind .b.f <1> "foo" 381 list [bind .b.f] [bind .b.f <1>] 382} {<Button-1> {}} 383 384test bind-11.1 {Tk_GetAllBindings procedure} { 385 catch {destroy .b.f} 386 frame .b.f -class Test -width 150 -height 100 387 foreach i "! a \\\{ ~ <Delete> <space> <<Paste>> <Tab> <Linefeed> <less> <Meta-a> <Acircumflex>" { 388 bind .b.f $i Test 389 } 390 lsort [bind .b.f] 391} {! <<Paste>> <Key-Acircumflex> <Key-Delete> <Key-Linefeed> <Key-Tab> <Key-less> <Key-space> <Meta-Key-a> a \{ ~} 392test bind-11.2 {Tk_GetAllBindings procedure} { 393 catch {destroy .b.f} 394 frame .b.f -class Test -width 150 -height 100 395 foreach i "<Double-1> <Triple-1> <Meta-Control-a> <Double-Alt-Enter> <1>" { 396 bind .b.f $i Test 397 } 398 lsort [bind .b.f] 399} {<Button-1> <Control-Meta-Key-a> <Double-Alt-Enter> <Double-Button-1> <Triple-Button-1>} 400test bind-11.3 {Tk_GetAllBindings procedure} { 401 catch {destroy .b.f} 402 frame .b.f -class Test -width 150 -height 100 403 foreach i "<Double-Triple-1> abcd a<Leave>b" { 404 bind .b.f $i Test 405 } 406 lsort [bind .b.f] 407} {<Triple-Button-1> a<Leave>b abcd} 408 409 410test bind-12.1 {Tk_DeleteAllBindings procedure} { 411 catch {destroy .b.f} 412 frame .b.f -class Test -width 150 -height 100 413 destroy .b.f 414} {} 415test bind-12.2 {Tk_DeleteAllBindings procedure} { 416 catch {destroy .b.f} 417 frame .b.f -class Test -width 150 -height 100 418 foreach i "a b c <Meta-1> <Alt-a> <Control-a>" { 419 bind .b.f $i x 420 } 421 destroy .b.f 422} {} 423test bind-12.3 {Tk_DeleteAllBindings procedure: pending bindings deleted later} testcbind { 424 catch {destroy .b.f} 425 frame .b.f 426 pack .b.f 427 update 428 testcbind .b.f <1> {lappend x before; event gen .b.f <2>; lappend x after} {lappend x bye.f1} 429 testcbind .b.f <2> {destroy .b.f} {lappend x bye.f2} 430 bind .b.f <Destroy> {lappend x fDestroy} 431 testcbind .b.f <3> {foo} {lappend x bye.f3} 432 set x {} 433 event gen .b.f <1> 434 set x 435} {before fDestroy bye.f3 bye.f2 after bye.f1} 436 437bind Test <KeyPress> {lappend x "%W %K Test press any"} 438bind all <KeyPress> {lappend x "%W %K all press any"} 439bind Test a {lappend x "%W %K Test press a"} 440bind all x {lappend x "%W %K all press x"} 441 442test bind-13.1 {Tk_BindEvent procedure} { 443 setup 444 bind .b.f a {lappend x "%W %K .b.f press a"} 445 set x {} 446 event gen .b.f <Key-a> 447 event gen .b.f <Key-b> 448 event gen .b.f <Key-x> 449 set x 450} {{.b.f a .b.f press a} {.b.f a Test press a} {.b.f a all press any} {.b.f b Test press any} {.b.f b all press any} {.b.f x Test press any} {.b.f x all press x}} 451 452bind Test <KeyPress> {lappend x "%W %K Test press any"; break} 453bind all <KeyPress> {continue; lappend x "%W %K all press any"} 454 455test bind-13.2 {Tk_BindEvent procedure} { 456 setup 457 bind .b.f b {lappend x "%W %K .b.f press a"} 458 set x {} 459 event gen .b.f <Key-b> 460 set x 461} {{.b.f b .b.f press a} {.b.f b Test press any}} 462if {[info procs bgerror] == "bgerror"} { 463 rename bgerror {} 464} 465proc bgerror args {} 466bind Test <KeyPress> {lappend x "%W %K Test press any"; error Test} 467test bind-13.3 {Tk_BindEvent procedure} { 468 setup 469 bind .b.f b {lappend x "%W %K .b.f press a"} 470 set x {} 471 event gen .b.f <Key-b> 472 update 473 list $x $errorInfo 474} {{{.b.f b .b.f press a} {.b.f b Test press any}} {Test 475 while executing 476"error Test" 477 (command bound to event)}} 478rename bgerror {} 479test bind-13.4 {Tk_BindEvent procedure} { 480 proc foo {} { 481 set x 44 482 event gen .b.f <Key-a> 483 } 484 setup 485 bind .b.f a {lappend x "%W %K .b.f press a"} 486 set x {} 487 foo 488 set x 489} {{.b.f a .b.f press a} {.b.f a Test press a}} 490test bind-13.5 {Tk_BindEvent procedure} { 491 bind all <Destroy> {lappend x "%W destroyed"} 492 set x {} 493 list [catch {frame .b.g -gorp foo} msg] $msg $x 494} {1 {unknown option "-gorp"} {{.b.g destroyed}}} 495foreach i [bind all] { 496 bind all $i {} 497} 498foreach i [bind Test] { 499 bind Test $i {} 500} 501test bind-13.6 {Tk_BindEvent procedure} { 502 setup 503 bind .b.f z {lappend x "%W z (.b.f binding)"} 504 bind Test z {lappend x "%W z (.b.f binding)"} 505 bind all z {bind .b.f z {}; lappend x "%W z (.b.f binding)"} 506 set x {} 507 event gen .b.f <Key-z> 508 bind Test z {} 509 bind all z {} 510 set x 511} {{.b.f z (.b.f binding)} {.b.f z (.b.f binding)} {.b.f z (.b.f binding)}} 512test bind-13.7 {Tk_BindEvent procedure} { 513 setup 514 bind .b.f z {lappend x "%W z (.b.f binding)"} 515 bind Test z {lappend x "%W z (.b.f binding)"} 516 bind all z {destroy .b.f; lappend x "%W z (.b.f binding)"} 517 set x {} 518 event gen .b.f <Key-z> 519 bind Test z {} 520 bind all z {} 521 set x 522} {{.b.f z (.b.f binding)} {.b.f z (.b.f binding)} {.b.f z (.b.f binding)}} 523test bind-13.8 {Tk_BindEvent procedure} { 524 setup 525 bind .b.f <1> {lappend x "%W z (.b.f <1> binding)"} 526 bind .b.f <ButtonPress> {lappend x "%W z (.b.f <ButtonPress> binding)"} 527 set x {} 528 event gen .b.f <Button-1> 529 event gen .b.f <Button-2> 530 set x 531} {{.b.f z (.b.f <1> binding)} {.b.f z (.b.f <ButtonPress> binding)}} 532test bind-13.9 {Tk_BindEvent procedure: ignore NotifyInferior} { 533 setup 534 bind .b.f <Enter> "lappend x Enter%#" 535 bind .b.f <Leave> "lappend x Leave%#" 536 set x {} 537 event gen .b.f <Enter> -serial 100 -detail NotifyAncestor 538 event gen .b.f <Enter> -serial 101 -detail NotifyInferior 539 event gen .b.f <Leave> -serial 102 -detail NotifyAncestor 540 event gen .b.f <Leave> -serial 103 -detail NotifyInferior 541 set x 542} {Enter100 Leave102} 543test bind-13.10 {Tk_BindEvent procedure: collapse Motions} { 544 setup 545 bind .b.f <Motion> "lappend x Motion%#(%x,%y)" 546 set x {} 547 event gen .b.f <Motion> -serial 100 -x 100 -y 200 -when tail 548 update 549 event gen .b.f <Motion> -serial 101 -x 200 -y 300 -when tail 550 event gen .b.f <Motion> -serial 102 -x 300 -y 400 -when tail 551 update 552 set x 553} {Motion100(100,200) Motion102(300,400)} 554test bind-13.11 {Tk_BindEvent procedure: collapse repeating modifiers} { 555 setup 556 bind .b.f <Key> "lappend x %K%#" 557 bind .b.f <KeyRelease> "lappend x %K%#" 558 event gen .b.f <Key-Shift_L> -serial 100 -when tail 559 event gen .b.f <KeyRelease-Shift_L> -serial 101 -when tail 560 event gen .b.f <Key-Shift_L> -serial 102 -when tail 561 event gen .b.f <KeyRelease-Shift_L> -serial 103 -when tail 562 update 563} {} 564test bind-13.12 {Tk_BindEvent procedure: valid key detail} { 565 setup 566 bind .b.f <Key> "lappend x Key%K" 567 bind .b.f <KeyRelease> "lappend x Release%K" 568 set x {} 569 event gen .b.f <Key> -keysym a 570 event gen .b.f <KeyRelease> -keysym a 571 set x 572} {Keya Releasea} 573test bind-13.13 {Tk_BindEvent procedure: invalid key detail} { 574 setup 575 bind .b.f <Key> "lappend x Key%K" 576 bind .b.f <KeyRelease> "lappend x Release%K" 577 set x {} 578 event gen .b.f <Key> -keycode 0 579 event gen .b.f <KeyRelease> -keycode 0 580 set x 581} {Key?? Release??} 582test bind-13.14 {Tk_BindEvent procedure: button detail} { 583 setup 584 bind .b.f <Button> "lappend x Button%b" 585 bind .b.f <ButtonRelease> "lappend x Release%b" 586 set x {} 587 event gen .b.f <Button> -button 1 588 event gen .b.f <ButtonRelease> -button 3 589 set x 590} {Button1 Release3} 591test bind-13.15 {Tk_BindEvent procedure: virtual detail} { 592 setup 593 bind .b.f <<Paste>> "lappend x Paste" 594 set x {} 595 event gen .b.f <<Paste>> 596 set x 597} {Paste} 598test bind-13.16 {Tk_BindEvent procedure: virtual event in event stream} { 599 setup 600 bind .b.f <<Paste>> "lappend x Paste" 601 set x {} 602 event gen .b.f <<Paste>> 603 set x 604} {Paste} 605test bind-13.17 {Tk_BindEvent procedure: match detail physical} { 606 setup 607 bind .b.f <Button-2> {set x Button-2} 608 event add <<Paste>> <Button-2> 609 bind .b.f <<Paste>> {set x Paste} 610 set x {} 611 event gen .b.f <Button-2> 612 set x 613} {Button-2} 614test bind-13.18 {Tk_BindEvent procedure: no match detail physical} { 615 setup 616 event add <<Paste>> <Button-2> 617 bind .b.f <<Paste>> {set x Paste} 618 set x {} 619 event gen .b.f <Button-2> 620 set x 621} {Paste} 622test bind-13.19 {Tk_BindEvent procedure: match detail virtual} { 623 setup 624 event add <<Paste>> <Button-2> 625 bind .b.f <<Paste>> "lappend x Paste" 626 set x {} 627 event gen .b.f <Button-2> 628 set x 629} {Paste} 630test bind-13.20 {Tk_BindEvent procedure: no match detail virtual} { 631 setup 632 event add <<Paste>> <Button-2> 633 bind .b.f <<Paste>> "lappend x Paste" 634 set x {} 635 event gen .b.f <Button> 636 set x 637} {} 638test bind-13.21 {Tk_BindEvent procedure: match no-detail physical} { 639 setup 640 bind .b.f <Button> {set x Button} 641 event add <<Paste>> <Button> 642 bind .b.f <<Paste>> {set x Paste} 643 set x {} 644 event gen .b.f <Button-2> 645 set x 646} {Button} 647test bind-13.22 {Tk_BindEvent procedure: no match no-detail physical} { 648 setup 649 event add <<Paste>> <Button> 650 bind .b.f <<Paste>> {set x Paste} 651 set x {} 652 event gen .b.f <Button-2> 653 set x 654} {Paste} 655test bind-13.23 {Tk_BindEvent procedure: match no-detail virtual} { 656 setup 657 event add <<Paste>> <Button> 658 bind .b.f <<Paste>> "lappend x Paste" 659 set x {} 660 event gen .b.f <Button-2> 661 set x 662} {Paste} 663test bind-13.24 {Tk_BindEvent procedure: no match no-detail virtual} { 664 setup 665 event add <<Paste>> <Key> 666 bind .b.f <<Paste>> "lappend x Paste" 667 set x {} 668 event gen .b.f <Button> 669 set x 670} {} 671test bind-13.25 {Tk_BindEvent procedure: precedence} { 672 setup 673 event add <<Paste>> <Button-2> 674 event add <<Copy>> <Button> 675 bind .b.f <Button-2> "lappend x Button-2" 676 bind .b.f <<Paste>> "lappend x Paste" 677 bind .b.f <Button> "lappend x Button" 678 bind .b.f <<Copy>> "lappend x Copy" 679 680 set x {} 681 event gen .b.f <Button-2> 682 bind .b.f <Button-2> {} 683 event gen .b.f <Button-2> 684 bind .b.f <<Paste>> {} 685 event gen .b.f <Button-2> 686 bind .b.f <Button> {} 687 event gen .b.f <Button-2> 688 bind .b.f <<Copy>> {} 689 event gen .b.f <Button-2> 690 set x 691} {Button-2 Paste Button Copy} 692test bind-13.26 {Tk_BindEvent procedure: no detail virtual pattern list} { 693 setup 694 bind .b.f <Button-2> {set x Button-2} 695 set x {} 696 event gen .b.f <Button-2> 697 set x 698} {Button-2} 699test bind-13.27 {Tk_BindEvent procedure: detail virtual pattern list} { 700 setup 701 event add <<Paste>> <Button-2> 702 bind .b.f <<Paste>> {set x Paste} 703 set x {} 704 event gen .b.f <Button-2> 705 set x 706} {Paste} 707test bind-13.28 {Tk_BindEvent procedure: no no-detail virtual pattern list} { 708 setup 709 bind .b.f <Button> {set x Button} 710 set x {} 711 event gen .b.f <Button-2> 712 set x 713} {Button} 714test bind-13.29 {Tk_BindEvent procedure: no-detail virtual pattern list} { 715 setup 716 event add <<Paste>> <Button> 717 bind .b.f <<Paste>> {set x Paste} 718 set x {} 719 event gen .b.f <Button-2> 720 set x 721} {Paste} 722test bind-13.30 {Tk_BindEvent procedure: no match} { 723 setup 724 event gen .b.f <Button-2> 725} {} 726test bind-13.31 {Tk_BindEvent procedure: match} { 727 setup 728 bind .b.f <Button-2> {set x Button-2} 729 set x {} 730 event gen .b.f <Button-2> 731 set x 732} {Button-2} 733test bind-13.32 {Tk_BindEvent procedure: many C bindings cause realloc} testcbind { 734 setup 735 bindtags .b.f {a b c d e f g h i j k l m n o p} 736 foreach p [bindtags .b.f] { 737 testcbind $p <1> "lappend x $p" 738 } 739 set x {} 740 event gen .b.f <1> 741 foreach p [bindtags .b.f] { 742 bind $p <1> {} 743 } 744 set x 745} {a b c d e f g h i j k l m n o p} 746test bind-13.33 {Tk_BindEvent procedure: multiple tags} { 747 setup 748 bind .b.f <Button-2> {lappend x .b.f} 749 bind Test <Button-2> {lappend x Button} 750 set x {} 751 event gen .b.f <Button-2> 752 bind Test <Button-2> {} 753 set x 754} {.b.f Button} 755test bind-13.34 {Tk_BindEvent procedure: execute C binding} testcbind { 756 setup 757 testcbind .b.f <1> {lappend x 1} 758 set x {} 759 event gen .b.f <1> 760 set x 761} {1} 762test bind-13.35 {Tk_BindEvent procedure: pending list marked deleted} testcbind { 763 setup 764 testcbind Test <1> {lappend x Test} {lappend x Deleted} 765 bind .b.f <1> {lappend x .b.f; destroy .b.f} 766 set x {} 767 event gen .b.f <1> 768 set y [list $x [bind Test]] 769 bind Test <1> {} 770 set y 771} {.b.f <Button-1>} 772test bind-13.36 {Tk_BindEvent procedure: C binding marked deleted} testcbind { 773 setup 774 testcbind Test <1> {lappend x Test} {lappend x Deleted} 775 bind .b.f <1> {lappend x .b.f; bind Test <1> {}; lappend x after} 776 set x {} 777 event gen .b.f <1> 778 set x 779} {.b.f after Deleted} 780test bind-13.37 {Tk_BindEvent procedure: C binding gets to run} testcbind { 781 setup 782 testcbind Test <1> {lappend x Test} 783 bind .b.f <1> {lappend x .b.f} 784 set x {} 785 event gen .b.f <1> 786 bind Test <1> {} 787 set x 788} {.b.f Test} 789test bind-13.38 {Tk_BindEvent procedure: C binding deleted, refcount == 0} testcbind { 790 setup 791 testcbind .b.f <1> {lappend x hi; bind .b.f <1> {}} {lappend x bye} 792 set x {} 793 event gen .b.f <1> 794 set x 795} {hi bye} 796test bind-13.39 {Tk_BindEvent procedure: C binding deleted, refcount != 0} testcbind { 797 setup 798 testcbind .b.f <1> { 799 lappend x before$n 800 if {$n==0} { 801 bind .b.f <1> {} 802 } else { 803 set n [expr $n-1] 804 event gen .b.f <1> 805 } 806 lappend x after$n 807 } {lappend x Deleted} 808 set n 3 809 set x {} 810 event gen .b.f <1> 811 set x 812} {before3 before2 before1 before0 after0 after0 after0 after0 Deleted} 813test bind-13.40 {Tk_BindEvent procedure: continue in script} { 814 setup 815 bind .b.f <Button-2> {lappend x b1; continue; lappend x b2} 816 bind Test <Button-2> {lappend x B1; continue; lappend x B2} 817 set x {} 818 event gen .b.f <Button-2> 819 bind Test <Button-2> {} 820 set x 821} {b1 B1} 822test bind-13.41 {Tk_BindEvent procedure: continue in script} testcbind { 823 setup 824 testcbind .b.f <Button-2> {lappend x b1; continue; lappend x b2} 825 testcbind Test <Button-2> {lappend x B1; continue; lappend x B2} 826 set x {} 827 event gen .b.f <Button-2> 828 bind Test <Button-2> {} 829 set x 830} {b1 B1} 831test bind-13.42 {Tk_BindEvent procedure: break in script} { 832 setup 833 bind .b.f <Button-2> {lappend x b1; break; lappend x b2} 834 bind Test <Button-2> {lappend x B1; break; lappend x B2} 835 set x {} 836 event gen .b.f <Button-2> 837 bind Test <Button-2> {} 838 set x 839} {b1} 840test bind-13.43 {Tk_BindEvent procedure: break in script} testcbind { 841 setup 842 testcbind .b.f <Button-2> {lappend x b1; break; lappend x b2} 843 testcbind Test <Button-2> {lappend x B1; break; lappend x B2} 844 set x {} 845 event gen .b.f <Button-2> 846 bind Test <Button-2> {} 847 set x 848} {b1} 849 850proc bgerror msg { 851 global x 852 lappend x $msg 853} 854test bind-13.44 {Tk_BindEvent procedure: error in script} { 855 setup 856 bind .b.f <Button-2> {lappend x b1; blap} 857 bind Test <Button-2> {lappend x B1} 858 set x {} 859 event gen .b.f <Button-2> 860 update 861 bind Test <Button-2> {} 862 set x 863} {b1 {invalid command name "blap"}} 864test bind-13.45 {Tk_BindEvent procedure: error in script} testcbind { 865 setup 866 testcbind .b.f <Button-2> {lappend x b1; blap} 867 testcbind Test <Button-2> {lappend x B1} 868 set x {} 869 event gen .b.f <Button-2> 870 update 871 bind Test <Button-2> {} 872 set x 873} {b1 {invalid command name "blap"}} 874 875test bind-14.1 {TkBindDeadWindow: no C bindings pending} testcbind { 876 setup 877 bind .b.f <1> x 878 testcbind .b.f <2> y 879 destroy .b.f 880} {} 881test bind-14.2 {TkBindDeadWindow: is called after <Destroy>} testcbind { 882 setup 883 testcbind .b.f <Destroy> "lappend x .b.f" 884 testcbind Test <Destroy> "lappend x Test" 885 set x {} 886 destroy .b.f 887 bind Test <Destroy> {} 888 set x 889} {.b.f Test} 890test bind-14.3 {TkBindDeadWindow: pending C bindings} testcbind { 891 setup 892 bindtags .b.f {a b c d} 893 testcbind a <1> "lappend x a1" "lappend x bye.a1" 894 testcbind b <1> "destroy .b.f; lappend x b1" "lappend x bye.b1" 895 testcbind c <1> "lappend x c1" "lappend x bye.c1" 896 testcbind d <1> "lappend x d1" "lappend x bye.d1" 897 bind a <2> "event gen .b.f <1>" 898 testcbind b <2> "lappend x b2" "lappend x bye.b2" 899 testcbind c <2> "lappend x c2" "lappend x bye.d2" 900 bind d <2> "lappend x d2" 901 testcbind a <3> "event gen .b.f <2>" 902 set x {} 903 event gen .b.f <3> 904 set y $x 905 foreach tag {a b c d} { 906 foreach event {<1> <2> <3>} { 907 bind $tag $event {} 908 } 909 } 910 set y 911} {a1 b1 d2} 912 913test bind-15.1 {MatchPatterns procedure, ignoring type mismatches} { 914 setup 915 bind .b.f ab {set x 1} 916 set x 0 917 event gen .b.f <Key-a> 918 event gen .b.f <KeyRelease-a> 919 event gen .b.f <Key-b> 920 event gen .b.f <KeyRelease-b> 921 set x 922} 1 923test bind-15.2 {MatchPatterns procedure, ignoring type mismatches} { 924 setup 925 bind .b.f ab {set x 1} 926 set x 0 927 event gen .b.f <Key-a> 928 event gen .b.f <Enter> 929 event gen .b.f <KeyRelease-a> 930 event gen .b.f <Leave> 931 event gen .b.f <Key-b> 932 event gen .b.f <KeyRelease-b> 933 set x 934} 1 935test bind-15.3 {MatchPatterns procedure, ignoring type mismatches} { 936 setup 937 bind .b.f ab {set x 1} 938 set x 0 939 event gen .b.f <Key-a> 940 event gen .b.f <Button-1> 941 event gen .b.f <Key-b> 942 set x 943} 0 944test bind-15.4 {MatchPatterns procedure, ignoring type mismatches} { 945 setup 946 bind .b.f <Double-1> {set x 1} 947 set x 0 948 event gen .b.f <Button-1> 949 event gen .b.f <ButtonRelease-1> 950 event gen .b.f <Button-1> 951 event gen .b.f <ButtonRelease-1> 952 set x 953} 1 954test bind-15.5 {MatchPatterns procedure, ignoring type mismatches} { 955 setup 956 bind .b.f <Double-ButtonRelease> {set x 1} 957 set x 0 958 event gen .b.f <Button-1> 959 event gen .b.f <ButtonRelease-1> 960 event gen .b.f <Button-2> 961 event gen .b.f <ButtonRelease-2> 962 set x 963} 1 964test bind-15.6 {MatchPatterns procedure, ignoring type mismatches} { 965 setup 966 bind .b.f <Double-1> {set x 1} 967 set x 0 968 event gen .b.f <Button-1> 969 event gen .b.f <Key-a> 970 event gen .b.f <ButtonRelease-1> 971 event gen .b.f <Button-1> 972 event gen .b.f <ButtonRelease-1> 973 set x 974} 0 975test bind-15.7 {MatchPatterns procedure, ignoring type mismatches} { 976 setup 977 bind .b.f <Double-1> {set x 1} 978 set x 0 979 event gen .b.f <Button-1> 980 event gen .b.f <Key-Shift_L> 981 event gen .b.f <ButtonRelease-1> 982 event gen .b.f <Button-1> 983 event gen .b.f <ButtonRelease-1> 984 set x 985} 1 986test bind-15.8 {MatchPatterns procedure, ignoring type mismatches} { 987 setup 988 bind .b.f ab {set x 1} 989 set x 0 990 event gen .b.f <Key-a> 991 event gen .b.f <Key-c> 992 event gen .b.f <Key-b> 993 set x 994} 0 995test bind-15.9 {MatchPatterns procedure, modifier checks} { 996 setup 997 bind .b.f <M1-M2-Key> {set x 1} 998 set x 0 999 event gen .b.f <Key-a> -state 0x18 1000 set x 1001} 1 1002test bind-15.10 {MatchPatterns procedure, modifier checks} { 1003 setup 1004 bind .b.f <M1-M2-Key> {set x 1} 1005 set x 0 1006 event gen .b.f <Key-a> -state 0xfc 1007 set x 1008} 1 1009test bind-15.11 {MatchPatterns procedure, modifier checks} { 1010 setup 1011 bind .b.f <M1-M2-Key> {set x 1} 1012 set x 0 1013 event gen .b.f <Key-a> -state 0x8 1014 set x 1015} 0 1016test bind-15.12 {MatchPatterns procedure, ignore modifier presses and releases} {nonPortable} { 1017 # This test is non-portable because the Shift_L keysym may behave 1018 # differently on some platforms. 1019 setup 1020 bind .b.f aB {set x 1} 1021 set x 0 1022 event gen .b.f <Key-a> 1023 event gen .b.f <Key-Shift_L> 1024 event gen .b.f <Key-b> -state 1 1025 set x 1026} 1 1027test bind-15.13 {MatchPatterns procedure, checking detail} { 1028 setup 1029 bind .b.f ab {set x 1} 1030 set x 0 1031 event gen .b.f <Key-a> 1032 event gen .b.f <Key-c> 1033 set x 1034} 0 1035test bind-15.14 {MatchPatterns procedure, checking "nearby"} { 1036 setup 1037 bind .b.f <Double-1> {set x 1} 1038 set x 0 1039 event gen .b.f <Button-2> 1040 event gen .b.f <ButtonRelease-2> 1041 event gen .b.f <Button-1> -x 30 -y 40 1042 event gen .b.f <Button-1> -x 31 -y 39 1043 event gen .b.f <ButtonRelease-1> 1044 set x 1045} 1 1046test bind-15.15 {MatchPatterns procedure, checking "nearby"} { 1047 setup 1048 bind .b.f <Double-1> {set x 1} 1049 set x 0 1050 event gen .b.f <Button-2> 1051 event gen .b.f <ButtonRelease-2> 1052 event gen .b.f <Button-1> -x 30 -y 40 1053 event gen .b.f <Button-1> -x 29 -y 41 1054 event gen .b.f <ButtonRelease-1> 1055 set x 1056} 1 1057test bind-15.16 {MatchPatterns procedure, checking "nearby"} { 1058 setup 1059 bind .b.f <Double-1> {set x 1} 1060 set x 0 1061 event gen .b.f <Button-2> 1062 event gen .b.f <ButtonRelease-2> 1063 event gen .b.f <Button-1> -x 30 -y 40 1064 event gen .b.f <Button-1> -x 40 -y 40 1065 event gen .b.f <ButtonRelease-2> 1066 set x 1067} 0 1068test bind-15.17 {MatchPatterns procedure, checking "nearby"} { 1069 setup 1070 bind .b.f <Double-1> {set x 1} 1071 set x 0 1072 event gen .b.f <Button-2> 1073 event gen .b.f <ButtonRelease-2> 1074 event gen .b.f <Button-1> -x 30 -y 40 1075 event gen .b.f <Button-1> -x 20 -y 40 1076 event gen .b.f <ButtonRelease-1> 1077 set x 1078} 0 1079test bind-15.18 {MatchPatterns procedure, checking "nearby"} { 1080 setup 1081 bind .b.f <Double-1> {set x 1} 1082 set x 0 1083 event gen .b.f <Button-2> 1084 event gen .b.f <ButtonRelease-2> 1085 event gen .b.f <Button-1> -x 30 -y 40 1086 event gen .b.f <Button-1> -x 30 -y 30 1087 event gen .b.f <ButtonRelease-1> 1088 set x 1089} 0 1090test bind-15.19 {MatchPatterns procedure, checking "nearby"} { 1091 setup 1092 bind .b.f <Double-1> {set x 1} 1093 set x 0 1094 event gen .b.f <Button-2> 1095 event gen .b.f <ButtonRelease-2> 1096 event gen .b.f <Button-1> -x 30 -y 40 1097 event gen .b.f <Button-1> -x 30 -y 50 1098 event gen .b.f <ButtonRelease-1> 1099 set x 1100} 0 1101test bind-15.20 {MatchPatterns procedure, checking "nearby"} { 1102 setup 1103 bind .b.f <Double-1> {set x 1} 1104 set x 0 1105 event gen .b.f <Button-2> 1106 event gen .b.f <ButtonRelease-2> 1107 event gen .b.f <Button-1> -time 300 1108 event gen .b.f <Button-1> -time 700 1109 event gen .b.f <ButtonRelease-1> 1110 set x 1111} 1 1112test bind-15.21 {MatchPatterns procedure, checking "nearby"} { 1113 setup 1114 bind .b.f <Double-1> {set x 1} 1115 set x 0 1116 event gen .b.f <Button-2> 1117 event gen .b.f <ButtonRelease-2> 1118 event gen .b.f <Button-1> -time 300 1119 event gen .b.f <Button-1> -time 900 1120 event gen .b.f <ButtonRelease-1> 1121 set x 1122} 0 1123test bind-15.22 {MatchPatterns procedure, time wrap-around} { 1124 setup 1125 bind .b.f <Double-1> {set x 1} 1126 set x 0 1127 event gen .b.f <Button-1> -time [expr -100] 1128 event gen .b.f <Button-1> -time 200 1129 event gen .b.f <ButtonRelease-1> 1130 set x 1131} 1 1132test bind-15.23 {MatchPatterns procedure, time wrap-around} { 1133 setup 1134 bind .b.f <Double-1> {set x 1} 1135 set x 0 1136 event gen .b.f <Button-1> -time -100 1137 event gen .b.f <Button-1> -time 500 1138 event gen .b.f <ButtonRelease-1> 1139 set x 1140} 0 1141test bind-15.24 {MatchPatterns procedure, virtual event} { 1142 setup 1143 event add <<Paste>> <Button-1> 1144 bind .b.f <<Paste>> {lappend x paste} 1145 set x {} 1146 event gen .b.f <Button-1> 1147 event gen .b.f <ButtonRelease-1> 1148 set x 1149} {paste} 1150test bind-15.25 {MatchPatterns procedure, reject a virtual event} { 1151 setup 1152 event add <<Paste>> <Shift-Button-1> 1153 bind .b.f <<Paste>> {lappend x paste} 1154 set x {} 1155 event gen .b.f <Button-1> 1156 event gen .b.f <ButtonRelease-1> 1157 set x 1158} {} 1159test bind-15.26 {MatchPatterns procedure, reject a virtual event} { 1160 setup 1161 event add <<V1>> <Button> 1162 event add <<V2>> <Button-1> 1163 event add <<V3>> <Shift-Button-1> 1164 bind .b.f <<V2>> "lappend x V2%#" 1165 set x {} 1166 event gen .b.f <Button> -serial 101 1167 event gen .b.f <Button-1> -serial 102 1168 event gen .b.f <Shift-Button-1> -serial 103 1169 event gen .b.f <ButtonRelease-1> 1170 bind .b.f <Shift-Button-1> "lappend x Shift-Button-1" 1171 event gen .b.f <Button> -serial 104 1172 event gen .b.f <Button-1> -serial 105 1173 event gen .b.f <Shift-Button-1> -serial 106 1174 event gen .b.f <ButtonRelease-1> 1175 set x 1176} {V2102 V2103 V2105 Shift-Button-1} 1177test bind-15.27 {MatchPatterns procedure, conflict resolution} { 1178 setup 1179 bind .b.f <KeyPress> {set x 0} 1180 bind .b.f a {set x 1} 1181 set x none 1182 event gen .b.f <Key-a> 1183 set x 1184} 1 1185test bind-15.28 {MatchPatterns procedure, conflict resolution} { 1186 setup 1187 bind .b.f <KeyPress> {set x 0} 1188 bind .b.f a {set x 1} 1189 set x none 1190 event gen .b.f <Key-b> 1191 set x 1192} 0 1193test bind-15.29 {MatchPatterns procedure, conflict resolution} { 1194 setup 1195 bind .b.f <KeyPress> {lappend x 0} 1196 bind .b.f a {lappend x 1} 1197 bind .b.f ba {lappend x 2} 1198 set x none 1199 event gen .b.f <Key-b> 1200 event gen .b.f <KeyRelease-b> 1201 event gen .b.f <Key-a> 1202 set x 1203} {none 0 2} 1204test bind-15.30 {MatchPatterns procedure, conflict resolution} { 1205 setup 1206 bind .b.f <ButtonPress> {set x 0} 1207 bind .b.f <1> {set x 1} 1208 set x none 1209 event gen .b.f <Button-1> 1210 event gen .b.f <ButtonRelease-1> 1211 set x 1212} 1 1213test bind-15.31 {MatchPatterns procedure, conflict resolution} { 1214 setup 1215 bind .b.f <M1-Key> {set x 0} 1216 bind .b.f <M2-Key> {set x 1} 1217 set x none 1218 event gen .b.f <Key-a> -state 0x18 1219 set x 1220} 1 1221test bind-15.32 {MatchPatterns procedure, conflict resolution} { 1222 setup 1223 bind .b.f <M2-Key> {set x 0} 1224 bind .b.f <M1-Key> {set x 1} 1225 set x none 1226 event gen .b.f <Key-a> -state 0x18 1227 set x 1228} 1 1229test bind-15.33 {MatchPatterns procedure, conflict resolution} { 1230 setup 1231 bind .b.f <1> {lappend x single} 1232 bind Test <1> {lappend x single(Test)} 1233 bind Test <Double-1> {lappend x double(Test)} 1234 set x {} 1235 event gen .b.f <Button-1> 1236 event gen .b.f <Button-1> 1237 event gen .b.f <Button-1> 1238 event gen .b.f <ButtonRelease-1> 1239 set x 1240} {single single(Test) single double(Test) single double(Test)} 1241foreach i [bind Test] { 1242 bind Test $i {} 1243} 1244test bind-16.1 {ExpandPercents procedure} { 1245 setup 1246 bind .b.f <Enter> {set x abcd} 1247 set x none 1248 event gen .b.f <Enter> 1249 set x 1250} abcd 1251test bind-16.2 {ExpandPercents procedure} { 1252 setup 1253 bind .b.f <Enter> {set x %#} 1254 set x none 1255 event gen .b.f <Enter> -serial 1234 1256 set x 1257} 1234 1258test bind-16.3 {ExpandPercents procedure} { 1259 setup 1260 bind .b.f <Configure> {set x %a} 1261 set x none 1262 event gen .b.f <Configure> -above .b -window .b.f 1263 set x 1264} [winfo id .b] 1265test bind-16.4 {ExpandPercents procedure} { 1266 setup 1267 bind .b.f <Button> {set x %b} 1268 set x none 1269 event gen .b.f <Button-3> 1270 event gen .b.f <ButtonRelease-3> 1271 set x 1272} 3 1273test bind-16.5 {ExpandPercents procedure} { 1274 setup 1275 bind .b.f <Expose> {set x %c} 1276 set x none 1277 event gen .b.f <Expose> -count 47 1278 set x 1279} 47 1280test bind-16.6 {ExpandPercents procedure} { 1281 setup 1282 bind .b.f <Enter> {set x %d} 1283 set x none 1284 event gen .b.f <Enter> -detail NotifyAncestor 1285 set x 1286} NotifyAncestor 1287test bind-16.7 {ExpandPercents procedure} { 1288 setup 1289 bind .b.f <Enter> {set x %d} 1290 set x none 1291 event gen .b.f <Enter> -detail NotifyVirtual 1292 set x 1293} NotifyVirtual 1294test bind-16.8 {ExpandPercents procedure} { 1295 setup 1296 bind .b.f <Enter> {set x %d} 1297 set x none 1298 event gen .b.f <Enter> -detail NotifyNonlinear 1299 set x 1300} NotifyNonlinear 1301test bind-16.9 {ExpandPercents procedure} { 1302 setup 1303 bind .b.f <Enter> {set x %d} 1304 set x none 1305 event gen .b.f <Enter> -detail NotifyNonlinearVirtual 1306 set x 1307} NotifyNonlinearVirtual 1308test bind-16.10 {ExpandPercents procedure} { 1309 setup 1310 bind .b.f <Enter> {set x %d} 1311 set x none 1312 event gen .b.f <Enter> -detail NotifyPointer 1313 set x 1314} NotifyPointer 1315test bind-16.11 {ExpandPercents procedure} { 1316 setup 1317 bind .b.f <Enter> {set x %d} 1318 set x none 1319 event gen .b.f <Enter> -detail NotifyPointerRoot 1320 set x 1321} NotifyPointerRoot 1322test bind-16.12 {ExpandPercents procedure} { 1323 setup 1324 bind .b.f <Enter> {set x %d} 1325 set x none 1326 event gen .b.f <Enter> -detail NotifyDetailNone 1327 set x 1328} NotifyDetailNone 1329test bind-16.13 {ExpandPercents procedure} { 1330 setup 1331 bind .b.f <Enter> {set x %f} 1332 set x none 1333 event gen .b.f <Enter> -focus 1 1334 set x 1335} 1 1336test bind-16.14 {ExpandPercents procedure} { 1337 setup 1338 bind .b.f <Expose> {set x "%x %y %w %h"} 1339 set x none 1340 event gen .b.f <Expose> -x 24 -y 18 -width 147 -height 61 1341 set x 1342} {24 18 147 61} 1343test bind-16.15 {ExpandPercents procedure} { 1344 setup 1345 bind .b.f <Configure> {set x "%x %y %w %h"} 1346 set x none 1347 event gen .b.f <Configure> -x 24 -y 18 -width 147 -height 61 -window .b.f 1348 set x 1349} {24 18 147 61} 1350test bind-16.16 {ExpandPercents procedure} { 1351 setup 1352 bind .b.f <Key> {set x "%k"} 1353 set x none 1354 event gen .b.f <Key> -keycode 146 1355 set x 1356} 146 1357test bind-16.17 {ExpandPercents procedure} { 1358 setup 1359 bind .b.f <Enter> {set x "%m"} 1360 set x none 1361 event gen .b.f <Enter> -mode NotifyNormal 1362 set x 1363} NotifyNormal 1364test bind-16.18 {ExpandPercents procedure} { 1365 setup 1366 bind .b.f <Enter> {set x "%m"} 1367 set x none 1368 event gen .b.f <Enter> -mode NotifyGrab 1369 set x 1370} NotifyGrab 1371test bind-16.19 {ExpandPercents procedure} { 1372 setup 1373 bind .b.f <Enter> {set x "%m"} 1374 set x none 1375 event gen .b.f <Enter> -mode NotifyUngrab 1376 set x 1377} NotifyUngrab 1378test bind-16.20 {ExpandPercents procedure} { 1379 setup 1380 bind .b.f <Enter> {set x "%m"} 1381 set x none 1382 event gen .b.f <Enter> -mode NotifyWhileGrabbed 1383 set x 1384} NotifyWhileGrabbed 1385test bind-16.21 {ExpandPercents procedure} { 1386 setup 1387 bind .b.f <Map> {set x "%o"} 1388 set x none 1389 event gen .b.f <Map> -override 1 -window .b.f 1390 set x 1391} 1 1392test bind-16.22 {ExpandPercents procedure} { 1393 setup 1394 bind .b.f <Reparent> {set x "%o"} 1395 set x none 1396 event gen .b.f <Reparent> -override true -window .b.f 1397 set x 1398} 1 1399test bind-16.23 {ExpandPercents procedure} { 1400 setup 1401 bind .b.f <Configure> {set x "%o"} 1402 set x none 1403 event gen .b.f <Configure> -override 1 -window .b.f 1404 set x 1405} 1 1406test bind-16.24 {ExpandPercents procedure} { 1407 setup 1408 bind .b.f <Circulate> {set x "%p"} 1409 set x none 1410 event gen .b.f <Circulate> -place PlaceOnTop -window .b.f 1411 set x 1412} PlaceOnTop 1413test bind-16.25 {ExpandPercents procedure} { 1414 setup 1415 bind .b.f <Circulate> {set x "%p"} 1416 set x none 1417 event gen .b.f <Circulate> -place PlaceOnBottom -window .b.f 1418 set x 1419} PlaceOnBottom 1420test bind-16.26 {ExpandPercents procedure} { 1421 setup 1422 bind .b.f <1> {set x "%s"} 1423 set x none 1424 event gen .b.f <Button-1> -state 1402 1425 event gen .b.f <ButtonRelease-1> 1426 set x 1427} 1402 1428test bind-16.27 {ExpandPercents procedure} { 1429 setup 1430 bind .b.f <Enter> {set x "%s"} 1431 set x none 1432 event gen .b.f <Enter> -state 0x3ff 1433 set x 1434} 1023 1435test bind-16.28 {ExpandPercents procedure} { 1436 setup 1437 bind .b.f <Visibility> {set x "%s"} 1438 set x none 1439 event gen .b.f <Visibility> -state VisibilityPartiallyObscured 1440 set x 1441} VisibilityPartiallyObscured 1442test bind-16.29 {ExpandPercents procedure} { 1443 setup 1444 bind .b.f <Visibility> {set x "%s"} 1445 set x none 1446 event gen .b.f <Visibility> -state VisibilityUnobscured 1447 set x 1448} VisibilityUnobscured 1449test bind-16.30 {ExpandPercents procedure} { 1450 setup 1451 bind .b.f <Visibility> {set x "%s"} 1452 set x none 1453 event gen .b.f <Visibility> -state VisibilityFullyObscured 1454 set x 1455} VisibilityFullyObscured 1456test bind-16.31 {ExpandPercents procedure} { 1457 setup 1458 bind .b.f <Button> {set x "%t"} 1459 set x none 1460 event gen .b.f <Button> -time 4294 1461 event gen .b.f <ButtonRelease> 1462 set x 1463} 4294 1464test bind-16.32 {ExpandPercents procedure} { 1465 setup 1466 bind .b.f <Button> {set x "%x %y"} 1467 set x none 1468 event gen .b.f <Button> -x 881 -y 432 1469 event gen .b.f <ButtonRelease> 1470 set x 1471} {881 432} 1472test bind-16.33 {ExpandPercents procedure} { 1473 setup 1474 bind .b.f <Reparent> {set x "%x %y"} 1475 set x none 1476 event gen .b.f <Reparent> -x 882 -y 431 -window .b.f 1477 set x 1478} {882 431} 1479test bind-16.34 {ExpandPercents procedure} { 1480 setup 1481 bind .b.f <Enter> {set x "%x %y"} 1482 set x none 1483 event gen .b.f <Enter> -x 781 -y 632 1484 set x 1485} {781 632} 1486test bind-16.35 {ExpandPercents procedure} {nonPortable} { 1487 setup 1488 bind .b.f <Key> {lappend x "%A"} 1489 set x {} 1490 event gen .b.f <Key-a> 1491 event gen .b.f <Key-A> -state 1 1492 event gen .b.f <Key-Tab> 1493 event gen .b.f <Key-Return> 1494 event gen .b.f <Key-F1> 1495 event gen .b.f <Key-Shift_L> 1496 event gen .b.f <Key-space> 1497 event gen .b.f <Key-dollar> -state 1 1498 event gen .b.f <Key-braceleft> -state 1 1499 event gen .b.f <Key-Multi_key> 1500 event gen .b.f <Key-e> 1501 event gen .b.f <Key-apostrophe> 1502 set x 1503} "a A { } {\r} {{}} {{}} { } {\$} \\\{ {{}} {{}} \u00e9" 1504test bind-16.36 {ExpandPercents procedure} { 1505 setup 1506 bind .b.f <Configure> {set x "%B"} 1507 set x none 1508 event gen .b.f <Configure> -borderwidth 24 -window .b.f 1509 set x 1510} 24 1511test bind-16.37 {ExpandPercents procedure} { 1512 setup 1513 bind .b.f <Enter> {set x "%E"} 1514 set x none 1515 event gen .b.f <Enter> -sendevent 1 1516 set x 1517} 1 1518test bind-16.38 {ExpandPercents procedure} {nonPortable} { 1519 setup 1520 bind .b.f <Key> {lappend x %K} 1521 set x {} 1522 event gen .b.f <Key-a> 1523 event gen .b.f <Key-A> -state 1 1524 event gen .b.f <Key-Tab> 1525 event gen .b.f <Key-F1> 1526 event gen .b.f <Key-Shift_L> 1527 event gen .b.f <Key-space> 1528 event gen .b.f <Key-dollar> -state 1 1529 event gen .b.f <Key-braceleft> -state 1 1530 set x 1531} {a A Tab F1 Shift_L space dollar braceleft} 1532test bind-16.39 {ExpandPercents procedure} { 1533 setup 1534 bind .b.f <Key> {set x "%N"} 1535 set x none 1536 event gen .b.f <Key-a> 1537 set x 1538} 97 1539test bind-16.40 {ExpandPercents procedure} { 1540 setup 1541 bind .b.f <Key> {set x "%S"} 1542 set x none 1543 event gen .b.f <Key-a> -subwindow .b 1544 set x 1545} [winfo id .b] 1546test bind-16.41 {ExpandPercents procedure} { 1547 setup 1548 bind .b.f <Key> {set x "%T"} 1549 set x none 1550 event gen .b.f <Key> 1551 set x 1552} 2 1553test bind-16.42 {ExpandPercents procedure} { 1554 setup 1555 bind .b.f <Key> {set x "%W"} 1556 set x none 1557 event gen .b.f <Key> 1558 set x 1559} .b.f 1560test bind-16.43 {ExpandPercents procedure} { 1561 setup 1562 bind .b.f <Button> {set x "%X %Y"} 1563 set x none 1564 event gen .b.f <Button> -rootx 422 -rooty 13 1565 event gen .b.f <ButtonRelease> 1566 set x 1567} {422 13} 1568test bind-16.44 {ExpandPercents procedure} { 1569 setup 1570 bind .b.f <Gravity> {set x "%R %S"} 1571 set x none 1572 event gen .b.f <Gravity> 1573 set x 1574} {?? ??} 1575 1576 1577test bind-17.1 {event command} { 1578 list [catch {event} msg] $msg 1579} {1 {wrong # args: should be "event option ?arg?"}} 1580test bind-17.2 {event command} { 1581 list [catch {event xyz} msg] $msg 1582} {1 {bad option "xyz": must be add, delete, generate, or info}} 1583test bind-17.3 {event command: add} { 1584 list [catch {event add} msg] $msg 1585} {1 {wrong # args: should be "event add virtual sequence ?sequence ...?"}} 1586test bind-17.4 {event command: add 1} { 1587 setup 1588 event add <<Paste>> <Control-v> 1589 event info <<Paste>> 1590} {<Control-Key-v>} 1591test bind-17.5 {event command: add 2} { 1592 setup 1593 event add <<Paste>> <Control-v> <Button-2> 1594 lsort [event info <<Paste>>] 1595} {<Button-2> <Control-Key-v>} 1596test bind-17.6 {event command: add with error} { 1597 setup 1598 list [catch {event add <<Paste>> <Control-v> <Button-2> abc <xyz> <1>} \ 1599 msg] $msg [lsort [event info <<Paste>>]] 1600} {1 {bad event type or keysym "xyz"} {<Button-2> <Control-Key-v> abc}} 1601test bind-17.7 {event command: delete} { 1602 list [catch {event delete} msg] $msg 1603} {1 {wrong # args: should be "event delete virtual ?sequence sequence ...?"}} 1604test bind-17.8 {event command: delete many} { 1605 setup 1606 event add <<Paste>> <3> <1> <2> t 1607 event delete <<Paste>> <1> <2> 1608 lsort [event info <<Paste>>] 1609} {<Button-3> t} 1610test bind-17.9 {event command: delete all} { 1611 setup 1612 event add <<Paste>> a b 1613 event delete <<Paste>> 1614 event info <<Paste>> 1615} {} 1616test bind-17.10 {event command: delete 1} { 1617 setup 1618 event add <<Paste>> a b c 1619 event delete <<Paste>> b 1620 lsort [event info <<Paste>>] 1621} {a c} 1622test bind-17.11 {event command: info name} { 1623 setup 1624 event add <<Paste>> a b c 1625 lsort [event info <<Paste>>] 1626} {a b c} 1627test bind-17.12 {event command: info all} { 1628 setup 1629 event add <<Paste>> a 1630 event add <<Alive>> b 1631 lsort [event info] 1632} {<<Alive>> <<Paste>>} 1633test bind-17.13 {event command: info error} { 1634 list [catch {event info <<Paste>> <Control-v>} msg] $msg 1635} {1 {wrong # args: should be "event info ?virtual?"}} 1636test bind-17.14 {event command: generate} { 1637 list [catch {event generate} msg] $msg 1638} {1 {wrong # args: should be "event generate window event ?options?"}} 1639test bind-17.15 {event command: generate} { 1640 setup 1641 bind .b.f <1> "lappend x 1" 1642 set x {} 1643 event generate .b.f <1> 1644 set x 1645} {1} 1646test bind-17.16 {event command: generate} { 1647 list [catch {event generate .b.f <xyz>} msg] $msg 1648} {1 {bad event type or keysym "xyz"}} 1649test bind-17.17 {event command} { 1650 list [catch {event foo} msg] $msg 1651} {1 {bad option "foo": must be add, delete, generate, or info}} 1652 1653test bind-18.1 {CreateVirtualEvent procedure: GetVirtualEventUid} { 1654 list [catch {event add asd <Ctrl-v>} msg] $msg 1655} {1 {virtual event "asd" is badly formed}} 1656test bind-18.2 {CreateVirtualEvent procedure: FindSequence} { 1657 list [catch {event add <<asd>> <Ctrl-v>} msg] $msg 1658} {1 {bad event type or keysym "Ctrl"}} 1659test bind-18.3 {CreateVirtualEvent procedure: new physical} { 1660 setup 1661 event add <<xyz>> <Control-v> 1662 event info <<xyz>> 1663} {<Control-Key-v>} 1664test bind-18.4 {CreateVirtualEvent procedure: duplicate physical} { 1665 setup 1666 event add <<xyz>> <Control-v> 1667 event add <<xyz>> <Control-v> 1668 event info <<xyz>> 1669} {<Control-Key-v>} 1670test bind-18.5 {CreateVirtualEvent procedure: existing physical} { 1671 setup 1672 event add <<xyz>> <Control-v> 1673 event add <<abc>> <Control-v> 1674 list [lsort [event info]] [event info <<xyz>>] [event info <<abc>>] 1675} {{<<abc>> <<xyz>>} <Control-Key-v> <Control-Key-v>} 1676test bind-18.6 {CreateVirtualEvent procedure: new virtual} { 1677 setup 1678 event add <<xyz>> <Control-v> 1679 list [event info] [event info <<xyz>>] 1680} {<<xyz>> <Control-Key-v>} 1681test bind-18.7 {CreateVirtualEvent procedure: existing virtual} { 1682 setup 1683 event add <<xyz>> <Control-v> 1684 event add <<xyz>> <Button-2> 1685 list [event info] [lsort [event info <<xyz>>]] 1686} {<<xyz>> {<Button-2> <Control-Key-v>}} 1687 1688 1689test bind-19.1 {DeleteVirtualEvent procedure: GetVirtualEventUid} { 1690 list [catch {event add xyz {}} msg] $msg 1691} {1 {virtual event "xyz" is badly formed}} 1692test bind-19.2 {DeleteVirtualEvent procedure: non-existent virtual} { 1693 setup 1694 event delete <<xyz>> 1695 event info 1696} {} 1697test bind-19.3 {DeleteVirtualEvent procedure: delete 1} { 1698 setup 1699 event add <<xyz>> <Control-v> 1700 event delete <<xyz>> <Control-v> 1701 event info <<xyz>> 1702} {} 1703test bind-19.4 {DeleteVirtualEvent procedure: delete 1, not owned} { 1704 setup 1705 event add <<xyz>> <Control-v> 1706 event delete <<xyz>> <Button-1> 1707 event info <<xyz>> 1708} {<Control-Key-v>} 1709test bind-19.5 {DeleteVirtualEvent procedure: delete 1, badly formed} { 1710 setup 1711 event add <<xyz>> <Control-v> 1712 list [catch {event delete <<xyz>> <xyz>} msg] $msg 1713} {1 {bad event type or keysym "xyz"}} 1714test bind-19.6 {DeleteVirtualEvent procedure: delete 1, badly formed} { 1715 setup 1716 event add <<xyz>> <Control-v> 1717 list [catch {event delete <<xyz>> <<Paste>>} msg] $msg 1718} {1 {virtual event not allowed in definition of another virtual event}} 1719test bind-19.7 {DeleteVirtualEvent procedure: owns 1, delete all} { 1720 setup 1721 event add <<xyz>> <Control-v> 1722 event delete <<xyz>> 1723 event info 1724} {} 1725test bind-19.8 {DeleteVirtualEvent procedure: owns 1, delete 1} { 1726 setup 1727 event add <<xyz>> <Control-v> 1728 event delete <<xyz>> <Control-v> 1729 event info 1730} {} 1731test bind-19.9 {DeleteVirtualEvent procedure: owns many, delete all} { 1732 setup 1733 event add <<xyz>> <Control-v> <Control-w> <Control-x> 1734 event delete <<xyz>> 1735 event info 1736} {} 1737test bind-19.10 {DeleteVirtualEvent procedure: owns many, delete 1} { 1738 setup 1739 event add <<xyz>> <Control-v> <Control-w> <Control-x> 1740 event delete <<xyz>> <Control-w> 1741 lsort [event info <<xyz>>] 1742} {<Control-Key-v> <Control-Key-x>} 1743test bind-19.11 {DeleteVirtualEvent procedure: owned by 1, only} { 1744 setup 1745 event add <<xyz>> <Button-2> 1746 bind .b.f <<xyz>> {lappend x %#} 1747 set x {} 1748 event gen .b.f <Button-2> -serial 101 1749 event gen .b.f <ButtonRelease-2> 1750 event delete <<xyz>> 1751 event gen .b.f <Button-2> -serial 102 1752 event gen .b.f <ButtonRelease-2> 1753 set x 1754} {101} 1755test bind-19.12 {DeleteVirtualEvent procedure: owned by 1, first in chain} { 1756 setup 1757 event add <<abc>> <Control-Button-2> 1758 event add <<xyz>> <Button-2> 1759 bind .b.f <<xyz>> {lappend x xyz} 1760 bind .b.f <<abc>> {lappend x abc} 1761 set x {} 1762 event gen .b.f <Button-2> 1763 event gen .b.f <ButtonRelease-2> 1764 event gen .b.f <Control-Button-2> 1765 event gen .b.f <Control-ButtonRelease-2> 1766 event delete <<xyz>> 1767 event gen .b.f <Button-2> 1768 event gen .b.f <ButtonRelease-2> 1769 event gen .b.f <Control-Button-2> 1770 event gen .b.f <Control-ButtonRelease-2> 1771 list $x [event info <<abc>>] 1772} {{xyz abc abc} <Control-Button-2>} 1773test bind-19.13 {DeleteVirtualEvent procedure: owned by 1, second in chain} { 1774 setup 1775 event add <<def>> <Shift-Button-2> 1776 event add <<xyz>> <Button-2> 1777 event add <<abc>> <Control-Button-2> 1778 bind .b.f <<xyz>> {lappend x xyz} 1779 bind .b.f <<abc>> {lappend x abc} 1780 bind .b.f <<def>> {lappend x def} 1781 set x {} 1782 event gen .b.f <Button-2> 1783 event gen .b.f <ButtonRelease-2> 1784 event gen .b.f <Control-Button-2> 1785 event gen .b.f <Control-ButtonRelease-2> 1786 event gen .b.f <Shift-Button-2> 1787 event gen .b.f <Shift-ButtonRelease-2> 1788 event delete <<xyz>> 1789 event gen .b.f <Button-2> 1790 event gen .b.f <Control-Button-2> 1791 event gen .b.f <Shift-Button-2> 1792 event gen .b.f <ButtonRelease-2> 1793 event gen .b.f <Control-ButtonRelease-2> 1794 event gen .b.f <Shift-ButtonRelease-2> 1795 list $x [event info <<def>>] [event info <<xyz>>] [event info <<abc>>] 1796} {{xyz abc def abc def} <Shift-Button-2> {} <Control-Button-2>} 1797test bind-19.14 {DeleteVirtualEvent procedure: owned by 1, last in chain} { 1798 setup 1799 event add <<xyz>> <Button-2> 1800 event add <<abc>> <Control-Button-2> 1801 event add <<def>> <Shift-Button-2> 1802 bind .b.f <<xyz>> {lappend x xyz} 1803 bind .b.f <<abc>> {lappend x abc} 1804 bind .b.f <<def>> {lappend x def} 1805 set x {} 1806 event gen .b.f <Button-2> 1807 event gen .b.f <ButtonRelease-2> 1808 event gen .b.f <Control-Button-2> 1809 event gen .b.f <Control-ButtonRelease-2> 1810 event gen .b.f <Shift-Button-2> 1811 event gen .b.f <Shift-ButtonRelease-2> 1812 event delete <<xyz>> 1813 event gen .b.f <Button-2> 1814 event gen .b.f <ButtonRelease-2> 1815 event gen .b.f <Control-Button-2> 1816 event gen .b.f <Control-ButtonRelease-2> 1817 event gen .b.f <Shift-Button-2> 1818 event gen .b.f <Shift-ButtonRelease-2> 1819 list $x [event info <<xyz>>] [event info <<abc>>] [event info <<def>>] 1820} {{xyz abc def abc def} {} <Control-Button-2> <Shift-Button-2>} 1821test bind-19.15 {DeleteVirtualEvent procedure: owned by many, first} { 1822 setup 1823 pack [frame .b.g -class Test -width 150 -height 100] 1824 pack [frame .b.h -class Test -width 150 -height 100] 1825 update 1826 event add <<xyz>> <Button-2> 1827 event add <<abc>> <Button-2> 1828 event add <<def>> <Button-2> 1829 bind .b.f <<xyz>> {lappend x xyz} 1830 bind .b.g <<abc>> {lappend x abc} 1831 bind .b.h <<def>> {lappend x def} 1832 set x {} 1833 event gen .b.f <Button-2> 1834 event gen .b.f <ButtonRelease-2> 1835 event gen .b.g <Button-2> 1836 event gen .b.g <ButtonRelease-2> 1837 event gen .b.h <Button-2> 1838 event gen .b.h <ButtonRelease-2> 1839 event delete <<xyz>> 1840 event gen .b.f <Button-2> 1841 event gen .b.f <ButtonRelease-2> 1842 event gen .b.g <Button-2> 1843 event gen .b.g <ButtonRelease-2> 1844 event gen .b.h <Button-2> 1845 event gen .b.h <ButtonRelease-2> 1846 destroy .b.g 1847 destroy .b.h 1848 list $x [event info <<xyz>>] [event info <<abc>>] [event info <<def>>] 1849} {{xyz abc def abc def} {} <Button-2> <Button-2>} 1850test bind-19.16 {DeleteVirtualEvent procedure: owned by many, middle} { 1851 setup 1852 pack [frame .b.g -class Test -width 150 -height 100] 1853 pack [frame .b.h -class Test -width 150 -height 100] 1854 update 1855 event add <<xyz>> <Button-2> 1856 event add <<abc>> <Button-2> 1857 event add <<def>> <Button-2> 1858 bind .b.f <<xyz>> {lappend x xyz} 1859 bind .b.g <<abc>> {lappend x abc} 1860 bind .b.h <<def>> {lappend x def} 1861 set x {} 1862 event gen .b.f <Button-2> 1863 event gen .b.f <ButtonRelease-2> 1864 event gen .b.g <Button-2> 1865 event gen .b.g <ButtonRelease-2> 1866 event gen .b.h <Button-2> 1867 event gen .b.h <ButtonRelease-2> 1868 event delete <<abc>> 1869 event gen .b.f <Button-2> 1870 event gen .b.f <ButtonRelease-2> 1871 event gen .b.g <Button-2> 1872 event gen .b.g <ButtonRelease-2> 1873 event gen .b.h <Button-2> 1874 event gen .b.h <ButtonRelease-2> 1875 destroy .b.g 1876 destroy .b.h 1877 list $x [event info <<xyz>>] [event info <<abc>>] [event info <<def>>] 1878} {{xyz abc def xyz def} <Button-2> {} <Button-2>} 1879test bind-19.17 {DeleteVirtualEvent procedure: owned by many, last} { 1880 setup 1881 pack [frame .b.g -class Test -width 150 -height 100] 1882 pack [frame .b.h -class Test -width 150 -height 100] 1883 update 1884 event add <<xyz>> <Button-2> 1885 event add <<abc>> <Button-2> 1886 event add <<def>> <Button-2> 1887 bind .b.f <<xyz>> {lappend x xyz} 1888 bind .b.g <<abc>> {lappend x abc} 1889 bind .b.h <<def>> {lappend x def} 1890 set x {} 1891 event gen .b.f <Button-2> 1892 event gen .b.f <ButtonRelease-2> 1893 event gen .b.g <Button-2> 1894 event gen .b.g <ButtonRelease-2> 1895 event gen .b.h <Button-2> 1896 event gen .b.h <ButtonRelease-2> 1897 event delete <<def>> 1898 event gen .b.f <Button-2> 1899 event gen .b.f <ButtonRelease-2> 1900 event gen .b.g <Button-2> 1901 event gen .b.g <ButtonRelease-2> 1902 event gen .b.h <Button-2> 1903 event gen .b.h <ButtonRelease-2> 1904 destroy .b.g 1905 destroy .b.h 1906 list $x [event info <<xyz>>] [event info <<abc>>] [event info <<def>>] 1907} {{xyz abc def xyz abc} <Button-2> <Button-2> {}} 1908 1909 1910test bind-20.1 {GetVirtualEvent procedure: GetVirtualEventUid} { 1911 list [catch {event info asd} msg] $msg 1912} {1 {virtual event "asd" is badly formed}} 1913test bind-20.2 {GetVirtualEvent procedure: non-existent event} { 1914 event info <<asd>> 1915} {} 1916test bind-20.3 {GetVirtualEvent procedure: owns 1} { 1917 setup 1918 event add <<xyz>> <Control-Key-v> 1919 event info <<xyz>> 1920} {<Control-Key-v>} 1921test bind-20.4 {GetVirtualEvent procedure: owns many} { 1922 setup 1923 event add <<xyz>> <Control-v> <Button-2> spack 1924 event info <<xyz>> 1925} {<Control-Key-v> <Button-2> spack} 1926 1927 1928test bind-21.1 {GetAllVirtualEvents procedure: no events} { 1929 setup 1930 event info 1931} {} 1932test bind-21.2 {GetAllVirtualEvents procedure: 1 event} { 1933 setup 1934 event add <<xyz>> <Control-v> 1935 event info 1936} {<<xyz>>} 1937test bind-21.3 {GetAllVirtualEvents procedure: many events} { 1938 setup 1939 event add <<xyz>> <Control-v> 1940 event add <<xyz>> <Button-2> 1941 event add <<abc>> <Control-v> 1942 event add <<def>> <Key-F6> 1943 lsort [event info] 1944} {<<abc>> <<def>> <<xyz>>} 1945 1946test bind-22.1 {HandleEventGenerate} { 1947 list [catch {event gen .xyz <Control-v>} msg] $msg 1948} {1 {bad window path name ".xyz"}} 1949test bind-22.2 {HandleEventGenerate} { 1950 list [catch {event gen zzz <Control-v>} msg] $msg 1951} {1 {bad window name/identifier "zzz"}} 1952test bind-22.3 {HandleEventGenerate} { 1953 list [catch {event gen 47 <Control-v>} msg] $msg 1954} {1 {bad window name/identifier "47"}} 1955test bind-22.4 {HandleEventGenerate} { 1956 setup 1957 bind .b.f <Button> {set x "%s %b"} 1958 set x {} 1959 event gen [winfo id .b.f] <Control-Button-1> -state 260 1960 set x 1961} {260 1} 1962test bind-22.5 {HandleEventGenerate} { 1963 list [catch {event gen . <xyz>} msg] $msg 1964} {1 {bad event type or keysym "xyz"}} 1965test bind-22.6 {HandleEventGenerate} { 1966 list [catch {event gen . <Double-Button-1>} msg] $msg 1967} {1 {Double or Triple modifier not allowed}} 1968test bind-22.7 {HandleEventGenerate} { 1969 list [catch {event gen . xyz} msg] $msg 1970} {1 {only one event specification allowed}} 1971test bind-22.8 {HandleEventGenerate} { 1972 list [catch {event gen . <Button> -button} msg] $msg 1973} {1 {value for "-button" missing}} 1974test bind-22.9 {HandleEventGenerate} { 1975 setup 1976 bind .b.f <Button> {set x "%s %b"} 1977 set x {} 1978 event gen .b.f <ButtonRelease-1> 1979 event gen .b.f <ButtonRelease-2> 1980 event gen .b.f <ButtonRelease-3> 1981 event gen .b.f <Control-Button-1> 1982 event gen .b.f <Control-ButtonRelease-1> 1983 set x 1984} {4 1} 1985test bind-22.10 {HandleEventGenerate} { 1986 setup 1987 bind .b.f <Key> {set x "%s %K"} 1988 set x {} 1989 event gen .b.f <Control-Key-1> 1990 set x 1991} {4 1} 1992test bind-22.11 {HandleEventGenerate} { 1993 setup 1994 bind .b.f <<Paste>> {set x "%s"} 1995 set x {} 1996 event gen .b.f <<Paste>> -state 1 1997 set x 1998} {1} 1999test bind-22.12 {HandleEventGenerate} { 2000 setup 2001 bind .b.f <Motion> {set x "%s"} 2002 set x {} 2003 event gen .b.f <Control-Motion> 2004 set x 2005} {4} 2006test bind-22.13 {HandleEventGenerate} { 2007 setup 2008 bind .b.f <Button> {lappend x %#} 2009 set x {} 2010 event gen .b.f <Button> -when now -serial 100 2011 event gen .b.f <ButtonRelease> -when now 2012 set x 2013} {100} 2014test bind-22.14 {HandleEventGenerate} { 2015 setup 2016 bind .b.f <Button> {lappend x %#} 2017 set x {} 2018 event gen .b.f <Button> -when head -serial 100 2019 event gen .b.f <Button> -when head -serial 101 2020 event gen .b.f <Button> -when head -serial 102 2021 event gen .b.f <ButtonRelease> -when tail 2022 lappend x foo 2023 update 2024 set x 2025} {foo 102 101 100} 2026test bind-22.15 {HandleEventGenerate} { 2027 setup 2028 bind .b.f <Button> {lappend x %#} 2029 set x {} 2030 event gen .b.f <Button> -when head -serial 99 2031 event gen .b.f <Button> -when mark -serial 100 2032 event gen .b.f <Button> -when mark -serial 101 2033 event gen .b.f <Button> -when mark -serial 102 2034 event gen .b.f <ButtonRelease> -when tail 2035 lappend x foo 2036 update 2037 set x 2038} {foo 100 101 102 99} 2039test bind-22.16 {HandleEventGenerate} { 2040 setup 2041 bind .b.f <Button> {lappend x %#} 2042 set x {} 2043 event gen .b.f <Button> -when head -serial 99 2044 event gen .b.f <Button> -when tail -serial 100 2045 event gen .b.f <Button> -when tail -serial 101 2046 event gen .b.f <Button> -when tail -serial 102 2047 event gen .b.f <ButtonRelease> -when tail 2048 lappend x foo 2049 update 2050 set x 2051} {foo 99 100 101 102} 2052test bind-22.17 {HandleEventGenerate} { 2053 list [catch {event gen . <Button> -when xyz} msg] $msg 2054} {1 {bad -when value "xyz": must be now, head, mark, or tail}} 2055test bind-22.18 {HandleEventGenerate} { 2056 # Bug 411307 2057 list [catch {event gen . <a> -root 98765} msg] $msg 2058} {1 {bad window name/identifier "98765"}} 2059set i 19 2060foreach check { 2061 {<Configure> %a {-above .xyz} {{1 {bad window path name ".xyz"}}}} 2062 {<Configure> %a {-above .b} {[winfo id .b]}} 2063 {<Configure> %a {-above xyz} {{1 {bad window name/identifier "xyz"}}}} 2064 {<Configure> %a {-above [winfo id .b]} {[winfo id .b]}} 2065 {<Key> %b {-above .} {{1 {<Key> event doesn't accept "-above" option}}}} 2066 2067 {<Configure> %B {-borderwidth xyz} {{1 {bad screen distance "xyz"}}}} 2068 {<Configure> %B {-borderwidth 2i} {[winfo pixels .b.f 2i]}} 2069 {<Key> %k {-borderwidth 2i} {{1 {<Key> event doesn't accept "-borderwidth" option}}}} 2070 2071 {<Button> %b {-button xyz} {{1 {expected integer but got "xyz"}}}} 2072 {<Button> %b {-button 1} 1} 2073 {<ButtonRelease> %b {-button 1} 1} 2074 {<Key> %k {-button 1} {{1 {<Key> event doesn't accept "-button" option}}}} 2075 2076 {<Expose> %c {-count xyz} {{1 {expected integer but got "xyz"}}}} 2077 {<Expose> %c {-count 20} 20} 2078 {<Key> %b {-count 20} {{1 {<Key> event doesn't accept "-count" option}}}} 2079 2080 {<Enter> %d {-detail xyz} {{1 {bad -detail value "xyz": must be NotifyAncestor, NotifyVirtual, NotifyInferior, NotifyNonlinear, NotifyNonlinearVirtual, NotifyPointer, NotifyPointerRoot, or NotifyDetailNone}}}} 2081 {<FocusIn> %d {-detail NotifyVirtual} {{}}} 2082 {<Enter> %d {-detail NotifyVirtual} NotifyVirtual} 2083 {<Key> %k {-detail NotifyVirtual} {{1 {<Key> event doesn't accept "-detail" option}}}} 2084 2085 {<Enter> %f {-focus xyz} {{1 {expected boolean value but got "xyz"}}}} 2086 {<Enter> %f {-focus 1} 1} 2087 {<Key> %k {-focus 1} {{1 {<Key> event doesn't accept "-focus" option}}}} 2088 2089 {<Expose> %h {-height xyz} {{1 {bad screen distance "xyz"}}}} 2090 {<Expose> %h {-height 2i} {[winfo pixels .b.f 2i]}} 2091 {<Configure> %h {-height 2i} {[winfo pixels .b.f 2i]}} 2092 {<Key> %k {-height 2i} {{1 {<Key> event doesn't accept "-height" option}}}} 2093 2094 {<Key> %k {-keycode xyz} {{1 {expected integer but got "xyz"}}}} 2095 {<Key> %k {-keycode 20} 20} 2096 {<Button> %b {-keycode 20} {{1 {<Button> event doesn't accept "-keycode" option}}}} 2097 2098 {<Key> %K {-keysym xyz} {{1 {unknown keysym "xyz"}}}} 2099 {<Key> %K {-keysym a} a} 2100 {<Button> %b {-keysym a} {{1 {<Button> event doesn't accept "-keysym" option}}}} 2101 2102 {<Enter> %m {-mode xyz} {{1 {bad -mode value "xyz": must be NotifyNormal, NotifyGrab, NotifyUngrab, or NotifyWhileGrabbed}}}} 2103 {<Enter> %m {-mode NotifyNormal} NotifyNormal} 2104 {<FocusIn> %m {-mode NotifyNormal} {{}}} 2105 {<Key> %k {-mode NotifyNormal} {{1 {<Key> event doesn't accept "-mode" option}}}} 2106 2107 {<Map> %o {-override xyz} {{1 {expected boolean value but got "xyz"}}}} 2108 {<Map> %o {-override 1} 1} 2109 {<Reparent> %o {-override 1} 1} 2110 {<Configure> %o {-override 1} 1} 2111 {<Key> %k {-override 1} {{1 {<Key> event doesn't accept "-override" option}}}} 2112 2113 {<Circulate> %p {-place xyz} {{1 {bad -place value "xyz": must be PlaceOnTop, or PlaceOnBottom}}}} 2114 {<Circulate> %p {-place PlaceOnTop} PlaceOnTop} 2115 {<Key> %k {-place PlaceOnTop} {{1 {<Key> event doesn't accept "-place" option}}}} 2116 2117 {<Key> %R {-root .xyz} {{1 {bad window path name ".xyz"}}}} 2118 {<Key> %R {-root .b} {[winfo id .b]}} 2119 {<Key> %R {-root xyz} {{1 {bad window name/identifier "xyz"}}}} 2120 {<Key> %R {-root [winfo id .b]} {[winfo id .b]}} 2121 {<Button> %R {-root .b} {[winfo id .b]}} 2122 {<ButtonRelease> %R {-root .b} {[winfo id .b]}} 2123 {<Motion> %R {-root .b} {[winfo id .b]}} 2124 {<<Paste>> %R {-root .b} {[winfo id .b]}} 2125 {<Enter> %R {-root .b} {[winfo id .b]}} 2126 {<Configure> %R {-root .b} {{1 {<Configure> event doesn't accept "-root" option}}}} 2127 2128 {<Key> %X {-rootx xyz} {{1 {bad screen distance "xyz"}}}} 2129 {<Key> %X {-rootx 2i} {[winfo pixels .b.f 2i]}} 2130 {<Button> %X {-rootx 2i} {[winfo pixels .b.f 2i]}} 2131 {<ButtonRelease> %X {-rootx 2i} {[winfo pixels .b.f 2i]}} 2132 {<Motion> %X {-rootx 2i} {[winfo pixels .b.f 2i]}} 2133 {<<Paste>> %X {-rootx 2i} {[winfo pixels .b.f 2i]}} 2134 {<Enter> %X {-rootx 2i} {[winfo pixels .b.f 2i]}} 2135 {<Configure> %X {-rootx 2i} {{1 {<Configure> event doesn't accept "-rootx" option}}}} 2136 2137 {<Key> %Y {-rooty xyz} {{1 {bad screen distance "xyz"}}}} 2138 {<Key> %Y {-rooty 2i} {[winfo pixels .b.f 2i]}} 2139 {<Button> %Y {-rooty 2i} {[winfo pixels .b.f 2i]}} 2140 {<ButtonRelease> %Y {-rooty 2i} {[winfo pixels .b.f 2i]}} 2141 {<Motion> %Y {-rooty 2i} {[winfo pixels .b.f 2i]}} 2142 {<<Paste>> %Y {-rooty 2i} {[winfo pixels .b.f 2i]}} 2143 {<Enter> %Y {-rooty 2i} {[winfo pixels .b.f 2i]}} 2144 {<Configure> %Y {-rooty 2i} {{1 {<Configure> event doesn't accept "-rooty" option}}}} 2145 2146 {<Key> %E {-sendevent xyz} {{1 {expected boolean value but got "xyz"}}}} 2147 {<Key> %E {-sendevent 1} 1} 2148 {<Key> %E {-sendevent yes} 1} 2149 {<Key> %E {-sendevent 43} 43} 2150 2151 {<Key> %# {-serial xyz} {{1 {expected integer but got "xyz"}}}} 2152 {<Key> %# {-serial 100} 100} 2153 2154 {<Key> %s {-state xyz} {{1 {expected integer but got "xyz"}}}} 2155 {<Key> %s {-state 1} 1} 2156 {<Button> %s {-state 1025} 1025} 2157 {<ButtonRelease> %s {-state 1025} 1025} 2158 {<Motion> %s {-state 1} 1} 2159 {<<Paste>> %s {-state 1} 1} 2160 {<Enter> %s {-state 1} 1} 2161 {<Visibility> %s {-state xyz} {{1 {bad -state value "xyz": must be VisibilityUnobscured, VisibilityPartiallyObscured, or VisibilityFullyObscured}}}} 2162 {<Visibility> %s {-state VisibilityUnobscured} VisibilityUnobscured} 2163 {<Configure> %s {-state xyz} {{1 {<Configure> event doesn't accept "-state" option}}}} 2164 2165 {<Key> %S {-subwindow .xyz} {{1 {bad window path name ".xyz"}}}} 2166 {<Key> %S {-subwindow .b} {[winfo id .b]}} 2167 {<Key> %S {-subwindow xyz} {{1 {bad window name/identifier "xyz"}}}} 2168 {<Key> %S {-subwindow [winfo id .b]} {[winfo id .b]}} 2169 {<Button> %S {-subwindow .b} {[winfo id .b]}} 2170 {<ButtonRelease> %S {-subwindow .b} {[winfo id .b]}} 2171 {<Motion> %S {-subwindow .b} {[winfo id .b]}} 2172 {<<Paste>> %S {-subwindow .b} {[winfo id .b]}} 2173 {<Enter> %S {-subwindow .b} {[winfo id .b]}} 2174 {<Configure> %S {-subwindow .b} {{1 {<Configure> event doesn't accept "-subwindow" option}}}} 2175 2176 {<Key> %t {-time xyz} {{1 {expected integer but got "xyz"}}}} 2177 {<Key> %t {-time 100} 100} 2178 {<Button> %t {-time 100} 100} 2179 {<ButtonRelease> %t {-time 100} 100} 2180 {<Motion> %t {-time 100} 100} 2181 {<<Paste>> %t {-time 100} 100} 2182 {<Enter> %t {-time 100} 100} 2183 {<Property> %t {-time 100} 100} 2184 {<Configure> %t {-time 100} {{1 {<Configure> event doesn't accept "-time" option}}}} 2185 2186 {<Expose> %w {-width xyz} {{1 {bad screen distance "xyz"}}}} 2187 {<Expose> %w {-width 2i} {[winfo pixels .b.f 2i]}} 2188 {<Configure> %w {-width 2i} {[winfo pixels .b.f 2i]}} 2189 {<Key> %k {-width 2i} {{1 {<Key> event doesn't accept "-width" option}}}} 2190 2191 {<Unmap> %W {-window .xyz} {{1 {bad window path name ".xyz"}}}} 2192 {<Unmap> %W {-window .b.f} .b.f} 2193 {<Unmap> %W {-window xyz} {{1 {bad window name/identifier "xyz"}}}} 2194 {<Unmap> %W {-window [winfo id .b.f]} .b.f} 2195 {<Unmap> %W {-window .b.f} .b.f} 2196 {<Map> %W {-window .b.f} .b.f} 2197 {<Reparent> %W {-window .b.f} .b.f} 2198 {<Configure> %W {-window .b.f} .b.f} 2199 {<Gravity> %W {-window .b.f} .b.f} 2200 {<Circulate> %W {-window .b.f} .b.f} 2201 {<Key> %W {-window .b.f} {{1 {<Key> event doesn't accept "-window" option}}}} 2202 2203 {<Key> %x {-x xyz} {{1 {bad screen distance "xyz"}}}} 2204 {<Key> %x {-x 2i} {[winfo pixels .b.f 2i]}} 2205 {<Button> %x {-x 2i} {[winfo pixels .b.f 2i]}} 2206 {<ButtonRelease> %x {-x 2i} {[winfo pixels .b.f 2i]}} 2207 {<Motion> %x {-x 2i} {[winfo pixels .b.f 2i]}} 2208 {<<Paste>> %x {-x 2i} {[winfo pixels .b.f 2i]}} 2209 {<Enter> %x {-x 2i} {[winfo pixels .b.f 2i]}} 2210 {<Expose> %x {-x 2i} {[winfo pixels .b.f 2i]}} 2211 {<Configure> %x {-x 2i} {[winfo pixels .b.f 2i]}} 2212 {<Gravity> %x {-x 2i} {[winfo pixels .b.f 2i]}} 2213 {<Reparent> %x {-x 2i} {[winfo pixels .b.f 2i]}} 2214 {<Map> %x {-x 2i} {{1 {<Map> event doesn't accept "-x" option}}}} 2215 2216 {<Key> %y {-y xyz} {{1 {bad screen distance "xyz"}}}} 2217 {<Key> %y {-y 2i} {[winfo pixels .b.f 2i]}} 2218 {<Button> %y {-y 2i} {[winfo pixels .b.f 2i]}} 2219 {<ButtonRelease> %y {-y 2i} {[winfo pixels .b.f 2i]}} 2220 {<Motion> %y {-y 2i} {[winfo pixels .b.f 2i]}} 2221 {<<Paste>> %y {-y 2i} {[winfo pixels .b.f 2i]}} 2222 {<Enter> %y {-y 2i} {[winfo pixels .b.f 2i]}} 2223 {<Expose> %y {-y 2i} {[winfo pixels .b.f 2i]}} 2224 {<Configure> %y {-y 2i} {[winfo pixels .b.f 2i]}} 2225 {<Gravity> %y {-y 2i} {[winfo pixels .b.f 2i]}} 2226 {<Reparent> %y {-y 2i} {[winfo pixels .b.f 2i]}} 2227 {<Map> %y {-y 2i} {{1 {<Map> event doesn't accept "-y" option}}}} 2228 2229 {<Key> %k {-xyz 1} {{1 {bad option "-xyz": must be -when, -above, -borderwidth, -button, -count, -delta, -detail, -focus, -height, -keycode, -keysym, -mode, -override, -place, -root, -rootx, -rooty, -sendevent, -serial, -state, -subwindow, -time, -warp, -width, -window, -x, or -y}}}} 2230} { 2231 set event [lindex $check 0] 2232 test bind-22.$i "HandleEventGenerate: options $event [lindex $check 2]" { 2233 setup 2234 bind .b.f $event "lappend x [lindex $check 1]" 2235 set x {} 2236 if [catch {eval event gen .b.f $event [lindex $check 2]} msg] { 2237 set x [list 1 $msg] 2238 } 2239 set x 2240 } [eval set x [lindex $check 3]] 2241 incr i 2242} 2243test bind-23.1 {GetVirtualEventUid procedure} { 2244 list [catch {event info <<asd} msg] $msg 2245} {1 {virtual event "<<asd" is badly formed}} 2246test bind-23.2 {GetVirtualEventUid procedure} { 2247 list [catch {event info <<>>} msg] $msg 2248} {1 {virtual event "<<>>" is badly formed}} 2249test bind-23.3 {GetVirtualEventUid procedure} { 2250 list [catch {event info <<asd>} msg] $msg 2251} {1 {virtual event "<<asd>" is badly formed}} 2252test bind-23.4 {GetVirtualEventUid procedure} { 2253 event info <<asd>> 2254} {} 2255 2256 2257test bind-24.1 {FindSequence procedure: no event} { 2258 list [catch {bind .b {} test} msg] $msg 2259} {1 {no events specified in binding}} 2260test bind-24.2 {FindSequence procedure: bad event} { 2261 list [catch {bind .b <xyz> test} msg] $msg 2262} {1 {bad event type or keysym "xyz"}} 2263test bind-24.3 {FindSequence procedure: virtual allowed} { 2264 bind .b.f <<Paste>> test 2265} {} 2266test bind-24.4 {FindSequence procedure: virtual not allowed} { 2267 list [catch {event add <<Paste>> <<Alive>>} msg] $msg 2268} {1 {virtual event not allowed in definition of another virtual event}} 2269test bind-24.5 {FindSequence procedure, multiple bindings} { 2270 setup 2271 bind .b.f <1> {lappend x single} 2272 bind .b.f <Double-1> {lappend x double} 2273 bind .b.f <Triple-1> {lappend x triple} 2274 bind .b.f <Quadruple-1> {lappend x quadruple} 2275 set x press 2276 event gen .b.f <Button-1> 2277 event gen .b.f <ButtonRelease-1> 2278 lappend x press 2279 event gen .b.f <Button-1> 2280 event gen .b.f <ButtonRelease-1> 2281 lappend x press 2282 event gen .b.f <Button-1> 2283 event gen .b.f <ButtonRelease-1> 2284 lappend x press 2285 event gen .b.f <Button-1> 2286 event gen .b.f <ButtonRelease-1> 2287 lappend x press 2288 event gen .b.f <Button-1> 2289 event gen .b.f <ButtonRelease-1> 2290 set x 2291} {press single press double press triple press quadruple press quadruple} 2292test bind-24.6 {FindSequence procedure: virtual composed} { 2293 list [catch {bind .b <Control-b><<Paste>> "puts hi"} msg] $msg 2294} {1 {virtual events may not be composed}} 2295test bind-24.7 {FindSequence procedure: new pattern sequence} { 2296 setup 2297 bind .b.f <Button-1><Button-2> {lappend x 1-2} 2298 set x {} 2299 event gen .b.f <Button-1> 2300 event gen .b.f <ButtonRelease-1> 2301 event gen .b.f <Button-2> 2302 event gen .b.f <ButtonRelease-2> 2303 set x 2304} {1-2} 2305test bind-24.8 {FindSequence procedure: similar pattern sequence} { 2306 setup 2307 bind .b.f <Button-1><Button-2> {lappend x 1-2} 2308 bind .b.f <Button-2> {lappend x 2} 2309 set x {} 2310 event gen .b.f <Button-3> 2311 event gen .b.f <Button-2> 2312 event gen .b.f <ButtonRelease-2> 2313 event gen .b.f <Button-1> 2314 event gen .b.f <ButtonRelease-1> 2315 event gen .b.f <Button-2> 2316 event gen .b.f <ButtonRelease-2> 2317 set x 2318} {2 1-2} 2319test bind-24.9 {FindSequence procedure: similar pattern sequence} { 2320 setup 2321 bind .b.f <Button-1><Button-2> {lappend x 1-2} 2322 bind .b.f <Button-2><Button-2> {lappend x 2-2} 2323 set x {} 2324 event gen .b.f <Button-3> 2325 event gen .b.f <Button-2> 2326 event gen .b.f <ButtonRelease-2> 2327 event gen .b.f <Button-2> 2328 event gen .b.f <ButtonRelease-2> 2329 event gen .b.f <Button-1> 2330 event gen .b.f <ButtonRelease-1> 2331 event gen .b.f <Button-2> 2332 event gen .b.f <ButtonRelease-2> 2333 set x 2334} {2-2 1-2} 2335test bind-24.10 {FindSequence procedure: similar pattern sequence} { 2336 setup 2337 bind .b.f <Button-2><Button-2> {lappend x 2-2} 2338 bind .b.f <Double-Button-2> {lappend x d-2} 2339 set x {} 2340 event gen .b.f <Button-3> 2341 event gen .b.f <Button-2> 2342 event gen .b.f <ButtonRelease-2> 2343 event gen .b.f <Button-2> 2344 event gen .b.f <ButtonRelease-2> 2345 event gen .b.f <Button-1> 2346 event gen .b.f <ButtonRelease-1> 2347 event gen .b.f <Button-2> -x 100 2348 event gen .b.f <ButtonRelease-2> 2349 event gen .b.f <Button-2> -x 200 2350 event gen .b.f <ButtonRelease-2> 2351 set x 2352} {d-2 2-2} 2353test bind-24.11 {FindSequence procedure: new sequence, don't create} { 2354 setup 2355 bind .b.f <Button-2> 2356} {} 2357test bind-24.12 {FindSequence procedure: not new sequence, don't create} { 2358 setup 2359 bind .b.f <Control-Button-2> "foo" 2360 bind .b.f <Button-2> 2361} {} 2362test bind-24.13 {FindSequence procedure: no binding} { 2363 catch {destroy .b.f} 2364 frame .b.f -class Test -width 150 -height 100 2365 list [catch {bind .b.f <a>} msg] $msg 2366} {0 {}} 2367test bind-24.14 {FindSequence procedure: no binding} { 2368 catch {destroy .b.f} 2369 canvas .b.f 2370 set i [.b.f create rect 10 10 100 100] 2371 list [catch {.b.f bind $i <a>} msg] $msg 2372} {0 {}} 2373 2374test bind-25.1 {ParseEventDescription procedure} { 2375 list [catch {bind .b \x7 test} msg] $msg 2376} {1 {bad ASCII character 0x7}} 2377test bind-25.2 {ParseEventDescription procedure} { 2378 list [catch {bind .b "\x7f" test} msg] $msg 2379} {1 {bad ASCII character 0x7f}} 2380test bind-25.3 {ParseEventDescription procedure} { 2381 list [catch {bind .b "\x4" test} msg] $msg 2382} {1 {bad ASCII character 0x4}} 2383test bind-25.4 {ParseEventDescription procedure} { 2384 setup 2385 bind .b.f a test 2386 bind .b.f a 2387} {test} 2388test bind-25.5 {ParseEventDescription procedure: virtual} { 2389 list [catch {bind .b <<>> foo} msg] $msg 2390} {1 {virtual event "<<>>" is badly formed}} 2391test bind-25.6 {ParseEventDescription procedure: virtual} { 2392 list [catch {bind .b <<Paste foo} msg] $msg 2393} {1 {missing ">" in virtual binding}} 2394test bind-25.7 {ParseEventDescription procedure: virtual} { 2395 list [catch {bind .b <<Paste> foo} msg] $msg 2396} {1 {missing ">" in virtual binding}} 2397test bind-25.8 {ParseEventDescription procedure: correctly terminate virtual} { 2398 list [catch {bind .b <<Paste>>h foo} msg] $msg 2399} {1 {virtual events may not be composed}} 2400test bind-25.9 {ParseEventDescription procedure} { 2401 list [catch {bind .b <> test} msg] $msg 2402} {1 {no event type or button # or keysym}} 2403test bind-25.10 {ParseEventDescription procedure: misinterpreted modifier} { 2404 button .x 2405 bind .x <Control-M> a 2406 bind .x <M-M> b 2407 set x [lsort [bind .x]] 2408 destroy .x 2409 set x 2410} {<Control-Key-M> <Meta-Key-M>} 2411test bind-25.11 {ParseEventDescription procedure} { 2412 catch {destroy .b.f} 2413 frame .b.f -class Test -width 150 -height 100 2414 bind .b.f <a---> {nothing} 2415 bind .b.f 2416} a 2417test bind-25.12 {ParseEventDescription procedure} { 2418 list [catch {bind .b <a-- test} msg] $msg 2419} {1 {missing ">" in binding}} 2420test bind-25.13 {ParseEventDescription procedure} { 2421 list [catch {bind .b <a-b> test} msg] $msg 2422} {1 {extra characters after detail in binding}} 2423test bind-25.14 {ParseEventDescription} { 2424 setup 2425 list [catch {bind .b <<abc {puts hi}} msg] $msg 2426} {1 {missing ">" in virtual binding}} 2427test bind-25.15 {ParseEventDescription} { 2428 setup 2429 list [catch {bind .b <<abc> {puts hi}} msg] $msg 2430} {1 {missing ">" in virtual binding}} 2431test bind-25.16 {ParseEventDescription} { 2432 setup 2433 bind .b <<Shift-Paste>> {puts hi} 2434 bind .b 2435} {<<Shift-Paste>>} 2436test bind-25.17 {ParseEventDescription} { 2437 setup 2438 list [catch {event add <<xyz>> <<abc>>} msg] $msg 2439} {1 {virtual event not allowed in definition of another virtual event}} 2440set i 1 2441foreach check { 2442 {{<Control- a>} <Control-Key-a>} 2443 {<Shift-a> <Shift-Key-a>} 2444 {<Lock-a> <Lock-Key-a>} 2445 {<Meta---a> <Meta-Key-a>} 2446 {<M-a> <Meta-Key-a>} 2447 {<Alt-a> <Alt-Key-a>} 2448 {<B1-a> <B1-Key-a>} 2449 {<B2-a> <B2-Key-a>} 2450 {<B3-a> <B3-Key-a>} 2451 {<B4-a> <B4-Key-a>} 2452 {<B5-a> <B5-Key-a>} 2453 {<Button1-a> <B1-Key-a>} 2454 {<Button2-a> <B2-Key-a>} 2455 {<Button3-a> <B3-Key-a>} 2456 {<Button4-a> <B4-Key-a>} 2457 {<Button5-a> <B5-Key-a>} 2458 {<M1-a> <Mod1-Key-a>} 2459 {<M2-a> <Mod2-Key-a>} 2460 {<M3-a> <Mod3-Key-a>} 2461 {<M4-a> <Mod4-Key-a>} 2462 {<M5-a> <Mod5-Key-a>} 2463 {<Mod1-a> <Mod1-Key-a>} 2464 {<Mod2-a> <Mod2-Key-a>} 2465 {<Mod3-a> <Mod3-Key-a>} 2466 {<Mod4-a> <Mod4-Key-a>} 2467 {<Mod5-a> <Mod5-Key-a>} 2468 {<Double-a> <Double-Key-a>} 2469 {<Triple-a> <Triple-Key-a>} 2470 {{<Double 1>} <Double-Button-1>} 2471 {<Triple-1> <Triple-Button-1>} 2472 {{<M1-M2 M3-M4 B1-Control-a>} <Control-B1-Mod1-Mod2-Mod3-Mod4-Key-a>} 2473} { 2474 test bind-25.$i {modifier names} { 2475 catch {destroy .b.f} 2476 frame .b.f -class Test -width 150 -height 100 2477 bind .b.f [lindex $check 0] foo 2478 bind .b.f 2479 } [lindex $check 1] 2480 bind .b.f [lindex $check 1] {} 2481 incr i 2482} 2483 2484foreach event [bind Test] { 2485 bind Test $event {} 2486} 2487foreach event [bind all] { 2488 bind all $event {} 2489} 2490test bind-26.1 {event names} { 2491 catch {destroy .b.f} 2492 frame .b.f -class Test -width 150 -height 100 2493 bind .b.f <FocusIn> {nothing} 2494 bind .b.f 2495} <FocusIn> 2496test bind-26.2 {event names} { 2497 catch {destroy .b.f} 2498 frame .b.f -class Test -width 150 -height 100 2499 bind .b.f <FocusOut> {nothing} 2500 bind .b.f 2501} <FocusOut> 2502test bind-26.3 {event names} { 2503 setup 2504 bind .b.f <Destroy> {lappend x "destroyed"} 2505 set x [bind .b.f] 2506 destroy .b.f 2507 set x 2508} {<Destroy> destroyed} 2509set i 4 2510foreach check { 2511 {Motion Motion} 2512 {Button Button} 2513 {ButtonPress Button} 2514 {ButtonRelease ButtonRelease} 2515 {Colormap Colormap} 2516 {Enter Enter} 2517 {Leave Leave} 2518 {Expose Expose} 2519 {Key Key} 2520 {KeyPress Key} 2521 {KeyRelease KeyRelease} 2522 {Property Property} 2523 {Visibility Visibility} 2524 {Activate Activate} 2525 {Deactivate Deactivate} 2526} { 2527 set event [lindex $check 0] 2528 test bind-26.$i {event names} { 2529 setup 2530 bind .b.f <$event> "set x {event $event}" 2531 set x xyzzy 2532 event gen .b.f <$event> 2533 list $x [bind .b.f] 2534 } [list "event $event" <[lindex $check 1]>] 2535 incr i 2536} 2537foreach check { 2538 {Circulate Circulate} 2539 {Configure Configure} 2540 {Gravity Gravity} 2541 {Map Map} 2542 {Reparent Reparent} 2543 {Unmap Unmap} 2544} { 2545 set event [lindex $check 0] 2546 test bind-26.$i {event names} { 2547 setup 2548 bind .b.f <$event> "set x {event $event}" 2549 set x xyzzy 2550 event gen .b.f <$event> -window .b.f 2551 list $x [bind .b.f] 2552 } [list "event $event" <[lindex $check 1]>] 2553 incr i 2554} 2555 2556 2557test bind-27.1 {button names} { 2558 list [catch {bind .b <Expose-1> foo} msg] $msg 2559} {1 {specified button "1" for non-button event}} 2560test bind-27.2 {button names} { 2561 list [catch {bind .b <Button-6> foo} msg] $msg 2562} {1 {specified keysym "6" for non-key event}} 2563set i 3 2564foreach button {1 2 3 4 5} { 2565 test bind-27.$i {button names} { 2566 setup 2567 bind .b.f <Button-$button> "lappend x \"button $button\"" 2568 set x [bind .b.f] 2569 event gen .b.f <Button-$button> 2570 event gen .b.f <ButtonRelease-$button> 2571 set x 2572 } [list <Button-$button> "button $button"] 2573 incr i 2574} 2575 2576test bind-28.1 {keysym names} { 2577 list [catch {bind .b <Expose-a> foo} msg] $msg 2578} {1 {specified keysym "a" for non-key event}} 2579test bind-28.2 {keysym names} { 2580 list [catch {bind .b <Gorp> foo} msg] $msg 2581} {1 {bad event type or keysym "Gorp"}} 2582test bind-28.3 {keysym names} { 2583 list [catch {bind .b <Key-Stupid> foo} msg] $msg 2584} {1 {bad event type or keysym "Stupid"}} 2585test bind-28.4 {keysym names} { 2586 catch {destroy .b.f} 2587 frame .b.f -class Test -width 150 -height 100 2588 bind .b.f <a> foo 2589 bind .b.f 2590} a 2591set i 5 2592foreach check { 2593 {a 0 a} 2594 {space 0 <Key-space>} 2595 {Return 0 <Key-Return>} 2596 {X 1 X} 2597} { 2598 set keysym [lindex $check 0] 2599 test bind-28.$i {keysym names} { 2600 setup 2601 bind .b.f <Key-$keysym> "lappend x \"keysym $keysym\"" 2602 bind .b.f <Key-x> "lappend x {bad binding match}" 2603 set x [lsort [bind .b.f]] 2604 event gen .b.f <Key-$keysym> -state [lindex $check 1] 2605 set x 2606 } [concat [lsort "x [lindex $check 2]"] "{keysym $keysym}"] 2607 incr i 2608} 2609 2610test bind-29.1 {dummy test to help ensure proper numbering} {} {} 2611setup 2612bind .b.f <KeyPress> {set x %K} 2613set i 2 2614foreach check { 2615 {a 0 a} 2616 {x 1 X} 2617 {x 2 X} 2618 {space 0 space} 2619 {F1 1 F1} 2620} { 2621 test bind-29.$i {GetKeySym procedure} {nonPortable} { 2622 set x nothing 2623 event gen .b.f <KeyPress> -keysym [lindex $check 0] \ 2624 -state [lindex $check 1] 2625 set x 2626 } [lindex $check 2] 2627 incr i 2628} 2629 2630 2631proc bgerror msg { 2632 global x errorInfo 2633 set x [list $msg $errorInfo] 2634} 2635test bind-30.1 {Tk_BackgroundError procedure} { 2636 setup 2637 bind .b.f <Button> {error "This is a test"} 2638 set x none 2639 event gen .b.f <Button> 2640 event gen .b.f <ButtonRelease> 2641 update 2642 set x 2643} {{This is a test} {This is a test 2644 while executing 2645"error "This is a test"" 2646 (command bound to event)}} 2647test bind-30.2 {Tk_BackgroundError procedure} { 2648 proc do {} { 2649 event gen .b.f <Button> 2650 event gen .b.f <ButtonRelease> 2651 } 2652 setup 2653 bind .b.f <Button> {error Message2} 2654 set x none 2655 do 2656 update 2657 set x 2658} {Message2 {Message2 2659 while executing 2660"error Message2" 2661 (command bound to event)}} 2662rename bgerror {} 2663 2664test bind-31.1 {MouseWheel events} { 2665 setup 2666 set x {} 2667 bind .b.f <MouseWheel> {set x Wheel} 2668 event gen .b.f <MouseWheel> 2669 set x 2670} {Wheel} 2671test bind-31.2 {MouseWheel events} { 2672 setup 2673 set x {} 2674 bind .b.f <MouseWheel> {set x %D} 2675 event gen .b.f <MouseWheel> -delta 120 2676 set x 2677} {120} 2678test bind-31.2 {MouseWheel events} { 2679 setup 2680 set x {} 2681 bind .b.f <MouseWheel> {set x "%D %x %y"} 2682 event gen .b.f <MouseWheel> -delta 240 -x 10 -y 30 2683 set x 2684} {240 10 30} 2685 2686destroy .b 2687 2688# cleanup 2689::tcltest::cleanupTests 2690return 2691