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"