r6233 - in /trunk/libtk-pod-perl: Changes META.yml Makefile.PL More.pm Pod.pm Pod/FindPods.pm Pod/Search.pm Pod/Search_db.pm Pod/SimpleBridge.pm Pod/Text.pm Pod/Tree.pm TODO debian/changelog t/cmdline.t tkmore tkpod

segre at users.alioth.debian.org segre at users.alioth.debian.org
Thu Aug 2 14:33:28 UTC 2007


Author: segre
Date: Thu Aug  2 14:33:28 2007
New Revision: 6233

URL: http://svn.debian.org/wsvn/?sc=1&rev=6233
Log:
New upstream version committed

Modified:
    trunk/libtk-pod-perl/Changes
    trunk/libtk-pod-perl/META.yml
    trunk/libtk-pod-perl/Makefile.PL
    trunk/libtk-pod-perl/More.pm
    trunk/libtk-pod-perl/Pod.pm
    trunk/libtk-pod-perl/Pod/FindPods.pm
    trunk/libtk-pod-perl/Pod/Search.pm
    trunk/libtk-pod-perl/Pod/Search_db.pm
    trunk/libtk-pod-perl/Pod/SimpleBridge.pm
    trunk/libtk-pod-perl/Pod/Text.pm
    trunk/libtk-pod-perl/Pod/Tree.pm
    trunk/libtk-pod-perl/TODO
    trunk/libtk-pod-perl/debian/changelog
    trunk/libtk-pod-perl/t/cmdline.t
    trunk/libtk-pod-perl/tkmore
    trunk/libtk-pod-perl/tkpod

Modified: trunk/libtk-pod-perl/Changes
URL: http://svn.debian.org/wsvn/trunk/libtk-pod-perl/Changes?rev=6233&op=diff
==============================================================================
--- trunk/libtk-pod-perl/Changes (original)
+++ trunk/libtk-pod-perl/Changes Thu Aug  2 14:33:28 2007
@@ -1,4 +1,22 @@
 History for Tk::Pod
+
+version 0.9935
+	o fixed missing "use" in tkpod (spotted by Torsten Foertsch)
+	o nicer diagnostics output when finding duplicate modules
+	o better STDERR diagnostics if Pod cannot not be found in findpod
+	o cmdline.t tests with different environment settings
+	o cmdline.t works now in BATCH=0 mode
+
+version 0.9934
+	o Fixed fulltext search on Debian machines (different index
+	  location)
+	o minor Pod changes
+	o Tk::More and tkmore now support the -encoding option
+	o support coloring tree items for vendor directories
+	o new menu item: View Pod source (like Edit Pod, but using
+	  Tk::More)
+	o new method for Tk::More: AddQuitBindings
+	o documented public methods in Tk::More
 
 version 0.9933
 	o new menu items with search.cpan.org and annocpan.org links

Modified: trunk/libtk-pod-perl/META.yml
URL: http://svn.debian.org/wsvn/trunk/libtk-pod-perl/META.yml?rev=6233&op=diff
==============================================================================
--- trunk/libtk-pod-perl/META.yml (original)
+++ trunk/libtk-pod-perl/META.yml Thu Aug  2 14:33:28 2007
@@ -1,8 +1,11 @@
-# http://module-build.sourceforge.net/META-spec.html
+meta-spec:
+    version: 1.3
+    url: http://module-build.sourceforge.net/META-spec-v1.3.html
 name:         Tk-Pod
-version:      0.9933
-version_from: 
-installdirs:  site
+version:      0.9935
+abstract: Pod browser widget for Tk
+author:
+    - Slaven Rezic <srezic at cpan.org>
 requires:
     File::Temp:                    0
     Pod::Simple:                   0
@@ -16,3 +19,5 @@
 resources:
     bugtracker: http://rt.cpan.org/NoAuth/Bugs.html?Dist=Tk-Pod
     license: http://dev.perl.org/licenses/
+    repository: http://sourceforge.net/cvs/?group_id=91459
+generated_by: Slaven Rezic

Modified: trunk/libtk-pod-perl/Makefile.PL
URL: http://svn.debian.org/wsvn/trunk/libtk-pod-perl/Makefile.PL?rev=6233&op=diff
==============================================================================
--- trunk/libtk-pod-perl/Makefile.PL (original)
+++ trunk/libtk-pod-perl/Makefile.PL Thu Aug  2 14:33:28 2007
@@ -2,7 +2,7 @@
 
 use ExtUtils::MakeMaker;
 
-$DIST_VERSION = "0.9933";
+$DIST_VERSION = "0.9935";
 $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: $!";
@@ -50,7 +50,8 @@
 	'DISTNAME'	=> 'Tk-Pod',
 	'NAME'		=> 'Tk::Pod',
 	'VERSION'	=> $DIST_VERSION,
