[Richard Suchenwirth] 2005-12-19 - As an example for custom control structures in [Tcl], here is a range-aware lookalike to [switch]. A range (numeric or strings) can be given as ''from..to'', and the associated scriptlet gets executed if the tested value lies inside that range. Like in [switch], fall-through collapsing of several cases is indicated by "-", and "default" as final condition fires if none else did. Different from [switch], numbers are compared by numeric value, no matter whether given as decimal, octal or hex.
----

 proc rswitch {value body} {
   set go 0
   foreach {cond script} $body {
      if {[regexp {(.+)\.\.(.+)} $cond -> from to]} {
           if {$value >= $from && $value <= $to} {incr go}
      } else {
          if {$value == $cond} {incr go}
      }
      if {$go && $script ne "-"} { #(2)
          uplevel 1 $script
          break
      }
   }
   if {$cond eq "default" && !$go} {uplevel 1 $script} ;#(1)
 }

Testing:
 % foreach i {0 1 2 3 4 5 6 7 8} {puts $i;rswitch $i {1 {puts yes} 2..5 {puts maybe} 6..8 {puts no}}}
 0
 1
 yes
 2
 maybe
 3
 maybe
 4
 maybe
 5
 maybe
 6
 no
 7
 no
 8
 no
Due to polymorphic comparison (numeric or string), this also works:^)
 % foreach i {A K c z 0 7} {
   puts $i;rswitch $i {A..Z {puts upper} a..z {puts lower} 0..9 {puts digit}}
 }
 A
 upper
 K
 upper
 c
 lower
 z
 lower
 0
 digit
 7
 digit
 % rswitch 0x2A {42 {puts magic} default {puts df}}
 magic

* Ok, that's useful stuff.. but what about multi-digit numbers? -- Sy / jrandomhacker.info
e.g., using:

 rswitch 100 {A..Z {echo upper} a..z {echo lower} 0..999 {echo digit}}
[RS] Yup, my bug. ".." in regular expressions match any char, so the original version
      if {[regexp (.+)..(.+) $cond -> from to]} {
was over-eager - in 0..99, it matched "0." as ''from'', and "9" as ''to''. Fixed above, so multi-digit numbers work (and added a line for ''default'' treatment at #(1)). Another enhancement at #(2) is fall-through treatment (a - b - c ...} just like in [switch]. Thanks for testing! 

[JAK] Try this version to allow the secondary switch syntax:

 proc rswitch {value args} {
   set go 0
   if {[llength $args] == 1 } {
	set body [concat $args]
   } else {
	set body [list $args]
   }
   foreach {cond script} [join $body] {
     if {[regexp {(.+)\.\.(.+)} $cond -> from to]} {
           if {$value >= $from && $value <= $to} {incr go}
      } else {
          if {$value == $cond} {incr go}
      }
      if {$go && $script ne "-"} { #(2)
          uplevel 1 $script
          break
      }
   }
   if {$cond eq "default" && !$go} {uplevel 1 $script} ;#(1)
 }


----
[Arts and crafts of Tcl-Tk programming] | [Category Control Structure]