Expansion with {*} in Tcl 8.4

wdb: For the impatient, the star expansion {*}(expr) can be emulated inside a proc. In Tcl 8.4 the procedure xproc below transforms it to an eval-construction.

 # stringIsList {ab c d} => yes
 # stringIsList {ab {*}c d} => no
 proc stringIsList s { expr {[catch {llength $s}] ? no : yes} }
 
 # findClosingBrace {[list a b] c d e} => {[list a b]}
 # findClosingBrace {{a b} c d} => {{a b}}
 # findClosingBrace {$abc def ghi} => {$abc}
 # findClosingBrace {abc def ghi} => {abc}
 proc findClosingBrace str {
     array set closing [list \[ \] \{ \} \" \"]
     switch -exact -- [string index $str 0] {
         \[ - \{ - \" {
             set i 0
             set closingBrace $closing([string index $str 0])
             set i [string first $closingBrace $str]
             while {![info complete [string range $str 0 $i]]} {
                 set i [string first $closingBrace $str [incr i]]
             }
             if {$i < 0} then {
                 return -code error [list unmatched delimiter on $str]
             }
             string range $str 0 $i
         }
         default {
             set l [regexp -inline {^[$]?[[:alnum:]_]*(?:[[:space:]]|$)} $str]
             string trimright [lindex $l 0]
         }
     }
 }
 
 # expandStar {abc def} => {{abc def}}
 # expandStar {c {*}d e c {*}d e} => {{c } d { e c } d { e}}
 proc expandStar {line {i 0}} {
     set i [string first "{*}" $line $i]
     if {$i < 0  || [stringIsList $line]} then {
         list $line
     } else {
         set result {}
         set i0 [expr {$i - 1}]
         set first [string range $line 0 $i0]
         lappend result $first
         set i3 [expr {$i + 3}]
         set expr [findClosingBrace [string range $line $i3 end]]
         lappend result $expr
         set iRest [expr {$i3 + [string length $expr]}]
         set rest [string range $line $iRest end]
         eval lappend result [expandStar $rest]
     }
 }
 
 # expandCommandLine {abc def} => {abc def}
 # expandCommandLine {c {*}d e} => {eval [list c] d [list e]}
 # expandCommandLine {ab [c {*}d e] e f} => {ab [eval [list c] d [list e]] e f}
 proc expandCommandLine line {
     if {[string first {{*}} $line] < 0} then {
         return $line
     }
     regexp {^[[:space:]]*} $line result
     append result eval
     set i [string first \[ $line]
     if {$i < 0} then {
         foreach {a b} [expandStar $line] {
             set a [string trim $a]
             if {$a ne ""} then {
                 append result " \[list " $a "\]"
             }
             append result " " $b
         }
         string trimright $result
     } else {
         set line1 [string range $line 0 [expr {$i - 1}]]
         set middle [findClosingBrace [string range $line $i end]]
         set l [string length $middle]
         set expr [string range $middle 1 end-1]
         append line1 \[ [expandCommandLine $expr] \]
         set rest [string range $line [expr {$i + $l}] end]
         append line1 [expandCommandLine $rest]
         set result ""
         foreach {a b} [expandStar $line1] {
             set a [string trim $a]
             if {$a ne ""} then {
                 append result " \[list " $a "\]"
             }
             append result " " $b
         }
         string trimright $result
     }
 }
 
 proc explodeLines lines {
     set result {}
     set currentLine ""
     foreach line [split $lines \n] {
         append currentLine \n $line
         if {[info complete $currentLine]} then {
             lappend result [string trimleft $currentLine \n]
             set currentLine ""
         }
     }
     set result
 }
 
 proc xproc {name arglist body} {
     set expandedLines {}
     foreach line [explodeLines $body] {
         lappend expandedLines [expandCommandLine $line]
     }
     uplevel [list proc $name $arglist [join $expandedLines \n]]
 }

sourceCode is a simplified proc-inspector:

  proc sourceCode p { list proc $p [info args $p] [info body $p] }

This little test proc shows us how to do it:

 xproc test1 arg1 {
     list first element {*}$arg1 last element
 }

Now watch the result:

 % sourceCode test1
 proc test1 arg1 {
     eval [list list first element] $arg1 [list last element]
 }
 %

The {*} construction has been replaced by an appropriate eval construction.

Btw, is there any explanation for dummies how to tell my Emacs speedbar to handle xproc as well as proc?


JRW: Hi, I stumbled upon this article after I ran into a similar issue. I came up with a work-around that seems to function just fine for the cases I've thrown at it, though I wont say its full-proof.

Here is my quick Proc, Enjoy!

# <p>
#   <br> Replacement for TCL 8.5's {*} operator for any TCL command
#   <br> Expands any item starting with a '*': command *[list A B C] => command A B C
#   <br>
#   <br> Example: 
#   <br>    set putArgs [list -nonewline stdout]
#   <br>    set output  "putArgs is expanded but this string is not"
#   <br>    
#   <br>    expand puts *$putArgs $output
#   <br>
#   <br> Further Considerations:
#   <br>    Expand calls the procedure in the calling stack (using uplevel) so all upvar variables are retained
# </p>
# <p>
#   <br> Known Bugs:
#   <br>  - Bug: If an argument is passed whose value starts with "*" it will attempt to expand it even if this was unintended
#   <br>    Workaround: Suggest putting a " " or some other character as the first value in the passed string if potentially unintended
#   <br>        If the input arguments should never start with "*" then there should not be a problem
# </p>
#
# @author   JRW
# @since    01/19/2015
# @param    command     The TCL Command to execute
# @param    args        The arguments for command as they would normally be arranged, except any parameter starting with '*' gets expanded
# @return   various     The return value from the given command
proc expand {command args} {
   
    foreach arg $args {
        if {[string index $arg 0] == "*"} {
            append command " [lrange [string trimleft $arg *] 0 end] "
        } else { 
            lappend command $arg
        }
    }
    
    return [uplevel $command]
}