Updated 2012-10-20 18:37:27 by RLE ▲

I've spent some time this evening hacking on a set of tools to ease my pain when I need a command with subcommands that parses its arguments in a manner that is compatible with proc.

I've got something that sort of works here, good enough for the serial command that I was implementing anyway:
# subcommands.tcl
# Copyright April 13, 2005  - Pierre Coueffin

proc subcommand {cmd arglname commands} {
    set code [list switch -exact -- $cmd]
    set switches {}
    foreach {c a b} $commands {
        set b "nameArgs [list $a] \$[set arglname]\n$b"
        lappend switches $c $b
    }

    lappend code $switches

    uplevel 1 $code
}

proc nameArgs {prototype argl} {
    set mandatory {}
    set optional {}
    set args [lindex $prototype end]
    if {! [string match $args args]} {
        set args {}
        upvar args v
        set v {}
    } else {
        set prototype [lrange $prototype 0 end-1]
    }

    foreach proto $prototype {
        switch [llength $proto] {
            0 {
                error "You can't have an argument with no name."
            }
            1 {
                if {[llength $optional] > 0} {
                error "You can't have a mandatory argument after an optional one."
                }
                lappend mandatory $proto
            }
            2 {
                foreach part $proto {
                    lappend optional $part
                }   
            }
            default {
                error "too many fields in argument specifier \"$proto\""
            }
        }
    }

    if {[llength $argl] < [llength $mandatory]} {
        set errmsg "wrong # args: should be \"$mandatory"
        foreach {opt default} $optional {
            append errmsg " ?$opt?"
        }
        append errmsg " $args\""
        error $errmsg
    }

    foreach name $mandatory arg [lrange $argl 0 [llength $mandatory]] {
        upvar $name v
        set v $arg
    }
    set argl [lrange $argl [llength $mandatory] end]

    if {[llength $argl] > [expr [llength $optional] / 2]} {
        if {$args == {}} {
            set errmsg "wrong # args: should be \"$mandatory"
            foreach {opt default} $optional {
                append errmsg " ?$opt?"
            }
            append errmsg "\""
            error $errmsg
        }
        upvar args v
        set len [expr [llength $optional] / 2]
        set v [lrange $argl $len end]
        set argl [lrange $argl 0 $len]
    }

    set i 0
    foreach {opt default} $optional arg $argl {
        upvar $opt v

        if {[llength $argl] <= $i} {
            set v $default
        } else {
            set v $arg
        }
        incr i
    }
    return
}

LV What would be an example of this in action?

[Pierre Coueffin] subcommand is used in The serial iterator (It's the only example, since I just wrote it...)

namedArgs is useful for breaking up argument lists. I intend to replace a bunch of places where I do:
foreach {a b c} $args break

with:
namedArgs {a b {c defaultValueForC} {d defaultValueForD} args} $args

the idea was to be more compatible with the way proc handles arguments. That's why it has so many attempts at sanity checks and verbose error messages...

It's not perfect yet, but I want to get some feedback in case anyone else spots the glaring design flaws that I'm sure are lurking in it.

Category Dev. ToolsCategory CommandCategory Argument Processing