perl 4.0 patch 16: patch #11, continued

See patch #11.

1 files changed, 44 insertions, 12 deletions

diff --git a/lib/perldb.pl b/lib/perldb.pl
index 8d1605426c..917469b492 100644
--- a/lib/perldb.pl
+++ b/lib/perldb.pl
@@ -1,6 +1,10 @@
 package DB;
 
-$header = '$RCSfile: perldb.pl,v $$Revision: 4.0.1.1 $$Date: 91/06/07 11:17:44 $';
+# 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.2 $$Date: 91/11/05 17:55:58 $';
 #
 # This file is automatically included if you do perl -d.
 # It's probably not useful to include this yourself.
@@ -10,6 +14,9 @@ $header = '$RCSfile: perldb.pl,v $$Revision: 4.0.1.1 $$Date: 91/06/07 11:17:44 $
 # have a breakpoint.  It also inserts a do 'perldb.pl' before the first line.
 #
 # $Log:	perldb.pl,v $
+# Revision 4.0.1.2  91/11/05  17:55:58  lwall
+# patch11: perldb.pl modified to run within emacs in perldb-mode
+# 
 # Revision 4.0.1.1  91/06/07  11:17:44  lwall
 # patch4: added $^P variable to control calling of perldb routines
 # patch4: debugger sometimes listed wrong number of lines for a statement
@@ -57,8 +64,16 @@ select(STDOUT);
 $| = 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\nEnter h for help.\n\n";
+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,11 +93,15 @@ sub DB {
 	}
     }
     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];
+	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,9 +263,14 @@ command		Execute as a perl statement in current package.
 		    $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;
+		    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,7 +417,11 @@ command		Execute as a perl statement in current package.
 			$start = 1 if ($start > $max);
 			last if ($start == $end);
 			if ($dbline[$start] =~ m'."\n$pat\n".'i) {
-			    print OUT "$start:\t", $dbline[$start], "\n";
+			    if ($emacs) {
+				print OUT "\032\032$filename:$start:0\n";
+			    } else {
+				print OUT "$start:\t", $dbline[$start], "\n";
+			    }
 			    last;
 			}
 		    } ';
@@ -417,7 +445,11 @@ command		Execute as a perl statement in current package.
 			$start = $max if ($start <= 0);
 			last if ($start == $end);
 			if ($dbline[$start] =~ m'."\n$pat\n".'i) {
-			    print OUT "$start:\t", $dbline[$start], "\n";
+			    if ($emacs) {
+				print OUT "\032\032$filename:$start:0\n";
+			    } else {
+				print OUT "$start:\t", $dbline[$start], "\n";
+			    }
 			    last;
 			}
 		    } ';