-	'NO_META'	=> 1,
+	'NO_META'	=> 1, # manually generated
+	'LICENSE'	=> 'perl',
 
 	'DIR'		=> [],	# Tk-Pod dist build dir is ignored
 

Modified: trunk/libtk-pod-perl/More.pm
URL: http://svn.debian.org/wsvn/trunk/libtk-pod-perl/More.pm?rev=6233&op=diff
==============================================================================
--- trunk/libtk-pod-perl/More.pm (original)
+++ trunk/libtk-pod-perl/More.pm Thu Aug  2 14:33:28 2007
@@ -3,7 +3,7 @@
 use strict;
 use vars qw($VERSION @ISA);
 
-$VERSION = sprintf("%d.%02d", q$Revision: 5.1 $ =~ /(\d+)\.(\d+)/);
+$VERSION = sprintf("%d.%02d", q$Revision: 5.2 $ =~ /(\d+)\.(\d+)/);
 
 use Tk qw(Ev);
 use Tk::Derived;
@@ -96,6 +96,7 @@
 		   'Search'    => 'SELF',
 		   'ShowMatch' => 'SELF',
 		   'Load'      => 'SELF',
+		   'AddQuitBindings' => 'SELF',
 		  );
 
     $cw->{DIRECTION} = "Next";
