In case of: select, another switch

I needed a switch command with variables in place of constants Here is the result. I added list of values in place of one value, and expression. I used case, CASE and default to name the needed internal procs.

syntax is:

       select value { 
          case list_of_values script
          ...  
          ?default script?
       }

or

       select { 
          case expr script
          ... 
          ?default script?
       }

default fires always so must be last (no check). As an added benefice you can put comments (or other commands)

ulis

 # the select proc
 #
 proc select {args} {
    foreach {cmd oldCmd} {oldValueCase valueCase oldCase case oldDefault default} {
       catch {rename $cmd $oldCmd};
    }

    proc default {body} {
       foreach {cmd oldCmd} {oldValueCase valueCase oldCase case oldDefault default} {
          if {[catch {rename $oldCmd $cmd}]} {
             catch {rename $cmd {}};
          }
       }
       
       return -code return [uplevel 1 $body];
    };

    switch [llength $args] {
       1   {
          # case expr
          #
          proc case {expr body} {
             if {[uplevel 1 expr $expr]} {
                foreach {cmd oldCmd} {oldCase case oldDefault default} {
                   if {[catch {rename $oldCmd $cmd}]} {
                      catch {rename $cmd {}};
                   }
                }
                return -code return [uplevel 1 $body];
             }
          }

          uplevel 1 [lindex $args 0];
       }
       2   {
          # case value list
          #
          proc valueCase {value list body} {
             if {[lsearch $list $value] != -1} {
                foreach {cmd oldCmd} {oldValueCase valueCase oldDefault default} {
                   if {[catch {rename $oldCmd $cmd}]} {
                      catch {rename $cmd {}};
                   }
                }
                interp {} case {};
                return -code return [uplevel 1 $body];
             }
          }

          foreach {value body} $args {break;}

          interp alias {} case {} valueCase $value;

          uplevel 1 $body;
       }
       default {
          error "wrong # args: should be \"select ?value? {case condition body ... ?default body?}\"";
       }
    }

    foreach {cmd oldCmd} {oldValueCase valueCase oldCase case oldDefault default} {
       if {[catch {rename $oldCmd $cmd}]} {
          catch {rename $cmd {}};
       }
    }
 }

 # some test cases

 set value key4
 foreach i {1 2 3} { set key$i key$i }
 select $value \
 {
  puts "value $value"
  # test for keys
  case key0               { puts "found key0" }
  case $key1              { puts "found $key1" }
  case [list $key2 $key3] { puts "found $key2 or $key3" }
  case {key4 key5}        { puts "found key4 or key5" }
  # default case
  default                 { puts "$value is not a valid key" }
 }

 set value 0
 select \
 {
  puts "value $value"
  case {$value <  0} { puts "negative value" }
  case {$value >  0} { puts "positive value" }
  case {$value == 0} { puts "null value" }
 }

See also Modeling COND with expr

Switch's alternate syntax affords a practical built-in way to achieve "variables in place of constants". Note, though, that [select] is more powerful in that it also permits arbitrary computed comparisons.


Martin Lemburg - I added the ability to not overwrite existing procs with the names case, CASE, default. They are "saved" by renaming/renaming back. I changed the select proc to return the result of the body execution like switch does.


DGP Yuck! Why patch in all that trouble? Just use namespaces and avoid the name conflict in the first place.


ulis: I am not tempted to use "case" or "default" as proc names because I see them as reserved word. I would never define a "switch" or a "for" proc.

Returning the selected value is a VERY good idea.