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

  1. package require Tk
  2. package require snit
  3.  
  4. snit::widgetadaptor noisybutton {
  5.  
  6. delegate option -hullcommand to hull as -command
  7. option -command -configuremethod Setopt
  8. delegate option * to hull
  9.  
  10. delegate method Invoke to hull as invoke
  11. delegate method * to hull
  12.  
  13. constructor args {
  14. installhull using ttk::button
  15. $self configurelist $args
  16. }
  17.  
  18. method Setopt {k v} {
  19. puts "Setopt $k $v"
  20. switch $k {
  21. -command {
  22. $self configure -hullcommand "puts {$self command!}; $v"
  23. }
  24. default {
  25. return -code error "Unknown option \"$k\""
  26. }
  27. }
  28. set options($k) $v
  29. }
  30.  
  31. method invoke {} {
  32. puts "$self invoke!"
  33. $self Invoke
  34. }
  35. }
  36.  
  37.