r4923 - in /packages/libtk-pod-perl/branches/upstream/current: ./
Pod/ t/
segre at users.alioth.debian.org
segre at users.alioth.debian.org
Fri Mar 2 07:36:54 CET 2007
Author: segre
Date: Fri Mar 2 07:36:53 2007
New Revision: 4923
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=4923
Log:
[svn-upgrade] Integrating new upstream version, libtk-pod-perl (0.9933)
Added:
packages/libtk-pod-perl/branches/upstream/current/t/TkTest.pm
Modified:
packages/libtk-pod-perl/branches/upstream/current/Changes
packages/libtk-pod-perl/branches/upstream/current/MANIFEST
packages/libtk-pod-perl/branches/upstream/current/META.yml
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_db.pm
packages/libtk-pod-perl/branches/upstream/current/Pod/SimpleBridge.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/Tree.pm
packages/libtk-pod-perl/branches/upstream/current/Pod/Util.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/optionalmods.t
packages/libtk-pod-perl/branches/upstream/current/tkmore
packages/libtk-pod-perl/branches/upstream/current/tkpod
Modified: packages/libtk-pod-perl/branches/upstream/current/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libtk-pod-perl/branches/upstream/current/Changes?rev=4923&op=diff
==============================================================================
--- packages/libtk-pod-perl/branches/upstream/current/Changes (original)
+++ packages/libtk-pod-perl/branches/upstream/current/Changes Fri Mar 2 07:36:53 2007
@@ -1,4 +1,13 @@
History for Tk::Pod
+
+version 0.9933
+ o new menu items with search.cpan.org and annocpan.org links
+ o Print keybinding
+ o Ptksh menu entry in debug mode
+ o tkpod: pod names now have priority over directories (problem
+ spotted by Andreas Koenig)
+ o pod tree fixes for MacOSX
+ o do not run test suite if no DISPLAY available (X11 only)
version 0.9932
o bugfix - Tk::Pod did not work with Tk804 and without
Modified: packages/libtk-pod-perl/branches/upstream/current/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libtk-pod-perl/branches/upstream/current/MANIFEST?rev=4923&op=diff
==============================================================================
--- packages/libtk-pod-perl/branches/upstream/current/MANIFEST (original)
+++ packages/libtk-pod-perl/branches/upstream/current/MANIFEST Fri Mar 2 07:36:53 2007
@@ -16,6 +16,7 @@
Pod/Styles.pm
Pod/Cache.pm
Pod/Util.pm
+t/TkTest.pm
t/basic.t
t/podtree.t
t/cmdline.t
Modified: packages/libtk-pod-perl/branches/upstream/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libtk-pod-perl/branches/upstream/current/META.yml?rev=4923&op=diff
==============================================================================
--- packages/libtk-pod-perl/branches/upstream/current/META.yml (original)
+++ packages/libtk-pod-perl/branches/upstream/current/META.yml Fri Mar 2 07:36:53 2007
@@ -1,6 +1,6 @@
# http://module-build.sourceforge.net/META-spec.html
name: Tk-Pod
-version: 0.9932
+version: 0.9933
version_from:
installdirs: site
requires:
Modified: packages/libtk-pod-perl/branches/upstream/current/Makefile.PL
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libtk-pod-perl/branches/upstream/current/Makefile.PL?rev=4923&op=diff
==============================================================================
--- packages/libtk-pod-perl/branches/upstream/current/Makefile.PL (original)
+++ packages/libtk-pod-perl/branches/upstream/current/Makefile.PL Fri Mar 2 07:36:53 2007
@@ -2,7 +2,7 @@
use ExtUtils::MakeMaker;
-$DIST_VERSION = "0.9932";
+$DIST_VERSION = "0.9933";
$is_devel_host = defined $ENV{USER} && $ENV{USER} eq 'eserte' && $^O =~ /bsd/i && -f "../../perl.release.mk";
if ($is_devel_host) {
open(P, "Pod.pm") or die "Can't open Pod.pm: $!";
@@ -28,6 +28,16 @@
}
}
+my %add_prereq_pm;
+if (eval { require Tk::Tree; 1 } && $Tk::Tree::VERSION eq '4.6') {
+ warn <<EOF;
+**********************************************************************
+* You have Tk::Tree $Tk::Tree::VERSION, which is broken.
+**********************************************************************
+EOF
+ $add_prereq_pm{"Tk::Tree"} = "4.7";
+}
+
WriteMakefile(
'PREREQ_PM' => { 'Tk' => 800.004,
'Pod::Simple' => 2.05, # there at least in 2.03 bugs when processing "-f ..." output
@@ -35,6 +45,7 @@
# the following are really only COREQUISITES
'Text::English' => 0,
'Tk::HistEntry' => 0.40,
+ %add_prereq_pm,
},
'DISTNAME' => 'Tk-Pod',
'NAME' => 'Tk::Pod',
@@ -48,10 +59,16 @@
'dist' => {'POSTOP'=>'-$(CHMOD) 644 $(DISTVNAME).tar$(SUFFIX)'},
);
+sub MY::test_via_harness {
+ my($self, $perl, $tests) = @_;
+ qq{\t$perl "-It" "-MTkTest" "-MExtUtils::Command::MM" }.
+ qq{"-e" "check_display_harness; test_harness(\$(TEST_VERBOSE), '\$(INST_LIB)', '\$(INST_ARCHLIB)')" $tests\n};
+}
+
sub MY::postamble {
my $postamble = <<'EOF';
demo :: pure_all
- $(FULLPERL) -w -Mblib tkpod -tree -nodebug
+ $(FULLPERL) -w -Mblib $(INST_SCRIPT)$(DFSEP)tkpod -tree -nodebug
EOF
Modified: packages/libtk-pod-perl/branches/upstream/current/Pod.pm
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libtk-pod-perl/branches/upstream/current/Pod.pm?rev=4923&op=diff
==============================================================================
--- packages/libtk-pod-perl/branches/upstream/current/Pod.pm (original)
+++ packages/libtk-pod-perl/branches/upstream/current/Pod.pm Fri Mar 2 07:36:53 2007
@@ -4,8 +4,8 @@
use Tk::Toplevel;
use vars qw($VERSION $DIST_VERSION @ISA);
-$VERSION = sprintf("%d.%02d", q$Revision: 5.10 $ =~ /(\d+)\.(\d+)/);
-$DIST_VERSION = "0.9932";
+$VERSION = sprintf("%d.%02d", q$Revision: 5.15 $ =~ /(\d+)\.(\d+)/);
+$DIST_VERSION = "0.9933";
@ISA = qw(Tk::Toplevel);
@@ -169,6 +169,31 @@
'-accelerator' => 'Ctrl+-',
'-command' => [$w, 'zoom_out'],
],
+ '-',
+ [Button => $compound->('Pod on search.cpan.org'),
+ '-command' => sub {
+ require Tk::Pod::Util;
+ my $url = $p->{pod_title};
+ eval {
+ require URI::Escape;
+ $url = URI::Escape::uri_escape($url);
+ };
+ Tk::Pod::Util::start_browser("http://search.cpan.org/perldoc?" . $url);
+ },
+ ],
+ [Button => $compound->('Pod on annocpan.org'),
+ '-command' => sub {
+ require Tk::Pod::Util;
+ my $url = $p->{pod_title};
+ eval {
+ require URI::Escape;
+ $url = URI::Escape::uri_escape($url);
+ };
+ ## It seems that the search works better than the direct link on annocpan.org...
+ Tk::Pod::Util::start_browser("http://www.annocpan.org/?mode=search&field=Module&name=$url");
+ #Tk::Pod::Util::start_browser("http://www.annocpan.org/perldoc?" . $url);
+ },
+ ],
]
],
@@ -233,6 +258,10 @@
($ENV{'TKPODDEBUG'}
? ('-',
[Button => 'WidgetDump', -command => sub { $w->WidgetDump }],
+ [Button => 'Ptksh', -command => sub {
+ require Config;
+ require $Config::Config{'scriptdir'} . "/ptksh";
+ }],
(defined &Tk::App::Reloader::reload_new_modules
? [Button => 'Reloader', -command => sub { Tk::App::Reloader::reload_new_modules() }]
: ()
@@ -272,6 +301,7 @@
$w->bind($path, "<Control-n>" => [$w,'newwindow',$p]);
$w->bind($path, "<Control-r>" => [$p, 'reload']);
$w->bind($path, "<Control-p>" => [$p, 'Print']);
+ $w->bind($path, "<Print>" => [$p, 'Print']);
$w->bind($path, "<Control-w>" => [$w, 'quit']);
$w->bind($path, "<Control-q>" => sub { $p->MainWindow->destroy })
if $exitbutton;
@@ -774,10 +804,8 @@
=head1 SEE ALSO
-L<Tk::Pod_usage|Tk::Pod_usage>
-L<Tk::Pod::Text|Tk::Pod::Text>
-L<tkpod|tkpod>
-L<perlpod|perlpod>
+L<Tk::Pod_usage>, L<Tk::Pod::Text>, L<tkpod>, L<perlpod>,
+L<Gtk2::Ex::PodViewer>, L<Prima::PodView>.
=head1 AUTHOR
Modified: packages/libtk-pod-perl/branches/upstream/current/Pod/FindPods.pm
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libtk-pod-perl/branches/upstream/current/Pod/FindPods.pm?rev=4923&op=diff
==============================================================================
--- packages/libtk-pod-perl/branches/upstream/current/Pod/FindPods.pm (original)
+++ packages/libtk-pod-perl/branches/upstream/current/Pod/FindPods.pm Fri Mar 2 07:36:53 2007
@@ -1,10 +1,10 @@
# -*- perl -*-
#
-# $Id: FindPods.pm,v 5.3 2005/08/12 21:31:02 eserte Exp $
+# $Id: FindPods.pm,v 5.5 2007/02/27 21:46:30 eserte Exp $
# Author: Slaven Rezic
#
-# Copyright (C) 2001,2003,2004,2005 Slaven Rezic. All rights reserved.
+# Copyright (C) 2001,2003,2004,2005,2007 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.
#
@@ -36,7 +36,7 @@
@EXPORT_OK = qw/%pods $has_cache pod_find/;
-$VERSION = sprintf("%d.%02d", q$Revision: 5.3 $ =~ /(\d+)\.(\d+)/);
+$VERSION = sprintf("%d.%02d", q$Revision: 5.5 $ =~ /(\d+)\.(\d+)/);
BEGIN { # Make a DEBUG constant very first thing...
if(defined &DEBUG) {
@@ -256,6 +256,8 @@
# general pod documentation as well as Pod::* documentation:
if ($^O =~ /^cygwin/) {
$f =~ s|^pods/||; # "pod" is "pods" on cygwin
+ } elsif ($^O =~ /^darwin/) {
+ $f =~ s|^pods/||; # ... and on MacOSX
} elsif ($^O eq 'MSWin32') {
$f =~ s|^pod/perl|perl|i;
$f =~ s|^pod/Win32|Win32|i;
Modified: packages/libtk-pod-perl/branches/upstream/current/Pod/Search_db.pm
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libtk-pod-perl/branches/upstream/current/Pod/Search_db.pm?rev=4923&op=diff
==============================================================================
--- packages/libtk-pod-perl/branches/upstream/current/Pod/Search_db.pm (original)
+++ packages/libtk-pod-perl/branches/upstream/current/Pod/Search_db.pm Fri Mar 2 07:36:53 2007
@@ -15,7 +15,7 @@
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 Carp;
use Fcntl;
@@ -84,7 +84,7 @@
#print "try words|", join('|', at _),"\n";
my %score;
- my $maxhits = 15;
+ my $maxhits = 50;
my (@unknown, @stop);
my $IF = $self->{IF};
Modified: packages/libtk-pod-perl/branches/upstream/current/Pod/SimpleBridge.pm
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libtk-pod-perl/branches/upstream/current/Pod/SimpleBridge.pm?rev=4923&op=diff
==============================================================================
--- packages/libtk-pod-perl/branches/upstream/current/Pod/SimpleBridge.pm (original)
+++ packages/libtk-pod-perl/branches/upstream/current/Pod/SimpleBridge.pm Fri Mar 2 07:36:53 2007
@@ -5,7 +5,7 @@
# Interface between Tk::Pod and Pod::Simple
use vars qw($VERSION);
-$VERSION = sprintf("%d.%02d", q$Revision: 5.1 $ =~ /(\d+)\.(\d+)/);
+$VERSION = sprintf("%d.%02d", q$Revision: 5.2 $ =~ /(\d+)\.(\d+)/);
BEGIN { # Make a DEBUG constant very first thing...
if(defined &DEBUG) {
@@ -53,13 +53,17 @@
my($token, $tagname, $style);
my $last_update = Tk::timeofday();
+ my $current_line;
while($token = $p->get_token) {
DEBUG > 7 and warn " t:", $token->dump, "\n";
+ if($token->can("attr_hash") && exists $token->attr_hash->{start_line}) {
+ $current_line = $token->attr_hash->{start_line};
+ }
if($token->is_text) {
- DEBUG > 10 and warn " ->pod_text( ", $token->text, ")\n";
- $w->pod_text( $token );
+ DEBUG > 10 and warn " ->pod_text( ", $token->text, ",", $current_line, ")\n";
+ $w->pod_text( $token, $current_line );
} elsif($token->is_start) {
($tagname = $token->tagname ) =~ tr/-:./__/;
@@ -119,7 +123,7 @@
###########################################################################
sub pod_text {
- my($w, $t) = @_;
+ my($w, $t, $current_line) = @_;
if( $w->{'pod_in_X'} ) {
# no-op
} else {
@@ -130,8 +134,8 @@
join('/', %attributes), "\n";
my $startpoint = $w->index('end -1c');
- $w->insert( 'end -1c', $t->text );
-
+ $w->insert( 'end -1c', $t->text, "start_line_" . $current_line );
+
$w->tag(
'add',
$w->tag_for(\%attributes),
Modified: packages/libtk-pod-perl/branches/upstream/current/Pod/Styles.pm
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libtk-pod-perl/branches/upstream/current/Pod/Styles.pm?rev=4923&op=diff
==============================================================================
--- packages/libtk-pod-perl/branches/upstream/current/Pod/Styles.pm (original)
+++ packages/libtk-pod-perl/branches/upstream/current/Pod/Styles.pm Fri Mar 2 07:36:53 2007
@@ -4,7 +4,7 @@
package Tk::Pod::Styles;
use vars qw($VERSION);
-$VERSION = sprintf("%d.%02d", q$Revision: 5.3 $ =~ /(\d+)\.(\d+)/);
+$VERSION = sprintf("%d.%02d", q$Revision: 5.4 $ =~ /(\d+)\.(\d+)/);
sub init_styles {
my $w = shift;
@@ -54,6 +54,21 @@
sub base_font_size { return $_[0]{'style'}{'base_font_size'} ||= 10 }
+sub font_sans_serif {
+ my $w = shift;
+ $w->optionGet("sansSerifFont", "SansSerifFont") || "helvetica";
+}
+
+sub font_serif {
+ my $w = shift;
+ $w->optionGet("serifFont", "SerifFont") || "times";
+}
+
+sub font_monospace {
+ my $w = shift;
+ $w->optionGet("monospaceFont", "MonospaceFont") || "courier";
+}
+
sub style_over_bullet {
$_[0]->{'style'}{'over_bullet'} ||=
[ 'indent' => $_[1]->attr('indent') || 4, @{ $_[0]->style_Para } ]
@@ -82,12 +97,14 @@
sub style_Para {
$_[0]->{'style'}{'Para'} ||=
- [ 'family' => 'times', 'size' => $_[0]->base_font_size ]
+ [ 'family' => $_[0]->font_serif,
+ 'size' => $_[0]->base_font_size,
+ ]
}
sub style_Verbatim {
$_[0]->{'style'}{'Verbatim'} ||=
- [ 'family' => 'courier',
+ [ 'family' => $_[0]->font_monospace,
'size' => $_[0]->base_font_size,
'wrap' => 'none',
]
@@ -95,25 +112,29 @@
sub style_head1 {
$_[0]->{'style'}{'head1'} ||=
- [ 'family' => 'helvetica', 'size' => int(1 + 1.75 * $_[0]->base_font_size),
+ [ 'family' => $_[0]->font_sans_serif,
+ 'size' => int(1 + 1.75 * $_[0]->base_font_size),
'underline' => 'true',
]
}
sub style_head2 {
$_[0]->{'style'}{'head2'} ||=
- [ 'family' => 'helvetica', 'size' => int(1 + 1.50 * $_[0]->base_font_size),
+ [ 'family' => $_[0]->font_sans_serif,
+ 'size' => int(1 + 1.50 * $_[0]->base_font_size),
'underline' => 'true',
]
}
sub style_head3 {
$_[0]->{'style'}{'head3'} ||=
- [ 'family' => 'helvetica', 'size' => int(1 + 1.25 * $_[0]->base_font_size),
+ [ 'family' => $_[0]->font_sans_serif,
+ 'size' => int(1 + 1.25 * $_[0]->base_font_size),
'underline' => 'true',
]
}
sub style_head4 {
$_[0]->{'style'}{'head4'} ||=
- [ 'family' => 'helvetica', 'size' => int(1 + 1.10 * $_[0]->base_font_size),
+ [ 'family' => $_[0]->font_sans_serif,
+ 'size' => int(1 + 1.10 * $_[0]->base_font_size),
'underline' => 'true',
]
}
@@ -121,7 +142,7 @@
# ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
sub style_C {
- $_[0]->{'style'}{'C'} ||= [ 'family' => 'courier', ] }
+ $_[0]->{'style'}{'C'} ||= [ 'family' => $_[0]->font_monospace, ] }
sub style_B {
$_[0]->{'style'}{'B'} ||= [ 'weight' => 'bold', ] }
Modified: packages/libtk-pod-perl/branches/upstream/current/Pod/Text.pm
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libtk-pod-perl/branches/upstream/current/Pod/Text.pm?rev=4923&op=diff
==============================================================================
--- packages/libtk-pod-perl/branches/upstream/current/Pod/Text.pm (original)
+++ packages/libtk-pod-perl/branches/upstream/current/Pod/Text.pm Fri Mar 2 07:36:53 2007
@@ -21,12 +21,12 @@
use Tk::Pod;
use Tk::Pod::SimpleBridge;
use Tk::Pod::Cache;
-use Tk::Pod::Util qw(is_in_path is_interactive detect_window_manager);
+use Tk::Pod::Util qw(is_in_path is_interactive detect_window_manager start_browser);
use vars qw($VERSION @ISA @POD $IDX
@tempfiles @gv_pids $terminal_fallback_warn_shown);
-$VERSION = sprintf("%d.%02d", q$Revision: 5.4 $ =~ /(\d+)\.(\d+)/);
+$VERSION = sprintf("%d.%02d", q$Revision: 5.9 $ =~ /(\d+)\.(\d+)/);
@ISA = qw(Tk::Frame Tk::Pod::SimpleBridge Tk::Pod::Cache);
@@ -97,8 +97,12 @@
}
sub findpod {
- my ($w,$name) = @_;
+ my ($w,$name,%opts) = @_;
+ my $quiet = delete $opts{-quiet};
+ warn "Unhandled extra options: ". join " ", %opts
+ if %opts;
unless (defined $name and length $name) {
+ return if $quiet;
$w->messageBox(
-title => "Tk::Pod Error",
-message => "Empty Pod file/name",
@@ -111,6 +115,7 @@
$absname = $name;
} else {
if ($name !~ /^[-_+:.\/A-Za-z0-9]+$/) {
+ return if $quiet;
$w->messageBox(
-title => "Tk::Pod Error",
-message => "Invalid path/file/module name '$name'\n");
@@ -119,6 +124,7 @@
$absname = Find($name);
}
if (!defined $absname) {
+ return if $quiet;
$w->messageBox(
-title => "Tk::Pod Error",
-message => "Can't find Pod '$name'\n"
@@ -246,7 +252,7 @@
sub edit
{
- my ($w,$edit) = @_;
+ my ($w,$edit,$linenumber) = @_;
my($text, $path);
$path = $w->cget('-path');
if (!defined $path)
@@ -323,11 +329,33 @@
else
{
# grandchild
- exec("$edit $path");
+ if (defined $linenumber && $edit =~ m{\bemacsclient\b}) # XXX an experiment, maybe support more editors?
+ {
+ exec("$edit +$linenumber $path");
+ }
+ else
+ {
+ exec("$edit $path");
+ }
}
}
}
}
+}
+
+sub edit_get_linenumber
+{
+ my($w) = @_;
+ my $linenumber;
+ for my $tag ($w->tagNames('@' . ($w->{MenuX} - $w->rootx) . ',' . ($w->{MenuY} - $w->rooty)))
+ {
+ if ($tag =~ m{start_line_(\d+)})
+ {
+ $linenumber = $1;
+ last;
+ }
+ }
+ $w->edit(undef, $linenumber);
}
sub _sgn { $_[0] cmp 0 }
@@ -384,6 +412,7 @@
$p_scr->bind('<Double-1>', sub { $w->DoubleClick($_[0]) });
$p_scr->bind('<Shift-Double-1>', sub { $w->ShiftDoubleClick($_[0]) });
$p_scr->bind('<Double-2>', sub { $w->ShiftDoubleClick($_[0]) });
+ $p_scr->bind('<3>', sub { $w->PostPopupMenu($p_scr, $w->pointerxy) });
$p->configure(-font => $w->Font(family => 'courier'));
@@ -406,13 +435,14 @@
};
my $m = $p->Menu
- (-tearoff => $Tk::platform ne 'MSWin32',
+ (-title => "Tkpod",
+ -tearoff => $Tk::platform ne 'MSWin32',
-menuitems =>
[
[Button => 'Back', -command => [$w, 'history_move', -1]],
[Button => 'Forward', -command => [$w, 'history_move', +1]],
[Button => 'Reload', -command => sub{$w->reload} ],
- [Button => 'Edit Pod', -command => sub{$w->edit} ],
+ [Button => 'Edit Pod', -command => sub{ $w->edit_get_linenumber } ],
[Button => 'Search fulltext',-command => ['SearchFullText', $w]],
[Separator => ""],
[Cascade => 'Edit',
@@ -629,20 +659,8 @@
sub Link_url {
my ($w,$how,$index,$man,$sec) = @_;
- if (!defined &WWWBrowser::start_browser && !eval { require WWWBrowser }) {
- *WWWBrowser::start_browser = sub {
- my $url = shift;
- if ($^O eq 'MSWin32') {
- system("start explorer $url");
- } elsif ($^O eq 'cygwin') {
- system("explorer $url &");
- } else {
- system("mozilla $url &");
- }
- };
- }
DEBUG and warn "Start browser with $man\n";
- WWWBrowser::start_browser($man);
+ start_browser($man);
}
sub Link_man {
@@ -1136,6 +1154,13 @@
}
}
+sub PostPopupMenu {
+ my($w, $p_scr, $X, $Y) = @_;
+ $w->{MenuX} = $X;
+ $w->{MenuY} = $Y;
+ $p_scr->PostPopupMenu($X, $Y);
+}
+
END {
if (@tempfiles) {
my $gv_running;
@@ -1147,7 +1172,7 @@
}
if ($gv_running) {
- warn "A ghostscript (or equivalent) process is still running, do not delete temporary files: @tempfiles\n";
+ warn "A ghostscript (or equivalent) process is still running, won't delete temporary files: @tempfiles\n";
} else {
for my $temp (@tempfiles) {
unlink $temp;
@@ -1213,6 +1238,9 @@
The position of the scrollbars, see also L<Tk::Scrolled>. By default,
the vertical scrollbar is on the right on Windows systems and on the
left on X11 systems.
+
+Note that it is not necessary and usually will do the wrong thing if
+you put a C<Tk::Pod::Text> widget into a C<Scrolled> component.
=back
@@ -1309,6 +1337,8 @@
=back
+Unicode outside Latin1 range: E<0x20ac> (euro sign).
+
Pod with umlaut: L<ExtUtils::MakeMaker>.
Details: L<perlpod> or perl, perlfunc.
Modified: packages/libtk-pod-perl/branches/upstream/current/Pod/Tree.pm
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libtk-pod-perl/branches/upstream/current/Pod/Tree.pm?rev=4923&op=diff
==============================================================================
--- packages/libtk-pod-perl/branches/upstream/current/Pod/Tree.pm (original)
+++ packages/libtk-pod-perl/branches/upstream/current/Pod/Tree.pm Fri Mar 2 07:36:53 2007
@@ -1,10 +1,10 @@
# -*- perl -*-
#
-# $Id: Tree.pm,v 5.1 2004/09/08 21:07:25 eserte Exp $
+# $Id: Tree.pm,v 5.2 2007/02/27 21:46:43 eserte Exp $
# Author: Slaven Rezic
#
-# Copyright (C) 2001,2004 Slaven Rezic. All rights reserved.
+# Copyright (C) 2001,2004,2007 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.
#
@@ -54,7 +54,7 @@
use strict;
use vars qw($VERSION @ISA @POD %EXTRAPODDIR $FindPods $ExtraFindPods);
-$VERSION = sprintf("%d.%02d", q$Revision: 5.1 $ =~ /(\d+)\.(\d+)/);
+$VERSION = sprintf("%d.%02d", q$Revision: 5.2 $ =~ /(\d+)\.(\d+)/);
use base 'Tk::Tree';
@@ -401,6 +401,7 @@
my($w,$path) = @_;
my $fs_case_tolerant =
($^O eq 'MSWin32' ||
+ $^O eq 'darwin' || # case_tolerant=0 here!
(File::Spec->can("case_tolerant") && File::Spec->case_tolerant)
);
if ($^O eq 'MSWin32') {
Modified: packages/libtk-pod-perl/branches/upstream/current/Pod/Util.pm
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libtk-pod-perl/branches/upstream/current/Pod/Util.pm?rev=4923&op=diff
==============================================================================
--- packages/libtk-pod-perl/branches/upstream/current/Pod/Util.pm (original)
+++ packages/libtk-pod-perl/branches/upstream/current/Pod/Util.pm Fri Mar 2 07:36:53 2007
@@ -1,7 +1,7 @@
# -*- perl -*-
#
-# $Id: Util.pm,v 5.1 2004/09/08 21:06:56 eserte Exp $
+# $Id: Util.pm,v 5.2 2006/05/04 18:59:37 eserte Exp $
# Author: Slaven Rezic
#
# Copyright (C) 2003,2004 Slaven Rezic. All rights reserved.
@@ -15,10 +15,10 @@
package Tk::Pod::Util;
use strict;
use vars qw($VERSION @EXPORT_OK);
-$VERSION = sprintf("%d.%02d", q$Revision: 5.1 $ =~ /(\d+)\.(\d+)/);
+$VERSION = sprintf("%d.%02d", q$Revision: 5.2 $ =~ /(\d+)\.(\d+)/);
use base qw(Exporter);
- at EXPORT_OK = qw(is_in_path is_interactive detect_window_manager);
+ at EXPORT_OK = qw(is_in_path is_interactive detect_window_manager start_browser);
# REPO BEGIN
# REPO NAME is_in_path /home/e/eserte/src/repository
@@ -50,8 +50,8 @@
return -t STDIN && -t STDOUT;
}
- # from perlfaq8
- open(TTY, "/dev/tty") or die $!;
+ # from perlfaq8 (with glitches)
+ open(TTY, "/dev/tty") or return 0;
my $tpgrp = POSIX::tcgetpgrp(fileno(*TTY));
my $pgrp = getpgrp();
if ($tpgrp == $pgrp) {
@@ -87,6 +87,29 @@
@ret;
}
+sub start_browser {
+ my($url) = @_;
+
+ if (!defined &WWWBrowser::start_browser && !eval { require WWWBrowser }) {
+ *WWWBrowser::start_browser = sub {
+ my $url = shift;
+ if ($^O eq 'MSWin32') {
+ system(qq{start explorer "$url"});
+ } elsif ($^O eq 'cygwin') {
+ system(qq{explorer "$url" &});
+ } elsif (is_in_path("mozilla")) {
+ system(qq{mozilla "$url" &});
+ } elsif (is_in_path("firefox")) {
+ system(qq{firefox "$url" &});
+ } else { # last fallback
+ system(qq{mozilla "$url" &});
+ }
+ };
+ }
+
+ WWWBrowser::start_browser($url);
+}
+
1;
__END__
Modified: packages/libtk-pod-perl/branches/upstream/current/Pod_usage.pod
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libtk-pod-perl/branches/upstream/current/Pod_usage.pod?rev=4923&op=diff
==============================================================================
--- packages/libtk-pod-perl/branches/upstream/current/Pod_usage.pod (original)
+++ packages/libtk-pod-perl/branches/upstream/current/Pod_usage.pod Fri Mar 2 07:36:53 2007
@@ -111,7 +111,7 @@
L<Tk::Pod::Text>,
L<Tk::Pod::Tree>,
L<Tk::More>,
-L<Tk::Pod::English>,
+L<Text::English>.
=head1 KEYWORDS
Modified: packages/libtk-pod-perl/branches/upstream/current/TODO
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libtk-pod-perl/branches/upstream/current/TODO?rev=4923&op=diff
==============================================================================
--- packages/libtk-pod-perl/branches/upstream/current/TODO (original)
+++ packages/libtk-pod-perl/branches/upstream/current/TODO Fri Mar 2 07:36:53 2007
@@ -83,6 +83,10 @@
Make tree busy while building first time.
+=item *
+
+Show a progress bar or an indicator when refreshing the pod index.
+
=back
=head3 Tk::More
@@ -101,11 +105,22 @@
=item *
-In server mode, no commandline options are accepted.
+In server mode, no commandline options are accepted. Probably at least
+-h/-? should be supported and errors for other options dropped.
=item *
Get rid of the numerous warnings in server/client mode.
+
+=item *
+
+If the client sends a file which cannot be opened, then the server
+crashes!
+
+=item *
+
+The tkpod client should send cwd, so relative filenames work in server
+mode, too.
=back
@@ -157,6 +172,10 @@
But I would appreciate a general solution with either a
~/.tkpodrc or the X resources, as already mentioned.
+-> There's now a solution with X resources, which are also settable
+with -xrm. But maybe a .tkpodrc solution would also be nice, especially
+for non-X11 people.
+
=item *
cleanup search interface to perlindex. Maybe patch Ulrichs TPJ example
@@ -309,3 +328,16 @@
L<http://www.perlmonks.org/index.pl?node_id=352893>.
=back
+
+=head3 tkpod
+
+=over
+
+=item *
+
+Instead of listening to a tcp socket, maybe one should use a unix
+domain socket (security, a unix domain socket may be chown'ed and
+chmod'ed!)
+
+=back
+
Added: packages/libtk-pod-perl/branches/upstream/current/t/TkTest.pm
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libtk-pod-perl/branches/upstream/current/t/TkTest.pm?rev=4923&op=file
==============================================================================
--- packages/libtk-pod-perl/branches/upstream/current/t/TkTest.pm (added)
+++ packages/libtk-pod-perl/branches/upstream/current/t/TkTest.pm Fri Mar 2 07:36:53 2007
@@ -1,0 +1,43 @@
+# Copyright (C) 2003,2006,2007 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.
+
+# Parts taken from TkTest.pm from Perl/Tk
+
+package TkTest;
+
+use strict;
+use vars qw(@EXPORT);
+
+use base qw(Exporter);
+ at EXPORT = qw(check_display_harness);
+
+sub check_display_harness () {
+ # In case of cygwin, use'ing Tk before forking (which is done by
+ # Test::Harness) may lead to "remap" errors, which are normally
+ # solved by the rebase or rebaseall utilities.
+ #
+ # Here, I just skip the DISPLAY check on cygwin to not force users
+ # to run rebase.
+ #
+ return if $^O eq 'cygwin' || $^O eq 'MSWin32';
+
+ eval q{
+ use blib;
+ use Tk;
+ };
+ die "Strange: could not load Tk library: $@" if $@;
+
+ if (defined $Tk::platform && $Tk::platform eq 'unix') {
+ my $mw = eval { MainWindow->new() };
+ if (!Tk::Exists($mw)) {
+ warn "Cannot create MainWindow (maybe no X11 server is running or DISPLAY is not set?)\n$@\n";
+ exit 0;
+ }
+ $mw->destroy;
+ }
+}
+
+1;
+
+__END__
Modified: packages/libtk-pod-perl/branches/upstream/current/t/cmdline.t
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libtk-pod-perl/branches/upstream/current/t/cmdline.t?rev=4923&op=diff
==============================================================================
--- packages/libtk-pod-perl/branches/upstream/current/t/cmdline.t (original)
+++ packages/libtk-pod-perl/branches/upstream/current/t/cmdline.t Fri Mar 2 07:36:53 2007
@@ -2,20 +2,23 @@
# -*- perl -*-
#
-# $Id: cmdline.t,v 1.2 2003/02/05 14:46:29 eserte Exp $
+# $Id: cmdline.t,v 1.6 2007/01/27 19:58:54 eserte Exp $
# Author: Slaven Rezic
#
use strict;
+use FindBin;
use File::Spec;
+use Getopt::Long;
BEGIN {
if (!eval q{
- use Test;
+ use Test::More;
use POSIX ":sys_wait_h";
+ use File::Temp qw(tempfile tempdir);
1;
}) {
- print "1..0 # skip: no Test module\n";
+ print "1..0 # skip: no Test::More and/or POSIX module\n";
exit;
}
if ($ENV{BATCH} || $^O eq 'MSWin32') {
@@ -24,9 +27,29 @@
}
}
-BEGIN { plan tests => 6 }
+my $DEBUG = 0;
-my $script = 'blib/script/tkpod';
+my $blib = File::Spec->rel2abs("$FindBin::RealBin/../blib");
+my $script = "$blib/script/tkpod";
+
+GetOptions("d|debug" => \$DEBUG)
+ or die "usage: $0 [-debug]";
+
+# Create test directories/files:
+my $testdir = tempdir("tkpod_XXXXXXXX", TMPDIR => 1, CLEANUP => 1);
+die "Can't create temporary directory: $!" if !$testdir;
+
+my $cpandir = "$testdir/CPAN";
+mkdir $cpandir or die "Cannot create temporary directory: $!";
+
+my $cpanfile = "$testdir/CPAN.pm";
+{
+ open my $fh, ">", $cpanfile
+ or die "Cannot create $cpanfile: $!";
+ print $fh "=pod\nTest\n=cut\n";
+ close $fh
+ or die "While closing: $!";
+}
my @opt = (['-tk'],
['-tree','-geometry','+0+0'],
@@ -35,14 +58,37 @@
#['-Iblib/lib'],
['-d'],
['-server'],
+ ['-xrm', '*font: {nimbus sans l} 24',
+ '-xrm', '*serifFont: {nimbus roman no9 l}',
+ '-xrm', '*sansSerifFont: {nimbus sans l}',
+ '-xrm', '*monospaceFont: {nimbus mono l}',
+ ],
+ [$script], # the pod of tkpod itself
+ # This should be near end...
+ ['__ACTION__', chdir => $testdir ],
+ ["CPAN"],
);
+
+plan tests => scalar @opt;
+
OPT:
for my $opt (@opt) {
+ if ($opt->[0] eq '__ACTION__') {
+ my $action = $opt->[1];
+ if ($action eq 'chdir') {
+ chdir $opt->[2] or die $!;
+ } else {
+ die "Unknown action $action";
+ }
+ pass "Just setting an action...";
+ next;
+ }
+
my $pid = fork;
if ($pid == 0) {
- my @cmd = ($^X, "-Mblib", $script, @$opt);
- #warn "@cmd\n";
- open(STDERR, ">" . File::Spec->devnull);
+ my @cmd = ($^X, "-Mblib=$blib", $script, "-geometry", "+10+10", @$opt);
+ warn "@cmd\n" if $DEBUG;
+ open(STDERR, ">" . File::Spec->devnull) unless $DEBUG;
exec @cmd;
die $!;
}
@@ -50,7 +96,7 @@
select(undef,undef,undef,0.1);
my $kid = waitpid($pid, WNOHANG);
if ($kid) {
- ok($?, 0);
+ is($?, 0, "Trying tkpod with @$opt");
next OPT;
}
}
@@ -58,12 +104,12 @@
for (1..10) {
select(undef,undef,undef,0.1);
if (!kill 0 => $pid) {
- ok(1);
+ pass("Trying tkpod with @$opt");
next OPT;
}
}
kill KILL => $pid;
- ok(1);
+ pass("Trying tkpod with @$opt");
}
__END__
Modified: packages/libtk-pod-perl/branches/upstream/current/t/optionalmods.t
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libtk-pod-perl/branches/upstream/current/t/optionalmods.t?rev=4923&op=diff
==============================================================================
--- packages/libtk-pod-perl/branches/upstream/current/t/optionalmods.t (original)
+++ packages/libtk-pod-perl/branches/upstream/current/t/optionalmods.t Fri Mar 2 07:36:53 2007
@@ -2,7 +2,7 @@
# -*- perl -*-
#
-# $Id: optionalmods.t,v 1.2 2005/12/29 22:34:33 eserte Exp $
+# $Id: optionalmods.t,v 1.4 2007/02/27 21:47:03 eserte Exp $
# Author: Slaven Rezic
#
@@ -11,15 +11,22 @@
BEGIN {
if (!eval q{
use Test::More;
- require Test::Without::Module;
+# require Test::Without::Module;
+# die "Problems with Test::Without::Module 0.09"
+# if $Test::Without::Module::VERSION eq '0.09';
+ $ENV{DEVEL_HIDE_PM} = "";
+ $ENV{DEVEL_HIDE_VERBOSE} = 0;
+ require Devel::Hide;
1;
}) {
- print "1..0 # skip: no Test::More and/or Test::Without::Module modules\n";
+# print "1..0 # skip: no Test::More and/or Test::Without::Module (!= 0.09) modules\n";
+ print "1..0 # skip: no Test::More and/or Devel::Hide modules\n";
exit;
}
}
-use Test::Without::Module qw(Text::English Tk::HistEntry Tk::ToolBar);
+#use Test::Without::Module qw(Text::English Tk::HistEntry Tk::ToolBar);
+use Devel::Hide qw(Text::English Tk::HistEntry Tk::ToolBar);
use Tk;
use Tk::Pod;
Modified: packages/libtk-pod-perl/branches/upstream/current/tkmore
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libtk-pod-perl/branches/upstream/current/tkmore?rev=4923&op=diff
==============================================================================
--- packages/libtk-pod-perl/branches/upstream/current/tkmore (original)
+++ packages/libtk-pod-perl/branches/upstream/current/tkmore Fri Mar 2 07:36:53 2007
@@ -3,7 +3,7 @@
use strict;
use vars qw($VERSION);
-$VERSION = sprintf("%d.%02d", q$Revision: 5.2 $ =~ /(\d+)\.(\d+)/);
+$VERSION = sprintf("%d.%02d", q$Revision: 5.3 $ =~ /(\d+)\.(\d+)/);
use Tk;
use Tk::More;
@@ -45,6 +45,8 @@
return if !defined $f;
load_file($f);
});
+$fm->entryconfigure("Exit", -accelerator => "Ctrl-Q");
+
my $helpmenu = $menu->Menu
(-tearoff => 0,
-menuitems => [
@@ -61,6 +63,7 @@
$more->focus;
load_file($file);
$more->bind("<q>" => sub { $mw->destroy });
+$more->bind("<Control-q>" => sub { $mw->destroy });
MainLoop;
sub load_file {
Modified: packages/libtk-pod-perl/branches/upstream/current/tkpod
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libtk-pod-perl/branches/upstream/current/tkpod?rev=4923&op=diff
==============================================================================
--- packages/libtk-pod-perl/branches/upstream/current/tkpod (original)
+++ packages/libtk-pod-perl/branches/upstream/current/tkpod Fri Mar 2 07:36:53 2007
@@ -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.3 $ =~ /(\d+)\.(\d+)/);
+$VERSION = sprintf("%d.%02d", q$Revision: 5.6 $ =~ /(\d+)\.(\d+)/);
use IO::Socket;
@@ -96,18 +96,24 @@
$tree = 0;
#XXX Getopt::Long::Configure ("bundling");
-if (!GetOptions("tk" => \$tk_opt,
- "tree" => \$tree,
- "notree" => sub { $tree = 0 },
- "s|server!" => \$server,
- "Mblib" => \$Mblib,
- "I=s@" => \@I,
- "d|debug!" => \$debug,
- "f=s" => \$function,
- "q=s" => \$question,
+if (!GetOptions("tk" => \$tk_opt,
+ "tree" => \$tree,
+ "notree" => sub { $tree = 0 },
+ "s|server!" => \$server,
+ "Mblib" => \$Mblib,
+ "I=s@" => \@I,
+ "d|debug!" => \$debug,
+ "f=s" => \$function,
+ "q=s" => \$question,
+ "filedialog=s" => sub {
+ my $mod = $_[1];
+ eval qq{ use $mod qw(as_default) };
+ die $@ if $@;
+ },
)) {
die <<EOT;
Usage: $0 [-tk] [[-no]tree] [-Mblib] [-I dir] [-d|debug] [-s|server]
+ [-filedialog module]
[-f function | -q FAQRegex | directory | name [...]]
EOT
@@ -181,14 +187,14 @@
my $opened = 0;
foreach $file (@ARGV)
{
- if (-d $file)
+ if (-d $file && !Tk::Pod::Text->findpod($file, -quiet => 1))
{
Tk::Pod->Dir($file);
}
else
{
$tl = $mw->Pod(-tree => $tree,
- -exitbutton => 1);
+ -exitbutton => 1);
# -file => ... should be called after creating the Pod window,
# because -title => ... is set implicitly by Pod's new
$tl->configure(-file => $file);
@@ -199,7 +205,7 @@
if (defined $function)
{
$tl = $mw->Pod(-tree => $tree,
- -exitbutton => 1);
+ -exitbutton => 1);
$tl->configure($tl->getpodargs(-f => $function));
$opened++;
}
@@ -302,7 +308,8 @@
=head1 SYNOPSIS
- tkpod [-tk] [[-no]tree] [-Mblib] [-I dir] [-d|debug] [-s|server]
+ tkpod [-tk] [[-no]tree] [-Mblib] [-I dir] [-d|debug] [-s|server]
+ [-filedialog module]
[-f function | -q FAQRegex | directory | name [...]]
@@ -316,8 +323,8 @@
listed on the command line or with the B<-I> option are added to the
default search path.
-For each C<name> listed on the command line B<tkpod> tries to
-to find Pod in C<name, name.pod> and C<name.pm> in the search
+For each C<name> listed on the command line B<tkpod> tries
+to find Pod in C<name>, C<name.pod> and C<name.pm> in the search
path. For each C<name> a new Pod browser window is opened.
If no C<name> is listed, then the main C<perl> pod is opened instead.
@@ -368,6 +375,11 @@
=item B<-q> I<FAQRegex>
Show the FAQ entry matching I<FAQRegex>.
+
+=item B<-filedialog> I<module>
+
+Use an alternative file dialog module, e.g. L<Tk::FileSelect>,
+L<Tk::FBox> or L<Tk::PathEntry::Dialog>.
=back
More information about the Pkg-perl-cvs-commits
mailing list