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