figenc

[RADIOACTIVE] rsa and symmetric key encryption scripts and executables
git clone git://git.figbert.com/figenc.git
Log | Files | Refs | README

button.tcl (20642B)


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