From: Ilya Zakharevich <ilya@math.berkeley.edu>
Date: Thu, 28 Jan 1999 10:02:20 +0000 (-0500)
Subject: Re: [PATCH 5.005_53] Better perldoc
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=eb459f908c6917de52963debd198446257f3d2da;p=p5sagit%2Fp5-mst-13.2.git

Re: [PATCH 5.005_53] Better perldoc

	Message-ID: <19990128100220.A1321@monk.mps.ohio-state.edu>

p4raw-id: //depot/perl@2917
---

diff --git a/utils/perldoc.PL b/utils/perldoc.PL
index 2633510..f549cb1 100644
--- a/utils/perldoc.PL
+++ b/utils/perldoc.PL
@@ -232,7 +232,7 @@ sub minus_f_nocase {
      }
      return "";
 }
- 
+
 
 sub check_file {
     my($dir,$file) = @_;
@@ -273,7 +273,7 @@ sub searchfor {
 	) {
 	    return $ret;
 	}
-	
+
 	if ($recurse) {
 	    opendir(D,$dir);
 	    my @newdirs = map "$dir/$_", grep {
@@ -291,6 +291,15 @@ sub searchfor {
     return ();
 }
 
+sub filter_nroff {
+  my @data = split /\n{2,}/, shift;
+  shift @data while @data and $data[0] !~ /\S/; # Go to header
+  shift @data if @data and $data[0] =~ /Contributed\s+Perl/; # Skip header
+  pop @data if @data and $data[-1] =~ /^\w/; # Skip footer, like
+				# 28/Jan/99 perl 5.005, patch 53 1
+  join "\n\n", @data;
+}
+
 my @found;
 foreach (@pages) {
         if ($podidx && open(PODIDX, $podidx)) {
@@ -331,9 +340,9 @@ foreach (@pages) {
 		print STDERR "Found as @files\n" if $opt_v;
 	} else {
 		# no match, try recursive search
-		
+
 		@searchdirs = grep(!/^\.$/,@INC);
-		
+
 		@files= searchfor(1,$_,@searchdirs) if $opt_r;
 		if( @files ) {
 			print STDERR "Loosely found as @files\n" if $opt_v;
@@ -389,7 +398,7 @@ if ($Is_MSWin32) {
 	  $tmp = POSIX::tmpnam();
 	  unshift @pagers, 'less', 'cmd /c more <';
 	} else {
-	  $tmp = "/tmp/perldoc1.$$";	  
+	  $tmp = "/tmp/perldoc1.$$";
 	}
 	push @pagers, qw( more less pg view cat );
 	unshift @pagers, $ENV{PAGER}  if $ENV{PAGER};
@@ -402,8 +411,9 @@ if ($opt_m) {
 	}
 	if ($Is_VMS) { eval 'use vmsish qw(status exit); exit $?' }
 	exit 1;
-} 
+}
 
+my @pod;
 if ($opt_f) {
    my $perlfunc = shift @found;
    open(PFUNC, $perlfunc) or die "Can't open $perlfunc: $!";
@@ -418,7 +428,6 @@ if ($opt_f) {
 
    # Look for our function
    my $found = 0;
-   my @pod;
    while (<PFUNC>) {
        if (/^=item\s+\Q$search_string\E\b/o)  {
 	   $found = 1;
@@ -429,27 +438,9 @@ if ($opt_f) {
        push @pod, $_;
        ++$found if /^\w/;	# found descriptive text
    }
-   if (@pod) {
-       if ($opt_t) {
-	   open(FORMATTER, "| pod2text") || die "Can't start filter";
-	   print FORMATTER "=over 8\n\n";
-	   print FORMATTER @pod;
-	   print FORMATTER "=back\n";
-	   close(FORMATTER);
-       } elsif (@pod < $lines-2) {
-	   print @pod;
-       } else {
-	   foreach my $pager (@pagers) {
-		open (PAGER, "| $pager") or next;
-		print PAGER @pod ;
-		close(PAGER) or next;
-		last;
-	   }
-       }
-   } else {
+   if (!@pod) {
        die "No documentation for perl function `$opt_f' found\n";
    }
-   exit;
 }
 
 if ($opt_q) {
@@ -468,28 +459,24 @@ if ($opt_q) {
       next unless $found;
       push @pod, $_;
    }
-   
-   if (@pod) {
-      if ($opt_t) {
-	 open(FORMATTER, "| pod2text") || die "Can't start filter";
-	 print FORMATTER "=over 8\n\n";
-	 print FORMATTER @pod;
-	 print FORMATTER "=back\n";
-	 close(FORMATTER);
-      } elsif (@pod < $lines-2) {
-	 print @pod;
-      } else {
-	 foreach my $pager (@pagers) {
-	    open (PAGER, "| $pager") or next;
-	    print PAGER @pod ;
-	    close(PAGER) or next;
-	    last;
-	 }
-      }
-   } else {
+
+   if (!@pod) {
       die "No documentation for perl FAQ keyword `$opt_q' found\n";
    }
-   exit;
+}
+
+my $tmp1;
+my $filter;
+
+if (@pod) {
+  $tmp1 = $tmp . "_";
+  open(TMP,">$tmp1") or die "open '$tmp1': $!";
+  print TMP "=over 8\n\n";
+  print TMP @pod;
+  print TMP "=back\n";
+  close(TMP) or die "close '$tmp1': $!";
+  @found = $tmp1;
+  $filter = 1;
 }
 
 foreach (@found) {
@@ -503,13 +490,14 @@ foreach (@found) {
 		my $cmd = "pod2man --lax $_ | nroff -man";
 		$cmd .= " | col -x" if $^O =~ /hpux/;
 		my $rslt = `$cmd`;
+		$rslt = filter_nroff $rslt if $filter;
 		unless(($err = $?)) {
 			open(TMP,">>$tmp");
 			print TMP $rslt;
 			close TMP;
 		}
 	}
-	                                                
+
 	if( $opt_u or $err or -z $tmp) {
 		open(OUT,">>$tmp");
 		open(IN,"<$_");
@@ -535,6 +523,9 @@ if( $no_tty ) {
 }
 
 1 while unlink($tmp); #Possibly pointless VMSism
+if (defined $tmp1) {
+  1 while unlink($tmp1); #Possibly pointless VMSism
+}
 
 exit 0;
 
@@ -639,6 +630,8 @@ preference, the pager defined in C<PERLDOC_PAGER>, C<MANPAGER>, or
 C<PAGER> before trying to find a pager on its own.  (C<MANPAGER> is not
 used if C<perldoc> was told to display plain text or unformatted pod.)
 
+One useful value for C<PERLDOC_PAGER> is C<less -+C -E>.
+
 =head1 AUTHOR
 
 Kenneth Albanowski <kjahds@kjahds.com>