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     ! 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.