apply woes

## apply.tcl
# from: http://wiki.tcl.tk/4884
proc apply {fun args} {
    set len [llength $fun]
    if {($len < 2) || ($len > 3)} {
        error "can't interpret \"$fun\" as anonymous function"
    }
    lassign $fun argList body ns
    set name ::$ns::[getGloballyUniqueName]
    set body0 {
        rename [lindex [info level 0] 0] {}
    }
    proc $name $argList ${body0}$body
    set code [catch {uplevel 1 $name $args} res opt]
    return -options $opt $res
}   


## schema.tcl
# source apply.tcl

set schema_names(ID)   "Reg No"
set schema_names(name) "Name" 
set schema_names(gender)   "Sex"
set schema_names(father)   "Father's Name"
set schema_names(mother)   "Mother's Name"
set schema_names(spouse)   "Spouse's Name"
set schema_names(address)  "Address"
set schema_names(first_visit)  "First Visit"
set schema_names(age_years) "Age (y)"
set schema_names(age_months)   "Age (m)"

proc schema_widget {name} {
    switch $name {
        "gender" {
            set moreargs [list -values [list "" "M" "F"]]
            proc gender_spinbox {args} {
                return [apply spinbox [concat args moreargs]]
            }
            return gender_spinbox
        }
        default {
            return entry   
        }
    }
}

## editor.tcl
# source schema.tcl

foreach {name label} [array get schema_names] {
    label .l_$name -text $label
    set widget [schema_widget $name]
    $widget .w_$name
    grid .l_$name .w_$name
}