## start of expand.tcl
 #
 # prototype expand command
 # Joe Mistachkin
 # 7/31/2003

 set expand_argument_error "wrong # args: should be \"expand ?-expand expand_list? arg ?arg ...?\""
 set expand_list_error "malformed expansion list"

 proc expand_processExpansionList { array_name error_name expand_list argument_count } {
   # get variable to put error message into...
   upvar "1" $error_name local_error

   if {$argument_count > "0"} then {
     # we are going to put the results into the caller's array.
     upvar "1" $array_name local_array

     # set all arguments to default state (not expanded)
     set index "0"
     while {$index < $argument_count} {
       set local_array($index) "0"
       incr index
     }

     # assume success until we find an actual error.
     set result "0"

     # are we processing a "to" range?
     set range(from) "-1"
     set range(to) "-1"

     set last_item ""
     foreach this_item $expand_list {
       if {[string is integer -strict $this_item] != "0"} then {
         if {$range(from) != "-1"} then {
           # mark the end of the range...
           set range(to) $this_item

           # make sure it's a valid range...
           if {$range(from) <= $range(to)} then {
             # mark entire range to be expanded...
             set index $range(from)
             while {$index <= $range(to)} {
               set local_array($index) "1"
               incr index
             }

             # reset range positions...
             set range(from) "-1"
             set range(to) "-1"
           } else {
             # nope, not a valid range.
             set local_error "not a valid range"
             set result "-1"
             break
           }
         } else {
           if {(($this_item >= "0") && ($this_item < $argument_count))} then {
             # mark this argument for expansion...
             set local_array($this_item) "1"
           } else {
             # out of bounds.
             set local_error "argument index out of bounds"
             set result "-1"
             break
           }
         }
       } else {
         switch -exact -- $this_item {
           "to"    {
             if {$range(from) == "-1"} then {
               if {[string is integer -strict $last_item] != "0"} then {
                 set range(from) $last_item
               } else {
                 # invalid start of range...
                 set local_error "invalid index for start of range"
                 set result "-1"
                 break
               }
             } else {
               # already started a range...
               set local_error "range already started"
               set result "-1"
               break
             }
           }
           "end"   {
             # mark last argument to be expanded...
             set local_array([expr {$argument_count - "1"}]) "1"
           }
           default {
             # unknown argument processing directive.
             set local_error "unknown argument processing directive"
             set result "-1"
             break
           }
         }
       }

       # set last item processed to current item...
       set last_item $this_item
     }
   } else {
     # NOTE: not really an error.
     set local_error "nothing to process"
     set result "0"
   }

   return $result
 }

 proc expand { args } {
   global expand_argument_error
   global expand_list_error
   #
   # check for list of things to expand...
   # (default is to expand nothing)
   #
   if {[llength $args] > "0"} then {
     switch -exact -- [lindex $args "0"] {
       "-expand" {
         # we want to expand the specified arguments.
         set expand "1"
         # next, there should be a list of things to expand.
         set index "1"
         # the option and expansion list are NOT included in the argument count.
         set argument_count [expr {[llength $args] - ($index + "1")}]
       }
       "-noexpand" {
         # we want to NOT expand the specified arguments.
         set expand "0"
         # next, there should be a list of things to NOT expand.
         set index "1"
         # the option and expansion list are NOT included in the argument count.
         set argument_count [expr {[llength $args] - ($index + "1")}]
       }
       default {
         # don't expand by default.
         set expand "0"
         # there is no list of things to expand.
         set index "-1"
         # all arguments are passed along.
         set argument_count [llength $args]
       }
     }

     if {(($index == "-1") || ([llength $args] > ($index + "1")))} then {
       if {$index != "-1"} then {
         # get list of args to modify.
         set expand_list [lindex $args $index]

         set expand_error ""
         array set expand_array {}
         if {[expand_processExpansionList expand_array expand_error $expand_list $argument_count] != "0"} then {
           error "$expand_list_error: $expand_error"
         }
       } else {
         # no arguments to modify.
         set expand_list [list]
       }

       # start with an empty list as the command string to evaluate.
       set result [list]
       # start just beyond the end of the expansion list (if any).
       set this_index [expr {$index + "1"}]
       while {$this_index < [llength $args]} {
         # get the translated argument index...
         if {$index != "-1"} then {
           set argument_index [expr {$this_index - ($index + "1")}]
         } else {
           set argument_index $this_index
         }

         if {[info exists expand_array($argument_index)] != "0"} then {
           # is the argument targeted for expansion?
           if {$expand_array($argument_index) != "0"} then {
             set do_expand [expr {$expand ? "1" : "0"}]
           } else {
             set do_expand [expr {$expand ? "0" : "1"}]
           }
         } else {
           set do_expand [expr {$expand ? "0" : "1"}]
         }

         if {$do_expand != "0"} then {
           # add the expanded list to the command string.
           set result [concat $result [lindex $args $this_index]]
         } else {
           # add the unmodified argument to the command string.
           lappend result [lindex $args $this_index]
         }

         incr this_index
       }
     } else {
       # not enough arguments.
       error $expand_argument_error
     }
   } else {
     #
     # NOTE: potential for design change here.
     #
     # return empty string when given no arguments...?
     set result ""
   }

   uplevel "1" $result
 }

 proc expand_test_proc { args } {
   puts stdout "number of args = [llength $args]"
   puts stdout "args = \{ $args \}"
 }

 ## end of expand.tcl

Try these examples:

 expand -expand {1 to 3 end} expand_test_proc [list argument 1] [list argument 2] [list argument 3] [list argument 4] [list argument 5]
 expand -expand {1} expand_test_proc [list this is a test.]
 expand -noexpand {1} expand_test_proc [list this is a test.]
 expand expand_test_proc [list this is a test.]

<<categories>>Command