From bloom-picayune.mit.edu!snorkelwacker.mit.edu!think.com!zaphod.mps.ohio-state.edu!wuarchive!uunet!mcsun!hp4nl!mhres!squirrel!pronto!jv Wed Jul  3 14:53:24 EDT 1991

The following patch modifies lib/perldb.pl for use with
emacs/perldb.el from GNU Emacs. It has been adopted from several
sources (emacs/perldb.pl being one) to 4.0 patchlevel 10.

**NOTE** This patch is based on the 4.010 version of lib/perldb.pl,
	 *NOT* emacs/perldb.pl. (In the latter case the size would
	 have been about 24K!)

To apply, chdir to your perl source dir, and run through 'patch -p0 -N'.

*** lib/perldb.pl	Mon Jun 10 11:54:19 1991
--- /usr/local/lib/perl4/perldb.pl	Tue Jul  2 13:28:50 1991
***************
*** 1,5 ****
--- 1,9 ----
  package DB;
  
+ # modified Perl debugger, to be run from Emacs in perldb-mode
+ # Ray Lischner (uunet!mntgfx!lisch) as of 5 Nov 1990
+ # Johan Vromans -- upgrade to 4.0 pl 10
+ 
  $header = '$RCSfile: perldb.pl,v $$Revision: 4.0.1.1 $$Date: 91/06/07 11:17:44 $';
  #
  # This file is automatically included if you do perl -d.
***************
*** 57,64 ****
  $| = 1;				# for real STDOUT
  $sub = '';
  
  $header =~ s/.Header: ([^,]+),v(\s+\S+\s+\S+).*$/$1$2/;
! print OUT "\nLoading DB routines from $header\n\nEnter h for help.\n\n";
  
  sub DB {
      &save;
--- 61,76 ----
  $| = 1;				# for real STDOUT
  $sub = '';
  
+ # Is Perl being run from Emacs?
+ $emacs = $main'ARGV[$[] eq '-emacs';
+ shift(@main'ARGV) if $emacs;
+ 
  $header =~ s/.Header: ([^,]+),v(\s+\S+\s+\S+).*$/$1$2/;
! print OUT "\nLoading DB routines from $header\n";
! print OUT ("Emacs support ",
! 	   $emacs ? "enabled" : "available",
! 	   ".\n");
! print OUT "\nEnter h for help.\n\n";
  
  sub DB {
      &save;
***************
*** 78,88 ****
  	}
      }
      if ($single || $trace || $signal) {
! 	print OUT "$package'" unless $sub =~ /'/;
! 	print OUT "$sub($filename:$line):\t",$dbline[$line];
! 	for ($i = $line + 1; $i <= $max && $dbline[$i] == 0; ++$i) {
! 	    last if $dbline[$i] =~ /^\s*(;|}|#|\n)/;
! 	    print OUT "$sub($filename:$i):\t",$dbline[$i];
  	}
      }
      $evalarg = $action, &eval if $action;
--- 90,104 ----
  	}
      }
      if ($single || $trace || $signal) {
! 	if ($emacs) {
! 	    print OUT "\032\032$filename:$line:0\n";
! 	} else {
! 	    print OUT "$package'" unless $sub =~ /'/;
! 	    print OUT "$sub($filename:$line):\t",$dbline[$line];
! 	    for ($i = $line + 1; $i <= $max && $dbline[$i] == 0; ++$i) {
! 		last if $dbline[$i] =~ /^\s*(}|#|\n)/;
! 		print OUT "$sub($filename:$i):\t",$dbline[$i];
! 	    }
  	}
      }
      $evalarg = $action, &eval if $action;
***************
*** 244,252 ****
  		    $i = $2;
  		    $i = $line if $i eq '.';
  		    $i = 1 if $i < 1;
! 		    for (; $i <= $end; $i++) {
! 			print OUT "$i:\t", $dbline[$i];
! 			last if $signal;
  		    }
  		    $start = $i;	# remember in case they want more
  		    $start = $max if $start > $max;
--- 260,273 ----
  		    $i = $2;
  		    $i = $line if $i eq '.';
  		    $i = 1 if $i < 1;
! 		    if ($emacs) {
! 			print OUT "\032\032$filename:$i:0\n";
! 			$i = $end;
! 		    } else {
! 			for (; $i <= $end; $i++) {
! 			    print OUT "$i:\t", $dbline[$i];
! 			    last if $signal;
! 			}
  		    }
  		    $start = $i;	# remember in case they want more
  		    $start = $max if $start > $max;
***************
*** 393,399 ****
  			$start = 1 if ($start > $max);
  			last if ($start == $end);
  			if ($dbline[$start] =~ m'."\n$pat\n".'i) {
! 			    print OUT "$start:\t", $dbline[$start], "\n";
  			    last;
  			}
  		    } ';
--- 414,424 ----
  			$start = 1 if ($start > $max);
  			last if ($start == $end);
  			if ($dbline[$start] =~ m'."\n$pat\n".'i) {
! 			    if ($emacs) {
! 				print OUT "\032\032$filename:$start:0\n";
! 			    } else {
! 				print OUT "$start:\t", $dbline[$start], "\n";
! 			    }
  			    last;
  			}
  		    } ';
***************
*** 417,423 ****
  			$start = $max if ($start <= 0);
  			last if ($start == $end);
  			if ($dbline[$start] =~ m'."\n$pat\n".'i) {
! 			    print OUT "$start:\t", $dbline[$start], "\n";
  			    last;
  			}
  		    } ';
--- 442,452 ----
  			$start = $max if ($start <= 0);
  			last if ($start == $end);
  			if ($dbline[$start] =~ m'."\n$pat\n".'i) {
! 			    if ($emacs) {
! 				print OUT "\032\032$filename:$start:0\n";
! 			    } else {
! 				print OUT "$start:\t", $dbline[$start], "\n";
! 			    }
  			    last;
  			}
  		    } ';
-- 
Johan Vromans				       jv@mh.nl via internet backbones
Multihouse Automatisering bv		       uucp: ..!{uunet,hp4nl}!mh.nl!jv
Doesburgweg 7, 2803 PL Gouda, The Netherlands  phone/fax: +31 1820 62911/62500
------------------------ "Arms are made for hugging" -------------------------