Here comes the code for the extension to [subst] introduced in [extending the notation of proc args]...
The documentation is written in [tcldoc].
======
# provides a fail-safe {@link http://www.tcl.tk/man/tcl8.5/TclCmd/subst.htm
# http://www.tcl.tk/man/tcl8.5/TclCmd/subst.htm} which optionally performs
# substitutions in an uplevel. If -inplace
, then false
is returned
# if any call to ::subst
fails. All variables are handled anyways.
# @param -nocomplain in case of an error, the initial value is returned and no error is thrown
# @param -uplevel the level at which substitutions are performed. Defaults to the current context
# @param -inplace all non-switch arguments at the end are variable names in the caller's context.
# Their value is replaced and true
or false
is returned
# @param -- optionally used to separate switches from other parameters
# @param args forwards all args
defined for ::subst
,
# but allows multiple strings or variable names
# @return the value of the last argument after performing TCL substitutions
# @see http://www.tcl.tk/man/tcl8.5/TclCmd/uplevel.htm
# http://www.tcl.tk/man/tcl8.5/TclCmd/uplevel.htm
proc subst {args} {
set level 0
set complain true
set inplace false
set switches {}
for {set i 0} {$i < 7} {incr i} {
set c [lindex $args $i]
switch $c {
-uplevel {set level [lindex $args [incr i]]}
-nocomplain {set complain false}
-inplace {set inplace true}
-nobackslashes - -nocommands - -novariables {lappend switches $c}
default {
if {$c eq {--}} {incr i}
break
}
}
}
set args [lrange $args $i end]
catch {incr level}
# 4 paths for -nocomplain and -inplace
if {$inplace} {
set ret true
foreach args $args {
upvar $args myvar
if {[catch {uplevel $uplevel [list ::subst $myvar]} result options]} {
if {$complain} {
return {*}$options $result
} else {
::logger::tree::TAFF::lib::debug \
"{[info level 0]} could not perform on {$args} with value {$myvar}: $result"
set ret false
}
} else {
set myvar $result
}
}
} else {
set ret {}
foreach args $args {
if {[catch {uplevel $uplevel [list ::subst $args]} result options]} {
if {$complain} {
return {*}$options $result
} else {
::logger::tree::TAFF::lib::debug \
"{[info level 0]} could not perform on {$args}: $result"
lappend ret $args
}
} else {
lappend ret $result
}
}
}
return $ret
}
======
For redirection see: [Overloading Proc]
<>Enter Category Here