home *** CD-ROM | disk | FTP | other *** search
/ PC World 2000 December / PCWorld_2000-12_cd.bin / Komunikace / Comanche / BWidget-1.2 / button.tcl < prev    next >
Text File  |  2000-11-02  |  10KB  |  303 lines
  1. # ------------------------------------------------------------------------------
  2. #  button.tcl
  3. #  This file is part of Unifix BWidget Toolkit
  4. # ------------------------------------------------------------------------------
  5. #  Index of commands:
  6. #   Public commands
  7. #     - Button::create
  8. #     - Button::configure
  9. #     - Button::cget
  10. #     - Button::invoke
  11. #   Private commands (event bindings)
  12. #     - Button::_destroy
  13. #     - Button::_enter
  14. #     - Button::_leave
  15. #     - Button::_press
  16. #     - Button::_release
  17. #     - Button::_repeat
  18. # ------------------------------------------------------------------------------
  19.  
  20. namespace eval Button {
  21.     Widget::tkinclude Button button :cmd \
  22.         remove {-command -relief -text -textvariable -underline}
  23.  
  24.     Widget::declare Button {
  25.         {-name            String "" 0}
  26.         {-text            String "" 0}
  27.         {-textvariable    String "" 0}
  28.         {-underline       Int    -1 0 {=-1}}
  29.         {-armcommand      String "" 0}
  30.         {-disarmcommand   String "" 0}
  31.         {-command         String "" 0}
  32.         {-repeatdelay     Int    0  0 {=0 ""}}
  33.         {-repeatinterval  Int    0  0 {=0 ""}}
  34.         {-relief          Enum   raised  0 {raised sunken flat ridge solid groove link}}
  35.     }
  36.  
  37.     DynamicHelp::include Button balloon
  38.  
  39.     Widget::syncoptions Button "" :cmd {-text {} -underline {}}
  40.  
  41.     variable _current ""
  42.     variable _pressed ""
  43.  
  44.     bind BwButton <Enter>           {Button::_enter %W}
  45.     bind BwButton <Leave>           {Button::_leave %W}
  46.     bind BwButton <ButtonPress-1>   {Button::_press %W}
  47.     bind BwButton <ButtonRelease-1> {Button::_release %W}
  48.     bind BwButton <Key-space>       {Button::invoke %W; break}
  49.     bind BwButton <Return>          {Button::invoke %W; break}
  50.     bind BwButton <Destroy>         {Widget::destroy %W; rename %W {}}
  51.  
  52.     proc ::Button { path args } { return [eval Button::create $path $args] }
  53.     proc use {} {}
  54. }
  55.  
  56.  
  57. # ------------------------------------------------------------------------------
  58. #  Command Button::create
  59. # ------------------------------------------------------------------------------
  60. proc Button::create { path args } {
  61.     Widget::init Button $path $args
  62.  
  63.     set relief [Widget::getoption $path -relief]
  64.     if { ![string compare $relief "link"] } {
  65.         set relief "flat"
  66.     }
  67.  
  68.     set var [Widget::getoption $path -textvariable]
  69.     if {  ![string length $var] } {
  70.         set desc [BWidget::getname [Widget::getoption $path -name]]
  71.         if { [llength $desc] } {
  72.             set text  [lindex $desc 0]
  73.             set under [lindex $desc 1]
  74.             Widget::setoption $path -text $text
  75.             Widget::setoption $path -underline $under
  76.         } else {
  77.             set text  [Widget::getoption $path -text]
  78.             set under [Widget::getoption $path -underline]
  79.         }
  80.     } else {
  81.         set under -1
  82.         set text  ""
  83.         Widget::setoption $path -underline $under
  84.     }
  85.  
  86.     eval button $path [Widget::subcget $path :cmd] \
  87.         [list -relief $relief -text $text -underline $under -textvariable $var]
  88.     bindtags $path [list $path BwButton [winfo toplevel $path] all]
  89.  
  90.     set accel [string tolower [string index $text $under]]
  91.     if { $accel != "" } {
  92.         bind [winfo toplevel $path] <Alt-$accel> "Button::invoke $path"
  93.     }
  94.  
  95.     DynamicHelp::sethelp $path $path 1
  96.  
  97.     rename $path ::$path:cmd
  98.     proc ::$path { cmd args } "return \[eval Button::\$cmd $path \$args\]"
  99.  
  100.     return $path
  101. }
  102.  
  103.  
  104. # ------------------------------------------------------------------------------
  105. #  Command Button::configure
  106. # ------------------------------------------------------------------------------
  107. proc Button::configure { path args } {
  108.     set oldunder [$path:cmd cget -underline]
  109.     if { $oldunder != -1 } {
  110.         set oldaccel [string tolower [string index [$path:cmd cget -text] $oldunder]]
  111.     } else {
  112.         set oldaccel ""
  113.     }
  114.     set res [Widget::configure $path $args]
  115.  
  116.     set rc [Widget::hasChanged $path -relief relief]
  117.     set sc [Widget::hasChanged $path -state  state]
  118.  
  119.     if { $rc || $sc } {
  120.         if { ![string compare $relief "link"] } {
  121.             if { ![string compare $state "active"] } {
  122.                 set relief "raised"
  123.             } else {
  124.                 set relief "flat"
  125.             }
  126.         }
  127.         $path:cmd configure -relief $relief -state $state
  128.     }
  129.  
  130.     set cv [Widget::hasChanged $path -textvariable var]
  131.     set cn [Widget::hasChanged $path -name name]
  132.     set ct [Widget::hasChanged $path -text text]
  133.     set cu [Widget::hasChanged $path -underline under]
  134.  
  135.     if { $cv || $cn || $ct || $cu } {
  136.         if {  ![string length $var] } {
  137.             set desc [BWidget::getname $name]
  138.             if { [llength $desc] } {
  139.                 set text  [lindex $desc 0]
  140.                 set under [lindex $desc 1]
  141.             }
  142.         } else {
  143.             set under -1
  144.             set text  ""
  145.         }
  146.         set top [winfo toplevel $path]
  147.         bind $top <Alt-$oldaccel> {}
  148.         set accel [string tolower [string index $text $under]]
  149.         if { $accel != "" } {
  150.             bind $top <Alt-$accel> "Button::invoke $path"
  151.         }
  152.         $path:cmd configure -text $text -underline $under -textvariable $var
  153.     }
  154.     DynamicHelp::sethelp $path $path
  155.  
  156.     return $res
  157. }
  158.  
  159.  
  160. # ------------------------------------------------------------------------------
  161. #  Command Button::cget
  162. # ------------------------------------------------------------------------------
  163. proc Button::cget { path option } {
  164.     return [Widget::cget $path $option]
  165. }
  166.  
  167.  
  168. # ------------------------------------------------------------------------------
  169. #  Command Button::invoke
  170. # ------------------------------------------------------------------------------
  171. proc Button::invoke { path } {
  172.     if { [string compare [$path:cmd cget -state] "disabled"] } {
  173.     $path:cmd configure -state active -relief sunken
  174.     update idletasks
  175.         if { [set cmd [Widget::getoption $path -armcommand]] != "" } {
  176.             uplevel \#0 $cmd
  177.         }
  178.     after 100
  179.         set relief [Widget::getoption $path -relief]
  180.         if { ![string compare $relief "link"] } {
  181.             set relief flat
  182.         }
  183.     $path:cmd configure \
  184.             -state  [Widget::getoption $path -state] \
  185.             -relief $relief
  186.         if { [set cmd [Widget::getoption $path -disarmcommand]] != "" } {
  187.             uplevel \#0 $cmd
  188.         }
  189.         if { [set cmd [Widget::getoption $path -command]] != "" } {
  190.             uplevel \#0 $cmd
  191.         }
  192.     }
  193. }
  194.  
  195.  
  196. # ------------------------------------------------------------------------------
  197. #  Command Button::_enter
  198. # ------------------------------------------------------------------------------
  199. proc Button::_enter { path } {
  200.     variable _current
  201.     variable _pressed
  202.  
  203.     set _current $path
  204.     if { [string compare [$path:cmd cget -state] "disabled"] } {
  205.         $path:cmd configure -state active
  206.         if { $_pressed == $path } {
  207.             $path:cmd configure -relief sunken
  208.         } elseif { ![string compare [Widget::getoption $path -relief] "link"] } {
  209.             $path:cmd configure -relief raised
  210.         }
  211.     }
  212. }
  213.  
  214.  
  215. # ------------------------------------------------------------------------------
  216. #  Command Button::_leave
  217. # ------------------------------------------------------------------------------
  218. proc Button::_leave { path } {
  219.     variable _current
  220.     variable _pressed
  221.  
  222.     set _current ""
  223.     if { [string compare [$path:cmd cget -state] "disabled"] } {
  224.         $path:cmd configure -state [Widget::getoption $path -state]
  225.         set relief [Widget::getoption $path -relief]
  226.         if { $_pressed == $path } {
  227.             if { ![string compare $relief "link"] } {
  228.                 set relief raised
  229.             }
  230.             $path:cmd configure -relief $relief
  231.         } elseif { ![string compare $relief "link"] } {
  232.             $path:cmd configure -relief flat
  233.         }
  234.     }
  235. }
  236.  
  237.  
  238. # ------------------------------------------------------------------------------
  239. #  Command Button::_press
  240. # ------------------------------------------------------------------------------
  241. proc Button::_press { path } {
  242.     variable _pressed
  243.  
  244.     if { [string compare [$path:cmd cget -state] "disabled"] } {
  245.         set _pressed $path
  246.     $path:cmd configure -relief sunken
  247.         if { [set cmd [Widget::getoption $path -armcommand]] != "" } {
  248.             uplevel \#0 $cmd
  249.             if { [set delay [Widget::getoption $path -repeatdelay]]    > 0 ||
  250.                  [set delay [Widget::getoption $path -repeatinterval]] > 0 } {
  251.                 after $delay "Button::_repeat $path"
  252.             }
  253.         }
  254.     }
  255. }
  256.  
  257.  
  258. # ------------------------------------------------------------------------------
  259. #  Command Button::_release
  260. # ------------------------------------------------------------------------------
  261. proc Button::_release { path } {
  262.     variable _current
  263.     variable _pressed
  264.  
  265.     if { $_pressed == $path } {
  266.         set _pressed ""
  267.         set relief [Widget::getoption $path -relief]
  268.         if { ![string compare $relief "link"] } {
  269.             set relief raised
  270.         }
  271.         $path:cmd configure -relief $relief
  272.         if { [set cmd [Widget::getoption $path -disarmcommand]] != "" } {
  273.             uplevel \#0 $cmd
  274.         }
  275.         if { $_current == $path &&
  276.              [string compare [$path:cmd cget -state] "disabled"] &&
  277.              [set cmd [Widget::getoption $path -command]] != "" } {
  278.             uplevel \#0 $cmd
  279.         }
  280.     }
  281. }
  282.  
  283.  
  284. # ------------------------------------------------------------------------------
  285. #  Command Button::_repeat
  286. # ------------------------------------------------------------------------------
  287. proc Button::_repeat { path } {
  288.     variable _current
  289.     variable _pressed
  290.  
  291.     if { $_current == $path && $_pressed == $path &&
  292.          [string compare [$path:cmd cget -state] "disabled"] &&
  293.          [set cmd [Widget::getoption $path -armcommand]] != "" } {
  294.         uplevel \#0 $cmd
  295.     }
  296.     if { $_pressed == $path &&
  297.          ([set delay [Widget::getoption $path -repeatinterval]] > 0 ||
  298.           [set delay [Widget::getoption $path -repeatdelay]]    > 0) } {
  299.         after $delay "Button::_repeat $path"
  300.     }
  301. }
  302.  
  303.