view release on metacpan or  search on metacpan

More.pm  view on Meta::CPAN

package Tk::More;

use strict;
use vars qw($VERSION @ISA);

$VERSION = '5.09';

use Tk qw(Ev);
use Tk::Derived;
use Tk::Frame;
@ISA = qw(Tk::Derived Tk::Frame);

Construct Tk::Widget 'More';

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

    require Tk::ROText;
    require Tk::LabEntry;

    $cw->SUPER::Populate($args);

    my $Entry = 'LabEntry';
    my @Entry_args;
    if (eval { die "Not yet";
	       require Tk::HistEntry;
	       Tk::HistEntry->VERSION(0.37);
	       1;
	   }) {
	$Entry = 'HistEntry';
    } else {
	@Entry_args = (-labelPack=>[-side =>'left']);
    }

    my $search;
    my $e = $cw->$Entry(
		@Entry_args,
		-textvariable => \$search,
		-relief => 'flat',
		-state => 'disabled',
		)->pack(-side=>'bottom', -fill => 'x', -expand=>'no');
    $cw->Advertise('searchentry' => $e);

    my $t = $cw->ROText(-cursor=>undef)->pack(-fill => 'both' , -expand => 'yes');
    $cw->Advertise('text' => $t);
    $t->tagConfigure('search', -foreground => 'red');

    # reorder bindings: private widget bindings first
    $t->bindtags([$t, grep { $_ ne $t->PathName } $t->bindtags]);

    $t->bind('<Key-slash>',    [$cw, 'Search', 'Next']);
    $t->bind('<Key-question>', [$cw, 'Search', 'Prev']);
    $t->bind('<Key-n>',        [$cw, 'ShowMatch', 'Next']);
    $t->bind('<Key-N>',        [$cw, 'ShowMatch', 'Prev']);

    $t->bind('<Key-g>', $t->bind(ref($t),'<Control-Home>'));
    $t->bind('<Key-G>', $t->bind(ref($t),'<Control-End>'));
    $t->bind('<Home>',  $t->bind('<Key-g>'));
    $t->bind('<End>',   $t->bind('<Key-G>'));

    $t->bind('<Key-j>', [$cw, 'scroll', $t,  1, 'line']);
    $t->bind('<Down>',  [$cw, 'scroll', $t,  1, 'line']);
    $t->bind('<Key-k>', [$cw, 'scroll', $t, -1, 'line']);
    $t->bind('<Up>',    [$cw, 'scroll', $t, -1, 'line']);

    $t->bind('<Key-f>', [$cw, 'scroll', $t,  1, 'page']);
    $t->bind('<Next>',  [$cw, 'scroll', $t,  1, 'page']);
    $t->bind('<Key-b>', [$cw, 'scroll', $t, -1, 'page']);
    $t->bind('<Prior>', [$cw, 'scroll', $t, -1, 'page']);

    $t->bind('<Right>', [sub {