@@ -190,9 +191,15 @@
 # Load copied from TextUndo (xxx yy marks changes)
 sub Load
 {
- my ($text,$file) = @_;
+ my ($text,$file,%args) = @_;
+ my $encoding = delete $args{-encoding};
+ die "Unhandled arguments: " . join(" ", %args) if %args;
  if (open(FILE,"<$file"))
   {
+   if ($encoding)
+    {
+     binmode FILE, ":encoding($encoding)";
+    }
    $text->MainWindow->Busy;
    $text->SUPER::delete('1.0','end');
    #yy delete $text->{UNDO};
@@ -289,6 +296,11 @@
     Tk->break;
 }
 
+sub AddQuitBindings {
+    my($more) = @_;
+    $more->bind("<q>" => sub { $more->toplevel->destroy });
+    $more->bind("<Control-q>" => sub { $more->toplevel->destroy });
+}
 
 #package Tk::More::Status;
 #
@@ -378,6 +390,30 @@
 
 =back
 
+=head1 METHODS
+
+=over
+
+=item Load($file, %args)
+
+Load I<$file> into the widget. I<%args> may be one of the following
+
+=over
+
+=item -encoding => I<$encoding>
+
+Assume the encoding of the file to be I<$encoding>. If none is given,
+then assume no encoding (which is equivalent to iso-8859-1).
+
+=back
+
+=item AddQuitBinding
+
+Convenience method to add the bindinds Key-q and Control-Key-q to
+close the Toplevel window containing this More widget.
+
+=back
+
 =head1 BUGS
 
 Besides that most of more bindings are not implemented. This bugs

Modified: trunk/libtk-pod-perl/Pod.pm
URL: http://svn.debian.org/wsvn/trunk/libtk-pod-perl/Pod.pm?rev=6233&op=diff
==============================================================================
--- trunk/libtk-pod-perl/Pod.pm (original)
+++ trunk/libtk-pod-perl/Pod.pm Thu Aug  2 14:33:28 2007
@@ -4,8 +4,8 @@
 use Tk::Toplevel;
 
 use vars qw($VERSION $DIST_VERSION @ISA);
-$VERSION = sprintf("%d.%02d", q$Revision: 5.15 $ =~ /(\d+)\.(\d+)/);
-$DIST_VERSION = "0.9933";
+$VERSION = sprintf("%d.%02d", q$Revision: 5.17 $ =~ /(\d+)\.(\d+)/);
+$DIST_VERSION = "0.9935";
 
 @ISA = qw(Tk::Toplevel);
 

Modified: trunk/libtk-pod-perl/Pod/FindPods.pm
URL: http://svn.debian.org/wsvn/trunk/libtk-pod-perl/Pod/FindPods.pm?rev=6233&op=diff
==============================================================================
--- trunk/libtk-pod-perl/Pod/FindPods.pm (original)
+++ trunk/libtk-pod-perl/Pod/FindPods.pm Thu Aug  2 14:33:28 2007
@@ -1,7 +1,7 @@
 # -*- perl -*-
 
 #
-# $Id: FindPods.pm,v 5.5 2007/02/27 21:46:30 eserte Exp $
+# $Id: FindPods.pm,v 5.7 2007/07/27 20:25:25 eserte Exp $
 # Author: Slaven Rezic
 #
 # Copyright (C) 2001,2003,2004,2005,2007 Slaven Rezic. All rights reserved.
@@ -14,6 +14,8 @@
 
 package Tk::Pod::FindPods;
 
+=encoding iso-8859-2
+
 =head1 NAME
 
 Tk::Pod::FindPods - find Pods installed on the current system
@@ -36,7 +38,7 @@
 
 @EXPORT_OK = qw/%pods $has_cache pod_find/;
 
-$VERSION = sprintf("%d.%02d", q$Revision: 5.5 $ =~ /(\d+)\.(\d+)/);
+$VERSION = sprintf("%d.%02d", q$Revision: 5.7 $ =~ /(\d+)\.(\d+)/);
 
 BEGIN {  # Make a DEBUG constant very first thing...
   if(defined &DEBUG) {
@@ -143,6 +145,8 @@
 	$pods{$args{-category}} = {};
     }
 
+    my $duplicate_warning_header_seen = 0;
+
     my $wanted = sub {
 	if (-d) {
 	    if ($seen_dir{$File::Find::name}) {
@@ -175,7 +179,13 @@
 		my($ext1) = $hash->{$name}    =~ /\.(.*)$/;
 		my($ext2) = $File::Find::name =~ /\.(.*)$/;
 		if ($ext1 eq $ext2) {
-		    warn "Pod with same name (" . basename($hash->{$name}) . ") at different locations found: $hash->{$name} and $File::Find::name.\n";
+		    (my $modname = $name) =~ s{/}{::}g;
+		    if (!$duplicate_warning_header_seen) {
+			$duplicate_warning_header_seen = 1;
+			warn "*** Pod(s) with same name at different locations found: ***\n";
+		    }
+		    (my $hash_name_without_scheme = $hash->{$name}) =~ s{^file:}{};
+		    warn "  $modname:\n    $hash_name_without_scheme\n    $File::Find::name\n";
 		    return;
 		}
 	    }
@@ -240,6 +250,10 @@
 
     foreach my $inc (@script_dirs) {
 	find({ %opts, wanted => $wanted_scripts }, $inc);
+    }
+
+    if ($duplicate_warning_header_seen) {
+	warn "*** This was the list of Pod(s) with same name at different locations. ***\n";
     }
 
     $self->{pods} = \%pods;
@@ -325,6 +339,8 @@
 	'cpan';
     } elsif (is_site_module($path)) {
 	'site';
+    } elsif (is_vendor_module($path)) {
+	'vendor';
     } else {
 	'core';
     }
@@ -339,6 +355,15 @@
                 \Q$Config{'installsitelib'}\E
                |
 		\Q$Config{'installsitearch'}\E
+	       )/x;
+}
+
+sub is_vendor_module {
+    my $path = shift;
+    $path =~ /^(
+                \Q$Config{'installvendorlib'}\E
+               |
+		\Q$Config{'installvendorarch'}\E
 	       )/x;
 }
 
@@ -511,11 +536,11 @@
 
 =head1 SEE ALSO
 
-Tk::Tree(3).
+L<Tk::Tree>.
 
 =head1 AUTHOR
 
-Slaven Rezic <F<slaven at rezic.de>>
+Slaven Reziæ <F<slaven at rezic.de>>
 
 Copyright (c) 2001,2003,2004,2005 Slaven Rezic. All rights reserved.
 This program is free software; you can redistribute it and/or modify

Modified: trunk/libtk-pod-perl/Pod/Search.pm
URL: http://svn.debian.org/wsvn/trunk/libtk-pod-perl/Pod/Search.pm?rev=6233&op=diff
==============================================================================
--- trunk/libtk-pod-perl/Pod/Search.pm (original)
+++ trunk/libtk-pod-perl/Pod/Search.pm Thu Aug  2 14:33:28 2007
@@ -3,7 +3,7 @@
 use strict;
 use vars qw(@ISA $VERSION);
 
-$VERSION = sprintf("%d.%02d", q$Revision: 5.3 $ =~ /(\d+)\.(\d+)/);
+$VERSION = sprintf("%d.%02d", q$Revision: 5.4 $ =~ /(\d+)\.(\d+)/);
 
 use Carp;
 use Tk::Frame;
@@ -203,6 +203,8 @@
 1;
 __END__
 
+=encoding iso-8859-2
+
 =head1 NAME
 
 Tk::Pod::Search - Widget to access perlindex Pod full text index
@@ -258,7 +260,7 @@
 
 =head1 SEE ALSO
 
-Tk::Pod::Text, tkpod, perlindex, Tk::Pod, Tk::Pod::Search_db
+L<Tk::Pod::Text>, L<tkpod>, L<perlindex>, L<Tk::Pod>, L<Tk::Pod::Search_db>
 
 =head1 KEYWORDS
 
@@ -268,7 +270,7 @@
 
 Achim Bohnet <F<ach at mpe.mpg.de>>
 
-Current maintainer is Slaven Rezic <F<slaven at rezic.de>>.
+Current maintainer is Slaven Reziæ <F<slaven at rezic.de>>.
 
 Copyright (c) 1997-1998 Achim Bohnet. All rights reserved.  This program
 is free software; you can redistribute it and/or modify it under the same

Modified: trunk/libtk-pod-perl/Pod/Search_db.pm
URL: http://svn.debian.org/wsvn/trunk/libtk-pod-perl/Pod/Search_db.pm?rev=6233&op=diff
==============================================================================
--- trunk/libtk-pod-perl/Pod/Search_db.pm (original)
+++ trunk/libtk-pod-perl/Pod/Search_db.pm Thu Aug  2 14:33:28 2007
@@ -15,7 +15,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 Carp;
 use Fcntl;
@@ -25,6 +25,10 @@
 (my $PREFIX = $Config::Config{prefix}) =~ y|\\|/|d;
 (my $IDXDIR = $Config::Config{man1dir}) =~ s|/[^/]+$||;
 $IDXDIR ||= $PREFIX; # use perl directory if no manual directory exists
+# Debian uses a non-standard directory:
+if (-e "/etc/debian_version" && -d "/var/cache/perlindex") {
+    $IDXDIR = "/var/cache/perlindex";
+}
 
 sub new {
     my $class = shift;
@@ -133,6 +137,8 @@
 1;
 __END__
 
+=encoding iso-8859-2
+
 =head1 NAME
 
 Tk::Pod::Search_db - dirty OO wrapper for C<perlindex>'s search functionality
@@ -196,7 +202,7 @@
 
 =head1 SEE ALSO
 
-tkpod, perlindex perlpod, Tk::Pod::Search
+L<tkpod>, L<perlindex>, L<perlpod>, L<Tk::Pod::Search>
 
 =head1 AUTHORS
 
@@ -205,7 +211,7 @@
 Most of the code here is borrowed from L<perlindex> written by
 Ulrich Pfeifer <F<Ulrich.Pfeifer at de.uu.net>>.
 
-Current maintainer is Slaven Rezic <F<slaven at rezic.de>>.
+Current maintainer is Slaven Reziæ <F<slaven at rezic.de>>.
 
 Copyright (c) 1997-1998 Achim Bohnet. All rights reserved.  This program is
 free software; you can redistribute it and/or modify it under the same

Modified: trunk/libtk-pod-perl/Pod/SimpleBridge.pm
URL: http://svn.debian.org/wsvn/trunk/libtk-pod-perl/Pod/SimpleBridge.pm?rev=6233&op=diff
==============================================================================
--- trunk/libtk-pod-perl/Pod/SimpleBridge.pm (original)
+++ trunk/libtk-pod-perl/Pod/SimpleBridge.pm Thu Aug  2 14:33:28 2007
@@ -5,7 +5,7 @@
 # Interface between Tk::Pod and Pod::Simple
 
 use vars qw($VERSION);
-$VERSION = sprintf("%d.%02d", q$Revision: 5.2 $ =~ /(\d+)\.(\d+)/);
+$VERSION = sprintf("%d.%02d", q$Revision: 5.3 $ =~ /(\d+)\.(\d+)/);
 
 BEGIN {  # Make a DEBUG constant very first thing...
   if(defined &DEBUG) {
@@ -387,6 +387,8 @@
 1;
 __END__
 
+=encoding iso-8859-2
+
 =head1 NAME
 
 Tk::Pod::SimpleBridge -- render Pod::Simple events to a Tk::Pod window
@@ -400,12 +402,12 @@
 
 =head1 DESCRIPTION
 
-This class contains methods that Tk::Pod (specifically Tk::Pod::Text)
+This class contains methods that L<Tk::Pod> (specifically L<Tk::Pod::Text>)
 uses to render a pod page's text into its window.  It uses L<Pod::Simple>
 (specifically L<Pod::Simple::PullParser>) to do the parsing.
 
-Tk::Pod used to use Tk::Parse (a snapshot of an old old Pod-parser)
-to do the Pod-parsing.  But it doesn't anymore -- it now uses Pod::Simple
+L<Tk::Pod> used to use Tk::Parse (a snapshot of an old old Pod-parser)
+to do the Pod-parsing.  But it doesn't anymore -- it now uses L<Pod::Simple>
 via this module.
 
 =head1 COPYRIGHT AND DISCLAIMERS
@@ -425,6 +427,6 @@
 the old Tk::Pod::Text code that Nick Ing-Simmons
 <F<nick at ni-s.u-net.com>> originally wrote.
 
-Current maintainer is Slaven Rezic <F<slaven at rezic.de>>.
+Current maintainer is Slaven Reziæ <F<slaven at rezic.de>>.
 
 =cut

Modified: trunk/libtk-pod-perl/Pod/Text.pm
URL: http://svn.debian.org/wsvn/trunk/libtk-pod-perl/Pod/Text.pm?rev=6233&op=diff
==============================================================================
--- trunk/libtk-pod-perl/Pod/Text.pm (original)
+++ trunk/libtk-pod-perl/Pod/Text.pm Thu Aug  2 14:33:28 2007
@@ -26,7 +26,7 @@
 use vars qw($VERSION @ISA @POD $IDX
 	    @tempfiles @gv_pids $terminal_fallback_warn_shown);
 
-$VERSION = sprintf("%d.%02d", q$Revision: 5.9 $ =~ /(\d+)\.(\d+)/);
+$VERSION = sprintf("%d.%02d", q$Revision: 5.12 $ =~ /(\d+)\.(\d+)/);
 
 @ISA = qw(Tk::Frame Tk::Pod::SimpleBridge Tk::Pod::Cache);
 
@@ -129,7 +129,7 @@
 	  -title => "Tk::Pod Error",
 	  -message => "Can't find Pod '$name'\n"
 	);
-	die;
+	die "Can't find Pod '$name' in @POD\n";
     }
     if (eval { require File::Spec; File::Spec->can("rel2abs") }) {
 	DEBUG and warn "Turn $absname into an absolute file name";
@@ -250,14 +250,14 @@
  $w->markSet(insert => '@0,0');
 }
 
-sub edit
+# Works also for viewing source code
+sub _get_editable_path
 {
- my ($w,$edit,$linenumber) = @_;
- my($text, $path);
- $path = $w->cget('-path');
+ my ($w) = @_;
+ my $path = $w->cget('-path');
  if (!defined $path)
   {
-   $text = $w->cget("-text");
+   my $text = $w->cget("-text");
    $w->_need_File_Temp;
    my($fh,$fname) = File::Temp::tempfile(UNLINK => 1,
 					 SUFFIX => ".pod");
@@ -265,6 +265,13 @@
    close $fh;
    $path = $fname;
   }
+ $path;
+}
+
+sub edit
+{
+ my ($w,$edit,$linenumber) = @_;
+ my $path = $w->_get_editable_path;
  if (!defined $edit)
   {
    $edit = $ENV{TKPODEDITOR};
@@ -358,6 +365,22 @@
  $w->edit(undef, $linenumber);
 }
 
+sub view_source
+{
+ my($w) = @_;
+ # XXX why is -title empty here?
+ my $title = $w->cget(-title) || $w->cget('-file');
+ my $t = $w->Toplevel(-title => "Source of $title - Tkpod");
+ my $font_size = $w->base_font_size;
+ my $more = $t->Scrolled('More',
+			 -font => "Courier $font_size",
+			 -scrollbars => $Tk::platform eq 'MSWin32' ? 'e' : 'w',
+			)->pack(-fill => "both", -expand => 1);
+ $more->Load($w->_get_editable_path);
+ $more->AddQuitBindings;
+ $more->focus;
+}
+
 sub _sgn { $_[0] cmp 0 }
 
 sub zoom_normal {
@@ -443,6 +466,7 @@
 	  [Button => 'Forward',  -command => [$w, 'history_move', +1]],
 	  [Button => 'Reload',   -command => sub{$w->reload} ],
 	  [Button => 'Edit Pod',       -command => sub{ $w->edit_get_linenumber } ],
+	  [Button => 'View source',    -command => sub{ $w->view_source } ],
 	  [Button => 'Search fulltext',-command => ['SearchFullText', $w]],
 	  [Separator => ""],
 	  [Cascade => 'Edit',
@@ -1406,7 +1430,7 @@
 
 Nick Ing-Simmons <F<nick at ni-s.u-net.com>>
 
-Current maintainer is Slaven Rezic <F<slaven at rezic.de>>.
+Current maintainer is Slaven ReziE<0x107> <F<slaven at rezic.de>>.
 
 Copyright (c) 1998 Nick Ing-Simmons.  All rights reserved.  This program
 is free software; you can redistribute it and/or modify it under the same

Modified: trunk/libtk-pod-perl/Pod/Tree.pm
URL: http://svn.debian.org/wsvn/trunk/libtk-pod-perl/Pod/Tree.pm?rev=6233&op=diff
==============================================================================
--- trunk/libtk-pod-perl/Pod/Tree.pm (original)
+++ trunk/libtk-pod-perl/Pod/Tree.pm Thu Aug  2 14:33:28 2007
@@ -1,7 +1,7 @@
 # -*- perl -*-
 
 #
-# $Id: Tree.pm,v 5.2 2007/02/27 21:46:43 eserte Exp $
+# $Id: Tree.pm,v 5.4 2007/05/10 20:11:09 eserte Exp $
 # Author: Slaven Rezic
 #
 # Copyright (C) 2001,2004,2007 Slaven Rezic. All rights reserved.
@@ -54,7 +54,7 @@
 
 use strict;
 use vars qw($VERSION @ISA @POD %EXTRAPODDIR $FindPods $ExtraFindPods);
-$VERSION = sprintf("%d.%02d", q$Revision: 5.2 $ =~ /(\d+)\.(\d+)/);
+$VERSION = sprintf("%d.%02d", q$Revision: 5.4 $ =~ /(\d+)\.(\d+)/);
 
 use base 'Tk::Tree';
 
@@ -234,6 +234,10 @@
 					-foreground => '#702000',
 					-selectforeground => '#702000',
 				       );
+    $w->{Style}{'vendor'} = $w->ItemStyle('imagetext',
+					  -foreground => '#856b48',
+					  -selectforeground => '#856b48',
+					 );
     $w->{Style}{'cpan'} = $w->ItemStyle('imagetext',
 					-foreground => '#000080',
 					-selectforeground => '#000080',
@@ -610,13 +614,13 @@
 
 =head1 SEE ALSO
 
-Tk::Tree(3), Tk::Pod(3), tkpod(1), Tk::Pod::FindPods(3).
+L<Tk::Tree>, L<Tk::Pod>, L<tkpod>, L<Tk::Pod::FindPods>.
 
 =head1 AUTHOR
 
-Slaven Rezic <F<slaven at rezic.de>>
-
-Copyright (c) 2001,2004 Slaven Rezic.  All rights reserved.  This program
+Slaven ReziE<0x107> <F<slaven at rezic.de>>
+
+Copyright (c) 2001,2004 Slaven ReziE<0x107>.  All rights reserved.  This program
 is free software; you can redistribute it and/or modify it under the same
 terms as Perl itself.
 

Modified: trunk/libtk-pod-perl/TODO
URL: http://svn.debian.org/wsvn/trunk/libtk-pod-perl/TODO?rev=6233&op=diff
==============================================================================
--- trunk/libtk-pod-perl/TODO (original)
+++ trunk/libtk-pod-perl/TODO Thu Aug  2 14:33:28 2007
@@ -8,22 +8,6 @@
 =head3 Tk::Pod
 
 =over
-
-=item *
-
-Ctrl-O Exporter does not work?!
-
-=item *
-
-What about the reported error on Suse Linux (see Tk-Pod entry on
-rt.cpan.org)? I can't reproduce this bug...
-
-=item *
-
-Dump does not always work on a RedHat 8.0 system, so I had to use a
-workaround. Also, Tk::Pod very often dumps core on this system in
-conjuction with perl5.8.0 and Tk800.025, but this might be a
-RedHat-related issue.
 
 =item *
 
@@ -35,11 +19,6 @@
 For Windows: check whether Tk::More/Tk::Tree match the system
 background colors. Also check if the "Help" menu item is on the
 correct place.
-
-=item *
-
-maybe special handling for Tk::Pod::FindPods under Mac OS X is
-necessary (pod directory is /System/Library/Perl/pods)
 
 =item *
 
@@ -73,7 +52,22 @@
 Tweaking the _indent functionality in Tk::Pod::SimpleBridge seems to
 be necessary.
 
-=back
+=item *
+
+If .pod and .pm are located in separated directories, then the wrong
+file (the .pm) might be chosen. Seen on Debian with IO::Handle.
+
+=back
+
+=head3 Tk::Pod::FindPods
+
+=over
+
+=item *
+
+The location of the cache file is predictable and on /tmp which is
+bad. Either choose a unpredictable but unique filename, or use
+techniques like O_EXCL (is this supported everywhere?).
 
 =head3 Tk::Pod::Tree
 
@@ -148,10 +142,6 @@
 =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 *
 
@@ -341,3 +331,28 @@
 
 =back
 
+=head2 Expired
+
+These bugs are probably fixed or not reproducable or apparent on old
+systems only:
+
+=over
+
+=item *
+
+Ctrl-O Exporter does not work?!
+
+=item *
+
+What about the reported error on Suse Linux (see Tk-Pod entry on
+rt.cpan.org)? I can't reproduce this bug...
+
+=item *
+
+Dump does not always work on a RedHat 8.0 system, so I had to use a
+workaround. Also, Tk::Pod very often dumps core on this system in
+conjuction with perl5.8.0 and Tk800.025, but this might be a
+RedHat-related issue.
+
+=back
+

Modified: trunk/libtk-pod-perl/debian/changelog
URL: http://svn.debian.org/wsvn/trunk/libtk-pod-perl/debian/changelog?rev=6233&op=diff
==============================================================================
--- trunk/libtk-pod-perl/debian/changelog (original)
+++ trunk/libtk-pod-perl/debian/changelog Thu Aug  2 14:33:28 2007
@@ -1,8 +1,8 @@
-libtk-pod-perl (0.9933-1) unstable; urgency=low
+libtk-pod-perl (0.9935-1) UNRELEASED; urgency=low
 
-  * New upstream release
+  * (NOT RELEASED YET) New upstream release
 
- -- Carlo Segre <segre at debian.org>  Fri,  2 Mar 2007 00:37:23 -0600
+ -- Carlo Segre <segre at debian.org>  Thu, 02 Aug 2007 02:43:59 -0500
 
 libtk-pod-perl (0.9932-5) unstable; urgency=low
 

Modified: trunk/libtk-pod-perl/t/cmdline.t
URL: http://svn.debian.org/wsvn/trunk/libtk-pod-perl/t/cmdline.t?rev=6233&op=diff
==============================================================================
--- trunk/libtk-pod-perl/t/cmdline.t (original)
+++ trunk/libtk-pod-perl/t/cmdline.t Thu Aug  2 14:33:28 2007
@@ -2,7 +2,7 @@
 # -*- perl -*-
 
 #
-# $Id: cmdline.t,v 1.6 2007/01/27 19:58:54 eserte Exp $
+# $Id: cmdline.t,v 1.7 2007/07/27 20:31:51 eserte Exp $
 # Author: Slaven Rezic
 #
 
@@ -21,8 +21,8 @@
 	print "1..0 # skip: no Test::More and/or POSIX module\n";
 	exit;
     }
-    if ($ENV{BATCH} || $^O eq 'MSWin32') {
-	print "1..0 # skip: not on Windows or in BATCH mode\n";
+    if ($^O eq 'MSWin32') {
+	print "1..0 # skip: not on Windows\n"; # XXX but why?
 	exit;
     }
 }
@@ -32,8 +32,11 @@
 my $blib   = File::Spec->rel2abs("$FindBin::RealBin/../blib");
 my $script = "$blib/script/tkpod";
 
-GetOptions("d|debug" => \$DEBUG)
-    or die "usage: $0 [-debug]";
+my $batch_mode = defined $ENV{BATCH} ? $ENV{BATCH} : 1;
+
+GetOptions("d|debug" => \$DEBUG,
+	   "batch!" => \$batch_mode)
+    or die "usage: $0 [-debug] [-nobatch]";
 
 # Create test directories/files:
 my $testdir = tempdir("tkpod_XXXXXXXX", TMPDIR => 1, CLEANUP => 1);
@@ -46,12 +49,23 @@
 {
     open my $fh, ">", $cpanfile
 	or die "Cannot create $cpanfile: $!";
-    print $fh "=pod\nTest\n=cut\n";
+    print $fh "=pod\n\nTest\n\n=cut\n";
     close $fh
 	or die "While closing: $!";
 }
 
-my @opt = (['-tk'],
+my $obscurepod = "ThisFileReallyShouldNotExistInAPerlDistroXYZfooBAR";
+my $obscurefile = "$testdir/$obscurepod.pod";
+{
+    open my $fh, ">", $obscurefile
+	or die "Cannot create $obscurefile: $!";
+    print $fh "=pod\n\nThis is: $obscurepod\n\n=cut\n";
+    close $fh
+	or die "While closing: $!";
+}
+
+my @opt = (
+	   ['-tk'],
 	   ['-tree','-geometry','+0+0'],
 	   ['-notree'],
 	   ['-Mblib'],
@@ -64,6 +78,13 @@
 	    '-xrm', '*monospaceFont: {nimbus mono l}',
 	   ],
 	   [$script], # the pod of tkpod itself
+
+	   # Environment settings
+	   ['-tree', '__ENV__', TKPODCACHE => "$testdir/pods_%v_%o_%u"],
+	   ['__ENV__', TKPODDEBUG => 1],
+	   ['__ENV__', TKPODEDITOR => 'ptked'],
+	   [$obscurepod.".pod", '__ENV__', TKPODDIRS => $testdir],
+
 	   # This should be near end...
 	   ['__ACTION__', chdir => $testdir ],
 	   ["CPAN"],
@@ -84,32 +105,72 @@
 	next;
     }
 
-    my $pid = fork;
-    if ($pid == 0) {
-	my @cmd = ($^X, "-Mblib=$blib", $script, "-geometry", "+10+10", @$opt);
-	warn "@cmd\n" if $DEBUG;
+    local %ENV = %ENV;
+    delete $ENV{$_} for qw(TKPODCACHE TKPODDEBUG TKPODDIRS TKPODEDITOR);
+
+    my @this_opts;
+    my @this_env;
+    for(my $i = 0; $i<=$#$opt; $i++) {
+	if ($opt->[$i] eq '__ENV__') {
+	    $ENV{$opt->[$i+1]} = $opt->[$i+2];
+	    push @this_env, $opt->[$i+1]."=".$opt->[$i+2];
+	    $i+=2;
+	} else {
+	    push @this_opts, $opt->[$i];
+	}
+    }
+
+    my $testname = "Trying tkpod with @this_opts";
+    if (@this_env) {
+	$testname .= ", environment " . join(", ", @this_env);
+    }
+
+    if ($batch_mode) {
+	my $pid = fork;
+	if ($pid == 0) {
+	    run_tkpod(\@this_opts);
+	}
+	for (1..10) {
+	    select(undef,undef,undef,0.05);
+	    my $kid = waitpid($pid, WNOHANG);
+	    if ($kid) {
+		is($?, 0, $testname);
+		next OPT;
+	    }
+	}
+	kill TERM => $pid;
+	for (1..10) {
+	    select(undef,undef,undef,0.05);
+	    if (!kill 0 => $pid) {
+		pass($testname);
+		next OPT;
+	    }
+	}
+	kill KILL => $pid;
+	pass($testname);
+    } else {
+	run_tkpod(\@this_opts);
+	pass($testname);
+    }
+}
+
+sub run_tkpod {
+    my $this_opts_ref = shift;
+    my @cmd = ($^X, "-Mblib=$blib", $script, "-geometry", "+10+10", @$this_opts_ref);
+    warn "@cmd\n" if $DEBUG;
+    if ($batch_mode) {
 	open(STDERR, ">" . File::Spec->devnull) unless $DEBUG;
 	exec @cmd;
 	die $!;
-    }
-    for (1..10) {
-	select(undef,undef,undef,0.1);
-	my $kid = waitpid($pid, WNOHANG);
-	if ($kid) {
-	    is($?, 0, "Trying tkpod with @$opt");
-	    next OPT;
+    } else {
+	system @cmd;
+	if ($? == 2) {
+	    die "Aborted by user...\n";
+	}
+	if ($? != 0) {
+	    warn "<@cmd> failed with status code <$?>";
 	}
     }
-    kill TERM => $pid;
-    for (1..10) {
-	select(undef,undef,undef,0.1);
-	if (!kill 0 => $pid) {
-	    pass("Trying tkpod with @$opt");
-	    next OPT;
-	}
-    }
-    kill KILL => $pid;
-    pass("Trying tkpod with @$opt");
 }
 
 __END__

Modified: trunk/libtk-pod-perl/tkmore
URL: http://svn.debian.org/wsvn/trunk/libtk-pod-perl/tkmore?rev=6233&op=diff
==============================================================================
--- trunk/libtk-pod-perl/tkmore (original)
+++ trunk/libtk-pod-perl/tkmore Thu Aug  2 14:33:28 2007
@@ -3,7 +3,7 @@
 use strict;
 use vars qw($VERSION);
 
-$VERSION = sprintf("%d.%02d", q$Revision: 5.3 $ =~ /(\d+)\.(\d+)/);
+$VERSION = sprintf("%d.%02d", q$Revision: 5.4 $ =~ /(\d+)\.(\d+)/);
 
 use Tk;
 use Tk::More;
@@ -12,7 +12,7 @@
 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!")) {
+if (!GetOptions(\%opt, "font=s", "i|ignore-case!", "encoding=s")) {
     require Pod::Usage;
     Pod::Usage::pod2usage(2);
 }
@@ -62,13 +62,12 @@
 
 $more->focus;
 load_file($file);
-$more->bind("<q>" => sub { $mw->destroy });
-$more->bind("<Control-q>" => sub { $mw->destroy });
+$more->AddQuitBindings;
 MainLoop;
 
 sub load_file {
     my $file = shift;
-    $more->Load($file);
+    $more->Load($file, -encoding => $opt{encoding});
     $mw->title("tkmore - $file");
 }
 
@@ -80,7 +79,7 @@
 
 =head1 SYNOPSIS
 
-    tkmore [X11 options] [-i] filename
+    tkmore [X11 options] [-i] [-encoding encoding] filename
 
 =head1 DESCRIPTION
 
@@ -88,11 +87,18 @@
 
 =head2 OPTIONS
 
+Besides standard X11 options like C<-font>, B<tkmore> supports:
+
 =over
 
 =item -i
 
-Turn on case-insensitive search.
+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
 

Modified: trunk/libtk-pod-perl/tkpod
URL: http://svn.debian.org/wsvn/trunk/libtk-pod-perl/tkpod?rev=6233&op=diff
==============================================================================
--- trunk/libtk-pod-perl/tkpod (original)
+++ trunk/libtk-pod-perl/tkpod Thu Aug  2 14:33:28 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.6 $ =~ /(\d+)\.(\d+)/);
+$VERSION = sprintf("%d.%02d", q$Revision: 5.7 $ =~ /(\d+)\.(\d+)/);
 
 use IO::Socket;
 
@@ -83,11 +83,11 @@
 ### Problems under Windows... do not use it anymore
 #BEGIN { eval { require Tk::FcyEntry; }; };
 use Tk::Pod 4.18;
+use Tk::Pod::Text; # for findpod
 use Getopt::Long;
 #require Tk::ErrorDialog;
 
 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;
 
@@ -141,6 +141,9 @@
 	Tk::App::Reloader::shortcut();
 	$use_reloader = 1;
     }
+    if (eval { require Tk::App::Debug; 1 }) {
+	warn "Loaded Tk::App::Debug...\n";
+    }
 }
 
 start_server() if $server;




More information about the Pkg-perl-cvs-commits mailing list