Version 16 of Expansion with {*} in Tcl 8.4

Updated 2013-08-13 02:36:14 by RLE

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?