home *** CD-ROM | disk | FTP | other *** search
/ Clickx 115 / Clickx 115.iso / software / tools / windows / tails-i386-0.16.iso / live / filesystem.squashfs / usr / share / tcltk / tk8.5 / button.tcl < prev    next >
Encoding:
Text File  |  2009-11-17  |  19.4 KB  |  749 lines
  1. # button.tcl --
  2. #
  3. # This file defines the default bindings for Tk label, button,
  4. # checkbutton, and radiobutton widgets and provides procedures
  5. # that help in implementing those bindings.
  6. #
  7. # RCS: @(#) $Id: button.tcl,v 1.19.4.1 2009/10/24 00:12:03 dkf Exp $
  8. #
  9. # Copyright (c) 1992-1994 The Regents of the University of California.
  10. # Copyright (c) 1994-1996 Sun Microsystems, Inc.
  11. # Copyright (c) 2002 ActiveState Corporation.
  12. #
  13. # See the file "license.terms" for information on usage and redistribution
  14. # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  15. #
  16.  
  17. #-------------------------------------------------------------------------
  18. # The code below creates the default class bindings for buttons.
  19. #-------------------------------------------------------------------------
  20.  
  21. if {[tk windowingsystem] eq "aqua"} {
  22.     bind Radiobutton <Enter> {
  23.     tk::ButtonEnter %W
  24.     }
  25.     bind Radiobutton <1> {
  26.     tk::ButtonDown %W
  27.     }
  28.     bind Radiobutton <ButtonRelease-1> {
  29.     tk::ButtonUp %W
  30.     }
  31.     bind Checkbutton <Enter> {
  32.     tk::ButtonEnter %W
  33.     }
  34.     bind Checkbutton <1> {
  35.     tk::ButtonDown %W
  36.     }
  37.     bind Checkbutton <ButtonRelease-1> {
  38.     tk::ButtonUp %W
  39.     }
  40.     bind Checkbutton <Leave> {
  41.     tk::ButtonLeave %W
  42.     }
  43. }
  44. if {"windows" eq $tcl_platform(platform)} {
  45.     bind Checkbutton <equal> {
  46.     tk::CheckRadioInvoke %W select
  47.     }
  48.     bind Checkbutton <plus> {
  49.     tk::CheckRadioInvoke %W select
  50.     }
  51.     bind Checkbutton <minus> {
  52.     tk::CheckRadioInvoke %W deselect
  53.     }
  54.     bind Checkbutton <1> {
  55.     tk::CheckRadioDown %W
  56.     }
  57.     bind Checkbutton <ButtonRelease-1> {
  58.     tk::ButtonUp %W
  59.     }
  60.     bind Checkbutton <Enter> {
  61.     tk::CheckRadioEnter %W
  62.     }
  63.     bind Checkbutton <Leave> {
  64.     tk::ButtonLeave %W
  65.     }
  66.  
  67.     bind Radiobutton <1> {
  68.     tk::CheckRadioDown %W
  69.     }
  70.     bind Radiobutton <ButtonRelease-1> {
  71.     tk::ButtonUp %W
  72.     }
  73.     bind Radiobutton <Enter> {
  74.     tk::CheckRadioEnter %W
  75.     }
  76. }
  77. if {"x11" eq [tk windowingsystem]} {
  78.     bind Checkbutton <Return> {
  79.     if {!$tk_strictMotif} {
  80.         tk::CheckInvoke %W
  81.     }
  82.     }
  83.     bind Radiobutton <Return> {
  84.     if {!$tk_strictMotif} {
  85.         tk::CheckRadioInvoke %W
  86.     }
  87.     }
  88.     bind Checkbutton <1> {
  89.     tk::CheckInvoke %W
  90.     }
  91.     bind Radiobutton <1> {
  92.     tk::CheckRadioInvoke %W
  93.     }
  94.     bind Checkbutton <Enter> {
  95.     tk::CheckEnter %W
  96.     }
  97.     bind Radiobutton <Enter> {
  98.     tk::ButtonEnter %W
  99.     }
  100.     bind Checkbutton <Leave> {
  101.     tk::CheckLeave %W
  102.     }
  103. }
  104.  
  105. bind Button <space> {
  106.     tk::ButtonInvoke %W
  107. }
  108. bind Checkbutton <space> {
  109.     tk::CheckRadioInvoke %W
  110. }
  111. bind Radiobutton <space> {
  112.     tk::CheckRadioInvoke %W
  113. }
  114.  
  115. bind Button <FocusIn> {}
  116. bind Button <Enter> {
  117.     tk::ButtonEnter %W
  118. }
  119. bind Button <Leave> {
  120.     tk::ButtonLeave %W
  121. }
  122. bind Button <1> {
  123.     tk::ButtonDown %W
  124. }
  125. bind Button <ButtonRelease-1> {
  126.     tk::ButtonUp %W
  127. }
  128.  
  129. bind Checkbutton <FocusIn> {}
  130.  
  131. bind Radiobutton <FocusIn> {}
  132. bind Radiobutton <Leave> {
  133.     tk::ButtonLeave %W
  134. }
  135.  
  136. if {"windows" eq $tcl_platform(platform)} {
  137.  
  138. #########################
  139. # Windows implementation 
  140. #########################
  141.  
  142. # ::tk::ButtonEnter --
  143. # The procedure below is invoked when the mouse pointer enters a
  144. # button widget.  It records the button we're in and changes the
  145. # state of the button to active unless the button is disabled.
  146. #
  147. # Arguments:
  148. # w -        The name of the widget.
  149.  
  150. proc ::tk::ButtonEnter w {
  151.     variable ::tk::Priv
  152.     if {[$w cget -state] ne "disabled"} {
  153.  
  154.     # If the mouse button is down, set the relief to sunken on entry.
  155.     # Overwise, if there's an -overrelief value, set the relief to that.
  156.  
  157.     set Priv($w,relief) [$w cget -relief]
  158.     if {$Priv(buttonWindow) eq $w} {
  159.         $w configure -relief sunken -state active
  160.         set Priv($w,prelief) sunken
  161.     } elseif {[set over [$w cget -overrelief]] ne ""} {
  162.         $w configure -relief $over
  163.         set Priv($w,prelief) $over
  164.     }
  165.     }
  166.     set Priv(window) $w
  167. }
  168.  
  169. # ::tk::ButtonLeave --
  170. # The procedure below is invoked when the mouse pointer leaves a
  171. # button widget.  It changes the state of the button back to inactive.
  172. # Restore any modified relief too.
  173. #
  174. # Arguments:
  175. # w -        The name of the widget.
  176.  
  177. proc ::tk::ButtonLeave w {
  178.     variable ::tk::Priv
  179.     if {[$w cget -state] ne "disabled"} {
  180.     $w configure -state normal
  181.     }
  182.  
  183.     # Restore the original button relief if it was changed by Tk.
  184.     # That is signaled by the existence of Priv($w,prelief).
  185.  
  186.     if {[info exists Priv($w,relief)]} {
  187.     if {[info exists Priv($w,prelief)] && \
  188.         $Priv($w,prelief) eq [$w cget -relief]} {
  189.         $w configure -relief $Priv($w,relief)
  190.     }
  191.     unset -nocomplain Priv($w,relief) Priv($w,prelief)
  192.     }
  193.  
  194.     set Priv(window) ""
  195. }
  196.  
  197. # ::tk::ButtonDown --
  198. # The procedure below is invoked when the mouse button is pressed in
  199. # a button widget.  It records the fact that the mouse is in the button,
  200. # saves the button's relief so it can be restored later, and changes
  201. # the relief to sunken.
  202. #
  203. # Arguments:
  204. # w -        The name of the widget.
  205.  
  206. proc ::tk::ButtonDown w {
  207.     variable ::tk::Priv
  208.  
  209.     # Only save the button's relief if it does not yet exist.  If there
  210.     # is an overrelief setting, Priv($w,relief) will already have been set,
  211.     # and the current value of the -relief option will be incorrect.
  212.  
  213.     if {![info exists Priv($w,relief)]} {
  214.     set Priv($w,relief) [$w cget -relief]
  215.     }
  216.  
  217.     if {[$w cget -state] ne "disabled"} {
  218.     set Priv(buttonWindow) $w
  219.     $w configure -relief sunken -state active
  220.     set Priv($w,prelief) sunken
  221.  
  222.     # If this button has a repeatdelay set up, get it going with an after
  223.     after cancel $Priv(afterId)
  224.     set delay [$w cget -repeatdelay]
  225.     set Priv(repeated) 0
  226.     if {$delay > 0} {
  227.         set Priv(afterId) [after $delay [list tk::ButtonAutoInvoke $w]]
  228.     }
  229.     }
  230. }
  231.  
  232. # ::tk::ButtonUp --
  233. # The procedure below is invoked when the mouse button is released
  234. # in a button widget.  It restores the button's relief and invokes
  235. # the command as long as the mouse hasn't left the button.
  236. #
  237. # Arguments:
  238. # w -        The name of the widget.
  239.  
  240. proc ::tk::ButtonUp w {
  241.     variable ::tk::Priv
  242.     if {$Priv(buttonWindow) eq $w} {
  243.     set Priv(buttonWindow) ""
  244.  
  245.     # Restore the button's relief if it was cached.
  246.  
  247.     if {[info exists Priv($w,relief)]} {
  248.         if {[info exists Priv($w,prelief)] && \
  249.             $Priv($w,prelief) eq [$w cget -relief]} {
  250.         $w configure -relief $Priv($w,relief)
  251.         }
  252.         unset -nocomplain Priv($w,relief) Priv($w,prelief)
  253.     }
  254.  
  255.     # Clean up the after event from the auto-repeater
  256.     after cancel $Priv(afterId)
  257.  
  258.     if {$Priv(window) eq $w && [$w cget -state] ne "disabled"} {
  259.         $w configure -state normal
  260.  
  261.         # Only invoke the command if it wasn't already invoked by the
  262.         # auto-repeater functionality
  263.         if { $Priv(repeated) == 0 } {
  264.         uplevel #0 [list $w invoke]
  265.         }
  266.     }
  267.     }
  268. }
  269.  
  270. # ::tk::CheckRadioEnter --
  271. # The procedure below is invoked when the mouse pointer enters a
  272. # checkbutton or radiobutton widget.  It records the button we're in
  273. # and changes the state of the button to active unless the button is
  274. # disabled.
  275. #
  276. # Arguments:
  277. # w -        The name of the widget.
  278.  
  279. proc ::tk::CheckRadioEnter w {
  280.     variable ::tk::Priv
  281.     if {[$w cget -state] ne "disabled"} {
  282.     if {$Priv(buttonWindow) eq $w} {
  283.         $w configure -state active
  284.     }
  285.     if {[set over [$w cget -overrelief]] ne ""} {
  286.         set Priv($w,relief)  [$w cget -relief]
  287.         set Priv($w,prelief) $over
  288.         $w configure -relief $over
  289.     }
  290.     }
  291.     set Priv(window) $w
  292. }
  293.  
  294. # ::tk::CheckRadioDown --
  295. # The procedure below is invoked when the mouse button is pressed in
  296. # a button widget.  It records the fact that the mouse is in the button,
  297. # saves the button's relief so it can be restored later, and changes
  298. # the relief to sunken.
  299. #
  300. # Arguments:
  301. # w -        The name of the widget.
  302.  
  303. proc ::tk::CheckRadioDown w {
  304.     variable ::tk::Priv
  305.     if {![info exists Priv($w,relief)]} {
  306.     set Priv($w,relief) [$w cget -relief]
  307.     }
  308.     if {[$w cget -state] ne "disabled"} {
  309.     set Priv(buttonWindow) $w
  310.     set Priv(repeated) 0
  311.     $w configure -state active
  312.     }
  313. }
  314.  
  315. }
  316.  
  317. if {"x11" eq [tk windowingsystem]} {
  318.  
  319. #####################
  320. # Unix implementation
  321. #####################
  322.  
  323. # ::tk::ButtonEnter --
  324. # The procedure below is invoked when the mouse pointer enters a
  325. # button widget.  It records the button we're in and changes the
  326. # state of the button to active unless the button is disabled.
  327. #
  328. # Arguments:
  329. # w -        The name of the widget.
  330.  
  331. proc ::tk::ButtonEnter {w} {
  332.     variable ::tk::Priv
  333.     if {[$w cget -state] ne "disabled"} {
  334.     # On unix the state is active just with mouse-over
  335.     $w configure -state active
  336.  
  337.     # If the mouse button is down, set the relief to sunken on entry.
  338.     # Overwise, if there's an -overrelief value, set the relief to that.
  339.  
  340.     set Priv($w,relief) [$w cget -relief]
  341.     if {$Priv(buttonWindow) eq $w} {
  342.         $w configure -relief sunken
  343.         set Priv($w,prelief) sunken
  344.     } elseif {[set over [$w cget -overrelief]] ne ""} {
  345.         $w configure -relief $over
  346.         set Priv($w,prelief) $over
  347.     }
  348.     }
  349.     set Priv(window) $w
  350. }
  351.  
  352. # ::tk::ButtonLeave --
  353. # The procedure below is invoked when the mouse pointer leaves a
  354. # button widget.  It changes the state of the button back to inactive.
  355. # Restore any modified relief too.
  356. #
  357. # Arguments:
  358. # w -        The name of the widget.
  359.  
  360. proc ::tk::ButtonLeave w {
  361.     variable ::tk::Priv
  362.     if {[$w cget -state] ne "disabled"} {
  363.     $w configure -state normal
  364.     }
  365.  
  366.     # Restore the original button relief if it was changed by Tk.
  367.     # That is signaled by the existence of Priv($w,prelief).
  368.  
  369.     if {[info exists Priv($w,relief)]} {
  370.     if {[info exists Priv($w,prelief)] && \
  371.         $Priv($w,prelief) eq [$w cget -relief]} {
  372.         $w configure -relief $Priv($w,relief)
  373.     }
  374.     unset -nocomplain Priv($w,relief) Priv($w,prelief)
  375.     }
  376.  
  377.     set Priv(window) ""
  378. }
  379.  
  380. # ::tk::ButtonDown --
  381. # The procedure below is invoked when the mouse button is pressed in
  382. # a button widget.  It records the fact that the mouse is in the button,
  383. # saves the button's relief so it can be restored later, and changes
  384. # the relief to sunken.
  385. #
  386. # Arguments:
  387. # w -        The name of the widget.
  388.  
  389. proc ::tk::ButtonDown w {
  390.     variable ::tk::Priv
  391.  
  392.     # Only save the button's relief if it does not yet exist.  If there
  393.     # is an overrelief setting, Priv($w,relief) will already have been set,
  394.     # and the current value of the -relief option will be incorrect.
  395.  
  396.     if {![info exists Priv($w,relief)]} {
  397.     set Priv($w,relief) [$w cget -relief]
  398.     }
  399.  
  400.     if {[$w cget -state] ne "disabled"} {
  401.     set Priv(buttonWindow) $w
  402.     $w configure -relief sunken
  403.     set Priv($w,prelief) sunken
  404.  
  405.     # If this button has a repeatdelay set up, get it going with an after
  406.     after cancel $Priv(afterId)
  407.     set delay [$w cget -repeatdelay]
  408.     set Priv(repeated) 0
  409.     if {$delay > 0} {
  410.         set Priv(afterId) [after $delay [list tk::ButtonAutoInvoke $w]]
  411.     }
  412.     }
  413. }
  414.  
  415. # ::tk::ButtonUp --
  416. # The procedure below is invoked when the mouse button is released
  417. # in a button widget.  It restores the button's relief and invokes
  418. # the command as long as the mouse hasn't left the button.
  419. #
  420. # Arguments:
  421. # w -        The name of the widget.
  422.  
  423. proc ::tk::ButtonUp w {
  424.     variable ::tk::Priv
  425.     if {$w eq $Priv(buttonWindow)} {
  426.     set Priv(buttonWindow) ""
  427.  
  428.     # Restore the button's relief if it was cached.
  429.  
  430.     if {[info exists Priv($w,relief)]} {
  431.         if {[info exists Priv($w,prelief)] && \
  432.             $Priv($w,prelief) eq [$w cget -relief]} {
  433.         $w configure -relief $Priv($w,relief)
  434.         }
  435.         unset -nocomplain Priv($w,relief) Priv($w,prelief)
  436.     }
  437.  
  438.     # Clean up the after event from the auto-repeater
  439.     after cancel $Priv(afterId)
  440.  
  441.     if {$Priv(window) eq $w && [$w cget -state] ne "disabled"} {
  442.         # Only invoke the command if it wasn't already invoked by the
  443.         # auto-repeater functionality
  444.         if { $Priv(repeated) == 0 } {
  445.         uplevel #0 [list $w invoke]
  446.         }
  447.     }
  448.     }
  449. }
  450.  
  451. }
  452.  
  453. if {[tk windowingsystem] eq "aqua"} {
  454.  
  455. ####################
  456. # Mac implementation
  457. ####################
  458.  
  459. # ::tk::ButtonEnter --
  460. # The procedure below is invoked when the mouse pointer enters a
  461. # button widget.  It records the button we're in and changes the
  462. # state of the button to active unless the button is disabled.
  463. #
  464. # Arguments:
  465. # w -        The name of the widget.
  466.  
  467. proc ::tk::ButtonEnter {w} {
  468.     variable ::tk::Priv
  469.     if {[$w cget -state] ne "disabled"} {
  470.  
  471.     # If there's an -overrelief value, set the relief to that.
  472.  
  473.     if {$Priv(buttonWindow) eq $w} {
  474.         $w configure -state active
  475.     } elseif {[set over [$w cget -overrelief]] ne ""} {
  476.         set Priv($w,relief)  [$w cget -relief]
  477.         set Priv($w,prelief) $over
  478.         $w configure -relief $over
  479.     }
  480.     }
  481.     set Priv(window) $w
  482. }
  483.  
  484. # ::tk::ButtonLeave --
  485. # The procedure below is invoked when the mouse pointer leaves a
  486. # button widget.  It changes the state of the button back to
  487. # inactive.  If we're leaving the button window with a mouse button
  488. # pressed (Priv(buttonWindow) == $w), restore the relief of the
  489. # button too.
  490. #
  491. # Arguments:
  492. # w -        The name of the widget.
  493.  
  494. proc ::tk::ButtonLeave w {
  495.     variable ::tk::Priv
  496.     if {$w eq $Priv(buttonWindow)} {
  497.     $w configure -state normal
  498.     }
  499.  
  500.     # Restore the original button relief if it was changed by Tk.
  501.     # That is signaled by the existence of Priv($w,prelief).
  502.  
  503.     if {[info exists Priv($w,relief)]} {
  504.     if {[info exists Priv($w,prelief)] && \
  505.         $Priv($w,prelief) eq [$w cget -relief]} {
  506.         $w configure -relief $Priv($w,relief)
  507.     }
  508.     unset -nocomplain Priv($w,relief) Priv($w,prelief)
  509.     }
  510.  
  511.     set Priv(window) ""
  512. }
  513.  
  514. # ::tk::ButtonDown --
  515. # The procedure below is invoked when the mouse button is pressed in
  516. # a button widget.  It records the fact that the mouse is in the button,
  517. # saves the button's relief so it can be restored later, and changes
  518. # the relief to sunken.
  519. #
  520. # Arguments:
  521. # w -        The name of the widget.
  522.  
  523. proc ::tk::ButtonDown w {
  524.     variable ::tk::Priv
  525.  
  526.     if {[$w cget -state] ne "disabled"} {
  527.     set Priv(buttonWindow) $w
  528.     $w configure -state active
  529.  
  530.     # If this button has a repeatdelay set up, get it going with an after
  531.     after cancel $Priv(afterId)
  532.     set Priv(repeated) 0
  533.     if { ![catch {$w cget -repeatdelay} delay] } {
  534.         if {$delay > 0} {
  535.         set Priv(afterId) [after $delay [list tk::ButtonAutoInvoke $w]]
  536.         }
  537.     }
  538.     }
  539. }
  540.  
  541. # ::tk::ButtonUp --
  542. # The procedure below is invoked when the mouse button is released
  543. # in a button widget.  It restores the button's relief and invokes
  544. # the command as long as the mouse hasn't left the button.
  545. #
  546. # Arguments:
  547. # w -        The name of the widget.
  548.  
  549. proc ::tk::ButtonUp w {
  550.     variable ::tk::Priv
  551.     if {$Priv(buttonWindow) eq $w} {
  552.     set Priv(buttonWindow) ""
  553.     $w configure -state normal
  554.  
  555.     # Restore the button's relief if it was cached.
  556.  
  557.     if {[info exists Priv($w,relief)]} {
  558.         if {[info exists Priv($w,prelief)] && \
  559.             $Priv($w,prelief) eq [$w cget -relief]} {
  560.         $w configure -relief $Priv($w,relief)
  561.         }
  562.         unset -nocomplain Priv($w,relief) Priv($w,prelief)
  563.     }
  564.  
  565.     # Clean up the after event from the auto-repeater
  566.     after cancel $Priv(afterId)
  567.  
  568.     if {$Priv(window) eq $w && [$w cget -state] ne "disabled"} {
  569.         # Only invoke the command if it wasn't already invoked by the
  570.         # auto-repeater functionality
  571.         if { $Priv(repeated) == 0 } {
  572.         uplevel #0 [list $w invoke]
  573.         }
  574.     }
  575.     }
  576. }
  577.  
  578. }
  579.  
  580. ##################
  581. # Shared routines
  582. ##################
  583.  
  584. # ::tk::ButtonInvoke --
  585. # The procedure below is called when a button is invoked through
  586. # the keyboard.  It simulate a press of the button via the mouse.
  587. #
  588. # Arguments:
  589. # w -        The name of the widget.
  590.  
  591. proc ::tk::ButtonInvoke w {
  592.     if {[$w cget -state] ne "disabled"} {
  593.     set oldRelief [$w cget -relief]
  594.     set oldState [$w cget -state]
  595.     $w configure -state active -relief sunken
  596.     update idletasks
  597.     after 100
  598.     $w configure -state $oldState -relief $oldRelief
  599.     uplevel #0 [list $w invoke]
  600.     }
  601. }
  602.  
  603. # ::tk::ButtonAutoInvoke --
  604. #
  605. #    Invoke an auto-repeating button, and set it up to continue to repeat.
  606. #
  607. # Arguments:
  608. #    w    button to invoke.
  609. #
  610. # Results:
  611. #    None.
  612. #
  613. # Side effects:
  614. #    May create an after event to call ::tk::ButtonAutoInvoke.
  615.  
  616. proc ::tk::ButtonAutoInvoke {w} {
  617.     variable ::tk::Priv
  618.     after cancel $Priv(afterId)
  619.     set delay [$w cget -repeatinterval]
  620.     if {$Priv(window) eq $w} {
  621.     incr Priv(repeated)
  622.     uplevel #0 [list $w invoke]
  623.     }
  624.     if {$delay > 0} {
  625.     set Priv(afterId) [after $delay [list tk::ButtonAutoInvoke $w]]
  626.     }
  627. }
  628.  
  629. # ::tk::CheckRadioInvoke --
  630. # The procedure below is invoked when the mouse button is pressed in
  631. # a checkbutton or radiobutton widget, or when the widget is invoked
  632. # through the keyboard.  It invokes the widget if it
  633. # isn't disabled.
  634. #
  635. # Arguments:
  636. # w -        The name of the widget.
  637. # cmd -        The subcommand to invoke (one of invoke, select, or deselect).
  638.  
  639. proc ::tk::CheckRadioInvoke {w {cmd invoke}} {
  640.     if {[$w cget -state] ne "disabled"} {
  641.     uplevel #0 [list $w $cmd]
  642.     }
  643. }
  644.  
  645. # Special versions of the handlers for checkbuttons on Unix that do the magic
  646. # to make things work right when the checkbutton indicator is hidden;
  647. # radiobuttons don't need this complexity.
  648.  
  649. # ::tk::CheckInvoke --
  650. # The procedure below invokes the checkbutton, like ButtonInvoke, but handles
  651. # what to do when the checkbutton indicator is missing. Only used on Unix.
  652. #
  653. # Arguments:
  654. # w -        The name of the widget.
  655.  
  656. proc ::tk::CheckInvoke {w} {
  657.     variable ::tk::Priv
  658.     if {[$w cget -state] ne "disabled"} {
  659.     # Additional logic to switch the "selected" colors around if necessary
  660.     # (when we're indicator-less).
  661.  
  662.     if {![$w cget -indicatoron]} {
  663.         if {[$w cget -selectcolor] eq $Priv($w,aselectcolor)} {
  664.         $w configure -selectcolor $Priv($w,selectcolor)
  665.         } else {
  666.         $w configure -selectcolor $Priv($w,aselectcolor)
  667.         }
  668.     }
  669.     uplevel #0 [list $w invoke]
  670.     }
  671. }
  672.  
  673. # ::tk::CheckEnter --
  674. # The procedure below enters the checkbutton, like ButtonEnter, but handles
  675. # what to do when the checkbutton indicator is missing. Only used on Unix.
  676. #
  677. # Arguments:
  678. # w -        The name of the widget.
  679.  
  680. proc ::tk::CheckEnter {w} {
  681.     variable ::tk::Priv
  682.     if {[$w cget -state] ne "disabled"} {
  683.     # On unix the state is active just with mouse-over
  684.     $w configure -state active
  685.  
  686.     # If the mouse button is down, set the relief to sunken on entry.
  687.     # Overwise, if there's an -overrelief value, set the relief to that.
  688.  
  689.     set Priv($w,relief) [$w cget -relief]
  690.     if {$Priv(buttonWindow) eq $w} {
  691.         $w configure -relief sunken
  692.         set Priv($w,prelief) sunken
  693.     } elseif {[set over [$w cget -overrelief]] ne ""} {
  694.         $w configure -relief $over
  695.         set Priv($w,prelief) $over
  696.     }
  697.  
  698.     # Compute what the "selected and active" color should be.
  699.  
  700.     if {![$w cget -indicatoron]} {
  701.         set Priv($w,selectcolor) [$w cget -selectcolor]
  702.         lassign [winfo rgb $w [$w cget -selectcolor]]      r1 g1 b1
  703.         lassign [winfo rgb $w [$w cget -activebackground]] r2 g2 b2
  704.         set Priv($w,aselectcolor) \
  705.         [format "#%04x%04x%04x" [expr {($r1+$r2)/2}] \
  706.              [expr {($g1+$g2)/2}] [expr {($b1+$b2)/2}]]
  707.         if {[set ::[$w cget -variable]] eq [$w cget -onvalue]} {
  708.         $w configure -selectcolor $Priv($w,aselectcolor)
  709.         }
  710.     }
  711.     }
  712.     set Priv(window) $w
  713. }
  714.  
  715. # ::tk::CheckLeave --
  716. # The procedure below leaves the checkbutton, like ButtonLeave, but handles
  717. # what to do when the checkbutton indicator is missing. Only used on Unix.
  718. #
  719. # Arguments:
  720. # w -        The name of the widget.
  721.  
  722. proc ::tk::CheckLeave {w} {
  723.     variable ::tk::Priv
  724.     if {[$w cget -state] ne "disabled"} {
  725.     $w configure -state normal
  726.     }
  727.  
  728.     # Restore the original button "selected" color; assume that the user
  729.     # wasn't monkeying around with things too much.
  730.  
  731.     if {![$w cget -indicatoron] && [info exist Priv($w,selectcolor)]} {
  732.     $w configure -selectcolor $Priv($w,selectcolor)
  733.     }
  734.     unset -nocomplain Priv($w,selectcolor) Priv($w,aselectcolor)
  735.  
  736.     # Restore the original button relief if it was changed by Tk. That is
  737.     # signaled by the existence of Priv($w,prelief).
  738.  
  739.     if {[info exists Priv($w,relief)]} {
  740.     if {[info exists Priv($w,prelief)] && \
  741.         $Priv($w,prelief) eq [$w cget -relief]} {
  742.         $w configure -relief $Priv($w,relief)
  743.     }
  744.     unset -nocomplain Priv($w,relief) Priv($w,prelief)
  745.     }
  746.  
  747.     set Priv(window) ""
  748. }
  749.