Version 8 of an extension to subst

Updated 2014-06-12 01:19:24 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
puts [subst -nocomplain {$v1 $v2 $v3}]

hello world $v3

I find this useful in code-generation / template expansion situations.