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

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

通讯编程

开发平台：

Visual C++

frame.test：源码内容
  1. # This file is a Tcl script to test out the "frame" and "toplevel"
  2. # commands of Tk.  It is organized in the standard fashion for Tcl
  3. # tests.
  4. #
  5. # Copyright (c) 1994 The Regents of the University of California.
  6. # Copyright (c) 1994-1996 Sun Microsystems, Inc.
  7. # Copyright (c) 1998-1999 by Scriptics Corporation.
  8. # All rights reserved.
  9. #
  10. # RCS: @(#) $Id: frame.test,v 1.7.2.1 2003/07/16 23:17:39 pspjuth Exp $
  12. package require tcltest 2.1
  13. namespace import -force tcltest::configure
  14. namespace import -force tcltest::testsDirectory
  15. configure -testdir [file join [pwd] [file dirname [info script]]]
  16. configure -loadfile [file join [testsDirectory] constraints.tcl]
  17. tcltest::loadTestedCommands
  19. # eatColors --
  20. # Creates a toplevel window and allocates enough colors in it to
  21. # use up all the slots in the colormap.
  22. #
  23. # Arguments:
  24. # w - Name of toplevel window to create.
  26. proc eatColors {w} {
  27.     catch {destroy $w}
  28.     toplevel $w
  29.     wm geom $w +0+0
  30.     canvas $w.c -width 400 -height 200 -bd 0
  31.     pack $w.c
  32.     for {set y 0} {$y < 8} {incr y} {
  33. for {set x 0} {$x < 40} {incr x} {
  34.     set color [format #%02x%02x%02x [expr $x*6] [expr $y*30] 0]
  35.     $w.c create rectangle [expr 10*$x] [expr 20*$y] 
  36.     [expr 10*$x + 10] [expr 20*$y + 20] -outline {} 
  37.     -fill $color
  38. }
  39.     }
  40.     update
  41. }
  43. # colorsFree --
  44. #
  45. # Returns 1 if there appear to be free colormap entries in a window,
  46. # 0 otherwise.
  47. #
  48. # Arguments:
  49. # w - Name of window in which to check.
  50. # red, green, blue - Intensities to use in a trial color allocation
  51. # to see if there are colormap entries free.
  53. proc colorsFree {w {red 31} {green 245} {blue 192}} {
  54.     set vals [winfo rgb $w [format #%02x%02x%02x $red $green $blue]]
  55.     expr ([lindex $vals 0]/256 == $red) && ([lindex $vals 1]/256 == $green) 
  56.     && ([lindex $vals 2]/256 == $blue)
  57. }
  59. test frame-1.1 {frame configuration options} {
  60.     frame .f -class NewFrame
  61.     list [.f configure -class] [catch {.f configure -class Different} msg] $msg
  62. } {{-class class Class Frame NewFrame} 1 {can't modify -class option after widget is created}}
  63. catch {destroy .f}
  64. test frame-1.2 {frame configuration options} {
  65.     frame .f -colormap new
  66.     list [.f configure -colormap] [catch {.f configure -colormap .} msg] $msg
  67. } {{-colormap colormap Colormap {} new} 1 {can't modify -colormap option after widget is created}}
  68. catch {destroy .f}
  69. test frame-1.3 {frame configuration options} {
  70.     frame .f -visual default
  71.     list [.f configure -visual] [catch {.f configure -visual best} msg] $msg
  72. } {{-visual visual Visual {} default} 1 {can't modify -visual option after widget is created}}
  73. catch {destroy .f}
  74. test frame-1.4 {frame configuration options} {
  75.     list [catch {frame .f -screen bogus} msg] $msg
  76. } {1 {unknown option "-screen"}}
  77. test frame-1.5 {frame configuration options} {
  78.     set result [list [catch {frame .f -container true} msg] $msg 
  79.     [.f configure -container]]
  80.     destroy .f
  81.     set result
  82. } {0 .f {-container container Container 0 1}}
  83. test frame-1.6 {frame configuration options} {
  84.     list [catch {frame .f -container bogus} msg] $msg
  85. } {1 {expected boolean value but got "bogus"}}
  86. test frame-1.7 {frame configuration options} {
  87.     frame .f
  88.     set result [list [catch {.f configure -container 1} msg] $msg]
  89.     destroy .f
  90.     set result
  91. } {1 {can't modify -container option after widget is created}}
  92. test frame-1.8 {frame configuration options} {
  93.     # Make sure all options can be set to the default value
  94.     frame .f
  95.     set opts {}
  96.     foreach opt [.f configure] {
  97.         if {[llength $opt] == 5} {
  98.             lappend opts [lindex $opt 0] [lindex $opt 4]
  99.         }
  100.     }
  101.     eval frame .g $opts
  102.     destroy .f .g
  103. } {}
  105. frame .f
  106. set i 9
  107. foreach test {
  108.     {-background #ff0000 #ff0000 non-existent
  109.     {unknown color name "non-existent"}}
  110.     {-bd 4 4 badValue {bad screen distance "badValue"}}
  111.     {-bg #00ff00 #00ff00 non-existent
  112.     {unknown color name "non-existent"}}
  113.     {-borderwidth 1.3 1 badValue {bad screen distance "badValue"}}
  114.     {-cursor arrow arrow badValue {bad cursor spec "badValue"}}
  115.     {-height 100 100 not_a_number {bad screen distance "not_a_number"}}
  116.     {-highlightbackground #112233 #112233 ugly {unknown color name "ugly"}}
  117.     {-highlightcolor #123456 #123456 non-existent
  118.     {unknown color name "non-existent"}}
  119.     {-highlightthickness 6 6 badValue {bad screen distance "badValue"}}
  120.     {-padx 3 3 badValue {bad screen distance "badValue"}}
  121.     {-pady 4 4 badValue {bad screen distance "badValue"}}
  122.     {-relief ridge ridge badValue {bad relief "badValue": must be flat, groove, raised, ridge, solid, or sunken}}
  123.     {-takefocus "any string" "any string" {} {}}
  124.     {-width 32 32 badValue {bad screen distance "badValue"}}
  125. } {
  126.     set name [lindex $test 0]
  127.     test frame-1.$i {frame configuration options} {
  128. .f configure $name [lindex $test 1]
  129. lindex [.f configure $name] 4
  130.     } [lindex $test 2]
  131.     incr i
  132.     if {[lindex $test 3] != ""} {
  133. test frame-1.$i {frame configuration options} {
  134.     list [catch {.f configure $name [lindex $test 3]} msg] $msg
  135. } [list 1 [lindex $test 4]]
  136.     }
  137.     .f configure $name [lindex [.f configure $name] 3]
  138.     incr i
  139. }
  140. destroy .f
  142. set i 1
  143. test frame-2.1 {toplevel configuration options} {
  144.     catch {destroy .t}
  145.     toplevel .t -width 200 -height 100 -class NewClass
  146.     wm geometry .t +0+0
  147.     list [.t configure -class] [catch {.t configure -class Another} msg] $msg
  148. } {{-class class Class Toplevel NewClass} 1 {can't modify -class option after widget is created}}
  149. test frame-2.2 {toplevel configuration options} {
  150.     catch {destroy .t}
  151.     toplevel .t -width 200 -height 100 -colormap new
  152.     wm geometry .t +0+0
  153.     list [.t configure -colormap] [catch {.t configure -colormap .} msg] $msg
  154. } {{-colormap colormap Colormap {} new} 1 {can't modify -colormap option after widget is created}}
  155. test frame-2.3 {toplevel configuration options} {
  156.     catch {destroy .t}
  157.     toplevel .t -width 200 -height 100 -colormap {} -use {}
  158.     wm geometry .t +0+0
  159.     list [catch {.t configure -container 1} msg] $msg [.t configure -container]
  160. } {1 {can't modify -container option after widget is created} {-container container Container 0 0}}
  161. test frame-2.4 {toplevel configuration options} {
  162.     catch {destroy .t}
  163.     list [catch {toplevel .t -width 200 -height 100 -colormap bogus} msg] $msg
  164. } {1 {bad window path name "bogus"}}
  165. set default "[winfo visual .] [winfo depth .]"
  166. test frame-2.5 {toplevel configuration options} {
  167.     catch {destroy .t}
  168.     toplevel .t -width 200 -height 100
  169.     wm geometry .t +0+0
  170.     list [catch {.t configure -use 0x44022} msg] $msg [.t configure -use]
  171. } {1 {can't modify -use option after widget is created} {-use use Use {} {}}}
  172. test frame-2.6 {toplevel configuration options} {
  173.     catch {destroy .t}
  174.     toplevel .t -width 200 -height 100 -visual default
  175.     wm geometry .t +0+0
  176.     list [.t configure -visual] [catch {.t configure -visual best} msg] $msg
  177. } {{-visual visual Visual {} default} 1 {can't modify -visual option after widget is created}}
  178. test frame-2.7 {toplevel configuration options} {
  179.     catch {destroy .t}
  180.     list [catch {toplevel .t -width 200 -height 100 -visual who_knows?} msg] $msg
  181. } {1 {unknown or ambiguous visual name "who_knows?": class must be best, directcolor, grayscale, greyscale, pseudocolor, staticcolor, staticgray, staticgrey, truecolor, or default}}
  182. if [info exists env(DISPLAY)] {
  183.     test frame-2.8 {toplevel configuration options} {
  184. catch {destroy .t}
  185. toplevel .t -width 200 -height 100 -screen $env(DISPLAY)
  186. wm geometry .t +0+0
  187. list [.t configure -screen] 
  188. [catch {.t configure -screen another} msg] $msg
  189.     } [list [list -screen screen Screen {} $env(DISPLAY)] 1 {can't modify -screen option after widget is created}]
  190. }
  191. test frame-2.9 {toplevel configuration options} {
  192.     catch {destroy .t}
  193.     list [catch {toplevel .t -width 200 -height 100 -screen bogus} msg] $msg
  194. } {1 {couldn't connect to display "bogus"}}
  195. test frame-2.10 {toplevel configuration options} {
  196.     catch {destroy .t}
  197.     catch {destroy .x}
  198.     toplevel .t -container 1 -width 300 -height 120
  199.     wm geometry .t +0+0
  200.     set result [list 
  201.             [catch {toplevel .x -container 1 -use [winfo id .t]} msg] $msg]
  202.     destroy .t .x
  203.     set result
  204. } {1 {A window cannot have both the -use and the -container option set.}}
  205. test frame-2.11 {toplevel configuration options} {
  206.     # Make sure all options can be set to the default value
  207.     toplevel .f
  208.     set opts {}
  209.     foreach opt [.f configure] {
  210.         if {[llength $opt] == 5} {
  211.             lappend opts [lindex $opt 0] [lindex $opt 4]
  212.         }
  213.     }
  214.     eval toplevel .g $opts
  215.     destroy .f .g
  216. } {}
  218. catch {destroy .t}
  219. toplevel .t -width 300 -height 150
  220. wm geometry .t +0+0
  221. update
  222. set i 12
  223. foreach test {
  224.     {-background #ff0000 #ff0000 non-existent
  225.     {unknown color name "non-existent"}}
  226.     {-bd 4 4 badValue {bad screen distance "badValue"}}
  227.     {-bg #00ff00 #00ff00 non-existent
  228.     {unknown color name "non-existent"}}
  229.     {-borderwidth 1.3 1 badValue {bad screen distance "badValue"}}
  230.     {-cursor arrow arrow badValue {bad cursor spec "badValue"}}
  231.     {-height 100 100 not_a_number {bad screen distance "not_a_number"}}
  232.     {-highlightcolor #123456 #123456 non-existent
  233.     {unknown color name "non-existent"}}
  234.     {-highlightthickness 3 3 badValue {bad screen distance "badValue"}}
  235.     {-padx 3 3 badValue {bad screen distance "badValue"}}
  236.     {-pady 4 4 badValue {bad screen distance "badValue"}}
  237.     {-relief ridge ridge badValue {bad relief "badValue": must be flat, groove, raised, ridge, solid, or sunken}}
  238.     {-width 32 32 badValue {bad screen distance "badValue"}}
  239. } {
  240.     set name [lindex $test 0]
  241.     test frame-2.$i {toplevel configuration options} {
  242. .t configure $name [lindex $test 1]
  243. lindex [.t configure $name] 4
  244.     } [lindex $test 2]
  245.     incr i
  246.     if {[lindex $test 3] != ""} {
  247. test frame-2.$i {toplevel configuration options} {
  248.     list [catch {.t configure $name [lindex $test 3]} msg] $msg
  249. } [list 1 [lindex $test 4]]
  250.     }
  251.     .t configure $name [lindex [.t configure $name] 3]
  252.     incr i
  253. }
  255. test frame-3.1 {TkCreateFrame procedure} {
  256.     list [catch frame msg] $msg
  257. } {1 {wrong # args: should be "frame pathName ?options?"}}
  258. test frame-3.2 {TkCreateFrame procedure} {
  259.     catch {destroy .f}
  260.     frame .f
  261.     set result [.f configure -class]
  262.     destroy .f
  263.     set result
  264. } {-class class Class Frame Frame}
  265. test frame-3.3 {TkCreateFrame procedure} {
  266.     catch {destroy .t}
  267.     toplevel .t
  268.     wm geometry .t +0+0
  269.     set result [.t configure -class]
  270.     destroy .t
  271.     set result
  272. } {-class class Class Toplevel Toplevel}
  273. test frame-3.4 {TkCreateFrame procedure} {
  274.     catch {destroy .t}
  275.     toplevel .t -width 350 -class NewClass -bg black -visual default -height 90
  276.     wm geometry .t +0+0
  277.     update
  278.     list [lindex [.t configure -width] 4] 
  279.     [lindex [.t configure -background] 4] 
  280.     [lindex [.t configure -height] 4]
  281. } {350 black 90}
  283. # Be sure that the -class, -colormap, and -visual options are processed
  284. # before configuring the widget.
  286. test frame-3.5 {TkCreateFrame procedure} {
  287.     catch {destroy .f}
  288.     option add *NewFrame.background #123456
  289.     frame .f -class NewFrame
  290.     option clear
  291.     lindex [.f configure -background] 4
  292. } {#123456}
  293. test frame-3.6 {TkCreateFrame procedure} {
  294.     catch {destroy .f}
  295.     option add *NewFrame.background #123456
  296.     frame .f -class NewFrame
  297.     option clear
  298.     lindex [.f configure -background] 4
  299. } {#123456}
  300. test frame-3.7 {TkCreateFrame procedure} {
  301.     catch {destroy .f}
  302.     option add *NewFrame.background #332211
  303.     option add *f.class NewFrame
  304.     frame .f
  305.     option clear
  306.     list [lindex [.f configure -class] 4] [lindex [.f configure -background] 4]
  307. } {NewFrame #332211}
  308. test frame-3.8 {TkCreateFrame procedure} {
  309.     catch {destroy .f}
  310.     option add *Silly.background #122334
  311.     option add *f.Class Silly
  312.     frame .f
  313.     option clear
  314.     list [lindex [.f configure -class] 4] [lindex [.f configure -background] 4]
  315. } {Silly #122334}
  316. test frame-3.9 {TkCreateFrame procedure, -use option} unixOnly {
  317.     catch {destroy .t}
  318.     catch {destroy .x}
  319.     toplevel .t -container 1 -width 300 -height 120
  320.     wm geometry .t +0+0
  321.     toplevel .x -width 140 -height 300 -use [winfo id .t] -bg green
  322.     tkwait visibility .x
  323.     set result "[expr [winfo rootx .x] - [winfo rootx .t]] [expr [winfo rooty .x] - [winfo rooty .t]] [winfo width .t] [winfo height .t]"
  324.     destroy .t
  325.     set result
  326. } {0 0 140 300}
  327. test frame-3.10 {TkCreateFrame procedure, -use option} unixOnly {
  328.     catch {destroy .t}
  329.     catch {destroy .x}
  330.     toplevel .t -container 1 -width 300 -height 120
  331.     wm geometry .t +0+0
  332.     option add *x.use [winfo id .t]
  333.     toplevel .x -width 140 -height 300 -bg green
  334.     tkwait visibility .x
  335.     set result "[expr [winfo rootx .x] - [winfo rootx .t]] [expr [winfo rooty .x] - [winfo rooty .t]] [winfo width .t] [winfo height .t]"
  336.      destroy .t
  337.     option clear
  338.     set result
  339. } {0 0 140 300}
  341. # The tests below require specific display characteristics.  Even so,
  342. # they are non-portable:  some machines don't seem to ever run out of
  343. # colors.
  345. if {([winfo visual .] == "pseudocolor") && ([winfo depth .] == 8)} {
  346.     eatColors .t1
  347.     test frame-3.11 {TkCreateFrame procedure} {nonPortable} {
  348. catch {destroy .t}
  349. toplevel .t -width 300 -height 200 -bg #475601
  350. wm geometry .t +0+0
  351. update
  352. colorsFree .t
  353.     } {0}
  354.     test frame-3.12 {TkCreateFrame procedure} {nonPortable} {
  355. catch {destroy .t}
  356. toplevel .t -width 300 -height 200 -bg #475601 -colormap new
  357. wm geometry .t +0+0
  358. update
  359. colorsFree .t
  360.     } {1}
  361.     test frame-3.13 {TkCreateFrame procedure} {nonPortable} {
  362. catch {destroy .t}
  363. option add *t.class Toplevel2
  364. option add *Toplevel2.colormap new
  365. toplevel .t -width 300 -height 200 -bg #475601
  366. wm geometry .t +0+0
  367. update
  368. option clear
  369. colorsFree .t
  370.     } {1}
  371.     test frame-3.14 {TkCreateFrame procedure} {nonPortable} {
  372. catch {destroy .t}
  373. option add *t.class Toplevel3
  374. option add *Toplevel3.Colormap new
  375. toplevel .t -width 300 -height 200 -bg #475601 -colormap new
  376. wm geometry .t +0+0
  377. update
  378. option clear
  379. colorsFree .t
  380.     } {1}
  381.     test frame-3.15 {TkCreateFrame procedure, -use and -colormap} {unixOnly nonPortable} {
  382. catch {destroy .t}
  383. catch {destroy .x}
  384. toplevel .t -container 1 -width 300 -height 120
  385. wm geometry .t +0+0
  386. toplevel .x -width 140 -height 300 -use [winfo id .t] -bg green -colormap new
  387. tkwait visibility .x
  388. set result "[colorsFree .t] [colorsFree .x]"
  389. destroy .t
  390. set result
  391.     } {0 1}
  392.     test frame-3.16 {TkCreateFrame procedure} {nonPortable} {
  393. catch {destroy .t}
  394. toplevel .t -width 300 -height 200 -bg #475601 -visual default
  395. wm geometry .t +0+0
  396. update
  397. colorsFree .t
  398.     } {0}
  399.     test frame-3.17 {TkCreateFrame procedure} {nonPortable} {
  400. catch {destroy .t}
  401. toplevel .t -width 300 -height 200 -bg #475601 -visual default 
  402. -colormap new
  403. wm geometry .t +0+0
  404. update
  405. colorsFree .t
  406.     } {1}
  407.     if {[lsearch -exact [winfo visualsavailable .] {grayscale 8}] >= 0} {
  408.         test frame-3.18 {TkCreateFrame procedure} {nonPortable} {
  409.     catch {destroy .t}
  410.     toplevel .t -visual {grayscale 8} -width 300 -height 200 
  411.     -bg #434343 
  412.     wm geometry .t +0+0
  413.     update
  414.     colorsFree .t 131 131 131
  415. } {1}
  416.         test frame-3.19 {TkCreateFrame procedure} {nonPortable} {
  417.     catch {destroy .t}
  418.     option add *t.class T4
  419.     option add *T4.visual {grayscale 8}
  420.     toplevel .t -width 300 -height 200 -bg #434343
  421.     wm geometry .t +0+0
  422.     update
  423.     option clear
  424.     list [colorsFree .t 131 131 131] [lindex [.t configure -visual] 4]
  425. } {1 {grayscale 8}}
  426.         test frame-3.20 {TkCreateFrame procedure} {nonPortable} {
  427.     catch {destroy .t}
  428.     set x ok
  429.     option add *t.class T5
  430.     option add *T5.Visual {grayscale 8}
  431.     toplevel .t -width 300 -height 200 -bg #434343
  432.     wm geometry .t +0+0
  433.     update
  434.     option clear
  435.     list [colorsFree .t 131 131 131] [lindex [.t configure -visual] 4]
  436. } {1 {grayscale 8}}
  437.         test frame-3.21 {TkCreateFrame procedure} {nonPortable} {
  438.     catch {destroy .t}
  439.     set x ok
  440.     toplevel .t -visual {grayscale 8} -width 300 -height 200 
  441.     -bg #434343 
  442.     wm geometry .t +0+0
  443.     update
  444.     colorsFree .t 131 131 131
  445. } {1}
  446.     }
  447.     destroy .t1
  448. }
  449. test frame-3.22 {TkCreateFrame procedure, default dimensions} {
  450.     catch {destroy .t}
  451.     toplevel .t
  452.     wm geometry .t +0+0
  453.     update
  454.     set result "[winfo reqwidth .t] [winfo reqheight .t]"
  455.     frame .t.f -bg red
  456.     pack .t.f
  457.     update
  458.     lappend result [winfo reqwidth .t.f] [winfo reqheight .t.f]
  459.     destroy .t
  460.     set result
  461. } {200 200 1 1}
  462. test frame-3.23 {TkCreateFrame procedure} {
  463.     catch {destroy .f}
  464.     list [catch {frame .f -gorp glob} msg] $msg
  465. } {1 {unknown option "-gorp"}}
  466. test frame-3.24 {TkCreateFrame procedure} {
  467.     catch {destroy .t}
  468.     list [catch {
  469. toplevel .t -width 300 -height 200 -colormap new -bogus option
  470. wm geometry .t +0+0
  471.     } msg] $msg
  472. } {1 {unknown option "-bogus"}}
  474. test frame-4.1 {TkCreateFrame procedure} {
  475.     catch {destroy .f}
  476.     catch {frame .f -gorp glob}
  477.     winfo exists .f
  478. } 0
  479. test frame-4.2 {TkCreateFrame procedure} {
  480.     catch {destroy .f}
  481.     list [frame .f -width 200 -height 100] [winfo exists .f]
  482. } {.f 1}
  484. catch {destroy .f}
  485. frame .f -highlightcolor black
  486. test frame-5.1 {FrameWidgetCommand procedure} {
  487.     list [catch .f msg] $msg
  488. } {1 {wrong # args: should be ".f option ?arg arg ...?"}}
  489. test frame-5.2 {FrameWidgetCommand procedure, cget option} {
  490.     list [catch {.f cget} msg] $msg
  491. } {1 {wrong # args: should be ".f cget option"}}
  492. test frame-5.3 {FrameWidgetCommand procedure, cget option} {
  493.     list [catch {.f cget a b} msg] $msg
  494. } {1 {wrong # args: should be ".f cget option"}}
  495. test frame-5.4 {FrameWidgetCommand procedure, cget option} {
  496.     list [catch {.f cget -gorp} msg] $msg
  497. } {1 {unknown option "-gorp"}}
  498. test frame-5.5 {FrameWidgetCommand procedure, cget option} {
  499.     .f cget -highlightcolor
  500. } {black}
  501. test frame-5.6 {FrameWidgetCommand procedure, cget option} {
  502.     list [catch {.f cget -screen} msg] $msg
  503. } {1 {unknown option "-screen"}}
  504. test frame-5.7 {FrameWidgetCommand procedure, cget option} {
  505.     catch {destroy .t}
  506.     toplevel .t
  507.     catch {.t cget -screen}
  508. } {0}
  509. catch {destroy .t}
  510. test frame-5.8 {FrameWidgetCommand procedure, configure option} {
  511.     llength [.f configure]
  512. } {18}
  513. test frame-5.9 {FrameWidgetCommand procedure, configure option} {
  514.     list [catch {.f configure -gorp} msg] $msg
  515. } {1 {unknown option "-gorp"}}
  516. test frame-5.10 {FrameWidgetCommand procedure, configure option} {
  517.     list [catch {.f configure -gorp bogus} msg] $msg
  518. } {1 {unknown option "-gorp"}}
  519. test frame-5.11 {FrameWidgetCommand procedure, configure option} {
  520.     list [catch {.f configure -width 200 -height} msg] $msg
  521. } {1 {value for "-height" missing}}
  522. test frame-5.12 {FrameWidgetCommand procedure} {
  523.     list [catch {.f swizzle} msg] $msg
  524. } {1 {bad option "swizzle": must be cget or configure}}
  525. test frame-5.13 {FrameWidgetCommand procedure, configure option} {
  526.     llength [. configure]
  527. } {21}
  529. test frame-6.1 {ConfigureFrame procedure} {
  530.     catch {destroy .f}
  531.     frame .f -width 150
  532.     list [winfo reqwidth .f] [winfo reqheight .f]
  533. } {150 1}
  534. test frame-6.2 {ConfigureFrame procedure} {
  535.     catch {destroy .f}
  536.     frame .f -height 97
  537.     list [winfo reqwidth .f] [winfo reqheight .f]
  538. } {1 97}
  539. test frame-6.3 {ConfigureFrame procedure} {
  540.     catch {destroy .f}
  541.     frame .f
  542.     set result {}
  543.     lappend result [winfo reqwidth .f] [winfo reqheight .f]
  544.     .f configure -width 100 -height 180
  545.     lappend result [winfo reqwidth .f] [winfo reqheight .f]
  546.     .f configure -width 0 -height 0
  547.     lappend result [winfo reqwidth .f] [winfo reqheight .f]
  548. } {1 1 100 180 100 180}
  550. test frame-7.1 {FrameEventProc procedure} {
  551.     frame .frame2
  552.     set result [info commands .frame2]
  553.     destroy .frame2
  554.     lappend result [info commands .frame2]
  555. } {.frame2 {}}
  556. test frame-7.2 {FrameEventProc procedure} {
  557.     deleteWindows
  558.     frame .f1 -bg #543210
  559.     rename .f1 .f2
  560.     set x {}
  561.     lappend x [winfo children .]
  562.     lappend x [.f2 cget -bg]
  563.     destroy .f1
  564.     lappend x [info command .f*] [winfo children .]
  565. } {.f1 #543210 {} {}}
  567. test frame-8.1 {FrameCmdDeletedProc procedure} {
  568.     deleteWindows
  569.     frame .f1
  570.     rename .f1 {}
  571.     list [info command .f*] [winfo children .]
  572. } {{} {}}
  573. test frame-8.2 {FrameCmdDeletedProc procedure} {
  574.     deleteWindows
  575.     toplevel .f1 -menu .m
  576.     wm geometry .f1 +0+0
  577.     update
  578.     rename .f1 {}
  579.     update
  580.     list [info command .f*] [winfo children .]
  581. } {{} {}}
  582. #
  583. # This one fails with the dash-patch!!!! Still don't know why  :-(
  584. #
  585. #test frame-8.3 {FrameCmdDeletedProc procedure} {
  586. #    eval destroy [winfo children .]
  587. #    toplevel .f1 -menu .m
  588. #    wm geometry .f1 +0+0
  589. #    menu .m
  590. #    update
  591. #    rename .f1 {}
  592. #    update
  593. #    set result [list [info command .f*] [winfo children .]]
  594. #    eval destroy [winfo children .]
  595. #    set result
  596. #} {{} .m}
  598. test frame-9.1 {MapFrame procedure} {
  599.     catch {destroy .t}
  600.     toplevel .t -width 100 -height 400
  601.     wm geometry .t +0+0
  602.     set result [winfo ismapped .t]
  603.     update idletasks
  604.     lappend result [winfo ismapped .t]
  605. } {0 1}
  606. test frame-9.2 {MapFrame procedure} {
  607.     catch {destroy .t}
  608.     toplevel .t -width 100 -height 400
  609.     wm geometry .t +0+0
  610.     destroy .t
  611.     update
  612.     winfo exists .t
  613. } {0}
  614. test frame-9.3 {MapFrame procedure, window deleted while mapping} {
  615.     toplevel .t2 -width 200 -height 200
  616.     wm geometry .t2 +0+0
  617.     tkwait visibility .t2
  618.     catch {destroy .t}
  619.     toplevel .t -width 100 -height 400
  620.     wm geometry .t +0+0
  621.     frame .t2.f -width 50 -height 50
  622.     bind .t2.f <Configure> {destroy .t}
  623.     pack .t2.f -side top
  624.     update idletasks
  625.     winfo exists .t
  626. } {0}
  628. set l [interp hidden]
  629. deleteWindows
  631. test frame-10.1 {frame widget vs hidden commands} {
  632.     catch {destroy .t}
  633.     frame .t
  634.     interp hide {} .t
  635.     destroy .t
  636.     list [winfo children .] [interp hidden]
  637. } [list {} $l]
  639. test frame-11.1 {TkInstallFrameMenu} {
  640.     catch {destroy .t}
  641.     menu .m1
  642.     .m1 add cascade -menu .m1.system
  643.     menu .m1.system -tearoff 0
  644.     .m1.system add command -label foo
  645.     list [toplevel .t -menu .m1] [destroy .m1] [destroy .t]
  646. } {.t {} {}}
  647. test frame-11.2 {TkInstallFrameMenu - frame renamed} {
  648.     catch {destroy .t}
  649.     catch {rename foo {}}
  650.     menu .m1
  651.     .m1 add cascade -menu .m1.system
  652.     menu .m1.system -tearoff 0
  653.     .m1.system add command -label foo
  654.     toplevel .t
  655.     list [rename .t foo] [destroy .t] [destroy foo] [destroy .m1]
  656. } {{} {} {} {}}
  658. test frame-12.1 {FrameWorldChanged procedure} {
  659.     # Test -bd -padx and -pady
  660.     destroy .f
  661.     frame .f -borderwidth 2 -padx 3 -pady 4
  662.     place .f -x 0 -y 0 -width 40 -height 40
  663.     pack [frame .f.f] -fill both -expand 1
  664.     update
  665.     set result [list [winfo x .f.f] [winfo y .f.f] 
  666.             [winfo width .f.f] [winfo height .f.f]]
  667.     destroy .f
  668.     set result
  669. } {5 6 30 28}
  670. test frame-12.2 {FrameWorldChanged procedure} {
  671.     # Test all -labelanchor positions
  672.     destroy .f
  673.     set font {helvetica 12}
  674.     labelframe .f -highlightthickness 1 -bd 3 -padx 1 -pady 2 -font $font 
  675.             -text "Mupp"
  676.     set fh [expr {[font metrics $font -linespace] + 2 - 3}]
  677.     set fw [expr {[font measure $font "Mupp"] + 2 - 3}]
  678.     if {$fw < 0} {set fw 0}
  679.     if {$fh < 0} {set fh 0}
  680.     place .f -x 0 -y 0 -width 100 -height 100
  681.     pack [frame .f.f] -fill both -expand 1
  683.     set result {} 
  684.     foreach lp {nw n ne en e es se s sw ws w wn} {
  685.         .f configure -labelanchor $lp
  686.         update
  687.         set expx 5
  688.         set expy 6
  689.         set expw 90
  690.         set exph 88
  691.         switch -glob $lp {
  692.             n* {incr expy $fh ; incr exph -$fh}
  693.             s* {incr exph -$fh}
  694.             w* {incr expx $fw ; incr expw -$fw}
  695.             e* {incr expw -$fw}
  696.         }
  697.         lappend result [expr {
  698.                 [winfo x .f.f] == $expx && [winfo y .f.f] == $expy &&
  699.                 [winfo width .f.f] == $expw && [winfo height .f.f] == $exph}]
  700.     }
  701.     destroy .f
  702.     set result
  703. } {1 1 1 1 1 1 1 1 1 1 1 1}
  704. test frame-12.3 {FrameWorldChanged procedure} {
  705.     # Check reaction on font change
  706.     destroy .f
  707.     font create myfont -family courier -size 10
  708.     labelframe .f -font myfont -text Mupp
  709.     place .f -x 0 -y 0 -width 40 -height 40
  710.     pack [frame .f.f] -fill both -expand 1
  711.     update
  712.     set h1 [font metrics myfont -linespace]
  713.     set y1 [winfo y .f.f]
  714.     font configure myfont -size 20
  715.     update
  716.     set h2 [font metrics myfont -linespace]
  717.     set y2 [winfo y .f.f]
  718.     destroy .f
  719.     font delete myfont
  720.     expr {($h2 - $h1) - ($y2 - $y1)}
  721. } {0}
  723. test frame-13.1 {labelframe configuration options} {
  724.     labelframe .f -class NewFrame
  725.     list [.f configure -class] [catch {.f configure -class Different} msg] $msg
  726. } {{-class class Class Labelframe NewFrame} 1 {can't modify -class option after widget is created}}
  727. catch {destroy .f}
  728. test frame-13.2 {labelframe configuration options} {
  729.     list [catch {labelframe .f -colormap new} msg] $msg
  730. } {0 .f}
  731. catch {destroy .f}
  732. test frame-13.3 {labelframe configuration options} {
  733.     list [catch {labelframe .f -visual default} msg] $msg
  734. } {0 .f}
  735. catch {destroy .f}
  736. test frame-13.4 {labelframe configuration options} {
  737.     list [catch {labelframe .f -screen bogus} msg] $msg
  738. } {1 {unknown option "-screen"}}
  739. test frame-13.5 {labelframe configuration options} {
  740.     set result [list [catch {labelframe .f -container true} msg] $msg 
  741.     [.f configure -container]]
  742.     destroy .f
  743.     set result
  744. } {0 .f {-container container Container 0 1}}
  745. test frame-13.6 {labelframe configuration options} {
  746.     list [catch {labelframe .f -container bogus} msg] $msg
  747. } {1 {expected boolean value but got "bogus"}}
  748. test frame-13.7 {labelframe configuration options} {
  749.     labelframe .f
  750.     set result [list [catch {.f configure -container 1} msg] $msg]
  751.     destroy .f
  752.     set result
  753. } {1 {can't modify -container option after widget is created}}
  754. labelframe .f
  755. set i 8
  756. foreach test {
  757.     {-background #ff0000 #ff0000 non-existent
  758.     {unknown color name "non-existent"}}
  759.     {-bd 4 4 badValue {bad screen distance "badValue"}}
  760.     {-bg #00ff00 #00ff00 non-existent
  761.     {unknown color name "non-existent"}}
  762.     {-borderwidth 1.3 1 badValue {bad screen distance "badValue"}}
  763.     {-cursor arrow arrow badValue {bad cursor spec "badValue"}}
  764.     {-fg #0000ff #0000ff non-existent
  765.     {unknown color name "non-existent"}}
  766.     {-font {courier 8} {courier 8} {} {}}
  767.     {-foreground #ff0000 #ff0000 non-existent
  768.     {unknown color name "non-existent"}}
  769.     {-height 100 100 not_a_number {bad screen distance "not_a_number"}}
  770.     {-highlightbackground #112233 #112233 ugly {unknown color name "ugly"}}
  771.     {-highlightcolor #123456 #123456 non-existent
  772.     {unknown color name "non-existent"}}
  773.     {-highlightthickness 6 6 badValue {bad screen distance "badValue"}}
  774.     {-labelanchor se se badValue {bad labelanchor "badValue": must be e, en, es, n, ne, nw, s, se, sw, w, wn, or ws}}
  775.     {-padx 3 3 badValue {bad screen distance "badValue"}}
  776.     {-pady 4 4 badValue {bad screen distance "badValue"}}
  777.     {-relief ridge ridge badValue {bad relief "badValue": must be flat, groove, raised, ridge, solid, or sunken}}
  778.     {-takefocus "any string" "any string" {} {}}
  779.     {-text "any string" "any string" {} {}}
  780.     {-width 32 32 badValue {bad screen distance "badValue"}}
  781. } {
  782.     set name [lindex $test 0]
  783.     test frame-13.$i {labelframe configuration options} {
  784. .f configure $name [lindex $test 1]
  785. lindex [.f configure $name] 4
  786.     } [lindex $test 2]
  787.     incr i
  788.     if {[lindex $test 3] != ""} {
  789. test frame-13.$i {labelframe configuration options} {
  790.     list [catch {.f configure $name [lindex $test 3]} msg] $msg
  791. } [list 1 [lindex $test 4]]
  792.     }
  793.     .f configure $name [lindex [.f configure $name] 3]
  794.     incr i
  795. }
  796. destroy .f
  798. test frame-14.1 {labelframe labelwidget option} {
  799.     # Test that label is moved in stacking order
  800.     destroy .f .l
  801.     label .l -text Mupp
  802.     labelframe .f -labelwidget .l
  803.     pack .f
  804.     frame .f.f -width 50 -height 50
  805.     pack .f.f
  806.     update
  807.     set res [list [winfo children .] [winfo width .f] 
  808.             [expr {[winfo height .f] - [winfo height .l]}]]
  809.     destroy .f .l
  810.     set res
  811. } {{.f .l} 54 52}
  812. test frame-14.2 {labelframe labelwidget option} {
  813.     # Test the labelframe's reaction if the label is destroyed
  814.     destroy .f .l
  815.     label .l -text Aratherlonglabel
  816.     labelframe .f -labelwidget .l
  817.     pack .f
  818.     label .f.l -text Mupp
  819.     pack .f.l
  820.     update
  821.     set res [list [.f cget -labelwidget]]
  822.     lappend res [expr {[winfo width .f] - [winfo width .l]}]
  823.     destroy .l
  824.     lappend res [.f cget -labelwidget]
  825.     update
  826.     lappend res [expr {[winfo width .f] - [winfo width .f.l]}]
  827.     destroy .f
  828.     set res
  829. } {.l 12 {} 4}
  830. test frame-14.3 {labelframe labelwidget option} {
  831.     # Test the labelframe's reaction if the label is stolen
  832.     destroy .f .l
  833.     label .l -text Aratherlonglabel
  834.     labelframe .f -labelwidget .l
  835.     pack .f
  836.     label .f.l -text Mupp
  837.     pack .f.l
  838.     update
  839.     set res [list [.f cget -labelwidget]]
  840.     lappend res [expr {[winfo width .f] - [winfo width .l]}]
  841.     pack .l
  842.     lappend res [.f cget -labelwidget]
  843.     update
  844.     lappend res [expr {[winfo width .f] - [winfo width .f.l]}]
  845.     destroy .f .l
  846.     set res
  847. } {.l 12 {} 4}
  848. test frame-14.4 {labelframe labelwidget option} {
  849.     # Test the label's reaction if the labelframe is destroyed
  850.     destroy .f .l
  851.     label .l -text Mupp
  852.     labelframe .f -labelwidget .l
  853.     pack .f
  854.     update
  855.     set res [list [winfo manager .l]]
  856.     destroy .f
  857.     lappend res [winfo manager .l]
  858.     destroy .l
  859.     set res
  860. } {labelframe {}}
  861. test frame-14.5 {labelframe labelwidget option} {
  862.     # Test that the labelframe reacts on changes in label
  863.     destroy .f .l
  864.     label .l -text Aratherlonglabel
  865.     labelframe .f -labelwidget .l
  866.     pack .f
  867.     label .f.l -text Mupp
  868.     pack .f.l
  869.     update
  870.     set first [winfo width .f]
  871.     set res [expr {[winfo width .f] - [winfo width .l]}]
  872.     .l configure -text Shorter
  873.     update
  874.     lappend res [expr {[winfo width .f] - [winfo width .l]}]
  875.     lappend res [expr {[winfo width .f] < $first}]
  876.     .l configure -text Alotlongerthananytimebefore
  877.     update
  878.     lappend res [expr {[winfo width .f] - [winfo width .l]}]
  879.     lappend res [expr {[winfo width .f] > $first}]
  880.     destroy .f .l
  881.     set res
  882. } {12 12 1 12 1}
  883. test frame-14.6 {labelframe labelwidget option} {
  884.     # Destroying a labelframe with a child label caused a crash
  885.     # when not handling mapping of the label correctly.
  886.     # This test does not test anything directly, it's just ment
  887.     # to catch if the same mistake is made again.
  888.     destroy .f
  889.     labelframe .f
  890.     pack .f
  891.     label .f.l -text Mupp
  892.     .f configure -labelwidget .f.l
  893.     update
  894.     destroy .f
  895. } {}
  897. catch {destroy .f}
  898. rename eatColors {}
  899. rename colorsFree {}
  901. # cleanup
  902. ::tcltest::cleanupTests
  903. return