r1288 - in packages/libtk-pod-perl/branches/upstream/current: . Pod
t
Carlo Segre
segre-guest at costa.debian.org
Sun Aug 14 23:42:24 UTC 2005
Author: segre-guest
Date: 2005-08-14 23:42:23 +0000 (Sun, 14 Aug 2005)
New Revision: 1288
Modified:
packages/libtk-pod-perl/branches/upstream/current/Changes
packages/libtk-pod-perl/branches/upstream/current/Makefile.PL
packages/libtk-pod-perl/branches/upstream/current/Pod.pm
packages/libtk-pod-perl/branches/upstream/current/Pod/FindPods.pm
packages/libtk-pod-perl/branches/upstream/current/Pod/Search.pm
packages/libtk-pod-perl/branches/upstream/current/Pod/Styles.pm
packages/libtk-pod-perl/branches/upstream/current/Pod/Text.pm
packages/libtk-pod-perl/branches/upstream/current/Pod_usage.pod
packages/libtk-pod-perl/branches/upstream/current/TODO
packages/libtk-pod-perl/branches/upstream/current/t/cmdline.t
packages/libtk-pod-perl/branches/upstream/current/t/more.t
packages/libtk-pod-perl/branches/upstream/current/t/pods.t
packages/libtk-pod-perl/branches/upstream/current/t/podtree.t
packages/libtk-pod-perl/branches/upstream/current/t/subclass.t
packages/libtk-pod-perl/branches/upstream/current/tkmore
packages/libtk-pod-perl/branches/upstream/current/tkpod
Log:
Load /tmp/tmp.3LYlsf/libtk-pod-perl-0.9930 into
packages/libtk-pod-perl/branches/upstream/current.
Modified: packages/libtk-pod-perl/branches/upstream/current/Changes
===================================================================
--- packages/libtk-pod-perl/branches/upstream/current/Changes 2005-08-12 23:20:22 UTC (rev 1287)
+++ packages/libtk-pod-perl/branches/upstream/current/Changes 2005-08-14 23:42:23 UTC (rev 1288)
@@ -1,5 +1,13 @@
History for Tk::Pod
+version 0.9930
+ o fixing zoom function problems on some X11 servers
+ o changed About dialog
+ o tkmore: Pod, new options
+ o new environment variable TKPODCACHE
+ o fixed for installations with vendor_perl in @INC (thanks to
+ Alexey Tourbin)
+
version 0.9929
o no functional changes, just repair version damage
Modified: packages/libtk-pod-perl/branches/upstream/current/Makefile.PL
===================================================================
--- packages/libtk-pod-perl/branches/upstream/current/Makefile.PL 2005-08-12 23:20:22 UTC (rev 1287)
+++ packages/libtk-pod-perl/branches/upstream/current/Makefile.PL 2005-08-14 23:42:23 UTC (rev 1288)
@@ -2,7 +2,7 @@
use ExtUtils::MakeMaker;
-$DIST_VERSION = "0.9929";
+$DIST_VERSION = "0.9930";
if (defined $ENV{USER} && $ENV{USER} eq 'eserte') {
open(P, "Pod.pm") or die "Can't open Pod.pm: $!";
SEARCH_FOR_DIST_VERSION: {
Modified: packages/libtk-pod-perl/branches/upstream/current/Pod/FindPods.pm
===================================================================
--- packages/libtk-pod-perl/branches/upstream/current/Pod/FindPods.pm 2005-08-12 23:20:22 UTC (rev 1287)
+++ packages/libtk-pod-perl/branches/upstream/current/Pod/FindPods.pm 2005-08-14 23:42:23 UTC (rev 1288)
@@ -1,12 +1,12 @@
# -*- perl -*-
#
-# $Id: FindPods.pm,v 5.1 2004/09/08 21:08:44 eserte Exp $
+# $Id: FindPods.pm,v 5.3 2005/08/12 21:31:02 eserte Exp $
# Author: Slaven Rezic
#
-# Copyright (C) 2001,2003,2004 Slaven Rezic. All rights reserved.
-# This package is free software; you can redistribute it and/or
-# modify it under the same terms as Perl itself.
+# Copyright (C) 2001,2003,2004,2005 Slaven Rezic. All rights reserved.
+# This package is free software; you can redistribute it and/or modify
+# it under the same terms as Perl itself.
#
# Mail: slaven at rezic.de
# WWW: http://www.rezic.de/eserte/
@@ -36,7 +36,7 @@
@EXPORT_OK = qw/%pods $has_cache pod_find/;
-$VERSION = sprintf("%d.%02d", q$Revision: 5.1 $ =~ /(\d+)\.(\d+)/);
+$VERSION = sprintf("%d.%02d", q$Revision: 5.3 $ =~ /(\d+)\.(\d+)/);
BEGIN { # Make a DEBUG constant very first thing...
if(defined &DEBUG) {
@@ -130,7 +130,7 @@
@dirs = @{ $args{-directories} };
@script_dirs = ();
} else {
- @dirs = grep { $_ ne '.' } @INC; # ignore current directory
+ @dirs = sort { length($b) <=> length($a) } grep { $_ ne '.' } @INC; # ignore current directory
@script_dirs = ($Config{'scriptdir'});
}
@@ -233,6 +233,7 @@
}
foreach my $inc (@dirs) {
+ next unless -d $inc;
$curr_dir = $inc;
find({ %opts, wanted => $wanted }, $inc);
}
@@ -277,6 +278,7 @@
my %arch;
my @configs;
foreach my $inc (@INC) {
+ next unless -d $inc;
if (!opendir(DIR, $inc)) {
warn "Can't opendir $inc: $!";
next;
@@ -343,11 +345,17 @@
(my $os = $Config{'archname'}) =~ s/[^a-z0-9]/_/gi;
my $uid = $<;
- if (File::Spec->can('tmpdir')) {
- File::Spec->catfile(File::Spec->tmpdir, join('_', 'pods',$ver,$os,$uid));
- } else {
- File::Spec->catfile(($ENV{TMPDIR}||"/tmp"), join('_', 'pods',$ver,$os,$uid));
- }
+ my $cache_file_pattern = $ENV{TKPODCACHE};
+ if (!defined $cache_file_pattern) {
+ $cache_file_pattern = File::Spec->catfile
+ (File::Spec->can('tmpdir') ? File::Spec->tmpdir : $ENV{TMPDIR}||"/tmp",
+ join('_', 'pods',"%v","%o","%u")
+ );
+ }
+ $cache_file_pattern =~ s/%v/$ver/g;
+ $cache_file_pattern =~ s/%o/$os/g;
+ $cache_file_pattern =~ s/%u/$uid/g;
+ $cache_file_pattern;
}
sub pods { shift->{pods} }
@@ -459,6 +467,46 @@
__END__
+=head1 ENVIRONMENT
+
+=over
+
+=item TKPODCACHE
+
+Path for the cache file. By default, the cache file is written to the
+temporary directory (F</tmp> or the OS equivalent). The following
+placeholders are recognized:
+
+=over
+
+=item %v
+
+The perl version.
+
+=item %o
+
+The OS (technically correct: the archname, which can include tokens
+like "64int" or "thread").
+
+=item %u
+
+The user id.
+
+=back
+
+Example for using F</var/tmp> instead of F</tmp> for the cache file
+location (on many systems F</var/tmp> is persistent, unlike F</tmp>):
+
+ setenv TKPODCACHE /var/tmp/pods_%v_%o_%u
+
+or
+
+ TKPODCACHE=/var/tmp/pods_%v_%o_%u; export TKPODCACHE
+
+depending on your shell.
+
+=back
+
=head1 SEE ALSO
Tk::Tree(3).
@@ -467,8 +515,8 @@
Slaven Rezic <F<slaven at rezic.de>>
-Copyright (c) 2001,2003,2004 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.
+Copyright (c) 2001,2003,2004,2005 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.
=cut
Modified: packages/libtk-pod-perl/branches/upstream/current/Pod/Search.pm
===================================================================
--- packages/libtk-pod-perl/branches/upstream/current/Pod/Search.pm 2005-08-12 23:20:22 UTC (rev 1287)
+++ packages/libtk-pod-perl/branches/upstream/current/Pod/Search.pm 2005-08-14 23:42:23 UTC (rev 1288)
@@ -3,7 +3,7 @@
use strict;
use vars qw(@ISA $VERSION);
-$VERSION = sprintf("%d.%02d", q$Revision: 5.1 $ =~ /(\d+)\.(\d+)/);
+$VERSION = sprintf("%d.%02d", q$Revision: 5.3 $ =~ /(\d+)\.(\d+)/);
use Carp;
use Tk::Frame;
@@ -40,14 +40,14 @@
my $s = $f->Label();
$l->pack(-fill=>'both', -side=>'top', -expand=>1);
- $f->pack(-fill => "x", -expand => 1, -side => "top");
+ $f->pack(-fill => "x", -side => "top");
$s->pack(-anchor => 'e', -side=>'left');
$e->pack(-fill=>'x', -side=>'left', -expand=>1);
my $current_path = delete $args->{-currentpath};
$cw->{RestrictPod} = undef;
my $cb;
- if (defined $current_path) {
+ if (defined $current_path && $current_path ne "") {
$cb = $cw->Checkbutton(-variable => \$cw->{RestrictPod},
-text => "Restrict to $current_path",
-anchor => "w",
Modified: packages/libtk-pod-perl/branches/upstream/current/Pod/Styles.pm
===================================================================
--- packages/libtk-pod-perl/branches/upstream/current/Pod/Styles.pm 2005-08-12 23:20:22 UTC (rev 1287)
+++ packages/libtk-pod-perl/branches/upstream/current/Pod/Styles.pm 2005-08-14 23:42:23 UTC (rev 1288)
@@ -4,11 +4,13 @@
package Tk::Pod::Styles;
use vars qw($VERSION);
-$VERSION = sprintf("%d.%02d", q$Revision: 5.1 $ =~ /(\d+)\.(\d+)/);
+$VERSION = sprintf("%d.%02d", q$Revision: 5.3 $ =~ /(\d+)\.(\d+)/);
sub init_styles {
my $w = shift;
- $w->set_base_font_size($w->standard_font_size);
+ if (!defined $w->{'style'}{'base_font_size'}) {
+ $w->set_base_font_size($w->standard_font_size);
+ }
}
sub standard_font_size {
@@ -32,10 +34,16 @@
$w->set_base_font_size($new_size);
for my $tag ($w->tagNames) {
+ my $fontsize = $w->{'style_fontsize'}{$tag};
my $f = $w->tagCget($tag, '-font');
if ($f) {
my %f = $w->fontActual($f);
- $f{-size} += $delta;
+ if (!defined $fontsize) {
+ $fontsize = $f{-size};
+ }
+ $fontsize += $delta;
+ $w->{'style_fontsize'}{$tag} = $fontsize;
+ $f{-size} = $fontsize;
my $new_f = $w->fontCreate(%f);
$w->tagConfigure($tag, -font => $new_f);
}
@@ -130,3 +138,7 @@
# ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
1;
__END__
+
+### Local Variables:
+### cperl-indent-level: 2
+### End:
Modified: packages/libtk-pod-perl/branches/upstream/current/Pod/Text.pm
===================================================================
--- packages/libtk-pod-perl/branches/upstream/current/Pod/Text.pm 2005-08-12 23:20:22 UTC (rev 1287)
+++ packages/libtk-pod-perl/branches/upstream/current/Pod/Text.pm 2005-08-14 23:42:23 UTC (rev 1288)
@@ -24,9 +24,9 @@
use Tk::Pod::Util qw(is_in_path is_interactive detect_window_manager);
use vars qw($VERSION @ISA @POD $IDX
- @tempfiles @gv_pids);
+ @tempfiles @gv_pids $terminal_fallback_warn_shown);
-$VERSION = sprintf("%d.%02d", q$Revision: 5.1 $ =~ /(\d+)\.(\d+)/);
+$VERSION = sprintf("%d.%02d", q$Revision: 5.4 $ =~ /(\d+)\.(\d+)/);
@ISA = qw(Tk::Frame Tk::Pod::SimpleBridge Tk::Pod::Cache);
@@ -113,7 +113,7 @@
if ($name !~ /^[-_+:.\/A-Za-z0-9]+$/) {
$w->messageBox(
-title => "Tk::Pod Error",
- -message => "Invalid path/file/module name: '$name'\n");
+ -message => "Invalid path/file/module name '$name'\n");
die;
}
$absname = Find($name);
@@ -121,7 +121,7 @@
if (!defined $absname) {
$w->messageBox(
-title => "Tk::Pod Error",
- -message => "Can't find Pod. Invalid file/module name: '$name'\n"
+ -message => "Can't find Pod '$name'\n"
);
die;
}
@@ -259,29 +259,46 @@
close $fh;
$path = $fname;
}
- if ($^O eq 'MSWin32') # XXX what is right?
+ if (!defined $edit)
{
- system("ptked $path");
+ $edit = $ENV{TKPODEDITOR};
}
- else
+ if ($^O eq 'MSWin32')
{
- if (!defined $edit)
+ if (defined $edit && $edit ne "")
{
- $edit = $ENV{TKPODEDITOR};
+ system(1, $edit, $path);
}
- if (!defined $edit)
+ else
{
+ system(1, "ptked", $path);
+ }
+ }
+ else
+ {
+ if (!defined $edit || $edit eq "")
+ {
# VISUAL and EDITOR are supposed to have a terminal, but tkpod can
# be started without a terminal.
my $isatty = is_interactive();
- $edit = $ENV{XEDITOR};
- if (!$isatty && !defined $edit)
+ if (!$isatty)
{
- $w->messageBox(
- -title => "Tk::Pod Error",
- -message => "No terminal, fallback to ptked"
- );
- $edit = 'ptked';
+ if (!defined $edit || $edit eq "")
+ {
+ $edit = $ENV{XEDITOR};
+ }
+ if (!defined $edit || $edit eq "")
+ {
+ if (!$terminal_fallback_warn_shown)
+ {
+ $w->messageBox(
+ -title => "Tk::Pod Warning",
+ -message => "No terminal and neither TKPODEDITOR nor XEDITOR environment variables set. Fallback to ptked."
+ );
+ $terminal_fallback_warn_shown = 1;
+ }
+ $edit = 'ptked';
+ }
}
else
{
@@ -425,6 +442,7 @@
# -font ignored because it does not change the other fonts
#'-font' => [ 'PASSIVE', undef, undef, undef],
'-scrollbars' => [ $p, qw(scrollbars Scrollbars), $Tk::platform eq 'MSWin32' ? 'e' : 'w' ],
+ '-basefontsize' => ['METHOD'], # XXX may change
'DEFAULT' => [ $p ],
);
@@ -432,6 +450,19 @@
$args->{-width} = $w->{Length};
}
+sub basefontsize
+{
+ my($w, $val) = @_;
+ if ($val)
+ {
+ $w->set_base_font_size($val);
+ }
+ else
+ {
+ $w->base_font_size;
+ }
+}
+
sub Font
{
my ($w,%args) = @_;
@@ -661,17 +692,28 @@
sub InternalManViewer {
my($w, $mansec, $man) = @_;
- return 0 if (!is_in_path("man"));
+ my $man_exe = "man";
+ if (!is_in_path($man_exe)) {
+ if ($^O eq 'MSWin32') {
+ $man_exe = "c:/cygwin/bin/man.exe";
+ if (!-e $man_exe) {
+ return 0;
+ }
+ } else {
+ return 0;
+ }
+ }
my $t = $w->Toplevel(-title => "Manpage $man($mansec)");
+ my $font_size = $w->base_font_size;
my $more = $t->Scrolled("More",
- -font => "Courier 10", # XXX do not hardcode
+ -font => "Courier $font_size",
-scrollbars => $Tk::platform eq 'MSWin32' ? 'e' : 'w',
)->pack(-fill => "both", -expand => 1);
- $more->tagConfigure("bold", -font => "Courier 10 bold"); # XXX do not hardcode
+ $more->tagConfigure("bold", -font => "Courier $font_size bold");
my $menu = $more->menu;
$t->configure(-menu => $menu);
local $SIG{PIPE} = "IGNORE";
- open(MAN, "man" . (defined $mansec ? " $mansec" : "") . " $man |")
+ open(MAN, $man_exe . (defined $mansec ? " $mansec" : "") . " $man |")
or die $!;
if (eof MAN) {
$more->insert("end", "No entry for for $man" . (defined $mansec ? " in section $mansec of" : "") . " the manual");
Modified: packages/libtk-pod-perl/branches/upstream/current/Pod.pm
===================================================================
--- packages/libtk-pod-perl/branches/upstream/current/Pod.pm 2005-08-12 23:20:22 UTC (rev 1287)
+++ packages/libtk-pod-perl/branches/upstream/current/Pod.pm 2005-08-14 23:42:23 UTC (rev 1288)
@@ -4,8 +4,8 @@
use Tk::Toplevel;
use vars qw($VERSION $DIST_VERSION @ISA);
-$VERSION = sprintf("%d.%02d", q$Revision: 5.2 $ =~ /(\d+)\.(\d+)/);
-$DIST_VERSION = "0.9929";
+$VERSION = sprintf("%d.%02d", q$Revision: 5.6 $ =~ /(\d+)\.(\d+)/);
+$DIST_VERSION = "0.9930";
@ISA = qw(Tk::Toplevel);
@@ -122,14 +122,14 @@
],
'-',
[Button => "Zoom ~in", '-accelerator' => 'Ctrl++',
- -command => ['zoom_in', $p],
+ -command => [$w, 'zoom_in'],
$compound->("viewmag+"),
],
- [Button => "~Normal", -command => ['zoom_normal', $p],
+ [Button => "~Normal", -command => [$w, 'zoom_normal'],
$compound->(),
],
[Button => "Zoom ~out", '-accelerator' => 'Ctrl+-',
- -command => ['zoom_out', $p],
+ -command => [$w, 'zoom_out'],
$compound->("viewmag-"),
],
]
@@ -191,7 +191,7 @@
[
# XXX restructure to not reference to tkpod
[Button => '~Usage...', -command => ['help', $w]],
- [Button => '~Programming...', -command => sub { $w->parent->Pod(-file=>'Tk/Pod.pm', -exitbutton => $w->cget(-exitbutton)) }],
+ [Button => '~Programming...', -command => ['help_programming', $w]],
[Button => '~About...', -command => ['about', $w]],
($ENV{'TKPODDEBUG'}
? ('-',
@@ -228,8 +228,8 @@
$w->bind($path, "<$mod-Right>" => [$p, 'history_move', +1]);
}
- $w->bind($path, "<Control-minus>" => [$p, 'zoom_out']);
- $w->bind($path, "<Control-plus>" => [$p, 'zoom_in']);
+ $w->bind($path, "<Control-minus>" => [$w, 'zoom_out']);
+ $w->bind($path, "<Control-plus>" => [$w, 'zoom_in']);
$w->bind($path, "<F3>" => [$w,'openfile']);
$w->bind($path, "<Control-o>" => [$w,'openpod',$p]);
$w->bind($path, "<Control-n>" => [$w,'newwindow',$p]);
@@ -335,11 +335,7 @@
if ($go == 1) {
$cw->configure(%pod_args);
} elsif ($go == 2) {
- my $new_cw = $cw->MainWindow->Pod
- ('-tree' => $cw->cget(-tree),
- -exitbutton => $cw->cget(-exitbutton),
- );
- $new_cw->configure(%pod_args);
+ my $new_cw = $cw->clone(%pod_args);
}
}
}
@@ -374,10 +370,7 @@
}
sub newwindow {
- my($cw) = @_;
- $cw->MainWindow->Pod('-tree' => $cw->cget(-tree),
- -exitbutton => $cw->cget(-exitbutton),
- );
+ shift->clone;
}
sub Dir {
@@ -392,31 +385,56 @@
sub help {
my $w = shift;
- $w->parent->Pod(-file=>'Tk::Pod_usage.pod',
- -exitbutton => $w->cget(-exitbutton),
- );
+ $w->clone('-tree' => 0,
+ '-file' => 'Tk::Pod_usage.pod',
+ );
}
+sub help_programming {
+ my $w = shift;
+ $w->clone('-tree' => 0,
+ '-file' => 'Tk/Pod.pm',
+ );
+}
+
sub about {
+ my $w = shift;
+ require Tk::DialogBox;
+ require Tk::ROText;
+ my $d = $w->DialogBox(-title => "About Tk::Pod",
+ -buttons => ["OK"],
+ );
my $message = <<EOF;
-This is:
-Tk-Pod distribution $DIST_VERSION
-Tk::Pod module $VERSION
+Tk::Pod - a Pod viewer written in Perl/Tk
-Using:
-@{[ $Pod::Simple::VERSION ? "Pod::Simple $Pod::Simple::VERSION\n"
+Version information:
+ Tk-Pod distribution $DIST_VERSION
+ Tk::Pod module $VERSION
+
+System information:
+ @{[ $Pod::Simple::VERSION ? "Pod::Simple $Pod::Simple::VERSION\n"
: ""
-]}Tk $Tk::VERSION
-Perl $]
-OS $^O
+]} Tk $Tk::VERSION
+ Perl $]
+ OS $^O
-Please contact <srezic\@cpan.org>
-in case of problems.
+Please contact <srezic\@cpan.org> in case of problems.
+Send the contents of this window for diagnostics.
+
EOF
- $_[0]->messageBox(-title => "About Tk::Pod",
- -icon => "info",
- -message => $message,
- );
+ my @lines = split /\n/, $message, -1;
+ my $width = 0;
+ for (@lines) {
+ $width = length $_ if length $_ > $width;
+ }
+ my $txt = $d->add("Scrolled", "ROText",
+ -height => scalar @lines,
+ -width => $width + 1,
+ -relief => "flat",
+ -scrollbars => "oe",
+ )->pack(-expand => 1, -fill => "both");
+ $txt->insert("end", $message);
+ $d->Show;
}
sub add_section_menu {
@@ -546,11 +564,8 @@
my $e = $_[1];
my @args = $common_showcommand->($e);
# XXX -title?
- $w->MainWindow->Pod
- (@args,
- '-exitbutton' => $w->cget(-exitbutton),
- '-tree' => !!$tree,
- );
+ $w->clone(-tree => !!$tree,
+ @args);
},
);
}
@@ -618,17 +633,52 @@
if ($go == 1) {
$cw->configure(-file => $pod);
} elsif ($go == 2) {
- my $new_cw = $cw->MainWindow->Pod
- ('-tree' => $cw->cget('-tree'),
- '-exitbutton' => $cw->cget('-exitbutton'),
- );
- $new_cw->configure('-file' => $pod);
+ my $new_cw = $cw->clone('-file' => $pod);
}
}
}
}
}
+sub zoom {
+ my($w, $method) = @_;
+ my $p = $w->Subwidget("pod");
+ $p->$method;
+ $w->set_base_font_size($p->base_font_size);
+}
+
+sub zoom_in { shift->zoom("zoom_in") }
+sub zoom_out { shift->zoom("zoom_out") }
+sub zoom_normal { shift->zoom("zoom_normal") }
+
+sub base_font_size {
+ my $w = shift;
+ $w->{Base_Font_Size};
+}
+
+sub set_base_font_size {
+ my($w, $font_size) = @_;
+ $w->{Base_Font_Size} = $font_size;
+}
+
+sub clone {
+ my($w, %pod_args) = @_;
+ my %pre_args;
+ for ('-tree', '-exitbutton') {
+ if (exists $pod_args{$_}) {
+ $pre_args{$_} = delete $pod_args{$_};
+ } else {
+ $pre_args{$_} = $w->cget($_);
+ }
+ }
+ my $new_w = $w->MainWindow->Pod
+ (%pre_args,
+ '-basefontsize' => $w->base_font_size,
+ );
+ $new_w->configure(%pod_args) if %pod_args;
+ $new_w;
+}
+
1;
__END__
Property changes on: packages/libtk-pod-perl/branches/upstream/current/Pod_usage.pod
___________________________________________________________________
Name: svn:executable
-
+ *
Modified: packages/libtk-pod-perl/branches/upstream/current/TODO
===================================================================
--- packages/libtk-pod-perl/branches/upstream/current/TODO 2005-08-12 23:20:22 UTC (rev 1287)
+++ packages/libtk-pod-perl/branches/upstream/current/TODO 2005-08-14 23:42:23 UTC (rev 1288)
@@ -95,6 +95,20 @@
=back
+=head3 tkpod
+
+=over
+
+=item *
+
+In server mode, no commandline options are accepted.
+
+=item *
+
+Get rid of the numerous warnings in server/client mode.
+
+=back
+
=head2 WISHLIST
=head3 Tk::Pod
@@ -103,6 +117,29 @@
=item *
+History: prefer short pod names over filenames. Do not record
+temporary file names (as in perldoc -f / -q) in history view.
+
+=item *
+
+If "perlindex -index" is not run yet: ask user to run it? Problematic
+on Unix, because perlindex should be run as superuser.
+
+=item *
+
+On Windows: show printer selection dialog first, maybe also on
+KDE/GNOME, if available.
+
+=item *
+
+Optionally save settings on exit, e.g. current base font size.
+
+=item *
+
+New menu item: View Pod source (like Edit Pod, but using tkmore or Tk::More)
+
+=item *
+
Marek Rouchal writes:
Subject: tkpod - other font
@@ -254,6 +291,11 @@
=item *
+Some zoom functionality, maybe depending on the zoom factor of the
+main window, and/or an additional menu entry.
+
+=item *
+
Should I include something similar to perlfunc for perlfaq (perldoc
-q)? Maybe a new menu item "Search FAQ"?
Property changes on: packages/libtk-pod-perl/branches/upstream/current/t/cmdline.t
___________________________________________________________________
Name: svn:executable
-
+ *
Property changes on: packages/libtk-pod-perl/branches/upstream/current/t/more.t
___________________________________________________________________
Name: svn:executable
-
+ *
Property changes on: packages/libtk-pod-perl/branches/upstream/current/t/pods.t
___________________________________________________________________
Name: svn:executable
-
+ *
Property changes on: packages/libtk-pod-perl/branches/upstream/current/t/podtree.t
___________________________________________________________________
Name: svn:executable
-
+ *
Property changes on: packages/libtk-pod-perl/branches/upstream/current/t/subclass.t
___________________________________________________________________
Name: svn:executable
-
+ *
Modified: packages/libtk-pod-perl/branches/upstream/current/tkmore
===================================================================
--- packages/libtk-pod-perl/branches/upstream/current/tkmore 2005-08-12 23:20:22 UTC (rev 1287)
+++ packages/libtk-pod-perl/branches/upstream/current/tkmore 2005-08-14 23:42:23 UTC (rev 1288)
@@ -3,15 +3,38 @@
use strict;
use vars qw($VERSION);
-$VERSION = sprintf("%d.%02d", q$Revision: 5.1 $ =~ /(\d+)\.(\d+)/);
+$VERSION = sprintf("%d.%02d", q$Revision: 5.2 $ =~ /(\d+)\.(\d+)/);
use Tk;
use Tk::More;
+use Getopt::Long;
+my %opt = (font => "Courier 10"); # XXX do not hardcode, get size from default font
+
+Getopt::Long::config('pass_through');
+if (!GetOptions(\%opt, "font=s", "i|ignore-case!")) {
+ 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 => "Courier 10", # XXX do not hardcode
+ -font => $opt{font},
-scrollbars => "osoe",
+ -searchcase => !$opt{i},
)->pack(-fill => "both", -expand => 1);
my $menu = $more->menu;
@@ -36,7 +59,7 @@
$mw->configure(-menu => $menu);
$more->focus;
-load_file(shift);
+load_file($file);
$more->bind("<q>" => sub { $mw->destroy });
MainLoop;
@@ -47,3 +70,39 @@
}
__END__
+
+=head1 NAME
+
+tkmore - a Perl/Tk based pager
+
+=head1 SYNOPSIS
+
+ tkmore [X11 options] [-i] filename
+
+=head1 DESCRIPTION
+
+B<tkmore> is a pager similar to L<more(1)> or L<less(1)>.
+
+=head2 OPTIONS
+
+=over
+
+=item -i
+
+Turn on case-insensitive search.
+
+=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
Property changes on: packages/libtk-pod-perl/branches/upstream/current/tkmore
___________________________________________________________________
Name: svn:executable
-
+ *
Modified: packages/libtk-pod-perl/branches/upstream/current/tkpod
===================================================================
--- packages/libtk-pod-perl/branches/upstream/current/tkpod 2005-08-12 23:20:22 UTC (rev 1287)
+++ packages/libtk-pod-perl/branches/upstream/current/tkpod 2005-08-14 23:42:23 UTC (rev 1288)
@@ -3,7 +3,7 @@
use strict;
use vars qw($VERSION $tk_opt $tree $server $portfile $Mblib @I $debug);
-$VERSION = sprintf("%d.%02d", q$Revision: 5.1 $ =~ /(\d+)\.(\d+)/);
+$VERSION = sprintf("%d.%02d", q$Revision: 5.3 $ =~ /(\d+)\.(\d+)/);
use IO::Socket;
@@ -88,6 +88,7 @@
my $mw = MainWindow->new();
eval 'use blib "/home/e/eserte/src/perl/Tk-App";require Tk::App::Debug';
+my $orig_state = $mw->state; # may be iconic
$mw->withdraw;
my $function;
@@ -175,6 +176,7 @@
}
}
+my $tl;
my $file;
my $opened = 0;
foreach $file (@ARGV)
@@ -185,7 +187,7 @@
}
else
{
- my $tl = $mw->Pod(-tree => $tree,
+ $tl = $mw->Pod(-tree => $tree,
-exitbutton => 1);
# -file => ... should be called after creating the Pod window,
# because -title => ... is set implicitly by Pod's new
@@ -196,14 +198,14 @@
if (defined $function)
{
- my $tl = $mw->Pod(-tree => $tree,
+ $tl = $mw->Pod(-tree => $tree,
-exitbutton => 1);
$tl->configure($tl->getpodargs(-f => $function));
$opened++;
}
if (defined $question)
{
- my $tl = $mw->Pod(-tree => $tree,
+ $tl = $mw->Pod(-tree => $tree,
-exitbutton => 1);
$tl->configure($tl->getpodargs(-q => $question));
$opened++;
@@ -213,15 +215,19 @@
{
if ($tree)
{
- $mw->Pod(-tree => 1, -exitbutton => 1);
+ $tl = $mw->Pod(-tree => 1, -exitbutton => 1);
}
else
{
- my $tl = $mw->Pod(-tree => $tree, -exitbutton => 1);
+ $tl = $mw->Pod(-tree => $tree, -exitbutton => 1);
$tl->configure(-file => "perl");
}
}
+if (Tk::Exists($tl) && $orig_state eq 'iconic') {
+ $tl->iconify;
+}
+
# xxx dirty but it works. A simple $mw->destroy if $mw->children
# does not work because Tk::ErrorDialogs could be created.
# (they are withdrawn after Ok instead of destory'ed I guess)
@@ -387,7 +393,8 @@
=back
-See L<Tk::Pod::Text/Environment> for more environment variables.
+See L<Tk::Pod::Text/Environment> and L<Tk::Pod::FindPods/Environment>
+for more environment variables.
=head1 KNOWN BUGS
Property changes on: packages/libtk-pod-perl/branches/upstream/current/tkpod
___________________________________________________________________
Name: svn:executable
-
+ *
More information about the Pkg-perl-cvs-commits
mailing list