← Back to branch summary

~ubuntu-branches/ubuntu/intrepid/horae/intrepid

« back to all changes in this revision

Viewing changes to 0CPAN/Tk-HistEntry-0.42/examples/newclass.pl

  • Committer: Bazaar Package Importer
  • Author(s): Carlo Segre
  • Date: 2008-02-23 23:13:02 UTC
  • mfrom: (2.1.2 hardy)
  • Revision ID: james.westby@ubuntu.com-20080223231302-mnyyxs3icvrus4ke
Tags: 066-3
Apply patch to athena_parts/misc.pl for compatibility with 
perl-tk 804.28.

Show diffs side-by-side

added added

removed removed

Lines of Context:
0CPAN/Tk-HistEntry-0.42/examples/newclass.pl
1
 
#!/usr/local/bin/perl -w
2
 
# -*- perl -*-
3
 
 
4
 
#
5
 
# $Id: newclass.pl,v 1.2 1998/05/20 08:38:12 eserte Exp $
6
 
# Author: Slaven Rezic
7
 
#
8
 
# Copyright (C) 1997,1998 Slaven Rezic. All rights reserved.
9
 
# This program is free software; you can redistribute it and/or
10
 
# modify it under the same terms as Perl itself.
11
 
#
12
 
# Mail: eserte@cs.tu-berlin.de
13
 
# WWW:  http://user.cs.tu-berlin.de/~eserte/
14
 
#
15
 
 
16
 
use Tk;
17
 
use Tk::HistEntry;
18
 
use Tk::FireButton;
19
 
use strict;
20
 
 
21
 
package MyHistEntry;
22
 
@MyHistEntry::ISA = qw(Tk::Frame);
23
 
Construct Tk::Widget 'MyHistEntry';
24
 
 
25
 
{ my $foo = $Tk::FireButton::INCBITMAP;
26
 
     $foo = $Tk::FireButton::DECBITMAP; }
27
 
 
28
 
sub Populate {
29
 
    my($f, $args) = @_;
30
 
 
31
 
    my $e = $f->Component(SimpleHistEntry => 'entry');
32
 
    my $binc = $f->Component( FireButton => 'inc',
33
 
        -bitmap             => $Tk::FireButton::INCBITMAP,
34
 
        -command            => sub { $e->historyUp },
35
 
    );
36
 
 
37
 
    my $bdec = $f->Component( FireButton => 'dec',
38
 
        -bitmap             => $Tk::FireButton::DECBITMAP,
39
 
        -command            => sub { $e->historyDown },
40
 
    );
41
 
 
42
 
    $f->gridColumnconfigure(0, -weight => 1);
43
 
    $f->gridColumnconfigure(1, -weight => 0);
44
 
 
45
 
    $f->gridRowconfigure(0, -weight => 1);
46
 
    $f->gridRowconfigure(1, -weight => 1);
47
 
 
48
 
    $binc->grid(-row => 0, -column => 1, -sticky => 'news');
49
 
    $bdec->grid(-row => 1, -column => 1, -sticky => 'news');
50
 
 
51
 
    $e->grid(-row => 0, -column => 0, -rowspan => 2, -sticky => 'news');
52
 
 
53
 
    $f->ConfigSpecs
54
 
      (-repeatinterval => ['CHILDREN', "repeatInterval",
55
 
                           "RepeatInterval", 100       ],
56
 
       -repeatdelay    => ['CHILDREN', "repeatDelay",
57
 
                           "RepeatDeleay",   300       ],
58
 
       DEFAULT => [$e],
59
 
      );
60
 
 
61
 
    $f->Delegates(DEFAULT => $e);
62
 
 
63
 
    $f;
64
 
 
65
 
}
66
 
 
67
 
package main;
68
 
 
69
 
my $top = new MainWindow;
70
 
 
71
 
my($bla);
72
 
 
73
 
my($b2, $lb2);
74
 
$b2 = $top->MyHistEntry(-textvariable => \$bla,
75
 
                        -repeatinterval => 30,
76
 
                        -bell => 1,
77
 
                        -dup => 1,
78
 
                        -command => sub {
79
 
                            my($w, $s, $added) = @_;
80
 
                            if ($added) {
81
 
                                $lb2->insert('end', $s);
82
 
                                $lb2->see('end');
83
 
                            }
84
 
                            $bla = '';
85
 
                        })->pack;
86
 
$lb2 = $top->Scrolled('Listbox', -scrollbars => 'osoe'
87
 
                     )->pack;
88
 
 
89
 
# # Autodestroy
90
 
# my $seconds = 60;
91
 
# my $autodestroy_text = "Autodestroy in " . $seconds . "s\n";
92
 
# $top->Label(-textvariable => \$autodestroy_text,
93
 
#          )->pack;
94
 
# $top->repeat(1000, sub { if ($seconds <= 0) { $top->destroy }
95
 
#                        $seconds--;
96
 
#                        $autodestroy_text = "Autodestroy in " . $seconds
97
 
#                          . "s\n";
98
 
#                    });
99
 
 
100
 
$top->Button(-text => 'Exit',
101
 
             -command => sub { $top->destroy },
102
 
            )->pack;
103
 
 
104
 
MainLoop;
105