summaryrefslogtreecommitdiffstats
path: root/tests/clrpick.test
diff options
context:
space:
mode:
authorandreask <andreask>2013-01-22 19:30:43 (GMT)
committerandreask <andreask>2013-01-22 19:30:43 (GMT)
commit48c9fcb7281cc6aa076113db874c7ae0e105795d (patch)
tree7187940ff056462bfa41705a2ce04d0ed07d424e /tests/clrpick.test
parent41f5d19540b0b3f053da352e1569c9a4ed019dd5 (diff)
downloadtk-contrib_patrick_fradin_code_cleanup.zip
tk-contrib_patrick_fradin_code_cleanup.tar.gz
tk-contrib_patrick_fradin_code_cleanup.tar.bz2
Contribution by Patrick Fradin <patrick.fradin@planar.com>contrib_patrick_fradin_code_cleanup
Quoting his mail: <pre> ========================================================== Hi Jeff, I spent some of my time to contribute to the TclTk community ! I'm in late for Christmas gift but like we said in French : "Mieux vaut tard que jamais". ;-) I've use TclDevKit 5.3.0 tclchecker to analyse TclTk code in Tcl and Tk library directories (library, tools and tests) to correct a lot of warnings and few errors. (encapsulate some expr, use 'chan xxx' instead of fconfigure, fileevent...) I've made some improvements too : Examples : - Use 'lassign' instead of many 'lindex' of 'foreach/break' loop. - Use 'in' or 'ni' operators instead of 'lsearch -exact' or to factorise some eq/ne && / || tests. - Use 'eq' or 'ne' to tests strings instead of '==' or '!='. - Use 'unset -nocomplain' to avoid 'catch {unset...}'. - Remove some useless catch around 'destroy' calls. - Use expand {*} instead of 'eval'. Don't touch a lot of code because I don't know all structs and lists. I think it could be a greater improvement to reduce 'eval' calls. Due to previous experience, I dot not change any indentation ! ;-) ========================================================== </pre>
Diffstat (limited to 'tests/clrpick.test')
-rw-r--r--tests/clrpick.test40
1 files changed, 18 insertions, 22 deletions
diff --git a/tests/clrpick.test b/tests/clrpick.test
index 5f1b8b5..2a2c9f7 100644
--- a/tests/clrpick.test
+++ b/tests/clrpick.test
@@ -19,20 +19,20 @@ if {[testConstraint defaultPseudocolor8]} {
set i 0
canvas .c
pack .c -expand 1 -fill both
- while {$i<$numcolors} {
- set color \#[format "%02x%02x%02x" $i [expr $i+1] [expr $i+3]]
- .c create rectangle [expr 10+$i] [expr 10+$i] [expr 50+$i] [expr 50+$i] -fill $color -outline $color
+ while {$i < $numcolors} {
+ set color [format "#%02x%02x%02x" $i [expr {$i + 1}] [expr {$i + 3}]]
+ .c create rectangle [expr {10 + $i}] [expr {10 + $i}] [expr {50 + $i}] [expr {50 + $i}] -fill $color -outline $color
incr i
}
set i 0
- while {$i<$numcolors} {
+ while {$i < $numcolors} {
set color [.c itemcget $i -fill]
- if {$color != ""} {
- foreach {r g b} [winfo rgb . $color] {}
- set r [expr $r/256]
- set g [expr $g/256]
- set b [expr $b/256]
- if {"$color" != "#[format %02x%02x%02x $r $g $b]"} {
+ if {$color ne ""} {
+ lassign [winfo rgb . $color] r g b
+ set r [expr {$r / 256}]
+ set g [expr {$g / 256}]
+ set b [expr {$b / 256}]
+ if {"$color" ne [format "#%02x%02x%02x" $r $g $b]} {
testConstraint colorsLeftover 0
}
}
@@ -103,7 +103,7 @@ proc PressButton {btn} {
proc ChooseColorByKey {parent r g b} {
set w .__tk__color
- upvar ::tk::dialog::color::[winfo name $w] data
+ upvar 1 ::tk::dialog::color::[winfo name $w] data
update
$data(red,entry) delete 0 end
@@ -124,14 +124,14 @@ proc ChooseColorByKey {parent r g b} {
proc SendButtonPress {parent btn type} {
set w .__tk__color
- upvar ::tk::dialog::color::[winfo name $w] data
+ upvar 1 ::tk::dialog::color::[winfo name $w] data
set button $data($btn\Btn)
- if ![winfo ismapped $button] {
+ if {![winfo ismapped $button]} {
update
}
- if {$type == "mouse"} {
+ if {$type eq "mouse"} {
PressButton $button
} else {
event generate $w <Enter>
@@ -141,8 +141,6 @@ proc SendButtonPress {parent btn type} {
}
}
-
-
test clrpick-2.1 {tk_chooseColor command} -constraints {
nonUnixUserInteraction colorsLeftover
} -setup {
@@ -163,20 +161,20 @@ test clrpick-2.1 {tk_chooseColor command} -constraints {
ToPressButton . ok
tk_chooseColor -title "Press Ok $verylongstring" -initialcolor #404040 \
-parent .
-} -result {#404040}
+} -result "#404040"
test clrpick-2.2 {tk_chooseColor command} -constraints {
nonUnixUserInteraction colorsLeftover
} -body {
set colors "128 128 64"
ToChooseColorByKey . 128 128 64
tk_chooseColor -parent . -title "choose #808040"
-} -result {#808040}
+} -result "#808040"
test clrpick-2.3 {tk_chooseColor command} -constraints {
nonUnixUserInteraction colorsLeftover
} -body {
ToPressButton . ok
tk_chooseColor -parent . -title "Press OK"
-} -result {#808040}
+} -result "#808040"
test clrpick-2.4 {tk_chooseColor command} -constraints {
nonUnixUserInteraction colorsLeftover
} -body {
@@ -184,14 +182,13 @@ test clrpick-2.4 {tk_chooseColor command} -constraints {
tk_chooseColor -parent . -title "Press Cancel"
} -result {}
-
test clrpick-3.1 {tk_chooseColor: background events} -constraints {
nonUnixUserInteraction
} -body {
after 1 {set x 53}
ToPressButton . ok
tk_chooseColor -parent . -title "Press OK" -initialcolor #000000
-} -result {#000000}
+} -result "#000000"
test clrpick-3.2 {tk_chooseColor: background events} -constraints {
nonUnixUserInteraction
} -body {
@@ -200,7 +197,6 @@ test clrpick-3.2 {tk_chooseColor: background events} -constraints {
tk_chooseColor -parent . -title "Press Cancel"
} -result {}
-
test clrpick-4.1 {tk_chooseColor: screen is inherited from parent} -constraints {
unix notAqua
} -body {