Return to button.tcl CVS log

Up to [Micropolis - Activity] / micropolis / src / tk / library

Annotation of micropolis/src/tk/library/button.tcl, revision 1.1.1.1

1.1       root        1: # button.tcl --
                      2: #
                      3: # This file contains Tcl procedures used to manage Tk buttons.
                      4: #
                      5: # $Header: /user6/ouster/wish/scripts/RCS/button.tcl,v 1.7 92/07/28 15:41:13 ouster Exp $ SPRITE (Berkeley)
                      6: #
                      7: # Copyright 1992 Regents of the University of California
                      8: # Permission to use, copy, modify, and distribute this
                      9: # software and its documentation for any purpose and without
                     10: # fee is hereby granted, provided that this copyright
                     11: # notice appears in all copies.  The University of California
                     12: # makes no representations about the suitability of this
                     13: # software for any purpose.  It is provided "as is" without
                     14: # express or implied warranty.
                     15: #
                     16: 
                     17: # The procedure below is invoked when the mouse pointer enters a
                     18: # button widget.  It records the button we're in and changes the
                     19: # state of the button to active unless the button is disabled.
                     20: 
                     21: proc tk_butEnter w {
                     22:     global tk_priv tk_strictMotif
                     23:     if {[lindex [$w config -state] 4] != "disabled"} {
                     24:        if {!$tk_strictMotif} {
                     25:            $w config -state active
                     26:        }
                     27:        set tk_priv(window) $w
                     28:     }
                     29: }
                     30: 
                     31: # The procedure below is invoked when the mouse pointer leaves a
                     32: # button widget.  It changes the state of the button back to
                     33: # inactive.
                     34: 
                     35: proc tk_butLeave w {
                     36:     global tk_priv tk_strictMotif
                     37:     if {[lindex [$w config -state] 4] != "disabled"} {
                     38:        if {!$tk_strictMotif} {
                     39:            $w config -state normal
                     40:        }
                     41:     }
                     42:     set tk_priv(window) ""
                     43: }
                     44: 
                     45: # The procedure below is invoked when the mouse button is pressed in
                     46: # a button/radiobutton/checkbutton widget.  It records information
                     47: # (a) to indicate that the mouse is in the button, and
                     48: # (b) to save the button's relief so it can be restored later.
                     49: 
                     50: proc tk_butDown w {
                     51:     global tk_priv
                     52:     set tk_priv(relief) [lindex [$w config -relief] 4]
                     53:     if {[lindex [$w config -state] 4] != "disabled"} {
                     54:        $w config -relief sunken
                     55:     }
                     56: }
                     57: 
                     58: # The procedure below is invoked when the mouse button is released
                     59: # for a button/radiobutton/checkbutton widget.  It restores the
                     60: # button's relief and invokes the command as long as the mouse
                     61: # hasn't left the button.
                     62: 
                     63: proc tk_butUp w {
                     64:     global tk_priv
                     65:     $w config -relief $tk_priv(relief)
                     66:     if {($w == $tk_priv(window))
                     67:            && ([lindex [$w config -state] 4] != "disabled")} {
                     68:        uplevel #0 [list $w invoke]
                     69:     }
                     70: }

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.