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

  1. package provide nproc 0.1
  2.  
  3. if {[info command ::nproc] eq {}} {
  4.  
  5. proc ::dictargs argdef {
  6. if {[catch {dict keys $argdef} argnames]} {
  7. puts $argnames
  8. error "Argument definition is not a well formed dict"
  9. }
  10. set result {}
  11. append result {if {[llength $args]==1} {set argdict [lindex $args 0]} else {set argdict $args}} \n
  12. foreach {field info} $argdict {
  13. set argbody [list if {[dict exists $argdict {@field@}]} {set {@field@} [dict get $argdict {@field@}]}]
  14. set map [list @field@ $field]
  15. if {[dict exists $info mandatory]} {
  16. lappend argbody else {error "@field@ is required"}
  17. } elseif {[dict exists $info default]} {
  18. lappend map @dvalue@ [dict get $info default]
  19. lappend argbody else {set {@field@} {@dvalue@}}
  20. }
  21. append result [string map $map $argbody] \n
  22. }
  23. return $result
  24. }
  25.  
  26. proc ::newproc {name arglist body} {
  27. set result {}
  28. if {[lindex [lindex $arglist end] 0] eq "dictargs"} {
  29. append result [::dictargs [lindex [lindex $arglist end] 1]]
  30. set arglist [lrange $arglist 0 end-1]
  31. lappend arglist args
  32. }
  33. append result $body
  34. ::proc $name $arglist $body
  35. }
  36.  
  37. ###
  38. # Named Procedures
  39. ###
  40. proc ::nproc {name argdef body} {
  41. set result {}
  42. append result [::dictargs $argdef] \n
  43. append result $body
  44. ::proc $name args $result
  45. }
  46. }
  47.  
  48. newproc standard {subject sender {dictargs {
  49. mtime {}
  50. body {}
  51. }} {
  52. set auto_reply [subst {To: $sender
  53. Subject: Re: $subject
  54.  
  55. Dear $sender,
  56. Thank you for writing us about $subject}]
  57. if {[dict exists $dictargs mtime]} {
  58. append auto_reply " on [clock format [clock scan $mtime]]"
  59. }
  60. puts $auto_reply
  61. }
  62.  
  63.  
  64. # Example
  65. nproc newstyle {
  66. subject {mandatory 1}
  67. sender {mandatory 1}
  68. mtime {}
  69. body {}
  70. } {
  71. set auto_reply [subst {To: $sender
  72. Subject: Re: $subject
  73.  
  74. Dear $sender,
  75. Thank you for writing us about $subject}]
  76. if {[dict exists $dictargs mtime]} {
  77. append auto_reply " on [clock format [clock scan $mtime]]"
  78. }
  79. puts $auto_reply
  80. }
  81.