if false {
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]]
}
if false {sourceCode is a simplified proc-inspector:
}
proc sourceCode p { list proc $p [info args $p] [info body $p] }
if false {This little test proc shows us how to do it:
}
xproc test1 arg1 {
list first element {*}$arg1 last element
}
if false {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?
}
