开通博客赚积分
发布资源赚积分
分类

源码开发语言/平台
当前位置：首页 > 源码/资料 > Windows编程 > 通讯编程 > 查看源码
menu.test
资源名称：ns-allinone-2.33.tar.gz　[点击查看]
上传用户：rrhhcc
上传日期：2015-12-11
资源大小：54129k
文件大小：78k
源码类别：

通讯编程

开发平台：

Visual C++

menu.test：源码内容
  1. # This file is a Tcl script to test menus in Tk.  It is
  2. # organized in the standard fashion for Tcl tests.
  3. #
  4. # Copyright (c) 1995-1997 Sun Microsystems, Inc.
  5. # Copyright (c) 1998-1999 by Scriptics Corporation.
  6. # All rights reserved.
  7. #
  8. # RCS: @(#) $Id: menu.test,v 1.13.2.2 2006/11/24 18:11:54 hobbs Exp $
  10. package require tcltest 2.1
  11. namespace import -force tcltest::configure
  12. namespace import -force tcltest::testsDirectory
  13. configure -testdir [file join [pwd] [file dirname [info script]]]
  14. configure -loadfile [file join [testsDirectory] constraints.tcl]
  15. tcltest::loadTestedCommands
  17. test menu-1.1 {Tk_MenuCmd procedure} {
  18.     list [catch menu msg] $msg
  19. } {1 {wrong # args: should be "menu pathName ?options?"}}
  20. test menu-1.2 {Tk_MenuCmd procedure} {
  21.     list [catch "menu bogus" msg] $msg
  22. } {1 {bad window path name "bogus"}}
  23. test menu-1.3 {Tk_MenuCmd procedure} {
  24.     list [catch "menu .m1 foo" msg] $msg
  25. } {1 {unknown option "foo"}}
  26. test menu-1.4 {Tk_MenuCmd procedure} {
  27.     catch {destroy .m1}
  28.     list [catch {menu .m1} msg] $msg [destroy .m1]
  29. } {0 .m1 {}}
  30. test menu-1.5 {Tk_MenuCmd - creating menubar} {
  31.     catch {destroy .m1}
  32.     menu .m1
  33.     .m1 add cascade -label Test -menu ""
  34.     list [. configure -menu .m1] [. configure -menu ""] [destroy .m1]
  35. } {{} {} {}}
  36. test menu-1.6 {Tk_MenuCmd procedure menu ref no cascade} {
  37.     catch {destroy .t2}
  38.     catch {destroy .m1}
  39.     toplevel .t2 -menu .m1
  40.     wm geometry .t2 +0+0
  41.     list [catch {menu .m1} msg] $msg [destroy .m1 .t2]
  42. } {0 .m1 {}}
  43. test menu-1.7 {Tk_MenuCmd procedure one clone cascade} {
  44.     catch {destroy .m1}
  45.     catch {destroy .m2}
  46.     catch {destroy .t2}
  47.     toplevel .t2 -menu .m1
  48.     wm geometry .t2 +0+0
  49.     menu .m1
  50.     .m1 add cascade -menu .m2
  51.     list [catch {menu .m2} msg] $msg [destroy .t2 .m1 .m2]
  52. } {0 .m2 {}}
  53. test menu-1.8 {Tk_MenuCmd procedure two clone cascades} {
  54.     catch {destroy .m1}
  55.     catch {destroy .t2}
  56.     catch {destroy .t3}
  57.     catch {destroy .m2}
  58.     menu .m1
  59.     .m1 add cascade -menu .m2
  60.     toplevel .t2 -menu .m1
  61.     wm geometry .t2 +0+0
  62.     toplevel .t3 -menu .m1
  63.     wm geometry .t3 +0+0
  64.     list [catch {menu .m2} msg] $msg [destroy .t2 .t3 .m1 .m2]
  65. } {0 .m2 {}}
  66. test menu-1.9 {Tk_MenuCmd procedure two clone cascades different order} {
  67.     catch {destroy .t2}
  68.     catch {destroy .m1}
  69.     catch {destroy .t3}
  70.     catch {destroy .m2}
  71.     toplevel .t2 -menu .m1
  72.     wm geometry .t2 +0+0
  73.     menu .m1
  74.     .m1 add cascade -menu .m2
  75.     toplevel .t3 -menu .m1
  76.     wm geometry .t3 +0+0
  77.     list [catch {menu .m2} msg] $msg [destroy .t2 .t3 .m1 .m2]
  78. } {0 .m2 {}}
  79. test menu-1.10 {Tk_MenuCmd procedure two clone cascades menus last} {
  80.     catch {destroy .t2}
  81.     catch {destroy .t3}
  82.     catch {destroy .m1}
  83.     catch {destroy .m2}
  84.     toplevel .t2 -menu .m1
  85.     wm geometry .t2 +0+0
  86.     toplevel .t3 -menu .m1
  87.     wm geometry .t3 +0+0
  88.     menu .m1
  89.     .m1 add cascade -menu .m2
  90.     list [catch {menu .m2} msg] $msg [destroy .t2 .t3 .m1 .m2]
  91. } {0 .m2 {}}
  92. test menu-1.11 {Tk_MenuCmd procedure three clones cascades} {
  93.     catch {destroy .t2}
  94.     catch {destroy .t3}
  95.     catch {destroy .t4}
  96.     catch {destroy .m1}
  97.     catch {destroy .m2}
  98.     toplevel .t2 -menu .m1
  99.     wm geometry .t2 +0+0
  100.     toplevel .t3 -menu .m1
  101.     wm geometry .t3 +0+0
  102.     toplevel .t4 -menu .m1
  103.     wm geometry .t4 +0+0
  104.     menu .m1
  105.     .m1 add cascade -menu .m2
  106.     list [catch {menu .m2} msg] $msg [destroy .t2 .t3 .t4 .m1 .m2]
  107. } {0 .m2 {}}
  108. test menu-1.12 {Tk_MenuCmd procedure} {
  109.     catch {destroy .t2}
  110.     catch {destroy .m1}
  111.     toplevel .t2 -menu .m1
  112.     wm geometry .t2 +0+0
  113.     list [catch {menu .m1} msg] $msg [destroy .t2 .m1]
  114. } {0 .m1 {}}
  115. test menu-1.13 {Tk_MenuCmd procedure} {
  116.     catch {destroy .t2}
  117.     catch {destroy .t3}
  118.     catch {destroy .m1}
  119.     toplevel .t2 -menu .m1
  120.     wm geometry .t2 +0+0
  121.     toplevel .t3 -menu .m1
  122.     wm geometry .t3 +0+0
  123.     list [catch {menu .m1} msg] $msg [destroy .t2 .t3 .m1]
  124. } {0 .m1 {}}
  125. test menu-1.14 {Tk_MenuCmd procedure} {
  126.     catch {destroy .t2}
  127.     catch {destroy .t3}
  128.     catch {destroy .t4}
  129.     catch {destroy .m1}
  130.     toplevel .t2 -menu .m1
  131.     wm geometry .t2 +0+0
  132.     toplevel .t3 -menu .m1
  133.     wm geometry .t3 +0+0
  134.     toplevel .t4 -menu .m1
  135.     wm geometry .t4 +0+0
  136.     list [catch {menu .m1} msg] $msg [destroy .t2 .t3 .t4 .m1]
  137. } {0 .m1 {}}
  139. catch {destroy .m1}
  140. menu .m1
  141. set i 1
  142. foreach configTest {
  143.     {-activebackground #012345 #012345 non-existent
  144.     {unknown color name "non-existent"}}
  145.     {-activeborderwidth 1.3 1.3 badValue {bad screen distance "badValue"}}
  146.     {-activeforeground #ff0000 #ff0000 non-existent
  147.     {unknown color name "non-existent"}}
  148.     {-background #ff0000 #ff0000 non-existent
  149.     {unknown color name "non-existent"}}
  150.     {-bg #110022 #110022 bogus {unknown color name "bogus"}}
  151.     {-borderwidth 1.3 1.3 badValue {bad screen distance "badValue"}}
  152.     {-cursor arrow arrow badValue {bad cursor spec "badValue"}}
  153.     {-disabledforeground #00ff00 #00ff00 xyzzy {unknown color name "xyzzy"}}
  154.     {-fg #110022 #110022 bogus {unknown color name "bogus"}}
  155.     {-font -Adobe-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-* 
  156.     -Adobe-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-* {}
  157.     {font "" doesn't exist}}
  158.     {-foreground #110022 #110022 bogus {unknown color name "bogus"}}
  159.     {-postcommand "any old string" "any old string" {} {}}
  160.     {-relief groove groove 1.5 {bad relief "1.5": must be flat, groove, raised, ridge, solid, or sunken}}
  161.     {-selectcolor #110022 #110022 bogus {unknown color name "bogus"}}
  162.     {-takefocus "any string" "any string" {} {}}
  163.     {-tearoff 0 0}
  164.     {-tearoff 1 1}
  165.     {-tearoffcommand "any old string" "any old string" {} {}}
  166. } {
  167.     set name [lindex $configTest 0]
  168.     set value [lindex $configTest 1]
  169.     set result [lindex $configTest 2]
  170.     test menu-2.$i [list configuration options $name $value $result] {
  171. .m1 configure $name $value
  172. lindex [.m1 configure $name] 4
  173.     } $result
  174.     incr i
  175.     if {[lindex $configTest 3] != ""} {
  176. set value [lindex $configTest 3]
  177. set result [lindex $configTest 4]
  178. test menu-2.$i [list configuration options $name $value $result] {
  179.     list [catch {.m1 configure $name $value} msg] $msg
  180. } [list 1 $result]
  181.     }
  182.     .m1 configure $name [lindex [.m1 configure $name] 3]
  183.     incr i
  184. }
  185. destroy .m1
  187. # We need to test all of the options with all of the different types of
  188. # menu entries. The following code sets up .m1 with 6 items. It then
  189. # runs through the big table below it.
  190. # index 0 is tearoff, 1 command, 2 cascade, 3 separator, 4 checkbutton, 
  191. # 5 radiobutton
  193. menu .m1
  194. .m1 add command -label "command"
  195. menu .m2
  196. .m2 add command -label "test"
  197. .m1 add cascade -label "cascade" -menu .m2
  198. .m1 add separator
  199. .m1 add checkbutton -label "checkbutton" -variable check -onvalue on -offvalue off
  200. .m1 add radiobutton -label "radiobutton" -variable radio
  201. image create photo image1 -file [file join $tk_library demos images earth.gif]
  203. foreach configTest {
  204.     {-activebackground 
  205.         {{#012345 
  206.             {{unknown option "-activebackground"} #012345 #012345 
  207.             {unknown option "-activebackground"} #012345 #012345
  208.             }
  209.         }
  210.         {non-existent 
  211.             {{unknown option "-activebackground"} 
  212.     {unknown color name "non-existent"}
  213.     {unknown color name "non-existent"}
  214.     {unknown option "-activebackground"}
  215.     {unknown color name "non-existent"}
  216.     {unknown color name "non-existent"}
  217.     }
  218. }}
  219.     }
  220.     {-activeforeground
  221.      {{#ff0000 
  222.     {{unknown option "-activeforeground"}
  223.     #ff0000 #ff0000 {unknown option "-activeforeground"} #ff0000 #ff0000
  224.     }
  225. }
  226. {non-existent
  227.     {{unknown option "-activeforeground"} 
  228.     {unknown color name "non-existent"}
  229.     {unknown color name "non-existent"}
  230.     {unknown option "-activeforeground"}
  231.     {unknown color name "non-existent"}
  232.     {unknown color name "non-existent"}
  233.     }
  234. }}
  235.     }
  236.     {-accelerator
  237.      {{"Ctrl+S" 
  238.     {{unknown option "-accelerator"}
  239.     "Ctrl+S" "Ctrl+S" {unknown option "-accelerator"} 
  240.     "Ctrl+S" "Ctrl+S"
  241.     }
  242. }}
  243.     }
  244.     {-background
  245.      {{#ff0000 
  246.          {#ff0000 #ff0000 #ff0000 #ff0000 #ff0000 #ff0000
  247.     }
  248. }
  249. {non-existent
  250.     {{unknown color name "non-existent"} 
  251.     {unknown color name "non-existent"}
  252.     {unknown color name "non-existent"}
  253.     {unknown color name "non-existent"}
  254.     {unknown color name "non-existent"}
  255.     {unknown color name "non-existent"}
  256.     }
  257. }}
  258.     }
  259.     {-bitmap
  260.      {{questhead 
  261.     {{unknown option "-bitmap"} questhead questhead 
  262.     {unknown option "-bitmap"} questhead questhead
  263.     }
  264. }
  265. {badValue
  266.     {{unknown option "-bitmap"} 
  267.     {bitmap "badValue" not defined}
  268.     {bitmap "badValue" not defined}
  269.     {unknown option "-bitmap"}
  270.     {bitmap "badValue" not defined}
  271.     {bitmap "badValue" not defined}
  272.     }
  273. }}
  274.     }
  275.     {-columnbreak
  276. {{1
  277.     {{unknown option "-columnbreak"} 1 1 
  278.     {unknown option "-columnbreak"} 1 1}
  279. }}
  280.     }
  281.     {-command
  282.      {{beep 
  283.     {{unknown option "-command"} beep beep 
  284.     {unknown option "-command"} beep beep
  285.     }
  286. }}
  287.     }
  288.     {-font
  289.      {{-Adobe-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-* 
  290.     {{unknown option "-font"}
  291.          -Adobe-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-*
  292.          -Adobe-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-* 
  293.     {unknown option "-font"} 
  294.          -Adobe-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-*
  295.          -Adobe-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-*
  296.     }
  297. }
  298. {{kill rock stars}
  299.     {{unknown option "-font"}
  300.     {expected integer but got "rock"}
  301.     {expected integer but got "rock"}
  302.     {unknown option "-font"}
  303.     {expected integer but got "rock"}
  304.     {expected integer but got "rock"}
  305.     }
  306. }}
  307.     }
  308.     {-foreground
  309.      {{#110022 
  310.     {{unknown option "-foreground"} #110022 #110022 
  311.     {unknown option "-foreground"} #110022 #110022
  312.     }
  313. }
  314. {non-existent
  315.     {{unknown option "-foreground"} 
  316.     {unknown color name "non-existent"}
  317.     {unknown color name "non-existent"}
  318.     {unknown option "-foreground"}
  319.     {unknown color name "non-existent"}
  320.     {unknown color name "non-existent"}
  321.     }
  322. }}
  323.     }
  324.     {-image
  325.      {{image1 
  326.     {{unknown option "-image"} image1 image1 
  327.     {unknown option "-image"} image1 image1
  328.     }
  329. }
  330. {bogus
  331.     {{unknown option "-image"} 
  332.     {image "bogus" doesn't exist}
  333.     {image "bogus" doesn't exist}
  334.     {unknown option "-image"}
  335.     {image "bogus" doesn't exist}
  336.     {image "bogus" doesn't exist}
  337.     }
  338. }
  339. {""
  340.     {{unknown option "-image"}
  341.     {}
  342.     {}
  343.     {unknown option "-image"}
  344.     {}
  345.     {}
  346.     }
  347. }}
  348.     }
  349.     {-indicatoron
  350.      {{1 
  351.     {{unknown option "-indicatoron"}
  352.     {unknown option "-indicatoron"}
  353.     {unknown option "-indicatoron"} 
  354.     {unknown option "-indicatoron"} 1 1
  355.     }
  356. }}
  357.     }
  358.     {-label
  359.      {{test 
  360.     {{unknown option "-label"} test test 
  361.     {unknown option "-label"} test test
  362.     }
  363. }}
  364.     }
  365.     {-menu
  366.      {{.m2 
  367.     {{unknown option "-menu"}
  368.     {unknown option "-menu"} .m2 
  369.     {unknown option "-menu"}
  370.     {unknown option "-menu"}
  371.     {unknown option "-menu"}
  372.     }
  373. }}
  374.     }
  375.     {-offvalue
  376.      {{off
  377.     {{unknown option "-offvalue"} 
  378.     {unknown option "-offvalue"}
  379.     {unknown option "-offvalue"}
  380.     {unknown option "-offvalue"}
  381.          off
  382.     {unknown option "-offvalue"}
  383.     }
  384. }}
  385.     }
  386.     {-onvalue
  387.      {{on
  388.     {{unknown option "-onvalue"}
  389.     {unknown option "-onvalue"}
  390.     {unknown option "-onvalue"}
  391.     {unknown option "-onvalue"}
  392.          on 
  393.     {unknown option "-onvalue"}
  394.     }
  395. }}
  396.     }
  397.     {-selectcolor
  398.      {{#110022 
  399.     {{unknown option "-selectcolor"} 
  400.     {unknown option "-selectcolor"}
  401.     {unknown option "-selectcolor"} 
  402.     {unknown option "-selectcolor"}
  403.          #110022
  404.          #110022
  405.     }
  406. }
  407. {non-existent
  408.     {{unknown option "-selectcolor"} 
  409.     {unknown option "-selectcolor"}
  410.     {unknown option "-selectcolor"}
  411.     {unknown option "-selectcolor"}
  412.     {unknown color name "non-existent"}
  413.     {unknown color name "non-existent"}
  414.     }
  415. }}
  416.     }
  417.     {-selectimage
  418.      {{image1 
  419.          {{unknown option "-selectimage"}
  420.          {unknown option "-selectimage"}
  421.          {unknown option "-selectimage"} 
  422.          {unknown option "-selectimage"} image1 image1
  423.     }
  424. }
  425. {bogus
  426.     {{unknown option "-selectimage"} 
  427.     {unknown option "-selectimage"}
  428.     {unknown option "-selectimage"}
  429.     {unknown option "-selectimage"}
  430.     {image "bogus" doesn't exist}
  431.     {image "bogus" doesn't exist}
  432.     }
  433. }
  434. {""
  435.     {{unknown option "-selectimage"}
  436.     {unknown option "-selectimage"}
  437.     {unknown option "-selectimage"}
  438.     {unknown option "-selectimage"}
  439.     {}
  440.     {}
  441.     }
  442. }}
  443.     }
  444.     {-state
  445.      {{normal 
  446.          {normal normal normal {unknown option "-state"} normal normal
  447.     }
  448. }}
  449.     }
  450.     {-value
  451.      {{"any string"
  452.          {{unknown option "-value"}
  453.          {unknown option "-value"}
  454.          {unknown option "-value"}
  455.          {unknown option "-value"}
  456.          {unknown option "-value"} "any string"
  457.     }
  458. }}
  459.     }
  460.     {-variable
  461.      {{"any string"
  462.          {{unknown option "-variable"}
  463.          {unknown option "-variable"}
  464.          {unknown option "-variable"} 
  465.          {unknown option "-variable"}
  466.          "any string"
  467.          "any string"
  468.     }
  469. }}
  470.     }
  471.     {-underline
  472.      {{0 
  473.          {{unknown option "-underline"} 0 0 
  474.          {unknown option "-underline"} 0 0
  475.     }
  476. }
  477. {3p
  478.     {{unknown option "-underline"} 
  479.     {expected integer but got "3p"}
  480.     {expected integer but got "3p"}
  481.     {unknown option "-underline"}
  482.     {expected integer but got "3p"}
  483.     {expected integer but got "3p"}
  484.     }
  485. }}
  486.     }
  487. } {
  488.     set name [lindex $configTest 0]
  489.     foreach attempt [lindex $configTest 1] {
  490.      set value [lindex $attempt 0]
  491.      set options [lindex $attempt 1]
  492.      foreach item {0 1 2 3 4 5} {
  493.          catch {unset msg}
  494.          test menu-2.$i [list entry configuration options $name $item $value [.m1 type $item]] {
  495.              set result [catch {.m1 entryconfigure $item $name $value} msg]
  496.                 if {$result == 1} {
  497.                  set msg
  498.              } else {
  499.                  lindex [.m1 entryconfigure $item $name] 4
  500.              }
  501.          } [lindex $options $item]
  502.          incr i
  503.      }
  504.     }
  505. }
  507. image delete image1
  508. destroy .m1
  509. destroy .m2
  511. test menu-3.1 {MenuWidgetCmd procedure} {
  512.     catch {destroy .m1}
  513.     menu .m1
  514.     list [catch {.m1} msg] $msg [destroy .m1]
  515. } {1 {wrong # args: should be ".m1 option ?arg arg ...?"} {}}
  516. test menu-3.2 {MenuWidgetCmd, Tcl_Preserve and Tcl_Release} {nonUnixUserInteraction } {
  517.     catch {destroy .m1}
  518.     menu .m1 -postcommand "destroy .m1"
  519.     .m1 add command -label "menu-3.2: Hit Escape"
  520.     list [catch {.m1 post 40 40} msg] $msg
  521. } {0 {}}
  522. test menu-3.3 {MenuWidgetCmd procedure, "activate" option} {
  523.     catch {destroy .m1}
  524.     menu .m1
  525.     .m1 add command -label "test"
  526.     list [catch {.m1 activate} msg] $msg [destroy .m1]
  527. } {1 {wrong # args: should be ".m1 activate index"} {}}
  528. test menu-3.4 {MenuWidgetCmd procedure, "activate" option} {
  529.     catch {destroy .m1}
  530.     menu .m1
  531.     list [catch {.m1 activate "foo"} msg] $msg [destroy .m1]
  532. } {1 {bad menu entry index "foo"} {}}
  533. test menu-3.5 {MenuWidgetCmd procedure, "activate" option} {
  534.     catch {destroy .m1}
  535.     menu .m1
  536.     .m1 add command -label "test"
  537.     .m1 add separator
  538.     list [catch {.m1 activate 2} msg] $msg [destroy .m1]
  539. } {0 {} {}}
  540. test menu-3.6 {MenuWidgetCmd procedure, "activate" option} {
  541.     catch {destroy .m1}
  542.     menu .m1
  543.     .m1 add command -label "test"
  544.     .m1 entryconfigure 1 -state disabled
  545.     list [catch {.m1 activate 1} msg] $msg [destroy .m1]
  546. } {0 {} {}}
  547. test menu-3.7 {MenuWidgetCmd procedure, "activate" option} {
  548.     catch {destroy .m1}
  549.     menu .m1
  550.     .m1 add command -label "test"
  551.     list [catch {.m1 activate 1} msg] $msg [destroy .m1]
  552. } {0 {} {}}
  553. test menu-3.8 {MenuWidgetCmd procedure, "add" option} {
  554.     catch {destroy .m1}
  555.     menu .m1
  556.     list [catch {.m1 add} msg] $msg [destroy .m1]
  557. } {1 {wrong # args: should be ".m1 add type ?options?"} {}}
  558. test menu-3.9 {MenuWidgetCmd procedure, "add" option} {
  559.     catch {destroy .m1}
  560.     menu .m1
  561.     list [catch {.m1 add foo} msg] $msg [destroy .m1]
  562. } {1 {bad menu entry type "foo": must be cascade, checkbutton, command, radiobutton, or separator} {}}
  563. test menu-3.10 {MenuWidgetCmd procedure, "add" option} {
  564.     catch {destroy .m1}
  565.     menu .m1
  566.     list [catch {.m1 add separator} msg] $msg [destroy .m1]
  567. } {0 {} {}}
  568. test menu-3.11 {MenuWidgetCmd procedure, "cget" option} {
  569.     catch {destroy .m1}
  570.     menu .m1
  571.     list [catch {.m1 cget} msg] $msg [destroy .m1]
  572. } {1 {wrong # args: should be ".m1 cget option"} {}}
  573. test menu-3.12 {MenuWidgetCmd procedure, "cget" option} {
  574.     catch {destroy .m1}
  575.     menu .m1
  576.     list [catch {.m1 cget -gorp} msg] $msg [destroy .m1]
  577. } {1 {unknown option "-gorp"} {}}
  578. test menu-3.13 {MenuWidgetCmd procedure, "cget" option} {
  579.     catch {destroy .m1}
  580.     menu .m1
  581.     .m1 configure -postcommand "Some string"
  582.     list [catch {.m1 cget -postcommand} msg] $msg [destroy .m1]
  583. } {0 {Some string} {}}
  584. test menu-3.14 {MenuWidgetCmd procedure, "clone" option} {
  585.     catch {destroy .m1}
  586.     menu .m1
  587.     list [catch {.m1 clone} msg] $msg [destroy .m1]
  588. } {1 {wrong # args: should be ".m1 clone newMenuName ?menuType?"} {}}
  589. test menu-3.15 {MenuWidgetCmd procedure, "clone" option} {
  590.     catch {destroy .m1}
  591.     menu .m1
  592.     list [catch {.m1 clone a b c d} msg] $msg [destroy .m1]
  593. } {1 {wrong # args: should be ".m1 clone newMenuName ?menuType?"} {}}
  594. test menu-3.16 {MenuWidgetCmd procedure, "clone" option} {
  595.     catch {destroy .m1}
  596.     menu .m1
  597.     list [catch {.m1 clone .m1.clone1} msg] $msg [destroy .m1]
  598. } {0 {} {}}
  599. test menu-3.17 {MenuWidgetCmd procedure, "clone" option} {
  600.     catch {destroy .m1}
  601.     menu .m1
  602.     list [catch {.m1 clone .m1.clone1 tearoff} msg] $msg [destroy .m1]
  603. } {0 {} {}}
  604. test menu-3.18 {MenuWidgetCmd procedure, "configure" option} {
  605.     catch {destroy .m1}
  606.     menu .m1
  607.     list [catch {llength [.m1 configure]} msg] $msg [destroy .m1]
  608. } {0 20 {}}
  609. test menu-3.19 {MenuWidgetCmd procedure, "configure" option} {
  610.     catch {destroy .m1}
  611.     menu .m1
  612.     list [catch {.m1 configure -gorp} msg] $msg [destroy .m1]
  613. } {1 {unknown option "-gorp"} {}}
  614. test menu-3.20 {MenuWidgetCmd procedure, "configure" option} {
  615.     catch {destroy .m1}
  616.     menu .m1
  617.     list [catch {.m1 configure -postcommand "A random String"} msg] $msg [destroy .m1]
  618. } {0 {} {}}
  619. test menu-3.21 {MenuWidgetCmd procedure, "configure" option} {
  620.     catch {destroy .m1}
  621.     menu .m1
  622.     .m1 configure -postcommand "Another string"
  623.     list [catch {lindex [.m1 configure -postcommand] 4} msg] $msg [destroy .m1]
  624. } {0 {Another string} {}}
  625. test menu-3.22 {MenuWidgetCmd procedure, "delete" option} {
  626.     catch {destroy .m1}
  627.     menu .m1
  628.     list [catch {.m1 delete} msg] $msg [destroy .m1]
  629. } {1 {wrong # args: should be ".m1 delete first ?last?"} {}}
  630. test menu-3.23 {MenuWidgetCmd procedure, "delete" option} {
  631.     catch {destroy .m1}
  632.     menu .m1
  633.     list [catch {.m1 delete foo} msg] $msg [destroy .m1]
  634. } {1 {bad menu entry index "foo"} {}}
  635. test menu-3.24 {MenuWidgetCmd procedure, "delete" option} {
  636.     catch {destroy .m1}
  637.     menu .m1
  638.     list [catch {.m1 delete 0 "foo"} msg] $msg [destroy .m1]
  639. } {1 {bad menu entry index "foo"} {}}
  640. test menu-3.25 {MenuWidgetCmd procedure, "delete" option} {
  641.     catch {destroy .m1}
  642.     menu .m1
  643.     list [catch {.m1 delete 0} msg] $msg [destroy .m1]
  644. } {0 {} {}}
  645. test menu-3.26 {MenuWidgetCmd procedure, "delete" option} {
  646.     catch {destroy .m1}
  647.     menu .m1
  648.     .m1 add command -label "foo"
  649.     list [catch {.m1 delete 1 0} msg] $msg [destroy .m1] 
  650. } {0 {} {}}
  651. test menu-3.27 {MenuWidgetCmd procedure, "delete" option} {
  652.     catch {destroy .m1}
  653.     menu .m1
  654.     .m1 add command -label "1"
  655.     .m1 add command -label "2"
  656.     .m1 add command -label "3"
  657.     list [catch {.m1 delete 1 3} msg] $msg [destroy .m1]
  658. } {0 {} {}}
  659. test menu-3.28 {MenuWidgetCmd procedure, "delete" option} {
  660.     catch {destroy .m1}
  661.     menu .m1
  662.     .m1 add command -label "1"
  663.     .m1 add command -label "2"
  664.     .m1 add command -label "3"
  665.     .m1 activate 2
  666.     list [catch {.m1 delete 1 3} msg] $msg [destroy .m1]
  667. } {0 {} {}}
  668. test menu-3.29 {MenuWidgetCmd procedure, "delete" option} {
  669.     catch {destroy .m1}
  670.     menu .m1
  671.     .m1 add command -label "1"
  672.     .m1 add command -label "2"
  673.     .m1 add command -label "3"
  674.     .m1 activate 3
  675.     list [catch {.m1 delete 1} msg] $msg [destroy .m1]
  676. } {0 {} {}}
  677. test menu-3.30 {MenuWidgetCmd procedure, "entrycget" option} {
  678.     catch {destroy .m1}
  679.     menu .m1
  680.     list [catch {.m1 entrycget} msg] $msg [destroy .m1]
  681. } {1 {wrong # args: should be ".m1 entrycget index option"} {}}
  682. test menu-3.31 {MenuWidgetCmd procedure, "entrycget" option} {
  683.     catch {destroy .m1}
  684.     menu .m1
  685.     list [catch {.m1 entrycget index option foo} msg] $msg [destroy .m1]
  686. } {1 {wrong # args: should be ".m1 entrycget index option"} {}}
  687. test menu-3.32 {MenuWidgetCmd procedure, "entrycget" option} {
  688.     catch {destroy .m1}
  689.     menu .m1
  690.     list [catch {.m1 entrycget foo -label} msg] $msg [destroy .m1]
  691. } {1 {bad menu entry index "foo"} {}}
  692. test menu-3.33 {MenuWidgetCmd procedure, "entrycget" option} {
  693.     catch {destroy .m1}
  694.     menu .m1
  695.     .m1 add command -label "test"
  696.     list [catch {.m1 entrycget 1 -label} msg] $msg [destroy .m1]
  697. } {0 test {}}
  698. test menu-3.34 {MenuWidgetCmd procedure, "entryconfigure" option} {
  699.     catch {destroy .m1}
  700.     menu .m1
  701.     list [catch {.m1 entryconfigure} msg] $msg [destroy .m1]
  702. } {1 {wrong # args: should be ".m1 entryconfigure index ?option value ...?"} {}}
  703. test menu-3.35 {MenuWidgetCmd procedure, "entryconfigure" option} {
  704.     catch {destroy .m1}
  705.     menu .m1
  706.     list [catch {.m1 entryconfigure foo} msg] $msg [destroy .m1]
  707. } {1 {bad menu entry index "foo"} {}}
  708. test menu-3.36 {MenuWidgetCmd procedure, "entryconfigure" option} {
  709.     catch {destroy .m1}
  710.     menu .m1
  711.     .m1 add command -label "test"
  712.     list [catch {llength [.m1 entryconfigure 1]} msg] $msg [destroy .m1]
  713. } {0 15 {}}
  714. test menu-3.37 {MenuWidgetCmd procedure, "entryconfigure" option} {
  715.     catch {destroy .m1}
  716.     menu .m1
  717.     .m1 add command -label "test"
  718.     list [catch {lindex [.m1 entryconfigure 1 -label] 4} msg] $msg [destroy .m1]
  719. } {0 test {}}
  720. test menu-3.38 {MenuWidgetCmd procedure, "entryconfigure" option} {
  721.     catch {destroy .m1}
  722.     menu .m1
  723.     .m1 add command -label "test"
  724.     .m1 entryconfigure 1 -label "changed"
  725.     list [catch {lindex [.m1 entryconfigure 1 -label] 4} msg] $msg [destroy .m1]
  726. } {0 changed {}}
  727. test menu-3.39 {MenuWidgetCmd procedure, "index" option} {
  728.     catch {destroy .m1}
  729.     menu .m1
  730.     list [catch {.m1 index} msg] $msg [destroy .m1]
  731. } {1 {wrong # args: should be ".m1 index string"} {}}
  732. test menu-3.40 {MenuWidgetCmd procedure, "index" option} {
  733.     catch {destroy .m1}
  734.     menu .m1
  735.     list [catch {.m1 index foo} msg] $msg [destroy .m1]
  736. } {1 {bad menu entry index "foo"} {}}
  737. test menu-3.41 {MenuWidgetCmd procedure, "index" option} {
  738.     catch {destroy .m1}
  739.     menu .m1
  740.     .m1 add command -label "test"
  741.     list [catch {.m1 index "test"} msg] $msg [destroy .m1]
  742. } {0 1 {}}
  743. test menu-3.42 {MenuWidgetCmd procedure, "insert" option} {
  744.     catch {destroy .m1}
  745.     menu .m1
  746.     list [catch {.m1 insert} msg] $msg [destroy .m1]
  747. } {1 {wrong # args: should be ".m1 insert index type ?options?"} {}}
  748. test menu-3.43 {MenuWidgetCmd procedure, "insert" option} {
  749.     catch {destroy .m1}
  750.     menu .m1
  751.     .m1 insert 1 command -label "test"
  752.     list [catch {.m1 entrycget 1 -label} msg] $msg [destroy .m1]
  753. } {0 test {}}
  754. test menu-3.44 {MenuWidgetCmd procedure, "invoke" option} {
  755.     catch {destroy .m1}
  756.     menu .m1
  757.     list [catch {.m1 invoke} msg] $msg [destroy .m1]
  758. } {1 {wrong # args: should be ".m1 invoke index"} {}}
  759. test menu-3.45 {MenuWidgetCmd procedure, "invoke" option} {
  760.     catch {destroy .m1}
  761.     menu .m1
  762.     list [catch {.m1 invoke foo} msg] $msg [destroy .m1]
  763. } {1 {bad menu entry index "foo"} {}}
  764. test menu-3.46 {MenuWidgetCmd procedure, "invoke" option} {
  765.     catch {destroy .m1}
  766.     catch {unset foo}
  767.     menu .m1
  768.     .m1 add command -label "set foo" -command "set foo hello"
  769.     list [catch {.m1 invoke 1} msg] $msg [catch {set foo} msg2] $msg2 [catch {unset foo} msg3] $msg3 [destroy .m1]
  770. } {0 hello 0 hello 0 {} {}}
  771. test menu-3.47 {MenuWidgetCmd procedure, "post" option} {
  772.     catch {destroy .m1}
  773.     menu .m1
  774.     .m1 add command -label "On Windows, hit Escape to get this menu to go away"
  775.     list [catch {.m1 post} msg] $msg [destroy .m1]
  776. } {1 {wrong # args: should be ".m1 post x y"} {}}
  777. test menu-3.48 {MenuWidgetCmd procedure, "post" option} {
  778.     catch {destroy .m1}
  779.     menu .m1
  780.     list [catch {.m1 post foo 40} msg] $msg [destroy .m1]
  781. } {1 {expected integer but got "foo"} {}}
  782. test menu-3.49 {MenuWidgetCmd procedure, "post" option} {
  783.     catch {destroy .m1}
  784.     menu .m1
  785.     list [catch {.m1 post 40 bar} msg] $msg [destroy .m1]
  786. } {1 {expected integer but got "bar"} {}}
  787. test menu-3.50 {MenuWidgetCmd procedure, "post" option} {nonUnixUserInteraction } {
  788.     catch {destroy .m1}
  789.     menu .m1
  790.     .m1 add command -label "menu-3.53: hit Escape" -command "puts hello"
  791.     list [catch {.m1 post 40 40} msg] $msg [destroy .m1]
  792. } {0 {} {}}
  793. test menu-3.51 {MenuWidgetCmd procedure, "postcascade" option} {
  794.     catch {destroy .m1}
  795.     menu .m1
  796.     list [catch {.m1 postcascade} msg] $msg [destroy .m1]
  797. } {1 {wrong # args: should be ".m1 postcascade index"} {}}
  798. test menu-3.52 {MenuWidgetCmd procedure, "postcascade" option} {
  799.     catch {destroy .m1}
  800.     menu .m1
  801.     list [catch {.m1 postcascade foo} msg] $msg [destroy .m1]
  802. } {1 {bad menu entry index "foo"} {}}
  803. test menu-3.53 {MenuWidgetCmd procedure, "postcascade" option} {nonUnixUserInteraction } {
  804.     catch {destroy .m1}
  805.     catch {destroy .m2}
  806.     menu .m1
  807.     .m1 add command -label "menu-3.56 - hit Escape"
  808.     menu .m2
  809.     .m1 post 40 40
  810.     .m1 add cascade -menu .m2
  811.     list [catch {.m1 postcascade 1} msg] $msg [destroy .m1 .m2]
  812. } {0 {} {}}
  813. test menu-3.54 {MenuWidgetCmd procedure, "postcascade" option} {
  814.     catch {destroy .m1}
  815.     catch {destroy .m2}
  816.     menu .m1
  817.     menu .m2
  818.     .m1 add cascade -menu .m2 -label "menu-3.57 - hit Escape"
  819.     .m1 postcascade 1
  820.     list [catch {.m1 postcascade none} msg] $msg [destroy .m1 .m2]
  821. } {0 {} {}}
  822. test menu-3.55 {MenuWidgetCmd procedure, "type" option} {
  823.     catch {destroy .m1}
  824.     menu .m1
  825.     list [catch {.m1 type} msg] $msg [destroy .m1]
  826. } {1 {wrong # args: should be ".m1 type index"} {}}
  827. test menu-3.56 {MenuWidgetCmd procedure, "type" option} {
  828.     catch {destroy .m1}
  829.     menu .m1
  830.     list [catch {.m1 type foo} msg] $msg [destroy .m1]
  831. } {1 {bad menu entry index "foo"} {}}
  832. test menu-3.57 {MenuWidgetCmd procedure, "type" option} {
  833.     catch {destroy .m1}
  834.     menu .m1
  835.     .m1 add command -label "test"
  836.     list [catch {.m1 type 1} msg] $msg [destroy .m1]
  837. } {0 command {}}
  838. test menu-3.58 {MenuWidgetCmd procedure, "type" option} {
  839.     catch {destroy .m1}
  840.     menu .m1
  841.     .m1 add separator
  842.     list [catch {.m1 type 1} msg] $msg [destroy .m1]
  843. } {0 separator {}}
  844. test menu-3.59 {MenuWidgetCmd procedure, "type" option} {
  845.     catch {destroy .m1}
  846.     menu .m1
  847.     .m1 add checkbutton -label "test"
  848.     list [catch {.m1 type 1} msg] $msg [destroy .m1]
  849. } {0 checkbutton {}}
  850. test menu-3.60 {MenuWidgetCmd procedure, "type" option} {
  851.     catch {destroy .m1}
  852.     menu .m1
  853.     .m1 add radiobutton -label "test"
  854.     list [catch {.m1 type 1} msg] $msg [destroy .m1]
  855. } {0 radiobutton {}}
  856. test menu-3.61 {MenuWidgetCmd procedure, "type" option} {
  857.     catch {destroy .m1}
  858.     menu .m1
  859.     .m1 add cascade -label "test"
  860.     list [catch {.m1 type 1} msg] $msg [destroy .m1]
  861. } {0 cascade {}}
  862. test menu-3.62 {MenuWidgetCmd procedure, "type" option} {
  863.     catch {destroy .m1}
  864.     menu .m1
  865.     list [catch {.m1 type 0} msg] $msg [destroy .m1]
  866. } {0 tearoff {}}
  867. test menu-3.63 {MenuWidgetCmd procedure, "unpost" option} {
  868.     catch {destroy .m1}
  869.     menu .m1
  870.     list [catch {.m1 unpost foo} msg] $msg [destroy .m1]
  871. } {1 {wrong # args: should be ".m1 unpost"} {}}
  872. test menu-3.64 {MenuWidgetCmd procedure, "unpost" option} {nonUnixUserInteraction } {
  873.     catch {destroy .m1}
  874.     menu .m1
  875.     .m1 add command -label "menu-3.68 - hit Escape"
  876.     .m1 post 40 40 
  877.     list [catch {.m1 unpost} msg] $msg [destroy .m1]
  878. } {0 {} {}}
  879. test menu-3.65 {MenuWidgetCmd procedure, "yposition" option} {
  880.     catch {destroy .m1}
  881.     menu .m1
  882.     list [catch {.m1 yposition} msg] $msg [destroy .m1]
  883. } {1 {wrong # args: should be ".m1 yposition index"} {}}
  884. test menu-3.66 {MenuWidgetCmd procedure, "yposition" option} {
  885.     catch {destroy .m1}
  886.     menu .m1
  887.     list [catch {.m1 yposition 1}] [destroy .m1]
  888. } {0 {}}
  889. test menu-3.67 {MenuWidgetCmd procedure, bad option} {
  890.     catch {destroy .m1}
  891.     menu .m1
  892.     list [catch {.m1 foo} msg] $msg [destroy .m1]
  893. } {1 {bad option "foo": must be activate, add, cget, clone, configure, delete, entrycget, entryconfigure, index, insert, invoke, post, postcascade, type, unpost, or yposition} {}}
  894. test menu-3.68 {MenuWidgetCmd procedure, fix for bug#508988} {
  895.     set t .t
  896.     set m1 .t.m1
  897.     set c1 .t.c1
  898.     set c2 .t.c2
  899.     toplevel .t
  900.     menu $m1 -tearoff 1
  901.     menu $c1 -tearoff 1
  902.     $c1 add command -label c1
  903.     menu $c2 -tearoff 1
  904.     $c2 add command -label c2
  905.     $m1 add cascade -label c1 -menu $c1
  906.     $t configure -menu $m1
  907.     $m1 entryconfigure 1 -menu $c2 -label c2
  908.     $t configure -menu ""
  909.     set l [list [winfo exists $c1] [winfo exists $c2]]
  910.     destroy $t;
  911.     set l;
  912. } {1 1}
  914. test menu-4.1 {TkInvokeMenu: disabled} {
  915.     catch {destroy .m1}
  916.     catch {unset foo}
  917.     menu .m1
  918.     .m1 add checkbutton -label "test" -variable foo -onvalue on -offvalue off 
  919. -state disabled
  920.     list [catch {.m1 invoke 1} msg] [destroy .m1] $foo
  921. } {0 {} off}
  922. test menu-4.2 {TkInvokeMenu: tearoff} {
  923.     catch {destroy .m1}
  924.     menu .m1
  925.     list [catch {.m1 invoke 0} msg] [destroy .m1]
  926. } {0 {}}
  927. test menu-4.3 {TkInvokeMenu: checkbutton -on} {
  928.     catch {destroy .m1}
  929.     catch {unset foo}
  930.     menu .m1
  931.     .m1 add checkbutton -label "test" -variable foo -onvalue on -offvalue off
  932.     list [catch {.m1 invoke 1} msg] $msg [catch {set foo} msg2] $msg2 [catch {unset foo} msg3] $msg3 [destroy .m1]
  933. } {0 {} 0 on 0 {} {}}
  934. test menu-4.4 {TkInvokeMenu: checkbutton -off} {
  935.     catch {destroy .m1}
  936.     catch {unset foo}
  937.     menu .m1
  938.     .m1 add checkbutton -label "test" -variable foo -onvalue on -offvalue off
  939.     .m1 invoke 1
  940.     list [catch {.m1 invoke 1} msg] $msg [catch {set foo} msg2] $msg2 [catch {unset foo} msg3] $msg3 [destroy .m1]
  941. } {0 {} 0 off 0 {} {}}
  942. test menu-4.5 {TkInvokeMenu: checkbutton array element} {
  943.     catch {destroy .m1}
  944.     catch {unset foo}
  945.     menu .m1
  946.     .m1 add checkbutton -label "test" -variable foo(1) -onvalue on 
  947.     list [catch {.m1 invoke 1} msg] $msg [catch {set foo(1)} msg2] $msg2 [catch {unset foo} msg3] $msg3 [destroy .m1]
  948. } {0 {} 0 on 0 {} {}}
  949. test menu-4.6 {TkInvokeMenu: radiobutton} {
  950.     catch {destroy .m1}
  951.     catch {unset foo}
  952.     menu .m1
  953.     .m1 add radiobutton -label "1" -variable foo -value one
  954.     .m1 add radiobutton -label "2" -variable foo -value two
  955.     .m1 add radiobutton -label "3" -variable foo -value three
  956.     list [catch {.m1 invoke 1} msg] $msg [catch {set foo} msg2] $msg2 [catch {unset foo} msg3] $msg3 [destroy .m1]
  957. } {0 {} 0 one 0 {} {}}
  958. test menu-4.7 {TkInvokeMenu: radiobutton} {
  959.     catch {destroy .m1}
  960.     catch {unset foo}
  961.     menu .m1
  962.     .m1 add radiobutton -label "1" -variable foo -value one
  963.     .m1 add radiobutton -label "2" -variable foo -value two
  964.     .m1 add radiobutton -label "3" -variable foo -value three
  965.     list [catch {.m1 invoke 2} msg] $msg [catch {set foo} msg2] $msg2 [catch {unset foo} msg3] $msg3 [destroy .m1]
  966. } {0 {} 0 two 0 {} {}}
  967. test menu-4.8 {TkInvokeMenu: radiobutton} {
  968.     catch {destroy .m1}
  969.     catch {unset foo}
  970.     menu .m1
  971.     .m1 add radiobutton -label "1" -variable foo -value one
  972.     .m1 add radiobutton -label "2" -variable foo -value two
  973.     .m1 add radiobutton -label "3" -variable foo -value three
  974.     list [catch {.m1 invoke 3} msg] $msg [catch {set foo} msg2] $msg2 [catch {unset foo} msg3] $msg3 [destroy .m1]
  975. } {0 {} 0 three 0 {} {}}
  976. test menu-4.9 {TkInvokeMenu: radiobutton array element} {
  977.     catch {destroy .m1}
  978.     catch {unset foo}
  979.     menu .m1
  980.     .m1 add radiobutton -label "1" -variable foo(2) -value one
  981.     .m1 add radiobutton -label "2" -variable foo(2) -value two
  982.     .m1 add radiobutton -label "3" -variable foo(2) -value three
  983.     list [catch {.m1 invoke 3} msg] $msg [catch {set foo(2)} msg2] $msg2 [catch {unset foo} msg3] $msg3 [destroy .m1]
  984. } {0 {} 0 three 0 {} {}}
  985. test menu-4.10 {TkInvokeMenu} {
  986.     catch {destroy .m1}
  987.     catch {unset menu_test}
  988.     menu .m1
  989.     .m1 add command -label "test" -command "set menu_test menu-4.8"
  990.     list [catch {.m1 invoke 1} msg] $msg [catch {set menu_test} msg2] $msg2 [catch {unset menu_test} msg3] $msg3 [destroy .m1]
  991. } {0 menu-4.8 0 menu-4.8 0 {} {}}
  992. test menu-4.11 {TkInvokeMenu} {
  993.     catch {destroy .m1}
  994.     menu .m1
  995.     .m1 add cascade -label "test" -menu .m1.m2
  996.     list [catch {.m1 invoke 1} msg] $msg [destroy .m1]
  997. } {0 {} {}}
  998. test menu-4.12 {TkInvokeMenu} {
  999.     catch {destroy .m1}
  1000.     menu .m1
  1001.     .m1 add command -label "test" -command ".m1 delete 1"
  1002.     list [catch {.m1 invoke 1} msg] $msg [catch {.m1 type "test"} msg2] $msg2 [destroy .m1]
  1003. } {0 {} 1 {bad menu entry index "test"} {}}
  1005. test menu-5.1 {DestroyMenuInstance} {
  1006.     catch {destroy .m1}
  1007.     menu .m1
  1008.     list [catch {destroy .m1} msg] $msg
  1009. } {0 {}}
  1010. test menu-5.2 {DestroyMenuInstance - cascade menu} {
  1011.     catch {destroy .m1}
  1012.     catch {destroy .m2}
  1013.     menu .m1
  1014.     .m1 add cascade -menu .m2
  1015.     menu .m2
  1016.     list [catch {destroy .m2} msg] $msg [destroy .m1]
  1017. } {0 {} {}}
  1018. test menu-5.3 {DestroyMenuInstance - multiple cascade parents} {
  1019.     catch {destroy .m1}
  1020.     catch {destroy .m2}
  1021.     catch {destroy .m3}
  1022.     menu .m1
  1023.     .m1 add cascade -menu .m3
  1024.     menu .m2
  1025.     .m2 add cascade -menu .m3
  1026.     menu .m3
  1027.     list [catch {destroy .m3} msg] $msg [destroy .m1 .m2]
  1028. } {0 {} {}}
  1029. test menu-5.4 {DestroyMenuInstance - multiple cascade parents} {
  1030.     catch {destroy .m1}
  1031.     catch {destroy .m2}
  1032.     catch {destroy .m3}
  1033.     catch {destroy .m4}
  1034.     menu .m1
  1035.     .m1 add cascade -menu .m4
  1036.     menu .m2
  1037.     .m2 add cascade -menu .m4
  1038.     menu .m3
  1039.     .m3 add cascade -menu .m4
  1040.     menu .m4
  1041.     list [catch {destroy .m4} msg] $msg [destroy .m1 .m2 .m3]
  1042. } {0 {} {}}
  1043. test menu-5.5 {DestroyMenuInstance - cascades of cloned menus} {
  1044.     catch {destroy .m1}
  1045.     catch {destroy .m2}
  1046.     menu .m1
  1047.     menu .m2
  1048.     .m1 add cascade -menu .m2
  1049.     . configure -menu .m1
  1050.     list [catch {destroy .m2} msg] $msg [.m1 entrycget 1 -menu] [. configure -menu ""] [destroy .m1]
  1051. } {0 {} .m2 {} {}}
  1052. test menu-5.6 {DestroyMenuInstance - cascades of cloned menus} {
  1053.     catch {destroy .m1}
  1054.     catch {destroy .m2}
  1055.     catch {destroy .t2}
  1056.     menu .m1
  1057.     .m1 add cascade -menu .m2
  1058.     menu .m2
  1059.     . configure -menu .m1
  1060.     toplevel .t2
  1061.     wm geometry .t2 +0+0
  1062.     .t2 configure -menu .m1
  1063.     list [catch {destroy .m2} msg] $msg [. configure -menu ""] [destroy .t2 .m1]
  1064. } {0 {} {} {}}
  1065. test menu-5.7 {DestroyMenuInstance - basic clones} {
  1066.     catch {destroy .m1}
  1067.     menu .m1
  1068.     set tearoff [tk::TearOffMenu .m1]
  1069.     list [catch {destroy $tearoff} msg] $msg [destroy .m1]
  1070. } {0 {} {}}
  1071. test menu-5.8 {DestroyMenuInstance - multiple clones} {
  1072.     catch {destroy .m1}
  1073.     menu .m1
  1074.     set tearoff1 [tk::TearOffMenu .m1]
  1075.     set tearoff2 [tk::TearOffMenu .m1]
  1076.     list [catch {destroy $tearoff1} msg] $msg [destroy .m1]
  1077. } {0 {} {}}
  1078. test menu-5.9 {DestroyMenuInstace - master menu} {
  1079.     catch {destroy .m1}
  1080.     menu .m1
  1081.     tk::TearOffMenu .m1
  1082.     list [catch {destroy .m1} msg] $msg
  1083. } {0 {}}
  1084. test menu-5.10 {DestroyMenuInstance - freeing entries} {
  1085.     catch {destroy .m1}
  1086.     menu .m1
  1087.     .m1 add command -label "foo"
  1088.     list [catch {destroy .m1} msg] $msg
  1089. } {0 {}}
  1090. test menu-5.11 {DestroyMenuInstace - no entries} {
  1091.     catch {destroy .m1}
  1092.     menu .m1
  1093.     .m1 configure -tearoff 0
  1094.     list [catch {destroy .m1} msg] $msg
  1095. } {0 {}}
  1096. test menu-5.12 {DestroyMenuInstance - platform data} {
  1097.     catch {destroy .m1}
  1098.     menu .m1
  1099.     list [catch {destroy .m1} msg] $msg
  1100. } {0 {}}
  1101. test menu-5.13 {DestroyMenuInstance - clones when mismatched tearoffs} {
  1102.     catch {destroy .m1}
  1103.     catch {destroy .m2}
  1104.     menu .m1
  1105.     menu .m2
  1106.     .m1 add cascade -menu .m2
  1107.     set tearoff [tk::TearOffMenu .m1 40 40]
  1108.     list [destroy .m2] [destroy .m1]
  1109. } {{} {}}
  1111. test menu-6.1 {TkDestroyMenu} {
  1112.     catch {destroy .m1}
  1113.     menu .m1
  1114.     list [catch {destroy .m1} msg] $msg
  1115. } {0 {}}
  1116. test menu-6.2 {TkDestroyMenu - reentrancy} {
  1117.     catch {destroy .m1}
  1118.     catch {destroy .m2}
  1119.     menu .m1
  1120.     bind .m1 <Destroy> {destroy .m1}
  1121.     menu .m2
  1122.     bind .m2 <Destroy> {destroy .m2}
  1123.     list [catch {destroy .m1} msg] $msg [destroy .m2]
  1124. } {0 {} {}}
  1125. test menu-6.3 {TkDestroyMenu - reentrancy} {
  1126.     catch {destroy .m1}
  1127.     catch {destroy .m2}
  1128.     catch {destroy .m3}
  1129.     menu .m1
  1130.     bind .m1 <Destroy> {destroy .m2}
  1131.     .m1 clone .m2
  1132.     .m1 clone .m3
  1133.     list [catch {destroy .m1} msg] $msg [winfo exists .m2]
  1134. } {0 {} 0}
  1135. test menu-6.4 {TkDestroyMenu - reentrancy - clones} {
  1136.     catch {destroy .m1}
  1137.     catch {destroy .m2}
  1138.     menu .m1
  1139.     .m1 clone .m2
  1140.     .m1 clone .m1.m3
  1141.     list [catch {destroy .m1} msg] $msg
  1142. } {0 {}}
  1143. test menu-6.5 {TkDestroyMenu} {
  1144.     catch {destroy .m1}
  1145.     catch {destroy .m2}
  1146.     menu .m1
  1147.     .m1 clone .m2
  1148.     destroy .m1
  1149.     winfo exists .m2
  1150. } {0}
  1151. test menu-6.6 {TkDestroyMenu} {
  1152.     catch {destroy .m1}
  1153.     catch {destroy .m2}
  1154.     menu .m1
  1155.     .m1 clone .m2 tearoff
  1156.     list [catch {destroy .m1} msg] $msg
  1157. } {0 {}}
  1158. test menu-6.7 {TkDestroyMenu} {
  1159.     catch {destroy .m1}
  1160.     catch {destroy .m2}
  1161.     menu .m1
  1162.     .m1 clone .m2
  1163.     destroy .m2
  1164.     list [catch {destroy .m1} msg] $msg
  1165. } {0 {}}
  1166. test menu-6.8 {TkDestroyMenu} {
  1167.     catch {destroy .m1}
  1168.     catch {destroy .m2}
  1169.     catch {destroy .m3}
  1170.     menu .m1
  1171.     .m1 clone .m2
  1172.     .m1 clone .m3
  1173.     destroy .m1
  1174.     list [winfo exists .m2] [winfo exists .m3]
  1175. } {0 0}
  1176. test menu-6.9 {TkDestroyMenu} {
  1177.     catch {destroy .m1}
  1178.     catch {destroy .m2}
  1179.     catch {destroy .m3}
  1180.     menu .m1
  1181.     .m1 clone .m2
  1182.     .m1 clone .m3
  1183.     list [catch {destroy .m2} msg] $msg [catch {destroy .m3} msg2] $msg2 [catch {destroy .m1} msg3] $msg3
  1184. } {0 {} 0 {} 0 {}}
  1185. test menu-6.10 {TkDestroyMenu} {
  1186.     catch {destroy .m1}
  1187.     catch {destroy .m2}
  1188.     catch {destroy .m3}
  1189.     menu .m1
  1190.     .m1 clone .m2
  1191.     .m1 clone .m3
  1192.     list [catch {destroy .m3} msg] $msg [catch {destroy .m1} msg2] $msg2
  1193. } {0 {} 0 {}}
  1194. test menu-6.11 {TkDestroyMenu} {
  1195.     catch {destroy .m1}
  1196.     catch {destroy .m2}
  1197.     catch {destroy .m3}
  1198.     catch {destroy .m4}
  1199.     menu .m1
  1200.     .m1 clone .m2
  1201.     .m1 clone .m3
  1202.     .m1 clone .m4
  1203.     list [catch {destroy .m2} msg1] $msg1 [catch {destroy .m1} msg2] $msg2
  1204. } {0 {} 0 {}}
  1205. test menu-6.12 {TkDestroyMenu} {
  1206.     catch {destroy .m1}
  1207.     catch {destroy .m2}
  1208.     catch {destroy .m3}
  1209.     catch {destroy .m4}
  1210.     menu .m1
  1211.     .m1 clone .m2
  1212.     .m1 clone .m3
  1213.     .m1 clone .m4
  1214.     list [catch {destroy .m3} msg1] $msg1 [catch {destroy .m1} msg2] $msg2
  1215. } {0 {} 0 {}}
  1216. test menu-6.13 {TkDestroyMenu} {
  1217.     catch {destroy .m1}
  1218.     catch {destroy .m2}
  1219.     catch {destroy .m3}
  1220.     catch {destroy .m4}
  1221.     menu .m1
  1222.     .m1 clone .m2
  1223.     .m1 clone .m3
  1224.     .m1 clone .m4
  1225.     list [catch {destroy .m4} msg1] $msg1 [catch {destroy .m1} msg2] $msg2
  1226. } {0 {} 0 {}}
  1227. test menu-6.14 {TkDestroyMenu} {
  1228.     catch {destroy .m1}
  1229.     menu .m1
  1230.     . configure -menu .m1
  1231.     list [catch {destroy .m1} msg] $msg [. configure -menu ""]
  1232. } {0 {} {}}
  1233. test menu-6.15 {TkDestroyMenu} {
  1234.     catch {destroy .m1}
  1235.     catch {destroy .t2}
  1236.     menu .m1
  1237.     toplevel .t2
  1238.     wm geometry .t2 +0+0
  1239.     . configure -menu .m1
  1240.     .t2 configure -menu .m1
  1241.     list [catch {destroy .m1} msg] $msg [destroy .t2] [. configure -menu ""]
  1242. } {0 {} {} {}}
  1243. test menu-6.16 {TkDestroyMenu} {
  1244.     catch {destroy .m1}
  1245.     catch {destroy .t2}
  1246.     catch {destroy .t3}
  1247.     menu .m1
  1248.     toplevel .t2
  1249.     wm geometry .t2 +0+0
  1250.     toplevel .t3
  1251.     wm geometry .t3 +0+0
  1252.     . configure -menu .m1
  1253.     .t2 configure -menu .m1
  1254.     .t3 configure -menu .m1
  1255.     list [catch {destroy .m1} msg] $msg [destroy .t2] [destroy .t3] [. configure -menu ""]
  1256. } {0 {} {} {} {}}
  1258. test menu-7.1 {UnhookCascadeEntry} {
  1259.     catch {destroy .m1}
  1260.     menu .m1
  1261.     .m1 add command -label "test"
  1262.     list [catch {destroy .m1} msg] $msg
  1263. } {0 {}}
  1264. test menu-7.2 {UnhookCascadeEntry} {
  1265.     catch {destroy .m1}
  1266.     menu .m1
  1267.     .m1 add cascade -menu .m2
  1268.     list [catch {destroy .m1} msg] $msg
  1269. } {0 {}}
  1270. test menu-7.3 {UnhookCascadeEntry} {
  1271.     catch {destroy .m1}
  1272.     catch {destroy .m2}
  1273.     menu .m1
  1274.     menu .m2
  1275.     .m2 add cascade -menu .cascade
  1276.     .m1 add cascade -menu .cascade
  1277.     list [catch {destroy .m1} msg] $msg [destroy .m2]
  1278. } {0 {} {}}
  1279. test menu-7.4 {UnhookCascadeEntry} {
  1280.     catch {destroy .m1}
  1281.     catch {destroy .m2}
  1282.     menu .m1
  1283.     menu .m2
  1284.     .m1 add cascade -menu .cascade
  1285.     .m2 add cascade -menu .cascade
  1286.     list [catch {destroy .m1} msg] $msg [destroy .m2]
  1287. } {0 {} {}}
  1288. test menu-7.5 {UnhookCascadeEntry} {
  1289.     catch {destroy .m1}
  1290.     catch {destroy .m2}
  1291.     catch {destroy .m3}
  1292.     menu .m1
  1293.     menu .m2
  1294.     menu .m3
  1295.     .m1 add cascade -menu .cascade
  1296.     .m2 add cascade -menu .cascade
  1297.     .m3 add cascade -menu .cascade
  1298.     list [catch {destroy .m1} msg] $msg [destroy .m2 .m3]
  1299. } {0 {} {}}
  1300. test menu-7.6 {UnhookCascadeEntry} {
  1301.     catch {destroy .m1}
  1302.     catch {destroy .m2}
  1303.     catch {destroy .m3}
  1304.     menu .m1
  1305.     menu .m2
  1306.     menu .m3
  1307.     .m1 add cascade -menu .cascade
  1308.     .m2 add cascade -menu .cascade
  1309.     .m3 add cascade -menu .cascade
  1310.     list [catch {destroy .m2} msg] $msg [destroy .m1 .m3]
  1311. } {0 {} {}}
  1312. test menu-7.7 {UnhookCascadeEntry} {
  1313.     catch {destroy .m1}
  1314.     catch {destroy .m2}
  1315.     catch {destroy .m3}
  1316.     menu .m1
  1317.     menu .m2
  1318.     menu .m3
  1319.     .m1 add cascade -menu .cascade
  1320.     .m2 add cascade -menu .cascade
  1321.     .m3 add cascade -menu .cascade
  1322.     list [catch {destroy .m3} msg] $msg [destroy .m1 .m2]
  1323. } {0 {} {}}
  1324. test menu-7.8 {UnhookCascadeEntry} {
  1325.     catch {destroy .m1}
  1326.     catch {destroy .m2}
  1327.     menu .m1
  1328.     menu .m2
  1329.     .m1 add cascade -menu .m2
  1330.     list [catch {destroy .m1} msg] $msg [destroy .m2]
  1331. } {0 {} {}}
  1332. test menu-7.9 {UnhookCascadeEntry} {
  1333.     catch {destroy .m1}
  1334.     catch {destroy .m2}
  1335.     menu .m1
  1336.     menu .m2
  1337.     .m1 add cascade -menu .m2
  1338.     destroy .m1
  1339.     list [catch {destroy .m2} msg] $msg
  1340. } {0 {}}
  1342. test menu-8.1 {DestroyMenuEntry} {
  1343.     catch {destroy .m1}
  1344.     catch {destroy .m2}
  1345.     menu .m1
  1346.     menu .m2
  1347.     .m1 add cascade -menu .m2
  1348.     list [catch {.m1 delete 1} msg] $msg [destroy .m1 .m2]
  1349. } {0 {} {}}
  1350. test menu-8.2 {DestroyMenuEntry} {
  1351.     catch {image delete image1a}
  1352.     catch {destroy .m1}
  1353.     image create photo image1a -file [file join $tk_library demos images earth.gif]
  1354.     menu .m1
  1355.     .m1 add command -image image1a
  1356.     list [catch {.m1 delete 1} msg] $msg [destroy .m1] [image delete image1a]
  1357. } {0 {} {} {}}
  1358. test menu-8.3 {DestroyMenuEntry} testImageType {
  1359.     catch {eval image delete [image names]}
  1360.     catch {destroy .m1}
  1361.     image create test image1
  1362.     image create test image2
  1363.     menu .m1
  1364.     .m1 add checkbutton -image image1 -selectimage image2
  1365.     .m1 invoke 1
  1366.     list [catch {.m1 delete 1} msg] $msg [destroy .m1] [eval image delete [image names]]
  1367. } {0 {} {} {}}
  1368. test menu-8.4 {DestroyMenuEntry} {
  1369.     catch {destroy .m1}
  1370.     menu .m1
  1371.     .m1 add checkbutton -variable foo
  1372.     list [catch {.m1 delete 1} msg] $msg [destroy .m1]
  1373. } {0 {} {}} 
  1374. test menu-8.5 {DestroyMenuEntry} {
  1375.     catch {destroy .m1}
  1376.     menu .m1
  1377.     .m1 add command -label "test"
  1378.     list [catch {.m1 delete 1} msg] $msg [destroy .m1]
  1379. } {0 {} {}}
  1380. test menu-8.6 {DestroyMenuEntry} {
  1381.     catch {destroy .m1}
  1382.     menu .m1
  1383.     .m1 add command -label "one"
  1384.     .m1 add command -label "two"
  1385.     list [catch {.m1 delete 1} msg] $msg [.m1 entrycget 1 -label] [destroy .m1]
  1386. } {0 {} two {}}
  1387. test menu-8.7 {DestroyMenuEntry} {
  1388.     catch {destroy .m1}
  1389.     catch {destroy .m2}
  1390.     menu .m1
  1391.     .m1 add command -label "one"
  1392.     .m1 clone .m2 tearoff
  1393.     list [catch {.m2 delete 0} msg] $msg [destroy .m1]
  1394. } {0 {} {}}
  1396. # test menu-9 - Can only change when fonts change on system, which cannot
  1397. # be done from tcl.
  1399. test menu-9.1 {ConfigureMenu} {
  1400.     catch {destroy .m1}
  1401.     menu .m1
  1402.     list [catch {.m1 configure -postcommand "beep"} msg] $msg [.m1 cget -postcommand] [destroy .m1]    
  1403. } {0 {} beep {}}
  1404. test menu-9.2 {ConfigureMenu} {
  1405.     catch {destroy .m1}
  1406.     menu .m1
  1407.     .m1 add command -label "test"
  1408.     list [catch {.m1 configure -tearoff 0} msg] $msg [.m1 entrycget 1 -label] [destroy .m1]
  1409. } {0 {} test {}}
  1410. test menu-9.3 {ConfigureMenu} {
  1411.     catch {destroy .m1}
  1412.     menu .m1
  1413.     list [catch {.m1 configure -postcommand "beep"} msg] $msg [.m1 cget -postcommand] [destroy .m1]
  1414. } {0 {} beep {}}
  1415. test menu-9.4 {ConfigureMenu} {
  1416.     catch {destroy .m1}
  1417.     menu .m1
  1418.     .m1 add command -label "test"
  1419.     list [catch {.m1 configure -fg red} msg] $msg [destroy .m1]
  1420. } {0 {} {}}
  1421. test menu-9.5 {ConfigureMenu} {
  1422.     catch {destroy .m1}
  1423.     menu .m1
  1424.     .m1 add command -label "test"
  1425.     .m1 add command -label "two"
  1426.     list [catch {.m1 configure -fg red} msg] $msg [destroy .m1]
  1427. } {0 {} {}}
  1428. test menu-9.6 {ConfigureMenu} {
  1429.     catch {destroy .m1}
  1430.     menu .m1
  1431.     .m1 add command -label "test"
  1432.     .m1 add command -label "two"
  1433.     .m1 add command -label "three"
  1434.     list [catch {.m1 configure -fg red} msg] $msg [destroy .m1]
  1435. } {0 {} {}}
  1436. test menu-9.7 {ConfigureMenu} {
  1437.     catch {destroy .m1}
  1438.     catch {destroy .m2}
  1439.     menu .m1
  1440.     .m1 clone .m2 tearoff
  1441.     list [catch {.m1 configure -fg red} msg] $msg [.m2 cget -fg] [destroy .m1]
  1442. } {0 {} red {}}
  1443. test menu-9.8 {ConfigureMenu} {
  1444.     catch {destroy .m1}
  1445.     catch {destroy .m2}
  1446.     menu .m1
  1447.     .m1 clone .m2 tearoff
  1448.     list [catch {.m2 configure -fg red} msg] $msg [.m1 cget -fg] [destroy .m1]
  1449. } {0 {} red {}}
  1450. test menu-9.9 {ConfigureMenu} {
  1451.     catch {destroy .m1}
  1452.     menu .m1
  1453.     list [catch {. configure -menu .m1} msg] $msg [. configure -menu ""] [destroy .m1]
  1454. } {0 {} {} {}}
  1456. test menu-10.1 {PostProcessEntry: array variable} {
  1457.     catch {destroy .m1}
  1458.     catch {unset foo}
  1459.     menu .m1
  1460.     set foo(1) on
  1461.     .m1 add checkbutton -variable foo(1) -onvalue on -offvalue off -label "Nonsense"
  1462.     list [catch {set foo(1)} msg] $msg [destroy .m1]
  1463. } {0 on {}}
  1464. test menu-10.2 {PostProcessEntry: array variable} {
  1465.     catch {destroy .m1}
  1466.     catch {unset foo}
  1467.     menu .m1
  1468.     .m1 add checkbutton -variable foo(1) -onvalue on -offvalue off -label "Nonsense"
  1469.     list [catch {set foo(1)} msg] $msg [destroy .m1]
  1470. } {0 off {}}
  1472. test menu-11.1 {ConfigureMenuEntry} {
  1473.     catch {destroy .m1}
  1474.     catch {unset foo}
  1475.     menu .m1
  1476.     .m1 add checkbutton -variable foo -onvalue on -offvalue off -label "Nonsense"
  1477.     list [catch {.m1 entryconfigure 1 -variable bar} msg] $msg [.m1 entrycget 1 -variable] [destroy .m1]
  1478. } {0 {} bar {}}
  1479. test menu-11.2 {ConfigureMenuEntry} {
  1480.     catch {destroy .m1}
  1481.     menu .m1
  1482.     .m1 add command -label "test"
  1483.     list [catch {.m1 entryconfigure 1 -label ""} msg] $msg [.m1 entrycget 1 -label] [destroy .m1]
  1484. } {0 {} {} {}}
  1485. test menu-11.3 {ConfigureMenuEntry} {
  1486.     catch {destroy .m1}
  1487.     menu .m1
  1488.     .m1 add command
  1489.     list [catch {.m1 entryconfigure 1 -label "test"} cmd] $cmd [.m1 entrycget 1 -label] [destroy .m1]
  1490. } {0 {} test {}}
  1491. test menu-11.4 {ConfigureMenuEntry} {
  1492.     catch {destroy .m1}
  1493.     menu .m1 
  1494.     .m1 add command
  1495.     list [catch {.m1 entryconfigure 1 -accel "S"} msg] $msg [.m1 entrycget 1 -accel] [destroy .m1]
  1496. } {0 {} S {}}
  1497. test menu-11.5 {ConfigureMenuEntry} {
  1498.     catch {destroy .m1}
  1499.     menu .m1
  1500.     .m1 add command
  1501.     list [catch {.m1 entryconfigure 1 -label "test"} msg] $msg [.m1 entrycget 1 -label] [destroy .m1]
  1502. } {0 {} test {}}
  1503. test menu-11.6 {ConfigureMenuEntry} {
  1504.     catch {destroy .m1}
  1505.     menu .m1
  1506.     .m1 add command
  1507.     list [catch {.m1 entryconfigure 1 -label "test"} msg] $msg [destroy .m1]
  1508. } {0 {} {}}
  1509. test menu-11.7 {ConfigureMenuEntry} {
  1510.     catch {destroy .m1}
  1511.     catch {destroy .m2}
  1512.     menu .m2
  1513.     menu .m1
  1514.     .m1 add cascade
  1515.     list [catch {.m1 entryconfigure 1 -label "test" -menu .m2} msg] $msg [destroy .m1 .m2]
  1516. } {0 {} {}}
  1517. test menu-11.8 {ConfigureMenuEntry} {
  1518.     catch {destroy .m1}
  1519.     menu .m1
  1520.     .m1 add cascade
  1521.     list [catch {.m1 entryconfigure 1 -label "test" -menu .m2} msg] $msg [destroy .m1]
  1522. } {0 {} {}}
  1523. test menu-11.9 {ConfigureMenuEntry} {
  1524.     catch {destroy .m1}
  1525.     menu .m1
  1526.     .m1 add cascade -menu .m3
  1527.     list [catch {.m1 entryconfigure 1 -label "test" -menu .m2} msg] $msg [destroy .m1]
  1528. } {0 {} {}}
  1529. test menu-11.10 {ConfigureMenuEntry} {
  1530.     catch {destroy .m1}
  1531.     menu .m1
  1532.     .m1 add cascade
  1533.     list [catch {.m1 entryconfigure 1 -label "test" -menu .m2} msg] $msg [destroy .m1]
  1534. } {0 {} {}}
  1535. test menu-11.11 {ConfigureMenuEntry} {
  1536.     catch {destroy .m1}
  1537.     menu .m1
  1538.     .m1 add cascade -menu .m2
  1539.     list [catch {.m1 entryconfigure 1 -label "test" -menu .m2} msg] $msg [destroy .m1]
  1540. } {0 {} {}}
  1541. test menu-11.12 {ConfigureMenuEntry} {
  1542.     catch {destroy .m1}
  1543.     catch {destroy .m2}
  1544.     catch {destroy .m3}
  1545.     catch {destroy .m4}
  1546.     catch {destroy .m5}
  1547.     menu .m1
  1548.     menu .m2 
  1549.     .m2 add cascade -menu .m1
  1550.     menu .m3 
  1551.     .m3 add cascade -menu .m1
  1552.     menu .m4 
  1553.     .m4 add cascade -menu .m1
  1554.     menu .m5 
  1555.     .m5 add cascade
  1556.     list [catch {.m5 entryconfigure 1 -label "test" -menu .m1} msg] $msg [destroy .m1 .m2 .m3 .m4 .m5]
  1557. } {0 {} {}}
  1558. test menu-11.13 {ConfigureMenuEntry} {
  1559.     catch {destroy .m1}
  1560.     catch {destroy .m2}
  1561.     catch {destroy .m3}
  1562.     catch {destroy .m4}
  1563.     menu .m1
  1564.     menu .m2 
  1565.     .m2 add cascade -menu .m1
  1566.     menu .m3 
  1567.     .m3 add cascade -menu .m1
  1568.     menu .m4 
  1569.     .m4 add cascade -menu .m1
  1570.     list [catch {.m3 entryconfigure 1 -label "test" -menu .m1} msg] $msg [destroy .m1 .m2 .m3 .m4]
  1571. } {0 {} {}}
  1572. test menu-11.14 {ConfigureMenuEntry} {
  1573.     catch {destroy .m1}
  1574.     menu .m1
  1575.     .m1 add checkbutton
  1576.     list [catch {.m1 entryconfigure 1 -variable "test"} msg] $msg [.m1 entrycget 1 -variable] [destroy .m1]
  1577. } {0 {} test {}}
  1578. test menu-11.15 {ConfigureMenuEntry} {
  1579.     catch {destroy .m1}
  1580.     menu .m1
  1581.     list [catch {.m1 add checkbutton -label "test"} msg] $msg [.m1 entrycget 1 -variable] [destroy .m1]
  1582. } {0 {} test {}}
  1583. test menu-11.16 {ConfigureMenuEntry} {
  1584.     catch {destroy .m1}
  1585.     menu .m1
  1586.     list [catch {.m1 add radiobutton -label "test"} msg] $msg [destroy .m1]
  1587. } {0 {} {}}
  1588. test menu-11.17 {ConfigureMenuEntry} {
  1589.     catch {destroy .m1}
  1590.     menu .m1
  1591.     .m1 add checkbutton
  1592.     list [catch {.m1 entryconfigure 1 -onvalue "test"} msg] $msg [.m1 entrycget 1 -onvalue] [destroy .m1]
  1593. } {0 {} test {}}
  1594. test menu-11.18 {ConfigureMenuEntry} testImageType {
  1595.     catch {destroy .m1}
  1596.     catch {image delete image1}
  1597.     menu .m1
  1598.     .m1 add command
  1599.     image create test image1
  1600.     list [catch {.m1 entryconfigure 1 -image image1} msg] $msg [destroy .m1] [image delete image1]
  1601. } {0 {} {} {}}
  1602. test menu-11.19 {ConfigureMenuEntry} testImageType {
  1603.     catch {destroy .m1}
  1604.     catch {image delete image1}
  1605.     catch {image delete image2}
  1606.     image create test image1
  1607.     image create photo image2 -file [file join $tk_library demos images earth.gif]
  1608.     menu .m1
  1609.     .m1 add command -image image1
  1610.     list [catch {.m1 entryconfigure 1 -image image2} msg] $msg [destroy .m1] [image delete image1] [image delete image2]
  1611. } {0 {} {} {} {}}
  1612. test menu-11.20 {ConfigureMenuEntry} testImageType {
  1613.     catch {destroy .m1}
  1614.     catch {image delete image1}
  1615.     catch {image delete image2}
  1616.     image create photo image1 -file [file join $tk_library demos images earth.gif]
  1617.     image create test image2
  1618.     menu .m1
  1619.     .m1 add checkbutton -image image1
  1620.     list [catch {.m1 entryconfigure 1 -selectimage image2} msg] $msg [destroy .m1] [image delete image1] [image delete image2]
  1621. } {0 {} {} {} {}}
  1622. test menu-11.21 {ConfigureMenuEntry} testImageType {
  1623.     catch {destroy .m1}
  1624.     catch {image delete image1}
  1625.     catch {image delete image2}
  1626.     catch {image delete image3}
  1627.     image create photo image1 -file [file join $tk_library demos images earth.gif]
  1628.     image create test image2
  1629.     image create test image3
  1630.     menu .m1
  1631.     .m1 add checkbutton -image image1 -selectimage image2
  1632.     list [catch {.m1 entryconfigure 1 -selectimage image3} msg] $msg [destroy .m1] [image delete image1] [image delete image2] [image delete image3]
  1633. } {0 {} {} {} {} {}}
  1635. test menu-12.1 {ConfigureMenuCloneEntries} {
  1636.     catch {destroy .m1}
  1637.     catch {destroy .m2}
  1638.     catch {destroy .m3}
  1639.     menu .m1
  1640.     .m1 clone .m2
  1641.     .m2 configure -tearoff 0
  1642.     .m1 clone .m3
  1643.     .m1 add command -label "test"
  1644.     .m1 add command -label "test2"
  1645.     list [list [catch {.m1 entryconfigure 1 -gork "foo"} msg] $msg] [destroy .m1]
  1646. } {{1 {unknown option "-gork"}} {}}
  1647. test menu-12.2 {ConfigureMenuCloneEntries} {
  1648.     catch {destroy .m1}
  1649.     catch {destroy .m2}
  1650.     catch {destroy .m3}
  1651.     catch {destroy .m4}
  1652.     menu .m1
  1653.     .m1 clone .m2
  1654.     menu .m3
  1655.     .m1 add cascade -menu .m3
  1656.     menu .m4
  1657.     list [catch {.m1 entryconfigure 1 -menu .m4} msg] $msg [destroy .m1] [destroy .m3] [destroy .m4]
  1658. } {0 {} {} {} {}}
  1659. test menu-12.3 {ConfigureMenuCloneEntries} {
  1660.     catch {destroy .m1}
  1661.     catch {destroy .m2}
  1662.     menu .m1
  1663.     .m1 clone .m2
  1664.     .m1 add cascade -label dummy
  1665.     list [catch {.m1 entryconfigure dummy -menu .m3} msg] $msg [destroy .m1]
  1666. } {0 {} {}}
  1668. test menu-12.4 {ConfigureMenuCloneEntries} {
  1669.      catch {destroy .m1}
  1670.      catch {destroy .m2}
  1671.      menu .m1
  1672.      .m1 add cascade -label File -menu .m1.foo
  1673.      menu .m1.foo
  1674.      .m1.foo add command -label bar
  1675.      .m1 clone .m2
  1676.      list [catch {.m1 entryconfigure File -state disabled} msg1] $msg1 [destroy .m1]
  1677. } {0 {} {}}
  1679. test menu-13.1 {TkGetMenuIndex} {
  1680.     catch {destroy .m1}
  1681.     menu .m1
  1682.     .m1 add command -label "active"
  1683.     .m1 add command -label "test2"
  1684.     .m1 add command -label "test3"
  1685.     .m1 activate 2
  1686.     list [catch {.m1 entrycget active -label} msg] $msg [destroy .m1]
  1687. } {0 test2 {}}
  1688. test menu-13.2 {TkGetMenuIndex} {
  1689.     catch {destroy .m1}
  1690.     menu .m1
  1691.     .m1 add command -label "last"
  1692.     .m1 add command -label "test2"
  1693.     .m1 add command -label "test3"
  1694.     .m1 activate 2
  1695.     list [catch {.m1 entrycget last -label} msg] $msg [destroy .m1]
  1696. } {0 test3 {}}
  1697. test menu-13.3 {TkGetMenuIndex} {
  1698.     catch {destroy .m1}
  1699.     menu .m1
  1700.     .m1 add command -label "last"
  1701.     .m1 add command -label "test2"
  1702.     .m1 add command -label "test3"
  1703.     .m1 activate 2
  1704.     list [catch {.m1 entrycget end -label} msg] $msg [destroy .m1]
  1705. } {0 test3 {}}
  1706. test menu-13.4 {TkGetMenuIndex} {
  1707.     catch {destroy .m1}
  1708.     menu .m1
  1709.     .m1 add command -label "test"
  1710.     list [catch {.m1 insert last command -label "test2"} msg] $msg [.m1 entrycget last -label] [destroy .m1]
  1711. } {0 {} test2 {}}
  1712. test menu-13.5 {TkGetMenuIndex} {
  1713.     catch {destroy .m1}
  1714.     menu .m1
  1715.     .m1 add command -label "test"
  1716.     list [catch {.m1 insert end command -label "test2"} msg] $msg [.m1 entrycget end -label] [destroy .m1]
  1717. } {0 {} test2 {}}
  1718. test menu-13.6 {TkGetMenuIndex} {
  1719.     catch {destroy .m1}
  1720.     menu .m1
  1721.     .m1 add command -label "active"
  1722.     .m1 add command -label "test2"
  1723.     .m1 add command -label "test3"
  1724.     .m1 activate 2
  1725.     list [catch {.m1 entrycget none -label} msg] $msg [destroy .m1]
  1726. } {0 {} {}}
  1727. #test menu-13.7 - Need to add @test here.
  1728. test menu-13.7 {TkGetMenuIndex} {
  1729.     catch {destroy .m1}
  1730.     menu .m1
  1731.     .m1 add command -label "active"
  1732.     .m1 add command -label "test2"
  1733.     .m1 add command -label "test3"
  1734.     list [catch {.m1 entrycget 1 -label} msg] $msg [destroy .m1]
  1735. } {0 active {}}
  1736. test menu-13.8 {TkGetMenuIndex} {
  1737.     catch {destroy .m1}
  1738.     menu .m1
  1739.     .m1 add command -label "active"
  1740.     list [catch {.m1 entrycget -1 -label} msg] $msg [destroy .m1]
  1741. } {1 {bad menu entry index "-1"} {}}
  1742. test menu-13.9 {TkGetMenuIndex} {
  1743.     catch {destroy .m1}
  1744.     menu .m1
  1745.     .m1 add command -label "test"
  1746.     .m1 add command -label "test2"
  1747.     list [catch {.m1 entrycget 999 -label} msg] $msg [destroy .m1]
  1748. } {0 test2 {}}
  1749. test menu-13.10 {TkGetMenuIndex} {
  1750.     catch {destroy .m1}
  1751.     menu .m1
  1752.     .m1 insert 999 command -label "test"
  1753.     list [catch {.m1 entrycget 1 -label} msg] $msg [destroy .m1]
  1754. } {0 test {}}
  1755. test menu-13.11 {TkGetMenuIndex} {
  1756.     catch {destroy .m1}
  1757.     menu .m1
  1758.     .m1 add command -label "1test"
  1759.     list [catch {.m1 entrycget 1test -label} msg] $msg [destroy .m1]
  1760. } {0 1test {}}
  1761. test menu-13.12 {TkGetMenuIndex} {
  1762.     catch {destroy .m1}
  1763.     menu .m1
  1764.     .m1 add command -label "test"
  1765.     .m1 add command -label "test2" -command "beep"
  1766.     .m1 add command -label "test3"
  1767.     list [catch {.m1 entrycget test2 -command} msg] $msg [destroy .m1]
  1768. } {0 beep {}}
  1770. test menu-14.1 {MenuCmdDeletedProc} {
  1771.     catch {destroy .m1}
  1772.     menu .m1
  1773.     list [catch {destroy .m1} msg] $msg
  1774. } {0 {}}
  1775. test menu-14.2 {MenuCmdDeletedProc} {
  1776.     catch {destroy .m1}
  1777.     menu .m1
  1778.     .m1 clone .m2
  1779.     list [catch {destroy .m1} msg] $msg
  1780. } {0 {}}
  1782. test menu-15.1 {MenuNewEntry} {
  1783.     catch {destroy .m1}
  1784.     menu .m1
  1785.     list [catch {.m1 add command -label "test"} msg] $msg [destroy .m1]
  1786. } {0 {} {}}
  1787. test menu-15.2 {MenuNewEntry} {
  1788.     catch {destroy .m1}
  1789.     menu .m1
  1790.     .m1 add command -label "test"
  1791.     .m1 add command -label "test3"
  1792.     list [catch {.m1 insert 2 command -label "test2"} msg] $msg [destroy .m1]
  1793. } {0 {} {}}
  1794. test menu-15.3 {MenuNewEntry} {
  1795.     catch {destroy .m1}
  1796.     menu .m1
  1797.     .m1 add command -label "test"
  1798.     list [catch {.m1 add command -label "test2"} msg] $msg [destroy .m1]
  1799. } {0 {} {}}
  1800. test menu-15.4 {MenuNewEntry} {
  1801.     catch {destroy .m1}
  1802.     menu .m1
  1803.     list [catch {.m1 add command -label "test"} msg] $msg [destroy .m1]
  1804. } {0 {} {}}
  1806. test menu-16.1 {MenuAddOrInsert} {
  1807.     catch {destroy .m1}
  1808.     menu .m1
  1809.     list [catch {.m1 insert foo command -label "test"} msg] $msg [destroy .m1]
  1810. } {1 {bad menu entry index "foo"} {}}
  1811. test menu-16.2 {MenuAddOrInsert} {
  1812.     catch {destroy .m1}
  1813.     menu .m1
  1814.     .m1 add command -label "test"
  1815.     list [catch {.m1 insert test command -label "foo"} msg] $msg [destroy .m1]
  1816. } {0 {} {}}
  1817. test menu-16.3 {MenuAddOrInsert} {
  1818.     catch {destroy .m1}
  1819.     menu .m1
  1820.     list [catch {.m1 insert -1 command -label "test"} msg] $msg [destroy .m1]
  1821. } {1 {bad menu entry index "-1"} {}}
  1822. test menu-16.4 {MenuAddOrInsert} {
  1823.     catch {destroy .m1}
  1824.     menu .m1
  1825.     .m1 add command -label "test"
  1826.     .m1 insert 0 command -label "test2"
  1827.     list [catch {.m1 entrycget 1 -label} msg] $msg [destroy .m1]
  1828. } {0 test2 {}}
  1829. test menu-16.5 {MenuAddOrInsert} {
  1830.     catch {destroy .m1}
  1831.     menu .m1
  1832.     list [catch {.m1 add cascade} msg] $msg [destroy .m1]
  1833. } {0 {} {}}
  1834. test menu-16.6 {MenuAddOrInsert} {
  1835.     catch {destroy .m1}
  1836.     menu .m1
  1837.     list [catch {.m1 add checkbutton} msg] $msg [destroy .m1]
  1838. } {0 {} {}}
  1839. test menu-16.7 {MenuAddOrInsert} {
  1840.     catch {destroy .m1}
  1841.     menu .m1
  1842.     list [catch {.m1 add command} msg] $msg [destroy .m1]
  1843. } {0 {} {}}
  1844. test menu-16.8 {MenuAddOrInsert} {
  1845.     catch {destroy .m1}
  1846.     menu .m1
  1847.     list [catch {.m1 add radiobutton} msg] $msg [destroy .m1]
  1848. } {0 {} {}}
  1849. test menu-16.9 {MenuAddOrInsert} {
  1850.     catch {destroy .m1}
  1851.     menu .m1
  1852.     list [catch {.m1 add separator} msg] $msg [destroy .m1]
  1853. } {0 {} {}}
  1854. test menu-16.10 {MenuAddOrInsert} {
  1855.     catch {destroy .m1}
  1856.     menu .m1
  1857.     list [catch {.m1 add blork} msg] $msg [destroy .m1]
  1858. } {1 {bad menu entry type "blork": must be cascade, checkbutton, command, radiobutton, or separator} {}}
  1859. test menu-16.11 {MenuAddOrInsert} {
  1860.     catch {destroy .m1}
  1861.     menu .m1
  1862.     list [catch {.m1 add command} msg] $msg [destroy .m1]
  1863. } {0 {} {}}
  1864. test menu-16.12 {MenuAddOrInsert} {
  1865.     catch {destroy .m1}
  1866.     catch {destroy .m2}
  1867.     catch {destroy .m3}
  1868.     menu .m1
  1869.     .m1 clone .m2
  1870.     .m2 clone .m3
  1871.     list [catch {.m2 add command -label "test"} msg1] $msg1 [catch {.m1 entrycget 1 -label} msg2] $msg2 [catch {.m3 entrycget 1 -label} msg3] $msg3 [destroy .m1]
  1872. } {0 {} 0 test 0 test {}}
  1873. test menu-16.13 {MenuAddOrInsert} {
  1874.     catch {destroy .m1}
  1875.     catch {destroy .m2}
  1876.     catch {destroy .m3}
  1877.     menu .m1
  1878.     .m1 clone .m2
  1879.     .m2 clone .m3
  1880.     list [catch {.m3 add command -label "test"} msg1] $msg1 [catch {.m1 entrycget 1 -label} msg2] $msg2 [catch {.m2 entrycget 1 -label} msg3] $msg3 [destroy .m1]
  1881. } {0 {} 0 test 0 test {}}
  1882. test menu-16.14 {MenuAddOrInsert} {
  1883.     catch {destroy .m1}
  1884.     menu .m1
  1885.     list [catch {.m1 add command -blork} msg] $msg [destroy .m1]
  1886. } {1 {unknown option "-blork"} {}}
  1887. test menu-16.15 {MenuAddOrInsert} {
  1888.     catch {destroy .m1}
  1889.     catch {destroy .container}
  1890.     menu .m1
  1891.     .m1 add command -label "File"
  1892.     menu .container
  1893.     . configure -menu .container
  1894.     list [catch {.container add cascade -label "File" -menu .m1} msg] $msg [. configure -menu ""] [destroy .container .m1]
  1895. } {0 {} {} {}}
  1896. test menu-16.16 {MenuAddOrInsert} {
  1897.     catch {destroy .m1}
  1898.     catch {destroy .m2}
  1899.     menu .m1
  1900.     menu .m2
  1901.     set tearoff [tk::TearOffMenu .m2]
  1902.     list [catch {.m2 add cascade -menu .m1} msg] $msg [$tearoff unpost] [catch {destroy .m1} msg2] $msg2 [catch {destroy .m2} msg3] $msg3
  1903. } {0 {} {} 0 {} 0 {}}
  1904. test menu-16.17 {MenuAddOrInsert} {
  1905.     catch {destroy .m1}
  1906.     catch {destroy .container}
  1907.     menu .m1
  1908.     menu .container
  1909.     . configure -menu .container
  1910.     set tearoff [tk::TearOffMenu .container]
  1911.     list [catch {.container add cascade -label "File" -menu .m1} msg] $msg [. configure -menu ""] [destroy .m1 .container]
  1912. } {0 {} {} {}}
  1913. test menu-16.18 {MenuAddOrInsert} {
  1914.     catch {destroy .m1}
  1915.     catch {destroy .container}
  1916.     menu .m1
  1917.     menu .container
  1918.     .container add cascade -menu .m1
  1919.     . configure -menu .container
  1920.     list [catch {.container add cascade -label "File" -menu .m1} msg] $msg [. configure -menu ""] [destroy .m1 .container]
  1921. } {0 {} {} {}}
  1922. test menu-16.19 {MenuAddOrInsert - Insert a cascade deep into the tree} {
  1923.     catch {destroy .menubar}
  1924.     menu .menubar
  1925.     menu .menubar.test -tearoff 0
  1926.     .menubar add cascade -label Test -underline 0 -menu .menubar.test
  1927.     menu .menubar.test.cascade -tearoff 0
  1928.     .menubar.test.cascade add command -label SubItem -command "puts SubItemSelected"
  1929.     . configure -menu .menubar
  1930.     list [catch {.menubar.test add cascade -label SubMenu 
  1931. -menu .menubar.test.cascade} msg] 
  1932. [info commands .#menubar.#menubar#test.#menubar#test#cascade] 
  1933. [. configure -menu ""] [destroy .menubar]
  1934. } {0 .#menubar.#menubar#test.#menubar#test#cascade {} {}}
  1936. test menu-17.1 {MenuVarProc} {
  1937.     catch {destroy .m1}
  1938.     catch {unset foo}
  1939.     menu .m1
  1940.     set foo "hello"
  1941.     list [catch {.m1 add checkbutton -variable foo -onvalue hello -offvalue goodbye} msg] $msg [catch {unset foo} msg2] $msg2 [destroy .m1]
  1942. } {0 {} 0 {} {}}
  1943. # menu-17.2 - Don't know how to generate the flags in the if
  1944. test menu-17.2 {MenuVarProc} {
  1945.     catch {destroy .m1}
  1946.     catch {unset foo}
  1947.     menu .m1
  1948.     list [catch {.m1 add checkbutton -variable foo -onvalue hello -offvalue goodbye} msg] $msg [set foo ""] [destroy .m1]
  1949. } {0 {} {} {}}
  1950. test menu-17.3 {MenuVarProc} {
  1951.     catch {destroy .m1}
  1952.     catch {unset foo}
  1953.     menu .m1
  1954.     set foo "hello"
  1955.     list [catch {.m1 add checkbutton -variable foo -onvalue hello -offvalue goodbye} msg] $msg [set foo "hello"] [destroy .m1] [catch {unset foo} msg2] $msg2
  1956. } {0 {} hello {} 0 {}}
  1957. test menu-17.4 {MenuVarProc} {
  1958.     catch {destroy .m1}
  1959.     menu .m1
  1960.     set foo "goodbye"
  1961.     list [catch {.m1 add checkbutton -variable foo -onvalue hello -offvalue goodbye} msg] $msg [set foo "hello"] [destroy .m1] [catch {unset foo} msg2] $msg2
  1962. } {0 {} hello {} 0 {}}
  1963. test menu-17.5 {MenuVarProc} {
  1964.     catch {destroy .m1}
  1965.     menu .m1
  1966.     set foo "hello"
  1967.     list [catch {.m1 add checkbutton -variable foo -onvalue hello -offvalue goodbye} msg] $msg [set foo "goodbye"] [destroy .m1] [catch {unset foo} msg2] $msg2
  1968. } {0 {} goodbye {} 0 {}}
  1970. test menu-18.1 {TkActivateMenuEntry} {
  1971.     catch {destroy .m1}
  1972.     menu .m1
  1973.     .m1 add command -label "test"
  1974.     list [catch {.m1 activate 1} msg] $msg [destroy .m1]
  1975. } {0 {} {}}
  1976. test menu-18.2 {TkActivateMenuEntry} {
  1977.     catch {destroy .m1}
  1978.     menu .m1
  1979.     .m1 add command -label "test"
  1980.     list [catch {.m1 activate 0} msg] $msg [destroy .m1]
  1981. } {0 {} {}}
  1982. test menu-18.3 {TkActivateMenuEntry} {
  1983.     catch {destroy .m1}
  1984.     menu .m1
  1985.     .m1 add command -label "test"
  1986.     .m1 add command -label "test2"
  1987.     .m1 activate 1
  1988.     list [catch {.m1 activate 2} msg] $msg [destroy .m1]
  1989. } {0 {} {}}
  1990. test menu-18.4 {TkActivateMenuEntry} {
  1991.     catch {destroy .m1}
  1992.     menu .m1
  1993.     .m1 add command -label "test"
  1994.     .m1 add command -label "test2"
  1995.     .m1 activate 1
  1996.     list [catch {.m1 activate 1} msg] $msg [destroy .m1]
  1997. } {0 {} {}}
  1999. test menu-19.1 {TkPostCommand} {nonUnixUserInteraction } {
  2000.     catch {destroy .m1}
  2001.     menu .m1 -postcommand "set menu_test menu-19.1"
  2002.     .m1 add command -label "menu-19.1 - hit Escape"
  2003.     list [catch {.m1 post 40 40} msg] $msg [.m1 unpost] [set menu_test] [destroy .m1]
  2004. } {0 menu-19.1 {} menu-19.1 {}}
  2005. test menu-19.2 {TkPostCommand} {nonUnixUserInteraction } {
  2006.     catch {destroy .m1}
  2007.     menu .m1
  2008.     .m1 add command -label "menu-19.2 - hit Escape"
  2009.     list [catch {.m1 post 40 40} msg] $msg [.m1 unpost] [destroy .m1]
  2010. } {0 {} {} {}}
  2012. test menu-20.1 {CloneMenu} {
  2013.     catch {destroy .m1}
  2014.     catch {destroy .m2}
  2015.     menu .m1
  2016.     list [catch {.m1 clone .m2} msg1] $msg1 [destroy .m1]
  2017. } {0 {} {}}
  2018. test menu-20.2 {CloneMenu} {
  2019.     catch {destroy .m1}
  2020.     catch {destroy .m2}
  2021.     menu .m1
  2022.     list [catch {.m1 clone .m2 normal} msg1] $msg1 [destroy .m1]
  2023. } {0 {} {}}
  2024. test menu-20.3 {CloneMenu} {
  2025.     catch {destroy .m1}
  2026.     catch {destroy .m2}
  2027.     menu .m1
  2028.     list [catch {.m1 clone .m2 tearoff} msg1] $msg1 [destroy .m1]
  2029. } {0 {} {}}
  2030. test menu-20.4 {CloneMenu} {
  2031.     catch {destroy .m1}
  2032.     catch {destroy .m2}
  2033.     menu .m1
  2034.     list [catch {.m1 clone .m2 menubar} msg1] $msg1 [destroy .m1]
  2035. } {0 {} {}}
  2036. test menu-20.5 {CloneMenu} {
  2037.     catch {destroy .m1}
  2038.     catch {destroy .m2}
  2039.     menu .m1
  2040.     list [catch {.m1 clone .m2 foo} msg1] $msg1 [destroy .m1]
  2041. } {1 {bad menu type "foo": must be normal, tearoff, or menubar} {}}
  2042. test menu-20.6 {CloneMenu - hooking up bookeeping ptrs} {
  2043.     catch {destroy .m1}
  2044.     catch {destroy .m2}
  2045.     menu .m1
  2046.     list [catch {.m1 clone .m2} msg] $msg [destroy .m1]
  2047.  } {0 {} {}}
  2048.  test menu-20.7 {CloneMenu - hooking up bookeeping ptrs - multiple children} {
  2049.     catch {destroy .m1}
  2050.     catch {destroy .m2}
  2051.     catch {destroy .m3}
  2052.     menu .m1
  2053.     .m1 clone .m2
  2054.     list [catch {.m1 clone .m3} msg] $msg [destroy .m1]
  2055.  } {0 {} {}}
  2056.  test menu-20.8 {CloneMenu - cascade entries} {
  2057.     catch {destroy .m1}
  2058.     catch {destroy .foo}
  2059.     menu .m1
  2060.     .m1 add cascade -menu .m2
  2061.     list [catch {.m1 clone .foo} msg] $msg [destroy .m1]
  2062.  } {0 {} {}}
  2063.  test menu-20.9 {CloneMenu - cascades entries} {
  2064.     catch {destroy .m1}
  2065.     catch {destroy .m2}
  2066.     catch {destroy .foo}
  2067.     menu .m1
  2068.     .m1 add cascade -menu .m2
  2069.     menu .m2
  2070.     list [catch {.m1 clone .foo} msg] $msg [destroy .m1 .m2]
  2071.  } {0 {} {}}
  2072. test menu-20.10 {CloneMenu - tearoff fields} {
  2073.     catch {destroy .m1}
  2074.     catch {destroy .m2}
  2075.     menu .m1
  2076.     list [catch {.m1 clone .m2 normal} msg1] $msg1 [catch {.m2 cget -tearoff} msg2] $msg2 [destroy .m1]
  2077. } {0 {} 0 1 {}}
  2078. test menu-20.11 {CloneMenu} {
  2079.     catch {destroy .m1}
  2080.     catch {destroy .m2}
  2081.     menu .m1
  2082.     menu .m2
  2083.     list [catch {.m1 clone .m2} msg] $msg [destroy .m1 .m2]
  2084. } {1 {window name "m2" already exists in parent} {}}
  2086. test menu-21.1 {MenuDoYPosition} {
  2087.     catch {destroy .m1}
  2088.     menu .m1
  2089.     list [catch {.m1 yposition glorp} msg] $msg [destroy .m1]
  2090. } {1 {bad menu entry index "glorp"} {}}
  2091. test menu-21.2 {MenuDoYPosition} {
  2092.     catch {destroy .m1}
  2093.     menu .m1
  2094.     .m1 add command -label "Test"
  2095.     list [catch {.m1 yposition 1}] [destroy .m1]
  2096. } {0 {}}
  2098. test menu-22.1 {GetIndexFromCoords} {
  2099.     catch {destroy .m1}
  2100.     menu .m1
  2101.     .m1 add command -label "test"
  2102.     .m1 configure -tearoff 0
  2103.     list [catch {.m1 index @5} msg] $msg [destroy .m1]
  2104. } {0 0 {}}
  2105. test menu-22.2 {GetIndexFromCoords} {
  2106.     catch {destroy .m1}
  2107.     menu .m1
  2108.     .m1 add command -label "test"
  2109.     .m1 configure -tearoff 0
  2110.     list [catch {.m1 index @5,5} msg] $msg [destroy .m1]
  2111. } {0 0 {}}
  2113. test menu-23.1 {RecursivelyDeleteMenu} {
  2114.     catch {destroy .m1}
  2115.     menu .m1
  2116.     . configure -menu .m1
  2117.     list [catch {. configure -menu ""} msg] $msg [destroy .m1]
  2118. } {0 {} {}}
  2119. test menu-23.2 {RecursivelyDeleteMenu} {
  2120.     catch {destroy .m1}
  2121.     catch {destroy .m2}
  2122.     menu .m2
  2123.     .m2 add command -label "test2"
  2124.     menu .m1
  2125.     .m1 add cascade -label "test1" -menu .m2
  2126.     . configure -menu .m1
  2127.     list [catch {. configure -menu ""} msg] $msg [destroy .m1 .m2]
  2128. } {0 {} {}}
  2130. test menu-24.1 {TkNewMenuName} {
  2131.     catch {destroy .m1}
  2132.     menu .m1
  2133.     list [catch {. configure -menu .m1} msg] $msg [. configure -menu ""] [destroy .m1]
  2134. } {0 {} {} {}}
  2135. test menu-24.2 {TkNewMenuName} {
  2136.     catch {destroy .m1}
  2137.     catch {destroy .m1#0}
  2138.     menu .m1
  2139.     menu .m1#0
  2140.     list [catch {. configure -menu .m1} msg] $msg [. configure -menu ""] [destroy .m1]
  2141. } {0 {} {} {}}
  2142. test menu-24.3 {TkNewMenuName} {
  2143.     catch {destroy .#m}
  2144.     menu .#m
  2145.     rename .#m hideme
  2146.     list [catch {. configure -menu [menu .m]} $msg] [. configure -menu ""] [destroy .#m] [destroy .m] [destroy hideme]
  2147. } {0 {} {} {} {}}
  2149. test menu-25.1 {TkSetWindowMenuBar} {
  2150.     . configure -menu ""
  2151.     list [catch {. configure -menu .m1} msg] $msg [. configure -menu ""]
  2152. } {0 {} {}}
  2153. test menu-25.2 {TkSetWindowMenuBar} {
  2154.     . configure -menu ""
  2155.     list [catch {. configure -menu .m1} msg] $msg [. configure -menu ""]
  2156. } {0 {} {}}
  2157. test menu-25.3 {TkSetWindowMenuBar} {
  2158.     . configure -menu ""
  2159.     catch {destroy .m1}
  2160.     menu .m1
  2161.     list [catch {. configure -menu .m1} msg] $msg [. configure -menu ""] [destroy .m1]
  2162. } {0 {} {} {}}
  2163. test menu-25.4 {TkSetWindowMenuBar} {
  2164.     catch {destroy .m1}
  2165.     catch {destroy .m2}
  2166.     . configure -menu ""
  2167.     menu .m1
  2168.     . configure -menu .m1
  2169.     menu .m2
  2170.     list [catch {. configure -menu .m2} msg] $msg [. configure -menu ""] [destroy .m1 .m2]
  2171. } {0 {} {} {}}
  2172. test menu-25.5 {TkSetWindowMenuBar} {
  2173.     catch {destroy .m1}
  2174.     catch {destroy .m2}
  2175.     catch {destroy .m3}
  2176.     . configure -menu ""
  2177.     menu .m1
  2178.     . configure -menu .m1
  2179.     .m1 clone .m2
  2180.     menu .m3
  2181.     list [catch {. configure -menu .m3} msg] $msg [. configure -menu ""] [destroy .m1 .m3]
  2182. } {0 {} {} {}}
  2183. test menu-25.6 {TkSetWindowMenuBar} {
  2184.     catch {destroy .m1}
  2185.     catch {destroy .m2}
  2186.     catch {destroy .m3}
  2187.     . configure -menu ""
  2188.     menu .m1
  2189.     .m1 clone .m2
  2190.     . configure -menu .m2
  2191.     menu .m3
  2192.     list [catch {. configure -menu .m3} msg] $msg [. configure -menu ""] [destroy .m1 .m3]
  2193. } {0 {} {} {}}
  2194. test menu-25.7 {TkSetWindowMenuBar} {
  2195.     catch {destroy .m1}
  2196.     catch {destroy .m2}
  2197.     . configure -menu ""
  2198.     menu .m1
  2199.     menu .m2
  2200.     . configure -menu .m1
  2201.     toplevel .t2
  2202.     .t2 configure -menu .m1
  2203.     list [catch {.t2 configure -menu .m2} msg] $msg [. configure -menu ""] [destroy .t2 .m1 .m2]
  2204. } {0 {} {} {}}
  2205. test menu-25.8 {TkSetWindowMenuBar} {
  2206.     catch {destroy .m1}
  2207.     catch {destroy .m2}
  2208.     catch {destroy .t2}
  2209.     . configure -menu ""
  2210.     menu .m1
  2211.     menu .m2
  2212.     . configure -menu .m1
  2213.     toplevel .t2
  2214.     wm geometry .t2 +0+0
  2215.     .t2 configure -menu .m1
  2216.     list [catch {. configure -menu .m2} msg] $msg [. configure -menu ""] [destroy .t2 .m1 .m2]
  2217. } {0 {} {} {}}
  2218. test menu-25.9 {TkSetWindowMenuBar} {
  2219.     catch {destroy .m1}
  2220.     catch {destroy .m2}
  2221.     catch {destroy .t2}
  2222.     catch {destroy .t3}
  2223.     . configure -menu ""
  2224.     menu .m1
  2225.     menu .m2
  2226.     . configure -menu .m1
  2227.     toplevel .t2 -menu .m1
  2228.     wm geometry .t2 +0+0
  2229.     toplevel .t3 -menu .m1
  2230.     wm geometry .t3 +0+0
  2231.     list [catch {.t3 configure -menu .m2} msg] $msg [. configure -menu ""] [destroy .t2 .t3 .m1 .m2]
  2232. } {0 {} {} {}}
  2233. test menu-25.10 {TkSetWindowMenuBar} {
  2234.     catch {destroy .m1}
  2235.     catch {destroy .m2}
  2236.     catch {destroy .t2}
  2237.     catch {destroy .t3}
  2238.     . configure -menu ""
  2239.     menu .m1
  2240.     menu .m2
  2241.     . configure -menu .m1
  2242.     toplevel .t2 -menu .m1
  2243.     wm geometry .t2 +0+0
  2244.     toplevel .t3 -menu .m1
  2245.     wm geometry .t3 +0+0
  2246.     list [catch {.t2 configure -menu .m2} msg] $msg [. configure -menu ""] [destroy .t2 .t3 .m1 .m2]
  2247. } {0 {} {} {}}
  2248. test menu-25.11 {TkSetWindowMenuBar} {
  2249.     catch {destroy .m1}
  2250.     catch {destroy .m2}
  2251.     catch {destroy .t2}
  2252.     catch {destroy .t3}
  2253.     . configure -menu ""
  2254.     menu .m1
  2255.     menu .m2
  2256.     . configure -menu .m1
  2257.     toplevel .t2 -menu .m1
  2258.     wm geometry .t2 +0+0
  2259.     toplevel .t3 -menu .m1
  2260.     wm geometry .t3 +0+0
  2261.     list [catch {. configure -menu .m2} msg] $msg [. configure -menu ""] [destroy .t2 .t3 .m1 .m2]
  2262. } {0 {} {} {}}
  2263. test menu-25.12 {TkSetWindowMenuBar} {
  2264.     catch {destroy .m1}
  2265.     . configure -menu ""
  2266.     menu .m1
  2267.     list [catch {. configure -menu .m1} msg] $msg [. configure -menu ""] [destroy .m1]
  2268. } {0 {} {} {}}
  2269. test menu-25.13 {TkSetWindowMenuBar} {
  2270.     . configure -menu ""
  2271.     list [catch {. configure -menu .m1} msg] $msg [. configure -menu ""]
  2272. } {0 {} {}}
  2273. test menu-25.14 {TkSetWindowMenuBar} {
  2274.     catch {destroy .m1}
  2275.     . configure -menu ""
  2276.     menu .m1
  2277.     list [catch {. configure -menu .m1} msg] $msg [. configure -menu ""] [destroy .m1]
  2278. } {0 {} {} {}}
  2279. test menu-25.15 {TkSetWindowMenuBar} {
  2280.     . configure -menu ""
  2281.     list [catch {. configure -menu .m1} msg] $msg [. configure -menu ""]
  2282. } {0 {} {}}
  2283. test menu-25.16 {TkSetWindowMenuBar} {
  2284.     catch {destroy .m1}
  2285.     . configure -menu ""
  2286.     menu .m1
  2287.     . configure -menu .m1
  2288.     list [catch {toplevel .t2 -menu m1} msg] $msg [. configure -menu ""] [destroy .t2 .m1]
  2289. } {0 .t2 {} {}}
  2291. test menu-26.1 {DestroyMenuHashTable} {
  2292.     catch {interp destroy testinterp}
  2293.     interp create testinterp
  2294.     load {} Tk testinterp
  2295.     interp eval testinterp {menu .m1}
  2296.     list [catch {interp delete testinterp} msg] $msg
  2297. } {0 {}}
  2299. test menu-27.1 {GetMenuHashTable} {
  2300.     catch {interp destroy testinterp}
  2301.     interp create testinterp
  2302.     load {} Tk testinterp
  2303.     list [catch {interp eval testinterp {menu .m1}} msg] $msg [interp delete testinterp]
  2304. } {0 .m1 {}}
  2306. test menu-28.1 {TkCreateMenuReferences - not there before} {
  2307.     catch {destroy .m1}
  2308.     list [catch {menu .m1} msg] $msg [destroy .m1]
  2309. } {0 .m1 {}}
  2310. test menu-28.2 {TkCreateMenuReferences - there already} {
  2311.     catch {destroy .m1}
  2312.     catch {destroy .m2}
  2313.     menu .m1
  2314.     .m1 add cascade -menu .m2
  2315.     list [catch {menu .m2} msg] $msg [destroy .m1 .m2]
  2316. } {0 .m2 {}}
  2318. test menu-29.1 {TkFindMenuReferences - not there} {
  2319.     catch {destroy .m1}
  2320.     . configure -menu ""
  2321.     menu .m1
  2322.     .m1 add cascade -menu .m2
  2323.     list [catch {. configure -menu .m1} msg] $msg [. configure -menu ""] [destroy .m1]
  2324. } {0 {} {} {}}
  2325. test menu-30.1 {TkFindMenuReferences - there already} {
  2326.     catch {destroy .m1}
  2327.     catch {destroy .m2}
  2328.     . configure -menu ""
  2329.     menu .m1
  2330.     menu .m2
  2331.     .m1 add cascade -menu .m2
  2332.     list [catch {. configure -menu .m1} msg] $msg [. configure -menu ""] [destroy .m1 .m2]
  2333. } {0 {} {} {}}
  2335. test menu-31.1 {TkFreeMenuReferences - menuPtr} {
  2336.     catch {destroy .m1}
  2337.     menu .m1
  2338.     list [catch {destroy .m1} msg] $msg
  2339. } {0 {}}
  2340. test menu-31.2 {TkFreeMenuReferences - cascadePtr} {
  2341.     catch {destroy .m1}
  2342.     . configure -menu ""
  2343.     menu .m1
  2344.     .m1 add cascade -menu .m2
  2345.     list [catch {.m1 entryconfigure 1 -menu .m3} msg] $msg [destroy .m1]
  2346. } {0 {} {}}
  2347. test menu-31.3 {TkFreeMenuReferences - topLevelListPtr} {
  2348.     . configure -menu .m1
  2349.     list [catch {. configure -menu ""} msg] $msg
  2350. } {0 {}}
  2351. test menu-31.4 {TkFreeMenuReferences - not empty} {
  2352.     catch {destroy .m1}
  2353.     catch {destroy .m2}
  2354.     menu .m1
  2355.     .m1 add cascade -menu .m3
  2356.     menu .m2
  2357.     .m2 add cascade -menu .m3
  2358.     list [catch {.m2 entryconfigure 1 -menu ".foo"} msg] $msg [destroy .m1 .m2]
  2359. } {0 {} {}}
  2361. test menu-32.1 {DeleteMenuCloneEntries} {
  2362.     catch {destroy .m1}
  2363.     catch {destroy .m2}
  2364.     menu .m1
  2365.     .m1 add command -label foo
  2366.     .m1 clone .m2
  2367.     list [catch {.m1 delete 1} msg] $msg [destroy .m1]
  2368. } {0 {} {}}
  2369. test menu-32.2 {DeleteMenuCloneEntries} {
  2370.     catch {destroy .m1}
  2371.     catch {destroy .m2}
  2372.     menu .m1
  2373.     .m1 add command -label one
  2374.     .m1 add command -label two
  2375.     .m1 add command -label three
  2376.     .m1 add command -label four
  2377.     .m1 clone .m2
  2378.     list [catch {.m1 delete 2 3} msg] $msg [destroy .m1]
  2379. } {0 {} {}}
  2380. test menu-32.3 {DeleteMenuCloneEntries} {
  2381.     catch {destroy .m1}
  2382.     catch {destroy .m2}
  2383.     menu .m1 -tearoff 0
  2384.     .m1 add command -label one
  2385.     .m1 add command -label two
  2386.     .m1 add command -label three
  2387.     .m1 add command -label four
  2388.     .m1 clone .m2
  2389.     .m2 configure -tearoff 1
  2390.     list [catch {.m1 delete 1 2} msg] $msg [destroy .m1]
  2391. } {0 {} {}}
  2392. test menu-32.4 {DeleteMenuCloneEntries} {
  2393.     catch {destroy .m1}
  2394.     catch {destroy .m2}
  2395.     menu .m1
  2396.     .m1 add command -label one
  2397.     .m1 add command -label two
  2398.     .m1 add command -label three
  2399.     .m1 add command -label four
  2400.     .m1 clone .m2
  2401.     .m2 configure -tearoff 0
  2402.     list [catch {.m1 delete 2 3} msg] $msg [destroy .m1]
  2403. } {0 {} {}}
  2404. test menu-32.5 {DeleteMenuCloneEntries} {
  2405.     catch {destroy .m1}
  2406.     catch {destroy .m2}
  2407.     menu .m1
  2408.     .m1 add command -label one
  2409.     .m1 add command -label two
  2410.     .m1 clone .m2
  2411.     .m1 activate one
  2412.     list [catch {.m1 delete one} msg] $msg [destroy .m1]
  2413. } {0 {} {}}
  2414. test menu-32.6 {DeleteMenuCloneEntries - reentrancy - crashes tk8.0} {
  2415.     catch {destroy .m1}
  2416.     menu .m1
  2417.     .m1 add command -label test -command ".m1 delete test ; .m1 add command -label test -command ".m1 delete test"; .m1 delete test"
  2418.     list [catch {.m1 invoke test} msg] $msg [destroy .m1]
  2419. } {0 {} {}}
  2420. test menu-32.7 {DeleteMenuCloneEntries - one entry} {
  2421.     catch {destroy .m1}
  2422.     menu .m1 -tearoff 0
  2423.     .m1 add command -label Hello
  2424.     list [catch {.m1 delete Hello} msg] $msg [destroy .m1]
  2425. } {0 {} {}}
  2426. test menu-32.8 {Ensure all menu clone commands are deleted} {
  2427.     # SF bug #465324
  2428.     catch {destroy .menubar}
  2429.     catch {destroy .menubar.test}
  2430.     menu .menubar
  2431.     . configure -menu .menubar
  2432.     menu .menubar.test
  2433.     .menubar.test add command -label "hi"
  2434.     for {set i 0} {$i < 10} {incr i} {
  2435. .menubar add cascade -menu .menubar.test -label "Test"
  2436. .menubar delete Test
  2437.     }
  2439.     info commands .#menubar*test*
  2440. } {}
  2441. test menu-32.9 {Ensure deleting of clones doesn't corrupt menu refs} {
  2442.     catch {destroy .menubar}
  2443.     catch {destroy .menubar.test}
  2444.     
  2445.     menu .menubar
  2446.     . configure -menu .menubar
  2447.     menu .menubar.test
  2448.     .menubar add cascade -menu .menubar.test -label "Test"
  2449.     menu .menubar.cascade
  2451.     .menubar.test add cascade -menu .menubar.cascade -label "Cascade"
  2452.     set res {}
  2453.     lappend res [.menubar.test entrycget 1 -menu]
  2454.     lappend res [.#menubar.#menubar#test entrycget 1 -menu]
  2455.     destroy .menubar.test
  2456.     menu .menubar.test
  2457.     .menubar.test add cascade -menu .menubar.cascade -label "Cascade"
  2458.     lappend res [.menubar.test entrycget 1 -menu]
  2459.     lappend res [.#menubar.#menubar#test entrycget 1 -menu]
  2460.     set res
  2461. } {.menubar.cascade .#menubar.#menubar#test.#menubar#cascade .menubar.cascade .#menubar.#menubar#test.#menubar#cascade}
  2463. set l [interp hidden]
  2464. deleteWindows
  2466. test menu-33.1 {menu vs command hiding} {
  2467.     catch {destroy .m}
  2468.     menu .m
  2469.     interp hide {} .m
  2470.     destroy .m
  2471.     list [winfo children .] [interp hidden]
  2472. } [list {} $l]
  2474. # menu-34 MenuInit only called at boot time
  2476. # creating menus on two different screens then deleting the
  2477. # menu from the first screen crashes Tk8.3.1
  2478. #
  2479. test menu-35.1 {menus on multiple screens - crashes tk8.3.1, Bug 5454} 
  2480. {altDisplay} {
  2481.     toplevel .one
  2482.     menu .one.m
  2483.     toplevel .two -screen $::env(TK_ALT_DISPLAY)
  2484.     menu .two.m
  2485.     destroy .one
  2486.     destroy .two
  2487. } {}
  2489. test menu-36.1 {menu -underline string overruns Bug 1599877} {} {
  2490.     # ensure that -underline does not do string overruns [Bug 1599877]
  2491.     catch {destroy .m}
  2492.     menu .m
  2493.     .m add command -label "File" -underline [expr {1<<30}]
  2494.     . configure -menu .m
  2495.     update
  2496.     tk::TraverseToMenu . "e"
  2497. } {}
  2499. # cleanup
  2500. deleteWindows
  2501. ::tcltest::cleanupTests
  2502. return