Tk Source Code

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

Artifact 6377cb0d762b7261e1a0e9a144b18a844ab1444f7e2af3584a85a3ee22ba3a14:


     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  package require tcltest 2.2
    11  namespace import ::tcltest::*
    12  eval tcltest::configure $argv
    13  tcltest::loadTestedCommands
    14  tk useinputmethods 0
    15  
    16  toplevel .t -width 100 -height 50
    17  wm geom .t +0+0
    18  update idletasks
    19  
    20  foreach p [event info] {event delete $p}
    21  foreach event [bind Test] {
    22      bind Test $event {}
    23  }
    24  foreach event [bind all] {
    25      bind all $event {}
    26  }
    27  
    28  proc unsetBindings {} {
    29      bind all <Enter> {}
    30      bind Test <Enter> {}
    31      bind Toplevel <Enter> {}
    32      bind xyz <Enter> {}
    33      bind {a b} <Enter> {}
    34      bind .t <Enter> {}
    35  }
    36  
    37  # move the mouse pointer away of the testing area
    38  # otherwise some spurious events may pollute the tests
    39  toplevel .top
    40  wm geometry .top 50x50-50-50
    41  update
    42  event generate .top <Button-1> -warp 1
    43  update
    44  destroy .top
    45  
    46  test bind-1.1 {bind command} -body {
    47      bind
    48  } -returnCodes error -result {wrong # args: should be "bind window ?pattern? ?command?"}
    49  test bind-1.2 {bind command} -body {
    50      bind a b c d
    51  } -returnCodes error -result {wrong # args: should be "bind window ?pattern? ?command?"}
    52  test bind-1.3 {bind command} -body {
    53      bind .gorp
    54  } -returnCodes error -result {bad window path name ".gorp"}
    55  test bind-1.4 {bind command} -body {
    56      bind foo
    57  } -returnCodes ok -result {}
    58  test bind-1.5 {bind command} -body {
    59      bind .t <gorp-> {}
    60  } -returnCodes ok -result {}
    61  test bind-1.6 {bind command} -body {
    62      frame .t.f
    63      bind .t.f <Enter> {test script}
    64      set result [bind .t.f <Enter>]
    65      bind .t.f <Enter> {}
    66      list $result [bind .t.f <Enter>]
    67  } -cleanup {
    68      destroy .t.f
    69  } -result {{test script} {}}
    70  test bind-1.7 {bind command} -body {
    71      frame .t.f
    72      bind .t.f <Enter> {test script}
    73      bind .t.f <Enter> {+more text}
    74      bind .t.f <Enter>
    75  } -cleanup {
    76      destroy .t.f
    77  } -result {test script
    78  more text}
    79  test bind-1.8 {bind command} -body {
    80      bind .t <gorp-> {test script} 
    81  } -returnCodes error -result {bad event type or keysym "gorp"}
    82  test bind-1.9 {bind command} -body {
    83      catch {bind .t <gorp-> {test script}} 
    84      bind .t
    85  } -result {}
    86  test bind-1.10 {bind command} -body {
    87      bind .t <gorp->
    88  } -returnCodes ok -result {}
    89  test bind-1.11 {bind command} -body {
    90      frame .t.f
    91      bind .t.f <Enter> {script 1}
    92      bind .t.f <Leave> {script 2}
    93      bind .t.f a {script for a}
    94      bind .t.f b {script for b}
    95      lsort [bind .t.f]
    96  } -cleanup {
    97      destroy .t.f
    98  } -result {<Enter> <Leave> a b}
    99  
   100  test bind-2.1 {bindtags command} -body {
   101      bindtags
   102  } -returnCodes error -result {wrong # args: should be "bindtags window ?taglist?"}
   103  test bind-2.2 {bindtags command} -body {
   104      bindtags a b c
   105  } -returnCodes error -result {wrong # args: should be "bindtags window ?taglist?"}
   106  test bind-2.3 {bindtags command} -body {
   107      bindtags .foo
   108  } -returnCodes error -result {bad window path name ".foo"}
   109  test bind-2.4 {bindtags command} -body {
   110      bindtags .t
   111  } -result {.t Toplevel all}
   112  test bind-2.5 {bindtags command} -body {
   113      frame .t.f
   114      bindtags .t.f
   115  } -cleanup {
   116      destroy .t.f
   117  } -result {.t.f Frame .t all}
   118  test bind-2.6 {bindtags command} -body {
   119      frame .t.f
   120      bindtags .t.f {{x y z} b c d}
   121      bindtags .t.f
   122  } -cleanup {
   123      destroy .t.f
   124  } -result {{x y z} b c d}
   125  test bind-2.7 {bindtags command} -body {
   126      frame .t.f
   127      bindtags .t.f {x y z}
   128      bindtags .t.f {}
   129      bindtags .t.f
   130  } -cleanup {
   131      destroy .t.f
   132  } -result {.t.f Frame .t all}
   133  test bind-2.8 {bindtags command} -body {
   134      frame .t.f
   135      bindtags .t.f {x y z}
   136      bindtags .t.f {a b c d}
   137      bindtags .t.f
   138  } -cleanup {
   139      destroy .t.f
   140  } -result {a b c d}
   141  test bind-2.9 {bindtags command} -body {
   142      frame .t.f
   143      bindtags .t.f {a b c}
   144      bindtags .t.f "\{" 
   145  } -cleanup {
   146      destroy .t.f
   147  } -returnCodes error -result {unmatched open brace in list} 
   148  test bind-2.10 {bindtags command} -body {
   149      frame .t.f
   150      bindtags .t.f {a b c}
   151      catch {bindtags .t.f "\{"}
   152      bindtags .t.f
   153  } -cleanup {
   154      destroy .t.f
   155  } -result {.t.f Frame .t all}
   156  test bind-2.11 {bindtags command} -body {
   157      frame .t.f
   158      bindtags .t.f {a b c}
   159      bindtags .t.f "a .gorp b" 
   160  } -cleanup {
   161      destroy .t.f
   162  } -returnCodes ok  
   163  test bind-2.12 {bindtags command} -body {
   164      frame .t.f
   165      bindtags .t.f {a b c}
   166      catch {bindtags .t.f "a .gorp b"}
   167      bindtags .t.f
   168  } -cleanup {
   169      destroy .t.f
   170  } -result {a .gorp b}
   171  
   172  
   173  test bind-3.1 {TkFreeBindingTags procedure} -body {
   174      frame .t.f
   175      bindtags .t.f "a b c d"
   176      destroy .t.f
   177  } -cleanup {
   178      destroy .t.f
   179  } -result {}
   180  test bind-3.2 {TkFreeBindingTags procedure} -body {
   181      frame .t.f
   182      catch {bindtags .t.f "a .gorp b .t.f"}
   183      destroy .t.f
   184  } -cleanup {
   185      destroy .t.f
   186  } -result {}
   187  
   188  
   189  test bind-4.1 {TkBindEventProc procedure} -setup {
   190      frame .t.f -class Test -width 150 -height 100
   191      pack .t.f
   192      update
   193      set x {}
   194  } -body {
   195      bind all <Enter> {lappend x "%W enter all"}
   196      bind Test <Enter> {lappend x "%W enter frame"}
   197      bind Toplevel <Enter> {lappend x "%W enter toplevel"}
   198      bind xyz <Enter> {lappend x "%W enter xyz"}
   199      bind {a b} <Enter> {lappend x "%W enter {a b}"}
   200      bind .t <Enter>  {lappend x "%W enter .t"}
   201      bind .t.f <Enter> {lappend x "%W enter .t.f"}
   202      
   203      event generate .t.f <Enter>
   204      return $x
   205  } -cleanup {
   206      destroy .t.f
   207      unsetBindings
   208  } -result {{.t.f enter .t.f} {.t.f enter frame} {.t.f enter .t} {.t.f enter all}}
   209  test bind-4.2 {TkBindEventProc procedure} -setup {
   210      frame .t.f -class Test -width 150 -height 100
   211      pack .t.f
   212      update
   213      set x {}
   214  } -body {
   215      bind all <Enter> {lappend x "%W enter all"}
   216      bind Test <Enter> {lappend x "%W enter frame"}
   217      bind Toplevel <Enter> {lappend x "%W enter toplevel"}
   218      bind xyz <Enter> {lappend x "%W enter xyz"}
   219      bind {a b} <Enter> {lappend x "%W enter {a b}"}
   220      bind .t <Enter>  {lappend x "%W enter .t"}
   221      bind .t.f <Enter> {lappend x "%W enter .t.f"}
   222      
   223      bindtags .t.f {.t.f {a b} xyz}
   224      event generate .t.f <Enter> 
   225      return $x
   226  } -cleanup {
   227      destroy .t.f
   228      unsetBindings
   229  } -result {{.t.f enter .t.f} {.t.f enter {a b}} {.t.f enter xyz}}
   230  test bind-4.3 {TkBindEventProc procedure} -body {
   231      set x {}
   232      bind all <Enter> {lappend x "%W enter all"}
   233      bind Test <Enter> {lappend x "%W enter frame"}
   234      bind Toplevel <Enter> {lappend x "%W enter toplevel"}
   235      bind xyz <Enter> {lappend x "%W enter xyz"}
   236      bind {a b} <Enter> {lappend x "%W enter {a b}"}
   237      bind .t <Enter>  {lappend x "%W enter .t"}
   238      
   239      event generate .t <Enter>
   240      return $x
   241  } -cleanup {
   242      unsetBindings
   243  }  -result {{.t enter .t} {.t enter toplevel} {.t enter all}}
   244  test bind-4.4 {TkBindEventProc procedure} -setup {
   245      frame .t.f -class Test -width 150 -height 100
   246      pack .t.f
   247      frame .t.f3 -width 50 -height 50
   248      pack .t.f3
   249      update
   250      set x {}
   251  } -body {
   252      bind all <Enter> {lappend x "%W enter all"}
   253      bind Test <Enter> {lappend x "%W enter frame"}
   254      bind Toplevel <Enter> {lappend x "%W enter toplevel"}
   255      bind xyz <Enter> {lappend x "%W enter xyz"}
   256      bind {a b} <Enter> {lappend x "%W enter {a b}"}
   257      bind .t <Enter>  {lappend x "%W enter .t"}
   258      
   259      bindtags .t.f {.t.f .t.f2 .t.f3}
   260      bind .t.f <Enter> {lappend x "%W enter .t.f"}
   261      bind .t.f3 <Enter> {lappend x "%W enter .t.f3"}
   262      event generate .t.f <Enter>
   263      return $x
   264  } -cleanup {
   265      destroy .t.f .t.f3
   266      unsetBindings
   267  } -result {{.t.f enter .t.f} {.t.f enter .t.f3}}
   268  test bind-4.5 {TkBindEventProc procedure} -setup {
   269      # This tests memory allocation for objPtr;  it won't serve any useful
   270      # purpose unless run with some sort of allocation checker turned on.
   271      frame .t.f -class Test -width 150 -height 100
   272      pack .t.f
   273      update
   274  } -body {
   275      bind all <Enter> {lappend x "%W enter all"}
   276      bind Test <Enter> {lappend x "%W enter frame"}
   277      bind Toplevel <Enter> {lappend x "%W enter toplevel"}
   278      bind xyz <Enter> {lappend x "%W enter xyz"}
   279      bind {a b} <Enter> {lappend x "%W enter {a b}"}
   280      bind .t <Enter>  {lappend x "%W enter .t"}
   281      bindtags .t.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}
   282      
   283      event generate .t.f <Enter>
   284  } -cleanup {
   285      destroy .t.f
   286      unsetBindings
   287  } -result {}
   288  
   289  
   290  test bind-5.1 {Tk_CreateBindingTable procedure} -body {
   291      canvas .t.c
   292      .t.c bind foo
   293  } -cleanup {
   294      destroy .t.c
   295  } -result {}
   296  
   297  
   298  test bind-6.1 {Tk_DeleteBindTable procedure} -body {
   299      canvas .t.c
   300      .t.c bind foo <1> {string 1}
   301      .t.c create rectangle 0 0 100 100
   302      .t.c bind 1 <2> {string 2}
   303      destroy .t.c
   304  } -cleanup {
   305      destroy .t.c
   306  } -result {}
   307  test bind-7.1 {Tk_CreateBinding procedure: bad binding} -body {
   308      canvas .t.c
   309      .t.c bind foo <
   310  } -cleanup {
   311      destroy .t.c
   312  } -returnCodes error -result {no event type or button # or keysym}
   313  test bind-7.3 {Tk_CreateBinding procedure: append} -body {
   314      canvas .t.c
   315      .t.c bind foo <1> "button 1"
   316      .t.c bind foo <1> "+more button 1"
   317      .t.c bind foo <1>
   318  } -cleanup {
   319      destroy .t.c
   320  } -result {button 1
   321  more button 1}
   322  test bind-7.4 {Tk_CreateBinding procedure: append to non-existing} -body {
   323      canvas .t.c
   324      .t.c bind foo <1> "+button 1"
   325      .t.c bind foo <1>
   326  } -cleanup {
   327      destroy .t.c
   328  } -result {button 1}
   329  
   330  test bind-8.1 {Tk_CreateBinding: error} -body {
   331      bind . <xyz> "xyz"
   332  } -returnCodes error -result {bad event type or keysym "xyz"}
   333  
   334  test bind-9.1 {Tk_DeleteBinding procedure} -body {
   335      frame .t.f -class Test -width 150 -height 100
   336      bind .t.f <
   337  } -cleanup {
   338      destroy .t.f
   339  } -returnCodes ok
   340  test bind-9.2 {Tk_DeleteBinding procedure} -setup {
   341      set result {}
   342  } -body {
   343      frame .t.f -class Test -width 150 -height 100
   344      foreach i {a b c d} {
   345          bind .t.f $i "binding for $i"
   346      }
   347      foreach i {b d a c} {
   348          bind .t.f $i {}
   349          lappend result [lsort [bind .t.f]]
   350      }
   351      return $result
   352  } -cleanup {
   353      destroy .t.f
   354  } -result {{a c d} {a c} c {}}
   355  test bind-9.3 {Tk_DeleteBinding procedure} -setup {
   356      set result {}
   357  } -body {
   358      frame .t.f -class Test -width 150 -height 100
   359      foreach i {<1> <Meta-1> <Control-1> <Double-Alt-1>} {
   360          bind .t.f $i "binding for $i"
   361      }
   362      foreach i {<Control-1> <Double-Alt-1> <1> <Meta-1>} {
   363          bind .t.f $i {}
   364          lappend result [lsort [bind .t.f]]
   365      }
   366      return $result
   367  } -cleanup {
   368      destroy .t.f
   369  } -result {{<Button-1> <Double-Alt-Button-1> <Meta-Button-1>} {<Button-1> <Meta-Button-1>} <Meta-Button-1> {}}
   370  
   371  test bind-10.1 {Tk_GetBinding procedure} -body {
   372      canvas .t.c
   373      .t.c bind foo <
   374  } -cleanup {
   375      destroy .t.c
   376  } -returnCodes error -result {no event type or button # or keysym}
   377  test bind-10.2 {Tk_GetBinding procedure} -body {
   378      canvas .t.c
   379      .t.c bind foo a Test
   380      .t.c bind foo a
   381  } -cleanup {
   382      destroy .t.c
   383  } -result {Test}
   384  
   385  test bind-11.1 {Tk_GetAllBindings procedure} -body {
   386      frame .t.f 
   387      foreach i "! a \\\{ ~ <Delete> <space> <<Paste>> <Tab> <Linefeed> <less> <Meta-a> <Acircumflex>" {
   388          bind .t.f $i Test
   389      }
   390      lsort [bind .t.f]
   391  } -cleanup {
   392      destroy .t.f
   393  } -result {! <<Paste>> <Key-Acircumflex> <Key-Delete> <Key-Linefeed> <Key-Tab> <Key-less> <Key-space> <Meta-Key-a> a \{ ~}
   394  test bind-11.2 {Tk_GetAllBindings procedure} -body {
   395      frame .t.f 
   396      foreach i "<Double-1> <Triple-1> <Meta-Control-a> <Double-Alt-Enter> <1>" {
   397          bind .t.f $i Test
   398      }
   399      lsort [bind .t.f]
   400  } -cleanup {
   401      destroy .t.f
   402  } -result {<Button-1> <Control-Meta-Key-a> <Double-Alt-Enter> <Double-Button-1> <Triple-Button-1>}
   403  test bind-11.3 {Tk_GetAllBindings procedure} -body {
   404      frame .t.f 
   405      foreach i "<Double-Triple-1> abcd a<Leave>b" {
   406          bind .t.f $i Test
   407      }
   408      lsort [bind .t.f]
   409  } -cleanup {
   410      destroy .t.f
   411  } -result {<Triple-Button-1> a<Leave>b abcd}
   412  
   413  
   414  test bind-12.1 {Tk_DeleteAllBindings procedure} -body {
   415      frame .t.f -class Test -width 150 -height 100
   416      destroy .t.f
   417  } -result {}
   418  test bind-12.2 {Tk_DeleteAllBindings procedure} -body {
   419      frame .t.f -class Test -width 150 -height 100
   420      foreach i "a b c <Meta-1> <Alt-a> <Control-a>" {
   421          bind .t.f $i x
   422      }
   423      destroy .t.f
   424  } -result {}
   425  
   426  test bind-13.1 {Tk_BindEvent procedure} -setup {
   427      frame .t.f -class Test -width 150 -height 100
   428      pack .t.f
   429      focus -force .t.f
   430      update
   431      set x {}
   432  } -body {
   433      bind Test <KeyPress> {lappend x "%W %K Test KeyPress"}
   434      bind all <KeyPress> {lappend x "%W %K all KeyPress"}
   435      bind Test : {lappend x "%W %K Test :"}
   436      bind all  _ {lappend x "%W %K all _"}
   437      bind .t.f : {lappend x "%W %K .t.f :"}
   438      
   439      event generate .t.f <Key-colon>
   440      event generate .t.f <Key-plus>
   441      event generate .t.f <Key-underscore>
   442      return $x
   443  } -cleanup {
   444      destroy .t.f
   445      bind all <KeyPress> {}
   446      bind Test <KeyPress> {}
   447      bind all _ {}
   448      bind Test : {}
   449  } -result {{.t.f colon .t.f :} {.t.f colon Test :} {.t.f colon all KeyPress} {.t.f plus Test KeyPress} {.t.f plus all KeyPress} {.t.f underscore Test KeyPress} {.t.f underscore all _}}
   450  
   451  test bind-13.2 {Tk_BindEvent procedure} -setup {
   452      frame .t.f -class Test -width 150 -height 100
   453      pack .t.f
   454      focus -force .t.f
   455      update
   456      set x {}
   457  } -body {
   458      bind Test <KeyPress> {lappend x "%W %K Test press any"; break}
   459      bind all <KeyPress> {continue; lappend x "%W %K all press any"}
   460      bind .t.f : {lappend x "%W %K .t.f pressed colon"}
   461      
   462      event generate .t.f <Key-colon>
   463      return $x
   464  } -cleanup {
   465      destroy .t.f
   466      bind all <KeyPress> {}
   467      bind Test <KeyPress> {}
   468  } -result {{.t.f colon .t.f pressed colon} {.t.f colon Test press any}}
   469  
   470  test bind-13.3 {Tk_BindEvent procedure} -setup {
   471      proc bgerror args {}
   472      frame .t.f -class Test -width 150 -height 100
   473      pack .t.f
   474      focus -force .t.f
   475      update
   476      set x {}
   477  } -body {
   478      bind Test <KeyPress> {lappend x "%W %K Test press any"; error Test}
   479      bind .t.f : {lappend x "%W %K .t.f pressed colon"}
   480      event generate .t.f <Key-colon>
   481      update
   482      list $x $errorInfo
   483  } -cleanup {
   484      destroy .t.f
   485      bind Test <KeyPress> {}
   486      rename bgerror {}
   487  }  -result {{{.t.f colon .t.f pressed colon} {.t.f colon Test press any}} {Test
   488      while executing
   489  "error Test"
   490      (command bound to event)}}
   491  test bind-13.4 {Tk_BindEvent procedure} -setup {
   492      proc foo {} {
   493          set x 44
   494          event generate .t.f <Key-colon>
   495      }
   496      frame .t.f -class Test -width 150 -height 100
   497      pack .t.f
   498      focus -force .t.f
   499      update
   500      set x {}
   501  } -body {
   502      bind Test : {lappend x "%W %K Test"}
   503      bind .t.f : {lappend x "%W %K .t.f"}
   504      foo
   505      return $x
   506  } -cleanup {
   507      destroy .t.f
   508      bind Test : {}
   509  } -result {{.t.f colon .t.f} {.t.f colon Test}}
   510  
   511  test bind-13.5 {Tk_BindEvent procedure} -body {
   512      bind all <Destroy> {lappend x "%W destroyed"}
   513      set x {}
   514      frame .t.g -gorp foo
   515  } -cleanup {
   516      bind all <Destroy> {}
   517  } -returnCodes error -result {unknown option "-gorp"} 
   518  test bind-13.6 {Tk_BindEvent procedure} -body {
   519      bind all <Destroy> {lappend x "%W destroyed"}
   520      set x {}
   521      catch {frame .t.g -gorp foo} 
   522      return $x
   523  } -cleanup {
   524      bind all <Destroy> {}
   525  } -result {{.t.g destroyed}}
   526  
   527  test bind-13.7 {Tk_BindEvent procedure} -setup {
   528      frame .t.f -class Test -width 150 -height 100
   529      pack .t.f
   530      focus -force .t.f
   531      update
   532      set x {}
   533  } -body {
   534      bind .t.f : {lappend x "%W (.t.f binding)"}
   535      bind Test : {lappend x "%W (Test binding)"}
   536      bind all : {bind .t.f : {}; lappend x "%W (all binding)"}
   537      event generate .t.f <Key-colon>
   538      return $x
   539  } -cleanup {
   540      bind Test : {}
   541      bind all : {}
   542      destroy .t.f
   543  } -result {{.t.f (.t.f binding)} {.t.f (Test binding)} {.t.f (all binding)}}
   544  test bind-13.8 {Tk_BindEvent procedure} -setup {
   545      frame .t.f -class Test -width 150 -height 100
   546      pack .t.f
   547      focus -force .t.f
   548      update
   549      set x {}
   550  } -body {
   551      bind .t.f : {lappend x "%W (.t.f binding)"}
   552      bind Test : {lappend x "%W (Test binding)"}
   553      bind all : {destroy .t.f; lappend x "%W (all binding)"}
   554      event generate .t.f <Key-colon>
   555      return $x
   556  } -cleanup {
   557      bind Test : {}
   558      bind all : {}
   559      destroy .t.f
   560  } -result {{.t.f (.t.f binding)} {.t.f (Test binding)} {.t.f (all binding)}}
   561  
   562  test bind-13.9 {Tk_BindEvent procedure} -setup {
   563      frame .t.f -class Test -width 150 -height 100
   564      pack .t.f
   565      focus -force .t.f
   566      update
   567      set x {}
   568  } -body {
   569      bind .t.f <1> {lappend x "%W z (.t.f <1> binding)"}
   570      bind .t.f <ButtonPress> {lappend x "%W z (.t.f <ButtonPress> binding)"}
   571      event generate .t.f <Button-1>
   572      event generate .t.f <Button-2>
   573      return $x
   574  } -cleanup {
   575      destroy .t.f
   576  } -result {{.t.f z (.t.f <1> binding)} {.t.f z (.t.f <ButtonPress> binding)}}
   577  test bind-13.10 {Tk_BindEvent procedure: ignore NotifyInferior} -setup {
   578      frame .t.f -class Test -width 150 -height 100
   579      pack .t.f
   580      focus -force .t.f
   581      update
   582      set x {}
   583  } -body {
   584      bind .t.f <Enter> "lappend x Enter%#"
   585      bind .t.f <Leave> "lappend x Leave%#"
   586      event generate .t.f <Enter> -serial 100 -detail NotifyAncestor
   587      event generate .t.f <Enter> -serial 101 -detail NotifyInferior
   588      event generate .t.f <Leave> -serial 102 -detail NotifyAncestor
   589      event generate .t.f <Leave> -serial 103 -detail NotifyInferior
   590      return $x
   591  } -cleanup {
   592      destroy .t.f
   593  } -result {Enter100 Leave102}
   594  test bind-13.11 {Tk_BindEvent procedure: collapse Motions} -setup {
   595      frame .t.f -class Test -width 150 -height 100
   596      pack .t.f
   597      focus -force .t.f
   598      update
   599      set x {}
   600  } -body {
   601      bind .t.f <Motion> "lappend x Motion%#(%x,%y)"
   602      event generate .t.f <Motion> -serial 100 -x 100 -y 200 -when tail 
   603      update
   604      event generate .t.f <Motion> -serial 101 -x 200 -y 300 -when tail
   605      event generate .t.f <Motion> -serial 102 -x 300 -y 400 -when tail 
   606      update
   607      return $x
   608  } -cleanup {
   609      destroy .t.f
   610  } -result {Motion100(100,200) Motion102(300,400)}
   611  test bind-13.12 {Tk_BindEvent procedure: collapse repeating modifiers} -setup {
   612      frame .t.f -class Test -width 150 -height 100
   613      pack .t.f
   614      focus -force .t.f
   615      update
   616  } -body {
   617      bind .t.f <Key> "lappend x %K%#"
   618      bind .t.f <KeyRelease> "lappend x %K%#"
   619      event generate .t.f <Key-Shift_L> -serial 100 -when tail 
   620      event generate .t.f <KeyRelease-Shift_L> -serial 101 -when tail 
   621      event generate .t.f <Key-Shift_L> -serial 102 -when tail 
   622      event generate .t.f <KeyRelease-Shift_L> -serial 103 -when tail 
   623      update
   624  } -cleanup {
   625      destroy .t.f
   626  } -result {}
   627  test bind-13.13 {Tk_BindEvent procedure: valid key detail} -setup {
   628      frame .t.f -class Test -width 150 -height 100
   629      pack .t.f
   630      focus -force .t.f
   631      update
   632      set x {}
   633  } -body {
   634      bind .t.f <Key> "lappend x Key%K"
   635      bind .t.f <KeyRelease> "lappend x Release%K"
   636      event generate .t.f <Key> -keysym colon
   637      event generate .t.f <KeyRelease> -keysym colon
   638      return $x
   639  } -cleanup {
   640      destroy .t.f
   641  } -result {Keycolon Releasecolon}
   642  test bind-13.14 {Tk_BindEvent procedure: invalid key detail} -setup {
   643      frame .t.f -class Test -width 150 -height 100
   644      pack .t.f
   645      focus -force .t.f
   646      update
   647      set x {}
   648  } -body {
   649      bind .t.f <Key> "lappend x Key%K"
   650      bind .t.f <KeyRelease> "lappend x Release%K"
   651      event generate .t.f <Key> -keycode -1
   652      event generate .t.f <KeyRelease> -keycode -1
   653      return $x
   654  } -cleanup {
   655      destroy .t.f
   656  } -result {Key?? Release??}
   657  test bind-13.15 {Tk_BindEvent procedure: button detail} -setup {
   658      frame .t.f -class Test -width 150 -height 100
   659      pack .t.f
   660      focus -force .t.f
   661      update
   662      set x {}
   663  } -body {
   664      bind .t.f <Button> "lappend x Button%b"
   665      bind .t.f <ButtonRelease> "lappend x Release%b"
   666      event generate .t.f <Button> -button 1
   667      event generate .t.f <ButtonRelease> -button 3
   668      set x
   669  } -cleanup {
   670      destroy .t.f
   671  } -result {Button1 Release3}
   672  test bind-13.16 {Tk_BindEvent procedure: virtual detail} -setup {
   673      frame .t.f -class Test -width 150 -height 100
   674      pack .t.f
   675      focus -force .t.f
   676      update
   677      set x {}
   678  } -body {
   679      bind .t.f <<Paste>> "lappend x Paste"
   680      event generate .t.f <<Paste>>
   681      return $x
   682  } -cleanup {
   683      destroy .t.f
   684  } -result {Paste}
   685  test bind-13.17 {Tk_BindEvent procedure: virtual event in event stream} -setup {
   686      frame .t.f -class Test -width 150 -height 100
   687      pack .t.f
   688      focus -force .t.f
   689      update
   690      set x {}
   691  } -body {
   692      bind .t.f <<Paste>> "lappend x Paste"
   693      event generate .t.f <<Paste>>
   694      return $x
   695  } -cleanup {
   696      destroy .t.f
   697  } -result {Paste}
   698  test bind-13.18 {Tk_BindEvent procedure: match detail physical} -setup {
   699      frame .t.f -class Test -width 150 -height 100
   700      pack .t.f
   701      focus -force .t.f
   702      update
   703      set x {}
   704  } -body {
   705      bind .t.f <Button-2> {set x Button-2}
   706      event add <<Paste>> <Button-2>
   707      bind .t.f <<Paste>> {set x Paste}
   708      event generate .t.f <Button-2>
   709      return $x
   710  } -cleanup {
   711      destroy .t.f
   712      event delete <<Paste>> <Button-2>
   713  } -result {Button-2}
   714  
   715  test bind-13.19 {Tk_BindEvent procedure: no match detail physical} -setup {
   716      frame .t.f -class Test -width 150 -height 100
   717      pack .t.f
   718      focus -force .t.f
   719      update
   720      set x {}
   721  } -body {
   722      event add <<Paste>> <Button-2>
   723      bind .t.f <<Paste>> {set x Paste}
   724      event generate .t.f <Button-2>
   725      return $x
   726  } -cleanup {
   727      destroy .t.f
   728      event delete <<Paste>> <Button-2>
   729  } -result {Paste}
   730  test bind-13.20 {Tk_BindEvent procedure: match detail virtual} -setup {
   731      frame .t.f -class Test -width 150 -height 100
   732      pack .t.f
   733      focus -force .t.f
   734      update
   735      set x {}
   736  } -body {
   737      event add <<Paste>> <Button-2>
   738      bind .t.f <<Paste>> "lappend x Paste"
   739      event generate .t.f <Button-2>
   740      return $x
   741  } -cleanup {
   742      destroy .t.f
   743      event delete <<Paste>> <Button-2>
   744  } -result {Paste}
   745  test bind-13.21 {Tk_BindEvent procedure: no match detail virtual} -setup {
   746      frame .t.f -class Test -width 150 -height 100
   747      pack .t.f
   748      focus -force .t.f
   749      update
   750      set x {}
   751  } -body {
   752      event add <<Paste>> <Button-2>
   753      bind .t.f <<Paste>> "lappend x Paste"
   754      event generate .t.f <Button>
   755      return $x
   756  } -cleanup {
   757      destroy .t.f
   758      event delete <<Paste>> <Button-2>
   759  } -result {}
   760  test bind-13.22 {Tk_BindEvent procedure: match no-detail physical} -setup {
   761      frame .t.f -class Test -width 150 -height 100
   762      pack .t.f
   763      focus -force .t.f
   764      update
   765      set x {}
   766  } -body {
   767      bind .t.f <Button> {set x Button}
   768      event add <<Paste>> <Button>
   769      bind .t.f <<Paste>> {set x Paste}
   770      event generate .t.f <Button-2>
   771      return $x
   772  } -cleanup {
   773      destroy .t.f
   774      event delete <<Paste>> <Button>
   775  } -result {Button}
   776  test bind-13.23 {Tk_BindEvent procedure: no match no-detail physical} -setup {
   777      frame .t.f -class Test -width 150 -height 100
   778      pack .t.f
   779      focus -force .t.f
   780      update
   781      set x {}
   782  } -body {
   783      event add <<Paste>> <Button>
   784      bind .t.f <<Paste>> {set x Paste}
   785      event generate .t.f <Button-2>
   786      return $x
   787  } -cleanup {
   788      destroy .t.f
   789      event delete <<Paste>> <Button>
   790  } -result {Paste}
   791  test bind-13.24 {Tk_BindEvent procedure: match no-detail virtual} -setup {
   792      frame .t.f -class Test -width 150 -height 100
   793      pack .t.f
   794      focus -force .t.f
   795      update
   796      set x {}
   797  } -body {
   798      event add <<Paste>> <Button>
   799      bind .t.f <<Paste>> "lappend x Paste"
   800      event generate .t.f <Button-2>
   801      return $x
   802  } -cleanup {
   803      destroy .t.f
   804      event delete <<Paste>> <Button>
   805  } -result {Paste}
   806  test bind-13.25 {Tk_BindEvent procedure: no match no-detail virtual} -setup {
   807      frame .t.f -class Test -width 150 -height 100
   808      pack .t.f
   809      focus -force .t.f
   810      update
   811      set x {}
   812  } -body {
   813      event add <<Paste>> <Key>
   814      bind .t.f <<Paste>> "lappend x Paste"
   815      event generate .t.f <Button>
   816      return $x
   817  } -cleanup {
   818      destroy .t.f
   819      event delete <<Paste>> <Key>
   820  } -result {}
   821  test bind-13.26 {Tk_BindEvent procedure: precedence} -setup {
   822      frame .t.f -class Test -width 150 -height 100
   823      pack .t.f
   824      focus -force .t.f
   825      update
   826      set x {}
   827  } -body {
   828      event add <<Paste>> <Button-2>
   829      event add <<Copy>> <Button>
   830      bind .t.f <Button-2> "lappend x Button-2"
   831      bind .t.f <<Paste>> "lappend x Paste"
   832      bind .t.f <Button> "lappend x Button"
   833      bind .t.f <<Copy>> "lappend x Copy"
   834  
   835      event generate .t.f <Button-2>
   836      bind .t.f <Button-2> {}
   837      event generate .t.f <Button-2>
   838      bind .t.f <<Paste>> {}
   839      event generate .t.f <Button-2>
   840      bind .t.f <Button> {}
   841      event generate .t.f <Button-2>
   842      bind .t.f <<Copy>> {}
   843      event generate .t.f <Button-2>
   844      return $x
   845  } -cleanup {
   846      destroy .t.f
   847      event delete <<Paste>> <Button-2>
   848      event delete <<Copy>> <Button>
   849  } -result {Button-2 Paste Button Copy}
   850  test bind-13.27 {Tk_BindEvent procedure: no detail virtual pattern list} -setup {
   851      frame .t.f -class Test -width 150 -height 100
   852      pack .t.f
   853      focus -force .t.f
   854      update
   855      set x {}
   856  } -body {
   857      bind .t.f <Button-2> {set x Button-2}
   858      event generate .t.f <Button-2> 
   859      return $x
   860  } -cleanup {
   861      destroy .t.f
   862  } -result {Button-2}
   863  test bind-13.28 {Tk_BindEvent procedure: detail virtual pattern list} -setup {
   864      frame .t.f -class Test -width 150 -height 100
   865      pack .t.f
   866      focus -force .t.f
   867      update
   868      set x {}
   869  } -body {
   870      event add <<Paste>> <Button-2>
   871      bind .t.f <<Paste>> {set x Paste}
   872      event generate .t.f <Button-2>
   873      return $x
   874  } -cleanup {
   875      destroy .t.f
   876      event delete <<Paste>> <Button-2>
   877  } -result {Paste}
   878  test bind-13.29 {Tk_BindEvent procedure: no no-detail virtual pattern list} -setup {
   879      frame .t.f -class Test -width 150 -height 100
   880      pack .t.f
   881      focus -force .t.f
   882      update
   883      set x {}
   884  } -body {
   885      bind .t.f <Button> {set x Button}
   886      event generate .t.f <Button-2>
   887      return $x
   888  } -cleanup {
   889      destroy .t.f
   890  } -result {Button}
   891  test bind-13.30 {Tk_BindEvent procedure: no-detail virtual pattern list} -setup {
   892      frame .t.f -class Test -width 150 -height 100
   893      pack .t.f
   894      focus -force .t.f
   895      update
   896      set x {}
   897  } -body {
   898      event add <<Paste>> <Button>
   899      bind .t.f <<Paste>> {set x Paste}
   900      event generate .t.f <Button-2>
   901      return $x
   902  } -cleanup {
   903      destroy .t.f
   904      event delete <<Paste>> <Button>
   905  } -result {Paste}
   906  test bind-13.31 {Tk_BindEvent procedure: no match} -setup {
   907      frame .t.f -class Test -width 150 -height 100
   908      pack .t.f
   909      focus -force .t.f
   910      update
   911  } -body {
   912      event generate .t.f <Button-2>
   913  } -cleanup {
   914      destroy .t.f
   915  } -result {}
   916  test bind-13.32 {Tk_BindEvent procedure: match} -setup {
   917      frame .t.f -class Test -width 150 -height 100
   918      pack .t.f
   919      focus -force .t.f
   920      update
   921      set x {}
   922  } -body {
   923      bind .t.f <Button-2> {set x Button-2}
   924      event generate .t.f <Button-2>
   925      return $x
   926  } -cleanup {
   927      destroy .t.f
   928  } -result {Button-2}
   929  test bind-13.33 {Tk_BindEvent procedure: many C bindings cause realloc} -setup {
   930      # this test might not be useful anymore [#3009998]
   931      frame .t.f -class Test -width 150 -height 100
   932      pack .t.f
   933      focus -force .t.f
   934      update
   935      set x {}
   936  } -body {
   937      bindtags .t.f {a b c d e f g h i j k l m n o p}
   938      foreach p [bindtags .t.f] {
   939          bind $p <1> "lappend x $p"
   940      }
   941      event generate .t.f <1>
   942      return $x
   943  } -cleanup {
   944      foreach p [bindtags .t.f] {bind $p <1> {}}
   945      destroy .t.f
   946  } -result {a b c d e f g h i j k l m n o p}
   947  test bind-13.34 {Tk_BindEvent procedure: multiple tags} -setup {
   948      frame .t.f -class Test -width 150 -height 100
   949      pack .t.f
   950      focus -force .t.f
   951      update
   952      set x {}
   953  } -body {
   954      bind .t.f <Button-2> {lappend x .t.f}
   955      bind Test <Button-2> {lappend x Button}
   956      event generate .t.f <Button-2>
   957      return $x
   958  } -cleanup {
   959      destroy .t.f
   960      bind Test <Button-2> {}
   961  } -result {.t.f Button}
   962  test bind-13.35 {Tk_BindEvent procedure: execute binding} -setup {
   963      frame .t.f -class Test -width 150 -height 100
   964      pack .t.f
   965      focus -force .t.f
   966      update
   967      set x {}
   968  } -body {
   969      bind .t.f <1> {lappend x 1}
   970      event generate .t.f <1>
   971      return $x
   972  } -cleanup {
   973      destroy .t.f
   974  } -result {1}
   975  test bind-13.38 {Tk_BindEvent procedure: binding gets to run} -setup {
   976      frame .t.f -class Test -width 150 -height 100
   977      pack .t.f
   978      focus -force .t.f
   979      update
   980      set x {}
   981  } -body {
   982      bind Test <1> {lappend x Test}
   983      bind .t.f <1> {lappend x .t.f}
   984      event generate .t.f <1>
   985      return $x
   986  } -cleanup {
   987      destroy .t.f
   988      bind Test <1> {}
   989  } -result {.t.f Test}
   990  test bind-13.41 {Tk_BindEvent procedure: continue in script} -setup {
   991      frame .t.f -class Test -width 150 -height 100
   992      pack .t.f
   993      focus -force .t.f
   994      update
   995      set x {}
   996  } -body {
   997      bind .t.f <Button-2> {lappend x b1; continue; lappend x b2}
   998      bind Test <Button-2> {lappend x B1; continue; lappend x B2}
   999      event generate .t.f <Button-2>
  1000      return $x
  1001  } -cleanup {
  1002      destroy .t.f
  1003      bind Test <Button-2> {}
  1004  } -result {b1 B1}
  1005  test bind-13.43 {Tk_BindEvent procedure: break in script} -setup {
  1006      frame .t.f -class Test -width 150 -height 100
  1007      pack .t.f
  1008      focus -force .t.f
  1009      update
  1010      set x {}
  1011  } -body {
  1012      bind .t.f <Button-2> {lappend x b1; break; lappend x b2}
  1013      bind Test <Button-2> {lappend x B1; break; lappend x B2}
  1014      event generate .t.f <Button-2>
  1015      return $x
  1016  } -cleanup {
  1017      destroy .t.f
  1018      bind Test <Button-2> {}
  1019  } -result  {b1}
  1020  test bind-13.45 {Tk_BindEvent procedure: error in script} -setup {
  1021      proc bgerror msg {
  1022          global x 
  1023          lappend x $msg
  1024      }
  1025      frame .t.f -class Test -width 150 -height 100
  1026      pack .t.f
  1027      focus -force .t.f
  1028      update
  1029      set x {}
  1030  } -body {
  1031      bind .t.f <Button-2> {lappend x b1; blap}
  1032      bind Test <Button-2> {lappend x B1}
  1033      event generate .t.f <Button-2>
  1034      update
  1035      return $x
  1036  } -cleanup {
  1037      destroy .t.f
  1038      bind Test <Button-2> {}
  1039      proc bgerror args {}
  1040  } -result {b1 {invalid command name "blap"}}
  1041  
  1042  test bind-15.1 {MatchPatterns procedure, ignoring type mismatches} -setup {
  1043      frame .t.f -class Test -width 150 -height 100
  1044      pack .t.f
  1045      focus -force .t.f
  1046      update
  1047  } -body {
  1048      bind .t.f 12 {set x 1}
  1049      set x 0
  1050      event generate .t.f <Key-1>
  1051      event generate .t.f <KeyRelease-1>
  1052      event generate .t.f <Key-2>
  1053      event generate .t.f <KeyRelease-2>
  1054      return $x
  1055  } -cleanup {
  1056      destroy .t.f
  1057  } -result {1}
  1058  test bind-15.2 {MatchPatterns procedure, ignoring type mismatches} -setup {
  1059      frame .t.f -class Test -width 150 -height 100
  1060      pack .t.f
  1061      focus -force .t.f
  1062      update
  1063  } -body {
  1064      bind .t.f 12 {set x 1}
  1065      set x 0
  1066      event generate .t.f <Key-1>
  1067      event generate .t.f <Enter>
  1068      event generate .t.f <KeyRelease-1>
  1069      event generate .t.f <Leave>
  1070      event generate .t.f <Key-2>
  1071      event generate .t.f <KeyRelease-2>
  1072      return $x
  1073  } -cleanup {
  1074      destroy .t.f
  1075  } -result {1}
  1076  test bind-15.3 {MatchPatterns procedure, ignoring type mismatches} -setup {
  1077      frame .t.f -class Test -width 150 -height 100
  1078      pack .t.f
  1079      focus -force .t.f
  1080      update
  1081  } -body {
  1082      bind .t.f 12 {set x 1}
  1083      set x 0
  1084      event generate .t.f <Key-1>
  1085      event generate .t.f <Button-1>
  1086      event generate .t.f <Key-2>
  1087      return $x
  1088  } -cleanup {
  1089      destroy .t.f
  1090  } -result {0}
  1091  test bind-15.4 {MatchPatterns procedure, ignoring type mismatches} -setup {
  1092      frame .t.f -class Test -width 150 -height 100
  1093      pack .t.f
  1094      focus -force .t.f
  1095      update
  1096  } -body {
  1097      bind .t.f <Double-1> {set x 1}
  1098      set x 0
  1099      event generate .t.f <Button-1>
  1100      event generate .t.f <ButtonRelease-1>
  1101      event generate .t.f <Button-1>
  1102      event generate .t.f <ButtonRelease-1>
  1103      return $x
  1104  } -cleanup {
  1105      destroy .t.f
  1106  } -result {1}
  1107  test bind-15.5 {MatchPatterns procedure, ignoring type mismatches} -setup {
  1108      frame .t.f -class Test -width 150 -height 100
  1109      pack .t.f
  1110      focus -force .t.f
  1111      update
  1112  } -body {
  1113      bind .t.f <Double-ButtonRelease> {set x 1}
  1114      set x 0
  1115      event generate .t.f <Button-1>
  1116      event generate .t.f <ButtonRelease-1>
  1117      event generate .t.f <Button-2>
  1118      event generate .t.f <ButtonRelease-2>
  1119      return $x
  1120  } -cleanup {
  1121      destroy .t.f
  1122  } -result {1}
  1123  test bind-15.6 {MatchPatterns procedure, ignoring type mismatches} -setup {
  1124      frame .t.f -class Test -width 150 -height 100
  1125      pack .t.f
  1126      focus -force .t.f
  1127      update
  1128  } -body {
  1129      bind .t.f <Double-1> {set x 1}
  1130      set x 0
  1131      event generate .t.f <Button-1>
  1132      event generate .t.f <Key-a>
  1133      event generate .t.f <ButtonRelease-1>
  1134      event generate .t.f <Button-1>
  1135      event generate .t.f <ButtonRelease-1>
  1136      return $x
  1137  } -cleanup {
  1138      destroy .t.f
  1139  } -result {0}
  1140  test bind-15.7 {MatchPatterns procedure, ignoring type mismatches} -setup {
  1141      frame .t.f -class Test -width 150 -height 100
  1142      pack .t.f
  1143      focus -force .t.f
  1144      update
  1145  } -body {
  1146      bind .t.f <Double-1> {set x 1}
  1147      set x 0
  1148      event generate .t.f <Button-1>
  1149      event generate .t.f <Key-Shift_L>
  1150      event generate .t.f <ButtonRelease-1>
  1151      event generate .t.f <Button-1>
  1152      event generate .t.f <ButtonRelease-1>
  1153      return $x
  1154  } -cleanup {
  1155      destroy .t.f
  1156  } -result {1}
  1157  test bind-15.8 {MatchPatterns procedure, ignoring type mismatches} -setup {
  1158      frame .t.f -class Test -width 150 -height 100
  1159      pack .t.f
  1160      focus -force .t.f
  1161      update
  1162  } -body {
  1163      bind .t.f ab {set x 1}
  1164      set x 0
  1165      event generate .t.f <Key-a>
  1166      event generate .t.f <Key-c>
  1167      event generate .t.f <Key-b>
  1168      return $x
  1169  } -cleanup {
  1170      destroy .t.f
  1171  } -result {0}
  1172  test bind-15.9 {MatchPatterns procedure, modifier checks} -setup {
  1173      frame .t.f -class Test -width 150 -height 100
  1174      pack .t.f
  1175      focus -force .t.f
  1176      update
  1177  } -body {
  1178      bind .t.f <M1-M2-Key> {set x 1}
  1179      set x 0
  1180      event generate .t.f <Key-a> -state 0x18
  1181      return $x
  1182  } -cleanup {
  1183      destroy .t.f
  1184  } -result {1}
  1185  test bind-15.10 {MatchPatterns procedure, modifier checks} -setup {
  1186      frame .t.f -class Test -width 150 -height 100
  1187      pack .t.f
  1188      focus -force .t.f
  1189      update
  1190  } -body {
  1191      bind .t.f <M1-M2-Key> {set x 1}
  1192      set x 0
  1193      event generate .t.f <Key-a> -state 0xfc
  1194      return $x
  1195  } -cleanup {
  1196      destroy .t.f
  1197  } -result {1}
  1198  test bind-15.11 {MatchPatterns procedure, modifier checks} -setup {
  1199      frame .t.f -class Test -width 150 -height 100
  1200      pack .t.f
  1201      focus -force .t.f
  1202      update
  1203  } -body {
  1204      bind .t.f <M1-M2-Key> {set x 1}
  1205      set x 0
  1206      event generate .t.f <Key-a> -state 0x8
  1207      return $x
  1208  } -cleanup {
  1209      destroy .t.f
  1210  } -result {0}
  1211  test bind-15.12 {MatchPatterns procedure, ignore modifier presses and releases} -constraints { 
  1212      nonPortable
  1213  } -setup {
  1214      frame .t.f -class Test -width 150 -height 100
  1215      pack .t.f
  1216      focus -force .t.f
  1217      update
  1218  } -body {
  1219      # This test is non-portable because the Shift_L keysym may behave
  1220      # differently on some platforms.
  1221      bind .t.f aB {set x 1}
  1222      set x 0
  1223      event generate .t.f <Key-a>
  1224      event generate .t.f <Key-Shift_L>
  1225      event generate .t.f <Key-b> -state 1
  1226      return $x
  1227  } -cleanup {
  1228      destroy .t.f
  1229  } -result {1}
  1230  test bind-15.13 {MatchPatterns procedure, checking detail} -setup {
  1231      frame .t.f -class Test -width 150 -height 100
  1232      pack .t.f
  1233      focus -force .t.f
  1234      update
  1235  } -body {
  1236      bind .t.f ab {set x 1}
  1237      set x 0
  1238      event generate .t.f <Key-a>
  1239      event generate .t.f <Key-c>
  1240      return $x
  1241  } -cleanup {
  1242      destroy .t.f
  1243  } -result {0}
  1244  test bind-15.14 {MatchPatterns procedure, checking "nearby"} -setup {
  1245      frame .t.f -class Test -width 150 -height 100
  1246      pack .t.f
  1247      focus -force .t.f
  1248      update
  1249  } -body {
  1250      bind .t.f <Double-1> {set x 1}
  1251      set x 0
  1252      event generate .t.f <Button-2> 
  1253      event generate .t.f <ButtonRelease-2>
  1254      event generate .t.f <Button-1> -x 30 -y 40
  1255      event generate .t.f <Button-1> -x 31 -y 39
  1256      event generate .t.f <ButtonRelease-1>
  1257      return $x
  1258  } -cleanup {
  1259      destroy .t.f
  1260  } -result {1}
  1261  test bind-15.15 {MatchPatterns procedure, checking "nearby"} -setup {
  1262      frame .t.f -class Test -width 150 -height 100
  1263      pack .t.f
  1264      focus -force .t.f
  1265      update
  1266  } -body {
  1267      bind .t.f <Double-1> {set x 1}
  1268      set x 0
  1269      event generate .t.f <Button-2> 
  1270      event generate .t.f <ButtonRelease-2>
  1271      event generate .t.f <Button-1> -x 30 -y 40
  1272      event generate .t.f <Button-1> -x 29 -y 41
  1273      event generate .t.f <ButtonRelease-1>
  1274      return $x
  1275  } -cleanup {
  1276      destroy .t.f
  1277  } -result {1}
  1278  test bind-15.16 {MatchPatterns procedure, checking "nearby"} -setup {
  1279      frame .t.f -class Test -width 150 -height 100
  1280      pack .t.f
  1281      focus -force .t.f
  1282      update
  1283  } -body {
  1284      bind .t.f <Double-1> {set x 1}
  1285      set x 0
  1286      event generate .t.f <Button-2> 
  1287      event generate .t.f <ButtonRelease-2>
  1288      event generate .t.f <Button-1> -x 30 -y 40
  1289      event generate .t.f <Button-1> -x 40 -y 40
  1290      event generate .t.f <ButtonRelease-2>
  1291      return $x
  1292  } -cleanup {
  1293      destroy .t.f
  1294  } -result {0}
  1295  test bind-15.17 {MatchPatterns procedure, checking "nearby"} -setup {
  1296      frame .t.f -class Test -width 150 -height 100
  1297      pack .t.f
  1298      focus -force .t.f
  1299      update
  1300  } -body {
  1301      bind .t.f <Double-1> {set x 1}
  1302      set x 0
  1303      event generate .t.f <Button-2> 
  1304      event generate .t.f <ButtonRelease-2>
  1305      event generate .t.f <Button-1> -x 30 -y 40
  1306      event generate .t.f <Button-1> -x 20 -y 40
  1307      event generate .t.f <ButtonRelease-1>
  1308      return $x
  1309  } -cleanup {
  1310      destroy .t.f
  1311  } -result {0}
  1312  test bind-15.18 {MatchPatterns procedure, checking "nearby"} -setup {
  1313      frame .t.f -class Test -width 150 -height 100
  1314      pack .t.f
  1315      focus -force .t.f
  1316      update
  1317  } -body {
  1318      bind .t.f <Double-1> {set x 1}
  1319      set x 0
  1320      event generate .t.f <Button-2> 
  1321      event generate .t.f <ButtonRelease-2>
  1322      event generate .t.f <Button-1> -x 30 -y 40
  1323      event generate .t.f <Button-1> -x 30 -y 30
  1324      event generate .t.f <ButtonRelease-1>
  1325      return $x
  1326  } -cleanup {
  1327      destroy .t.f
  1328  } -result {0}
  1329  test bind-15.19 {MatchPatterns procedure, checking "nearby"} -setup {
  1330      frame .t.f -class Test -width 150 -height 100
  1331      pack .t.f
  1332      focus -force .t.f
  1333      update
  1334  } -body {
  1335      bind .t.f <Double-1> {set x 1}
  1336      set x 0
  1337      event generate .t.f <Button-2> 
  1338      event generate .t.f <ButtonRelease-2>
  1339      event generate .t.f <Button-1> -x 30 -y 40
  1340      event generate .t.f <Button-1> -x 30 -y 50
  1341      event generate .t.f <ButtonRelease-1>
  1342      return $x
  1343  } -cleanup {
  1344      destroy .t.f
  1345  } -result {0}
  1346  test bind-15.20 {MatchPatterns procedure, checking "nearby"} -setup {
  1347      frame .t.f -class Test -width 150 -height 100
  1348      pack .t.f
  1349      focus -force .t.f
  1350      update
  1351  } -body {
  1352      bind .t.f <Double-1> {set x 1}
  1353      set x 0
  1354      event generate .t.f <Button-2> 
  1355      event generate .t.f <ButtonRelease-2>
  1356      event generate .t.f <Button-1> -time 300
  1357      event generate .t.f <Button-1> -time 700
  1358      event generate .t.f <ButtonRelease-1>
  1359      return $x
  1360  } -cleanup {
  1361      destroy .t.f
  1362  } -result {1}
  1363  test bind-15.21 {MatchPatterns procedure, checking "nearby"} -setup {
  1364      frame .t.f -class Test -width 150 -height 100
  1365      pack .t.f
  1366      focus -force .t.f
  1367      update
  1368  } -body {
  1369      bind .t.f <Double-1> {set x 1}
  1370      set x 0
  1371      event generate .t.f <Button-2> 
  1372      event generate .t.f <ButtonRelease-2>
  1373      event generate .t.f <Button-1> -time 300
  1374      event generate .t.f <Button-1> -time 900
  1375      event generate .t.f <ButtonRelease-1>
  1376      return $x
  1377  } -cleanup {
  1378      destroy .t.f
  1379  } -result {0}
  1380  test bind-15.22 {MatchPatterns procedure, time wrap-around} -setup {
  1381      frame .t.f -class Test -width 150 -height 100
  1382      pack .t.f
  1383      focus -force .t.f
  1384      update
  1385  } -body {
  1386      bind .t.f <Double-1> {set x 1}
  1387      set x 0
  1388      event generate .t.f <Button-1> -time -100
  1389      event generate .t.f <Button-1> -time 200
  1390      event generate .t.f <ButtonRelease-1>
  1391      return $x
  1392  } -cleanup {
  1393      destroy .t.f
  1394  } -result {1}
  1395  test bind-15.23 {MatchPatterns procedure, time wrap-around} -setup {
  1396      frame .t.f -class Test -width 150 -height 100
  1397      pack .t.f
  1398      focus -force .t.f
  1399      update
  1400  } -body {
  1401      bind .t.f <Double-1> {set x 1}
  1402      set x 0
  1403      event generate .t.f <Button-1> -time -100
  1404      event generate .t.f <Button-1> -time 500
  1405      event generate .t.f <ButtonRelease-1>
  1406      return $x
  1407  } -cleanup {
  1408      destroy .t.f
  1409  } -result {0}
  1410  test bind-15.24 {MatchPatterns procedure, virtual event} -setup {
  1411      frame .t.f -class Test -width 150 -height 100
  1412      pack .t.f
  1413      focus -force .t.f
  1414      update
  1415      set x {}
  1416  } -body {
  1417      event add <<Paste>> <Button-1>
  1418      bind .t.f <<Paste>> {lappend x paste}
  1419      event generate .t.f <Button-1>
  1420      event generate .t.f <ButtonRelease-1>
  1421      set x
  1422  } -cleanup {
  1423      destroy .t.f
  1424      event delete <<Paste>> <Button-1>
  1425  } -result {paste}
  1426  test bind-15.25 {MatchPatterns procedure, reject a  virtual event} -setup {
  1427      frame .t.f -class Test -width 150 -height 100
  1428      pack .t.f
  1429      focus -force .t.f
  1430      update
  1431      set x {}
  1432  } -body {
  1433      event add <<Paste>> <Shift-Button-1>
  1434      bind .t.f <<Paste>> {lappend x paste}
  1435      event generate .t.f <Button-1>
  1436      event generate .t.f <ButtonRelease-1>
  1437      set x
  1438  } -cleanup {
  1439      destroy .t.f
  1440      event delete <<Paste>> <Shift-Button-1>
  1441  } -result {}
  1442  test bind-15.26 {MatchPatterns procedure, reject a virtual event} -setup {
  1443      frame .t.f -class Test -width 150 -height 100
  1444      pack .t.f
  1445      focus -force .t.f
  1446      update
  1447      set x {}
  1448  } -body {
  1449      event add <<V1>> <Button>
  1450      event add <<V2>> <Button-1>
  1451      event add <<V3>> <Shift-Button-1>
  1452      bind .t.f <<V2>> "lappend x V2%#"
  1453      event generate .t.f <Button> -serial 101
  1454      event generate .t.f <Button-1> -serial 102
  1455      event generate .t.f <Shift-Button-1> -serial 103
  1456      event generate .t.f <ButtonRelease-1>
  1457      bind .t.f <Shift-Button-1> "lappend x Shift-Button-1"
  1458      event generate .t.f <Button> -serial 104
  1459      event generate .t.f <Button-1> -serial 105
  1460      event generate .t.f <Shift-Button-1> -serial 106
  1461      event generate .t.f <ButtonRelease-1>
  1462      set x
  1463  } -cleanup {
  1464      destroy .t.f
  1465      event delete <<V1>> <Button>
  1466      event delete <<V2>> <Button-1>
  1467      event delete <<V3>> <Shift-Button-1>
  1468  } -result {V2102 V2103 V2105 Shift-Button-1}
  1469  test bind-15.27 {MatchPatterns procedure, conflict resolution} -setup {
  1470      frame .t.f -class Test -width 150 -height 100
  1471      pack .t.f
  1472      focus -force .t.f
  1473      update
  1474  } -body {
  1475      bind .t.f <KeyPress> {set x 0}
  1476      bind .t.f 1 {set x 1}
  1477      set x none
  1478      event generate .t.f <Key-1>
  1479      return $x
  1480  } -cleanup {
  1481      destroy .t.f
  1482  } -result {1}
  1483  test bind-15.28 {MatchPatterns procedure, conflict resolution} -setup {
  1484      frame .t.f -class Test -width 150 -height 100
  1485      pack .t.f
  1486      focus -force .t.f
  1487      update
  1488  } -body {
  1489      bind .t.f <KeyPress> {set x 0}
  1490      bind .t.f 1 {set x 1}
  1491      set x none
  1492      event generate .t.f <Key-2>
  1493      return $x
  1494  } -cleanup {
  1495      destroy .t.f
  1496  } -result {0}
  1497  test bind-15.29 {MatchPatterns procedure, conflict resolution} -setup {
  1498      frame .t.f -class Test -width 150 -height 100
  1499      pack .t.f
  1500      focus -force .t.f
  1501      update
  1502  } -body {
  1503      bind .t.f <KeyPress> {lappend x 0}
  1504      bind .t.f 1 {lappend x 1}
  1505      bind .t.f 21 {lappend x 2}
  1506      set x none
  1507      event generate .t.f <Key-2>
  1508      event generate .t.f <KeyRelease-2>
  1509      event generate .t.f <Key-1>
  1510      set x
  1511  } -cleanup {
  1512      destroy .t.f
  1513  } -result {none 0 2}
  1514  test bind-15.30 {MatchPatterns procedure, conflict resolution} -setup {
  1515      frame .t.f -class Test -width 150 -height 100
  1516      pack .t.f
  1517      focus -force .t.f
  1518      update
  1519  } -body {
  1520      bind .t.f <ButtonPress> {set x 0}
  1521      bind .t.f <1> {set x 1}
  1522      set x none
  1523      event generate .t.f <Button-1>
  1524      event generate .t.f <ButtonRelease-1>
  1525      return $x
  1526  } -cleanup {
  1527      destroy .t.f
  1528  } -result {1}
  1529  test bind-15.31 {MatchPatterns procedure, conflict resolution} -setup {
  1530      frame .t.f -class Test -width 150 -height 100
  1531      pack .t.f
  1532      focus -force .t.f
  1533      update
  1534      set x {}
  1535  } -body {
  1536      bind .t.f <M1-Key> {set x 0}
  1537      bind .t.f <M2-Key> {set x 1}
  1538      event generate .t.f <Key-a> -state 0x18
  1539      return $x
  1540  } -cleanup {
  1541      destroy .t.f
  1542  } -result {1}
  1543  test bind-15.32 {MatchPatterns procedure, conflict resolution} -setup {
  1544      frame .t.f -class Test -width 150 -height 100
  1545      pack .t.f
  1546      focus -force .t.f
  1547      update
  1548  } -body {
  1549      bind .t.f <M2-Key> {set x 0}
  1550      bind .t.f <M1-Key> {set x 1}
  1551      set x none
  1552      event generate .t.f <Key-a> -state 0x18
  1553      return $x
  1554  } -cleanup {
  1555      destroy .t.f
  1556  } -result {1}
  1557  test bind-15.33 {MatchPatterns procedure, conflict resolution} -setup {
  1558      frame .t.f -class Test -width 150 -height 100
  1559      pack .t.f
  1560      focus -force .t.f
  1561      update
  1562      set x {}
  1563  } -body {
  1564      bind .t.f <1> {lappend x single}
  1565      bind Test <1> {lappend x single(Test)}
  1566      bind Test <Double-1> {lappend x double(Test)}
  1567      event generate .t.f <Button-1>
  1568      event generate .t.f <Button-1>
  1569      event generate .t.f <Button-1>
  1570      event generate .t.f <ButtonRelease-1>
  1571      set x
  1572  } -cleanup {
  1573      destroy .t.f
  1574      bind Test <1> {}
  1575      bind Test <Double-1> {}
  1576  } -result {single single(Test) single double(Test) single double(Test)}
  1577  
  1578  
  1579  test bind-16.1 {ExpandPercents procedure} -setup {
  1580      frame .t.f -class Test -width 150 -height 100
  1581      pack .t.f
  1582      focus -force .t.f
  1583      update
  1584  } -body {
  1585      bind .t.f <Enter> {set x abcd}
  1586      set x none
  1587      event generate .t.f <Enter>
  1588      set x
  1589  } -cleanup {
  1590      destroy .t.f
  1591  } -result {abcd}
  1592  test bind-16.2 {ExpandPercents procedure} -setup {
  1593      frame .t.f -class Test -width 150 -height 100
  1594      pack .t.f
  1595      focus -force .t.f
  1596      update
  1597  } -body {
  1598      bind .t.f <Enter> {set x %#}
  1599      set x none
  1600      event generate .t.f <Enter> -serial 1234
  1601      set x
  1602  } -cleanup {
  1603      destroy .t.f
  1604  } -result {1234}
  1605  test bind-16.3 {ExpandPercents procedure} -setup {
  1606      frame .t.f -class Test -width 150 -height 100
  1607      pack .t.f
  1608      focus -force .t.f
  1609      update
  1610  } -body {
  1611      bind .t.f <Configure> {set x %a}
  1612      set x none
  1613      event generate .t.f <Configure> -above .t -window .t.f
  1614      set x
  1615  } -cleanup {
  1616      destroy .t.f
  1617  } -result [winfo id .t]
  1618  test bind-16.4 {ExpandPercents procedure} -setup {
  1619      frame .t.f -class Test -width 150 -height 100
  1620      pack .t.f
  1621      focus -force .t.f
  1622      update
  1623  } -body {
  1624      bind .t.f <Button> {set x %b}
  1625      set x none
  1626      event generate .t.f <Button-3>
  1627      event generate .t.f <ButtonRelease-3>
  1628      set x
  1629  } -cleanup {
  1630      destroy .t.f
  1631  } -result {3}
  1632  test bind-16.5 {ExpandPercents procedure} -setup {
  1633      frame .t.f -class Test -width 150 -height 100
  1634      pack .t.f
  1635      focus -force .t.f
  1636      update
  1637  } -body {
  1638      bind .t.f <Expose> {set x %c}
  1639      set x none
  1640      event generate .t.f <Expose> -count 47
  1641      set x
  1642  } -cleanup {
  1643      destroy .t.f
  1644  } -result {47}
  1645  test bind-16.6 {ExpandPercents procedure} -setup {
  1646      frame .t.f -class Test -width 150 -height 100
  1647      pack .t.f
  1648      focus -force .t.f
  1649      update
  1650  } -body {
  1651      bind .t.f <Enter> {set x %d}
  1652      set x none
  1653      event generate .t.f <Enter> -detail NotifyAncestor
  1654      set x
  1655  } -cleanup {
  1656      destroy .t.f
  1657  } -result {NotifyAncestor}
  1658  test bind-16.7 {ExpandPercents procedure} -setup {
  1659      frame .t.f -class Test -width 150 -height 100
  1660      pack .t.f
  1661      focus -force .t.f
  1662      update
  1663  } -body {
  1664      bind .t.f <Enter> {set x %d}
  1665      set x none
  1666      event generate .t.f <Enter> -detail NotifyVirtual
  1667      set x
  1668  } -cleanup {
  1669      destroy .t.f
  1670  } -result {NotifyVirtual}
  1671  test bind-16.8 {ExpandPercents procedure} -setup {
  1672      frame .t.f -class Test -width 150 -height 100
  1673      pack .t.f
  1674      focus -force .t.f
  1675      update
  1676  } -body {
  1677      bind .t.f <Enter> {set x %d}
  1678      set x none
  1679      event generate .t.f <Enter> -detail NotifyNonlinear
  1680      set x
  1681  } -cleanup {
  1682      destroy .t.f
  1683  } -result {NotifyNonlinear}
  1684  test bind-16.9 {ExpandPercents procedure} -setup {
  1685      frame .t.f -class Test -width 150 -height 100
  1686      pack .t.f
  1687      focus -force .t.f
  1688      update
  1689  } -body {
  1690      bind .t.f <Enter> {set x %d}
  1691      set x none
  1692      event generate .t.f <Enter> -detail NotifyNonlinearVirtual
  1693      set x
  1694  } -cleanup {
  1695      destroy .t.f
  1696  } -result {NotifyNonlinearVirtual}
  1697  test bind-16.10 {ExpandPercents procedure} -setup {
  1698      frame .t.f -class Test -width 150 -height 100
  1699      pack .t.f
  1700      focus -force .t.f
  1701      update
  1702  } -body {
  1703      bind .t.f <Enter> {set x %d}
  1704      set x none
  1705      event generate .t.f <Enter> -detail NotifyPointer
  1706      set x
  1707  } -cleanup {
  1708      destroy .t.f
  1709  } -result {NotifyPointer}
  1710  test bind-16.11 {ExpandPercents procedure} -setup {
  1711      frame .t.f -class Test -width 150 -height 100
  1712      pack .t.f
  1713      focus -force .t.f
  1714      update
  1715  } -body {
  1716      bind .t.f <Enter> {set x %d}
  1717      set x none
  1718      event generate .t.f <Enter> -detail NotifyPointerRoot
  1719      set x
  1720  } -cleanup {
  1721      destroy .t.f
  1722  } -result {NotifyPointerRoot}
  1723  test bind-16.12 {ExpandPercents procedure} -setup {
  1724      frame .t.f -class Test -width 150 -height 100
  1725      pack .t.f
  1726      focus -force .t.f
  1727      update
  1728  } -body {
  1729      bind .t.f <Enter> {set x %d}
  1730      set x none
  1731      event generate .t.f <Enter> -detail NotifyDetailNone
  1732      set x
  1733  } -cleanup {
  1734      destroy .t.f
  1735  } -result {NotifyDetailNone}
  1736  test bind-16.13 {ExpandPercents procedure} -setup {
  1737      frame .t.f -class Test -width 150 -height 100
  1738      pack .t.f
  1739      focus -force .t.f
  1740      update
  1741  } -body {
  1742      bind .t.f <Enter> {set x %f}
  1743      set x none
  1744      event generate .t.f <Enter> -focus 1
  1745      return $x
  1746  } -cleanup {
  1747      destroy .t.f
  1748  } -result {1}
  1749  test bind-16.14 {ExpandPercents procedure} -setup {
  1750      frame .t.f -class Test -width 150 -height 100
  1751      pack .t.f
  1752      focus -force .t.f
  1753      update
  1754  } -body {
  1755      bind .t.f <Expose> {set x "%x %y %w %h"}
  1756      set x none
  1757      event generate .t.f <Expose> -x 24 -y 18 -width 147 -height 61
  1758      set x
  1759  } -cleanup {
  1760      destroy .t.f
  1761  } -result {24 18 147 61}
  1762  test bind-16.15 {ExpandPercents procedure} -setup {
  1763      frame .t.f -class Test -width 150 -height 100
  1764      pack .t.f
  1765      focus -force .t.f
  1766      update
  1767  } -body {
  1768      bind .t.f <Configure> {set x "%x %y %w %h"}
  1769      set x none
  1770      event generate .t.f <Configure> -x 24 -y 18 -width 147 -height 61 -window .t.f
  1771      set x
  1772  } -cleanup {
  1773      destroy .t.f
  1774  } -result {24 18 147 61}
  1775  test bind-16.16 {ExpandPercents procedure} -setup {
  1776      frame .t.f -class Test -width 150 -height 100
  1777      pack .t.f
  1778      focus -force .t.f
  1779      update
  1780  } -body {
  1781      bind .t.f <Key> {set x "%k"}
  1782      set x none
  1783      event generate .t.f <Key> -keycode 146
  1784      set x
  1785  } -cleanup {
  1786      destroy .t.f
  1787  } -result {146}
  1788  test bind-16.17 {ExpandPercents procedure} -setup {
  1789      frame .t.f -class Test -width 150 -height 100
  1790      pack .t.f
  1791      focus -force .t.f
  1792      update
  1793  } -body {
  1794      bind .t.f <Enter> {set x "%m"}
  1795      set x none
  1796      event generate .t.f <Enter> -mode NotifyNormal
  1797      set x
  1798  } -cleanup {
  1799      destroy .t.f
  1800  } -result {NotifyNormal}
  1801  test bind-16.18 {ExpandPercents procedure} -setup {
  1802      frame .t.f -class Test -width 150 -height 100
  1803      pack .t.f
  1804      focus -force .t.f
  1805      update
  1806  } -body {
  1807      bind .t.f <Enter> {set x "%m"}
  1808      set x none
  1809      event generate .t.f <Enter> -mode NotifyGrab
  1810      set x
  1811  } -cleanup {
  1812      destroy .t.f
  1813  } -result {NotifyGrab}
  1814  test bind-16.19 {ExpandPercents procedure} -setup {
  1815      frame .t.f -class Test -width 150 -height 100
  1816      pack .t.f
  1817      focus -force .t.f
  1818      update
  1819  } -body {
  1820      bind .t.f <Enter> {set x "%m"}
  1821      set x none
  1822      event generate .t.f <Enter> -mode NotifyUngrab
  1823      set x
  1824  } -cleanup {
  1825      destroy .t.f
  1826  } -result {NotifyUngrab}
  1827  test bind-16.20 {ExpandPercents procedure} -setup {
  1828      frame .t.f -class Test -width 150 -height 100
  1829      pack .t.f
  1830      focus -force .t.f
  1831      update
  1832      set x {}
  1833  } -body {
  1834      bind .t.f <Enter> {set x "%m"}
  1835      set x none
  1836      event generate .t.f <Enter> -mode NotifyWhileGrabbed
  1837      set x
  1838  } -cleanup {
  1839      destroy .t.f
  1840  } -result {NotifyWhileGrabbed}
  1841  test bind-16.21 {ExpandPercents procedure} -setup {
  1842      frame .t.f -class Test -width 150 -height 100
  1843      pack .t.f
  1844      focus -force .t.f
  1845      update
  1846  } -body {
  1847      bind .t.f <Map> {set x "%o"}
  1848      set x none
  1849      event generate .t.f <Map> -override 1 -window .t.f
  1850      return $x
  1851  } -cleanup {
  1852      destroy .t.f
  1853  } -result {1}
  1854  test bind-16.22 {ExpandPercents procedure} -setup {
  1855      frame .t.f -class Test -width 150 -height 100
  1856      pack .t.f
  1857      focus -force .t.f
  1858      update
  1859  } -body {
  1860      bind .t.f <Reparent> {set x "%o"}
  1861      set x none
  1862      event generate .t.f <Reparent> -override true -window .t.f
  1863      return $x
  1864  } -cleanup {
  1865      destroy .t.f
  1866  } -result {1}
  1867  test bind-16.23 {ExpandPercents procedure} -setup {
  1868      frame .t.f -class Test -width 150 -height 100
  1869      pack .t.f
  1870      focus -force .t.f
  1871      update
  1872  } -body {
  1873      bind .t.f <Configure> {set x "%o"}
  1874      set x none
  1875      event generate .t.f <Configure> -override 1 -window .t.f
  1876      return $x
  1877  } -cleanup {
  1878      destroy .t.f
  1879  } -result {1}
  1880  test bind-16.24 {ExpandPercents procedure} -setup {
  1881      frame .t.f -class Test -width 150 -height 100
  1882      pack .t.f
  1883      focus -force .t.f
  1884      update
  1885  } -body {
  1886      bind .t.f <Circulate> {set x "%p"}
  1887      set x none
  1888      event generate .t.f <Circulate> -place PlaceOnTop -window .t.f
  1889      set x
  1890  } -cleanup {
  1891      destroy .t.f
  1892  } -result {PlaceOnTop}
  1893  test bind-16.25 {ExpandPercents procedure} -setup {
  1894      frame .t.f -class Test -width 150 -height 100
  1895      pack .t.f
  1896      focus -force .t.f
  1897      update
  1898  } -body {
  1899      bind .t.f <Circulate> {set x "%p"}
  1900      set x none
  1901      event generate .t.f <Circulate> -place PlaceOnBottom -window .t.f
  1902      set x
  1903  } -cleanup {
  1904      destroy .t.f
  1905  } -result {PlaceOnBottom}
  1906  test bind-16.26 {ExpandPercents procedure} -setup {
  1907      frame .t.f -class Test -width 150 -height 100
  1908      pack .t.f
  1909      focus -force .t.f
  1910      update
  1911  } -body {
  1912      bind .t.f <1> {set x "%s"}
  1913      set x none
  1914      event generate .t.f <Button-1> -state 1402
  1915      event generate .t.f <ButtonRelease-1>
  1916      set x
  1917  } -cleanup {
  1918      destroy .t.f
  1919  } -result {1402}
  1920  test bind-16.27 {ExpandPercents procedure} -setup {
  1921      frame .t.f -class Test -width 150 -height 100
  1922      pack .t.f
  1923      focus -force .t.f
  1924      update
  1925  } -body {
  1926      bind .t.f <Enter> {set x "%s"}
  1927      set x none
  1928      event generate .t.f <Enter> -state 0x3ff
  1929      set x
  1930  } -cleanup {
  1931      destroy .t.f
  1932  } -result {1023}
  1933  test bind-16.28 {ExpandPercents procedure} -setup {
  1934      frame .t.f -class Test -width 150 -height 100
  1935      pack .t.f
  1936      focus -force .t.f
  1937      update
  1938  } -body {
  1939      bind .t.f <Visibility> {set x "%s"}
  1940      set x none
  1941      event generate .t.f <Visibility> -state VisibilityPartiallyObscured
  1942      set x
  1943  } -cleanup {
  1944      destroy .t.f
  1945  } -result {VisibilityPartiallyObscured}
  1946  test bind-16.29 {ExpandPercents procedure} -setup {
  1947      frame .t.f -class Test -width 150 -height 100
  1948      pack .t.f
  1949      focus -force .t.f
  1950      update
  1951  } -body {
  1952      bind .t.f <Visibility> {set x "%s"}
  1953      set x none
  1954      event generate .t.f <Visibility> -state VisibilityUnobscured
  1955      set x
  1956  } -cleanup {
  1957      destroy .t.f
  1958  } -result {VisibilityUnobscured}
  1959  test bind-16.30 {ExpandPercents procedure} -setup {
  1960      frame .t.f -class Test -width 150 -height 100
  1961      pack .t.f
  1962      focus -force .t.f
  1963      update
  1964  } -body {
  1965      bind .t.f <Visibility> {set x "%s"}
  1966      set x none
  1967      event generate .t.f <Visibility> -state VisibilityFullyObscured
  1968      set x
  1969  } -cleanup {
  1970      destroy .t.f
  1971  } -result {VisibilityFullyObscured}
  1972  test bind-16.31 {ExpandPercents procedure} -setup {
  1973      frame .t.f -class Test -width 150 -height 100
  1974      pack .t.f
  1975      focus -force .t.f
  1976      update
  1977  } -body {
  1978      bind .t.f <Button> {set x "%t"}
  1979      set x none
  1980      event generate .t.f <Button> -time 4294
  1981      event generate .t.f <ButtonRelease>
  1982      set x
  1983  } -cleanup {
  1984      destroy .t.f
  1985  } -result {4294}
  1986  test bind-16.32 {ExpandPercents procedure} -setup {
  1987      frame .t.f -class Test -width 150 -height 100
  1988      pack .t.f
  1989      focus -force .t.f
  1990      update
  1991  } -body {
  1992      bind .t.f <Button> {set x "%x %y"}
  1993      set x none
  1994      event generate .t.f <Button> -x 881 -y 432
  1995      event generate .t.f <ButtonRelease>
  1996      set x
  1997  } -cleanup {
  1998      destroy .t.f
  1999  } -result {881 432}
  2000  test bind-16.33 {ExpandPercents procedure} -setup {
  2001      frame .t.f -class Test -width 150 -height 100
  2002      pack .t.f
  2003      focus -force .t.f
  2004      update
  2005  } -body {
  2006      bind .t.f <Reparent> {set x "%x %y"}
  2007      set x none
  2008      event generate .t.f <Reparent> -x 882 -y 431 -window .t.f
  2009      set x
  2010  } -cleanup {
  2011      destroy .t.f
  2012  } -result {882 431}
  2013  test bind-16.34 {ExpandPercents procedure} -setup {
  2014      frame .t.f -class Test -width 150 -height 100
  2015      pack .t.f
  2016      focus -force .t.f
  2017      update
  2018  } -body {
  2019      bind .t.f <Enter> {set x "%x %y"}
  2020      set x none
  2021      event generate .t.f <Enter> -x 781 -y 632
  2022      set x
  2023  } -cleanup {
  2024      destroy .t.f
  2025  } -result {781 632}
  2026  test bind-16.35 {ExpandPercents procedure} -constraints {
  2027      nonPortable 
  2028  } -setup {
  2029      frame .t.f -class Test -width 150 -height 100
  2030      pack .t.f
  2031      focus -force .t.f
  2032      update
  2033      set x {}
  2034  } -body {
  2035      bind .t.f <Key> {lappend x "%A"}
  2036      event generate .t.f <Key-a>
  2037      event generate .t.f <Key-A> -state 1
  2038      event generate .t.f <Key-Tab>
  2039      event generate .t.f <Key-Return>
  2040      event generate .t.f <Key-F1>
  2041      event generate .t.f <Key-Shift_L>
  2042      event generate .t.f <Key-space>
  2043      event generate .t.f <Key-dollar> -state 1
  2044      event generate .t.f <Key-braceleft> -state 1
  2045      event generate .t.f <Key-Multi_key>
  2046      event generate .t.f <Key-e>
  2047      event generate .t.f <Key-apostrophe>
  2048      set x
  2049  } -cleanup {
  2050      destroy .t.f
  2051  } -result {a A {	} {\r} {{}} {{}} { } {\$} \\\{ {{}} {{}} \u00e9}
  2052  test bind-16.36 {ExpandPercents procedure} -setup {
  2053      frame .t.f -class Test -width 150 -height 100
  2054      pack .t.f
  2055      focus -force .t.f
  2056      update
  2057  } -body {
  2058      bind .t.f <Configure> {set x "%B"}
  2059      set x none
  2060      event generate .t.f <Configure> -borderwidth 24 -window .t.f
  2061      set x
  2062  } -cleanup {
  2063      destroy .t.f
  2064  } -result {24}
  2065  test bind-16.37 {ExpandPercents procedure} -setup {
  2066      frame .t.f -class Test -width 150 -height 100
  2067      pack .t.f
  2068      focus -force .t.f
  2069      update
  2070  } -body {
  2071      bind .t.f <Enter> {set x "%E"}
  2072      set x none
  2073      event generate .t.f <Enter> -sendevent 1
  2074      return $x
  2075  } -cleanup {
  2076      destroy .t.f
  2077  } -result {1}
  2078  test bind-16.38 {ExpandPercents procedure} -constraints {
  2079      nonPortable
  2080  } -setup {
  2081      frame .t.f -class Test -width 150 -height 100
  2082      pack .t.f
  2083      focus -force .t.f
  2084      update
  2085      set x {}
  2086  } -body {
  2087      bind .t.f <Key> {lappend x %K}
  2088      event generate .t.f <Key-a>
  2089      event generate .t.f <Key-A> -state 1
  2090      event generate .t.f <Key-Tab>
  2091      event generate .t.f <Key-F1>
  2092      event generate .t.f <Key-Shift_L>
  2093      event generate .t.f <Key-space>
  2094      event generate .t.f <Key-dollar> -state 1
  2095      event generate .t.f <Key-braceleft> -state 1
  2096      set x
  2097  } -cleanup {
  2098      destroy .t.f
  2099  } -result {a A Tab F1 Shift_L space dollar braceleft}
  2100  test bind-16.39 {ExpandPercents procedure} -setup {
  2101      frame .t.f -class Test -width 150 -height 100
  2102      pack .t.f
  2103      focus -force .t.f
  2104      update
  2105  } -body {
  2106      bind .t.f <Key> {set x "%N"}
  2107      set x none
  2108      event generate .t.f <Key-space>
  2109      set x
  2110  } -cleanup {
  2111      destroy .t.f
  2112  } -result {32}
  2113  test bind-16.40 {ExpandPercents procedure} -setup {
  2114      frame .t.f -class Test -width 150 -height 100
  2115      pack .t.f
  2116      focus -force .t.f
  2117      update
  2118  } -body {
  2119      bind .t.f <Key> {set x "%S"}
  2120      set x none
  2121      event generate .t.f <Key-space> -subwindow .t
  2122      set x
  2123  } -cleanup {
  2124      destroy .t.f
  2125  } -result [winfo id .t]
  2126  test bind-16.41 {ExpandPercents procedure} -setup {
  2127      frame .t.f -class Test -width 150 -height 100
  2128      pack .t.f
  2129      focus -force .t.f
  2130      update
  2131  } -body {
  2132      bind .t.f <Key> {set x "%T"}
  2133      set x none
  2134      event generate .t.f <Key>
  2135      set x
  2136  } -cleanup {
  2137      destroy .t.f
  2138  } -result {2}
  2139  test bind-16.42 {ExpandPercents procedure} -setup {
  2140      frame .t.f -class Test -width 150 -height 100
  2141      pack .t.f
  2142      focus -force .t.f
  2143      update
  2144      set x {}
  2145  } -body {
  2146      bind .t.f <Key> {set x "%W"}
  2147      set x none
  2148      event generate .t.f <Key>
  2149      set x
  2150  } -cleanup {
  2151      destroy .t.f
  2152  } -result {.t.f}
  2153  test bind-16.43 {ExpandPercents procedure} -setup {
  2154      frame .t.f -class Test -width 150 -height 100
  2155      pack .t.f
  2156      focus -force .t.f
  2157      update
  2158  } -body {
  2159      bind .t.f <Button> {set x "%X %Y"}
  2160      set x none
  2161      event generate .t.f <Button> -rootx 422 -rooty 13
  2162      event generate .t.f <ButtonRelease>
  2163      set x
  2164  } -cleanup {
  2165      destroy .t.f
  2166  } -result {422 13}
  2167  test bind-16.44 {ExpandPercents procedure} -setup {
  2168      frame .t.f -class Test -width 150 -height 100
  2169      pack .t.f
  2170      focus -force .t.f
  2171      update
  2172  } -body {
  2173      bind .t.f <Gravity> {set x "%R %S"}
  2174      set x none
  2175      event generate .t.f <Gravity>
  2176      set x
  2177  } -cleanup {
  2178      destroy .t.f
  2179  } -result {?? ??}
  2180  
  2181  test bind-16.45 {ExpandPercents procedure} -setup {
  2182      set savedBind(Entry) [bind Entry <Key>]
  2183      set savedBind(All) [bind all <Key>]
  2184      entry .t.e
  2185      pack .t.e
  2186      focus -force .t.e
  2187      foreach p [event info] {event delete $p}
  2188      update
  2189  } -body {
  2190      bind .t.e <Key> {set x "%M"}
  2191      bind Entry <Key> {set y "%M"}
  2192      bind all <Key> {set z "%M"}
  2193      set x none; set y none; set z none
  2194      event gen .t.e <Key-a>
  2195      list $x $y $z
  2196  } -cleanup {
  2197      destroy .t.e
  2198      bind all <Key> $savedBind(All)
  2199      bind Entry <Key> $savedBind(Entry)
  2200      unset savedBind
  2201  } -result {0 1 2}
  2202  test bind-16.46 {ExpandPercents procedure} -setup {
  2203      set savedBind(All) [bind all <Key>]
  2204      set savedBind(Entry) [bind Entry <Key>]
  2205      entry .t.e
  2206      pack .t.e
  2207      focus -force .t.e
  2208      foreach p [event info] {event delete $p}
  2209      update
  2210  } -body {
  2211      bind all <Key> {set z "%M"}
  2212      bind Entry <Key> {set y "%M"}
  2213      bind .t.e <Key> {set x "%M"}
  2214      set x none; set y none; set z none
  2215      event gen .t.e <Key-a>
  2216      list $x $y $z
  2217  } -cleanup {
  2218      destroy .t.e
  2219      bind Entry <Key> $savedBind(Entry)
  2220      bind all <Key> $savedBind(All)
  2221      unset savedBind
  2222  } -result {0 1 2}
  2223  
  2224  test bind-17.1 {event command} -body {
  2225      event
  2226  } -returnCodes error -result {wrong # args: should be "event option ?arg?"}
  2227  test bind-17.2 {event command} -body {
  2228      event xyz
  2229  } -returnCodes error -result {bad option "xyz": must be add, delete, generate, or info}
  2230  test bind-17.3 {event command: add} -body {
  2231      event add
  2232  } -returnCodes error -result {wrong # args: should be "event add virtual sequence ?sequence ...?"}
  2233  test bind-17.4 {event command: add 1} -body {
  2234      event delete <<Paste>>
  2235      event add <<Paste>> <Control-v>
  2236      event info <<Paste>>
  2237  } -cleanup {
  2238      event delete <<Paste>> <Control-v>
  2239  } -result {<Control-Key-v>}
  2240  test bind-17.5 {event command: add 2} -body {
  2241      event delete <<Paste>>
  2242      event add <<Paste>> <Control-v> <Button-2>
  2243      lsort [event info <<Paste>>]
  2244  } -cleanup {
  2245      event delete <<Paste>> <Control-v> <Button-2>
  2246  } -result {<Button-2> <Control-Key-v>}
  2247  
  2248  test bind-17.6 {event command: add with error} -body {
  2249      event add <<Paste>> <Control-v> <Button-2> abc <xyz> <1>
  2250  } -cleanup {
  2251      event delete <<Paste>>
  2252  } -returnCodes error -result {bad event type or keysym "xyz"} 
  2253  test bind-17.7 {event command: add with error} -body {
  2254      event delete <<Paste>>
  2255      catch {event add <<Paste>> <Control-v> <Button-2> abc <xyz> <1>}
  2256      lsort [event info <<Paste>>]
  2257  } -cleanup {
  2258      event delete <<Paste>>
  2259  } -result {<Button-2> <Control-Key-v> abc}
  2260  
  2261  test bind-17.8 {event command: delete} -body {
  2262      event delete
  2263  } -returnCodes error -result {wrong # args: should be "event delete virtual ?sequence ...?"}
  2264  test bind-17.9 {event command: delete many} -body {
  2265      event delete <<Paste>>
  2266      event add <<Paste>> <3> <1> <2> t
  2267      event delete <<Paste>> <1> <2>
  2268      lsort [event info <<Paste>>]
  2269  } -cleanup {
  2270      event delete <<Paste>>
  2271      event delete <<Paste>> <3> t
  2272  } -result {<Button-3> t}
  2273  test bind-17.10 {event command: delete all} -body {
  2274      event add <<Paste>> a b
  2275      event delete <<Paste>>
  2276      event info <<Paste>>
  2277  } -cleanup {
  2278      event delete <<Paste>> a b
  2279  } -result {}
  2280  test bind-17.11 {event command: delete 1} -body {
  2281      event delete <<Paste>>
  2282      event add <<Paste>> a b c
  2283      event delete <<Paste>> b
  2284      lsort [event info <<Paste>>]
  2285  } -cleanup {
  2286      event delete <<Paste>>
  2287  } -result {a c}
  2288  test bind-17.12 {event command: info name} -body {
  2289      event delete <<Paste>>
  2290      event add <<Paste>> a b c
  2291      lsort [event info <<Paste>>]
  2292  } -cleanup {
  2293      event delete <<Paste>>
  2294  } -result {a b c}
  2295  test bind-17.13 {event command: info all} -body {
  2296      foreach p [event info] {event delete $p}
  2297      event add <<Paste>> a
  2298      event add <<Alive>> b
  2299      lsort [event info]
  2300  } -cleanup {
  2301      event delete <<Paste>>
  2302      event delete <<Alive>>
  2303  } -result {<<Alive>> <<Paste>>}
  2304  
  2305  test bind-17.14 {event command: info error} -body {
  2306      event info <<Paste>> <Control-v>
  2307  } -returnCodes error -result {wrong # args: should be "event info ?virtual?"}
  2308  test bind-17.15 {event command: generate} -body {
  2309      event generate
  2310  } -returnCodes error -result {wrong # args: should be "event generate window event ?-option value ...?"}
  2311  
  2312  test bind-17.16 {event command: generate} -setup {
  2313      frame .t.f -class Test -width 150 -height 100
  2314      pack .t.f
  2315      focus -force .t.f
  2316      update
  2317      set x {}
  2318  } -body {
  2319      bind .t.f <1> "lappend x 1"
  2320      event generate .t.f <1>
  2321      set x
  2322  } -cleanup {
  2323      destroy .t.f
  2324  } -result {1}
  2325  test bind-17.17 {event command: generate} -setup {
  2326      frame .t.f -class Test -width 150 -height 100
  2327      pack .t.f
  2328      focus -force .t.f
  2329      update
  2330  } -body {
  2331      event generate .t.f <xyz>
  2332  } -cleanup {
  2333      destroy .t.f
  2334  }  -returnCodes error -result {bad event type or keysym "xyz"}
  2335  test bind-17.18 {event command} -body {
  2336      event foo
  2337  } -returnCodes error -result {bad option "foo": must be add, delete, generate, or info}
  2338  
  2339  
  2340  test bind-18.1 {CreateVirtualEvent procedure: GetVirtualEventUid} -body {
  2341      event add asd <Ctrl-v>
  2342  } -returnCodes error -result {virtual event "asd" is badly formed}
  2343  test bind-18.2 {CreateVirtualEvent procedure: FindSequence} -body {
  2344      event add <<asd>> <Ctrl-v>
  2345  } -returnCodes error -result {bad event type or keysym "Ctrl"}
  2346  test bind-18.3 {CreateVirtualEvent procedure: new physical} -body { 
  2347      event delete <<xyz>>
  2348      event add <<xyz>> <Control-v>
  2349      event info <<xyz>>
  2350  } -cleanup {
  2351      event delete <<xyz>>
  2352  } -result {<Control-Key-v>}
  2353  test bind-18.4 {CreateVirtualEvent procedure: duplicate physical} -body {
  2354      event delete <<xyz>>
  2355      event add <<xyz>> <Control-v> 
  2356      event add <<xyz>> <Control-v>
  2357      event info <<xyz>>
  2358  } -cleanup {
  2359      event delete <<xyz>>
  2360  } -result {<Control-Key-v>}
  2361  test bind-18.5 {CreateVirtualEvent procedure: existing physical} -body {
  2362      foreach p [event info] {event delete $p}
  2363      event add <<xyz>> <Control-v>
  2364      event add <<abc>> <Control-v>
  2365      list [lsort [event info]] [event info <<xyz>>] [event info <<abc>>]
  2366  } -cleanup {
  2367      event delete <<xyz>>
  2368      event delete <<abc>>
  2369  } -result {{<<abc>> <<xyz>>} <Control-Key-v> <Control-Key-v>}
  2370  test bind-18.6 {CreateVirtualEvent procedure: new virtual} -body {
  2371      foreach p [event info] {event delete $p}
  2372      event add <<xyz>> <Control-v>
  2373      list [event info] [event info <<xyz>>]
  2374  } -cleanup {
  2375      event delete <<abc>>
  2376  } -result {<<xyz>> <Control-Key-v>}
  2377  test bind-18.7 {CreateVirtualEvent procedure: existing virtual} -body {
  2378      foreach p [event info] {event delete $p}
  2379      event add <<xyz>> <Control-v>
  2380      event add <<xyz>> <Button-2>
  2381      list [event info] [lsort [event info <<xyz>>]]
  2382  } -cleanup {
  2383      event delete <<xyz>>
  2384  } -result {<<xyz>> {<Button-2> <Control-Key-v>}}
  2385  
  2386  
  2387  test bind-19.1 {DeleteVirtualEvent procedure: GetVirtualEventUid} -body {
  2388      event add xyz {}
  2389  } -returnCodes error -result {virtual event "xyz" is badly formed}
  2390  test bind-19.2 {DeleteVirtualEvent procedure: non-existent virtual} -setup {
  2391      foreach p [event info] {event delete $p}
  2392  } -body {
  2393      event delete <<xyz>>
  2394      event info
  2395  } -result {}
  2396  test bind-19.3 {DeleteVirtualEvent procedure: delete 1} -setup {
  2397      event delete <<xyz>>
  2398  } -body {
  2399      event add <<xyz>> <Control-v>
  2400      event delete <<xyz>> <Control-v>
  2401      event info <<xyz>>
  2402  } -result {}
  2403  test bind-19.4 {DeleteVirtualEvent procedure: delete 1, not owned} -setup {
  2404      event delete <<xyz>>
  2405  } -body {
  2406      event add <<xyz>> <Control-v>
  2407      event delete <<xyz>> <Button-1>
  2408      event info <<xyz>>
  2409  } -result {<Control-Key-v>}
  2410  test bind-19.5 {DeleteVirtualEvent procedure: delete 1, badly formed} -body {
  2411      event add <<xyz>> <Control-v>
  2412      event delete <<xyz>> <xyz>
  2413  } -cleanup {
  2414      event delete <<xyz>>
  2415  } -returnCodes error -result {bad event type or keysym "xyz"}
  2416  test bind-19.6 {DeleteVirtualEvent procedure: delete 1, badly formed} -body {
  2417      event add <<xyz>> <Control-v>
  2418      event delete <<xyz>> <<Paste>>
  2419  } -cleanup {
  2420      event delete <<xyz>>
  2421  } -returnCodes error -result {virtual event not allowed in definition of another virtual event}
  2422  test bind-19.7 {DeleteVirtualEvent procedure: owns 1, delete all} -body {
  2423      foreach p [event info] {event delete $p}
  2424      event add <<xyz>> <Control-v>
  2425      event delete <<xyz>>
  2426      event info 
  2427  } -result {}
  2428  test bind-19.8 {DeleteVirtualEvent procedure: owns 1, delete 1} -body {
  2429      foreach p [event info] {event delete $p}
  2430      event add <<xyz>> <Control-v>
  2431      event delete <<xyz>> <Control-v>
  2432      event info 
  2433  } -result {}
  2434  test bind-19.9 {DeleteVirtualEvent procedure: owns many, delete all} -body {
  2435      foreach p [event info] {event delete $p}
  2436      event add <<xyz>> <Control-v> <Control-w> <Control-x>
  2437      event delete <<xyz>>
  2438      event info
  2439  } -result {}
  2440  test bind-19.10 {DeleteVirtualEvent procedure: owns many, delete 1} -body {
  2441      event delete <<xyz>>
  2442      event add <<xyz>> <Control-v> <Control-w> <Control-x>
  2443      event delete <<xyz>> <Control-w>
  2444      lsort [event info <<xyz>>]
  2445  } -cleanup {
  2446      event delete <<xyz>>
  2447  } -result {<Control-Key-v> <Control-Key-x>}
  2448  test bind-19.11 {DeleteVirtualEvent procedure: owned by 1, only} -setup {
  2449      frame .t.f -class Test -width 150 -height 100
  2450      pack .t.f
  2451      focus -force .t.f
  2452      update
  2453      set x {}
  2454      event delete <<xyz>>
  2455  } -body {
  2456      event add <<xyz>> <Button-2>
  2457      bind .t.f <<xyz>> {lappend x %#}
  2458      event generate .t.f <Button-2> -serial 101
  2459      event generate .t.f <ButtonRelease-2>
  2460      event delete <<xyz>>
  2461      event generate .t.f <Button-2> -serial 102
  2462      event generate .t.f <ButtonRelease-2>
  2463      set x
  2464  } -cleanup {
  2465      destroy .t.f
  2466  } -result {101}
  2467  test bind-19.12 {DeleteVirtualEvent procedure: owned by 1, first in chain} -setup {
  2468      frame .t.f -class Test -width 150 -height 100
  2469      pack .t.f
  2470      focus -force .t.f
  2471      update
  2472      set x {}
  2473      event delete <<xyz>>
  2474      event delete <<abc>>
  2475  } -body {
  2476      event add <<abc>> <Control-Button-2>
  2477      event add <<xyz>> <Button-2>
  2478      bind .t.f <<xyz>> {lappend x xyz}
  2479      bind .t.f <<abc>> {lappend x abc}
  2480      event generate .t.f <Button-2>
  2481      event generate .t.f <ButtonRelease-2>
  2482      event generate .t.f <Control-Button-2>
  2483      event generate .t.f <Control-ButtonRelease-2>
  2484      event delete <<xyz>> 
  2485      event generate .t.f <Button-2>
  2486      event generate .t.f <ButtonRelease-2>
  2487      event generate .t.f <Control-Button-2>
  2488      event generate .t.f <Control-ButtonRelease-2>
  2489      list $x [event info <<abc>>]
  2490  } -cleanup {
  2491      destroy .t.f
  2492      event delete <<abc>>
  2493  } -result {{xyz abc abc} <Control-Button-2>}
  2494  test bind-19.13 {DeleteVirtualEvent procedure: owned by 1, second in chain} -setup {
  2495      frame .t.f -class Test -width 150 -height 100
  2496      pack .t.f
  2497      focus -force .t.f
  2498      update
  2499      set x {}
  2500      event delete <<def>>
  2501      event delete <<xyz>>
  2502      event delete <<abc>>
  2503  } -body {
  2504      event add <<def>> <Shift-Button-2>
  2505      event add <<xyz>> <Button-2>
  2506      event add <<abc>> <Control-Button-2>
  2507      bind .t.f <<xyz>> {lappend x xyz}
  2508      bind .t.f <<abc>> {lappend x abc}
  2509      bind .t.f <<def>> {lappend x def}
  2510      event generate .t.f <Button-2>
  2511      event generate .t.f <ButtonRelease-2>
  2512      event generate .t.f <Control-Button-2>
  2513      event generate .t.f <Control-ButtonRelease-2>
  2514      event generate .t.f <Shift-Button-2>
  2515      event generate .t.f <Shift-ButtonRelease-2>
  2516      event delete <<xyz>>
  2517      event generate .t.f <Button-2>
  2518      event generate .t.f <Control-Button-2>
  2519      event generate .t.f <Shift-Button-2>
  2520      event generate .t.f <ButtonRelease-2>
  2521      event generate .t.f <Control-ButtonRelease-2>
  2522      event generate .t.f <Shift-ButtonRelease-2>
  2523      list $x [event info <<def>>] [event info <<xyz>>] [event info <<abc>>]
  2524  } -cleanup {
  2525      destroy .t.f
  2526      event delete <<abc>>
  2527      event delete <<def>>
  2528  } -result {{xyz abc def abc def} <Shift-Button-2> {} <Control-Button-2>}
  2529  test bind-19.14 {DeleteVirtualEvent procedure: owned by 1, last in chain} -setup {
  2530      frame .t.f -class Test -width 150 -height 100
  2531      pack .t.f
  2532      focus -force .t.f
  2533      update
  2534      set x {}
  2535      event delete <<def>>
  2536      event delete <<xyz>>
  2537      event delete <<abc>>
  2538  } -body {
  2539      event add <<xyz>> <Button-2>
  2540      event add <<abc>> <Control-Button-2>
  2541      event add <<def>> <Shift-Button-2>
  2542      bind .t.f <<xyz>> {lappend x xyz}
  2543      bind .t.f <<abc>> {lappend x abc}
  2544      bind .t.f <<def>> {lappend x def}
  2545      event generate .t.f <Button-2>
  2546      event generate .t.f <ButtonRelease-2>
  2547      event generate .t.f <Control-Button-2>
  2548      event generate .t.f <Control-ButtonRelease-2>
  2549      event generate .t.f <Shift-Button-2>
  2550      event generate .t.f <Shift-ButtonRelease-2>
  2551      event delete <<xyz>> 
  2552      event generate .t.f <Button-2>
  2553      event generate .t.f <ButtonRelease-2>
  2554      event generate .t.f <Control-Button-2>
  2555      event generate .t.f <Control-ButtonRelease-2>
  2556      event generate .t.f <Shift-Button-2>
  2557      event generate .t.f <Shift-ButtonRelease-2>
  2558      list $x [event info <<xyz>>] [event info <<abc>>] [event info <<def>>]
  2559  } -cleanup {
  2560      destroy .t.f
  2561      event delete <<def>>
  2562      event delete <<abc>>
  2563  } -result {{xyz abc def abc def} {} <Control-Button-2> <Shift-Button-2>}
  2564  test bind-19.15 {DeleteVirtualEvent procedure: owned by many, first} -setup {
  2565      pack [frame .t.f -class Test -width 150 -height 100]
  2566      pack [frame .t.g -class Test -width 150 -height 100]
  2567      pack [frame .t.h -class Test -width 150 -height 100]
  2568      after 250 ;# we need a bit time to ensure that .t.h is mapped
  2569      focus -force .t.f
  2570      update
  2571      set x {}
  2572      event delete <<def>>
  2573      event delete <<xyz>>
  2574      event delete <<abc>>
  2575  } -body {
  2576      event add <<xyz>> <Button-2>
  2577      event add <<abc>> <Button-2>
  2578      event add <<def>> <Button-2>
  2579      bind .t.f <<xyz>> {lappend x xyz}
  2580      bind .t.g <<abc>> {lappend x abc}
  2581      bind .t.h <<def>> {lappend x def}
  2582      event generate .t.f <Button-2>
  2583      event generate .t.f <ButtonRelease-2>
  2584      event generate .t.g <Button-2>
  2585      event generate .t.g <ButtonRelease-2>
  2586      event generate .t.h <Button-2>
  2587      event generate .t.h <ButtonRelease-2>
  2588      event delete <<xyz>> 
  2589      event generate .t.f <Button-2>
  2590      event generate .t.f <ButtonRelease-2>
  2591      event generate .t.g <Button-2>
  2592      event generate .t.g <ButtonRelease-2>
  2593      event generate .t.h <Button-2>
  2594      event generate .t.h <ButtonRelease-2>
  2595      list $x [event info <<xyz>>] [event info <<abc>>] [event info <<def>>]
  2596  } -cleanup {
  2597      destroy .t.f .t.g .t.h
  2598      event delete <<def>>
  2599      event delete <<abc>>
  2600  } -result {{xyz abc def abc def} {} <Button-2> <Button-2>}
  2601  test bind-19.16 {DeleteVirtualEvent procedure: owned by many, middle} -setup {
  2602      pack [frame .t.f -class Test -width 150 -height 100]
  2603      pack [frame .t.g -class Test -width 150 -height 100]
  2604      pack [frame .t.h -class Test -width 150 -height 100]
  2605      after 250 ;# we need a bit time to ensure that .t.h is mapped
  2606      focus -force .t.f
  2607      update
  2608      set x {}
  2609      event delete <<def>>
  2610      event delete <<xyz>>
  2611      event delete <<abc>>
  2612  } -body {
  2613      event add <<xyz>> <Button-2>
  2614      event add <<abc>> <Button-2>
  2615      event add <<def>> <Button-2>
  2616      bind .t.f <<xyz>> {lappend x xyz}
  2617      bind .t.g <<abc>> {lappend x abc}
  2618      bind .t.h <<def>> {lappend x def}
  2619      event generate .t.f <Button-2>
  2620      event generate .t.f <ButtonRelease-2>
  2621      event generate .t.g <Button-2>
  2622      event generate .t.g <ButtonRelease-2>
  2623      event generate .t.h <Button-2>
  2624      event generate .t.h <ButtonRelease-2>
  2625      event delete <<abc>>
  2626      event generate .t.f <Button-2>
  2627      event generate .t.f <ButtonRelease-2>
  2628      event generate .t.g <Button-2>
  2629      event generate .t.g <ButtonRelease-2>
  2630      event generate .t.h <Button-2>
  2631      event generate .t.h <ButtonRelease-2>
  2632      list $x [event info <<xyz>>] [event info <<abc>>] [event info <<def>>]
  2633  } -cleanup {
  2634      destroy .t.f .t.g .t.h
  2635      event delete <<def>>
  2636      event delete <<xyz>>
  2637  } -result {{xyz abc def xyz def} <Button-2> {} <Button-2>}
  2638  test bind-19.17 {DeleteVirtualEvent procedure: owned by many, last} -setup {
  2639      pack [frame .t.f -class Test -width 150 -height 100]
  2640      pack [frame .t.g -class Test -width 150 -height 100]
  2641      pack [frame .t.h -class Test -width 150 -height 100]
  2642      after 250 ;# we need a bit time to ensure that .t.h is mapped
  2643      focus -force .t.f
  2644      update
  2645      set x {}
  2646      event delete <<def>>
  2647      event delete <<xyz>>
  2648      event delete <<abc>>
  2649  } -body {
  2650      event add <<xyz>> <Button-2>
  2651      event add <<abc>> <Button-2>
  2652      event add <<def>> <Button-2>
  2653      bind .t.f <<xyz>> {lappend x xyz}
  2654      bind .t.g <<abc>> {lappend x abc}
  2655      bind .t.h <<def>> {lappend x def}
  2656      event generate .t.f <Button-2>
  2657      event generate .t.f <ButtonRelease-2>
  2658      event generate .t.g <Button-2>
  2659      event generate .t.g <ButtonRelease-2>
  2660      event generate .t.h <Button-2>
  2661      event generate .t.h <ButtonRelease-2>
  2662      event delete <<def>> 
  2663      event generate .t.f <Button-2>
  2664      event generate .t.f <ButtonRelease-2>
  2665      event generate .t.g <Button-2>
  2666      event generate .t.g <ButtonRelease-2>
  2667      event generate .t.h <Button-2>
  2668      event generate .t.h <ButtonRelease-2>
  2669      list $x [event info <<xyz>>] [event info <<abc>>] [event info <<def>>]
  2670  } -cleanup {
  2671      destroy .t.f .t.g .t.h
  2672      event delete <<xyz>>
  2673      event delete <<abc>>
  2674  } -result {{xyz abc def xyz abc} <Button-2> <Button-2> {}}
  2675  
  2676  
  2677  test bind-20.1 {GetVirtualEvent procedure: GetVirtualEventUid} -body {
  2678      event info asd
  2679  } -returnCodes error -result {virtual event "asd" is badly formed}
  2680  test bind-20.2 {GetVirtualEvent procedure: non-existent event} -body {
  2681      event delete <<asd>>
  2682      event info <<asd>>
  2683  } -result {}
  2684  test bind-20.3 {GetVirtualEvent procedure: owns 1} -setup {
  2685      event delete <<xyz>>
  2686  } -body {
  2687      event add <<xyz>> <Control-Key-v>
  2688      event info <<xyz>>
  2689  } -cleanup {
  2690      event delete <<xyz>>
  2691  } -result {<Control-Key-v>}
  2692  test bind-20.4 {GetVirtualEvent procedure: owns many} -setup {
  2693      event delete <<xyz>>
  2694  } -body {
  2695      event add <<xyz>> <Control-v> <Button-2> spack
  2696      event info <<xyz>>
  2697  } -cleanup {
  2698      event delete <<xyz>>
  2699  } -result {<Control-Key-v> <Button-2> spack}
  2700  
  2701  
  2702  test bind-21.1 {GetAllVirtualEvents procedure: no events} -body {
  2703      foreach p [event info] {event delete $p}
  2704      event info
  2705  } -result {}
  2706  test bind-21.2 {GetAllVirtualEvents procedure: 1 event} -body {
  2707      foreach p [event info] {event delete $p}
  2708      event add <<xyz>> <Control-v>
  2709      event info
  2710  } -cleanup {
  2711      event delete <<xyz>>
  2712  } -result {<<xyz>>}
  2713  test bind-21.3 {GetAllVirtualEvents procedure: many events} -body {
  2714      foreach p [event info] {event delete $p}
  2715      event add <<xyz>> <Control-v>
  2716      event add <<xyz>> <Button-2>
  2717      event add <<abc>> <Control-v>
  2718      event add <<def>> <Key-F6>
  2719      lsort [event info]
  2720  } -cleanup {
  2721      event delete <<xyz>>
  2722      event delete <<abc>>
  2723      event delete <<def>>
  2724  } -result {<<abc>> <<def>> <<xyz>>}
  2725  
  2726  test bind-22.1 {HandleEventGenerate} -setup {
  2727      destroy .xyz
  2728  } -body {
  2729      event generate .xyz <Control-v>
  2730  } -returnCodes error -result {bad window path name ".xyz"}
  2731  test bind-22.2 {HandleEventGenerate} -body {
  2732      event generate zzz <Control-v>
  2733  } -returnCodes error -result {bad window name/identifier "zzz"}
  2734  test bind-22.3 {HandleEventGenerate} -body {
  2735      event generate 47 <Control-v>
  2736  } -returnCodes error -result {bad window name/identifier "47"}
  2737  test bind-22.4 {HandleEventGenerate} -setup {
  2738      frame .t.f -class Test -width 150 -height 100
  2739      pack .t.f
  2740      focus -force .t.f
  2741      update
  2742      set x {}
  2743  } -body {
  2744      bind .t.f <Button> {set x "%s %b"}
  2745      event generate [winfo id .t.f] <Control-Button-1> -state 260
  2746      set x
  2747  } -cleanup {
  2748      destroy .t.f
  2749  } -result {260 1}
  2750  test bind-22.5 {HandleEventGenerate} -body {
  2751      event generate . <xyz>
  2752  } -returnCodes error -result {bad event type or keysym "xyz"}
  2753  test bind-22.6 {HandleEventGenerate} -body {
  2754      event generate . <Double-Button-1>
  2755  } -returnCodes error -result {Double, Triple, or Quadruple modifier not allowed}
  2756  test bind-22.7 {HandleEventGenerate} -body {
  2757      event generate . xyz
  2758  } -returnCodes error -result {only one event specification allowed}
  2759  test bind-22.8 {HandleEventGenerate} -body {
  2760      event generate . <Button> -button
  2761  } -returnCodes error -result {value for "-button" missing}
  2762  test bind-22.9 {HandleEventGenerate} -setup {
  2763      frame .t.f -class Test -width 150 -height 100
  2764      pack .t.f
  2765      focus -force .t.f
  2766      update
  2767      set x {}
  2768  } -body {
  2769      bind .t.f <Button> {set x "%s %b"}
  2770      event generate .t.f <ButtonRelease-1>
  2771      event generate .t.f <ButtonRelease-2>
  2772      event generate .t.f <ButtonRelease-3>
  2773      event generate .t.f <Control-Button-1>
  2774      event generate .t.f <Control-ButtonRelease-1>
  2775      set x
  2776  } -cleanup {
  2777      destroy .t.f
  2778  } -result {4 1}
  2779  test bind-22.10 {HandleEventGenerate} -setup {
  2780      frame .t.f -class Test -width 150 -height 100
  2781      pack .t.f
  2782      focus -force .t.f
  2783      update
  2784      set x {}
  2785  } -body {
  2786      bind .t.f <Key> {set x "%s %K"}
  2787      event generate .t.f <Control-Key-space>
  2788      set x
  2789  } -cleanup {
  2790      destroy .t.f
  2791  } -result {4 space}
  2792  test bind-22.11 {HandleEventGenerate} -setup {
  2793      frame .t.f -class Test -width 150 -height 100
  2794      pack .t.f
  2795      focus -force .t.f
  2796      update
  2797      set x {}
  2798  } -body {
  2799      bind .t.f <<Paste>> {set x "%s"}
  2800      event generate .t.f <<Paste>> -state 1
  2801      set x
  2802  } -cleanup {
  2803      destroy .t.f
  2804  } -result {1}
  2805  test bind-22.12 {HandleEventGenerate} -setup {
  2806      frame .t.f -class Test -width 150 -height 100
  2807      pack .t.f
  2808      focus -force .t.f
  2809      update
  2810      set x {}
  2811  } -body {
  2812      bind .t.f <Motion> {set x "%s"}
  2813      event generate .t.f <Control-Motion>
  2814      set x
  2815  } -cleanup {
  2816      destroy .t.f
  2817  } -result {4}
  2818  test bind-22.13 {HandleEventGenerate} -setup {
  2819      frame .t.f -class Test -width 150 -height 100
  2820      pack .t.f
  2821      focus -force .t.f
  2822      update
  2823      set x {}
  2824  } -body {
  2825      bind .t.f <Button> {lappend x %#}
  2826      event generate .t.f <Button> -when now -serial 100
  2827      event generate .t.f <ButtonRelease> -when now
  2828      set x
  2829  } -cleanup {
  2830      destroy .t.f
  2831  } -result {100}
  2832  test bind-22.14 {HandleEventGenerate} -setup {
  2833      frame .t.f -class Test -width 150 -height 100
  2834      pack .t.f
  2835      focus -force .t.f
  2836      update
  2837      set x {}
  2838  } -body {
  2839      bind .t.f <Button> {lappend x %#}
  2840      event generate .t.f <Button> -when head -serial 100
  2841      event generate .t.f <Button> -when head -serial 101
  2842      event generate .t.f <Button> -when head -serial 102
  2843      event generate .t.f <ButtonRelease> -when tail
  2844      lappend x foo
  2845      update
  2846      set x
  2847  } -cleanup {
  2848      destroy .t.f
  2849  } -result {foo 102 101 100}
  2850  test bind-22.15 {HandleEventGenerate} -setup {
  2851      frame .t.f -class Test -width 150 -height 100
  2852      pack .t.f
  2853      focus -force .t.f
  2854      update
  2855      set x {}
  2856  } -body {
  2857      bind .t.f <Button> {lappend x %#}
  2858      event generate .t.f <Button> -when head -serial 99
  2859      event generate .t.f <Button> -when mark -serial 100
  2860      event generate .t.f <Button> -when mark -serial 101
  2861      event generate .t.f <Button> -when mark -serial 102
  2862      event generate .t.f <ButtonRelease> -when tail
  2863      lappend x foo
  2864      update
  2865      set x
  2866  } -cleanup {
  2867      destroy .t.f
  2868  } -result {foo 100 101 102 99}
  2869  test bind-22.16 {HandleEventGenerate} -setup {
  2870      frame .t.f -class Test -width 150 -height 100
  2871      pack .t.f
  2872      focus -force .t.f
  2873      update
  2874      set x {}
  2875  } -body {
  2876      bind .t.f <Button> {lappend x %#}
  2877      event generate .t.f <Button> -when head -serial 99
  2878      event generate .t.f <Button> -when tail -serial 100
  2879      event generate .t.f <Button> -when tail -serial 101
  2880      event generate .t.f <Button> -when tail -serial 102
  2881      event generate .t.f <ButtonRelease> -when tail
  2882      lappend x foo
  2883      update
  2884      set x
  2885  } -cleanup {
  2886      destroy .t.f
  2887  } -result {foo 99 100 101 102}
  2888  test bind-22.17 {HandleEventGenerate} -body {
  2889      event generate . <Button> -when xyz
  2890  } -returnCodes error -result {bad -when value "xyz": must be now, head, mark, or tail}
  2891  test bind-22.18 {HandleEventGenerate} -body {
  2892      # Bug 411307
  2893      event generate . <a> -root 98765
  2894  } -returnCodes error -result {bad window name/identifier "98765"}
  2895  
  2896  test bind-22.19 {HandleEventGenerate: options <Configure> -above .xyz} -setup {
  2897      frame .t.f -class Test -width 150 -height 100
  2898      pack .t.f
  2899      focus -force .t.f
  2900      update
  2901      set x {}
  2902  } -body {
  2903      bind .t.f <Configure> "lappend x %a"
  2904      event generate .t.f <Configure> -above .xyz
  2905  } -cleanup {
  2906      destroy .t.f
  2907  } -returnCodes error -result {bad window path name ".xyz"}
  2908  test bind-22.20 {HandleEventGenerate: options <Configure> -above .t} -setup {
  2909      frame .t.f -class Test -width 150 -height 100
  2910      pack .t.f
  2911      focus -force .t.f
  2912      update
  2913      set x {}
  2914  } -body {
  2915      bind .t.f <Configure> "lappend x %a"
  2916      event generate .t.f <Configure> -above .t
  2917      return $x
  2918  } -cleanup {
  2919      destroy .t.f
  2920  } -result [winfo id .t]
  2921  test bind-22.21 {HandleEventGenerate: options <Configure> -above xyz} -setup {
  2922      frame .t.f -class Test -width 150 -height 100
  2923      pack .t.f
  2924      focus -force .t.f
  2925      update
  2926      set x {}
  2927  } -body {
  2928      bind .t.f <Configure> "lappend x %a"
  2929      event generate .t.f <Configure> -above xyz
  2930  } -cleanup {
  2931      destroy .t.f
  2932  } -returnCodes error -result {bad window name/identifier "xyz"}
  2933  test bind-22.22 {HandleEventGenerate: options <Configure> -above [winfo id .t]} -setup {
  2934      frame .t.f -class Test -width 150 -height 100
  2935      pack .t.f
  2936      focus -force .t.f
  2937      update
  2938      set x {}
  2939  } -body {
  2940      bind .t.f <Configure> "lappend x %a"
  2941      event generate .t.f <Configure> -above [winfo id .t]
  2942      return $x
  2943  } -cleanup {
  2944      destroy .t.f
  2945  } -result [winfo id .t]
  2946  
  2947  test bind-22.23 {HandleEventGenerate: options <Key> -above .} -setup {
  2948      frame .t.f -class Test -width 150 -height 100
  2949      pack .t.f
  2950      focus -force .t.f
  2951      update
  2952      set x {}
  2953  } -body {
  2954      bind .t.f <Key> "lappend x %b"
  2955      event generate .t.f <Key> -above .
  2956      return $x
  2957  } -cleanup {
  2958      destroy .t.f
  2959  } -returnCodes error -result {<Key> event doesn't accept "-above" option}
  2960  
  2961  test bind-22.24 {HandleEventGenerate: options <Configure> -borderwidth xyz} -setup {
  2962      frame .t.f -class Test -width 150 -height 100
  2963      pack .t.f
  2964      focus -force .t.f
  2965      update
  2966      set x {}
  2967  } -body {
  2968      bind .t.f <Configure> "lappend x %B"
  2969      event generate .t.f <Configure> -borderwidth xyz
  2970      return $x
  2971  } -cleanup {
  2972      destroy .t.f
  2973  } -returnCodes error -result {bad screen distance "xyz"}
  2974  
  2975  test bind-22.25 {HandleEventGenerate: options <Configure> -borderwidth 2i} -setup {
  2976      frame .t.f -class Test -width 150 -height 100
  2977      pack .t.f
  2978      focus -force .t.f
  2979      update
  2980      set x {}
  2981  } -body {
  2982      bind .t.f <Configure> "lappend x %B"
  2983      event generate .t.f <Configure> -borderwidth 2i
  2984      expr {[winfo pixels .t.f 2i] eq $x}
  2985  } -cleanup {
  2986      destroy .t.f
  2987  } -result {1}
  2988  
  2989  test bind-22.26 {HandleEventGenerate: options <Key> -borderwidth 2i} -setup {
  2990      frame .t.f -class Test -width 150 -height 100
  2991      pack .t.f
  2992      focus -force .t.f
  2993      update
  2994      set x {}
  2995  } -body {
  2996      bind .t.f <Key> "lappend x %k"
  2997      event generate .t.f <Key> -borderwidth 2i
  2998  } -cleanup {
  2999      destroy .t.f
  3000  } -returnCodes error -result {<Key> event doesn't accept "-borderwidth" option}
  3001  
  3002  test bind-22.27 {HandleEventGenerate: options <Button> -button xyz} -setup {
  3003      frame .t.f -class Test -width 150 -height 100
  3004      pack .t.f
  3005      focus -force .t.f
  3006      update
  3007      set x {}
  3008  } -body {
  3009      bind .t.f <Button> "lappend x %b"
  3010      event generate .t.f <Button> -button xyz
  3011  } -cleanup {
  3012      destroy .t.f
  3013  } -returnCodes error -result {expected integer but got "xyz"}
  3014  
  3015  test bind-22.28 {HandleEventGenerate: options <Button> -button 1} -setup {
  3016      frame .t.f -class Test -width 150 -height 100
  3017      pack .t.f
  3018      focus -force .t.f
  3019      update
  3020      set x {}
  3021  } -body {
  3022      bind .t.f <Button> "lappend x %b"
  3023      event generate .t.f <Button> -button 1
  3024      return $x
  3025  } -cleanup {
  3026      destroy .t.f
  3027  } -result 1
  3028  
  3029  test bind-22.29 {HandleEventGenerate: options <ButtonRelease> -button 1} -setup {
  3030      frame .t.f -class Test -width 150 -height 100
  3031      pack .t.f
  3032      focus -force .t.f
  3033      update
  3034      set x {}
  3035  } -body {
  3036      bind .t.f <ButtonRelease> "lappend x %b"
  3037      event generate .t.f <ButtonRelease> -button 1
  3038      return $x
  3039  } -cleanup {
  3040      destroy .t.f
  3041  } -result 1
  3042  
  3043  test bind-22.30 {HandleEventGenerate: options <Key> -button 1} -setup {
  3044      frame .t.f -class Test -width 150 -height 100
  3045      pack .t.f
  3046      focus -force .t.f
  3047      update
  3048      set x {}
  3049  } -body {
  3050      bind .t.f <Key> "lappend x %k"
  3051      event generate .t.f <Key> -button 1
  3052  } -cleanup {
  3053      destroy .t.f
  3054  } -returnCodes error -result {<Key> event doesn't accept "-button" option}
  3055  
  3056  test bind-22.31 {HandleEventGenerate: options <Expose> -count xyz} -setup {
  3057      frame .t.f -class Test -width 150 -height 100
  3058      pack .t.f
  3059      focus -force .t.f
  3060      update
  3061      set x {}
  3062  } -body {
  3063      bind .t.f <Expose> "lappend x %c"
  3064      event generate .t.f <Expose> -count xyz
  3065  } -cleanup {
  3066      destroy .t.f
  3067  } -returnCodes error -result {expected integer but got "xyz"}
  3068  
  3069  test bind-22.32 {HandleEventGenerate: options <Expose> -count 20} -setup {
  3070      frame .t.f -class Test -width 150 -height 100
  3071      pack .t.f
  3072      focus -force .t.f
  3073      update
  3074      set x {}
  3075  } -body {
  3076      bind .t.f <Expose> "lappend x %c"
  3077      event generate .t.f <Expose> -count 20
  3078      return $x
  3079  } -cleanup {
  3080      destroy .t.f
  3081  } -result {20}
  3082  
  3083  test bind-22.33 {HandleEventGenerate: options <Key> -count 20} -setup {
  3084      frame .t.f -class Test -width 150 -height 100
  3085      pack .t.f
  3086      focus -force .t.f
  3087      update
  3088      set x {}
  3089  } -body {
  3090      bind .t.f <Key> "lappend x %b"
  3091      event generate .t.f <Key> -count 20
  3092  } -cleanup {
  3093      destroy .t.f
  3094  } -returnCodes error -result {<Key> event doesn't accept "-count" option}
  3095  
  3096  test bind-22.34 {HandleEventGenerate: options <Enter> -detail xyz} -setup {
  3097      frame .t.f -class Test -width 150 -height 100
  3098      pack .t.f
  3099      focus -force .t.f
  3100      update
  3101      set x {}
  3102  } -body {
  3103      bind .t.f <Enter> "lappend x %d"
  3104      event generate .t.f <Enter> -detail xyz
  3105  } -cleanup {
  3106      destroy .t.f
  3107  } -returnCodes error -result {bad -detail value "xyz": must be NotifyAncestor, NotifyVirtual, NotifyInferior, NotifyNonlinear, NotifyNonlinearVirtual, NotifyPointer, NotifyPointerRoot, or NotifyDetailNone}
  3108  
  3109  test bind-22.35 {HandleEventGenerate: options <FocusIn> -detail NotifyVirtual} -setup {
  3110      frame .t.f -class Test -width 150 -height 100
  3111      pack .t.f
  3112      focus -force .t.f
  3113      update
  3114      set x {}
  3115  } -body {
  3116      bind .t.f <FocusIn> "lappend x FocusIn %d"
  3117      event generate .t.f <FocusIn> -detail NotifyVirtual
  3118      return $x
  3119  } -cleanup {
  3120      destroy .t.f
  3121  } -result {FocusIn NotifyVirtual}
  3122  
  3123  test bind-22.35.1 {HandleEventGenerate: options <FocusOut> -detail NotifyVirtual} -setup {
  3124      frame .t.f -class Test -width 150 -height 100
  3125      pack .t.f
  3126      focus -force .t.f
  3127      update
  3128      set x {}
  3129  } -body {
  3130      bind .t.f <FocusOut> "lappend x FocusOut %d"
  3131      event generate .t.f <FocusOut> -detail NotifyVirtual
  3132      return $x
  3133  } -cleanup {
  3134      destroy .t.f
  3135  } -result {FocusOut NotifyVirtual}
  3136  
  3137  test bind-22.36 {HandleEventGenerate: options <Enter> -detail NotifyVirtual} -setup {
  3138      frame .t.f -class Test -width 150 -height 100
  3139      pack .t.f
  3140      focus -force .t.f
  3141      update
  3142      set x {}
  3143  } -body {
  3144      bind .t.f <Enter> "lappend x %d"
  3145      event generate .t.f <Enter> -detail NotifyVirtual
  3146      return $x
  3147  } -cleanup {
  3148      destroy .t.f
  3149  } -result {NotifyVirtual}
  3150  
  3151  test bind-22.37 {HandleEventGenerate: options <Key> -detail NotifyVirtual} -setup {
  3152      frame .t.f -class Test -width 150 -height 100
  3153      pack .t.f
  3154      focus -force .t.f
  3155      update
  3156      set x {}
  3157  } -body {
  3158      bind .t.f <Key> "lappend x %k"
  3159      event generate .t.f <Key> -detail NotifyVirtual
  3160  } -cleanup {
  3161      destroy .t.f
  3162  } -returnCodes error -result {<Key> event doesn't accept "-detail" option}
  3163  
  3164  test bind-22.38 {HandleEventGenerate: options <Enter> -focus xyz} -setup {
  3165      frame .t.f -class Test -width 150 -height 100
  3166      pack .t.f
  3167      focus -force .t.f
  3168      update
  3169      set x {}
  3170  } -body {
  3171      bind .t.f <Enter> "lappend x %f"
  3172      event generate .t.f <Enter> -focus xyz
  3173  } -cleanup {
  3174      destroy .t.f
  3175  } -returnCodes error -result {expected boolean value but got "xyz"}
  3176  
  3177  test bind-22.39 {HandleEventGenerate: options <Enter> -focus 1} -setup {
  3178      frame .t.f -class Test -width 150 -height 100
  3179      pack .t.f
  3180      focus -force .t.f
  3181      update
  3182      set x {}
  3183  } -body {
  3184      bind .t.f <Enter> "lappend x %f"
  3185      event generate .t.f <Enter> -focus 1
  3186      return $x
  3187  } -cleanup {
  3188      destroy .t.f
  3189  } -result {1}
  3190  
  3191  test bind-22.40 {HandleEventGenerate: options <Key> -focus 1} -setup {
  3192      frame .t.f -class Test -width 150 -height 100
  3193      pack .t.f
  3194      focus -force .t.f
  3195      update
  3196      set x {}
  3197  } -body {
  3198      bind .t.f <Key> "lappend x %k"
  3199      event generate .t.f <Key> -focus 1
  3200  } -cleanup {
  3201      destroy .t.f
  3202  } -returnCodes error -result {<Key> event doesn't accept "-focus" option}
  3203  
  3204  test bind-22.41 {HandleEventGenerate: options <Expose> -height xyz} -setup {
  3205      frame .t.f -class Test -width 150 -height 100
  3206      pack .t.f
  3207      focus -force .t.f
  3208      update
  3209      set x {}
  3210  } -body {
  3211      bind .t.f <Expose> "lappend x %h"
  3212      event generate .t.f <Expose> -height xyz
  3213  } -cleanup {
  3214      destroy .t.f
  3215  } -returnCodes error -result {bad screen distance "xyz"}
  3216  
  3217  test bind-22.42 {HandleEventGenerate: options <Expose> -height 2i} -setup {
  3218      frame .t.f -class Test -width 150 -height 100
  3219      pack .t.f
  3220      focus -force .t.f
  3221      update
  3222      set x {}
  3223  } -body {
  3224      bind .t.f <Expose> "lappend x %h"
  3225      event generate .t.f <Expose> -height 2i
  3226      expr {$x eq [winfo pixels .t.f 2i]}
  3227  } -cleanup {
  3228      destroy .t.f
  3229  } -result {1}
  3230  
  3231  test bind-22.43 {HandleEventGenerate: options <Configure> -height 2i} -setup {
  3232      frame .t.f -class Test -width 150 -height 100
  3233      pack .t.f
  3234      focus -force .t.f
  3235      update
  3236      set x {}
  3237  } -body {
  3238      bind .t.f <Configure> "lappend x %h"
  3239      event generate .t.f <Configure> -height 2i
  3240      expr {$x eq [winfo pixels .t.f 2i]}
  3241  } -cleanup {
  3242      destroy .t.f
  3243  } -result {1}
  3244  
  3245  test bind-22.44 {HandleEventGenerate: options <Key> -height 2i} -setup {
  3246      frame .t.f -class Test -width 150 -height 100
  3247      pack .t.f
  3248      focus -force .t.f
  3249      update
  3250      set x {}
  3251  } -body {
  3252      bind .t.f <Key> "lappend x %k"
  3253      event generate .t.f <Key> -height 2i
  3254  } -cleanup {
  3255      destroy .t.f
  3256  } -returnCodes error -result {<Key> event doesn't accept "-height" option}
  3257  
  3258  test bind-22.45 {HandleEventGenerate: options <Key> -keycode xyz} -setup {
  3259      frame .t.f -class Test -width 150 -height 100
  3260      pack .t.f
  3261      focus -force .t.f
  3262      update
  3263      set x {}
  3264  } -body {
  3265      bind .t.f <Key> "lappend x %k"
  3266      event generate .t.f <Key> -keycode xyz
  3267  } -cleanup {
  3268      destroy .t.f
  3269  } -returnCodes error -result {expected integer but got "xyz"}
  3270  
  3271  test bind-22.46 {HandleEventGenerate: options <Key> -keycode 20} -setup {
  3272      frame .t.f -class Test -width 150 -height 100
  3273      pack .t.f
  3274      focus -force .t.f
  3275      update
  3276      set x {}
  3277  } -body {
  3278      bind .t.f <Key> "lappend x %k"
  3279      event generate .t.f <Key> -keycode 20
  3280      return $x
  3281  } -cleanup {
  3282      destroy .t.f
  3283  } -result {20}
  3284  
  3285  test bind-22.47 {HandleEventGenerate: options <Button> -keycode 20} -setup {
  3286      frame .t.f -class Test -width 150 -height 100
  3287      pack .t.f
  3288      focus -force .t.f
  3289      update
  3290      set x {}
  3291  } -body {
  3292      bind .t.f <Button> "lappend x %b"
  3293      event generate .t.f <Button> -keycode 20
  3294  } -cleanup {
  3295      destroy .t.f
  3296  } -returnCodes error -result {<Button> event doesn't accept "-keycode" option}
  3297  
  3298  test bind-22.48 {HandleEventGenerate: options <Key> -keysym xyz} -setup {
  3299      frame .t.f -class Test -width 150 -height 100
  3300      pack .t.f
  3301      focus -force .t.f
  3302      update
  3303      set x {}
  3304  } -body {
  3305      bind .t.f <Key> "lappend x %K"
  3306      event generate .t.f <Key> -keysym xyz
  3307  } -cleanup {
  3308      destroy .t.f
  3309  } -returnCodes error -result {unknown keysym "xyz"}
  3310  
  3311  test bind-22.49 {HandleEventGenerate: options <Key> -keysym space} -setup {
  3312      frame .t.f -class Test -width 150 -height 100
  3313      pack .t.f
  3314      focus -force .t.f
  3315      update
  3316      set x {}
  3317  } -body {
  3318      bind .t.f <Key> "lappend x %K"
  3319      event generate .t.f <Key> -keysym space
  3320      return $x
  3321  } -cleanup {
  3322      destroy .t.f
  3323  } -result {space}
  3324  
  3325  test bind-22.50 {HandleEventGenerate: options <Button> -keysym space} -setup {
  3326      frame .t.f -class Test -width 150 -height 100
  3327      pack .t.f
  3328      focus -force .t.f
  3329      update
  3330      set x {}
  3331  } -body {
  3332      bind .t.f <Button> "lappend x %b"
  3333      event generate .t.f <Button> -keysym space
  3334  } -cleanup {
  3335      destroy .t.f
  3336  } -returnCodes error -result {<Button> event doesn't accept "-keysym" option}
  3337  
  3338  test bind-22.51 {HandleEventGenerate: options <Enter> -mode xyz} -setup {
  3339      frame .t.f -class Test -width 150 -height 100
  3340      pack .t.f
  3341      focus -force .t.f
  3342      update
  3343      set x {}
  3344  } -body {
  3345      bind .t.f <Enter> "lappend x %m"
  3346      event generate .t.f <Enter> -mode xyz
  3347  } -cleanup {
  3348      destroy .t.f
  3349  } -returnCodes error -result {bad -mode value "xyz": must be NotifyNormal, NotifyGrab, NotifyUngrab, or NotifyWhileGrabbed}
  3350  
  3351  test bind-22.52 {HandleEventGenerate: options <Enter> -mode NotifyNormal} -setup {
  3352      frame .t.f -class Test -width 150 -height 100
  3353      pack .t.f
  3354      focus -force .t.f
  3355      update
  3356      set x {}
  3357  } -body {
  3358      bind .t.f <Enter> "lappend x %m"
  3359      event generate .t.f <Enter> -mode NotifyNormal
  3360      return $x
  3361  } -cleanup {
  3362      destroy .t.f
  3363  } -result {NotifyNormal}
  3364  
  3365  test bind-22.53 {HandleEventGenerate: options <FocusIn> -mode NotifyNormal} -setup {
  3366      frame .t.f -class Test -width 150 -height 100
  3367      pack .t.f
  3368      focus -force .t.f
  3369      update
  3370      set x {}
  3371  } -body {
  3372      bind .t.f <FocusIn> "lappend x %m"
  3373      event generate .t.f <FocusIn> -mode NotifyNormal
  3374      return $x
  3375  } -cleanup {
  3376      destroy .t.f
  3377  } -result {NotifyNormal}
  3378  
  3379  test bind-22.54 {HandleEventGenerate: options <Key> -mode NotifyNormal} -setup {
  3380      frame .t.f -class Test -width 150 -height 100
  3381      pack .t.f
  3382      focus -force .t.f
  3383      update
  3384      set x {}
  3385  } -body {
  3386      bind .t.f <Key> "lappend x %k"
  3387      event generate .t.f <Key> -mode NotifyNormal
  3388  } -cleanup {
  3389      destroy .t.f
  3390  } -returnCodes error -result {<Key> event doesn't accept "-mode" option}
  3391  test bind-22.55 {HandleEventGenerate: options <Map> -override xyz} -setup {
  3392      frame .t.f -class Test -width 150 -height 100
  3393      pack .t.f
  3394      focus -force .t.f
  3395      update
  3396      set x {}
  3397  } -body {
  3398      bind .t.f <Map> "lappend x %o"
  3399      event generate .t.f <Map> -override xyz 
  3400  } -cleanup {
  3401      destroy .t.f
  3402  } -returnCodes error -result {expected boolean value but got "xyz"}
  3403  
  3404  test bind-22.56 {HandleEventGenerate: options <Map> -override 1} -setup {
  3405      frame .t.f -class Test -width 150 -height 100
  3406      pack .t.f
  3407      focus -force .t.f
  3408      update
  3409      set x {}
  3410  } -body {
  3411      bind .t.f <Map> "lappend x %o"
  3412      event generate .t.f <Map> -override 1 
  3413      return $x
  3414  } -cleanup {
  3415      destroy .t.f
  3416  } -result {1}
  3417  
  3418  test bind-22.57 {HandleEventGenerate: options <Reparent> -override 1} -setup {
  3419      frame .t.f -class Test -width 150 -height 100
  3420      pack .t.f
  3421      focus -force .t.f
  3422      update
  3423      set x {}
  3424  } -body {
  3425      bind .t.f <Reparent> "lappend x %o"
  3426      event generate .t.f <Reparent> -override 1 
  3427      return $x
  3428  } -cleanup {
  3429      destroy .t.f
  3430  } -result {1}
  3431  
  3432  test bind-22.58 {HandleEventGenerate: options <Configure> -override 1} -setup {
  3433      frame .t.f -class Test -width 150 -height 100
  3434      pack .t.f
  3435      focus -force .t.f
  3436      update
  3437      set x {}
  3438  } -body {
  3439      bind .t.f <Configure> "lappend x %o"
  3440      event generate .t.f <Configure> -override 1 
  3441      return $x
  3442  } -cleanup {
  3443      destroy .t.f
  3444  } -result {1}
  3445  
  3446  test bind-22.59 {HandleEventGenerate: options <Key> -override 1} -setup {
  3447      frame .t.f -class Test -width 150 -height 100
  3448      pack .t.f
  3449      focus -force .t.f
  3450      update
  3451      set x {}
  3452  } -body {
  3453      bind .t.f <Key> "lappend x %k"
  3454      event generate .t.f <Key> -override 1 
  3455  } -cleanup {
  3456      destroy .t.f
  3457  } -returnCodes error -result {<Key> event doesn't accept "-override" option}
  3458  
  3459  test bind-22.60 {HandleEventGenerate: options <Circulate> -place xyz} -setup {
  3460      frame .t.f -class Test -width 150 -height 100
  3461      pack .t.f
  3462      focus -force .t.f
  3463      update
  3464      set x {}
  3465  } -body {
  3466      bind .t.f <Circulate> "lappend x %p"
  3467      event generate .t.f <Circulate> -place xyz 
  3468  } -cleanup {
  3469      destroy .t.f
  3470  } -returnCodes error -result {bad -place value "xyz": must be PlaceOnTop, or PlaceOnBottom}
  3471  
  3472  test bind-22.61 {HandleEventGenerate: options <Circulate> -place PlaceOnTop} -setup {
  3473      frame .t.f -class Test -width 150 -height 100
  3474      pack .t.f
  3475      focus -force .t.f
  3476      update
  3477      set x {}
  3478  } -body {
  3479      bind .t.f <Circulate> "lappend x %p"
  3480      event generate .t.f <Circulate> -place PlaceOnTop 
  3481      return $x
  3482  } -cleanup {
  3483      destroy .t.f
  3484  } -result {PlaceOnTop}
  3485  
  3486  test bind-22.62 {HandleEventGenerate: options <Key> -place PlaceOnTop} -setup {
  3487      frame .t.f -class Test -width 150 -height 100
  3488      pack .t.f
  3489      focus -force .t.f
  3490      update
  3491      set x {}
  3492  } -body {
  3493      bind .t.f <Key> "lappend x %k"
  3494      event generate .t.f <Key> -place PlaceOnTop 
  3495  } -cleanup {
  3496      destroy .t.f
  3497  } -returnCodes error -result {<Key> event doesn't accept "-place" option}
  3498  
  3499  test bind-22.63 {HandleEventGenerate: options <Key> -root .xyz} -setup {
  3500      frame .t.f -class Test -width 150 -height 100
  3501      pack .t.f
  3502      focus -force .t.f
  3503      update
  3504      set x {}
  3505  } -body {
  3506      bind .t.f <Key> "lappend x %R"
  3507      event generate .t.f <Key> -root .xyz 
  3508  } -cleanup {
  3509      destroy .t.f
  3510  } -returnCodes error -result {bad window path name ".xyz"}
  3511  
  3512  test bind-22.64 {HandleEventGenerate: options <Key> -root .t} -setup {
  3513      frame .t.f -class Test -width 150 -height 100
  3514      pack .t.f
  3515      focus -force .t.f
  3516      update
  3517      set x {}
  3518  } -body {
  3519      bind .t.f <Key> "lappend x %R"
  3520      event generate .t.f <Key> -root .t 
  3521      expr {[winfo id .t] eq $x}
  3522  } -cleanup {
  3523      destroy .t.f
  3524  } -result {1}
  3525  
  3526  test bind-22.65 {HandleEventGenerate: options <Key> -root xyz} -setup {
  3527      frame .t.f -class Test -width 150 -height 100
  3528      pack .t.f
  3529      focus -force .t.f
  3530      update
  3531      set x {}
  3532  } -body {
  3533      bind .t.f <Key> "lappend x %R"
  3534      event generate .t.f <Key> -root xyz 
  3535  } -cleanup {
  3536      destroy .t.f
  3537  } -returnCodes error -result {bad window name/identifier "xyz"}
  3538  
  3539  test bind-22.66 {HandleEventGenerate: options <Key> -root [winfo id .t]} -setup {
  3540      frame .t.f -class Test -width 150 -height 100
  3541      pack .t.f
  3542      focus -force .t.f
  3543      update
  3544      set x {}
  3545  } -body {
  3546      bind .t.f <Key> "lappend x %R"
  3547      event generate .t.f <Key> -root [winfo id .t] 
  3548      expr {[winfo id .t] eq $x}
  3549  } -cleanup {
  3550      destroy .t.f
  3551  } -result {1}
  3552  
  3553  test bind-22.67 {HandleEventGenerate: options <Button> -root .t} -setup {
  3554      frame .t.f -class Test -width 150 -height 100
  3555      pack .t.f
  3556      focus -force .t.f
  3557      update
  3558      set x {}
  3559  } -body {
  3560      bind .t.f <Button> "lappend x %R"
  3561      event generate .t.f <Button> -root .t 
  3562      expr {[winfo id .t] eq $x}
  3563  } -cleanup {
  3564      destroy .t.f
  3565  } -result {1}
  3566  
  3567  test bind-22.68 {HandleEventGenerate: options <ButtonRelease> -root .t} -setup {
  3568      frame .t.f -class Test -width 150 -height 100
  3569      pack .t.f
  3570      focus -force .t.f
  3571      update
  3572      set x {}
  3573  } -body {
  3574      bind .t.f <ButtonRelease> "lappend x %R"
  3575      event generate .t.f <ButtonRelease> -root .t 
  3576      expr {[winfo id .t] eq $x}
  3577  } -cleanup {
  3578      destroy .t.f
  3579  } -result {1}
  3580  
  3581  test bind-22.69 {HandleEventGenerate: options <Motion> -root .t} -setup {
  3582      frame .t.f -class Test -width 150 -height 100
  3583      pack .t.f
  3584      focus -force .t.f
  3585      update
  3586      set x {}
  3587  } -body {
  3588      bind .t.f <Motion> "lappend x %R"
  3589      event generate .t.f <Motion> -root .t 
  3590      expr {[winfo id .t] eq $x}
  3591  } -cleanup {
  3592      destroy .t.f
  3593  } -result {1}
  3594  
  3595  test bind-22.70 {HandleEventGenerate: options <<Paste>> -root .t} -setup {
  3596      frame .t.f -class Test -width 150 -height 100
  3597      pack .t.f
  3598      focus -force .t.f
  3599      update
  3600      set x {}
  3601  } -body {
  3602      bind .t.f <<Paste>> "lappend x %R"
  3603      event generate .t.f <<Paste>> -root .t 
  3604      expr {[winfo id .t] eq $x}
  3605  } -cleanup {
  3606      destroy .t.f
  3607  } -result {1}
  3608  
  3609  test bind-22.71 {HandleEventGenerate: options <Enter> -root .t} -setup {
  3610      frame .t.f -class Test -width 150 -height 100
  3611      pack .t.f
  3612      focus -force .t.f
  3613      update
  3614      set x {}
  3615  } -body {
  3616      bind .t.f <Enter> "lappend x %R"
  3617      event generate .t.f <Enter> -root .t 
  3618      expr {[winfo id .t] eq $x}
  3619  } -cleanup {
  3620      destroy .t.f
  3621  } -result {1}
  3622  
  3623  test bind-22.72 {HandleEventGenerate: options <Configure> -root .t} -setup {
  3624      frame .t.f -class Test -width 150 -height 100
  3625      pack .t.f
  3626      focus -force .t.f
  3627      update
  3628      set x {}
  3629  } -body {
  3630      bind .t.f <Configure> "lappend x %R"
  3631      event generate .t.f <Configure> -root .t 
  3632  } -cleanup {
  3633      destroy .t.f
  3634  } -returnCodes error -result {<Configure> event doesn't accept "-root" option}
  3635  
  3636  test bind-22.73 {HandleEventGenerate: options <Key> -rootx xyz} -setup {
  3637      frame .t.f -class Test -width 150 -height 100
  3638      pack .t.f
  3639      focus -force .t.f
  3640      update
  3641      set x {}
  3642  } -body {
  3643      bind .t.f <Key> "lappend x %X"
  3644      event generate .t.f <Key> -rootx xyz 
  3645  } -cleanup {
  3646      destroy .t.f
  3647  } -returnCodes error -result {bad screen distance "xyz"}
  3648  
  3649  test bind-22.74 {HandleEventGenerate: options <Key> -rootx 2i} -setup {
  3650      frame .t.f -class Test -width 150 -height 100
  3651      pack .t.f
  3652      focus -force .t.f
  3653      update
  3654      set x {}
  3655  } -body {
  3656      bind .t.f <Key> "lappend x %X"
  3657      event generate .t.f <Key> -rootx 2i 
  3658      expr {[winfo pixels .t.f 2i] eq $x}
  3659  } -cleanup {
  3660      destroy .t.f
  3661  } -result {1}
  3662  
  3663  test bind-22.75 {HandleEventGenerate: options <Button> -rootx 2i} -setup {
  3664      frame .t.f -class Test -width 150 -height 100
  3665      pack .t.f
  3666      focus -force .t.f
  3667      update
  3668      set x {}
  3669  } -body {
  3670      bind .t.f <Button> "lappend x %X"
  3671      event generate .t.f <Button> -rootx 2i 
  3672      expr {[winfo pixels .t.f 2i] eq $x}
  3673  } -cleanup {
  3674      destroy .t.f
  3675  } -result {1}
  3676  
  3677  test bind-22.76 {HandleEventGenerate: options <ButtonRelease> -rootx 2i} -setup {
  3678      frame .t.f -class Test -width 150 -height 100
  3679      pack .t.f
  3680      focus -force .t.f
  3681      update
  3682      set x {}
  3683  } -body {
  3684      bind .t.f <ButtonRelease> "lappend x %X"
  3685      event generate .t.f <ButtonRelease> -rootx 2i 
  3686      expr {[winfo pixels .t.f 2i] eq $x}
  3687  } -cleanup {
  3688      destroy .t.f
  3689  } -result {1}
  3690  
  3691  test bind-22.77 {HandleEventGenerate: options <Motion> -rootx 2i} -setup {
  3692      frame .t.f -class Test -width 150 -height 100
  3693      pack .t.f
  3694      focus -force .t.f
  3695      update
  3696      set x {}
  3697  } -body {
  3698      bind .t.f <Motion> "lappend x %X"
  3699      event generate .t.f <Motion> -rootx 2i 
  3700      expr {[winfo pixels .t.f 2i] eq $x}
  3701  } -cleanup {
  3702      destroy .t.f
  3703  } -result {1}
  3704  
  3705  test bind-22.78 {HandleEventGenerate: options <<Paste>> -rootx 2i} -setup {
  3706      frame .t.f -class Test -width 150 -height 100
  3707      pack .t.f
  3708      focus -force .t.f
  3709      update
  3710      set x {}
  3711  } -body {
  3712      bind .t.f <<Paste>> "lappend x %X"
  3713      event generate .t.f <<Paste>> -rootx 2i 
  3714      expr {[winfo pixels .t.f 2i] eq $x}
  3715  } -cleanup {
  3716      destroy .t.f
  3717  } -result {1}
  3718  
  3719  test bind-22.79 {HandleEventGenerate: options <Enter> -rootx 2i} -setup {
  3720      frame .t.f -class Test -width 150 -height 100
  3721      pack .t.f
  3722      focus -force .t.f
  3723      update
  3724      set x {}
  3725  } -body {
  3726      bind .t.f <Enter> "lappend x %X"
  3727      event generate .t.f <Enter> -rootx 2i 
  3728      expr {[winfo pixels .t.f 2i] eq $x}
  3729  } -cleanup {
  3730      destroy .t.f
  3731  } -result {1}
  3732  
  3733  test bind-22.80 {HandleEventGenerate: options <Configure> -rootx 2i} -setup {
  3734      frame .t.f -class Test -width 150 -height 100
  3735      pack .t.f
  3736      focus -force .t.f
  3737      update
  3738      set x {}
  3739  } -body {
  3740      bind .t.f <Configure> "lappend x %X"
  3741      event generate .t.f <Configure> -rootx 2i 
  3742  } -cleanup {
  3743      destroy .t.f
  3744  } -returnCodes error -result {<Configure> event doesn't accept "-rootx" option}
  3745  
  3746  test bind-22.81 {HandleEventGenerate: options <Key> -rooty xyz} -setup {
  3747      frame .t.f -class Test -width 150 -height 100
  3748      pack .t.f
  3749      focus -force .t.f
  3750      update
  3751      set x {}
  3752  } -body {
  3753      bind .t.f <Key> "lappend x %Y"
  3754      event generate .t.f <Key> -rooty xyz 
  3755  } -cleanup {
  3756      destroy .t.f
  3757  } -returnCodes error -result {bad screen distance "xyz"}
  3758  
  3759  test bind-22.82 {HandleEventGenerate: options <Key> -rooty 2i} -setup {
  3760      frame .t.f -class Test -width 150 -height 100
  3761      pack .t.f
  3762      focus -force .t.f
  3763      update
  3764      set x {}
  3765  } -body {
  3766      bind .t.f <Key> "lappend x %Y"
  3767      event generate .t.f <Key> -rooty 2i 
  3768      expr {[winfo pixels .t.f 2i] eq $x}
  3769  } -cleanup {
  3770      destroy .t.f
  3771  } -result {1}
  3772  
  3773  test bind-22.83 {HandleEventGenerate: options <Button> -rooty 2i} -setup {
  3774      frame .t.f -class Test -width 150 -height 100
  3775      pack .t.f
  3776      focus -force .t.f
  3777      update
  3778      set x {}
  3779  } -body {
  3780      bind .t.f <Button> "lappend x %Y"
  3781      event generate .t.f <Button> -rooty 2i 
  3782      expr {[winfo pixels .t.f 2i] eq $x}
  3783  } -cleanup {
  3784      destroy .t.f
  3785  } -result {1}
  3786  
  3787  test bind-22.84 {HandleEventGenerate: options <ButtonRelease> -rooty 2i} -setup {
  3788      frame .t.f -class Test -width 150 -height 100
  3789      pack .t.f
  3790      focus -force .t.f
  3791      update
  3792      set x {}
  3793  } -body {
  3794      bind .t.f <ButtonRelease> "lappend x %Y"
  3795      event generate .t.f <ButtonRelease> -rooty 2i 
  3796      expr {[winfo pixels .t.f 2i] eq $x}
  3797  } -cleanup {
  3798      destroy .t.f
  3799  } -result {1}
  3800  
  3801  test bind-22.85 {HandleEventGenerate: options <Motion> -rooty 2i} -setup {
  3802      frame .t.f -class Test -width 150 -height 100
  3803      pack .t.f
  3804      focus -force .t.f
  3805      update
  3806      set x {}
  3807  } -body {
  3808      bind .t.f <Motion> "lappend x %Y"
  3809      event generate .t.f <Motion> -rooty 2i 
  3810      expr {[winfo pixels .t.f 2i] eq $x}
  3811  } -cleanup {
  3812      destroy .t.f
  3813  } -result {1}
  3814  
  3815  test bind-22.86 {HandleEventGenerate: options <<Paste>> -rooty 2i} -setup {
  3816      frame .t.f -class Test -width 150 -height 100
  3817      pack .t.f
  3818      focus -force .t.f
  3819      update
  3820      set x {}
  3821  } -body {
  3822      bind .t.f <<Paste>> "lappend x %Y"
  3823      event generate .t.f <<Paste>> -rooty 2i 
  3824      expr {[winfo pixels .t.f 2i] eq $x}
  3825  } -cleanup {
  3826      destroy .t.f
  3827  } -result {1}
  3828  
  3829  test bind-22.87 {HandleEventGenerate: options <Enter> -rooty 2i} -setup {
  3830      frame .t.f -class Test -width 150 -height 100
  3831      pack .t.f
  3832      focus -force .t.f
  3833      update
  3834      set x {}
  3835  } -body {
  3836      bind .t.f <Enter> "lappend x %Y"
  3837      event generate .t.f <Enter> -rooty 2i 
  3838      expr {[winfo pixels .t.f 2i] eq $x}
  3839  } -cleanup {
  3840      destroy .t.f
  3841  } -result {1}
  3842  
  3843  test bind-22.88 {HandleEventGenerate: options <Configure> -rooty 2i} -setup {
  3844      frame .t.f -class Test -width 150 -height 100
  3845      pack .t.f
  3846      focus -force .t.f
  3847      update
  3848      set x {}
  3849  } -body {
  3850      bind .t.f <Configure> "lappend x %Y"
  3851      event generate .t.f <Configure> -rooty 2i 
  3852  } -cleanup {
  3853      destroy .t.f
  3854  } -returnCodes error -result {<Configure> event doesn't accept "-rooty" option}
  3855  
  3856  test bind-22.89 {HandleEventGenerate: options <Key> -sendevent xyz} -setup {
  3857      frame .t.f -class Test -width 150 -height 100
  3858      pack .t.f
  3859      focus -force .t.f
  3860      update
  3861      set x {}
  3862  } -body {
  3863      bind .t.f <Key> "lappend x %E"
  3864      event generate .t.f <Key> -sendevent xyz 
  3865  } -cleanup {
  3866      destroy .t.f
  3867  } -returnCodes error -result {expected boolean value but got "xyz"}
  3868  
  3869  test bind-22.90 {HandleEventGenerate: options <Key> -sendevent 1} -setup {
  3870      frame .t.f -class Test -width 150 -height 100
  3871      pack .t.f
  3872      focus -force .t.f
  3873      update
  3874      set x {}
  3875  } -body {
  3876      bind .t.f <Key> "lappend x %E"
  3877      event generate .t.f <Key> -sendevent 1 
  3878      return $x
  3879  } -cleanup {
  3880      destroy .t.f
  3881  } -result {1}
  3882  
  3883  test bind-22.91 {HandleEventGenerate: options <Key> -sendevent yes} -setup {
  3884      frame .t.f -class Test -width 150 -height 100
  3885      pack .t.f
  3886      focus -force .t.f
  3887      update
  3888      set x {}
  3889  } -body {
  3890      bind .t.f <Key> "lappend x %E"
  3891      event generate .t.f <Key> -sendevent yes 
  3892      return $x
  3893  } -cleanup {
  3894      destroy .t.f
  3895  } -result {1}
  3896  
  3897  test bind-22.92 {HandleEventGenerate: options <Key> -sendevent 43} -setup {
  3898      frame .t.f -class Test -width 150 -height 100
  3899      pack .t.f
  3900      focus -force .t.f
  3901      update
  3902      set x {}
  3903  } -body {
  3904      bind .t.f <Key> "lappend x %E"
  3905      event generate .t.f <Key> -sendevent 43 
  3906      return $x
  3907  } -cleanup {
  3908      destroy .t.f
  3909  } -result {1}
  3910  
  3911  test bind-22.93 {HandleEventGenerate: options <Key> -serial xyz} -setup {
  3912      frame .t.f -class Test -width 150 -height 100
  3913      pack .t.f
  3914      focus -force .t.f
  3915      update
  3916      set x {}
  3917  } -body {
  3918      bind .t.f <Key> "lappend x %#"
  3919      event generate .t.f <Key> -serial xyz 
  3920  } -cleanup {
  3921      destroy .t.f
  3922  } -returnCodes error -result {expected integer but got "xyz"}
  3923  
  3924  test bind-22.94 {HandleEventGenerate: options <Key> -serial 100} -setup {
  3925      frame .t.f -class Test -width 150 -height 100
  3926      pack .t.f
  3927      focus -force .t.f
  3928      update
  3929      set x {}
  3930  } -body {
  3931      bind .t.f <Key> "lappend x %#"
  3932      event generate .t.f <Key> -serial 100 
  3933      return $x
  3934  } -cleanup {
  3935      destroy .t.f
  3936  } -result {100}
  3937  
  3938  test bind-22.95 {HandleEventGenerate: options <Key> -state xyz} -setup {
  3939      frame .t.f -class Test -width 150 -height 100
  3940      pack .t.f
  3941      focus -force .t.f
  3942      update
  3943      set x {}
  3944  } -body {
  3945      bind .t.f <Key> "lappend x %s"
  3946      event generate .t.f <Key> -state xyz 
  3947  } -cleanup {
  3948      destroy .t.f
  3949  } -returnCodes error -result {expected integer but got "xyz"}
  3950  
  3951  test bind-22.96 {HandleEventGenerate: options <Key> -state 1} -setup {
  3952      frame .t.f -class Test -width 150 -height 100
  3953      pack .t.f
  3954      focus -force .t.f
  3955      update
  3956      set x {}
  3957  } -body {
  3958      bind .t.f <Key> "lappend x %s"
  3959      event generate .t.f <Key> -state 1 
  3960      return $x
  3961  } -cleanup {
  3962      destroy .t.f
  3963  } -result {1}
  3964  
  3965  test bind-22.97 {HandleEventGenerate: options <Button> -state 1025} -setup {
  3966      frame .t.f -class Test -width 150 -height 100
  3967      pack .t.f
  3968      focus -force .t.f
  3969      update
  3970      set x {}
  3971  } -body {
  3972      bind .t.f <Button> "lappend x %s"
  3973      event generate .t.f <Button> -state 1025 
  3974      return $x
  3975  } -cleanup {
  3976      destroy .t.f
  3977  } -result {1025}
  3978  
  3979  test bind-22.98 {HandleEventGenerate: options <ButtonRelease> -state 1025} -setup {
  3980      frame .t.f -class Test -width 150 -height 100
  3981      pack .t.f
  3982      focus -force .t.f
  3983      update
  3984      set x {}
  3985  } -body {
  3986      bind .t.f <ButtonRelease> "lappend x %s"
  3987      event generate .t.f <ButtonRelease> -state 1025 
  3988      return $x
  3989  } -cleanup {
  3990      destroy .t.f
  3991  } -result {1025}
  3992  
  3993  test bind-22.99 {HandleEventGenerate: options <Motion> -state 1} -setup {
  3994      frame .t.f -class Test -width 150 -height 100
  3995      pack .t.f
  3996      focus -force .t.f
  3997      update
  3998      set x {}
  3999  } -body {
  4000      bind .t.f <Motion> "lappend x %s"
  4001      event generate .t.f <Motion> -state 1 
  4002      return $x
  4003  } -cleanup {
  4004      destroy .t.f
  4005  } -result {1}
  4006  
  4007  test bind-22.100 {HandleEventGenerate: options <<Paste>> -state 1} -setup {
  4008      frame .t.f -class Test -width 150 -height 100
  4009      pack .t.f
  4010      focus -force .t.f
  4011      update
  4012      set x {}
  4013  } -body {
  4014      bind .t.f <<Paste>> "lappend x %s"
  4015      event generate .t.f <<Paste>> -state 1 
  4016      return $x
  4017  } -cleanup {
  4018      destroy .t.f
  4019  } -result {1}
  4020  
  4021  test bind-22.101 {HandleEventGenerate: options <Enter> -state 1} -setup {
  4022      frame .t.f -class Test -width 150 -height 100
  4023      pack .t.f
  4024      focus -force .t.f
  4025      update
  4026      set x {}
  4027  } -body {
  4028      bind .t.f <Enter> "lappend x %s"
  4029      event generate .t.f <Enter> -state 1 
  4030      return $x
  4031  } -cleanup {
  4032      destroy .t.f
  4033  } -result {1}
  4034  
  4035  test bind-22.102 {HandleEventGenerate: options <Visibility> -state xyz} -setup {
  4036      frame .t.f -class Test -width 150 -height 100
  4037      pack .t.f
  4038      focus -force .t.f
  4039      update
  4040      set x {}
  4041  } -body {
  4042      bind .t.f <Visibility> "lappend x %s"
  4043      event generate .t.f <Visibility> -state xyz 
  4044  } -cleanup {
  4045      destroy .t.f
  4046  } -returnCodes error -result {bad -state value "xyz": must be VisibilityUnobscured, VisibilityPartiallyObscured, or VisibilityFullyObscured}
  4047  
  4048  test bind-22.103 {HandleEventGenerate: options <Visibility> -state VisibilityUnobscured} -setup {
  4049      frame .t.f -class Test -width 150 -height 100
  4050      pack .t.f
  4051      focus -force .t.f
  4052      update
  4053      set x {}
  4054  } -body {
  4055      bind .t.f <Visibility> "lappend x %s"
  4056      event generate .t.f <Visibility> -state VisibilityUnobscured 
  4057      return $x
  4058  } -cleanup {
  4059      destroy .t.f
  4060  } -result {VisibilityUnobscured}
  4061  
  4062  test bind-22.104 {HandleEventGenerate: options <Configure> -state xyz} -setup {
  4063      frame .t.f -class Test -width 150 -height 100
  4064      pack .t.f
  4065      focus -force .t.f
  4066      update
  4067      set x {}
  4068  } -body {
  4069      bind .t.f <Configure> "lappend x %s"
  4070      event generate .t.f <Configure> -state xyz 
  4071  } -cleanup {
  4072      destroy .t.f
  4073  } -returnCodes error -result {<Configure> event doesn't accept "-state" option}
  4074  
  4075  test bind-22.105 {HandleEventGenerate: options <Key> -subwindow .xyz} -setup {
  4076      frame .t.f -class Test -width 150 -height 100
  4077      pack .t.f
  4078      focus -force .t.f
  4079      update
  4080      set x {}
  4081  } -body {
  4082      bind .t.f <Key> "lappend x %S"
  4083      event generate .t.f <Key> -subwindow .xyz 
  4084  } -cleanup {
  4085      destroy .t.f
  4086  } -returnCodes error -result {bad window path name ".xyz"}
  4087  
  4088  test bind-22.106 {HandleEventGenerate: options <Key> -subwindow .t} -setup {
  4089      frame .t.f -class Test -width 150 -height 100
  4090      pack .t.f
  4091      focus -force .t.f
  4092      update
  4093      set x {}
  4094  } -body {
  4095      bind .t.f <Key> "lappend x %S"
  4096      event generate .t.f <Key> -subwindow .t 
  4097      expr {[winfo id .t] eq $x}
  4098  } -cleanup {
  4099      destroy .t.f
  4100  } -result {1}
  4101  
  4102  test bind-22.107 {HandleEventGenerate: options <Key> -subwindow xyz} -setup {
  4103      frame .t.f -class Test -width 150 -height 100
  4104      pack .t.f
  4105      focus -force .t.f
  4106      update
  4107      set x {}
  4108  } -body {
  4109      bind .t.f <Key> "lappend x %S"
  4110      event generate .t.f <Key> -subwindow xyz 
  4111  } -cleanup {
  4112      destroy .t.f
  4113  } -returnCodes error -result {bad window name/identifier "xyz"}
  4114  
  4115  test bind-22.108 {HandleEventGenerate: options <Key> -subwindow [winfo id .t]} -setup {
  4116      frame .t.f -class Test -width 150 -height 100
  4117      pack .t.f
  4118      focus -force .t.f
  4119      update
  4120      set x {}
  4121  } -body {
  4122      bind .t.f <Key> "lappend x %S"
  4123      event generate .t.f <Key> -subwindow [winfo id .t] 
  4124      expr {[winfo id .t] eq $x}
  4125  } -cleanup {
  4126      destroy .t.f
  4127  } -result {1}
  4128  
  4129  test bind-22.109 {HandleEventGenerate: options <Button> -subwindow .t} -setup {
  4130      frame .t.f -class Test -width 150 -height 100
  4131      pack .t.f
  4132      focus -force .t.f
  4133      update
  4134      set x {}
  4135  } -body {
  4136      bind .t.f <Button> "lappend x %S"
  4137      event generate .t.f <Button> -subwindow .t 
  4138      expr {[winfo id .t] eq $x}
  4139  } -cleanup {
  4140      destroy .t.f
  4141  } -result {1}
  4142  
  4143  test bind-22.110 {HandleEventGenerate: options <ButtonRelease> -subwindow .t} -setup {
  4144      frame .t.f -class Test -width 150 -height 100
  4145      pack .t.f
  4146      focus -force .t.f
  4147      update
  4148      set x {}
  4149  } -body {
  4150      bind .t.f <ButtonRelease> "lappend x %S"
  4151      event generate .t.f <ButtonRelease> -subwindow .t 
  4152      expr {[winfo id .t] eq $x}
  4153  } -cleanup {
  4154      destroy .t.f
  4155  } -result {1}
  4156  
  4157  test bind-22.111 {HandleEventGenerate: options <Motion> -subwindow .t} -setup {
  4158      frame .t.f -class Test -width 150 -height 100
  4159      pack .t.f
  4160      focus -force .t.f
  4161      update
  4162      set x {}
  4163  } -body {
  4164      bind .t.f <Motion> "lappend x %S"
  4165      event generate .t.f <Motion> -subwindow .t 
  4166      expr {[winfo id .t] eq $x}
  4167  } -cleanup {
  4168      destroy .t.f
  4169  } -result {1}
  4170  
  4171  test bind-22.112 {HandleEventGenerate: options <<Paste>> -subwindow .t} -setup {
  4172      frame .t.f -class Test -width 150 -height 100
  4173      pack .t.f
  4174      focus -force .t.f
  4175      update
  4176      set x {}
  4177  } -body {
  4178      bind .t.f <<Paste>> "lappend x %S"
  4179      event generate .t.f <<Paste>> -subwindow .t 
  4180      expr {[winfo id .t] eq $x}
  4181  } -cleanup {
  4182      destroy .t.f
  4183  } -result {1}
  4184  
  4185  test bind-22.113 {HandleEventGenerate: options <Enter> -subwindow .t} -setup {
  4186      frame .t.f -class Test -width 150 -height 100
  4187      pack .t.f
  4188      focus -force .t.f
  4189      update
  4190      set x {}
  4191  } -body {
  4192      bind .t.f <Enter> "lappend x %S"
  4193      event generate .t.f <Enter> -subwindow .t 
  4194      expr {[winfo id .t] eq $x}
  4195  } -cleanup {
  4196      destroy .t.f
  4197  } -result {1}
  4198  
  4199  test bind-22.114 {HandleEventGenerate: options <Configure> -subwindow .t} -setup {
  4200      frame .t.f -class Test -width 150 -height 100
  4201      pack .t.f
  4202      focus -force .t.f
  4203      update
  4204      set x {}
  4205  } -body {
  4206      bind .t.f <Configure> "lappend x %S"
  4207      event generate .t.f <Configure> -subwindow .t 
  4208  } -cleanup {
  4209      destroy .t.f
  4210  } -returnCodes error -result {<Configure> event doesn't accept "-subwindow" option}
  4211  
  4212  test bind-22.115 {HandleEventGenerate: options <Key> -time xyz} -setup {
  4213      frame .t.f -class Test -width 150 -height 100
  4214      pack .t.f
  4215      focus -force .t.f
  4216      update
  4217      set x {}
  4218  } -body {
  4219      bind .t.f <Key> "lappend x %t"
  4220      event generate .t.f <Key> -time xyz 
  4221  } -cleanup {
  4222      destroy .t.f
  4223  } -returnCodes error -result {expected integer but got "xyz"}
  4224  
  4225  test bind-22.116 {HandleEventGenerate: options <Key> -time 100} -setup {
  4226      frame .t.f -class Test -width 150 -height 100
  4227      pack .t.f
  4228      focus -force .t.f
  4229      update
  4230      set x {}
  4231  } -body {
  4232      bind .t.f <Key> "lappend x %t"
  4233      event generate .t.f <Key> -time 100 
  4234      return $x
  4235  } -cleanup {
  4236      destroy .t.f
  4237  } -result {100}
  4238  
  4239  test bind-22.117 {HandleEventGenerate: options <Button> -time 100} -setup {
  4240      frame .t.f -class Test -width 150 -height 100
  4241      pack .t.f
  4242      focus -force .t.f
  4243      update
  4244      set x {}
  4245  } -body {
  4246      bind .t.f <Button> "lappend x %t"
  4247      event generate .t.f <Button> -time 100 
  4248      return $x
  4249  } -cleanup {
  4250      destroy .t.f
  4251  } -result {100}
  4252  
  4253  test bind-22.118 {HandleEventGenerate: options <ButtonRelease> -time 100} -setup {
  4254      frame .t.f -class Test -width 150 -height 100
  4255      pack .t.f
  4256      focus -force .t.f
  4257      update
  4258      set x {}
  4259  } -body {
  4260      bind .t.f <ButtonRelease> "lappend x %t"
  4261      event generate .t.f <ButtonRelease> -time 100 
  4262      return $x
  4263  } -cleanup {
  4264      destroy .t.f
  4265  } -result {100}
  4266  
  4267  test bind-22.119 {HandleEventGenerate: options <Motion> -time 100} -setup {
  4268      frame .t.f -class Test -width 150 -height 100
  4269      pack .t.f
  4270      focus -force .t.f
  4271      update
  4272      set x {}
  4273  } -body {
  4274      bind .t.f <Motion> "lappend x %t"
  4275      event generate .t.f <Motion> -time 100 
  4276      return $x
  4277  } -cleanup {
  4278      destroy .t.f
  4279  } -result {100}
  4280  
  4281  test bind-22.120 {HandleEventGenerate: options <<Paste>> -time 100} -setup {
  4282      frame .t.f -class Test -width 150 -height 100
  4283      pack .t.f
  4284      focus -force .t.f
  4285      update
  4286      set x {}
  4287  } -body {
  4288      bind .t.f <<Paste>> "lappend x %t"
  4289      event generate .t.f <<Paste>> -time 100 
  4290      return $x
  4291  } -cleanup {
  4292      destroy .t.f
  4293  } -result {100}
  4294  
  4295  test bind-22.121 {HandleEventGenerate: options <Enter> -time 100} -setup {
  4296      frame .t.f -class Test -width 150 -height 100
  4297      pack .t.f
  4298      focus -force .t.f
  4299      update
  4300      set x {}
  4301  } -body {
  4302      bind .t.f <Enter> "lappend x %t"
  4303      event generate .t.f <Enter> -time 100 
  4304      return $x
  4305  } -cleanup {
  4306      destroy .t.f
  4307  } -result {100}
  4308  
  4309  test bind-22.122 {HandleEventGenerate: options <Property> -time 100} -setup {
  4310      frame .t.f -class Test -width 150 -height 100
  4311      pack .t.f
  4312      focus -force .t.f
  4313      update
  4314      set x {}
  4315  } -body {
  4316      bind .t.f <Property> "lappend x %t"
  4317      event generate .t.f <Property> -time 100 
  4318      return $x
  4319  } -cleanup {
  4320      destroy .t.f
  4321  } -result {100}
  4322  
  4323  test bind-22.123 {HandleEventGenerate: options <Configure> -time 100} -setup {
  4324      frame .t.f -class Test -width 150 -height 100
  4325      pack .t.f
  4326      focus -force .t.f
  4327      update
  4328      set x {}
  4329  } -body {
  4330      bind .t.f <Configure> "lappend x %t"
  4331      event generate .t.f <Configure> -time 100 
  4332  } -cleanup {
  4333      destroy .t.f
  4334  } -returnCodes error -result {<Configure> event doesn't accept "-time" option}
  4335  
  4336  test bind-22.124 {HandleEventGenerate: options <Expose> -width xyz} -setup {
  4337      frame .t.f -class Test -width 150 -height 100
  4338      pack .t.f
  4339      focus -force .t.f
  4340      update
  4341      set x {}
  4342  } -body {
  4343      bind .t.f <Expose> "lappend x %w"
  4344      event generate .t.f <Expose> -width xyz 
  4345  } -cleanup {
  4346      destroy .t.f
  4347  } -returnCodes error -result {bad screen distance "xyz"}
  4348  
  4349  test bind-22.125 {HandleEventGenerate: options <Expose> -width 2i} -setup {
  4350      frame .t.f -class Test -width 150 -height 100
  4351      pack .t.f
  4352      focus -force .t.f
  4353      update
  4354      set x {}
  4355  } -body {
  4356      bind .t.f <Expose> "lappend x %w"
  4357      event generate .t.f <Expose> -width 2i 
  4358      expr {[winfo pixels .t.f 2i] eq $x}
  4359  } -cleanup {
  4360      destroy .t.f
  4361  } -result {1}
  4362  
  4363  test bind-22.126 {HandleEventGenerate: options <Configure> -width 2i} -setup {
  4364      frame .t.f -class Test -width 150 -height 100
  4365      pack .t.f
  4366      focus -force .t.f
  4367      update
  4368      set x {}
  4369  } -body {
  4370      bind .t.f <Configure> "lappend x %w"
  4371      event generate .t.f <Configure> -width 2i 
  4372      expr {[winfo pixels .t.f 2i] eq $x}
  4373  } -cleanup {
  4374      destroy .t.f
  4375  } -result {1}
  4376  
  4377  test bind-22.127 {HandleEventGenerate: options <Key> -width 2i} -setup {
  4378      frame .t.f -class Test -width 150 -height 100
  4379      pack .t.f
  4380      focus -force .t.f
  4381      update
  4382      set x {}
  4383  } -body {
  4384      bind .t.f <Key> "lappend x %k"
  4385      event generate .t.f <Key> -width 2i 
  4386  } -cleanup {
  4387      destroy .t.f
  4388  } -returnCodes error -result {<Key> event doesn't accept "-width" option}
  4389  
  4390  test bind-22.128 {HandleEventGenerate: options <Unmap> -window .xyz} -setup {
  4391      frame .t.f -class Test -width 150 -height 100
  4392      pack .t.f
  4393      focus -force .t.f
  4394      update
  4395      set x {}
  4396  } -body {
  4397      bind .t.f <Unmap> "lappend x %W"
  4398      event generate .t.f <Unmap> -window .xyz 
  4399  } -cleanup {
  4400      destroy .t.f
  4401  } -returnCodes error -result {bad window path name ".xyz"}
  4402  
  4403  test bind-22.129 {HandleEventGenerate: options <Unmap> -window .t.f} -setup {
  4404      frame .t.f -class Test -width 150 -height 100
  4405      pack .t.f
  4406      focus -force .t.f
  4407      update
  4408      set x {}
  4409  } -body {
  4410      bind .t.f <Unmap> "lappend x %W"
  4411      event generate .t.f <Unmap> -window .t.f 
  4412      return $x
  4413  } -cleanup {
  4414      destroy .t.f
  4415  } -result {.t.f}
  4416  
  4417  test bind-22.130 {HandleEventGenerate: options <Unmap> -window xyz} -setup {
  4418      frame .t.f -class Test -width 150 -height 100
  4419      pack .t.f
  4420      focus -force .t.f
  4421      update
  4422      set x {}
  4423  } -body {
  4424      bind .t.f <Unmap> "lappend x %W"
  4425      event generate .t.f <Unmap> -window xyz 
  4426  } -cleanup {
  4427      destroy .t.f
  4428  } -returnCodes error -result {bad window name/identifier "xyz"}
  4429  
  4430  test bind-22.131 {HandleEventGenerate: options <Unmap> -window [winfo id .t.f]} -setup {
  4431      frame .t.f -class Test -width 150 -height 100
  4432      pack .t.f
  4433      focus -force .t.f
  4434      update
  4435      set x {}
  4436  } -body {
  4437      bind .t.f <Unmap> "lappend x %W"
  4438      event generate .t.f <Unmap> -window [winfo id .t.f] 
  4439      return $x
  4440  } -cleanup {
  4441      destroy .t.f
  4442  } -result {.t.f}
  4443  
  4444  test bind-22.132 {HandleEventGenerate: options <Unmap> -window .t.f} -setup {
  4445      frame .t.f -class Test -width 150 -height 100
  4446      pack .t.f
  4447      focus -force .t.f
  4448      update
  4449      set x {}
  4450  } -body {
  4451      bind .t.f <Unmap> "lappend x %W"
  4452      event generate .t.f <Unmap> -window .t.f 
  4453      return $x
  4454  } -cleanup {
  4455      destroy .t.f
  4456  } -result {.t.f}
  4457  
  4458  test bind-22.133 {HandleEventGenerate: options <Map> -window .t.f} -setup {
  4459      frame .t.f -class Test -width 150 -height 100
  4460      pack .t.f
  4461      focus -force .t.f
  4462      update
  4463      set x {}
  4464  } -body {
  4465      bind .t.f <Map> "lappend x %W"
  4466      event generate .t.f <Map> -window .t.f 
  4467      return $x
  4468  } -cleanup {
  4469      destroy .t.f
  4470  } -result {.t.f}
  4471  
  4472  test bind-22.134 {HandleEventGenerate: options <Reparent> -window .t.f} -setup {
  4473      frame .t.f -class Test -width 150 -height 100
  4474      pack .t.f
  4475      focus -force .t.f
  4476      update
  4477      set x {}
  4478  } -body {
  4479      bind .t.f <Reparent> "lappend x %W"
  4480      event generate .t.f <Reparent> -window .t.f 
  4481      return $x
  4482  } -cleanup {
  4483      destroy .t.f
  4484  } -result {.t.f}
  4485  
  4486  test bind-22.135 {HandleEventGenerate: options <Configure> -window .t.f} -setup {
  4487      frame .t.f -class Test -width 150 -height 100
  4488      pack .t.f
  4489      focus -force .t.f
  4490      update
  4491      set x {}
  4492  } -body {
  4493      bind .t.f <Configure> "lappend x %W"
  4494      event generate .t.f <Configure> -window .t.f 
  4495      return $x
  4496  } -cleanup {
  4497      destroy .t.f
  4498  } -result {.t.f}
  4499  
  4500  test bind-22.136 {HandleEventGenerate: options <Gravity> -window .t.f} -setup {
  4501      frame .t.f -class Test -width 150 -height 100
  4502      pack .t.f
  4503      focus -force .t.f
  4504      update
  4505      set x {}
  4506  } -body {
  4507      bind .t.f <Gravity> "lappend x %W"
  4508      event generate .t.f <Gravity> -window .t.f 
  4509      return $x
  4510  } -cleanup {
  4511      destroy .t.f
  4512  } -result {.t.f}
  4513  
  4514  test bind-22.137 {HandleEventGenerate: options <Circulate> -window .t.f} -setup {
  4515      frame .t.f -class Test -width 150 -height 100
  4516      pack .t.f
  4517      focus -force .t.f
  4518      update
  4519      set x {}
  4520  } -body {
  4521      bind .t.f <Circulate> "lappend x %W"
  4522      event generate .t.f <Circulate> -window .t.f 
  4523      return $x
  4524  } -cleanup {
  4525      destroy .t.f
  4526  } -result {.t.f}
  4527  
  4528  test bind-22.138 {HandleEventGenerate: options <Key> -window .t.f} -setup {
  4529      frame .t.f -class Test -width 150 -height 100
  4530      pack .t.f
  4531      focus -force .t.f
  4532      update
  4533      set x {}
  4534  } -body {
  4535      bind .t.f <Key> "lappend x %W"
  4536      event generate .t.f <Key> -window .t.f 
  4537  } -cleanup {
  4538      destroy .t.f
  4539  } -returnCodes error -result {<Key> event doesn't accept "-window" option}
  4540  
  4541  test bind-22.139 {HandleEventGenerate: options <Key> -x xyz} -setup {
  4542      frame .t.f -class Test -width 150 -height 100
  4543      pack .t.f
  4544      focus -force .t.f
  4545      update
  4546      set x {}
  4547  } -body {
  4548      bind .t.f <Key> "lappend x %x"
  4549      event generate .t.f <Key> -x xyz 
  4550  } -cleanup {
  4551      destroy .t.f
  4552  } -returnCodes error -result {bad screen distance "xyz"}
  4553  
  4554  test bind-22.140 {HandleEventGenerate: options <Key> -x 2i} -setup {
  4555      frame .t.f -class Test -width 150 -height 100
  4556      pack .t.f
  4557      focus -force .t.f
  4558      update
  4559      set x {}
  4560  } -body {
  4561      bind .t.f <Key> "lappend x %x"
  4562      event generate .t.f <Key> -x 2i 
  4563      expr {[winfo pixels .t.f 2i] eq $x}
  4564  } -cleanup {
  4565      destroy .t.f
  4566  } -result {1}
  4567  
  4568  test bind-22.141 {HandleEventGenerate: options <Button> -x 2i} -setup {
  4569      frame .t.f -class Test -width 150 -height 100
  4570      pack .t.f
  4571      focus -force .t.f
  4572      update
  4573      set x {}
  4574  } -body {
  4575      bind .t.f <Button> "lappend x %x"
  4576      event generate .t.f <Button> -x 2i 
  4577      expr {[winfo pixels .t.f 2i] eq $x}
  4578  } -cleanup {
  4579      destroy .t.f
  4580  } -result {1}
  4581  
  4582  test bind-22.142 {HandleEventGenerate: options <ButtonRelease> -x 2i} -setup {
  4583      frame .t.f -class Test -width 150 -height 100
  4584      pack .t.f
  4585      focus -force .t.f
  4586      update
  4587      set x {}
  4588  } -body {
  4589      bind .t.f <ButtonRelease> "lappend x %x"
  4590      event generate .t.f <ButtonRelease> -x 2i 
  4591      expr {[winfo pixels .t.f 2i] eq $x}
  4592  } -cleanup {
  4593      destroy .t.f
  4594  } -result {1}
  4595  
  4596  test bind-22.143 {HandleEventGenerate: options <Motion> -x 2i} -setup {
  4597      frame .t.f -class Test -width 150 -height 100
  4598      pack .t.f
  4599      focus -force .t.f
  4600      update
  4601      set x {}
  4602  } -body {
  4603      bind .t.f <Motion> "lappend x %x"
  4604      event generate .t.f <Motion> -x 2i 
  4605      expr {[winfo pixels .t.f 2i] eq $x}
  4606  } -cleanup {
  4607      destroy .t.f
  4608  } -result {1}
  4609  
  4610  test bind-22.144 {HandleEventGenerate: options <<Paste>> -x 2i} -setup {
  4611      frame .t.f -class Test -width 150 -height 100
  4612      pack .t.f
  4613      focus -force .t.f
  4614      update
  4615      set x {}
  4616  } -body {
  4617      bind .t.f <<Paste>> "lappend x %x"
  4618      event generate .t.f <<Paste>> -x 2i 
  4619      expr {[winfo pixels .t.f 2i] eq $x}
  4620  } -cleanup {
  4621      destroy .t.f
  4622  } -result {1}
  4623  
  4624  test bind-22.145 {HandleEventGenerate: options <Enter> -x 2i} -setup {
  4625      frame .t.f -class Test -width 150 -height 100
  4626      pack .t.f
  4627      focus -force .t.f
  4628      update
  4629      set x {}
  4630  } -body {
  4631      bind .t.f <Enter> "lappend x %x"
  4632      event generate .t.f <Enter> -x 2i 
  4633      expr {[winfo pixels .t.f 2i] eq $x}
  4634  } -cleanup {
  4635      destroy .t.f
  4636  } -result {1}
  4637  
  4638  test bind-22.146 {HandleEventGenerate: options <Expose> -x 2i} -setup {
  4639      frame .t.f -class Test -width 150 -height 100
  4640      pack .t.f
  4641      focus -force .t.f
  4642      update
  4643      set x {}
  4644  } -body {
  4645      bind .t.f <Expose> "lappend x %x"
  4646      event generate .t.f <Expose> -x 2i 
  4647      expr {[winfo pixels .t.f 2i] eq $x}
  4648  } -cleanup {
  4649      destroy .t.f
  4650  } -result {1}
  4651  
  4652  test bind-22.147 {HandleEventGenerate: options <Configure> -x 2i} -setup {
  4653      frame .t.f -class Test -width 150 -height 100
  4654      pack .t.f
  4655      focus -force .t.f
  4656      update
  4657      set x {}
  4658  } -body {
  4659      bind .t.f <Configure> "lappend x %x"
  4660      event generate .t.f <Configure> -x 2i 
  4661      expr {[winfo pixels .t.f 2i] eq $x}
  4662  } -cleanup {
  4663      destroy .t.f
  4664  } -result {1}
  4665  
  4666  test bind-22.148 {HandleEventGenerate: options <Gravity> -x 2i} -setup {
  4667      frame .t.f -class Test -width 150 -height 100
  4668      pack .t.f
  4669      focus -force .t.f
  4670      update
  4671      set x {}
  4672  } -body {
  4673      bind .t.f <Gravity> "lappend x %x"
  4674      event generate .t.f <Gravity> -x 2i 
  4675      expr {[winfo pixels .t.f 2i] eq $x}
  4676  } -cleanup {
  4677      destroy .t.f
  4678  } -result {1}
  4679  
  4680  test bind-22.149 {HandleEventGenerate: options <Reparent> -x 2i} -setup {
  4681      frame .t.f -class Test -width 150 -height 100
  4682      pack .t.f
  4683      focus -force .t.f
  4684      update
  4685      set x {}
  4686  } -body {
  4687      bind .t.f <Reparent> "lappend x %x"
  4688      event generate .t.f <Reparent> -x 2i 
  4689      expr {[winfo pixels .t.f 2i] eq $x}
  4690  } -cleanup {
  4691      destroy .t.f
  4692  } -result {1}
  4693  
  4694  test bind-22.150 {HandleEventGenerate: options <Map> -x 2i} -setup {
  4695      frame .t.f -class Test -width 150 -height 100
  4696      pack .t.f
  4697      focus -force .t.f
  4698      update
  4699      set x {}
  4700  } -body {
  4701      bind .t.f <Map> "lappend x %x"
  4702      event generate .t.f <Map> -x 2i 
  4703  } -cleanup {
  4704      destroy .t.f
  4705  } -returnCodes error -result {<Map> event doesn't accept "-x" option}
  4706  
  4707  test bind-22.151 {HandleEventGenerate: options <Key> -y xyz} -setup {
  4708      frame .t.f -class Test -width 150 -height 100
  4709      pack .t.f
  4710      focus -force .t.f
  4711      update
  4712      set x {}
  4713  } -body {
  4714      bind .t.f <Key> "lappend x %y"
  4715      event generate .t.f <Key> -y xyz 
  4716  } -cleanup {
  4717      destroy .t.f
  4718  } -returnCodes error -result {bad screen distance "xyz"}
  4719  
  4720  test bind-22.152 {HandleEventGenerate: options <Key> -y 2i} -setup {
  4721      frame .t.f -class Test -width 150 -height 100
  4722      pack .t.f
  4723      focus -force .t.f
  4724      update
  4725      set x {}
  4726  } -body {
  4727      bind .t.f <Key> "lappend x %y"
  4728      event generate .t.f <Key> -y 2i 
  4729      expr {[winfo pixels .t.f 2i] eq $x}
  4730  } -cleanup {
  4731      destroy .t.f
  4732  } -result {1}
  4733  
  4734  test bind-22.153 {HandleEventGenerate: options <Button> -y 2i} -setup {
  4735      frame .t.f -class Test -width 150 -height 100
  4736      pack .t.f
  4737      focus -force .t.f
  4738      update
  4739      set x {}
  4740  } -body {
  4741      bind .t.f <Button> "lappend x %y"
  4742      event generate .t.f <Button> -y 2i 
  4743      expr {[winfo pixels .t.f 2i] eq $x}
  4744  } -cleanup {
  4745      destroy .t.f
  4746  } -result {1}
  4747  
  4748  test bind-22.154 {HandleEventGenerate: options <ButtonRelease> -y 2i} -setup {
  4749      frame .t.f -class Test -width 150 -height 100
  4750      pack .t.f
  4751      focus -force .t.f
  4752      update
  4753      set x {}
  4754  } -body {
  4755      bind .t.f <ButtonRelease> "lappend x %y"
  4756      event generate .t.f <ButtonRelease> -y 2i 
  4757      expr {[winfo pixels .t.f 2i] eq $x}
  4758  } -cleanup {
  4759      destroy .t.f
  4760  } -result {1}
  4761  
  4762  test bind-22.155 {HandleEventGenerate: options <Motion> -y 2i} -setup {
  4763      frame .t.f -class Test -width 150 -height 100
  4764      pack .t.f
  4765      focus -force .t.f
  4766      update
  4767      set x {}
  4768  } -body {
  4769      bind .t.f <Motion> "lappend x %y"
  4770      event generate .t.f <Motion> -y 2i 
  4771      expr {[winfo pixels .t.f 2i] eq $x}
  4772  } -cleanup {
  4773      destroy .t.f
  4774  } -result {1}
  4775  
  4776  test bind-22.156 {HandleEventGenerate: options <<Paste>> -y 2i} -setup {
  4777      frame .t.f -class Test -width 150 -height 100
  4778      pack .t.f
  4779      focus -force .t.f
  4780      update
  4781      set x {}
  4782  } -body {
  4783      bind .t.f <<Paste>> "lappend x %y"
  4784      event generate .t.f <<Paste>> -y 2i 
  4785      expr {[winfo pixels .t.f 2i] eq $x}
  4786  } -cleanup {
  4787      destroy .t.f
  4788  } -result {1}
  4789  
  4790  test bind-22.157 {HandleEventGenerate: options <Enter> -y 2i} -setup {
  4791      frame .t.f -class Test -width 150 -height 100
  4792      pack .t.f
  4793      focus -force .t.f
  4794      update
  4795      set x {}
  4796  } -body {
  4797      bind .t.f <Enter> "lappend x %y"
  4798      event generate .t.f <Enter> -y 2i 
  4799      expr {[winfo pixels .t.f 2i] eq $x}
  4800  } -cleanup {
  4801      destroy .t.f
  4802  } -result {1}
  4803  
  4804  test bind-22.158 {HandleEventGenerate: options <Expose> -y 2i} -setup {
  4805      frame .t.f -class Test -width 150 -height 100
  4806      pack .t.f
  4807      focus -force .t.f
  4808      update
  4809      set x {}
  4810  } -body {
  4811      bind .t.f <Expose> "lappend x %y"
  4812      event generate .t.f <Expose> -y 2i 
  4813      expr {[winfo pixels .t.f 2i] eq $x}
  4814  } -cleanup {
  4815      destroy .t.f
  4816  } -result {1}
  4817  
  4818  test bind-22.159 {HandleEventGenerate: options <Configure> -y 2i} -setup {
  4819      frame .t.f -class Test -width 150 -height 100
  4820      pack .t.f
  4821      focus -force .t.f
  4822      update
  4823      set x {}
  4824  } -body {
  4825      bind .t.f <Configure> "lappend x %y"
  4826      event generate .t.f <Configure> -y 2i 
  4827      expr {[winfo pixels .t.f 2i] eq $x}
  4828  } -cleanup {
  4829      destroy .t.f
  4830  } -result {1}
  4831  
  4832  test bind-22.160 {HandleEventGenerate: options <Gravity> -y 2i} -setup {
  4833      frame .t.f -class Test -width 150 -height 100
  4834      pack .t.f
  4835      focus -force .t.f
  4836      update
  4837      set x {}
  4838  } -body {
  4839      bind .t.f <Gravity> "lappend x %y"
  4840      event generate .t.f <Gravity> -y 2i 
  4841      expr {[winfo pixels .t.f 2i] eq $x}
  4842  } -cleanup {
  4843      destroy .t.f
  4844  } -result {1}
  4845  
  4846  test bind-22.161 {HandleEventGenerate: options <Reparent> -y 2i} -setup {
  4847      frame .t.f -class Test -width 150 -height 100
  4848      pack .t.f
  4849      focus -force .t.f
  4850      update
  4851      set x {}
  4852  } -body {
  4853      bind .t.f <Reparent> "lappend x %y"
  4854      event generate .t.f <Reparent> -y 2i 
  4855      expr {[winfo pixels .t.f 2i] eq $x}
  4856  } -cleanup {
  4857      destroy .t.f
  4858  } -result {1}
  4859  
  4860  test bind-22.162 {HandleEventGenerate: options <Map> -y 2i} -setup {
  4861      frame .t.f -class Test -width 150 -height 100
  4862      pack .t.f
  4863      focus -force .t.f
  4864      update
  4865      set x {}
  4866  } -body {
  4867      bind .t.f <Map> "lappend x %y"
  4868      event generate .t.f <Map> -y 2i 
  4869  } -cleanup {
  4870      destroy .t.f
  4871  } -returnCodes error -result {<Map> event doesn't accept "-y" option}
  4872  
  4873  test bind-22.163 {HandleEventGenerate: options <Key> -xyz 1} -setup {
  4874      frame .t.f -class Test -width 150 -height 100
  4875      pack .t.f
  4876      focus -force .t.f
  4877      update
  4878      set x {}
  4879  } -body {
  4880      bind .t.f <Key> "lappend x %k"
  4881      event generate .t.f <Key> -xyz 1 
  4882  } -cleanup {
  4883      destroy .t.f
  4884  } -returnCodes error -result {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}
  4885  # Note that the -data option is tested in bind-32.* because it has
  4886  # more demanding requirements in memory handling
  4887  
  4888  
  4889  test bind-23.1 {GetVirtualEventUid procedure} -body {
  4890      event info <<asd
  4891  } -returnCodes error -result {virtual event "<<asd" is badly formed}
  4892  test bind-23.2 {GetVirtualEventUid procedure} -body {
  4893      event info <<>>
  4894  } -returnCodes error -result {virtual event "<<>>" is badly formed}
  4895  test bind-23.3 {GetVirtualEventUid procedure} -body {
  4896      event info <<asd>
  4897  } -returnCodes error -result {virtual event "<<asd>" is badly formed}
  4898  test bind-23.4 {GetVirtualEventUid procedure} -setup {
  4899      event delete <<asd>>
  4900  } -body {
  4901      event info <<asd>>
  4902  } -result {}
  4903  
  4904  
  4905  test bind-24.1 {FindSequence procedure: no event} -body {
  4906      bind .t {} test
  4907  } -returnCodes error -result {no events specified in binding}
  4908  test bind-24.2 {FindSequence procedure: bad event} -body {
  4909      bind .t <xyz> test
  4910  } -returnCodes error -result {bad event type or keysym "xyz"}
  4911  test bind-24.3 {FindSequence procedure: virtual allowed} -setup {
  4912      frame .t.f -class Test -width 150 -height 100
  4913      pack .t.f
  4914      focus -force .t.f
  4915      update
  4916      set x {}
  4917  } -body {
  4918      bind .t.f <<Paste>> test
  4919  } -cleanup {
  4920      destroy .t.f
  4921  } -result  {}
  4922  test bind-24.4 {FindSequence procedure: virtual not allowed} -body {
  4923      event add <<Paste>> <<Alive>>
  4924  } -returnCodes error -result {virtual event not allowed in definition of another virtual event}
  4925  test bind-24.5 {FindSequence procedure, multiple bindings} -setup {
  4926      frame .t.f -class Test -width 150 -height 100
  4927      pack .t.f
  4928      focus -force .t.f
  4929      update
  4930  } -body {
  4931      bind .t.f <1> {lappend x single}
  4932      bind .t.f <Double-1> {lappend x double}
  4933      bind .t.f <Triple-1> {lappend x triple}
  4934      bind .t.f <Quadruple-1> {lappend x quadruple}
  4935      set x press
  4936      event generate .t.f <Button-1>
  4937      event generate .t.f <ButtonRelease-1>
  4938      lappend x press
  4939      event generate .t.f <Button-1>
  4940      event generate .t.f <ButtonRelease-1>
  4941      lappend x press
  4942      event generate .t.f <Button-1>
  4943      event generate .t.f <ButtonRelease-1>
  4944      lappend x press
  4945      event generate .t.f <Button-1>
  4946      event generate .t.f <ButtonRelease-1>
  4947      lappend x press
  4948      event generate .t.f <Button-1>
  4949      event generate .t.f <ButtonRelease-1>
  4950      set x
  4951  } -cleanup {
  4952      destroy .t.f
  4953  } -result {press single press double press triple press quadruple press quadruple}
  4954  test bind-24.6 {FindSequence procedure: virtual composed} -body {
  4955      bind .t <Control-b><<Paste>> "puts hi"
  4956  } -returnCodes error -result {virtual events may not be composed}
  4957  test bind-24.7 {FindSequence procedure: new pattern sequence} -setup {
  4958      frame .t.f -class Test -width 150 -height 100
  4959      pack .t.f
  4960      focus -force .t.f
  4961      update
  4962      set x {}
  4963  } -body {
  4964      bind .t.f <Button-1><Button-2> {lappend x 1-2}
  4965      event generate .t.f <Button-1>
  4966      event generate .t.f <ButtonRelease-1>
  4967      event generate .t.f <Button-2>
  4968      event generate .t.f <ButtonRelease-2>
  4969      set x
  4970  } -cleanup {
  4971      destroy .t.f
  4972  } -result {1-2}
  4973  test bind-24.8 {FindSequence procedure: similar pattern sequence} -setup {
  4974      frame .t.f -class Test -width 150 -height 100
  4975      pack .t.f
  4976      focus -force .t.f
  4977      update
  4978      set x {}
  4979  } -body {
  4980      bind .t.f <Button-1><Button-2> {lappend x 1-2}
  4981      bind .t.f <Button-2> {lappend x 2}
  4982      event generate .t.f <Button-3>
  4983      event generate .t.f <Button-2>
  4984      event generate .t.f <ButtonRelease-2>
  4985      event generate .t.f <Button-1>
  4986      event generate .t.f <ButtonRelease-1>
  4987      event generate .t.f <Button-2>
  4988      event generate .t.f <ButtonRelease-2>
  4989      set x
  4990  } -cleanup {
  4991      destroy .t.f
  4992  } -result {2 1-2}
  4993  test bind-24.9 {FindSequence procedure: similar pattern sequence} -setup {
  4994      frame .t.f -class Test -width 150 -height 100
  4995      pack .t.f
  4996      focus -force .t.f
  4997      update
  4998      set x {}
  4999  } -body {
  5000      bind .t.f <Button-1><Button-2> {lappend x 1-2}
  5001      bind .t.f <Button-2><Button-2> {lappend x 2-2}
  5002      event generate .t.f <Button-3>
  5003      event generate .t.f <Button-2>
  5004      event generate .t.f <ButtonRelease-2>
  5005      event generate .t.f <Button-2>
  5006      event generate .t.f <ButtonRelease-2>
  5007      event generate .t.f <Button-1>
  5008      event generate .t.f <ButtonRelease-1>
  5009      event generate .t.f <Button-2>
  5010      event generate .t.f <ButtonRelease-2>
  5011      set x
  5012  } -cleanup {
  5013      destroy .t.f
  5014  } -result {2-2 1-2}
  5015  test bind-24.10 {FindSequence procedure: similar pattern sequence} -setup {
  5016      frame .t.f -class Test -width 150 -height 100
  5017      pack .t.f
  5018      focus -force .t.f
  5019      update
  5020      set x {}
  5021  } -body {
  5022      bind .t.f <Button-2><Button-2> {lappend x 2-2}
  5023      bind .t.f <Double-Button-2> {lappend x d-2}
  5024      event generate .t.f <Button-3>
  5025      event generate .t.f <Button-2>
  5026      event generate .t.f <ButtonRelease-2>
  5027      event generate .t.f <Button-2>
  5028      event generate .t.f <ButtonRelease-2>
  5029      event generate .t.f <Button-1>
  5030      event generate .t.f <ButtonRelease-1>
  5031      event generate .t.f <Button-2> -x 100
  5032      event generate .t.f <ButtonRelease-2>
  5033      event generate .t.f <Button-2> -x 200
  5034      event generate .t.f <ButtonRelease-2>
  5035      set x
  5036  } -cleanup {
  5037      destroy .t.f
  5038  } -result {d-2 2-2}
  5039  test bind-24.11 {FindSequence procedure: new sequence, don't create} -setup {
  5040      frame .t.f -class Test -width 150 -height 100
  5041      pack .t.f
  5042      focus -force .t.f
  5043      update
  5044  } -body {
  5045      bind .t.f <Button-2>
  5046  } -cleanup {
  5047      destroy .t.f
  5048  } -result {}
  5049  test bind-24.12 {FindSequence procedure: not new sequence, don't create} -setup {
  5050      frame .t.f -class Test -width 150 -height 100
  5051      pack .t.f
  5052      focus -force .t.f
  5053      update
  5054  } -body {
  5055      bind .t.f <Control-Button-2> "foo"
  5056      bind .t.f <Button-2>
  5057  } -cleanup {
  5058      destroy .t.f
  5059  } -result {}
  5060  test bind-24.13 {FindSequence procedure: no binding} -body {
  5061      frame .t.f -class Test -width 150 -height 100
  5062      bind .t.f <a>
  5063  } -cleanup {
  5064      destroy .t.f
  5065  } -returnCodes ok
  5066  test bind-24.14 {FindSequence procedure: no binding} -body {
  5067      canvas .t.c
  5068      set i [.t.c create rect 10 10 100 100]
  5069      .t.c bind $i <a>
  5070  } -cleanup {
  5071      destroy .t.c
  5072  } -returnCodes ok
  5073  
  5074  test bind-25.1 {ParseEventDescription procedure} -setup {
  5075      frame .t.f -class Test -width 150 -height 100
  5076      pack .t.f
  5077      focus -force .t.f
  5078      update
  5079  } -body {
  5080      bind .t.f a test
  5081      bind .t.f a
  5082  } -cleanup {
  5083      destroy .t.f
  5084  } -result test
  5085  test bind-25.2 {ParseEventDescription procedure: misinterpreted modifier} -setup {
  5086      button .b
  5087  } -body {
  5088      bind .b <Control-M> a
  5089      bind .b <M-M> b
  5090      lsort [bind .b]
  5091  } -cleanup {
  5092      destroy .b
  5093  } -result {<Control-Key-M> <Meta-Key-M>}
  5094  test bind-25.3 {ParseEventDescription procedure} -setup {
  5095      frame .t.f -class Test -width 150 -height 100
  5096  } -body {
  5097      bind .t.f <a---> {nothing}
  5098      bind .t.f
  5099  } -cleanup {
  5100      destroy .t.f
  5101  } -result a
  5102  test bind-25.4 {ParseEventDescription} -setup {
  5103      frame .t.f -class Test -width 150 -height 100
  5104  } -body {
  5105      bind .t.f <<Shift-Paste>> {puts hi}
  5106      bind .t.f
  5107  } -cleanup {
  5108      destroy .t.f
  5109  } -result {<<Shift-Paste>>}
  5110  
  5111  # Assorted error cases in event sequence parsing
  5112  test bind-25.5 {ParseEventDescription procedure error cases} -body {
  5113      bind .t \x7 {puts hi}
  5114  } -returnCodes error -result {bad ASCII character 0x7}
  5115  test bind-25.6 {ParseEventDescription procedure error cases} -body {
  5116      bind .t \x7f {puts hi}
  5117  } -returnCodes error -result {bad ASCII character 0x7f}
  5118  test bind-25.7 {ParseEventDescription procedure error cases} -body {
  5119      bind .t \x4 {puts hi}
  5120  } -returnCodes error -result {bad ASCII character 0x4}
  5121  test bind-25.8 {ParseEventDescription procedure error cases} -body {
  5122      bind .t <<>>  {puts hi}
  5123  } -returnCodes error -result {virtual event "<<>>" is badly formed}
  5124  test bind-25.9 {ParseEventDescription procedure error cases} -body {
  5125      bind .t <<Paste  {puts hi}
  5126  } -returnCodes error -result {missing ">" in virtual binding}
  5127  test bind-25.10 {ParseEventDescription procedure error cases} -body {
  5128      bind .t <<Paste>  {puts hi}
  5129  } -returnCodes error -result {missing ">" in virtual binding}
  5130  test bind-25.11 {ParseEventDescription procedure error cases} -body {
  5131      bind .t <<Paste>>h  {puts hi}
  5132  } -returnCodes error -result {virtual events may not be composed}
  5133  test bind-25.12 {ParseEventDescription procedure error cases} -body {
  5134      bind .t <>  {puts hi}
  5135  } -returnCodes error -result {no event type or button # or keysym}
  5136  test bind-25.13 {ParseEventDescription procedure error cases} -body {
  5137      bind .t <a--  {puts hi}
  5138  } -returnCodes error -result {missing ">" in binding}
  5139  test bind-25.14 {ParseEventDescription procedure error cases} -body {
  5140      bind .t <a-b> {puts hi}
  5141  } -returnCodes error -result {extra characters after detail in binding}
  5142  test bind-25.15 {ParseEventDescription procedure error cases} -body {
  5143      bind .t <<abc   {puts hi}
  5144  } -returnCodes error -result {missing ">" in virtual binding}
  5145  test bind-25.16 {ParseEventDescription procedure error cases} -body {
  5146      bind .t <<abc>  {puts hi}
  5147  } -returnCodes error -result {missing ">" in virtual binding}
  5148  test bind-25.17 {ParseEventDescription} -body {
  5149      event add <<xyz>> <<abc>>
  5150  } -returnCodes error -result {virtual event not allowed in definition of another virtual event}
  5151  
  5152  # Modifier canonicalization tests
  5153  
  5154  test bind-25.18 {modifier names} -setup {
  5155      frame .t.f -class Test -width 150 -height 100
  5156  } -body {
  5157      bind .t.f {<Control- a>} foo
  5158      bind .t.f
  5159  } -cleanup {
  5160      destroy .t.f
  5161  } -result <Control-Key-a>
  5162  
  5163  test bind-25.19 {modifier names} -setup {
  5164      frame .t.f -class Test -width 150 -height 100
  5165  } -body {
  5166      bind .t.f <Shift-a> foo
  5167      bind .t.f
  5168  } -cleanup {
  5169      destroy .t.f
  5170  } -result <Shift-Key-a>
  5171  
  5172  test bind-25.20 {modifier names} -setup {
  5173      frame .t.f -class Test -width 150 -height 100
  5174  } -body {
  5175      bind .t.f <Lock-a> foo
  5176      bind .t.f
  5177  } -cleanup {
  5178      destroy .t.f
  5179  } -result <Lock-Key-a>
  5180  
  5181  test bind-25.21 {modifier names} -setup {
  5182      frame .t.f -class Test -width 150 -height 100
  5183  } -body {
  5184      bind .t.f <Meta---a> foo
  5185      bind .t.f
  5186  } -cleanup {
  5187      destroy .t.f
  5188  } -result <Meta-Key-a>
  5189  
  5190  test bind-25.22 {modifier names} -setup {
  5191      frame .t.f -class Test -width 150 -height 100
  5192  } -body {
  5193      bind .t.f <M-a> foo
  5194      bind .t.f
  5195  } -cleanup {
  5196      destroy .t.f
  5197  } -result <Meta-Key-a>
  5198  
  5199  test bind-25.23 {modifier names} -setup {
  5200      frame .t.f -class Test -width 150 -height 100
  5201  } -body {
  5202      bind .t.f <Alt-a> foo
  5203      bind .t.f
  5204  } -cleanup {
  5205      destroy .t.f
  5206  } -result <Alt-Key-a>
  5207  
  5208  test bind-25.24 {modifier names} -setup {
  5209      frame .t.f -class Test -width 150 -height 100
  5210  } -body {
  5211      bind .t.f <B1-a> foo
  5212      bind .t.f
  5213  } -cleanup {
  5214      destroy .t.f
  5215  } -result <B1-Key-a>
  5216  
  5217  test bind-25.25 {modifier names} -setup {
  5218      frame .t.f -class Test -width 150 -height 100
  5219  } -body {
  5220      bind .t.f <B2-a> foo
  5221      bind .t.f
  5222  } -cleanup {
  5223      destroy .t.f
  5224  } -result <B2-Key-a>
  5225  
  5226  test bind-25.26 {modifier names} -setup {
  5227      frame .t.f -class Test -width 150 -height 100
  5228  } -body {
  5229      bind .t.f <B3-a> foo
  5230      bind .t.f
  5231  } -cleanup {
  5232      destroy .t.f
  5233  } -result <B3-Key-a>
  5234  
  5235  test bind-25.27 {modifier names} -setup {
  5236      frame .t.f -class Test -width 150 -height 100
  5237  } -body {
  5238      bind .t.f <B4-a> foo
  5239      bind .t.f
  5240  } -cleanup {
  5241      destroy .t.f
  5242  } -result <B4-Key-a>
  5243  
  5244  test bind-25.28 {modifier names} -setup {
  5245      frame .t.f -class Test -width 150 -height 100
  5246  } -body {
  5247      bind .t.f <B5-a> foo
  5248      bind .t.f
  5249  } -cleanup {
  5250      destroy .t.f
  5251  } -result <B5-Key-a>
  5252  
  5253  test bind-25.29 {modifier names} -setup {
  5254      frame .t.f -class Test -width 150 -height 100
  5255  } -body {
  5256      bind .t.f <Button1-a> foo
  5257      bind .t.f
  5258  } -cleanup {
  5259      destroy .t.f
  5260  } -result <B1-Key-a>
  5261  
  5262  test bind-25.30 {modifier names} -setup {
  5263      frame .t.f -class Test -width 150 -height 100
  5264  } -body {
  5265      bind .t.f <Button2-a> foo
  5266      bind .t.f
  5267  } -cleanup {
  5268      destroy .t.f
  5269  } -result <B2-Key-a>
  5270  
  5271  test bind-25.31 {modifier names} -setup {
  5272      frame .t.f -class Test -width 150 -height 100
  5273  } -body {
  5274      bind .t.f <Button3-a> foo
  5275      bind .t.f
  5276  } -cleanup {
  5277      destroy .t.f
  5278  } -result <B3-Key-a>
  5279  
  5280  test bind-25.32 {modifier names} -setup {
  5281      frame .t.f -class Test -width 150 -height 100
  5282  } -body {
  5283      bind .t.f <Button4-a> foo
  5284      bind .t.f
  5285  } -cleanup {
  5286      destroy .t.f
  5287  } -result <B4-Key-a>
  5288  
  5289  test bind-25.33 {modifier names} -setup {
  5290      frame .t.f -class Test -width 150 -height 100
  5291  } -body {
  5292      bind .t.f <Button5-a> foo
  5293      bind .t.f
  5294  } -cleanup {
  5295      destroy .t.f
  5296  } -result <B5-Key-a>
  5297  
  5298  test bind-25.34 {modifier names} -setup {
  5299      frame .t.f -class Test -width 150 -height 100
  5300  } -body {
  5301      bind .t.f <M1-a> foo
  5302      bind .t.f
  5303  } -cleanup {
  5304      destroy .t.f
  5305  } -result <Mod1-Key-a>
  5306  
  5307  test bind-25.35 {modifier names} -setup {
  5308      frame .t.f -class Test -width 150 -height 100
  5309  } -body {
  5310      bind .t.f <M2-a> foo
  5311      bind .t.f
  5312  } -cleanup {
  5313      destroy .t.f
  5314  } -result <Mod2-Key-a>
  5315  
  5316  test bind-25.36 {modifier names} -setup {
  5317      frame .t.f -class Test -width 150 -height 100
  5318  } -body {
  5319      bind .t.f <M3-a> foo
  5320      bind .t.f
  5321  } -cleanup {
  5322      destroy .t.f
  5323  } -result <Mod3-Key-a>
  5324  
  5325  test bind-25.37 {modifier names} -setup {
  5326      frame .t.f -class Test -width 150 -height 100
  5327  } -body {
  5328      bind .t.f <M4-a> foo
  5329      bind .t.f
  5330  } -cleanup {
  5331      destroy .t.f
  5332  } -result <Mod4-Key-a>
  5333  
  5334  test bind-25.38 {modifier names} -setup {
  5335      frame .t.f -class Test -width 150 -height 100
  5336  } -body {
  5337      bind .t.f <M5-a> foo
  5338      bind .t.f
  5339  } -cleanup {
  5340      destroy .t.f
  5341  } -result <Mod5-Key-a>
  5342  
  5343  test bind-25.39 {modifier names} -setup {
  5344      frame .t.f -class Test -width 150 -height 100
  5345  } -body {
  5346      bind .t.f <Mod1-a> foo
  5347      bind .t.f
  5348  } -cleanup {
  5349      destroy .t.f
  5350  } -result <Mod1-Key-a>
  5351  
  5352  test bind-25.40 {modifier names} -setup {
  5353      frame .t.f -class Test -width 150 -height 100
  5354  } -body {
  5355      bind .t.f <Mod2-a> foo
  5356      bind .t.f
  5357  } -cleanup {
  5358      destroy .t.f
  5359  } -result <Mod2-Key-a>
  5360  
  5361  test bind-25.41 {modifier names} -setup {
  5362      frame .t.f -class Test -width 150 -height 100
  5363  } -body {
  5364      bind .t.f <Mod3-a> foo
  5365      bind .t.f
  5366  } -cleanup {
  5367      destroy .t.f
  5368  } -result <Mod3-Key-a>
  5369  
  5370  test bind-25.42 {modifier names} -setup {
  5371      frame .t.f -class Test -width 150 -height 100
  5372  } -body {
  5373      bind .t.f <Mod4-a> foo
  5374      bind .t.f
  5375  } -cleanup {
  5376      destroy .t.f
  5377  } -result <Mod4-Key-a>
  5378  
  5379  test bind-25.43 {modifier names} -setup {
  5380      frame .t.f -class Test -width 150 -height 100
  5381  } -body {
  5382      bind .t.f <Mod5-a> foo
  5383      bind .t.f
  5384  } -cleanup {
  5385      destroy .t.f
  5386  } -result <Mod5-Key-a>
  5387  
  5388  test bind-25.44 {modifier names} -setup {
  5389      frame .t.f -class Test -width 150 -height 100
  5390  } -body {
  5391      bind .t.f <Double-a> foo
  5392      bind .t.f
  5393  } -cleanup {
  5394      destroy .t.f
  5395  } -result <Double-Key-a>
  5396  
  5397  test bind-25.45 {modifier names} -setup {
  5398      frame .t.f -class Test -width 150 -height 100
  5399  } -body {
  5400      bind .t.f <Triple-a> foo
  5401      bind .t.f
  5402  } -cleanup {
  5403      destroy .t.f
  5404  } -result <Triple-Key-a>
  5405  
  5406  test bind-25.46 {modifier names} -setup {
  5407      frame .t.f -class Test -width 150 -height 100
  5408  } -body {
  5409      bind .t.f {<Double 1>} foo
  5410      bind .t.f
  5411  } -cleanup {
  5412      destroy .t.f
  5413  } -result <Double-Button-1>
  5414  
  5415  test bind-25.47 {modifier names} -setup {
  5416      frame .t.f -class Test -width 150 -height 100
  5417  } -body {
  5418      bind .t.f <Triple-1> foo
  5419      bind .t.f
  5420  } -cleanup {
  5421      destroy .t.f
  5422  } -result <Triple-Button-1>
  5423  
  5424  test bind-25.48 {modifier names} -setup {
  5425      frame .t.f -class Test -width 150 -height 100
  5426  } -body {
  5427      bind .t.f {<M1-M2 M3-M4 B1-Control-a>} foo
  5428      bind .t.f
  5429  } -cleanup {
  5430      destroy .t.f
  5431  } -result <Control-B1-Mod1-Mod2-Mod3-Mod4-Key-a>
  5432  
  5433  test bind-25.49 {modifier names} -setup {
  5434      frame .t.f -class Test -width 150 -height 100
  5435  } -body {
  5436      bind .t.f <Extended-Return> foo
  5437      bind .t.f
  5438  } -cleanup {
  5439      destroy .t.f
  5440  } -result <Extended-Key-Return>
  5441  
  5442  
  5443  
  5444  test bind-26.1 {event names} -setup {
  5445      frame .t.f -class Test -width 150 -height 100
  5446  } -body {
  5447      bind .t.f <FocusIn> {nothing}
  5448      bind .t.f
  5449  } -cleanup {
  5450      destroy .t.f
  5451  } -result <FocusIn>
  5452  test bind-26.2 {event names} -setup {
  5453      frame .t.f -class Test -width 150 -height 100
  5454  } -body {
  5455      bind .t.f <FocusOut> {nothing}
  5456      bind .t.f
  5457  } -cleanup {
  5458      destroy .t.f
  5459  } -result <FocusOut>
  5460  test bind-26.3 {event names} -setup {
  5461      frame .t.f -class Test -width 150 -height 100
  5462      pack .t.f
  5463      focus -force .t.f
  5464      update
  5465  } -body {
  5466      bind .t.f <Destroy> {lappend x "destroyed"}
  5467      set x [bind .t.f]
  5468      destroy .t.f
  5469      set x
  5470  } -cleanup {
  5471      destroy .t.f
  5472  } -result {<Destroy> destroyed}
  5473  
  5474  test bind-26.4 {event names: Motion} -setup {
  5475      frame .t.f -class Test -width 150 -height 100
  5476      pack .t.f
  5477      focus -force .t.f
  5478      update
  5479  } -body {
  5480      bind .t.f <Motion> "set x {event Motion}"
  5481      set x xyzzy
  5482      event generate .t.f <Motion>
  5483      list $x [bind .t.f]
  5484  } -cleanup {
  5485      destroy .t.f
  5486  } -result {{event Motion} <Motion>}
  5487  
  5488  test bind-26.5 {event names: Button} -setup {
  5489      frame .t.f -class Test -width 150 -height 100
  5490      pack .t.f
  5491      focus -force .t.f
  5492      update
  5493  } -body {
  5494      bind .t.f <Button> "set x {event Button}"
  5495      set x xyzzy
  5496      event generate .t.f <Button>
  5497      list $x [bind .t.f]
  5498  } -cleanup {
  5499      destroy .t.f
  5500  } -result {{event Button} <Button>}
  5501  
  5502  test bind-26.6 {event names: ButtonPress} -setup {
  5503      frame .t.f -class Test -width 150 -height 100
  5504      pack .t.f
  5505      focus -force .t.f
  5506      update
  5507  } -body {
  5508      bind .t.f <ButtonPress> "set x {event ButtonPress}"
  5509      set x xyzzy
  5510      event generate .t.f <ButtonPress>
  5511      list $x [bind .t.f]
  5512  } -cleanup {
  5513      destroy .t.f
  5514  } -result {{event ButtonPress} <Button>}
  5515  
  5516  test bind-26.7 {event names: ButtonRelease} -setup {
  5517      frame .t.f -class Test -width 150 -height 100
  5518      pack .t.f
  5519      focus -force .t.f
  5520      update
  5521  } -body {
  5522      bind .t.f <ButtonRelease> "set x {event ButtonRelease}"
  5523      set x xyzzy
  5524      event generate .t.f <ButtonRelease>
  5525      list $x [bind .t.f]
  5526  } -cleanup {
  5527      destroy .t.f
  5528  } -result {{event ButtonRelease} <ButtonRelease>}
  5529  
  5530  test bind-26.8 {event names: Colormap} -setup {
  5531      frame .t.f -class Test -width 150 -height 100
  5532      pack .t.f
  5533      focus -force .t.f
  5534      update
  5535  } -body {
  5536      bind .t.f <Colormap> "set x {event Colormap}"
  5537      set x xyzzy
  5538      event generate .t.f <Colormap>
  5539      list $x [bind .t.f]
  5540  } -cleanup {
  5541      destroy .t.f
  5542  } -result {{event Colormap} <Colormap>}
  5543  
  5544  test bind-26.9 {event names: Enter} -setup {
  5545      frame .t.f -class Test -width 150 -height 100
  5546      pack .t.f
  5547      focus -force .t.f
  5548      update
  5549  } -body {
  5550      bind .t.f <Enter> "set x {event Enter}"
  5551      set x xyzzy
  5552      event generate .t.f <Enter>
  5553      list $x [bind .t.f]
  5554  } -cleanup {
  5555      destroy .t.f
  5556  } -result {{event Enter} <Enter>}
  5557  
  5558  test bind-26.10 {event names: Leave} -setup {
  5559      frame .t.f -class Test -width 150 -height 100
  5560      pack .t.f
  5561      focus -force .t.f
  5562      update
  5563  } -body {
  5564      bind .t.f <Leave> "set x {event Leave}"
  5565      set x xyzzy
  5566      event generate .t.f <Leave>
  5567      list $x [bind .t.f]
  5568  } -cleanup {
  5569      destroy .t.f
  5570  } -result {{event Leave} <Leave>}
  5571  
  5572  test bind-26.11 {event names: Expose} -setup {
  5573      frame .t.f -class Test -width 150 -height 100
  5574      pack .t.f
  5575      focus -force .t.f
  5576      update
  5577  } -body {
  5578      bind .t.f <Expose> "set x {event Expose}"
  5579      set x xyzzy
  5580      event generate .t.f <Expose>
  5581      list $x [bind .t.f]
  5582  } -cleanup {
  5583      destroy .t.f
  5584  } -result {{event Expose} <Expose>}
  5585  
  5586  test bind-26.12 {event names: Key} -setup {
  5587      frame .t.f -class Test -width 150 -height 100
  5588      pack .t.f
  5589      focus -force .t.f
  5590      update
  5591  } -body {
  5592      bind .t.f <Key> "set x {event Key}"
  5593      set x xyzzy
  5594      event generate .t.f <Key>
  5595      list $x [bind .t.f]
  5596  } -cleanup {
  5597      destroy .t.f
  5598  } -result {{event Key} <Key>}
  5599  
  5600  test bind-26.13 {event names: KeyPress} -setup {
  5601      frame .t.f -class Test -width 150 -height 100
  5602      pack .t.f
  5603      focus -force .t.f
  5604      update
  5605  } -body {
  5606      bind .t.f <KeyPress> "set x {event KeyPress}"
  5607      set x xyzzy
  5608      event generate .t.f <KeyPress>
  5609      list $x [bind .t.f]
  5610  } -cleanup {
  5611      destroy .t.f
  5612  } -result {{event KeyPress} <Key>}
  5613  
  5614  test bind-26.14 {event names: KeyRelease} -setup {
  5615      frame .t.f -class Test -width 150 -height 100
  5616      pack .t.f
  5617      focus -force .t.f
  5618      update
  5619  } -body {
  5620      bind .t.f <KeyRelease> "set x {event KeyRelease}"
  5621      set x xyzzy
  5622      event generate .t.f <KeyRelease>
  5623      list $x [bind .t.f]
  5624  } -cleanup {
  5625      destroy .t.f
  5626  } -result {{event KeyRelease} <KeyRelease>}
  5627  
  5628  test bind-26.15 {event names: Property} -setup {
  5629      frame .t.f -class Test -width 150 -height 100
  5630      pack .t.f
  5631      focus -force .t.f
  5632      update
  5633  } -body {
  5634      bind .t.f <Property> "set x {event Property}"
  5635      set x xyzzy
  5636      event generate .t.f <Property>
  5637      list $x [bind .t.f]
  5638  } -cleanup {
  5639      destroy .t.f
  5640  } -result {{event Property} <Property>}
  5641  
  5642  test bind-26.16 {event names: Visibility} -setup {
  5643      frame .t.f -class Test -width 150 -height 100
  5644      pack .t.f
  5645      focus -force .t.f
  5646      update
  5647  } -body {
  5648      bind .t.f <Visibility> "set x {event Visibility}"
  5649      set x xyzzy
  5650      event generate .t.f <Visibility>
  5651      list $x [bind .t.f]
  5652  } -cleanup {
  5653      destroy .t.f
  5654  } -result {{event Visibility} <Visibility>}
  5655  
  5656  test bind-26.17 {event names: Activate} -setup {
  5657      frame .t.f -class Test -width 150 -height 100
  5658      pack .t.f
  5659      focus -force .t.f
  5660      update
  5661  } -body {
  5662      bind .t.f <Activate> "set x {event Activate}"
  5663      set x xyzzy
  5664      event generate .t.f <Activate>
  5665      list $x [bind .t.f]
  5666  } -cleanup {
  5667      destroy .t.f
  5668  } -result {{event Activate} <Activate>}
  5669  
  5670  test bind-26.18 {event names: Deactivate} -setup {
  5671      frame .t.f -class Test -width 150 -height 100
  5672      pack .t.f
  5673      focus -force .t.f
  5674      update
  5675  } -body {
  5676      bind .t.f <Deactivate> "set x {event Deactivate}"
  5677      set x xyzzy
  5678      event generate .t.f <Deactivate>
  5679      list $x [bind .t.f]
  5680  } -cleanup {
  5681      destroy .t.f
  5682  } -result {{event Deactivate} <Deactivate>}
  5683  
  5684  
  5685  # These events require an extra argument to [event generate]
  5686  test bind-26.19 {event names: Circulate} -setup {
  5687      frame .t.f -class Test -width 150 -height 100
  5688      pack .t.f
  5689      focus -force .t.f
  5690      update
  5691  } -body {
  5692      bind .t.f <Circulate> "set x {event Circulate}"
  5693      set x xyzzy
  5694      event generate .t.f <Circulate>
  5695      list $x [bind .t.f]
  5696  } -cleanup {
  5697      destroy .t.f
  5698  } -result {{event Circulate} <Circulate>}
  5699  
  5700  test bind-26.20 {event names: Configure} -setup {
  5701      frame .t.f -class Test -width 150 -height 100
  5702      pack .t.f
  5703      focus -force .t.f
  5704      update
  5705  } -body {
  5706      bind .t.f <Configure> "set x {event Configure}"
  5707      set x xyzzy
  5708      event generate .t.f <Configure>
  5709      list $x [bind .t.f]
  5710  } -cleanup {
  5711      destroy .t.f
  5712  } -result {{event Configure} <Configure>}
  5713  
  5714  test bind-26.21 {event names: Gravity} -setup {
  5715      frame .t.f -class Test -width 150 -height 100
  5716      pack .t.f
  5717      focus -force .t.f
  5718      update
  5719  } -body {
  5720      bind .t.f <Gravity> "set x {event Gravity}"
  5721      set x xyzzy
  5722      event generate .t.f <Gravity>
  5723      list $x [bind .t.f]
  5724  } -cleanup {
  5725      destroy .t.f
  5726  } -result {{event Gravity} <Gravity>}
  5727  
  5728  test bind-26.22 {event names: Map} -setup {
  5729      frame .t.f -class Test -width 150 -height 100
  5730      pack .t.f
  5731      focus -force .t.f
  5732      update
  5733  } -body {
  5734      bind .t.f <Map> "set x {event Map}"
  5735      set x xyzzy
  5736      event generate .t.f <Map>
  5737      list $x [bind .t.f]
  5738  } -cleanup {
  5739      destroy .t.f
  5740  } -result {{event Map} <Map>}
  5741  
  5742  test bind-26.23 {event names: Reparent} -setup {
  5743      frame .t.f -class Test -width 150 -height 100
  5744      pack .t.f
  5745      focus -force .t.f
  5746      update
  5747  } -body {
  5748      bind .t.f <Reparent> "set x {event Reparent}"
  5749      set x xyzzy
  5750      event generate .t.f <Reparent>
  5751      list $x [bind .t.f]
  5752  } -cleanup {
  5753      destroy .t.f
  5754  } -result {{event Reparent} <Reparent>}
  5755  
  5756  test bind-26.24 {event names: Unmap} -setup {
  5757      frame .t.f -class Test -width 150 -height 100
  5758      pack .t.f
  5759      focus -force .t.f
  5760      update
  5761  } -body {
  5762      bind .t.f <Unmap> "set x {event Unmap}"
  5763      set x xyzzy
  5764      event generate .t.f <Unmap>
  5765      list $x [bind .t.f]
  5766  } -cleanup {
  5767      destroy .t.f
  5768  } -result {{event Unmap} <Unmap>}
  5769  
  5770  
  5771  test bind-27.1 {button names} -body {
  5772      bind .t <Expose-1> foo
  5773  } -returnCodes error -result {specified button "1" for non-button event}
  5774  test bind-27.2 {button names} -body {
  5775      bind .t <Button-6> foo
  5776  } -returnCodes error -result {bad button number "6"}
  5777  test bind-27.3 {button names} -setup {
  5778      frame .t.f -class Test -width 150 -height 100
  5779      pack .t.f
  5780      focus -force .t.f
  5781      update
  5782  } -body {
  5783      bind .t.f <Button-1> {lappend x "button 1"}
  5784      set x [bind .t.f]
  5785      event generate .t.f <Button-1>
  5786      event generate .t.f <ButtonRelease-1>
  5787      set x
  5788  } -cleanup {
  5789      destroy .t.f
  5790  } -result {<Button-1> {button 1}}
  5791  test bind-27.4 {button names} -setup {
  5792      frame .t.f -class Test -width 150 -height 100
  5793      pack .t.f
  5794      focus -force .t.f
  5795      update
  5796  } -body {
  5797      bind .t.f <Button-2> {lappend x "button 2"}
  5798      set x [bind .t.f]
  5799      event generate .t.f <Button-2>
  5800      event generate .t.f <ButtonRelease-2>
  5801      set x
  5802  } -cleanup {
  5803      destroy .t.f
  5804  } -result {<Button-2> {button 2}}
  5805  test bind-27.5 {button names} -setup {
  5806      frame .t.f -class Test -width 150 -height 100
  5807      pack .t.f
  5808      focus -force .t.f
  5809      update
  5810  } -body {
  5811      bind .t.f <Button-3> {lappend x "button 3"}
  5812      set x [bind .t.f]
  5813      event generate .t.f <Button-3>
  5814      event generate .t.f <ButtonRelease-3>
  5815      set x
  5816  } -cleanup {
  5817      destroy .t.f
  5818  } -result {<Button-3> {button 3}}
  5819  test bind-27.6 {button names} -setup {
  5820      frame .t.f -class Test -width 150 -height 100
  5821      pack .t.f
  5822      focus -force .t.f
  5823      update
  5824  } -body {
  5825      bind .t.f <Button-4> {lappend x "button 4"}
  5826      set x [bind .t.f]
  5827      event generate .t.f <Button-4>
  5828      event generate .t.f <ButtonRelease-4>
  5829      set x
  5830  } -cleanup {
  5831      destroy .t.f
  5832  } -result {<Button-4> {button 4}}
  5833  test bind-27.7 {button names} -setup {
  5834      frame .t.f -class Test -width 150 -height 100
  5835      pack .t.f
  5836      focus -force .t.f
  5837      update
  5838  } -body {
  5839      bind .t.f <Button-5> {lappend x "button 5"}
  5840      set x [bind .t.f]
  5841      event generate .t.f <Button-5>
  5842      event generate .t.f <ButtonRelease-5>
  5843      set x
  5844  } -cleanup {
  5845      destroy .t.f
  5846  } -result {<Button-5> {button 5}}
  5847  
  5848  test bind-28.1 {keysym names} -body {
  5849      bind .t <Expose-a> foo
  5850  } -returnCodes error -result {specified keysym "a" for non-key event}
  5851  test bind-28.2 {keysym names} -body {
  5852      bind .t <Gorp> foo
  5853  } -returnCodes error -result {bad event type or keysym "Gorp"}
  5854  test bind-28.3 {keysym names} -body {
  5855      bind .t <Key-Stupid> foo
  5856  } -returnCodes error -result {bad event type or keysym "Stupid"}
  5857  test bind-28.4 {keysym names} -body {
  5858      frame .t.f -class Test -width 150 -height 100
  5859      bind .t.f <a> foo
  5860      bind .t.f
  5861  } -cleanup {
  5862      destroy .t.f
  5863  } -result {a}
  5864  
  5865  test bind-28.5 {keysym names} -setup {
  5866      frame .t.f -class Test -width 150 -height 100
  5867      pack .t.f
  5868      focus -force .t.f
  5869      update
  5870  } -body {
  5871      bind .t.f <Key-colon> "lappend x \"keysym received\""
  5872      bind .t.f <Key-underscore> "lappend x {bad binding match}"
  5873      set x [lsort [bind .t.f]]
  5874      event generate .t.f <Key-colon> ;# -state 0
  5875      set x
  5876  } -cleanup {
  5877      destroy .t.f
  5878  } -result {: _ {keysym received}}
  5879  test bind-28.6 {keysym names} -setup {
  5880      frame .t.f -class Test -width 150 -height 100
  5881      pack .t.f
  5882      focus -force .t.f
  5883      update
  5884  } -body {
  5885      bind .t.f <Key-Return> "lappend x \"keysym Return\""
  5886      bind .t.f <Key-x> "lappend x {bad binding match}"
  5887      set x [lsort [bind .t.f]]
  5888      event generate .t.f <Key-Return> -state 0
  5889      set x
  5890  } -cleanup {
  5891      destroy .t.f
  5892  } -result {<Key-Return> x {keysym Return}}
  5893  test bind-28.7 {keysym names} -setup {
  5894      frame .t.f -class Test -width 150 -height 100
  5895      pack .t.f
  5896      focus -force .t.f
  5897      update
  5898  } -body {
  5899      bind .t.f <Key-X> "lappend x \"keysym X\""
  5900      bind .t.f <Key-x> "lappend x {bad binding match}"
  5901      set x [lsort [bind .t.f]]
  5902      event generate .t.f <Key-X> -state 1
  5903      set x
  5904  } -cleanup {
  5905      destroy .t.f
  5906  } -result {X x {keysym X}}
  5907  test bind-28.8 {keysym names} -setup {
  5908      frame .t.f -class Test -width 150 -height 100
  5909      pack .t.f
  5910      focus -force .t.f
  5911      update
  5912  } -body {
  5913      bind .t.f <Key-X> "lappend x \"keysym X\""
  5914      bind .t.f <Key-x> "lappend x {bad binding match}"
  5915      set x [lsort [bind .t.f]]
  5916      event generate .t.f <Key-X> -state 1
  5917      set x
  5918  } -cleanup {
  5919      destroy .t.f
  5920  } -result {X x {keysym X}}
  5921  
  5922  
  5923  test bind-29.1 {Tk_BackgroundError procedure} -setup {
  5924      proc bgerror msg {
  5925          global x errorInfo
  5926          set x [list $msg $errorInfo]
  5927      }
  5928      frame .t.f -class Test -width 150 -height 100
  5929      pack .t.f
  5930      focus -force .t.f
  5931      update
  5932  } -body {
  5933      bind .t.f <Button> {error "This is a test"}
  5934      set x none
  5935      event generate .t.f <Button>
  5936      event generate .t.f <ButtonRelease>
  5937      update
  5938      set x
  5939  } -cleanup {
  5940      destroy .t.f
  5941      rename bgerror {}
  5942  } -result {{This is a test} {This is a test
  5943      while executing
  5944  "error "This is a test""
  5945      (command bound to event)}}
  5946      
  5947  test bind-29.2 {Tk_BackgroundError procedure} -setup {
  5948      proc do {} {
  5949          event generate .t.f <Button>
  5950          event generate .t.f <ButtonRelease>
  5951      }
  5952      proc bgerror msg {
  5953          global x errorInfo
  5954          set x [list $msg $errorInfo]
  5955      }
  5956      frame .t.f -class Test -width 150 -height 100
  5957      pack .t.f
  5958      focus -force .t.f
  5959      update
  5960  } -body {
  5961      bind .t.f <Button> {error Message2}
  5962      set x none
  5963      do
  5964      update
  5965      set x
  5966  } -cleanup {
  5967      destroy .t.f
  5968      rename bgerror {}
  5969      rename do {}
  5970  } -result {Message2 {Message2
  5971      while executing
  5972  "error Message2"
  5973      (command bound to event)}}
  5974  
  5975  
  5976  test bind-30.1 {MouseWheel events} -setup {
  5977      frame .t.f -class Test -width 150 -height 100
  5978      pack .t.f
  5979      focus -force .t.f
  5980      update
  5981      set x {}
  5982  } -body {
  5983      bind .t.f <MouseWheel> {set x Wheel}
  5984      event generate .t.f <MouseWheel>
  5985      set x
  5986  } -cleanup {
  5987      destroy .t.f
  5988  } -result {Wheel}
  5989  test bind-30.2 {MouseWheel events} -setup {
  5990      frame .t.f -class Test -width 150 -height 100
  5991      pack .t.f
  5992      focus -force .t.f
  5993      update
  5994      set x {}
  5995  } -body {
  5996      bind .t.f <MouseWheel> {set x %D}
  5997      event generate .t.f <MouseWheel> -delta 120
  5998      set x
  5999  } -cleanup {
  6000      destroy .t.f
  6001  } -result {120}
  6002  test bind-30.3 {MouseWheel events} -setup {
  6003      frame .t.f -class Test -width 150 -height 100
  6004      pack .t.f
  6005      focus -force .t.f
  6006      update
  6007      set x {}
  6008  } -body {
  6009      bind .t.f <MouseWheel> {set x "%D %x %y"}
  6010      event generate .t.f <MouseWheel> -delta 240 -x 10 -y 30
  6011      set x
  6012  } -cleanup {
  6013      destroy .t.f
  6014  } -result {240 10 30}
  6015  
  6016  
  6017  test bind-31.1 {virtual event user_data field - bad generation} -setup {
  6018      frame .t.f -class Test -width 150 -height 100
  6019      pack .t.f
  6020      focus -force .t.f
  6021      update
  6022  } -body {
  6023  # Check no confusion, since Focus events use %d for something else
  6024      event generate .t.f <FocusIn> -data foo
  6025  } -cleanup {
  6026      destroy .t.f
  6027  } -returnCodes error -result {<FocusIn> event doesn't accept "-data" option}
  6028  test bind-31.2 {virtual event user_data field - NULL, synch} -setup {
  6029      frame .t.f -class Test -width 150 -height 100
  6030      pack .t.f
  6031      focus -force .t.f
  6032      update
  6033      set x {}
  6034  } -body {
  6035      bind .t.f <<TestUserData>> {set x "TestUserData >%d<"}
  6036      event generate .t.f <<TestUserData>>
  6037      set x
  6038  } -cleanup {
  6039      destroy .t.f
  6040  } -result {TestUserData >{}<}
  6041  test bind-31.3 {virtual event user_data field - shared, synch} -setup {
  6042      frame .t.f -class Test -width 150 -height 100
  6043      pack .t.f
  6044      focus -force .t.f
  6045      update
  6046      set x {}
  6047  } -body {
  6048      bind .t.f <<TestUserData>> {set x "TestUserData >%d<"}
  6049      event generate .t.f <<TestUserData>> -data "foo bar"
  6050      set x
  6051  } -cleanup {
  6052      destroy .t.f
  6053  } -result {TestUserData >foo bar<}
  6054  test bind-31.4 {virtual event user_data field - unshared, synch} -setup {
  6055      frame .t.f -class Test -width 150 -height 100
  6056      pack .t.f
  6057      focus -force .t.f
  6058      update
  6059      set x {}
  6060  } -body {
  6061      bind .t.f <<TestUserData>> {set x "TestUserData >%d<"}
  6062      event generate .t.f <<TestUserData>> -data [string index abc 1]
  6063      set x
  6064  } -cleanup {
  6065      destroy .t.f
  6066  } -result {TestUserData >b<}
  6067  # Note that asynch event handling can only really catch any potential
  6068  # extra errors when used in combination with a tool like Purify or
  6069  # Valgrind. Such testing is rarely done, but at least any problem with
  6070  # reference handling will eventually show up with these tests...
  6071  test bind-31.5 {virtual event user_data field - NULL, asynch} -setup {
  6072      frame .t.f -class Test -width 150 -height 100
  6073      pack .t.f
  6074      focus -force .t.f
  6075      update
  6076      set x {}
  6077  } -body {
  6078      bind .t.f <<TestUserData>> {set x "TestUserData >%d<"}
  6079      event generate .t.f <<TestUserData>> -when head
  6080      list $x [update] $x
  6081  } -cleanup {
  6082      destroy .t.f
  6083  } -result {{} {} {TestUserData >{}<}}
  6084  test bind-31.6 {virtual event user_data field - shared, asynch} -setup {
  6085      frame .t.f -class Test -width 150 -height 100
  6086      pack .t.f
  6087      focus -force .t.f
  6088      update
  6089      set x {}
  6090  } -body {
  6091      bind .t.f <<TestUserData>> {set x "TestUserData >%d<"}
  6092      event generate .t.f <<TestUserData>> -data "foo bar" -when head
  6093      list $x [update] $x
  6094  } -cleanup {
  6095      destroy .t.f
  6096  } -result {{} {} {TestUserData >foo bar<}}
  6097  test bind-31.7 {virtual event user_data field - unshared, asynch} -setup {
  6098      frame .t.f -class Test -width 150 -height 100
  6099      pack .t.f
  6100      focus -force .t.f
  6101      update
  6102      set x {}
  6103  } -body {
  6104      bind .t.f <<TestUserData>> {set x "TestUserData >%d<"}
  6105      event generate .t.f <<TestUserData>> -data [string index abc 1] -when head
  6106      list $x [update] $x
  6107  } -cleanup {
  6108      destroy .t.f
  6109  } -result {{} {} {TestUserData >b<}}
  6110  
  6111  test bind-32.1 {-warp, window was destroyed before the idle callback DoWarp} -setup {
  6112      frame .t.f
  6113      pack .t.f
  6114      focus -force .t.f
  6115      update
  6116  } -body {
  6117      event generate .t.f <Button-1> -warp 1
  6118      event generate .t.f <ButtonRelease-1>
  6119      destroy .t.f
  6120      update  ;  # shall simply not crash
  6121  } -cleanup {
  6122  } -result {}
  6123  test bind-32.2 {detection of double click should not fail} -setup {
  6124      pack [frame .t.f]
  6125      focus -force .t.f
  6126      bind .t.f <Double-Button-1> { set x "Double" }
  6127      update
  6128      set x {}
  6129  } -body {
  6130      event generate .t.f <ButtonPress-1>
  6131      event generate .t.f <ButtonRelease-1>
  6132      # Simulate a lot of intervening exposure events, with old implementation
  6133      # the event loop overflows, and the double click will not be detected.
  6134      # But new implementation should work properly.
  6135      for {set i 0} {$i < 1000} {incr i} {
  6136          event generate .t.f <Expose>
  6137      }
  6138      event generate .t.f <ButtonPress-1>
  6139      event generate .t.f <ButtonRelease-1>
  6140      set x
  6141  } -cleanup {
  6142      destroy .t.f
  6143  } -result {Double}
  6144  test bind-32.3 {should trigger best match of modifier states} -setup {
  6145      pack [frame .t.f]
  6146      focus -force .t.f
  6147      update
  6148      set x {}
  6149  } -body {
  6150      bind .t.f <Alt-Control-Key-A> { lappend x "Alt-Control" }
  6151      bind .t.f <Shift-Control-Key-A> { lappend x "Shift-Control" }
  6152      bind .t.f <Shift-Key-A> { lappend x "Shift" }
  6153      event generate .t.f <Alt-Control-Key-A>
  6154      set x
  6155  } -cleanup {
  6156      destroy .t.f
  6157  } -result {Shift-Control}
  6158  test bind-32.4 {should not trigger Double-1} -setup {
  6159      pack [frame .t.f]
  6160      focus -force .t.f
  6161      update
  6162      set x {}
  6163  } -body {
  6164      bind .t.f <Double-1> { set x "Double" }
  6165      event generate .t.f <1> -time current
  6166      after 1000
  6167      event generate .t.f <1> -time current
  6168      set x
  6169  } -cleanup {
  6170      destroy .t.f
  6171  } -result {}
  6172  test bind-32.5 {should trigger Quadruple-1} -setup {
  6173      pack [frame .t.f]
  6174      focus -force .t.f
  6175      update
  6176      set x {}
  6177  } -body {
  6178      bind .t.f <Quadruple-1> { set x "Quadruple" }
  6179      bind .t.f <Triple-1> { set x "Triple" }
  6180      bind .t.f <Double-1> { set x "Double" }
  6181      bind .t.f <1> { set x "Single" }
  6182      # Old implementation triggers "Double", but new implementation will
  6183      # trigger "Quadruple", the latter behavior conforms to other toolkits.
  6184      event generate .t.f <Button-1> -time 0
  6185      event generate .t.f <Button-1> -time 400
  6186      event generate .t.f <Button-1> -time 800
  6187      event generate .t.f <Button-1> -time 1200
  6188      set x
  6189  } -cleanup {
  6190      destroy .t.f
  6191  } -result {Quadruple}
  6192  test bind-32.6 {problem with sendevent} -setup {
  6193      pack [frame .t.f]
  6194      focus -force .t.f
  6195      update
  6196      set x {}
  6197  } -body {
  6198      # old implementation is losing sendevent value
  6199      bind .t.f <FocusIn> { set x "sendevent=%E" }
  6200      event generate .t.f <FocusIn> -sendevent 1
  6201      set x
  6202  } -cleanup {
  6203      destroy .t.f
  6204  } -result {sendevent=1}
  6205  test bind-32.7 {test sequences} -setup {
  6206      pack [frame .t.f]
  6207      focus -force .t.f
  6208      update
  6209      set x {}
  6210  } -body {
  6211      bind .t.f <Double-1> { lappend x "Double" }
  6212      bind .t.f <1><1><a> { lappend x "11" }
  6213      event generate .t.f <1>
  6214      event generate .t.f <1>
  6215      event generate .t.f <a>
  6216      set x
  6217  } -cleanup {
  6218      destroy .t.f
  6219  } -result {Double 11}
  6220  test bind-32.8 {test sequences} -setup {
  6221      pack [frame .t.f]
  6222      focus -force .t.f
  6223      update
  6224      set x {}
  6225  } -body {
  6226      bind .t.f <a><1><Double-1><1><a> { lappend x "Double" }
  6227      event generate .t.f <a>
  6228      event generate .t.f <1>
  6229      event generate .t.f <1>
  6230      event generate .t.f <1>
  6231      event generate .t.f <1>
  6232      event generate .t.f <a>
  6233      set x
  6234  } -cleanup {
  6235      destroy .t.f
  6236  } -result {Double}
  6237  test bind-32.9 {trigger events for modifier keys} -setup {
  6238      pack [frame .t.f]
  6239      focus -force .t.f
  6240      update
  6241      set x {}
  6242  } -body {
  6243      bind .t.f <Any-Key> { set x "Key" }
  6244      event generate .t.f <KeyPress> -keysym Caps_Lock
  6245      set x
  6246  } -cleanup {
  6247      destroy .t.f
  6248  } -result {Key}
  6249  test bind-32.10 {reset key state when destroying window} -setup {
  6250      set x {}
  6251  } -body {
  6252      pack [frame .t.f]; update; focus -force .t.f
  6253      bind .t.f <Key-A> { set x "A" }
  6254      event generate .t.f <KeyPress-A>
  6255      event generate .t.f <KeyPress-A>
  6256      destroy .t.f; update
  6257      pack [frame .t.f]; update; focus -force .t.f
  6258      bind .t.f <Key-A> { set x "A" }
  6259      bind .t.f <Double-Key-A> { set x "AA" }
  6260      event generate .t.f <KeyPress-A>
  6261      destroy .t.f
  6262      set x
  6263  } -result {A}
  6264  test bind-32.11 {match detailed virtual} -setup {
  6265      pack [frame .t.f -class Test]
  6266      focus -force .t.f
  6267      update
  6268      set x {}
  6269  } -body {
  6270      event add <<TestControlButton1>> <Control-Button-1>
  6271      bind Test <<TestControlButton1>> { set x "Control-Button-1" }
  6272      bind Test <Button-1> { set x "Button-1" }
  6273      bind .t.f <Button-1> { set x "Button-1" }
  6274      event generate .t.f <Control-ButtonPress-1>
  6275      set x
  6276  } -cleanup {
  6277      destroy .t.f
  6278      event delete <<TestControlButton1>>
  6279      bind Test <Button-1> {#}
  6280  } -result {Control-Button-1}
  6281  test bind-32.12 {don't detect repetition when window has changed} -setup {
  6282      pack [frame .t.f]
  6283      pack [frame .t.g]
  6284      focus -force .t.f
  6285      update
  6286      set x {}
  6287  } -body {
  6288      bind .t.f <Button-1> { set x "1" }
  6289      bind .t.f <Double-Button-1> { set x "11" }
  6290      event generate .t.f <ButtonPress-1>
  6291      event generate .t.g <ButtonPress-1>
  6292      event generate .t.f <ButtonPress-1>
  6293      set x
  6294  } -cleanup {
  6295      destroy .t.f
  6296      destroy .t.g
  6297  } -result {1}
  6298  test bind-32.13 {don't detect repetition when window has changed} -setup {
  6299      pack [frame .t.f]
  6300      pack [frame .t.g]
  6301      update
  6302      set x {}
  6303  } -body {
  6304      bind .t.f <Key-A> { set x "A" }
  6305      bind .t.f <Double-Key-A> { set x "AA" }
  6306      focus -force .t.f; event generate .t.f <KeyPress-A>
  6307      focus -force .t.g; event generate .t.g <KeyPress-A>
  6308      focus -force .t.f; event generate .t.f <KeyPress-A>
  6309      set x
  6310  } -cleanup {
  6311      destroy .t.f
  6312      destroy .t.g
  6313  } -result {A}
  6314  test bind-32.14 {don't detect repetition when window has changed} -setup {
  6315      pack [frame .t.f]
  6316      pack [frame .t.g]
  6317      update
  6318      set x {}
  6319  } -body {
  6320      bind .t.f <ButtonPress-1> { set x "1" }
  6321      bind .t.f <Double-ButtonPress-1> { set x "11" }
  6322      focus -force .t.f; event generate .t.f <ButtonPress-1>
  6323      focus -force .t.g; event generate .t.g <ButtonPress-1>
  6324      focus -force .t.f; event generate .t.f <ButtonPress-1>
  6325      set x
  6326  } -cleanup {
  6327      destroy .t.f
  6328      destroy .t.g
  6329  } -result {1}
  6330  test bind-32.15 {reset button state when destroying window} -setup {
  6331      set x {}
  6332  } -body {
  6333      pack [frame .t.f]; update; focus -force .t.f
  6334      bind .t.f <ButtonPress-1> { set x "1" }
  6335      event generate .t.f <ButtonPress-1>
  6336      event generate .t.f <ButtonPress-1>
  6337      destroy .t.f; update
  6338      pack [frame .t.f]; update; focus -force .t.f
  6339      bind .t.f <ButtonPress-1> { set x "1" }
  6340      bind .t.f <Double-ButtonPress-1> { set x "11" }
  6341      event generate .t.f <ButtonPress-1>
  6342      destroy .t.f
  6343      set x
  6344  } -result {1}
  6345  
  6346  test bind-33.1 {prefer longest match} -setup {
  6347      pack [frame .t.f]
  6348      focus -force .t.f
  6349      update
  6350      set x {}
  6351  } -body {
  6352      bind .t.f <a><1><1> { lappend x "a11" }
  6353      bind .t.f <Double-1> { lappend x "Double" }
  6354      event generate .t.f <a>
  6355      event generate .t.f <1>
  6356      event generate .t.f <1>
  6357      set x
  6358  } -cleanup {
  6359      destroy .t.f
  6360  } -result {a11}
  6361  test bind-33.2 {should prefer more specialized event} -setup {
  6362      pack [frame .t.f]
  6363      focus -force .t.f
  6364      update
  6365      set x {}
  6366  } -body {
  6367      bind .t.f <Double-1> { lappend x "Double" }
  6368      bind .t.f <1><1> { lappend x "11" }
  6369      event generate .t.f <1>
  6370      event generate .t.f <1>
  6371      set x
  6372  } -cleanup {
  6373      destroy .t.f
  6374      # This test case shows that old implementation has an issue, because
  6375      # in my opinion it is expected that <Double-1> is matching, this binding
  6376      # is more specialized. But new implementation will be conform to old,
  6377      # and so "11" is the expected result.
  6378  } -result {11}
  6379  test bind-33.3 {should prefer more specialized event} -setup {
  6380      pack [frame .t.f]
  6381      focus -force .t.f
  6382      update
  6383      set x {}
  6384  } -body {
  6385      bind .t.f <a><Double-1><a> { lappend x "Double" }
  6386      bind .t.f <a><1><1><a> { lappend x "11" }
  6387      event generate .t.f <a>
  6388      event generate .t.f <1>
  6389      event generate .t.f <1>
  6390      event generate .t.f <a>
  6391      set x
  6392  } -cleanup {
  6393      destroy .t.f
  6394      # Also this test case shows that old implementation has an issue, it is
  6395      # expected that <a><Double-1><a> is matching, because <Double-1> is more
  6396      # specialized than <1><1>. But new implementation will be conform to old,
  6397      # and so "11" is the expected result.
  6398  } -result {11}
  6399  test bind-33.4 {should prefer more specialized event} -setup {
  6400      pack [frame .t.f]
  6401      focus -force .t.f
  6402      update
  6403      set x {}
  6404  } -body {
  6405      bind .t.f <1><1> { lappend x "11" }
  6406      bind .t.f <Double-1> { lappend x "Double" }
  6407      event generate .t.f <1> -time 0
  6408      event generate .t.f <1> -time 1000
  6409      set x
  6410  } -cleanup {
  6411      destroy .t.f
  6412      # This test case also shows that old implementation has an issue, because
  6413      # here <1><1> will be triggered correctly, but this is not consistent with
  6414      # test case 33.2.
  6415  } -result {11}
  6416  test bind-33.5 {prefer most specialized} -setup {
  6417      pack [frame .t.f]
  6418      focus -force .t.f
  6419      update
  6420      set x {}
  6421  } -body {
  6422      bind .t.f <1><1> { lappend x "11" }
  6423      bind .t.f <Double-ButtonPress> { lappend x "Double" }
  6424      event generate .t.f <1>
  6425      event generate .t.f <1>
  6426      set x
  6427  } -cleanup {
  6428      destroy .t.f
  6429  } -result {11}
  6430  test bind-33.6 {prefer most specialized} -setup {
  6431      pack [frame .t.f]
  6432      focus -force .t.f
  6433      update
  6434      set x {}
  6435  } -body {
  6436      bind .t.f <a><1><1><1><1><a> { lappend x "1111" }
  6437      bind .t.f <a><ButtonPress><Double-ButtonPress><ButtonPress><a> { lappend x "Any-Double-Any" }
  6438      event generate .t.f <a>
  6439      event generate .t.f <1>
  6440      event generate .t.f <1>
  6441      event generate .t.f <1>
  6442      event generate .t.f <1>
  6443      event generate .t.f <a>
  6444      set x
  6445  } -cleanup {
  6446      destroy .t.f
  6447  } -result {1111}
  6448  test bind-33.7 {prefer most specialized} -setup {
  6449      pack [frame .t.f]
  6450      focus -force .t.f
  6451      update
  6452      set x {}
  6453  } -body {
  6454      bind .t.f <ButtonPress-1><a> { lappend x "1" }
  6455      bind .t.f <ButtonPress><a> { lappend x "Any" }
  6456      event generate .t.f <1>
  6457      event generate .t.f <a>
  6458      set x
  6459  } -cleanup {
  6460      destroy .t.f
  6461  } -result {1}
  6462  test bind-33.8 {prefer most specialized} -setup {
  6463      pack [frame .t.f]
  6464      focus -force .t.f
  6465      update
  6466      set x {}
  6467  } -body {
  6468      bind .t.f <Double-ButtonPress-1><a> { lappend x "1" }
  6469      bind .t.f <ButtonPress><ButtonPress><a> { lappend x "Any" }
  6470      event generate .t.f <1>
  6471      event generate .t.f <1>
  6472      event generate .t.f <a>
  6473      set x
  6474  } -cleanup {
  6475      destroy .t.f
  6476  } -result {1}
  6477  test bind-33.9 {prefer last in case of homogeneous patterns} -setup {
  6478      pack [frame .t.f]
  6479      focus -force .t.f
  6480      update
  6481      set x {}
  6482  } -body {
  6483      bind .t.f <1><2><2><Double-1> { lappend x "first" }
  6484      bind .t.f <1><Double-2><1><1> { lappend x "last" }
  6485      event generate .t.f <1>
  6486      event generate .t.f <2>
  6487      event generate .t.f <2>
  6488      event generate .t.f <1>
  6489      event generate .t.f <1>
  6490      set x
  6491  } -cleanup {
  6492      destroy .t.f
  6493  } -result {last}
  6494  test bind-33.10 {prefer last in case of homogeneous patterns} -setup {
  6495      pack [frame .t.f]
  6496      focus -force .t.f
  6497      update
  6498      set x {}
  6499  } -body {
  6500      bind .t.f <1><Double-2><1><1> { lappend x "first" }
  6501      bind .t.f <1><2><2><Double-1> { lappend x "last" }
  6502      event generate .t.f <1>
  6503      event generate .t.f <2>
  6504      event generate .t.f <2>
  6505      event generate .t.f <1>
  6506      event generate .t.f <1>
  6507      set x
  6508  } -cleanup {
  6509      destroy .t.f
  6510  } -result {last}
  6511  test bind-33.11 {should prefer most specialized} -setup {
  6512      pack [frame .t.f]
  6513      focus -force .t.f
  6514      update
  6515      set x {}
  6516  } -body {
  6517      bind .t.f <2><Double-1><Double-2><Double-1><2><2> { lappend x "first" }
  6518      bind .t.f <2><1><1><2><2><Double-1><Double-2> { lappend x "last" }
  6519      event generate .t.f <2>
  6520      event generate .t.f <1>
  6521      event generate .t.f <1>
  6522      event generate .t.f <2>
  6523      event generate .t.f <2>
  6524      event generate .t.f <1>
  6525      event generate .t.f <1>
  6526      event generate .t.f <2>
  6527      event generate .t.f <2>
  6528      set x
  6529  } -cleanup {
  6530      destroy .t.f
  6531      # This test case shows that old implementation has an issue, because
  6532      # in my opinion it is expected that first one is matching, this binding
  6533      # is more specialized. But new implementation will be conform to old,
  6534      # and so "last" is the expected result.
  6535  } -result {last}
  6536  test bind-33.12 {prefer last in case of homogeneous patterns} -setup {
  6537      pack [frame .t.f]
  6538      focus -force .t.f
  6539      update
  6540      set x {}
  6541  } -body {
  6542      bind .t.f <Control-1><1> { lappend x "first" }
  6543      bind .t.f <1><Control-1> { lappend x "last" }
  6544      event generate .t.f <Control-1>
  6545      event generate .t.f <Control-1>
  6546      set x
  6547  } -cleanup {
  6548      destroy .t.f
  6549  } -result {last}
6550 test bind-33.13 {prefer last in case of homogeneous patterns} -setup { 6551 pack [frame .t.f] 6552 focus -force .t.f 6553 update 6554 set x {} 6555 } -body { 6556 bind .t.f <1><Control-1> { lappend x "first" } 6557 bind .t.f <Control-1><1> { lappend x "last" } 6558 event generate .t.f <Control-1> 6559 event generate .t.f <Control-1> 6560 set x 6561 } -cleanup { 6562 destroy .t.f 6563 # Old implementation fails, and returns "first", but this is wrong, 6564 # because both bindings are homogeneous equal, so the latter must 6565 # be preferred. 6566 } -result {last}
6567 6568 6569 # cleanup 6570 cleanupTests 6571 return 6572 6573 # vi:set ts=4 sw=4 et: 6574 # Local Variables: 6575 # mode: tcl 6576 # End: