"Fossies" - the Fresh Open Source Software Archive

Member "Tk-804.036/examples/al_bug" (15 Nov 2013, 1178 Bytes) of package /linux/misc/Tk-804.036.tar.gz:

As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) Perl source code syntax highlighting (style: standard) with prefixed line numbers and code folding option. Alternatively you can here view or download the uninterpreted source code file. 
    1 #!/usr/local/bin/perl -w
    2 
    3 use Tk;
    4 use Tk::Table;
    5 use Tk::Entry;
    6 
    7 sub Foo::new {
    8     return bless {}
    9 }
   10 
   11 
   12 $MAX_ITEMS = 10;
   13 $VIEWED_ITEMS = 5;
   14 
   15 $f = new Foo;  # Used later for callback setup.
   16 
   17 $top = new MainWindow();
   18 
   19 my $t  = $top->Table(-scrollbars => 'e',
   20               -rows => $VIEWED_ITEMS,
   21               -columns => 3,
   22               -highlightthickness => 0,
   23               );
   24 $t->pack(-expand => 1,
   25      -fill => 'both'
   26      );
   27 
   28 ### Set up the entries and bindings.
   29 
   30 foreach $r (0..$MAX_ITEMS-1) {
   31     $c = 0;
   32     $tmp = ["0,$r","1,$r","2,$r"];
   33     foreach (@$tmp) {
   34     $e = $t->Entry(-width => 5,
   35                -relief => 'sunken',
   36                -highlightthickness => 0,
   37                -borderwidth => 1,
   38                -textvariable => \$_);
   39     $t->put($r, $c++, $e);
   40     }
   41 
   42     $t->get($r, 0)->bind('<Return>' => [$f, 'recalc', $r]);
   43     $t->get($r, 1)->bind('<Return>' => [$f, 'find', $r]);
   44 }
   45 
   46 MainLoop();
   47 exit;
   48 
   49 sub recalc {
   50     my($self, $r) = @_;
   51 
   52     print STDERR "In recalc on row $r\n";
   53 
   54     my $w = $t->get($r,1);
   55     $w->focus() ;
   56 }
   57 
   58 
   59 sub find {
   60     my($self, $r) = @_;
   61 
   62     print STDERR "In find on row $r\n";
   63 
   64     if (1 && $r < $MAX_ITEMS) {
   65     my $w = $t->get($r+1,0);
   66     $w->focus() ;
   67     $t->see($w);
   68     }
   69 }
   70 __END__
   71