File: newclass.pl

package info (click to toggle)
libtk-histentry-perl 0.43-2
  • links: PTS, VCS
  • area: main
  • in suites: lenny, squeeze, wheezy
  • size: 100 kB
  • ctags: 41
  • sloc: perl: 485; makefile: 36
file content (105 lines) | stat: -rwxr-xr-x 2,559 bytes parent folder | download | duplicates (7)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
#!/usr/local/bin/perl -w
# -*- perl -*-

#
# $Id: newclass.pl,v 1.2 1998/05/20 08:38:12 eserte Exp $
# Author: Slaven Rezic
#
# Copyright (C) 1997,1998 Slaven Rezic. All rights reserved.
# This program is free software; you can redistribute it and/or
# modify it under the same terms as Perl itself.
#
# Mail: eserte@cs.tu-berlin.de
# WWW:  http://user.cs.tu-berlin.de/~eserte/
#

use Tk;
use Tk::HistEntry;
use Tk::FireButton;
use strict;

package MyHistEntry;
@MyHistEntry::ISA = qw(Tk::Frame);
Construct Tk::Widget 'MyHistEntry';

{ my $foo = $Tk::FireButton::INCBITMAP;
     $foo = $Tk::FireButton::DECBITMAP; }

sub Populate {
    my($f, $args) = @_;

    my $e = $f->Component(SimpleHistEntry => 'entry');
    my $binc = $f->Component( FireButton => 'inc',
        -bitmap             => $Tk::FireButton::INCBITMAP,
        -command            => sub { $e->historyUp },
    );

    my $bdec = $f->Component( FireButton => 'dec',
        -bitmap             => $Tk::FireButton::DECBITMAP,
        -command            => sub { $e->historyDown },
    );

    $f->gridColumnconfigure(0, -weight => 1);
    $f->gridColumnconfigure(1, -weight => 0);

    $f->gridRowconfigure(0, -weight => 1);
    $f->gridRowconfigure(1, -weight => 1);

    $binc->grid(-row => 0, -column => 1, -sticky => 'news');
    $bdec->grid(-row => 1, -column => 1, -sticky => 'news');

    $e->grid(-row => 0, -column => 0, -rowspan => 2, -sticky => 'news');

    $f->ConfigSpecs
      (-repeatinterval => ['CHILDREN', "repeatInterval",
			   "RepeatInterval", 100       ],
       -repeatdelay    => ['CHILDREN', "repeatDelay",
			   "RepeatDeleay",   300       ],
       DEFAULT => [$e],
      );

    $f->Delegates(DEFAULT => $e);

    $f;

}

package main;

my $top = new MainWindow;

my($bla);

my($b2, $lb2);
$b2 = $top->MyHistEntry(-textvariable => \$bla,
			-repeatinterval => 30,
			-bell => 1,
			-dup => 1,
			-command => sub {
			    my($w, $s, $added) = @_;
			    if ($added) {
				$lb2->insert('end', $s);
				$lb2->see('end');
			    }
			    $bla = '';
			})->pack;
$lb2 = $top->Scrolled('Listbox', -scrollbars => 'osoe'
		     )->pack;

# # Autodestroy
# my $seconds = 60;
# my $autodestroy_text = "Autodestroy in " . $seconds . "s\n";
# $top->Label(-textvariable => \$autodestroy_text,
# 	   )->pack;
# $top->repeat(1000, sub { if ($seconds <= 0) { $top->destroy }
# 			 $seconds--;
# 			 $autodestroy_text = "Autodestroy in " . $seconds
# 			   . "s\n";
# 		     });

$top->Button(-text => 'Exit',
	     -command => sub { $top->destroy },
	    )->pack;

MainLoop;