Posted to tcl by aspect at Thu Jan 07 06:17:58 GMT 2016view pretty

package require Tk
package require snit

snit::widgetadaptor noisybutton {

    delegate option -hullcommand to hull as -command
    option -command -configuremethod Setopt
    delegate option * to hull

    delegate method Invoke to hull as invoke
    delegate method * to hull

    constructor args {
        installhull using ttk::button
        $self configurelist $args
    }

    method Setopt {k v} {
        puts "Setopt $k $v"
        switch $k {
            -command {
                $self configure -hullcommand "puts {$self command!}; $v"
            }
            default {
                return -code error "Unknown option \"$k\""
            }
        }
        set options($k) $v
    }

    method invoke {} {
        puts "$self invoke!"
        $self Invoke
    }
}