Return to button.tcl CVS log

Up to [Micropolis - Activity] / micropolis / res

Annotation of micropolis/res/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: # $tk_priv(window@$screen) keeps track of the button containing the mouse, 
        !            18: # and $tk_priv(relief@$screen) saves the original relief of the button so 
        !            19: # it can be restored when the mouse button is released.
        !            20: 
        !            21: # The procedure below is invoked when the mouse pointer enters a
        !            22: # button widget.  It records the button we're in and changes the
        !            23: # state of the button to active unless the button is disabled.
        !            24: 
        !            25: proc tk_butEnter w {
        !            26:     global tk_priv
        !            27:     set screen [winfo screen $w]
        !            28:     if {[lindex [$w config -state] 4] != "disabled"} {
        !            29:        $w config -state active
        !            30:        set tk_priv(window@$screen) $w
        !            31:     } else {
        !            32:        set tk_priv(window@$screen) ""
        !            33:     }
        !            34: }
        !            35: 
        !            36: # The procedure below is invoked when the mouse pointer leaves a
        !            37: # button widget.  It changes the state of the button back to
        !            38: # inactive.
        !            39: 
        !            40: proc tk_butLeave w {
        !            41:     global tk_priv
        !            42:     if {[lindex [$w config -state] 4] != "disabled"} {
        !            43:        $w config -state normal
        !            44:     }
        !            45:     set screen [winfo screen $w]
        !            46:     set tk_priv(window@$screen) ""
        !            47: }
        !            48: 
        !            49: # The procedure below is invoked when the mouse button is pressed in
        !            50: # a button/radiobutton/checkbutton widget.  It records information
        !            51: # (a) to indicate that the mouse is in the button, and
        !            52: # (b) to save the button's relief so it can be restored later.
        !            53: 
        !            54: proc tk_butDown w {
        !            55:     global tk_priv
        !            56:     set screen [winfo screen $w]
        !            57:     set tk_priv(relief@$screen) [lindex [$w config -relief] 4]
        !            58:     if {[lindex [$w config -state] 4] != "disabled"} {
        !            59:        $w config -relief sunken
        !            60:        update idletasks
        !            61:     }
        !            62: }
        !            63: 
        !            64: # The procedure below is invoked when the mouse button is released
        !            65: # for a button/radiobutton/checkbutton widget.  It restores the
        !            66: # button's relief and invokes the command as long as the mouse
        !            67: # hasn't left the button.
        !            68: 
        !            69: proc tk_butUp w {
        !            70:     global tk_priv
        !            71:     set screen [winfo screen $w]
        !            72:     $w config -relief $tk_priv(relief@$screen)
        !            73:     update idletasks
        !            74:     if {($w == $tk_priv(window@$screen))
        !            75:            && ([lindex [$w config -state] 4] != "disabled")} {
        !            76:        uplevel #0 [list $w invoke]
        !            77:     }
        !            78: }

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