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] }