Commit | Line | Data |
---|---|---|
86530b38 AT |
1 | # Conversion from Tk4.0 button.tcl competed. |
2 | # Copyright (c) 1992-1994 The Regents of the University of California. | |
3 | # Copyright (c) 1994 Sun Microsystems, Inc. | |
4 | # Copyright (c) 1995-1999 Nick Ing-Simmons. All rights reserved. | |
5 | # This program is free software; you can redistribute it and/or | |
6 | ||
7 | package Tk::Radiobutton; | |
8 | ||
9 | use vars qw($VERSION); | |
10 | $VERSION = '3.013'; # $Id: //depot/Tk8/Tk/Radiobutton.pm#13 $ | |
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::Button; | |
17 | ||
18 | ||
19 | use base qw(Tk::Button); | |
20 | Construct Tk::Widget 'Radiobutton'; | |
21 | ||
22 | sub Tk_cmd { \&Tk::radiobutton } | |
23 | ||
24 | sub CreateOptions | |
25 | { | |
26 | return (shift->SUPER::CreateOptions,'-variable'); | |
27 | } | |
28 | ||
29 | sub ClassInit | |
30 | { | |
31 | my ($class,$mw) = @_; | |
32 | $mw->bind($class,'<Enter>', 'Enter'); | |
33 | $mw->bind($class,'<Leave>', 'Leave'); | |
34 | $mw->bind($class,'<1>', 'Invoke'); | |
35 | $mw->bind($class,'<space>', 'Invoke'); | |
36 | return $class; | |
37 | } | |
38 | ||
39 | sub Invoke | |
40 | { | |
41 | my $w = shift; | |
42 | $w->invoke() unless($w->cget('-state') eq 'disabled'); | |
43 | } | |
44 | ||
45 | 1; |