Version 4 of ObjectProc

Updated 2002-10-02 08:34:50

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. Feel free to use it however you want.

---

  #Updated Oct 2, 2002 with the ability to have typeless args

  proc ObjectProcInstanceCmd {argTable body reqArgs argsPassed} {
    array set msg {}

    foreach var $reqArgs {
      upvar $var $var
    }

    foreach arg $argTable {
      foreach {theMsg value class} $arg break
      set msg($theMsg) $value
      foreach alias [list nil empty string] {
        if {[string equal $alias $class]} {
          set class none
          break
        }
      } 
      set msg($theMsg,class) $class
    }

    foreach {theMsg value} $argsPassed {
      if {[info exists msg($theMsg)] != 1} {
        return -code error "invalid message: $theMsg"
      }

      if {[string equal $msg($theMsg,class) "none"] || [string is $msg($theMsg,class) $value]} {
        set msg($theMsg) $value
      } else {
        return -code error "invalid value: $value for message: $theMsg"
      }
    }

    eval $body
  }

  proc ObjectProc {name reqArgs argStr label body} {
    set argTable [split $argStr \n]
    set i 0
    foreach argSet $argTable {
      if {[string trim $argSet] == ""} {
        set argTable [lreplace $argTable $i $i]
        continue
      }

      if {[llength $argSet] != 3} {
        return -code error "received a bad argument table"
      }
      incr i
    }

    lappend reqArgs args
    proc $name $reqArgs "ObjectProcInstanceCmd [list $argTable $body $reqArgs] \$args"
  }

---

Test Code

  ObjectProc p {} {
    -x 1 digit
    -y 20 digit
    -text "" none
  } body {
    puts "x + y = [expr {$msg(-x) + $msg(-y)}]"
    puts "-text is $msg(-text)"
  }

  p -x 1 -y 20 -text "Hello World"
  p -x 5 -text Wonderment

---

Category Command