Posted to tcl by hypnotoad at Mon Oct 23 19:11:34 GMT 2017view pretty

package provide nproc 0.1

if {[info command ::nproc] eq {}} {

proc ::dictargs argdef {
  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
  }
  return $result
}

proc ::newproc {name arglist body} {
  set result {}
  if {[lindex [lindex $arglist end] 0] eq "dictargs"} {
    append result [::dictargs [lindex [lindex $arglist end] 1]]
    set arglist [lrange $arglist 0 end-1]
    lappend arglist args
  }
  append result $body
  ::proc $name $arglist $body
}

###
# Named Procedures
###
proc ::nproc {name argdef body} {
  set result {}
  append result [::dictargs $argdef] \n
  append result $body
  ::proc $name args $result
}
}

newproc standard {subject sender {dictargs {
  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
}


# Example
nproc newstyle {
  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
}