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 $level [list ::subst $myvar]} result options]} {
if {$complain} {
return {*}$options $result
} else {
# TODO: log error?
set ret false
}
} else {
set myvar $result
}
}
} else {
set ret {}
foreach args $args {
if {[catch {uplevel $level [list ::subst $args]} result options]} {
if {$complain} {
return {*}$options $result
} else {
# TODO: log error?
lappend ret $args
}
} else {
lappend ret $result
}
}
}
return $ret
}
======
For redirection see: [Overloading Proc]
----
[samoc] 20140612: Here is another `subst` replacement that adds a `-nocomplain` option to ignore unknown variable names.
======
rename subst tcl_subst
proc subst_nocomplain {args} {
try {
uplevel tcl_subst $args
} trap {TCL LOOKUP VARNAME} {msg info} {
lassign [dict get $info -errorcode] - - - var
set args [string map [list \$$var \\\$$var] $args]
uplevel subst_nocomplain $args
}
}
proc subst {args} {
if {[set i [lsearch [lrange $args 0 end-1] -nocomplain]] != -1} {
uplevel subst_nocomplain [lreplace $args $i $i]
} else {
uplevel tcl_subst $args
}
}
======
e.g.
======
% set v1 hello
% set v2 world
% subst -nocomplain {$v1 $v2 $v3}
hello world $v3
======
I find this useful in code-generation / template expansion situations.
The following further modification handles unknown commands.
However, I'm not quite happy with the way this works. It relies on `regexp` match of the human-readable "invalid command name" message (it seems there is no -errorcode for this error).
Also, just escaping the `[` works for trivial situations, but can have unexpected results in some cases. See example below...
======
proc subst_nocomplain {args} {
try {
uplevel tcl_subst $args
} trap {TCL LOOKUP VARNAME} {msg info} {
lassign [dict get $info -errorcode] - - - var
set args [string map [list \$$var \\\$$var] $args]
uplevel subst_nocomplain $args
} on error {msg info} {
if {[regexp {invalid command name "(.*)"} $msg - cmd]} {
regsub -all [cat {\[ *} $cmd] $args {\\\0} args
uplevel subst_nocomplain $args
} else {
return -code error -options $info
}
}
}
proc cat {args} {join $args ""}
======
e.g.
======
proc bar {args} {
string toupper $args
}
set v1 hello
set v2 world
puts [subst -nocomplain {$v1 [foo $v2] [foo [bar a b c]] $v3}]
hello [foo world] [foo A B C] $v3
puts [subst -nocomplain {$v1 [bar [foo $v2] xx] [foo [bar a b c]] $v3}]
hello {[FOO} WORLD xx] [foo A B C] $v3
======
[AMG]: Bug reported [http://core.tcl.tk/tcl/tktview/311e61d12ad1eb6355c13d2d2ed4acf1c45c4557], thanks! And now fixed [http://core.tcl.tk/tcl/ci/990eed5c11736053b0db23ed241bc4a295e30714]. This is a super easy fix, and you might consider merging it into your own system.
[AMG]: Why are you modifying the entire $args list? Only the last element contains the string to be [subst]'ed. ''-- samoc: true, and my first implementation split "args" into "options" and "string", however the code far smaller this way (and there is no risk that any of the legal subset options contains a `$` that would be changed by `string map`).''
[AMG]: Here are some more cases that don't work:
======
subst -nocomplain {[ foo ]}
subst -nocomplain {[expr 42; foo]}
subst -nocomplain {[if {1} {foo}]}
======
Things can get arbitrarily fancy here. I'm not sure what exactly you want each of the above examples to return. ''-- samoc: the space after `[[` is fixed now, thats handy for generating bash scripts, see below...''
I'm puzzled about where the close bracket went following WORLD in your last example, or why xx isn't capitalised. ''-- samoc: `[[foo` becomes `{[[foo}`. Then, what was "foo's" close bracket gets eaten up by `bar`. i.e. `[[bar {[[foo} world]]`. So the xx is not passed to `bar`.''
----
another example:
======
set user sam
proc get_user_name {args} {return "Sam O'C"}
set script [subst -nocomplain \
{#!/bin/bash
file=$1
if [ -f $user/$file ]
then
echo "User [get_user_name $user] can't find: $file"
fi
}]
puts $script
#!/bin/bash
file=$1
if [ -f sam/$file ]
then
echo "User Sam O'C can't find: $file"
fi
======
----
[AMG]: I recently took a different design approach: changing the substitution operators. Instead of using `[[`brackets`]]` for script substitution and `[[[expr] {...}]]` for math, I used `$[[`dollar brackets`]]$` for script substitution and `$(`dollar parentheses`)$` for math. This was accomplished using [[[string map]]] on the script prior to handing it to [[[subst]]]. In my code, I still used `$`dollar sign for variable substitution and `\`backslash for special characters, but that can also be changed by extending this technique, which I will demonstrate here.
======none
subst [string map {
$[ [
]$ ]
$( [expr\ \{
)$ \}]
$$ $
$\\ \\
[ \\[
] \\]
$ \\$
\\ \\\\
} $script]
======
I also performed the substitution in a child [interp]reter and did a few other tricks specific to my application. See [Config file using slave interp] for something similar. I won't so that technique just now.
Actually, I didn't use [[subst]] to do the substitution; I just put the result of [[string map]] inside double quotes, so I additionally mapped `"` to `\"`. Here I'll use [[subst]] since it's in the page title.
This is your example, rewritten to use my technique and show off the additional features:
======
set map {$[ [ ]$ ] $( [expr\ \{ )$ \}] $$ $ $\\ \\ [ \\[ ] \\] $ \\$ \\ \\\\}
set user sam
proc get_user_name {args} {return "Sam O'C"}
subst [string map $map\
{#!/bin/bash
file=$1
if [ ! -f $$user/$file ]; then
echo "User $[get_user_name $$user]$ can't find: $file"
fi
echo "2+2 = $(2+2)$"
echo "tab$\t$\tcharacters"
echo '$single dollar sign$'
echo '$$$double dollar sign$$$'
echo '$$$$$triple dollar sign$$$$$'}]
======
The result is:
======none
#!/bin/bash
file=$1
if [ ! -f sam/$file ]; then
echo "User Sam O'C can't find: $file"
fi
echo "2+2 = 4"
echo "tab characters"
echo '$single dollar sign$'
echo '$$double dollar sign$$'
echo '$$$triple dollar sign$$$'
======
And here's a summary of all the special sequences:
%|Type this|To get this|Which [[subst]]s to this. |%
&|`$[[` |`[[` |Script substitution |&
&|`]]$` |`]]` |Script substitution |&
&|`$(` |`[[expr {` |Math substitution |&
&|`)$` |`}]]` |Math substitution |&
&|`$$` |`$` |Variable substitution |&
&|`$\` |`\` |Special character substitution or quoting|&
%| | | |%
&|`[[` |`\[[` |Literal open bracket |&
&|`]]` |`\]]` |Literal close bracket |&
&|`$` |`\$` |Literal dollar sign |&
&|`\` |`\\` |Literal backslash |&
<>String Processing