Version 1 of an extension to subst

Updated 2012-07-31 14:55:04 by heinrichmartin

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 $uplevel [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 $uplevel [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