Posted to tcl by jdc at Tue Jul 10 09:49:24 GMT 2007view pretty
package require Tk namespace eval ::myWidget { proc ::myWidget { path args } { return [eval ::myWidget::create $path $args] } # Create the mega widget and an object command, return the path # of the mega widget. proc create { path args } { # Base frame set bf [frame $path -bd 0] # parse args set txt "" foreach {option val} $args { switch -exact -- $option { -text { set txt $val } default { return -code error "Invalid myWidget option '$option'" } } } # Add widget contents here pack [label $path.l -text $txt] -fill both -expand true # Widget command rename $bf ::$bf:cmd proc ::$bf { cmd args } "return \[eval ::myWidget::\$cmd $bf \$args\]" # Done return $path } # return value for specified option proc cget { path option } { switch -exact -- $option { -text { return [$path.l cget -text] } default { return -code error "Invalid myWidget option '$option'" } } } # No args: return <option> <value> list for all options # 1 arg : retrun <value> for specified option # 2 args : set <option> to specified <value> proc configure { path args } { switch -exact -- [llength $args] { 0 { return [list -text [$path.l cget -text]] } 1 { return [::myWidget::cget $path [lindex $args 0]] } 2 { set option [lindex $args 0] set val [lindex $args 1] switch -exact -- $option { -text { return [$path.l configure -text $val] } default { return -code error "Invalid myWidget option '$option'" } } } } return } } pack [myWidget .m -text "Text 1"] puts "Text = [.m cget -text]" .m configure -text "Brol"