Version 4 of an extension to subst

Updated 2014-06-12 00:59:22 by samoc

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 $args -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.