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

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

通讯编程

开发平台：

Visual C++

spinbox.test：源码内容
  1. # This file is a Tcl script to test spinbox widgets in Tk.  It is
  2. # organized in the standard fashion for Tcl tests.
  3. #
  4. # Copyright (c) 1998-2000 by Scriptics Corporation.
  5. # All rights reserved.
  6. #
  7. # RCS: @(#) $Id: spinbox.test,v 1.5.2.1 2003/03/13 19:33:48 dgp Exp $
  9. package require tcltest 2.1
  10. namespace import -force tcltest::configure
  11. namespace import -force tcltest::testsDirectory
  12. configure -testdir [file join [pwd] [file dirname [info script]]]
  13. configure -loadfile [file join [testsDirectory] constraints.tcl]
  14. tcltest::loadTestedCommands
  16. proc scroll args {
  17.     global scrollInfo
  18.     set scrollInfo $args
  19. }
  21. # Create additional widget that's used to hold the selection at times.
  23. spinbox .sel
  24. .sel insert end "This is some sample text"
  26. # Font names
  28. set big -adobe-helvetica-medium-r-normal--24-240-75-75-p-*-iso8859-1
  29. set fixed -adobe-courier-medium-r-normal--12-120-75-75-m-*-iso8859-1
  31. # Create entries in the option database to be sure that geometry options
  32. # like border width have predictable values.
  34. option add *Spinbox.borderWidth 2
  35. option add *Spinbox.highlightThickness 2
  36. option add *Spinbox.font {Helvetica -12}
  38. spinbox .e -bd 2 -relief sunken
  39. pack .e
  40. update
  42. set i 1
  43. foreach test {
  44.     {-activebackground #ff0000 #ff0000 non-existent
  45.     {unknown color name "non-existent"}}
  46.     {-background #ff0000 #ff0000 non-existent
  47.     {unknown color name "non-existent"}}
  48.     {-bd 4 4 badValue {bad screen distance "badValue"}}
  49.     {-bg #ff0000 #ff0000 non-existent {unknown color name "non-existent"}}
  50.     {-borderwidth 1.3 1 badValue {bad screen distance "badValue"}}
  51.     {-buttonbackground #ff0000 #ff0000 non-existent
  52.     {unknown color name "non-existent"}}
  53.     {-buttoncursor arrow arrow badValue {bad cursor spec "badValue"}}
  54.     {-command {a command} {a command} {} {}}
  55.     {-cursor arrow arrow badValue {bad cursor spec "badValue"}}
  56.     {-disabledbackground green green non-existent 
  57. {unknown color name "non-existent"}}
  58.     {-disabledforeground #110022 #110022 bogus {unknown color name "bogus"}}
  59.     {-exportselection yes 1 xyzzy {expected boolean value but got "xyzzy"}}
  60.     {-fg #110022 #110022 bogus {unknown color name "bogus"}}
  61.     {-font -Adobe-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-*
  62. -Adobe-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-* {}
  63. {font "" doesn't exist}}
  64.     {-foreground #110022 #110022 bogus {unknown color name "bogus"}}
  65.     {-format %0.5f %0.5f %d {bad spinbox format specifier "%d"}}
  66.     {-from -10 -10.0 bogus {expected floating-point number but got "bogus"}}
  67.     {-highlightbackground #123456 #123456 ugly {unknown color name "ugly"}}
  68.     {-highlightcolor #123456 #123456 bogus {unknown color name "bogus"}}
  69.     {-highlightthickness 6 6 bogus {bad screen distance "bogus"}}
  70.     {-highlightthickness -2 0 {} {}}
  71.     {-increment 1.0 1.0 bogus {expected floating-point number but got "bogus"}}
  72.     {-insertbackground #110022 #110022 bogus {unknown color name "bogus"}}
  73.     {-insertborderwidth 1.3 1 2.6x {bad screen distance "2.6x"}}
  74.     {-insertofftime 100 100 3.2 {expected integer but got "3.2"}}
  75.     {-insertontime 100 100 3.2 {expected integer but got "3.2"}}
  76.     {-invalidcommand "a command" "a command" {} {}}
  77.     {-invcmd "a command" "a command" {} {}}
  78.     {-justify right right bogus {bad justification "bogus": must be left, right, or center}}
  79.     {-readonlybackground green green non-existent 
  80. {unknown color name "non-existent"}}
  81.     {-relief groove groove 1.5 {bad relief "1.5": must be flat, groove, raised, ridge, solid, or sunken}}
  82.     {-repeatdelay 500 500 3p {expected integer but got "3p"}}
  83.     {-repeatinterval -500 -500 3p {expected integer but got "3p"}}
  84.     {-selectbackground #110022 #110022 bogus {unknown color name "bogus"}}
  85.     {-selectborderwidth 1.3 1 badValue {bad screen distance "badValue"}}
  86.     {-selectforeground #654321 #654321 bogus {unknown color name "bogus"}}
  87.     {-state n normal bogus {bad state "bogus": must be disabled, normal, or readonly}}
  88.     {-takefocus "any string" "any string" {} {}}
  89.     {-textvariable i i {} {}}
  90.     {-to 14.9 14.9 bogus {expected floating-point number but got "bogus"}}
  91.     {-validate "key" "key" "bogus" {bad validate "bogus": must be all, key, focus, focusin, focusout, or none}}
  92.     {-validatecommand "a command" "a command" {} {}}
  93.     {-values {mon tue wed thur} {mon tue wed thur} {bad {}list} {list element in braces followed by "list" instead of space}}
  94.     {-vcmd "a command" "a command" {} {}}
  95.     {-width 402 402 3p {expected integer but got "3p"}}
  96.     {-wrap yes 1 xyzzy {expected boolean value but got "xyzzy"}}
  97.     {-xscrollcommand {Some command} {Some command} {} {}}
  98. } {
  99.     set name [lindex $test 0]
  100.     test spinbox-1.$i {configuration options} {
  101. .e configure $name [lindex $test 1]
  102. list [lindex [.e configure $name] 4] [.e cget $name]
  103.     } [list [lindex $test 2] [lindex $test 2]]
  104.     incr i
  105.     if {[lindex $test 3] != ""} {
  106. test spinbox-1.$i {configuration options} {
  107.     list [catch {.e configure $name [lindex $test 3]} msg] $msg
  108. } [list 1 [lindex $test 4]]
  109.     }
  110.     .e configure $name [lindex [.e configure $name] 3]
  111.     incr i
  112. }
  114. test spinbox-2.1 {Tk_SpinboxCmd procedure} {
  115.     list [catch {spinbox} msg] $msg
  116. } {1 {wrong # args: should be "spinbox pathName ?options?"}}
  117. test spinbox-2.2 {Tk_SpinboxCmd procedure} {
  118.     list [catch {spinbox gorp} msg] $msg
  119. } {1 {bad window path name "gorp"}}
  120. test spinbox-2.3 {Tk_SpinboxCmd procedure} {
  121.     catch {destroy .e}
  122.     spinbox .e
  123.     list [winfo exists .e] [winfo class .e] [info commands .e]
  124. } {1 Spinbox .e}
  125. test spinbox-2.4 {Tk_SpinboxCmd procedure} {
  126.     catch {destroy .e}
  127.     list [catch {spinbox .e -gorp foo} msg] $msg [winfo exists .e] 
  128.     [info commands .e]
  129. } {1 {unknown option "-gorp"} 0 {}}
  130. test spinbox-2.5 {Tk_SpinboxCmd procedure} {
  131.     catch {destroy .e}
  132.     spinbox .e
  133. } {.e}
  135. catch {destroy .e}
  136. spinbox .e -font $fixed
  137. pack .e
  138. update
  140. set cx [font measure $fixed a]
  141. set cy [font metrics $fixed -linespace]
  142. set ux [font measure $fixed u4e4e]
  144. test spinbox-3.1 {SpinboxWidgetCmd procedure} {
  145.     list [catch {.e} msg] $msg
  146. } {1 {wrong # args: should be ".e option ?arg arg ...?"}}
  147. test spinbox-3.2 {SpinboxWidgetCmd procedure, "bbox" widget command} {
  148.     list [catch {.e bbox} msg] $msg
  149. } {1 {wrong # args: should be ".e bbox index"}}
  150. test spinbox-3.3 {SpinboxWidgetCmd procedure, "bbox" widget command} {
  151.     list [catch {.e bbox a b} msg] $msg
  152. } {1 {wrong # args: should be ".e bbox index"}}
  153. test spinbox-3.4 {SpinboxWidgetCmd procedure, "bbox" widget command} {
  154.     list [catch {.e bbox bogus} msg] $msg
  155. } {1 {bad spinbox index "bogus"}}
  156. test spinbox-3.5 {SpinboxWidgetCmd procedure, "bbox" widget command} {
  157.     .e delete 0 end
  158.     .e bbox 0
  159. } [list 5 5 0 $cy]
  160. test spinbox-3.6 {SpinboxWidgetCmd procedure, "bbox" widget command} {
  161.     # Tcl_UtfAtIndex(): no utf chars
  163.     .e delete 0 end
  164.     .e insert 0 "abc"
  165.     list [.e bbox 3] [.e bbox end]
  166. } [list "[expr 5+2*$cx] 5 $cx $cy" "[expr 5+2*$cx] 5 $cx $cy"]
  167. test spinbox-3.7 {SpinboxWidgetCmd procedure, "bbox" widget command} {
  168.     # Tcl_UtfAtIndex(): utf at end
  169.     .e delete 0 end
  170.     .e insert 0 "abu4e4e"
  171.     .e bbox end
  172. } "[expr 5+2*$cx] 5 $ux $cy"
  173. test spinbox-3.8 {SpinboxWidgetCmd procedure, "bbox" widget command} {
  174.     # Tcl_UtfAtIndex(): utf before index
  175.     .e delete 0 end
  176.     .e insert 0 "abu4e4ec"
  177.     .e bbox 3
  178. } "[expr 5+2*$cx+$ux] 5 $cx $cy"
  179. test spinbox-3.9 {SpinboxWidgetCmd procedure, "bbox" widget command} {
  180.     # Tcl_UtfAtIndex(): no chars
  181.     .e delete 0 end
  182.     .e bbox end
  183. } "5 5 0 $cy"
  184. test spinbox-3.10 {SpinboxWidgetCmd procedure, "bbox" widget command} {
  185.     .e delete 0 end
  186.     .e insert 0 "abcdefghiju4e4eklmnop"
  187.     list [.e bbox 0] [.e bbox 1] [.e bbox 10] [.e bbox end]
  188. } [list "5 5 $cx $cy" "[expr 5+$cx] 5 $cx $cy" "[expr 5+10*$cx] 5 $ux $cy" "[expr 5+$ux+15*$cx] 5 $cx $cy"]
  189. test spinbox-3.11 {SpinboxWidgetCmd procedure, "cget" widget command} {
  190.     list [catch {.e cget} msg] $msg
  191. } {1 {wrong # args: should be ".e cget option"}}
  192. test spinbox-3.12 {SpinboxWidgetCmd procedure, "cget" widget command} {
  193.     list [catch {.e cget a b} msg] $msg
  194. } {1 {wrong # args: should be ".e cget option"}}
  195. test spinbox-3.13 {SpinboxWidgetCmd procedure, "cget" widget command} {
  196.     list [catch {.e cget -gorp} msg] $msg
  197. } {1 {unknown option "-gorp"}}
  198. test spinbox-3.14 {SpinboxWidgetCmd procedure, "cget" widget command} {
  199.     .e configure -bd 4
  200.     .e cget -bd
  201. } {4}
  202. test spinbox-3.15 {SpinboxWidgetCmd procedure, "configure" widget command} {
  203.     llength [.e configure]
  204. } {49}
  205. test spinbox-3.16 {SpinboxWidgetCmd procedure, "configure" widget command} {
  206.     list [catch {.e configure -foo} msg] $msg
  207. } {1 {unknown option "-foo"}}
  208. test spinbox-3.17 {SpinboxWidgetCmd procedure, "configure" widget command} {
  209.     .e configure -bd 4
  210.     .e configure -bg #ffffff
  211.     lindex [.e configure -bd] 4
  212. } {4}
  213. test spinbox-3.18 {SpinboxWidgetCmd procedure, "delete" widget command} {
  214.     list [catch {.e delete} msg] $msg
  215. } {1 {wrong # args: should be ".e delete firstIndex ?lastIndex?"}}
  216. test spinbox-3.19 {SpinboxWidgetCmd procedure, "delete" widget command} {
  217.     list [catch {.e delete a b c} msg] $msg
  218. } {1 {wrong # args: should be ".e delete firstIndex ?lastIndex?"}}
  219. test spinbox-3.20 {SpinboxWidgetCmd procedure, "delete" widget command} {
  220.     list [catch {.e delete foo} msg] $msg
  221. } {1 {bad spinbox index "foo"}}
  222. test spinbox-3.21 {SpinboxWidgetCmd procedure, "delete" widget command} {
  223.     list [catch {.e delete 0 bar} msg] $msg
  224. } {1 {bad spinbox index "bar"}}
  225. test spinbox-3.22 {SpinboxWidgetCmd procedure, "delete" widget command} {
  226.     .e delete 0 end
  227.     .e insert end "01234567890"
  228.     .e delete 2 4
  229.     .e get
  230. } {014567890}
  231. test spinbox-3.23 {SpinboxWidgetCmd procedure, "delete" widget command} {
  232.     .e delete 0 end
  233.     .e insert end "01234567890"
  234.     .e delete 6
  235.     .e get
  236. } {0123457890}
  237. test spinbox-3.24 {SpinboxWidgetCmd procedure, "delete" widget command} {
  238.     # UTF
  239.     set x {}
  240.     .e delete 0 end
  241.     .e insert end "01234u4e4e67890"
  242.     .e delete 6
  243.     lappend x [.e get]
  244.     .e delete 0 end
  245.     .e insert end "012345u4e4e7890"
  246.     .e delete 6
  247.     lappend x [.e get]
  248.     .e delete 0 end
  249.     .e insert end "0123456u4e4e890"
  250.     .e delete 6
  251.     lappend x [.e get]
  252. } [list "01234u4e4e7890" "0123457890" "012345u4e4e890"]
  253. test spinbox-3.25 {SpinboxWidgetCmd procedure, "delete" widget command} {
  254.     .e delete 0 end
  255.     .e insert end "01234567890"
  256.     .e delete 6 5
  257.     .e get
  258. } {01234567890}
  259. test spinbox-3.26 {SpinboxWidgetCmd procedure, "delete" widget command} {
  260.     .e delete 0 end
  261.     .e insert end "01234567890"
  262.     .e configure -state disabled
  263.     .e delete 2 8
  264.     .e configure -state normal
  265.     .e get
  266. } {01234567890}
  267. test spinbox-3.27 {SpinboxWidgetCmd procedure, "get" widget command} {
  268.     list [catch {.e get foo} msg] $msg
  269. } {1 {wrong # args: should be ".e get"}}
  270. test spinbox-3.28 {SpinboxWidgetCmd procedure, "icursor" widget command} {
  271.     list [catch {.e icursor} msg] $msg
  272. } {1 {wrong # args: should be ".e icursor pos"}}
  273. test spinbox-3.29 {SpinboxWidgetCmd procedure, "icursor" widget command} {
  274.     list [catch {.e icursor foo} msg] $msg
  275. } {1 {bad spinbox index "foo"}}
  276. test spinbox-3.30 {SpinboxWidgetCmd procedure, "icursor" widget command} {
  277.     .e delete 0 end
  278.     .e insert end "01234567890"
  279.     .e icursor 4
  280.     .e index insert
  281. } {4}
  282. test spinbox-3.31 {SpinboxWidgetCmd procedure, "index" widget command} {
  283.     list [catch {.e in} msg] $msg
  284. } {1 {ambiguous option "in": must be bbox, cget, configure, delete, get, icursor, identify, index, insert, invoke, scan, selection, set, validate, or xview}}
  285. test spinbox-3.32 {SpinboxWidgetCmd procedure, "index" widget command} {
  286.     list [catch {.e index} msg] $msg
  287. } {1 {wrong # args: should be ".e index string"}}
  288. test spinbox-3.33 {SpinboxWidgetCmd procedure, "index" widget command} {
  289.     list [catch {.e index foo} msg] $msg
  290. } {1 {bad spinbox index "foo"}}
  291. test spinbox-3.34 {SpinboxWidgetCmd procedure, "index" widget command} {
  292.     list [catch {.e index 0} msg] $msg
  293. } {0 0}
  294. test spinbox-3.35 {SpinboxWidgetCmd procedure, "index" widget command} {
  295.     # UTF
  296.     .e delete 0 end
  297.     .e insert 0 abcu4e4eu0153def
  298.     list [.e index 3] [.e index 4] [.e index end]
  299. } {3 4 8}
  300. test spinbox-3.36 {SpinboxWidgetCmd procedure, "insert" widget command} {
  301.     list [catch {.e insert a} msg] $msg
  302. } {1 {wrong # args: should be ".e insert index text"}}
  303. test spinbox-3.37 {SpinboxWidgetCmd procedure, "insert" widget command} {
  304.     list [catch {.e insert a b c} msg] $msg
  305. } {1 {wrong # args: should be ".e insert index text"}}
  306. test spinbox-3.38 {SpinboxWidgetCmd procedure, "insert" widget command} {
  307.     list [catch {.e insert foo Text} msg] $msg
  308. } {1 {bad spinbox index "foo"}}
  309. test spinbox-3.39 {SpinboxWidgetCmd procedure, "insert" widget command} {
  310.     .e delete 0 end
  311.     .e insert end "01234567890"
  312.     .e insert 3 xxx
  313.     .e get
  314. } {012xxx34567890}
  315. test spinbox-3.40 {SpinboxWidgetCmd procedure, "insert" widget command} {
  316.     .e delete 0 end
  317.     .e insert end "01234567890"
  318.     .e configure -state disabled
  319.     .e insert 3 xxx
  320.     .e configure -state normal
  321.     .e get
  322. } {01234567890}
  323. test spinbox-3.41 {SpinboxWidgetCmd procedure, "insert" widget command} {
  324.     list [catch {.e insert a b c} msg] $msg
  325. } {1 {wrong # args: should be ".e insert index text"}}
  326. test spinbox-3.42 {SpinboxWidgetCmd procedure, "scan" widget command} {
  327.     list [catch {.e scan a} msg] $msg
  328. } {1 {wrong # args: should be ".e scan mark|dragto x"}}
  329. test spinbox-3.43 {SpinboxWidgetCmd procedure, "scan" widget command} {
  330.     list [catch {.e scan a b c} msg] $msg
  331. } {1 {wrong # args: should be ".e scan mark|dragto x"}}
  332. test spinbox-3.44 {SpinboxWidgetCmd procedure, "scan" widget command} {
  333.     list [catch {.e scan foobar 20} msg] $msg
  334. } {1 {bad scan option "foobar": must be mark or dragto}}
  335. test spinbox-3.45 {SpinboxWidgetCmd procedure, "scan" widget command} {
  336.     list [catch {.e scan mark 20.1} msg] $msg
  337. } {1 {expected integer but got "20.1"}}
  338. # This test is non-portable because character sizes vary.
  340. test spinbox-3.46 {SpinboxWidgetCmd procedure, "scan" widget command} {fonts} {
  341.     .e delete 0 end
  342.     update
  343.     .e insert end "This is quite a long string, in fact a "
  344.     .e insert end "very very long string"
  345.     .e scan mark 30
  346.     .e scan dragto 28
  347.     .e index @0
  348. } {2}
  349. test spinbox-3.47 {SpinboxWidgetCmd procedure, "select" widget command} {
  350.     list [catch {.e select} msg] $msg
  351. } {1 {wrong # args: should be ".e selection option ?index?"}}
  352. test spinbox-3.48 {SpinboxWidgetCmd procedure, "select" widget command} {
  353.     list [catch {.e select foo} msg] $msg
  354. } {1 {bad selection option "foo": must be adjust, clear, element, from, present, range, or to}}
  355. test spinbox-3.49 {SpinboxWidgetCmd procedure, "select clear" widget command} {
  356.     list [catch {.e select clear gorp} msg] $msg
  357. } {1 {wrong # args: should be ".e selection clear"}}
  358. test spinbox-3.50 {SpinboxWidgetCmd procedure, "select clear" widget command} {
  359.     .e delete 0 end
  360.     .e insert end "0123456789"
  361.     .e select from 1
  362.     .e select to 4
  363.     update
  364.     .e select clear
  365.     list [catch {selection get} msg] $msg [selection own]
  366. } {1 {PRIMARY selection doesn't exist or form "STRING" not defined} .e}
  367. test spinbox-3.51 {SpinboxWidgetCmd procedure, "selection present" widget command} {
  368.     list [catch {.e selection present foo} msg] $msg
  369. } {1 {wrong # args: should be ".e selection present"}}
  370. test spinbox-3.52 {SpinboxWidgetCmd procedure, "selection present" widget command} {
  371.     .e delete 0 end
  372.     .e insert end 0123456789
  373.     .e select from 3
  374.     .e select to 6
  375.     .e selection present
  376. } {1}
  377. test spinbox-3.53 {SpinboxWidgetCmd procedure, "selection present" widget command} {
  378.     .e delete 0 end
  379.     .e insert end 0123456789
  380.     .e select from 3
  381.     .e select to 6
  382.     .e configure -exportselection false
  383.     .e selection present
  384. } {1}
  385. .e configure -exportselection true
  386. test spinbox-3.54 {SpinboxWidgetCmd procedure, "selection present" widget command} {
  387.     .e delete 0 end
  388.     .e insert end 0123456789
  389.     .e select from 3
  390.     .e select to 6
  391.     .e delete 0 end
  392.     .e selection present
  393. } {0}
  394. test spinbox-3.55 {SpinboxWidgetCmd procedure, "selection adjust" widget command} {
  395.     list [catch {.e select adjust x} msg] $msg
  396. } {1 {bad spinbox index "x"}}
  397. test spinbox-3.56 {SpinboxWidgetCmd procedure, "selection adjust" widget command} {
  398.     list [catch {.e select adjust 2 3} msg] $msg
  399. } {1 {wrong # args: should be ".e selection adjust index"}}
  400. test spinbox-3.57 {SpinboxWidgetCmd procedure, "selection adjust" widget command} {
  401.     .e delete 0 end
  402.     .e insert end "0123456789"
  403.     .e select from 1
  404.     .e select to 5
  405.     update
  406.     .e select adjust 4
  407.     selection get
  408. } {123}
  409. test spinbox-3.58 {SpinboxWidgetCmd procedure, "selection adjust" widget command} {
  410.     .e delete 0 end
  411.     .e insert end "0123456789"
  412.     .e select from 1
  413.     .e select to 5
  414.     update
  415.     .e select adjust 2
  416.     selection get
  417. } {234}
  418. test spinbox-3.59 {SpinboxWidgetCmd procedure, "selection from" widget command} {
  419.     list [catch {.e select from 2 3} msg] $msg
  420. } {1 {wrong # args: should be ".e selection from index"}}
  421. test spinbox-3.60 {SpinboxWidgetCmd procedure, "selection range" widget command} {
  422.     list [catch {.e select range 2} msg] $msg
  423. } {1 {wrong # args: should be ".e selection range start end"}}
  424. test spinbox-3.61 {SpinboxWidgetCmd procedure, "selection range" widget command} {
  425.     list [catch {.e selection range 2 3 4} msg] $msg
  426. } {1 {wrong # args: should be ".e selection range start end"}}
  427. test spinbox-3.62 {SpinboxWidgetCmd procedure, "selection range" widget command} {
  428.     .e delete 0 end
  429.     .e insert end 0123456789
  430.     .e select from 1
  431.     .e select to 5
  432.     .e select range 4 4
  433.     list [catch {.e index sel.first} msg] $msg
  434. } {1 {selection isn't in widget .e}}
  435. test spinbox-3.63 {SpinboxWidgetCmd procedure, "selection range" widget command} {
  436.     .e delete 0 end
  437.     .e insert end 0123456789
  438.     .e select from 3
  439.     .e select to 7
  440.     .e select range 2 9
  441.     list [.e index sel.first] [.e index sel.last] [.e index anchor]
  442. } {2 9 3}
  443. .e delete 0 end
  444. .e insert end "This is quite a long text string, so long that it "
  445. .e insert end "runs off the end of the window quite a bit."
  446. test spinbox-3.64 {SpinboxWidgetCmd procedure, "selection to" widget command} {
  447.     list [catch {.e select to 2 3} msg] $msg
  448. } {1 {wrong # args: should be ".e selection to index"}}
  449. test spinbox-3.65 {SpinboxWidgetCmd procedure, "xview" widget command} {
  450.     .e xview 5
  451.     .e xview
  452. } {0.0537634 0.268817}
  453. test spinbox-3.66 {SpinboxWidgetCmd procedure, "xview" widget command} {
  454.     list [catch {.e xview gorp} msg] $msg
  455. } {1 {bad spinbox index "gorp"}}
  456. test spinbox-3.67 {SpinboxWidgetCmd procedure, "xview" widget command} {
  457.     .e xview 0
  458.     .e icursor 10
  459.     .e xview insert
  460.     .e xview
  461. } {0.107527 0.322581}
  462. test spinbox-3.68 {SpinboxWidgetCmd procedure, "xview" widget command} {
  463.     list [catch {.e xview moveto foo bar} msg] $msg
  464. } {1 {wrong # args: should be ".e xview moveto fraction"}}
  465. test spinbox-3.69 {SpinboxWidgetCmd procedure, "xview" widget command} {
  466.     list [catch {.e xview moveto foo} msg] $msg
  467. } {1 {expected floating-point number but got "foo"}}
  468. test spinbox-3.70 {SpinboxWidgetCmd procedure, "xview" widget command} {
  469.     .e xview moveto 0.5
  470.     .e xview
  471. } {0.505376 0.72043}
  472. test spinbox-3.71 {SpinboxWidgetCmd procedure, "xview" widget command} {
  473.     list [catch {.e xview scroll 24} msg] $msg
  474. } {1 {wrong # args: should be ".e xview scroll number units|pages"}}
  475. test spinbox-3.72 {SpinboxWidgetCmd procedure, "xview" widget command} {
  476.     list [catch {.e xview scroll gorp units} msg] $msg
  477. } {1 {expected integer but got "gorp"}}
  478. test spinbox-3.73 {SpinboxWidgetCmd procedure, "xview" widget command} {
  479.     .e xview moveto 0
  480.     .e xview scroll 1 pages
  481.     .e xview
  482. } {0.193548 0.408602}
  483. test spinbox-3.74 {SpinboxWidgetCmd procedure, "xview" widget command} {
  484.     .e xview moveto .9
  485.     update
  486.     .e xview scroll -2 p
  487.     .e xview
  488. } {0.397849 0.612903}
  489. test spinbox-3.75 {SpinboxWidgetCmd procedure, "xview" widget command} {
  490.     .e xview 30
  491.     update
  492.     .e xview scroll 2 units 
  493.     .e index @0
  494. } {32}
  495. test spinbox-3.76 {SpinboxWidgetCmd procedure, "xview" widget command} {
  496.     .e xview 30
  497.     update
  498.     .e xview scroll -1 units 
  499.     .e index @0
  500. } {29}
  501. test spinbox-3.77 {SpinboxWidgetCmd procedure, "xview" widget command} {
  502.     list [catch {.e xview scroll 23 foobars} msg] $msg
  503. } {1 {bad argument "foobars": must be units or pages}}
  504. test spinbox-3.78 {SpinboxWidgetCmd procedure, "xview" widget command} {
  505.     list [catch {.e xview eat 23 hamburgers} msg] $msg
  506. } {1 {unknown option "eat": must be moveto or scroll}}
  507. test spinbox-3.79 {SpinboxWidgetCmd procedure, "xview" widget command} {
  508.     .e xview 0
  509.     update
  510.     .e xview -4
  511.     .e index @0
  512. } {0}
  513. test spinbox-3.80 {SpinboxWidgetCmd procedure, "xview" widget command} {
  514.     .e xview 300
  515.     .e index @0
  516. } {73}
  517. .e insert 10 u4e4e
  518. test spinbox-3.81 {SpinboxWidgetCmd procedure, "xview" widget command} {
  519.     # UTF
  520.     # If Tcl_NumUtfChars wasn't used, wrong answer would be:
  521.     # 0.106383 0.117021 0.117021
  523.     set x {}
  524.     .e xview moveto .1
  525.     lappend x [lindex [.e xview] 0]
  526.     .e xview moveto .11
  527.     lappend x [lindex [.e xview] 0]
  528.     .e xview moveto .12
  529.     lappend x [lindex [.e xview] 0]
  530. } {0.0957447 0.106383 0.117021}
  531. test spinbox-3.82 {SpinboxWidgetCmd procedure} {
  532.     list [catch {.e gorp} msg] $msg
  533. } {1 {bad option "gorp": must be bbox, cget, configure, delete, get, icursor, identify, index, insert, invoke, scan, selection, set, validate, or xview}}
  535. frame .f -width 200 -height 50 -relief raised -bd 2
  536. pack .f -side right
  537. test spinbox-5.1 {ConfigureSpinbox procedure, -textvariable} {
  538.     catch {destroy .e}
  539.     set x 12345
  540.     spinbox .e -textvariable x
  541.     .e get
  542. } {12345}
  543. test spinbox-5.2 {ConfigureSpinbox procedure, -textvariable} {
  544.     catch {destroy .e}
  545.     set x 12345
  546.     spinbox .e -textvariable x
  547.     set y abcde
  548.     .e configure -textvariable y
  549.     set x 54321
  550.     .e get
  551. } {abcde}
  552. test spinbox-5.3 {ConfigureSpinbox procedure, -textvariable} {
  553.     catch {destroy .e}
  554.     catch {unset x}
  555.     spinbox .e
  556.     .e insert 0 "Some text"
  557.     .e configure -textvariable x
  558.     set x
  559. } {Some text}
  560. test spinbox-5.4 {ConfigureSpinbox procedure, -textvariable} {
  561.     proc override args {
  562. global x
  563. set x 12345
  564.     }
  565.     catch {destroy .e}
  566.     catch {unset x}
  567.     trace variable x w override
  568.     spinbox .e
  569.     .e insert 0 "Some text"
  570.     .e configure -textvariable x
  571.     set result [list $x [.e get]]
  572.     unset x;  rename override {}
  573.     set result
  574. } {12345 12345}
  575. test spinbox-5.5 {ConfigureSpinbox procedure} {
  576.     catch {destroy .e}
  577.     spinbox .e -exportselection false
  578.     pack .e
  579.     .e insert end "0123456789"
  580.     .sel select from 0
  581.     .sel select to 10
  582.     set x {}
  583.     lappend x [selection get]
  584.     .e select from 1
  585.     .e select to 5
  586.     lappend x [selection get]
  587.     .e configure -exportselection 1
  588.     lappend x [selection get]
  589.     set x
  590. } {{This is so} {This is so} 1234}
  591. test spinbox-5.6 {ConfigureSpinbox procedure} {
  592.     catch {destroy .e}
  593.     spinbox .e
  594.     pack .e
  595.     .e insert end "0123456789"
  596.     .e select from 1
  597.     .e select to 5
  598.     .e configure -exportselection 0
  599.     list [catch {selection get} msg] $msg [.e index sel.first] 
  600.     [.e index sel.last]
  601. } {1 {PRIMARY selection doesn't exist or form "STRING" not defined} 1 5}
  602. test spinbox-5.7 {ConfigureSpinbox procedure} {
  603.     catch {destroy .e}
  604.     spinbox .e -font $fixed -width 4 -xscrollcommand scroll
  605.     pack .e
  606.     .e insert end "01234567890"
  607.     update
  608.     .e configure -width 5
  609.     set scrollInfo
  610. } {0 0.363636}
  611. test spinbox-5.8 {ConfigureSpinbox procedure} {fonts} {
  612.     catch {destroy .e}
  613.     spinbox .e -width 0
  614.     pack .e
  615.     .e insert end "0123"
  616.     update
  617.     .e configure -font $big
  618.     update
  619.     winfo geom .e
  620. } {79x37+0+0}
  621. test spinbox-5.9 {ConfigureSpinbox procedure} {fonts} {
  622.     catch {destroy .e}
  623.     spinbox .e -font $fixed -bd 2 -relief raised
  624.     pack .e
  625.     .e insert end "0123"
  626.     update
  627.     list [.e index @10] [.e index @11] [.e index @12] [.e index @13]
  628. } {0 0 1 1}
  629. test spinbox-5.10 {ConfigureSpinbox procedure} {fonts} {
  630.     catch {destroy .e}
  631.     spinbox .e -font $fixed -bd 2 -relief flat
  632.     pack .e
  633.     .e insert end "0123"
  634.     update
  635.     list [.e index @10] [.e index @11] [.e index @12] [.e index @13]
  636. } {0 0 1 1}
  637. test spinbox-5.11 {ConfigureSpinbox procedure} {
  638.     # If "0" in selected font had 0 width, caused divide-by-zero error.
  640.     catch {destroy .e}
  641.     pack [spinbox .e -font {{open look glyph}}]
  642.     .e scan dragto 30
  643.     update
  644. } {}    
  646. # No tests for DisplaySpinbox.
  648. test spinbox-6.1 {SpinboxComputeGeometry procedure} {fonts} {
  649.     catch {destroy .e}
  650.     spinbox .e -font $fixed -bd 2 -relief raised -width 20 -highlightthickness 3
  651.     pack .e
  652.     .e insert end 012t45
  653.     update
  654.     list [.e index @61] [.e index @62]
  655. } {3 4}
  656. test spinbox-6.2 {SpinboxComputeGeometry procedure} {fonts} {
  657.     catch {destroy .e}
  658.     spinbox .e -font $fixed -bd 2 -relief raised -width 20 -justify center 
  659.     -highlightthickness 3
  660.     pack .e
  661.     .e insert end 012t45
  662.     update
  663.     list [.e index @96] [.e index @97]
  664. } {3 4}
  665. test spinbox-6.3 {SpinboxComputeGeometry procedure} {fonts} {
  666.     catch {destroy .e}
  667.     spinbox .e -font $fixed -bd 2 -relief raised -width 20 -justify right 
  668.     -highlightthickness 3
  669.     pack .e
  670.     .e insert end 012t45
  671.     update
  672.     list [.e index @131] [.e index @132]
  673. } {3 4}
  674. test spinbox-6.4 {SpinboxComputeGeometry procedure} {
  675.     catch {destroy .e}
  676.     spinbox .e -font $fixed -bd 2 -relief raised -width 5
  677.     pack .e
  678.     .e insert end "01234567890"
  679.     update
  680.     .e xview 6
  681.     .e index @0
  682. } {6}
  683. test spinbox-6.5 {SpinboxComputeGeometry procedure} {
  684.     catch {destroy .e}
  685.     spinbox .e -font $fixed -bd 2 -relief raised -width 5
  686.     pack .e
  687.     .e insert end "01234567890"
  688.     update
  689.     .e xview 7
  690.     .e index @0
  691. } {6}
  692. test spinbox-6.6 {SpinboxComputeGeometry procedure} {fonts} {
  693.     catch {destroy .e}
  694.     spinbox .e -font $fixed -bd 2 -relief raised -width 10
  695.     pack .e
  696.     .e insert end "01234t67890"
  697.     update
  698.     .e xview 3
  699.     list [.e index @39] [.e index @40]
  700. } {5 6}
  701. test spinbox-6.7 {SpinboxComputeGeometry procedure} {fonts} {
  702.     catch {destroy .e}
  703.     spinbox .e -font $big -bd 3 -relief raised -width 5
  704.     pack .e
  705.     .e insert end "01234567"
  706.     update
  707.     list [winfo reqwidth .e] [winfo reqheight .e]
  708. } {94 39}
  709. test spinbox-6.8 {SpinboxComputeGeometry procedure} {fonts} {
  710.     catch {destroy .e}
  711.     spinbox .e -font $big -bd 3 -relief raised -width 0
  712.     pack .e
  713.     .e insert end "01234567"
  714.     update
  715.     list [winfo reqwidth .e] [winfo reqheight .e]
  716. } {133 39}
  717. test spinbox-6.9 {SpinboxComputeGeometry procedure} {fonts} {
  718.     catch {destroy .e}
  719.     spinbox .e -font $big -bd 3 -relief raised -width 0 -highlightthickness 2
  720.     pack .e
  721.     update
  722.     list [winfo reqwidth .e] [winfo reqheight .e]
  723. } {42 39}
  725. catch {destroy .e}
  726. spinbox .e -width 10 -font $fixed -textvariable contents -xscrollcommand scroll
  727. pack .e
  728. focus .e
  729. test spinbox-7.1 {InsertChars procedure} {
  730.     .e delete 0 end
  731.     .e insert 0 abcde
  732.     .e insert 2 XXX
  733.     update
  734.     list [.e get] $contents $scrollInfo
  735. } {abXXXcde abXXXcde {0 1}}
  736. test spinbox-7.2 {InsertChars procedure} {
  737.     .e delete 0 end
  738.     .e insert 0 abcde
  739.     .e insert 500 XXX
  740.     update
  741.     list [.e get] $contents $scrollInfo
  742. } {abcdeXXX abcdeXXX {0 1}}
  743. test spinbox-7.3 {InsertChars procedure} {
  744.     .e delete 0 end
  745.     .e insert 0 0123456789
  746.     .e select from 2
  747.     .e select to 6
  748.     .e insert 2 XXX
  749.     set x "[.e index sel.first] [.e index sel.last]"
  750.     .e select to 8
  751.     lappend x [.e index sel.first] [.e index sel.last]
  752. } {5 9 5 8}
  753. test spinbox-7.4 {InsertChars procedure} {
  754.     .e delete 0 end
  755.     .e insert 0 0123456789
  756.     .e select from 2
  757.     .e select to 6
  758.     .e insert 3 XXX
  759.     set x "[.e index sel.first] [.e index sel.last]"
  760.     .e select to 8
  761.     lappend x [.e index sel.first] [.e index sel.last]
  762. } {2 9 2 8}
  763. test spinbox-7.5 {InsertChars procedure} {
  764.     .e delete 0 end
  765.     .e insert 0 0123456789
  766.     .e select from 2
  767.     .e select to 6
  768.     .e insert 5 XXX
  769.     set x "[.e index sel.first] [.e index sel.last]"
  770.     .e select to 8
  771.     lappend x [.e index sel.first] [.e index sel.last]
  772. } {2 9 2 8}
  773. test spinbox-7.6 {InsertChars procedure} {
  774.     .e delete 0 end
  775.     .e insert 0 0123456789
  776.     .e select from 2
  777.     .e select to 6
  778.     .e insert 6 XXX
  779.     set x "[.e index sel.first] [.e index sel.last]"
  780.     .e select to 5
  781.     lappend x [.e index sel.first] [.e index sel.last]
  782. } {2 6 2 5}
  783. test spinbox-7.7 {InsertChars procedure} {
  784.     .e delete 0 end
  785.     .e insert 0 0123456789
  786.     .e icursor 4
  787.     .e insert 4 XXX
  788.     .e index insert
  789. } {7}
  790. test spinbox-7.8 {InsertChars procedure} {
  791.     .e delete 0 end
  792.     .e insert 0 0123456789
  793.     .e icursor 4
  794.     .e insert 5 XXX
  795.     .e index insert
  796. } {4}
  797. test spinbox-7.9 {InsertChars procedure} {
  798.     .e delete 0 end
  799.     .e insert 0 "This is a very long string"
  800.     update
  801.     .e xview 4
  802.     .e insert 3 XXX
  803.     .e index @0
  804. } {7}
  805. test spinbox-7.10 {InsertChars procedure} {
  806.     .e delete 0 end
  807.     .e insert 0 "This is a very long string"
  808.     update
  809.     .e xview 4
  810.     .e insert 4 XXX
  811.     .e index @0
  812. } {4}
  813. .e configure -width 0
  814. test spinbox-7.11 {InsertChars procedure} {fonts} {
  815.     .e delete 0 end
  816.     .e insert 0 "xyzzy"
  817.     update
  818.     .e insert 2 00
  819.     winfo reqwidth .e
  820. } {70}
  822. .e configure -width 10
  823. test spinbox-8.1 {DeleteChars procedure} {
  824.     .e delete 0 end
  825.     .e insert 0 abcde
  826.     .e delete 2 4
  827.     update
  828.     list [.e get] $contents $scrollInfo
  829. } {abe abe {0 1}}
  830. test spinbox-8.2 {DeleteChars procedure} {
  831.     .e delete 0 end
  832.     .e insert 0 abcde
  833.     .e delete -2 2
  834.     update
  835.     list [.e get] $contents $scrollInfo
  836. } {cde cde {0 1}}
  837. test spinbox-8.3 {DeleteChars procedure} {
  838.     .e delete 0 end
  839.     .e insert 0 abcde
  840.     .e delete 3 1000
  841.     update
  842.     list [.e get] $contents $scrollInfo
  843. } {abc abc {0 1}}
  844. test spinbox-8.4 {DeleteChars procedure} {
  845.     .e delete 0 end
  846.     .e insert 0 0123456789abcde
  847.     .e select from 3
  848.     .e select to 8
  849.     .e delete 1 3
  850.     update
  851.     set x "[.e index sel.first] [.e index sel.last]"
  852.     .e select to 5
  853.     lappend x [.e index sel.first] [.e index sel.last]
  854. } {1 6 1 5}
  855. test spinbox-8.5 {DeleteChars procedure} {
  856.     .e delete 0 end
  857.     .e insert 0 0123456789abcde
  858.     .e select from 3
  859.     .e select to 8
  860.     .e delete 1 4
  861.     update
  862.     set x "[.e index sel.first] [.e index sel.last]"
  863.     .e select to 4
  864.     lappend x [.e index sel.first] [.e index sel.last]
  865. } {1 5 1 4}
  866. test spinbox-8.6 {DeleteChars procedure} {
  867.     .e delete 0 end
  868.     .e insert 0 0123456789abcde
  869.     .e select from 3
  870.     .e select to 8
  871.     .e delete 1 7
  872.     update
  873.     set x "[.e index sel.first] [.e index sel.last]"
  874.     .e select to 5
  875.     lappend x [.e index sel.first] [.e index sel.last]
  876. } {1 2 1 5}
  877. test spinbox-8.7 {DeleteChars procedure} {
  878.     .e delete 0 end
  879.     .e insert 0 0123456789abcde
  880.     .e select from 3
  881.     .e select to 8
  882.     .e delete 1 8
  883.     list [catch {.e index sel.first} msg] $msg
  884. } {1 {selection isn't in widget .e}}
  885. test spinbox-8.8 {DeleteChars procedure} {
  886.     .e delete 0 end
  887.     .e insert 0 0123456789abcde
  888.     .e select from 3
  889.     .e select to 8
  890.     .e delete 3 7
  891.     update
  892.     set x "[.e index sel.first] [.e index sel.last]"
  893.     .e select to 8
  894.     lappend x [.e index sel.first] [.e index sel.last]
  895. } {3 4 3 8}
  896. test spinbox-8.9 {DeleteChars procedure} {
  897.     .e delete 0 end
  898.     .e insert 0 0123456789abcde
  899.     .e select from 3
  900.     .e select to 8
  901.     .e delete 3 8
  902.     list [catch {.e index sel.first} msg] $msg
  903. } {1 {selection isn't in widget .e}}
  904. test spinbox-8.10 {DeleteChars procedure} {
  905.     .e delete 0 end
  906.     .e insert 0 0123456789abcde
  907.     .e select from 8
  908.     .e select to 3
  909.     .e delete 5 8
  910.     update
  911.     set x "[.e index sel.first] [.e index sel.last]"
  912.     .e select to 8
  913.     lappend x [.e index sel.first] [.e index sel.last]
  914. } {3 5 5 8}
  915. test spinbox-8.11 {DeleteChars procedure} {
  916.     .e delete 0 end
  917.     .e insert 0 0123456789abcde
  918.     .e select from 8
  919.     .e select to 3
  920.     .e delete 8 10
  921.     update
  922.     set x "[.e index sel.first] [.e index sel.last]"
  923.     .e select to 4
  924.     lappend x [.e index sel.first] [.e index sel.last]
  925. } {3 8 4 8}
  926. test spinbox-8.12 {DeleteChars procedure} {
  927.     .e delete 0 end
  928.     .e insert 0 0123456789abcde
  929.     .e icursor 4
  930.     .e delete 1 4
  931.     .e index insert
  932. } {1}
  933. test spinbox-8.13 {DeleteChars procedure} {
  934.     .e delete 0 end
  935.     .e insert 0 0123456789abcde
  936.     .e icursor 4
  937.     .e delete 1 5
  938.     .e index insert
  939. } {1}
  940. test spinbox-8.14 {DeleteChars procedure} {
  941.     .e delete 0 end
  942.     .e insert 0 0123456789abcde
  943.     .e icursor 4
  944.     .e delete 4 6
  945.     .e index insert
  946. } {4}
  947. test spinbox-8.15 {DeleteChars procedure} {
  948.     .e delete 0 end
  949.     .e insert 0 "This is a very long string"
  950.     .e xview 4
  951.     .e delete 1 4
  952.     .e index @0
  953. } {1}
  954. test spinbox-8.16 {DeleteChars procedure} {
  955.     .e delete 0 end
  956.     .e insert 0 "This is a very long string"
  957.     .e xview 4
  958.     .e delete 1 5
  959.     .e index @0
  960. } {1}
  961. test spinbox-8.17 {DeleteChars procedure} {
  962.     .e delete 0 end
  963.     .e insert 0 "This is a very long string"
  964.     .e xview 4
  965.     .e delete 4 6
  966.     .e index @0
  967. } {4}
  968. .e configure -width 0
  969. test spinbox-8.18 {DeleteChars procedure} {fonts} {
  970.     .e delete 0 end
  971.     .e insert 0 "xyzzy"
  972.     update
  973.     .e delete 2 4
  974.     winfo reqwidth .e
  975. } {42}
  977. test spinbox-9.1 {SpinboxValueChanged procedure} {
  978.     catch {destroy .e}
  979.     proc override args {
  980. global x
  981. set x 12345
  982.     }
  983.     catch {unset x}
  984.     trace variable x w override
  985.     spinbox .e -textvariable x
  986.     .e insert 0 foo
  987.     set result [list $x [.e get]]
  988.     unset x; rename override {}
  989.     set result
  990. } {12345 12345}
  992. catch {destroy .e}
  993. spinbox .e
  994. pack .e
  995. .e configure -width 0
  996. test spinbox-10.1 {SpinboxSetValue procedure} {fonts} {
  997.     set x abcde
  998.     set y ab
  999.     .e configure -textvariable x
  1000.     update
  1001.     .e configure -textvariable y
  1002.     update
  1003.     list [.e get] [winfo reqwidth .e]
  1004. } {ab 35}
  1005. test spinbox-10.2 {SpinboxSetValue procedure, updating selection} {
  1006.     catch {destroy .e}
  1007.     spinbox .e -textvariable x
  1008.     .e insert 0 "abcdefghjklmnopqrstu"
  1009.     .e selection range 4 10
  1010.     set x "a"
  1011.     list [catch {.e index sel.first} msg] $msg
  1012. } {1 {selection isn't in widget .e}}
  1013. test spinbox-10.3 {SpinboxSetValue procedure, updating selection} {
  1014.     catch {destroy .e}
  1015.     spinbox .e -textvariable x
  1016.     .e insert 0 "abcdefghjklmnopqrstu"
  1017.     .e selection range 4 10
  1018.     set x "abcdefg"
  1019.     list [.e index sel.first] [.e index sel.last]
  1020. } {4 7}
  1021. test spinbox-10.4 {SpinboxSetValue procedure, updating selection} {
  1022.     catch {destroy .e}
  1023.     spinbox .e -textvariable x
  1024.     .e insert 0 "abcdefghjklmnopqrstu"
  1025.     .e selection range 4 10
  1026.     set x "abcdefghijklmn"
  1027.     list [.e index sel.first] [.e index sel.last]
  1028. } {4 10}
  1029. test spinbox-10.5 {SpinboxSetValue procedure, updating display position} {
  1030.     catch {destroy .e}
  1031.     spinbox .e -width 10 -font $fixed -textvariable x
  1032.     pack .e
  1033.     .e insert 0 "abcdefghjklmnopqrstuvwxyz"
  1034.     .e xview 10
  1035.     update
  1036.     set x "abcdefg"
  1037.     update
  1038.     .e index @0
  1039. } {0}
  1040. test spinbox-10.6 {SpinboxSetValue procedure, updating display position} {
  1041.     catch {destroy .e}
  1042.     spinbox .e -width 10 -font $fixed -textvariable x
  1043.     pack .e
  1044.     .e insert 0 "abcdefghjklmnopqrstuvwxyz"
  1045.     .e xview 10
  1046.     update
  1047.     set x "1234567890123456789012"
  1048.     update
  1049.     .e index @0
  1050. } {10}
  1051. test spinbox-10.7 {SpinboxSetValue procedure, updating insertion cursor} {
  1052.     catch {destroy .e}
  1053.     spinbox .e -width 10 -font $fixed -textvariable x
  1054.     pack .e
  1055.     .e insert 0 "abcdefghjklmnopqrstuvwxyz"
  1056.     .e icursor 5
  1057.     set x "123"
  1058.     .e index insert
  1059. } {3}
  1060. test spinbox-10.8 {SpinboxSetValue procedure, updating insertion cursor} {
  1061.     catch {destroy .e}
  1062.     spinbox .e -width 10 -font $fixed -textvariable x
  1063.     pack .e
  1064.     .e insert 0 "abcdefghjklmnopqrstuvwxyz"
  1065.     .e icursor 5
  1066.     set x "123456"
  1067.     .e index insert
  1068. } {5}
  1070. test spinbox-11.1 {SpinboxEventProc procedure} {
  1071.     catch {destroy .e}
  1072.     spinbox .e
  1073.     .e insert 0 abcdefg
  1074.     destroy .e
  1075.     update
  1076. } {}
  1077. test spinbox-11.2 {SpinboxEventProc procedure} {
  1078.     deleteWindows
  1079.     spinbox .e1 -fg #112233
  1080.     rename .e1 .e2
  1081.     set x {}
  1082.     lappend x [winfo children .]
  1083.     lappend x [.e2 cget -fg]
  1084.     destroy .e1
  1085.     lappend x [info command .e*] [winfo children .]
  1086. } {.e1 #112233 {} {}}
  1088. test spinbox-12.1 {SpinboxCmdDeletedProc procedure} {
  1089.     deleteWindows
  1090.     button .e1 -text "xyz_123"
  1091.     rename .e1 {}
  1092.     list [info command .e*] [winfo children .]
  1093. } {{} {}}
  1095. catch {destroy .e}
  1096. spinbox .e -font $fixed -width 5 -bd 2 -relief sunken
  1097. pack .e
  1098. .e insert 0 012345678901234567890
  1099. .e xview 4
  1100. update
  1101. test spinbox-13.1 {GetSpinboxIndex procedure} {
  1102.     .e index end
  1103. } {21}
  1104. test spinbox-13.2 {GetSpinboxIndex procedure} {
  1105.     list [catch {.e index abogus} msg] $msg
  1106. } {1 {bad spinbox index "abogus"}}
  1107. test spinbox-13.3 {GetSpinboxIndex procedure} {
  1108.     .e select from 1
  1109.     .e select to 6
  1110.     .e index anchor
  1111. } {1}
  1112. test spinbox-13.4 {GetSpinboxIndex procedure} {
  1113.     .e select from 4
  1114.     .e select to 1
  1115.     .e index anchor
  1116. } {4}
  1117. test spinbox-13.5 {GetSpinboxIndex procedure} {
  1118.     .e select from 3
  1119.     .e select to 15
  1120.     .e select adjust 4
  1121.     .e index anchor
  1122. } {15}
  1123. test spinbox-13.6 {GetSpinboxIndex procedure} {
  1124.     list [catch {.e index ebogus} msg] $msg
  1125. } {1 {bad spinbox index "ebogus"}}
  1126. test spinbox-13.7 {GetSpinboxIndex procedure} {
  1127.     .e icursor 2
  1128.     .e index insert
  1129. } {2}
  1130. test spinbox-13.8 {GetSpinboxIndex procedure} {
  1131.     list [catch {.e index ibogus} msg] $msg
  1132. } {1 {bad spinbox index "ibogus"}}
  1133. test spinbox-13.9 {GetSpinboxIndex procedure} {
  1134.     .e select from 1
  1135.     .e select to 6
  1136.     list [.e index sel.first] [.e index sel.last]
  1137. } {1 6}
  1138. selection clear .e
  1139. test spinbox-13.10 {GetSpinboxIndex procedure} {unixOnly} {
  1140.     # On unix, when selection is cleared, spinbox widget's internal 
  1141.     # selection range is reset.
  1143.     list [catch {.e index sel.first} msg] $msg
  1144. } {1 {selection isn't in widget .e}}
  1145. test spinbox-13.11 {GetSpinboxIndex procedure} {macOrPc} {
  1146.     # On mac and pc, when selection is cleared, spinbox widget remembers
  1147.     # last selected range.  When selection ownership is restored to 
  1148.     # spinbox, the old range will be rehighlighted.
  1150.     list [catch {selection get}] [.e index sel.first]
  1151. } {1 1}
  1152. test spinbox-13.12 {GetSpinboxIndex procedure} {unixOnly} {
  1153.     list [catch {.e index sbogus} msg] $msg
  1154. } {1 {selection isn't in widget .e}}
  1155. test spinbox-13.13 {GetSpinboxIndex procedure} {macOrPc} {
  1156.     list [catch {.e index sbogus} msg] $msg
  1157. } {1 {bad spinbox index "sbogus"}}
  1158. test spinbox-13.14 {GetSpinboxIndex procedure} {macOrPc} {
  1159.     list [catch {selection get}] [catch {.e index sbogus}]
  1160. } {1 1}
  1161. test spinbox-13.15 {GetSpinboxIndex procedure} {
  1162.     list [catch {.e index @xyz} msg] $msg
  1163. } {1 {bad spinbox index "@xyz"}}
  1164. test spinbox-13.16 {GetSpinboxIndex procedure} {fonts} {
  1165.     .e index @4
  1166. } {4}
  1167. test spinbox-13.17 {GetSpinboxIndex procedure} {fonts} {
  1168.     .e index @11
  1169. } {4}
  1170. test spinbox-13.18 {GetSpinboxIndex procedure} {fonts} {
  1171.     .e index @12
  1172. } {5}
  1173. test spinbox-13.19 {GetSpinboxIndex procedure} {fonts} {
  1174.     # 11 is the minimum button width
  1175.     .e index @[expr [winfo width .e] - 6 - 11]
  1176. } {8}
  1177. test spinbox-13.20 {GetSpinboxIndex procedure} {fonts} {
  1178.     .e index @[expr [winfo width .e] - 5]
  1179. } {9}
  1180. test spinbox-13.21 {GetSpinboxIndex procedure} {
  1181.     .e index @1000
  1182. } {9}
  1183. test spinbox-13.22 {GetSpinboxIndex procedure} {
  1184.     list [catch {.e index 1xyz} msg] $msg
  1185. } {1 {bad spinbox index "1xyz"}}
  1186. test spinbox-13.23 {GetSpinboxIndex procedure} {
  1187.     .e index -10
  1188. } {0}
  1189. test spinbox-13.24 {GetSpinboxIndex procedure} {
  1190.     .e index 12
  1191. } {12}
  1192. test spinbox-13.25 {GetSpinboxIndex procedure} {
  1193.     .e index 49
  1194. } {21}
  1196. # XXX Still need to write tests for SpinboxScanTo and SpinboxSelectTo.
  1198. set x {}
  1199. for {set i 1} {$i <= 500} {incr i} {
  1200.     append x "This is line $i, out of 500n"
  1201. }
  1202. test spinbox-14.1 {SpinboxFetchSelection procedure} {
  1203.     catch {destroy .e}
  1204.     spinbox .e
  1205.     .e insert end "This is a test string"
  1206.     .e select from 1
  1207.     .e select to 18
  1208.     selection get
  1209. } {his is a test str}
  1210. test spinbox-14.3 {SpinboxFetchSelection procedure} {
  1211.     catch {destroy .e}
  1212.     spinbox .e
  1213.     .e insert end $x
  1214.     .e select from 0
  1215.     .e select to end
  1216.     string compare [selection get] $x
  1217. } 0
  1219. test spinbox-15.1 {SpinboxLostSelection} {
  1220.     catch {destroy .e}
  1221.     spinbox .e
  1222.     .e insert 0 "Text"
  1223.     .e select from 0
  1224.     .e select to 4
  1225.     set result [selection get]
  1226.     selection clear
  1227.     .e select from 0
  1228.     .e select to 4
  1229.     lappend result [selection get]
  1230. } {Text Text}
  1232. # No tests for EventuallyRedraw.
  1234. catch {destroy .e}
  1235. spinbox .e -width 10 -xscrollcommand scroll
  1236. pack .e
  1237. update
  1239. test spinbox-16.1 {SpinboxVisibleRange procedure} {fonts} {
  1240.     .e delete 0 end
  1241.     .e insert 0 .............................
  1242.     .e xview
  1243. } {0 0.827586}
  1244. test spinbox-15.4 {SpinboxVisibleRange procedure} {
  1245.     .e delete 0 end
  1246.     .e xview
  1247. } {0 1}
  1249. catch {destroy .e}
  1250. spinbox .e -width 10 -xscrollcommand scroll -font $fixed
  1251. pack .e
  1252. update
  1253. test spinbox-17.1 {SpinboxUpdateScrollbar procedure} {
  1254.     .e delete 0 end
  1255.     .e insert 0 123
  1256.     update
  1257.     set scrollInfo
  1258. } {0 1}
  1259. test spinbox-17.2 {SpinboxUpdateScrollbar procedure} {
  1260.     .e delete 0 end
  1261.     .e insert 0 0123456789abcdef
  1262.     .e xview 3
  1263.     update
  1264.     set scrollInfo
  1265. } {0.1875 0.8125}
  1266. test spinbox-17.3 {SpinboxUpdateScrollbar procedure} {
  1267.     .e delete 0 end
  1268.     .e insert 0 abcdefghijklmnopqrs
  1269.     .e xview 6
  1270.     update
  1271.     set scrollInfo
  1272. } {0.315789 0.842105}
  1273. test spinbox-17.4 {SpinboxUpdateScrollbar procedure} {
  1274.     destroy .e
  1275.     set x "Background error did not happen"
  1276.     proc bgerror msg {
  1277. global x
  1278. set x $msg
  1279.     }
  1280.     spinbox .e -width 5 -xscrollcommand thisisnotacommand
  1281.     pack .e
  1282.     update
  1283.     rename bgerror {}
  1284.     list $x $errorInfo
  1285. } {{invalid command name "thisisnotacommand"} {invalid command name "thisisnotacommand"
  1286.     while executing
  1287. "thisisnotacommand 0 1"
  1288.     (horizontal scrolling command executed by .e)}}
  1290. set l [interp hidden]
  1291. deleteWindows
  1293. test spinbox-18.1 {Spinbox widget vs hiding} {
  1294.     destroy .e
  1295.     spinbox .e
  1296.     interp hide {} .e
  1297.     destroy .e
  1298.     list [winfo children .] [interp hidden]
  1299. } [list {} $l]    
  1301. ##
  1302. ## Spinbox widget VALIDATION tests
  1303. ##
  1305. destroy .e
  1306. catch {unset ::e}
  1307. catch {unset ::vVals}
  1308. spinbox .e -validate all 
  1309. -validatecommand [list doval %W %d %i %P %s %S %v %V] 
  1310. -invalidcommand bell 
  1311. -textvariable ::e 
  1312. -background red -foreground white
  1313. pack .e
  1314. proc doval {W d i P s S v V} {
  1315.     set ::vVals [list $W $d $i $P $s $S $v $V]
  1316.     return 1
  1317. }
  1319. # The validation tests build each one upon the previous, so cascading
  1320. # failures aren't good
  1321. #
  1322. test spinbox-19.1 {spinbox widget validation} {
  1323.     .e insert 0 a
  1324.     set ::vVals
  1325. } {.e 1 0 a {} a all key}
  1326. test spinbox-19.2 {spinbox widget validation} {
  1327.     .e insert 1 b
  1328.     set ::vVals
  1329. } {.e 1 1 ab a b all key}
  1330. test spinbox-19.3 {spinbox widget validation} {
  1331.     .e insert end c
  1332.     set ::vVals
  1333. } {.e 1 2 abc ab c all key}
  1334. test spinbox-19.4 {spinbox widget validation} {
  1335.     .e insert 1 123
  1336.     list $::vVals $::e
  1337. } {{.e 1 1 a123bc abc 123 all key} a123bc}
  1338. test spinbox-19.5 {spinbox widget validation} {
  1339.     .e delete 2
  1340.     set ::vVals
  1341. } {.e 0 2 a13bc a123bc 2 all key}
  1342. test spinbox-19.6 {spinbox widget validation} {
  1343.     .e configure -validate key
  1344.     .e delete 1 3
  1345.     set ::vVals
  1346. } {.e 0 1 abc a13bc 13 key key}
  1347. test spinbox-19.7 {spinbox widget validation} {
  1348.     set ::vVals {}
  1349.     .e configure -validate focus
  1350.     .e insert end d
  1351.     set ::vVals
  1352. } {}
  1353. test spinbox-19.8 {spinbox widget validation} {
  1354.     focus -force .e
  1355.     # update necessary to process FocusIn event
  1356.     update
  1357.     set ::vVals
  1358. } {.e -1 -1 abcd abcd {} focus focusin}
  1359. test spinbox-19.9 {spinbox widget validation} {
  1360.     focus -force .
  1361.     # update necessary to process FocusOut event
  1362.     update
  1363.     set ::vVals
  1364. } {.e -1 -1 abcd abcd {} focus focusout}
  1365. .e configure -validate all
  1366. test spinbox-19.10 {spinbox widget validation} {
  1367.     focus -force .e
  1368.     # update necessary to process FocusIn event
  1369.     update
  1370.     set ::vVals
  1371. } {.e -1 -1 abcd abcd {} all focusin}
  1372. test spinbox-19.11 {spinbox widget validation} {
  1373.     focus -force .
  1374.     # update necessary to process FocusOut event
  1375.     update
  1376.     set ::vVals
  1377. } {.e -1 -1 abcd abcd {} all focusout}
  1378. .e configure -validate focusin
  1379. test spinbox-19.12 {spinbox widget validation} {
  1380.     focus -force .e
  1381.     # update necessary to process FocusIn event
  1382.     update
  1383.     set ::vVals
  1384. } {.e -1 -1 abcd abcd {} focusin focusin}
  1385. test spinbox-19.13 {spinbox widget validation} {
  1386.     set ::vVals {}
  1387.     focus -force .
  1388.     # update necessary to process FocusOut event
  1389.     update
  1390.     set ::vVals
  1391. } {}
  1392. .e configure -validate focuso
  1393. test spinbox-19.14 {spinbox widget validation} {
  1394.     focus -force .e
  1395.     # update necessary to process FocusIn event
  1396.     update
  1397.     set ::vVals
  1398. } {}
  1399. test spinbox-19.15 {spinbox widget validation} {
  1400.     focus -force .
  1401.     # update necessary to process FocusOut event
  1402.     update
  1403.     set ::vVals
  1404. } {.e -1 -1 abcd abcd {} focusout focusout}
  1405. test spinbox-19.16 {spinbox widget validation} {
  1406.     list [.e validate] $::vVals
  1407. } {1 {.e -1 -1 abcd abcd {} all forced}}
  1408. test spinbox-19.17 {spinbox widget validation} {
  1409.     set ::e newdata
  1410.     list [.e cget -validate] $::vVals
  1411. } {focusout {.e -1 -1 newdata abcd {} focusout forced}}
  1413. proc doval {W d i P s S v V} {
  1414.     set ::vVals [list $W $d $i $P $s $S $v $V]
  1415.     return 0
  1416. }
  1417. .e configure -validate all
  1419. test spinbox-19.18 {spinbox widget validation} {
  1420.     set ::e nextdata
  1421.     list [.e cget -validate] $::vVals
  1422. } {none {.e -1 -1 nextdata newdata {} all forced}}
  1424. proc doval {W d i P s S v V} {
  1425.     set ::vVals [list $W $d $i $P $s $S $v $V]
  1426.     set ::e mydata
  1427.     return 1
  1428. }
  1429. .e configure -validate all
  1431. ## This sets validate to none because it shows that we prevent a possible
  1432. ## loop condition in the validation, when the spinbox textvar is also set
  1433. test spinbox-19.19 {spinbox widget validation} {
  1434.     .e validate
  1435.     list [.e cget -validate] [.e get] $::vVals
  1436. } {none mydata {.e -1 -1 nextdata nextdata {} all forced}}
  1438. .e configure -validate all
  1440. ## This leaves validate alone because we trigger validation through the
  1441. ## textvar (a write trace), and the write during validation triggers
  1442. ## nothing (by definition of avoiding loops on var traces).  This is
  1443. ## one of those "dangerous" conditions where the user will have a
  1444. ## different value in the spinbox widget shown as is in the textvar.
  1445. test spinbox-19.20 {spinbox widget validation} {
  1446.     set ::e testdata
  1447.     list [.e cget -validate] [.e get] $::e $::vVals
  1448. } {all testdata mydata {.e -1 -1 testdata mydata {} all forced}}
  1450. # A format specifier is allowed to be of the form %[-+ 0]{0,1}d.?d?f
  1451. #
  1452. destroy .e
  1453. spinbox .e
  1454. test spinbox-20.1 {spinbox config, -format specifier} {
  1455.     list [catch {.e config -format %2f} msg] $msg
  1456. } {0 {}}
  1457. test spinbox-20.2 {spinbox config, -format specifier} {
  1458.     list [catch {.e config -format %2.2f} msg] $msg
  1459. } {0 {}}
  1460. test spinbox-20.3 {spinbox config, -format specifier} {
  1461.     list [catch {.e config -format %.2f} msg] $msg
  1462. } {0 {}}
  1463. test spinbox-20.4 {spinbox config, -format specifier} {
  1464.     list [catch {.e config -format %2.f} msg] $msg
  1465. } {0 {}}
  1466. test spinbox-20.5 {spinbox config, -format specifier} {
  1467.     list [catch {.e config -format %2e-1f} msg] $msg
  1468. } {1 {bad spinbox format specifier "%2e-1f"}}
  1469. test spinbox-20.6 {spinbox config, -format specifier} {
  1470.     list [catch {.e config -format 2.2} msg] $msg
  1471. } {1 {bad spinbox format specifier "2.2"}}
  1472. test spinbox-20.7 {spinbox config, -format specifier} {
  1473.     list [catch {.e config -format %2.-2f} msg] $msg
  1474. } {1 {bad spinbox format specifier "%2.-2f"}}
  1475. test spinbox-20.8 {spinbox config, -format specifier} {
  1476.     list [catch {.e config -format %-2.02f} msg] $msg
  1477. } {0 {}}
  1478. test spinbox-20.9 {spinbox config, -format specifier} {
  1479.     list [catch {.e config -format "% 2.02f"} msg] $msg
  1480. } {0 {}}
  1481. test spinbox-20.10 {spinbox config, -format specifier} {
  1482.     list [catch {.e config -format "% -2.200f"} msg] $msg
  1483. } {0 {}}
  1484. test spinbox-20.11 {spinbox config, -format specifier} {
  1485.     list [catch {.e config -format "%09.200f"} msg] $msg
  1486. } {0 {}}
  1487. test spinbox-20.12 {spinbox config, -format specifier does something} {
  1488.     set out {}
  1489.     .e config -format "%02.f"
  1490.     .e config -values {} -from 0 -to 10 -increment 1
  1491.     lappend out [.e set 0]; # set currently doesn't force format
  1492.     .e invoke buttonup
  1493.     lappend out [.e set]; # but after invoke it should be formatted
  1494.     lappend out [.e set 3]; # set currently doesn't force format
  1495.     .e config -format "%03.f"
  1496.     lappend out [.e set]; # changing -format should cause formatting
  1497. } {0 01 3 003}
  1499. test spinbox-21.1 {spinbox button, out of range checking} {
  1500.     destroy .e
  1501.     spinbox .e -from -10 -to 20 -increment 2
  1502.     set out {}
  1503.     lappend out [.e get]; # -10
  1504.     .e delete 0 end
  1505.     .e insert 0 25; # set outside of range
  1506.     .e invoke buttondown; # should constrain
  1507.     lappend out [.e get]; # 20
  1508.     .e delete 0 end
  1509.     .e insert 0 25; # set outside of range
  1510.     .e invoke buttonup; # should constrain
  1511.     lappend out [.e get]; # 20
  1512.     .e delete 0 end
  1513.     .e insert 0 -100; # set outside of range
  1514.     .e invoke buttonup; # should constrain
  1515.     lappend out [.e get]; # -10
  1516.     .e delete 0 end
  1517.     .e insert 0 -100; # set outside of range
  1518.     .e invoke buttondown; # should constrain
  1519.     lappend out [.e get]; # -10
  1520.     .e delete 0 end
  1521.     .e insert 0 bogus; # set to a bogus value
  1522.     .e invoke buttondown; # should use fromValue
  1523.     lappend out [.e get]; # -10
  1524.     .e delete 0 end
  1525.     .e insert 0 19; # set just inside of range
  1526.     .e invoke buttonup; # no wrap
  1527.     lappend out [.e get]; # 20
  1528.     .e invoke buttonup; # no wrap
  1529.     lappend out [.e get]; # 20
  1530.     .e invoke buttondown
  1531.     lappend out [.e get]; # 18
  1532.     .e delete 0 end
  1533.     .e insert 0 -9; # set just inside of range
  1534.     .e invoke buttondown; # no wrap
  1535.     lappend out [.e get]; # -10
  1536.     .e invoke buttondown; # no wrap
  1537.     lappend out [.e get]; # -10
  1538.     .e invoke buttonup; # no wrap
  1539.     lappend out [.e get]; # -8
  1541.     .e configure -wrap 1
  1542.     .e delete 0 end
  1543.     .e insert 0 19; # set just inside of range
  1544.     .e invoke buttonup; # wrap
  1545.     lappend out [.e get]; # -10
  1546.     .e invoke buttonup
  1547.     lappend out [.e get]; # -8
  1548.     .e invoke buttondown
  1549.     lappend out [.e get]; # -10
  1550.     .e delete 0 end
  1551.     .e insert 0 -9; # set just inside of range
  1552.     .e invoke buttondown; # wrap
  1553.     lappend out [.e get]; # 20
  1554.     .e invoke buttondown
  1555.     lappend out [.e get]; # 18
  1556.     .e invoke buttonup; # no wrap
  1557.     lappend out [.e get]; # 20
  1559. } {-10 20 20 -10 -10 -10 20 20 18 -10 -10 -8 -10 -8 -10 20 18 20}
  1561. test spinbox-22.1 {spinbox config, -from changes SF bug 559078} {
  1562.     set val 5
  1563.     destroy .s
  1564.     spinbox .s -from 1 -to 10 -textvariable val
  1565.     set val
  1566. } {5}
  1567. test spinbox-22.2 {spinbox config, -from changes SF bug 559078} {
  1568.     .s configure -from 3 -to 10
  1569.     set val
  1570. } {5}
  1571. test spinbox-22.3 {spinbox config, -from changes SF bug 559078} {
  1572.     .s configure -from 6 -to 10
  1573.     set val
  1574. } {6}
  1576. test entry-23.1 {selection present while disabled, bug 637828} {
  1577.     destroy .e
  1578.     entry .e
  1579.     .e insert end 0123456789
  1580.     .e select from 3
  1581.     .e select to 6
  1582.     set out [.e selection present]
  1583.     .e configure -state disabled
  1584.     # still return 1 when disabled, because 'selection get' will work,
  1585.     # but selection cannot be changed (new behavior since 8.4)
  1586.     .e select to 9
  1587.     lappend out [.e selection present] [selection get]
  1588. } {1 1 345}
  1590. destroy .e
  1591. catch {unset ::e ::vVals}
  1593. ##
  1594. ## End validation tests
  1595. ##
  1597. # XXX Still need to write tests for SpinboxBlinkProc, SpinboxFocusProc,
  1598. # and SpinboxTextVarProc.
  1600. option clear
  1602. # cleanup
  1603. ::tcltest::cleanupTests
  1604. return