diff options
| author | andreask <andreask> | 2013-01-22 19:30:43 (GMT) |
|---|---|---|
| committer | andreask <andreask> | 2013-01-22 19:30:43 (GMT) |
| commit | 48c9fcb7281cc6aa076113db874c7ae0e105795d (patch) | |
| tree | 7187940ff056462bfa41705a2ce04d0ed07d424e /tests/clrpick.test | |
| parent | 41f5d19540b0b3f053da352e1569c9a4ed019dd5 (diff) | |
| download | tk-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.test | 40 |
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 { |
