File: tkmore

package info (click to toggle)
libtk-pod-perl 0.9939-1
  • links: PTS, VCS
  • area: main
  • in suites: lenny, squeeze
  • size: 332 kB
  • ctags: 254
  • sloc: perl: 4,416; makefile: 43
file content (117 lines) | stat: -rwxr-xr-x 2,229 bytes parent folder | download
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
106
107
108
109
110
111
112
113
114
115
116
117
#!/usr/bin/perl -w

use strict;
use vars qw($VERSION);

$VERSION = sprintf("%d.%02d", q$Revision: 5.5 $ =~ /(\d+)\.(\d+)/);

use Tk;
use Tk::More;
use Getopt::Long;

my %opt;

Getopt::Long::config('pass_through');
if (!GetOptions(\%opt, "font=s", "i|ignore-case!", "encoding=s")) {
    require Pod::Usage;
    Pod::Usage::pod2usage(2);
}

my $mw = tkinit;

# Unhandled options left?
Getopt::Long::config('nopass_through');
if (!GetOptions({})) {
    require Pod::Usage;
    Pod::Usage::pod2usage(2);
}

my $file = shift @ARGV;
if (!defined $file) {
    die "Filename is missing.\n";
}

my $more = $mw->Scrolled("More",
			 -font => $opt{font},
			 -scrollbars => "osoe",
			 -searchcase => !$opt{i},
			)->pack(-fill => "both", -expand => 1);

my $menu = $more->menu;
my $fm = $menu->entrycget("File", -menu);
$fm->insert("Exit", "command", -label => "Open ...", -underline => 0,
	    -command => sub {
		my $f = $more->getOpenFile;
		return if !defined $f;
		load_file($f);
	    });
$fm->entryconfigure("Exit", -accelerator => "Ctrl-Q");

my $helpmenu = $menu->Menu
    (-tearoff => 0,
     -menuitems => [
		    [Button => "~Usage",
		     -command => sub {
			 require Tk::Pod;
			 $mw->Pod(-file => "Tk::More");
		     }]
		   ]
    );
$menu->cascade(-label => "Help", -underline => 0, -menu => $helpmenu);
$mw->configure(-menu => $menu);

$more->focus;
load_file($file);
$more->AddQuitBindings;
MainLoop;

sub load_file {
    my $file = shift;
    $more->Load($file, -encoding => $opt{encoding});
    $mw->title("tkmore - $file");
}

__END__

=head1 NAME

tkmore - a Perl/Tk based pager

=head1 SYNOPSIS

    tkmore [X11 options] [-i] [-encoding encoding] filename

=head1 DESCRIPTION

B<tkmore> is a pager similar to L<more(1)> or L<less(1)>.

=head2 OPTIONS

Besides standard X11 options like C<-font>, B<tkmore> supports:

=over

=item -i

Turn on case-insensitive search. Alias: C<-ignore-case>.

=item -encoding encoding

Specify the encoding for the specified file and all subsequently
loaded files. By default no encoding is assumed.

=back

=head2 KEY BINDINGS

For a list of key bindings, see L<Tk::More/ADDITIONAL BINDINGS>.

=head1 AUTHOR

Slaven Rezic

=head1 SEE ALSO

L<Tk::More>, L<more(1)>, L<less(1)>

=cut