Posted to tcl by hypnotoad at Mon Oct 23 18:53:19 GMT 2017view pretty
package provide nproc 0.1 if {[info command ::nproc] eq {}} { ### # Named Procedures ### proc ::nproc {name argdef body} { if {[catch {dict keys $argdef} argnames]} { puts $argnames error "Argument definition is not a well formed dict" } set result {} append result {if {[llength $args]==1} {set argdict [lindex $args 0]} else {set argdict $args}} \n foreach {field info} $argdict { set argbody [list if {[dict exists $argdict {@field@}]} {set {@field@} [dict get $argdict {@field@}]}] set map [list @field@ $field] if {[dict exists $info mandatory]} { lappend argbody else {error "@field@ is required"} } elseif {[dict exists $info default]} { lappend map @dvalue@ [dict get $info default] lappend argbody else {set {@field@} {@dvalue@}} } append result [string map $map $argbody] \n } append result $body ::proc $name args $result } } # Example nproc newmessage { subject {mandatory 1} sender {mandatory 1} mtime {} body {} } { set auto_reply [subst {To: $sender Subject: Re: $subject Dear $sender, Thank you for writing us about $subject}] if {[dict exists $dictargs mtime]} { append auto_reply " on [clock format [clock scan $mtime]]" } puts $auto_reply }