Posted to tcl by aspect at Tue Jul 10 06:42:32 GMT 2007view raw
- ## 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
- }
Comments
Posted by error message at Tue Jul 10 06:48:46 GMT 2007 [text] [code]
Error in startup script: wrong # args: should be "catch command ?varName?" while compiling "catch {uplevel 1 $name $args} res opt" while compiling "set code [catch {uplevel 1 $name $args} res opt]" (compiling body of proc "apply", line 12) invoked from within "apply spinbox [concat args moreargs]" (procedure "gender_spinbox" line 2) invoked from within "$widget .w_$name" ("foreach" body line 4) invoked from within "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 }" (file "a.tcl" line 51)