GPS Wed Jun 12, 2002: The code below implements a proc-like command that allows default values for arguments, and type checking of values given to arguments.
Comments and improvements are welcome.
#! /bin/tclsh8.3
#version 2
proc ObjectProcInstanceCmd {argTable body argsPassed} {
array set ar {}
foreach arg $argTable {
foreach {var value class} $arg break
set ar($var) $value
foreach alias [list nil empty string] {
if {[string equal $alias $class]} {
set class none
break
}
}
set ar($var,class) $class
}
foreach {var value} $argsPassed {
if {[info exists ar($var)] != 1} {
return -code error "invalid flag: $var"
}
if {[string equal $ar($var,class) "none"] || [string is $ar($var,class) $value]} {
set ar($var) $value
} else {
return -code error "invalid value: $value for flag: $var"
}
}
eval $body
}
proc ObjectProc {name argStr label body} {
set argTable [split $argStr \n]
for {set i 0} {$i < [llength $argTable]} {incr i} {
set arg [lindex $argTable $i]
if {[string trim $arg] == ""} {
set argTable [lreplace $argTable $i $i]
continue
}
if {[llength $arg] != 3} {
return -code error "received a bad argument table"
}
}
proc $name {args} "ObjectProcInstanceCmd [list $argTable $body] \$args"
}
ObjectProc p {
-x "" digit
-y 20 digit
-text "" none
} body {
puts "x + y [expr {$ar(-x) + $ar(-y)}]"
puts "-text is $ar(-text)"
}
p -x 1 -y 20 -text "Hello World"
p -x 5 -text Wonderment
ObjectProc p2 {
-width 256 digit
-height 256 digit
-title default string
} body {
puts "making a box named $ar(-title) that is $ar(-width) wide and $ar(-height) pixels tall"
}
p2
p2 -title Boxy
if 0 {
#tests designed to fail
catch {p2 -title Kablamo -width abc} res
puts $res
catch {p2 -tit} res
puts $res
}