Version 5 of In case of: select, another switch

Updated 2002-04-25 10:58:49

if 0 {

    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.