Return to button.tcl CVS log

Up to [Micropolis - Activity] / micropolis / res

Annotation of micropolis/res/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: # $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.