Version 22 of an extension to subst

Updated 2014-06-17 02:11:12 by AMG

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 <code>-inplace</code>, then <code>false</code> is returned
# if any call to <code>::subst</code> 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 <code>true</code> or <code>false</code> is returned
# @param -- optionally used to separate switches from other parameters
# @param args forwards all <code>args</code> defined for <code>::subst</code>,
# 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 [L1 ], thanks! And now fixed [L2 ]. 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.

subst [string map {
    $[   [
    ]$   ]
    $(   [expr\ \{
    )$   \}]
    $$   $
    $\\  \\
    [    \\[
    ]    \\]
    $    \\$
    \\   \\\\
} $script]

I also performed the substitution in a child interpreter 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:

#!/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 thisTo get thisMeaning 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