util/src/TclTk/tk8.6.12/library/button.tcl

   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; but only if the user
 752     # has not changed it in the meantime.
 753
 754     if {![$w cget -indicatoron] && [info exist Priv($w,selectcolor)]} {
 755         if {[$w cget -selectcolor] eq $Priv($w,selectcolor)
 756                 || ([info exist Priv($w,aselectcolor)] &&
 757                     [$w cget -selectcolor] eq $Priv($w,aselectcolor))} {
 758             $w configure -selectcolor $Priv($w,selectcolor)
 759         }
 760     }
 761     unset -nocomplain Priv($w,selectcolor) Priv($w,aselectcolor)
 762
 763     # Restore the original button relief if it was changed by Tk. That is
 764     # signaled by the existence of Priv($w,prelief).
 765
 766     if {[info exists Priv($w,relief)]} {
 767         if {[info exists Priv($w,prelief)] && \
 768                 $Priv($w,prelief) eq [$w cget -relief]} {
 769             $w configure -relief $Priv($w,relief)
 770         }
 771         unset -nocomplain Priv($w,relief) Priv($w,prelief)
 772     }
 773
 774     set Priv(window) ""
 775 }
 776
 777 return
 778 \f
 779 # Local Variables:
 780 # mode: tcl
 781 # fill-column: 78
 782 # End: