Commit | Line | Data |
---|---|---|
86530b38 AT |
1 | package Tk::Checkbutton; |
2 | # Conversion from Tk4.0 button.tcl competed. | |
3 | # Copyright (c) 1992-1994 The Regents of the University of California. | |
4 | # Copyright (c) 1994 Sun Microsystems, Inc. | |
5 | # Copyright (c) 1995-1999 Nick Ing-Simmons. All rights reserved. | |
6 | # This program is free software; you can redistribute it and/or | |
7 | ||
8 | ||
9 | use vars qw($VERSION); | |
10 | $VERSION = '3.011'; # $Id: //depot/Tk8/Tk/Checkbutton.pm#11 $ | |
11 | ||
12 | # modify it under the same terms as Perl itself, subject | |
13 | # to additional disclaimer in license.terms due to partial | |
14 | # derivation from Tk4.0 sources. | |
15 | ||
16 | require Tk::Widget; | |
17 | require Tk::Button; | |
18 | ||
19 | use base qw(Tk::Button); | |
20 | ||
21 | Construct Tk::Widget 'Checkbutton'; | |
22 | ||
23 | sub Tk_cmd { \&Tk::checkbutton } | |
24 | ||
25 | ||
26 | sub ClassInit | |
27 | { | |
28 | my ($class,$mw) = @_; | |
29 | $mw->bind($class,'<Enter>', 'Enter'); | |
30 | $mw->bind($class,'<Leave>', 'Leave'); | |
31 | $mw->bind($class,'<1>', 'Invoke'); | |
32 | $mw->bind($class,'<space>', 'Invoke'); | |
33 | return $class; | |
34 | } | |
35 | ||
36 | sub Invoke | |
37 | { | |
38 | my $w = shift; | |
39 | $w->invoke() unless($w->cget('-state') eq 'disabled'); | |
40 | } | |
41 | ||
42 | 1; |