Keyword (optional) procedure arguments in Tcl

They are very usable in many language. For example in Python:

def f(a, b=0, **kw):
  print kw

f(1, 2, x=10, y=20)

kw is the dictionary and is accessible in usual way (item existent checking, getting and so on). Argument b can be skipped and is optional too.

For Tcl it's easy to write procedure for processing keyword arguments (like getopt):

proc getargs {argsName kwArgsName arguments} {
# like getopt for proc/method, ex:
# 1) argsName may be ""|{} - to avoid positional args saving
# 2) if no value of keyword argument, then it's value will be "Y"

    upvar 1 $kwArgsName kwargs
    set posargs {}

    proc isKw opt {
        return [expr {"-" eq [string index $opt 0]}]
    }
    proc setPosArg opt {
        upvar 1 posargs posargs
        lappend posargs $opt
    }
    proc setKwArg {name val} {
        set ret "@NOMORE"; # used or not $val, it's possible positional opt
        if {$name ne ""} {
            upvar 1 kwargs kwargs
            set defaultValue [lindex [array get kwargs $name] end]
            if {$defaultValue in {"Y" "N"}} {
                if {$val eq ""} {
                    set val "Y"
                } elseif {$val ni {"Y" "N"}} {
                    set ret $val
                    set val "Y"
                }
            }
            set kwargs($name) $val
        }
        return $ret
    }

    set kw ""
    set state OPT; # OPT|VAL|END
    lappend arguments "@EOO"
    foreach opt $arguments {
        switch -- $state {
            OPT {
                if {$opt eq "@EOO"} {
                    set state END
                } elseif {[isKw $opt]} {
                    set kw $opt
                    set state VAL
                } else {
                    setPosArg $opt
                }
            }

            VAL {
                if {$opt eq "@EOO"} {
                    setKwArg $kw ""
                    set state END
                } elseif {[isKw $opt]} {
                    setKwArg $kw ""
                    set kw $opt
                } else {
                    set maybePos [setKwArg $kw $opt]
                    if {$maybePos ne "@NOMORE"} { setPosArg $maybePos }
                    set state OPT
                }
            }

            END { break; }
        }
    }

    if {$argsName ne ""} {
        upvar 1 $argsName _posargs
        set _posargs $posargs
    }
}

Here is the example how to use:

set args {}; # positional args
array set kw {-a 1 -b 2}; # default kw-args
set inputArgs {-a 20 -c 30 zzz -q -v xxx yyy}
getargs args kw $inputArgs
puts "Args:\n $args"
puts "KW Args:"
foreach {k v} [array get kw] {
    puts " $k = $v"
}

If positional arguments are not needed, use "" or {} instead of its' variable name. If some keyword options has no value (it's flag only!), set it's default value ("Y" or "N") to kwArgsName (kw array is example), so getargs will not interpret the next word as option value. But it's possible to has value if it is "Y" or "N": someCommand -someFlag or someCommand -someFlag N

Tcl/Tk: list of COM ports (real, virtual) on Windows

If you need helper for user like combobox with available COM ports (serial devices, and they can be real COM ports or virtual like FTDI "bridges") in Tcl/Tk, use this procedures:

# list all ports as FTDIBUS and USB. Returns list of {PortName, FriendlyName, Auto?}
# where Auto is flag - port for HMC6343 or not
proc _ls_vports {} {
    set res {}
    foreach type {FTDIBUS USB} {
        set k0 "HKEY_LOCAL_MACHINE\\SYSTEM\\CurrentControlSet\\Enum\\$type"
        set k0ch [registry keys "$k0" {V[iI][dD]_*}]
        foreach k1 $k0ch {
            set k1ch [registry keys "$k0\\$k1"]
            foreach k2 $k1ch {
                set Class [registry get "$k0\\$k1\\$k2" Class]
                if {$Class == "Ports"} {
                    set FriendlyName [registry get "$k0\\$k1\\$k2" FriendlyName]
                    set PortName [registry get "$k0\\$k1\\$k2\\Device Parameters" PortName]
                    set Auto [expr {"silabser" == [registry get "$k0\\$k1\\$k2" "Service"]}]; #auto-detected
                    lappend res [list $PortName $FriendlyName $Auto]
                }
            }
        }
    }
    return $res
}

# Returns list of {PortName, "Com Port", 0} -
# auto-detect is impossible in this mode, no friendly name also
proc _ls_all {} {
    set serial_base "HKEY_LOCAL_MACHINE\\HARDWARE\\DEVICEMAP\\SERIALCOMM"
    set values [registry values $serial_base]
    set res {}
    foreach valueName $values {
        set PortName [registry get $serial_base $valueName]
        set FriendlyName "COM Port"
        set Auto 0
        lappend res [list $PortName $FriendlyName $Auto]
    }
    return $res
}

They returns list of triplets: {PortName, FriendlyName, Auto}. Auto is the flag {0|1} - 1 is for auto-detection of the silabser service (for Sillicon Labs CP210x USB-to-UART bridge chip, used in the HMC6343 demo board).