1#!/usr/local/bin/perl -w
2use strict;
3use Tk qw(MainLoop *widget);
4use Carp;
5
6my $mw = MainWindow->new;
7
8$mw->Button(-text => 'Button_1', -command => \&callback)->pack;
9my $w = $mw->Button(-text => 'Button_2', -command => \&callback)->pack;
10
11$mw->Button(-text => 'Quit', -command => [destroy => $mw])->pack;
12
13$w->after(1000,\&callback);
14
15MainLoop;
16
17sub callback
18{
19 print $widget->PathName,"\n";
20 my $w = $Tk::widget;
21 if (defined $w)
22  {
23   print "Callback for ",$w->cget('-text'),"\n";
24  }
25 else
26  {
27   carp "No widget!";
28  }
29}
30