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

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

通讯编程

开发平台：

Visual C++

winfo.test：源码内容
  1. # This file is a Tcl script to test out the "winfo" command.  It is
  2. # organized in the standard fashion for Tcl tests.
  3. #
  4. # Copyright (c) 1994 The Regents of the University of California.
  5. # Copyright (c) 1994-1997 Sun Microsystems, Inc.
  6. # Copyright (c) 1998-1999 by Scriptics Corporation.
  7. # All rights reserved.
  8. #
  9. # RCS: @(#) $Id: winfo.test,v 1.9.2.1 2005/10/10 15:19:41 patthoyts Exp $
  11. package require tcltest 2.1
  12. namespace import -force tcltest::configure
  13. namespace import -force tcltest::testsDirectory
  14. configure -testdir [file join [pwd] [file dirname [info script]]]
  15. configure -loadfile [file join [testsDirectory] constraints.tcl]
  16. tcltest::loadTestedCommands
  18. # eatColors --
  19. # Creates a toplevel window and allocates enough colors in it to
  20. # use up all the slots in the colormap.
  21. #
  22. # Arguments:
  23. # w - Name of toplevel window to create.
  24. # options - Options for w, such as "-colormap new".
  26. proc eatColors {w {options ""}} {
  27.     catch {destroy $w}
  28.     eval toplevel $w $options
  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. # XXX - This test file is woefully incomplete.  At present, only a
  44. # few of the winfo options are tested.
  46. test winfo-1.1 {"winfo atom" command} {
  47.     list [catch {winfo atom} msg] $msg
  48. } {1 {wrong # args: should be "winfo atom ?-displayof window? name"}}
  49. test winfo-1.2 {"winfo atom" command} {
  50.     list [catch {winfo atom a b} msg] $msg
  51. } {1 {wrong # args: should be "winfo atom ?-displayof window? name"}}
  52. test winfo-1.3 {"winfo atom" command} {
  53.     list [catch {winfo atom a b c d} msg] $msg
  54. } {1 {wrong # args: should be "winfo atom ?-displayof window? name"}}
  55. test winfo-1.4 {"winfo atom" command} {
  56.     list [catch {winfo atom -displayof geek foo} msg] $msg
  57. } {1 {bad window path name "geek"}}
  58. test winfo-1.5 {"winfo atom" command} {
  59.     winfo atom PRIMARY
  60. } 1
  61. test winfo-1.6 {"winfo atom" command} {
  62.     winfo atom -displayof . PRIMARY
  63. } 1
  65. test winfo-2.1 {"winfo atomname" command} {
  66.     list [catch {winfo atomname} msg] $msg
  67. } {1 {wrong # args: should be "winfo atomname ?-displayof window? id"}}
  68. test winfo-2.2 {"winfo atomname" command} {
  69.     list [catch {winfo atomname a b} msg] $msg
  70. } {1 {wrong # args: should be "winfo atomname ?-displayof window? id"}}
  71. test winfo-2.3 {"winfo atomname" command} {
  72.     list [catch {winfo atomname a b c d} msg] $msg
  73. } {1 {wrong # args: should be "winfo atomname ?-displayof window? id"}}
  74. test winfo-2.4 {"winfo atomname" command} {
  75.     list [catch {winfo atomname -displayof geek foo} msg] $msg
  76. } {1 {bad window path name "geek"}}
  77. test winfo-2.5 {"winfo atomname" command} {
  78.     list [catch {winfo atomname 44215} msg] $msg
  79. } {1 {no atom exists with id "44215"}}
  80. test winfo-2.6 {"winfo atomname" command} {
  81.     winfo atomname 2
  82. } SECONDARY
  83. test winfo-2.7 {"winfo atom" command} {
  84.     winfo atomname -displayof . 2
  85. } SECONDARY
  87. # Some tests require the "pseudocolor" visual class.
  88. testConstraint pseudocolor [expr { ([winfo depth .] == 8) 
  89. && ([winfo visual .] == "pseudocolor")}]
  91. test winfo-3.1 {"winfo colormapfull" command} {pseudocolor} {
  92.     list [catch {winfo colormapfull} msg] $msg
  93. } {1 {wrong # args: should be "winfo colormapfull window"}}
  94. test winfo-3.2 {"winfo colormapfull" command} {pseudocolor} {
  95.     list [catch {winfo colormapfull a b} msg] $msg
  96. } {1 {wrong # args: should be "winfo colormapfull window"}}
  97. test winfo-3.3 {"winfo colormapfull" command} {pseudocolor} {
  98.     list [catch {winfo colormapfull foo} msg] $msg
  99. } {1 {bad window path name "foo"}}
  100. test winfo-3.4 {"winfo colormapfull" command} {macOrUnix pseudocolor} {
  101.     eatColors .t {-colormap new}
  102.     set result [list [winfo colormapfull .] [winfo colormapfull .t]]
  103.     .t.c delete 34
  104.     lappend result [winfo colormapfull .t]
  105.     .t.c create rectangle 30 30 80 80 -fill #441739
  106.     lappend result [winfo colormapfull .t]
  107.     .t.c create rectangle 40 40 90 90 -fill #ffeedd
  108.     lappend result [winfo colormapfull .t]
  109.     destroy .t.c
  110.     lappend result [winfo colormapfull .t]
  111. } {0 1 0 0 1 0}
  112. catch {destroy .t}
  114. toplevel .t -width 550 -height 400
  115. frame .t.f -width 80 -height 60 -bd 2 -relief raised
  116. place .t.f -x 50 -y 50
  117. wm geom .t +0+0
  118. tkwait visibility .t.f
  120. test winfo-4.1 {"winfo containing" command} {
  121.     list [catch {winfo containing 22} msg] $msg
  122. } {1 {wrong # args: should be "winfo containing ?-displayof window? rootX rootY"}}
  123. test winfo-4.2 {"winfo containing" command} {
  124.     list [catch {winfo containing a b c} msg] $msg
  125. } {1 {wrong # args: should be "winfo containing ?-displayof window? rootX rootY"}}
  126. test winfo-4.3 {"winfo containing" command} {
  127.     list [catch {winfo containing a b c d e} msg] $msg
  128. } {1 {wrong # args: should be "winfo containing ?-displayof window? rootX rootY"}}
  129. test winfo-4.4 {"winfo containing" command} {
  130.     list [catch {winfo containing -displayof geek 25 30} msg] $msg
  131. } {1 {bad window path name "geek"}}
  132. test winfo-4.5 {"winfo containing" command} {
  133.     winfo containing [winfo rootx .t.f] [winfo rooty .t.f]
  134. } .t.f
  135. test winfo-4.6 {"winfo containing" command} {nonPortable} {
  136.     winfo containing [expr [winfo rootx .t.f]-1] [expr [winfo rooty .t.f]-1]
  137. } .t
  138. test winfo-4.7 {"winfo containing" command} {
  139.     set x [winfo containing -display .t.f [expr [winfo rootx .t]+600] 
  140.     [expr [winfo rooty .t.f]+450]]
  141.     expr {($x == ".") || ($x == "")}
  142. } {1}
  143. destroy .t
  145. test winfo-5.1 {"winfo interps" command} {
  146.     list [catch {winfo interps a} msg] $msg
  147. } {1 {wrong # args: should be "winfo interps ?-displayof window?"}}
  148. test winfo-5.2 {"winfo interps" command} {
  149.     list [catch {winfo interps a b c} msg] $msg
  150. } {1 {wrong # args: should be "winfo interps ?-displayof window?"}}
  151. test winfo-5.3 {"winfo interps" command} {
  152.     list [catch {winfo interps -displayof geek} msg] $msg
  153. } {1 {bad window path name "geek"}}
  154. test winfo-5.4 {"winfo interps" command} {unixOnly} {
  155.     expr [lsearch -exact [winfo interps] [tk appname]] >= 0
  156. } {1}
  157. test winfo-5.5 {"winfo interps" command} {unixOnly} {
  158.     expr [lsearch -exact [winfo interps -displayof .] [tk appname]] >= 0
  159. } {1}
  161. test winfo-6.1 {"winfo exists" command} {
  162.     list [catch {winfo exists} msg] $msg
  163. } {1 {wrong # args: should be "winfo exists window"}}
  164. test winfo-6.2 {"winfo exists" command} {
  165.     list [catch {winfo exists a b} msg] $msg
  166. } {1 {wrong # args: should be "winfo exists window"}}
  167. test winfo-6.3 {"winfo exists" command} {
  168.     winfo exists gorp
  169. } {0}
  170. test winfo-6.4 {"winfo exists" command} {
  171.     winfo exists .
  172. } {1}
  173. test winfo-6.5 {"winfo exists" command} {
  174.     button .b -text "Test button"
  175.     set x [winfo exists .b]
  176.     pack .b
  177.     update
  178.     bind .b <Destroy> {lappend x [winfo exists .x]}
  179.     destroy .b
  180.     lappend x [winfo exists .x]
  181. } {1 0 0}
  183. catch {destroy .b}
  184. button .b -text "Help"
  185. update
  186. test winfo-7.1 {"winfo pathname" command} {
  187.     list [catch {winfo pathname} msg] $msg
  188. } {1 {wrong # args: should be "winfo pathname ?-displayof window? id"}}
  189. test winfo-7.2 {"winfo pathname" command} {
  190.     list [catch {winfo pathname a b} msg] $msg
  191. } {1 {wrong # args: should be "winfo pathname ?-displayof window? id"}}
  192. test winfo-7.3 {"winfo pathname" command} {
  193.     list [catch {winfo pathname a b c d} msg] $msg
  194. } {1 {wrong # args: should be "winfo pathname ?-displayof window? id"}}
  195. test winfo-7.4 {"winfo pathname" command} {
  196.     list [catch {winfo pathname -displayof geek 25} msg] $msg
  197. } {1 {bad window path name "geek"}}
  198. test winfo-7.5 {"winfo pathname" command} {
  199.     list [catch {winfo pathname xyz} msg] $msg
  200. } {1 {expected integer but got "xyz"}}
  201. test winfo-7.6 {"winfo pathname" command} {
  202.     list [catch {winfo pathname 224} msg] $msg
  203. } {1 {window id "224" doesn't exist in this application}}
  204. test winfo-7.7 {"winfo pathname" command} {
  205.     winfo pathname -displayof .b [winfo id .]
  206. } {.}
  207. test winfo-7.8 {"winfo pathname" command} {unixOnly testwrapper} {
  208.     winfo pathname [testwrapper .]
  209. } {}
  211. test winfo-8.1 {"winfo pointerx" command} {
  212.     catch [winfo pointerx .b]
  213. } 1
  214. test winfo-8.2 {"winfo pointery" command} {
  215.     catch [winfo pointery .b]
  216. } 1
  217. test winfo-8.3 {"winfo pointerxy" command} {
  218.     catch [winfo pointerxy .b]
  219. } 1
  221. test winfo-9.1 {"winfo viewable" command} {
  222.     list [catch {winfo viewable} msg] $msg
  223. } {1 {wrong # args: should be "winfo viewable window"}}
  224. test winfo-9.2 {"winfo viewable" command} {
  225.     list [catch {winfo viewable foo} msg] $msg
  226. } {1 {bad window path name "foo"}}
  227. test winfo-9.3 {"winfo viewable" command} {
  228.     winfo viewable .
  229. } {1}
  230. test winfo-9.4 {"winfo viewable" command} {
  231.     wm iconify .
  232.     winfo viewable .
  233. } {0}
  234. wm deiconify .
  235. test winfo-9.5 {"winfo viewable" command} {
  236.     frame .f1 -width 100 -height 100 -relief raised -bd 2
  237.     place .f1 -x 0 -y 0
  238.     frame .f1.f2 -width 50 -height 50 -relief raised -bd 2
  239.     place .f1.f2 -x 0 -y 0
  240.     update
  241.     list [winfo viewable .f1] [winfo viewable .f1.f2]
  242. } {1 1}
  243. test winfo-9.6 {"winfo viewable" command} {
  244.     deleteWindows
  245.     frame .f1 -width 100 -height 100 -relief raised -bd 2
  246.     frame .f1.f2 -width 50 -height 50 -relief raised -bd 2
  247.     place .f1.f2 -x 0 -y 0
  248.     update
  249.     list [winfo viewable .f1] [winfo viewable .f1.f2]
  250. } {0 0}
  251. test winfo-9.7 {"winfo viewable" command} {
  252.     deleteWindows
  253.     frame .f1 -width 100 -height 100 -relief raised -bd 2
  254.     place .f1 -x 0 -y 0
  255.     frame .f1.f2 -width 50 -height 50 -relief raised -bd 2
  256.     place .f1.f2 -x 0 -y 0
  257.     update
  258.     wm iconify .
  259.     list [winfo viewable .f1] [winfo viewable .f1.f2]
  260. } {0 0}
  261. wm deiconify .
  262. deleteWindows
  264. test winfo-10.1 {"winfo visualid" command} {
  265.     list [catch {winfo visualid} msg] $msg
  266. } {1 {wrong # args: should be "winfo visualid window"}}
  267. test winfo-10.2 {"winfo visualid" command} {
  268.     list [catch {winfo visualid gorp} msg] $msg
  269. } {1 {bad window path name "gorp"}}
  270. test winfo-10.3 {"winfo visualid" command} {
  271.     expr 2+[winfo visualid .]-[winfo visualid .]
  272. } {2}
  274. test winfo-11.1 {"winfo visualid" command} {
  275.     list [catch {winfo visualsavailable} msg] $msg
  276. } {1 {wrong # args: should be "winfo visualsavailable window ?includeids?"}}
  277. test winfo-11.2 {"winfo visualid" command} {
  278.     list [catch {winfo visualsavailable gorp} msg] $msg
  279. } {1 {bad window path name "gorp"}}
  280. test winfo-11.3 {"winfo visualid" command} {
  281.     list [catch {winfo visualsavailable . includeids foo} msg] $msg
  282. } {1 {wrong # args: should be "winfo visualsavailable window ?includeids?"}}
  283. test winfo-11.4 {"winfo visualid" command} {
  284.     llength [lindex [winfo visualsa .] 0]
  285. } {2}
  286. test winfo-11.5 {"winfo visualid" command} {
  287.     llength [lindex [winfo visualsa . includeids] 0]
  288. } {3}
  289. test winfo-11.6 {"winfo visualid" command} {
  290.     set x [lindex [lindex [winfo visualsa . includeids] 0] 2]
  291.     expr $x + 2 - $x
  292. } {2}
  294. test winfo-12.1 {GetDisplayOf procedure} {
  295.     list [catch {winfo atom - foo x} msg] $msg
  296. } {1 {wrong # args: should be "winfo atom ?-displayof window? name"}}
  297. test winfo-12.2 {GetDisplayOf procedure} {
  298.     list [catch {winfo atom -d bad_window x} msg] $msg
  299. } {1 {bad window path name "bad_window"}}
  301. # Some embedding tests
  302. # 
  304. proc MakeEmbed {} {
  305.     frame .con -container 1
  306.     pack .con -expand yes -fill both
  307.     toplevel .emb -use [winfo id .con] -bd 0 -highlightthickness 0
  308.     button .emb.b
  309.     pack .emb.b -expand yes -fill both
  310.     update
  311. }
  312. test winfo-13.1 {root coordinates of embedded toplevel} {
  313.     MakeEmbed
  314.     set z [expr [winfo rootx .emb] == [winfo rootx .con] && 
  315. [winfo rooty .emb] == [winfo rooty .con]]
  316.     destroy .emb
  317.     destroy .con
  318.     set z
  319. } {1}
  320. test winfo-13.2 {destroying embedded toplevel} {
  321.     destroy .emb
  322.     update
  323.     expr [winfo exists .emb.b] || [winfo exists .con]
  324. } 0
  326. deleteWindows
  328. test winfo-13.3 {destroying container window} {
  329.     MakeEmbed
  330.     destroy .con
  331.     update
  332.     set z [expr [winfo exists .emb.b] || [winfo exists .emb]]
  333.     catch {destroy .emb}
  334.     catch {destroy .con}
  335.     set z
  336. } 0
  338. deleteWindows
  340. test winfo-13.4 {[winfo containing] with embedded windows} {
  341.     MakeEmbed
  342.     button .b
  343.     pack .b -expand yes -fill both
  344.     update
  346.     set z [string compare 
  347. [winfo containing [winfo rootx .emb.b] [winfo rooty .emb.b]] .emb.b]
  348.     catch {destroy .con}
  349.     catch {destroy .emb}
  350.     set z
  351. } 0
  353. test winfo-14.1 {usage} {
  354.     list [catch {winfo ismapped} msg] $msg
  355. } {1 {wrong # args: should be "winfo ismapped window"}}
  357. test winfo-14.2 {usage} {
  358.     list [catch {winfo ismapped . .} msg] $msg
  359. } {1 {wrong # args: should be "winfo ismapped window"}}
  361. test winfo-14.3 {initially unmapped} {
  362.     catch {destroy .t}
  363.     toplevel .t
  364.     winfo ismapped .t
  365. } 0
  367. test winfo-14.4 {mapped at idle time} {
  368.     catch {destroy .t}
  369.     toplevel .t
  370.     update idletasks
  371.     winfo ismapped .t
  372. } 1
  374. deleteWindows
  375. # cleanup
  376. ::tcltest::cleanupTests
  377. return