perl 4.0.00: (no release announcement available)perl-4.0.00

So far, 4.0 is still a beta test version.  For the last production
version, look in pub/perl.3.0/kits@44.

4 files changed, 1915 insertions, 0 deletions

diff --git a/emacs/perl-mode.el b/emacs/perl-mode.el
new file mode 100644
index 0000000000..5d7078cf3c
--- /dev/null
+++ b/emacs/perl-mode.el
@@ -0,0 +1,631 @@
+;; Perl code editing commands for GNU Emacs
+;;   Copyright (C) 1990  William F. Mann
+;; Adapted from C code editing commands 'c-mode.el', Copyright 1987 by the
+;; Free Software Foundation, under terms of its General Public License.
+
+;; This file may be made part of GNU Emacs at the option of the FSF, or
+;; of the perl distribution at the option of Larry Wall.
+
+;; This code is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY.  No author or distributor
+;; accepts responsibility to anyone for the consequences of using it
+;; or for whether it serves any particular purpose or works at all,
+;; unless he says so in writing.  Refer to the GNU Emacs General Public
+;; License for full details.
+
+;; Everyone is granted permission to copy, modify and redistribute
+;; this code, but only under the conditions described in the
+;; GNU Emacs General Public License.   A copy of this license is
+;; supposed to have been given to you along with GNU Emacs so you
+;; can know your rights and responsibilities.  It should be in a
+;; file named COPYING.  Among other things, the copyright notice
+;; and this notice must be preserved on all copies.
+
+;; To enter perl-mode automatically, add (autoload 'perl-mode "perl-mode")
+;; to your .emacs file and change the first line of your perl script to:
+;; #!/usr/bin/perl --	 # -*-Perl-*-
+;; With argments to perl:
+;; #!/usr/bin/perl -P-	 # -*-Perl-*-
+;; To handle files included with do 'filename.pl';, add something like
+;; (setq auto-mode-alist (append (list (cons "\\.pl$" 'perl-mode))
+;;                               auto-mode-alist))
+;; to your .emacs file; otherwise the .pl suffix defaults to prolog-mode.
+
+;; This code is based on the 18.53 version c-mode.el, with extensive
+;; rewriting.  Most of the features of c-mode survived intact.
+
+;; I added a new feature which adds functionality to TAB; it is controlled
+;; by the variable perl-tab-to-comment.  With it enabled, TAB does the
+;; first thing it can from the following list:  change the indentation;
+;; move past leading white space; delete an empty comment; reindent a
+;; comment; move to end of line; create an empty comment; tell you that
+;; the line ends in a quoted string, or has a # which should be a \#.
+
+;; If your machine is slow, you may want to remove some of the bindings
+;; to electric-perl-terminator.  I changed the indenting defaults to be
+;; what Larry Wall uses in perl/lib, but left in all the options.
+
+;; I also tuned a few things:  comments and labels starting in column
+;; zero are left there by indent-perl-exp; perl-beginning-of-function
+;; goes back to the first open brace/paren in column zero, the open brace
+;; in 'sub ... {', or the equal sign in 'format ... ='; indent-perl-exp
+;; (meta-^q) indents from the current line through the close of the next
+;; brace/paren, so you don't need to start exactly at a brace or paren.
+
+;; It may be good style to put a set of redundant braces around your
+;; main program.  This will let you reindent it with meta-^q.
+
+;; Known problems (these are all caused by limitations in the elisp
+;; parsing routine (parse-partial-sexp), which was not designed for such
+;; a rich language; writing a more suitable parser would be a big job):
+;; 1)  Regular expression delimitors do not act as quotes, so special
+;;       characters such as `'"#:;[](){} may need to be backslashed
+;;       in regular expressions and in both parts of s/// and tr///.
+;; 2)  The globbing syntax <pattern> is not recognized, so special
+;;       characters in the pattern string must be backslashed.
+;; 3)  The q, qq, and << quoting operators are not recognized; see below.
+;; 4)  \ (backslash) always quotes the next character, so '\' is
+;;       treated as the start of a string.  Use "\\" as a work-around.
+;; 5)  To make variables such a $' and $#array work, perl-mode treats
+;;       $ just like backslash, so '$' is the same as problem 5.
+;; 6)  Unfortunately, treating $ like \ makes ${var} be treated as an
+;;       unmatched }.  See below.
+;; 7)  When ' (quote) is used as a package name separator, perl-mode
+;;       doesn't understand, and thinks it is seeing a quoted string.
+
+;; Here are some ugly tricks to bypass some of these problems:  the perl
+;; expression /`/ (that's a back-tick) usually evaluates harmlessly,
+;; but will trick perl-mode into starting a quoted string, which
+;; can be ended with another /`/.  Assuming you have no embedded
+;; back-ticks, this can used to help solve problem 3:
+;;
+;;     /`/; $ugly = q?"'$?; /`/;
+;;
+;; To solve problem 6, add a /{/; before each use of ${var}:
+;;     /{/; while (<${glob_me}>) ...
+;;
+;; Problem 7 is even worse, but this 'fix' does work :-(
+;;     $DB'stop#'
+;;         [$DB'line#'
+;;          ] =~ s/;9$//;
+
+
+(defvar perl-mode-abbrev-table nil
+  "Abbrev table in use in perl-mode buffers.")
+(define-abbrev-table 'perl-mode-abbrev-table ())
+
+(defvar perl-mode-map ()
+  "Keymap used in Perl mode.")
+(if perl-mode-map
+    ()
+  (setq perl-mode-map (make-sparse-keymap))
+  (define-key perl-mode-map "{" 'electric-perl-terminator)
+  (define-key perl-mode-map "}" 'electric-perl-terminator)
+  (define-key perl-mode-map ";" 'electric-perl-terminator)
+  (define-key perl-mode-map ":" 'electric-perl-terminator)
+  (define-key perl-mode-map "\e\C-a" 'perl-beginning-of-function)
+  (define-key perl-mode-map "\e\C-e" 'perl-end-of-function)
+  (define-key perl-mode-map "\e\C-h" 'mark-perl-function)
+  (define-key perl-mode-map "\e\C-q" 'indent-perl-exp)
+  (define-key perl-mode-map "\177" 'backward-delete-char-untabify)
+  (define-key perl-mode-map "\t" 'perl-indent-command))
+
+(autoload 'c-macro-expand "cmacexp"
+  "Display the result of expanding all C macros occurring in the region.
+The expansion is entirely correct because it uses the C preprocessor."
+  t)
+
+(defvar perl-mode-syntax-table nil
+  "Syntax table in use in perl-mode buffers.")
+
+(if perl-mode-syntax-table
+    ()
+  (setq perl-mode-syntax-table (make-syntax-table (standard-syntax-table)))
+  (modify-syntax-entry ?\n ">" perl-mode-syntax-table)
+  (modify-syntax-entry ?# "<" perl-mode-syntax-table)
+  (modify-syntax-entry ?$ "/" perl-mode-syntax-table)
+  (modify-syntax-entry ?% "." perl-mode-syntax-table)
+  (modify-syntax-entry ?& "." perl-mode-syntax-table)
+  (modify-syntax-entry ?\' "\"" perl-mode-syntax-table)
+  (modify-syntax-entry ?* "." perl-mode-syntax-table)
+  (modify-syntax-entry ?+ "." perl-mode-syntax-table)
+  (modify-syntax-entry ?- "." perl-mode-syntax-table)
+  (modify-syntax-entry ?/ "." perl-mode-syntax-table)
+  (modify-syntax-entry ?< "." perl-mode-syntax-table)
+  (modify-syntax-entry ?= "." perl-mode-syntax-table)
+  (modify-syntax-entry ?> "." perl-mode-syntax-table)
+  (modify-syntax-entry ?\\ "\\" perl-mode-syntax-table)
+  (modify-syntax-entry ?` "\"" perl-mode-syntax-table)
+  (modify-syntax-entry ?| "." perl-mode-syntax-table)
+)
+
+(defconst perl-indent-level 4
+  "*Indentation of Perl statements with respect to containing block.")
+(defconst perl-continued-statement-offset 4
+  "*Extra indent for lines not starting new statements.")
+(defconst perl-continued-brace-offset -4
+  "*Extra indent for substatements that start with open-braces.
+This is in addition to perl-continued-statement-offset.")
+(defconst perl-brace-offset 0
+  "*Extra indentation for braces, compared with other text in same context.")
+(defconst perl-brace-imaginary-offset 0
+  "*Imagined indentation of an open brace that actually follows a statement.")
+(defconst perl-label-offset -2
+  "*Offset of Perl label lines relative to usual indentation.")
+
+(defconst perl-tab-always-indent t
+  "*Non-nil means TAB in Perl mode should always indent the current line,
+regardless of where in the line point is when the TAB command is used.")
+
+(defconst perl-tab-to-comment t
+  "*Non-nil means that for lines which don't need indenting, TAB will
+either indent an existing comment, move to end-of-line, or if at end-of-line
+already, create a new comment.")
+
+(defconst perl-nochange ";?#\\|\f\\|\\s(\\|\\(\\w\\|\\s_\\)+:"
+  "*Lines starting with this regular expression will not be auto-indented.")
+
+(defun perl-mode ()
+  "Major mode for editing Perl code.
+Expression and list commands understand all Perl brackets.
+Tab indents for Perl code.
+Comments are delimited with # ... \\n.
+Paragraphs are separated by blank lines only.
+Delete converts tabs to spaces as it moves back.
+\\{perl-mode-map}
+Variables controlling indentation style:
+ perl-tab-always-indent
+    Non-nil means TAB in Perl mode should always indent the current line,
+    regardless of where in the line point is when the TAB command is used.
+ perl-tab-to-comment
+    Non-nil means that for lines which don't need indenting, TAB will
+    either delete an empty comment, indent an existing comment, move 
+    to end-of-line, or if at end-of-line already, create a new comment.
+ perl-nochange
+    Lines starting with this regular expression will not be auto-indented.
+ perl-indent-level
+    Indentation of Perl statements within surrounding block.
+    The surrounding block's indentation is the indentation
+    of the line on which the open-brace appears.
+ perl-continued-statement-offset
+    Extra indentation given to a substatement, such as the
+    then-clause of an if or body of a while.
+ perl-continued-brace-offset
+    Extra indentation given to a brace that starts a substatement.
+    This is in addition to perl-continued-statement-offset.
+ perl-brace-offset
+    Extra indentation for line if it starts with an open brace.
+ perl-brace-imaginary-offset
+    An open brace following other text is treated as if it were
+    this far to the right of the start of its line.
+ perl-label-offset
+    Extra indentation for line that is a label.
+
+Various indentation styles:       K&R  BSD  BLK  GNU  LW
+  perl-indent-level                5    8    0    2    4
+  perl-continued-statement-offset  5    8    4    2    4
+  perl-continued-brace-offset      0    0    0    0   -4
+  perl-brace-offset               -5   -8    0    0    0
+  perl-brace-imaginary-offset      0    0    4    0    0
+  perl-label-offset               -5   -8   -2   -2   -2
+
+Turning on Perl mode calls the value of the variable perl-mode-hook with no 
+args, if that value is non-nil."
+  (interactive)
+  (kill-all-local-variables)
+  (use-local-map perl-mode-map)
+  (setq major-mode 'perl-mode)
+  (setq mode-name "Perl")
+  (setq local-abbrev-table perl-mode-abbrev-table)
+  (set-syntax-table perl-mode-syntax-table)
+  (make-local-variable 'paragraph-start)
+  (setq paragraph-start (concat "^$\\|" page-delimiter))
+  (make-local-variable 'paragraph-separate)
+  (setq paragraph-separate paragraph-start)
+  (make-local-variable 'paragraph-ignore-fill-prefix)
+  (setq paragraph-ignore-fill-prefix t)
+  (make-local-variable 'indent-line-function)
+  (setq indent-line-function 'perl-indent-line)
+  (make-local-variable 'require-final-newline)
+  (setq require-final-newline t)
+  (make-local-variable 'comment-start)
+  (setq comment-start "# ")
+  (make-local-variable 'comment-end)
+  (setq comment-end "")
+  (make-local-variable 'comment-column)
+  (setq comment-column 32)
+  (make-local-variable 'comment-start-skip)
+  (setq comment-start-skip "\\(^\\|\\s-\\);?#+ *")
+  (make-local-variable 'comment-indent-hook)
+  (setq comment-indent-hook 'perl-comment-indent)
+  (make-local-variable 'parse-sexp-ignore-comments)
+  (setq parse-sexp-ignore-comments nil)
+  (run-hooks 'perl-mode-hook))
+
+;; This is used by indent-for-comment
+;; to decide how much to indent a comment in Perl code
+;; based on its context.
+(defun perl-comment-indent ()
+  (if (and (bolp) (not (eolp)))
+      0					;Existing comment at bol stays there.
+    (save-excursion
+      (skip-chars-backward " \t")
+      (max (1+ (current-column))	;Else indent at comment column
+	   comment-column))))		; except leave at least one space.
+
+(defun electric-perl-terminator (arg)
+  "Insert character.  If at end-of-line, and not in a comment or a quote,
+correct the line's indentation."
+  (interactive "P")
+  (let ((insertpos (point)))
+    (and (not arg)			; decide whether to indent
+	 (eolp)
+	 (save-excursion
+	   (beginning-of-line)
+	   (and (not			; eliminate comments quickly
+		 (re-search-forward comment-start-skip insertpos t)) 
+		(or (/= last-command-char ?:)
+		    ;; Colon is special only after a label ....
+		    (looking-at "\\s-*\\(\\w\\|\\s_\\)+$"))
+		(let ((pps (parse-partial-sexp 
+			    (perl-beginning-of-function) insertpos)))
+		  (not (or (nth 3 pps) (nth 4 pps) (nth 5 pps))))))
+	 (progn				; must insert, indent, delete
+	   (insert-char last-command-char 1)
+	   (perl-indent-line)
+	   (delete-char -1))))
+  (self-insert-command (prefix-numeric-value arg)))
+
+;; not used anymore, but may be useful someday:
+;;(defun perl-inside-parens-p ()
+;;  (condition-case ()
+;;      (save-excursion
+;;	(save-restriction
+;;	  (narrow-to-region (point)
+;;			    (perl-beginning-of-function))
+;;	  (goto-char (point-max))
+;;	  (= (char-after (or (scan-lists (point) -1 1) (point-min))) ?\()))
+;;    (error nil)))
+
+(defun perl-indent-command (&optional arg)
+  "Indent current line as Perl code, or optionally, insert a tab character.
+
+With an argument, indent the current line, regardless of other options.
+
+If perl-tab-always-indent is nil and point is not in the indentation
+area at the beginning of the line, simply insert a tab.
+
+Otherwise, indent the current line.  If point was within the indentation
+area it is moved to the end of the indentation area.  If the line was
+already indented properly and point was not within the indentation area,
+and if perl-tab-to-comment is non-nil (the default), then do the first
+possible action from the following list:
+
+  1) delete an empty comment
+  2) move forward to start of comment, indenting if necessary
+  3) move forward to end of line
+  4) create an empty comment
+  5) move backward to start of comment, indenting if necessary."
+  (interactive "P")
+  (if arg				; If arg, just indent this line
+      (perl-indent-line "\f")
+    (if (and (not perl-tab-always-indent)
+	     (<= (current-column) (current-indentation)))
+	(insert-tab)
+      (let (bof lsexp delta (oldpnt (point)))
+	(beginning-of-line) 
+	(setq lsexp (point))
+	(setq bof (perl-beginning-of-function))
+	(goto-char oldpnt)
+	(setq delta (perl-indent-line "\f\\|;?#" bof))
+	(and perl-tab-to-comment
+	     (= oldpnt (point))		; done if point moved
+	     (if (listp delta)		; if line starts in a quoted string
+		 (setq lsexp (or (nth 2 delta) bof))
+	       (= delta 0))		; done if indenting occurred
+	     (let (eol state)
+	       (end-of-line) 
+	       (setq eol (point))
+	       (if (= (char-after bof) ?=)
+		   (if (= oldpnt eol)
+		       (message "In a format statement"))     
+		 (setq state (parse-partial-sexp lsexp eol))
+		 (if (nth 3 state)
+		     (if (= oldpnt eol)	; already at eol in a string
+			 (message "In a string which starts with a %c."
+				  (nth 3 state)))
+		   (if (not (nth 4 state))
+		       (if (= oldpnt eol) ; no comment, create one?
+			   (indent-for-comment))
+		     (beginning-of-line)
+		     (if (re-search-forward comment-start-skip eol 'move)
+			 (if (eolp)
+			     (progn	; kill existing comment
+			       (goto-char (match-beginning 0))
+			       (skip-chars-backward " \t")
+			       (kill-region (point) eol))
+			   (if (or (< oldpnt (point)) (= oldpnt eol))
+			       (indent-for-comment) ; indent existing comment
+			     (end-of-line)))
+		       (if (/= oldpnt eol)
+			   (end-of-line)
+			 (message "Use backslash to quote # characters.")
+			 (ding t))))))))))))
+
+(defun perl-indent-line (&optional nochange parse-start)
+  "Indent current line as Perl code.  Return the amount the indentation 
+changed by, or (parse-state) if line starts in a quoted string."
+  (let ((case-fold-search nil)
+	(pos (- (point-max) (point)))
+	(bof (or parse-start (save-excursion (perl-beginning-of-function))))
+	beg indent shift-amt)
+    (beginning-of-line)
+    (setq beg (point))
+    (setq shift-amt
+	  (cond ((= (char-after bof) ?=) 0)
+		((listp (setq indent (calculate-perl-indent bof))) indent)
+		((looking-at (or nochange perl-nochange)) 0)
+		(t
+		 (skip-chars-forward " \t\f")
+		 (cond ((looking-at "\\(\\w\\|\\s_\\)+:")
+			(setq indent (max 1 (+ indent perl-label-offset))))
+		       ((= (following-char) ?})
+			(setq indent (- indent perl-indent-level)))
+		       ((= (following-char) ?{)
+			(setq indent (+ indent perl-brace-offset))))
+		 (- indent (current-column)))))
+    (skip-chars-forward " \t\f")
+    (if (and (numberp shift-amt) (/= 0 shift-amt))
+	(progn (delete-region beg (point))
+	       (indent-to indent)))
+    ;; If initial point was within line's indentation,
+    ;; position after the indentation.  Else stay at same point in text.
+    (if (> (- (point-max) pos) (point))
+	(goto-char (- (point-max) pos)))
+    shift-amt))
+
+(defun calculate-perl-indent (&optional parse-start)
+  "Return appropriate indentation for current line as Perl code.
+In usual case returns an integer: the column to indent to.
+Returns (parse-state) if line starts inside a string."
+  (save-excursion
+    (beginning-of-line)
+    (let ((indent-point (point))
+	  (case-fold-search nil)
+	  (colon-line-end 0)
+	  state containing-sexp)
+      (if parse-start			;used to avoid searching
+	  (goto-char parse-start)
+	(perl-beginning-of-function))
+      (while (< (point) indent-point)	;repeat until right sexp
+	(setq parse-start (point))
+	(setq state (parse-partial-sexp (point) indent-point 0))
+; state = (depth_in_parens innermost_containing_list last_complete_sexp
+;          string_terminator_or_nil inside_commentp following_quotep
+;          minimum_paren-depth_this_scan)
+; Parsing stops if depth in parentheses becomes equal to third arg.
+	(setq containing-sexp (nth 1 state)))
+      (cond ((nth 3 state) state)	; In a quoted string?
+	    ((null containing-sexp)	; Line is at top level.
+	     (skip-chars-forward " \t\f")
+	     (if (= (following-char) ?{)
+		 0   ; move to beginning of line if it starts a function body
+	       ;; indent a little if this is a continuation line
+	       (perl-backward-to-noncomment)
+	       (if (or (bobp)
+		       (memq (preceding-char) '(?\; ?\})))
+		   0 perl-continued-statement-offset)))
+	    ((/= (char-after containing-sexp) ?{)
+	     ;; line is expression, not statement:
+	     ;; indent to just after the surrounding open.
+	     (goto-char (1+ containing-sexp))
+	     (current-column))
+	    (t
+	     ;; Statement level.  Is it a continuation or a new statement?
+	     ;; Find previous non-comment character.
+	     (perl-backward-to-noncomment)
+	     ;; Back up over label lines, since they don't
+	     ;; affect whether our line is a continuation.
+	     (while (or (eq (preceding-char) ?\,)
+			(and (eq (preceding-char) ?:)
+			     (memq (char-syntax (char-after (- (point) 2)))
+				   '(?w ?_))))
+	       (if (eq (preceding-char) ?\,)
+		   (perl-backward-to-start-of-continued-exp containing-sexp))
+	       (beginning-of-line)
+	       (perl-backward-to-noncomment))
+	     ;; Now we get the answer.
+	     (if (not (memq (preceding-char) '(?\; ?\} ?\{)))
+		 ;; This line is continuation of preceding line's statement;
+		 ;; indent  perl-continued-statement-offset  more than the
+		 ;; previous line of the statement.
+		 (progn
+		   (perl-backward-to-start-of-continued-exp containing-sexp)
+		   (+ perl-continued-statement-offset (current-column)
+		      (if (save-excursion (goto-char indent-point)
+					  (looking-at "[ \t]*{"))
+			  perl-continued-brace-offset 0)))
+	       ;; This line starts a new statement.
+	       ;; Position at last unclosed open.
+	       (goto-char containing-sexp)
+	       (or
+		 ;; If open paren is in col 0, close brace is special
+		 (and (bolp)
+		      (save-excursion (goto-char indent-point)
+				      (looking-at "[ \t]*}"))
+		      perl-indent-level)
+		 ;; Is line first statement after an open-brace?
+		 ;; If no, find that first statement and indent like it.
+		 (save-excursion
+		   (forward-char 1)
+		   ;; Skip over comments and labels following openbrace.
+		   (while (progn
+			    (skip-chars-forward " \t\f\n")
+			    (cond ((looking-at ";?#")
+				   (forward-line 1) t)
+				  ((looking-at "\\(\\w\\|\\s_\\)+:")
+				   (save-excursion 
+				     (end-of-line) 
+				     (setq colon-line-end (point)))
+				   (search-forward ":")))))
+		   ;; The first following code counts
+		   ;; if it is before the line we want to indent.
+		   (and (< (point) indent-point)
+			(if (> colon-line-end (point))
+			    (- (current-indentation) perl-label-offset)
+			  (current-column))))
+		 ;; If no previous statement,
+		 ;; indent it relative to line brace is on.
+		 ;; For open paren in column zero, don't let statement
+		 ;; start there too.  If perl-indent-level is zero,
+		 ;; use perl-brace-offset + perl-continued-statement-offset
+		 ;; For open-braces not the first thing in a line,
+		 ;; add in perl-brace-imaginary-offset.
+		 (+ (if (and (bolp) (zerop perl-indent-level))
+			(+ perl-brace-offset perl-continued-statement-offset)
+		      perl-indent-level)
+		    ;; Move back over whitespace before the openbrace.
+		    ;; If openbrace is not first nonwhite thing on the line,
+		    ;; add the perl-brace-imaginary-offset.
+		    (progn (skip-chars-backward " \t")
+			   (if (bolp) 0 perl-brace-imaginary-offset))
+		    ;; If the openbrace is preceded by a parenthesized exp,
+		    ;; move to the beginning of that;
+		    ;; possibly a different line
+		    (progn
+		      (if (eq (preceding-char) ?\))
+			  (forward-sexp -1))
+		      ;; Get initial indentation of the line we are on.
+		      (current-indentation))))))))))
+
+(defun perl-backward-to-noncomment ()
+  "Move point backward to after the first non-white-space, skipping comments."
+  (interactive)
+  (let (opoint stop)
+    (while (not stop)
+      (setq opoint (point))
+      (beginning-of-line)
+      (if (re-search-forward comment-start-skip opoint 'move 1)
+	  (progn (goto-char (match-end 1))
+		 (skip-chars-forward ";")))
+      (skip-chars-backward " \t\f")
+      (setq stop (or (bobp)
+		     (not (bolp))
+		     (forward-char -1))))))
+
+(defun perl-backward-to-start-of-continued-exp (lim)
+  (if (= (preceding-char) ?\))
+      (forward-sexp -1))
+  (beginning-of-line)
+  (if (<= (point) lim)
+      (goto-char (1+ lim)))
+  (skip-chars-forward " \t\f"))
+
+;; note: this may be slower than the c-mode version, but I can understand it.
+(defun indent-perl-exp ()
+  "Indent each line of the Perl grouping following point."
+  (interactive)
+  (let* ((case-fold-search nil)
+	 (oldpnt (point-marker))
+	 (bof-mark (save-excursion
+		     (end-of-line 2)
+		     (perl-beginning-of-function)
+		     (point-marker)))
+	 eol last-mark lsexp-mark delta)
+    (if (= (char-after (marker-position bof-mark)) ?=)
+	(message "Can't indent a format statement")
+      (message "Indenting Perl expression...")
+      (save-excursion (end-of-line) (setq eol (point)))
+      (save-excursion			; locate matching close paren
+	(while (and (not (eobp)) (<= (point) eol))
+	  (parse-partial-sexp (point) (point-max) 0))
+	(setq last-mark (point-marker)))
+      (setq lsexp-mark bof-mark)
+      (beginning-of-line)
+      (while (< (point) (marker-position last-mark))
+	(setq delta (perl-indent-line nil (marker-position bof-mark)))
+	(if (numberp delta)		; unquoted start-of-line?
+	    (progn 
+	      (if (eolp)
+		  (delete-horizontal-space))
+	      (setq lsexp-mark (point-marker))))
+	(end-of-line)
+	(setq eol (point))
+	(if (nth 4 (parse-partial-sexp (marker-position lsexp-mark) eol))
+	    (progn			; line ends in a comment
+	      (beginning-of-line)
+	      (if (or (not (looking-at "\\s-*;?#"))
+		      (listp delta)
+		      (and (/= 0 delta)
+			   (= (- (current-indentation) delta) comment-column)))
+		  (if (re-search-forward comment-start-skip eol t)
+		      (indent-for-comment))))) ; indent existing comment
+	(forward-line 1))
+      (goto-char (marker-position oldpnt))
+      (message "Indenting Perl expression...done"))))
+
+(defun perl-beginning-of-function (&optional arg)
+  "Move backward to next beginning-of-function, or as far as possible.
+With argument, repeat that many times; negative args move forward.
+Returns new value of point in all cases."
+  (interactive "p")
+  (or arg (setq arg 1))
+  (if (< arg 0) (forward-char 1))
+  (and (/= arg 0)
+       (re-search-backward "^\\s(\\|^\\s-*sub\\b[^{]+{\\|^\\s-*format\\b[^=]*="
+			   nil 'move arg)
+       (goto-char (1- (match-end 0))))
+  (point))
+
+;; note: this routine is adapted directly from emacs lisp.el, end-of-defun;
+;; no bugs have been removed :-)
+(defun perl-end-of-function (&optional arg)
+  "Move forward to next end-of-function.
+The end of a function is found by moving forward from the beginning of one.
+With argument, repeat that many times; negative args move backward."
+  (interactive "p")
+  (or arg (setq arg 1))
+  (let ((first t))
+    (while (and (> arg 0) (< (point) (point-max)))
+      (let ((pos (point)) npos)
+	(while (progn
+		(if (and first
+			 (progn
+			  (forward-char 1)
+			  (perl-beginning-of-function 1)
+			  (not (bobp))))
+		    nil
+		  (or (bobp) (forward-char -1))
+		  (perl-beginning-of-function -1))
+		(setq first nil)
+		(forward-list 1)
+		(skip-chars-forward " \t")
+		(if (looking-at "[#\n]")
+		    (forward-line 1))
+		(<= (point) pos))))
+      (setq arg (1- arg)))
+    (while (< arg 0)
+      (let ((pos (point)))
+	(perl-beginning-of-function 1)
+	(forward-sexp 1)
+	(forward-line 1)
+	(if (>= (point) pos)
+	    (if (progn (perl-beginning-of-function 2) (not (bobp)))
+		(progn
+		  (forward-list 1)
+		  (skip-chars-forward " \t")
+		  (if (looking-at "[#\n]")
+		      (forward-line 1)))
+	      (goto-char (point-min)))))
+      (setq arg (1+ arg)))))
+
+(defun mark-perl-function ()
+  "Put mark at end of Perl function, point at beginning."
+  (interactive)
+  (push-mark (point))
+  (perl-end-of-function)
+  (push-mark (point))
+  (perl-beginning-of-function)
+  (backward-paragraph))
+
+;;;;;;;; That's all, folks! ;;;;;;;;;
diff --git a/emacs/perldb.el b/emacs/perldb.el
new file mode 100644
index 0000000000..66951be26d
--- /dev/null
+++ b/emacs/perldb.el
@@ -0,0 +1,423 @@
+;; Run perl -d under Emacs
+;; Based on gdb.el, as written by W. Schelter, and modified by rms.
+;; Modified for Perl by Ray Lischner (uunet!mntgfx!lisch), Nov 1990.
+
+;; This file is part of GNU Emacs.
+;; Copyright (C) 1988,1990 Free Software Foundation, Inc.
+
+;; GNU Emacs is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY.  No author or distributor accepts responsibility
+;; to anyone for the consequences of using it or for whether it serves
+;; any particular purpose or works at all, unless he says so in writing.
+;; Refer to the GNU Emacs General Public License for full details.
+
+;; Everyone is granted permission to copy, modify and redistribute GNU
+;; Emacs, but only under the conditions described in the GNU Emacs
+;; General Public License.  A copy of this license is supposed to have
+;; been given to you along with GNU Emacs so you can know your rights and
+;; responsibilities.  It should be in a file named COPYING.  Among other
+;; things, the copyright notice and this notice must be preserved on all
+;; copies.
+
+;; Description of perl -d interface:
+
+;; A facility is provided for the simultaneous display of the source code
+;; in one window, while using perldb to step through a function in the
+;; other.  A small arrow in the source window, indicates the current
+;; line.
+
+;; Starting up:
+
+;; In order to use this facility, invoke the command PERLDB to obtain a
+;; shell window with the appropriate command bindings.  You will be asked
+;; for the name of a file to run and additional command line arguments.
+;; Perldb will be invoked on this file, in a window named *perldb-foo*
+;; if the file is foo.
+
+;; M-s steps by one line, and redisplays the source file and line.
+
+;; You may easily create additional commands and bindings to interact
+;; with the display.  For example to put the perl debugger command n on \M-n
+;; (def-perldb n "\M-n")
+
+;; This causes the emacs command perldb-next to be defined, and runs
+;; perldb-display-frame after the command.
+
+;; perldb-display-frame is the basic display function.  It tries to display
+;; in the other window, the file and line corresponding to the current
+;; position in the perldb window.  For example after a perldb-step, it would
+;; display the line corresponding to the position for the last step.  Or
+;; if you have done a backtrace in the perldb buffer, and move the cursor
+;; into one of the frames, it would display the position corresponding to
+;; that frame.
+
+;; perldb-display-frame is invoked automatically when a filename-and-line-number
+;; appears in the output.
+
+
+(require 'shell)
+
+(defvar perldb-prompt-pattern "^  DB<[0-9]+> "
+  "A regexp to recognize the prompt for perldb.") 
+
+(defvar perldb-mode-map nil
+  "Keymap for perldb-mode.")
+
+(if perldb-mode-map
+   nil
+  (setq perldb-mode-map (copy-keymap shell-mode-map))
+  (define-key perldb-mode-map "\C-l" 'perldb-refresh))
+
+(define-key ctl-x-map " " 'perldb-break)
+(define-key ctl-x-map "&" 'send-perldb-command)
+
+;;Of course you may use `def-perldb' with any other perldb command, including
+;;user defined ones.   
+
+(defmacro def-perldb (name key &optional doc)
+  (let* ((fun (intern (concat "perldb-" name))))
+    (` (progn
+	 (defun (, fun) (arg)
+	   (, (or doc ""))
+	   (interactive "p")
+	   (perldb-call (if (not (= 1 arg))
+			    (concat (, name) arg)
+			  (, name))))
+	 (define-key perldb-mode-map (, key) (quote (, fun)))))))
+
+(def-perldb "s"   "\M-s" "Step one source line with display")
+(def-perldb "n"   "\M-n" "Step one source line (skip functions)")
+(def-perldb "c"   "\M-c" "Continue with display")
+(def-perldb "r"   "\C-c\C-r" "Return from current subroutine")
+(def-perldb "A"   "\C-c\C-a" "Delete all actions")
+
+(defun perldb-mode ()
+  "Major mode for interacting with an inferior Perl debugger process.
+The following commands are available:
+
+\\{perldb-mode-map}
+
+\\[perldb-display-frame] displays in the other window
+the last line referred to in the perldb buffer.
+
+\\[perldb-s],\\[perldb-n], and \\[perldb-n] in the perldb window,
+call perldb to step, next or continue and then update the other window
+with the current file and position.
+
+If you are in a source file, you may select a point to break
+at, by doing \\[perldb-break].
+
+Commands:
+Many commands are inherited from shell mode. 
+Additionally we have:
+
+\\[perldb-display-frame] display frames file in other window
+\\[perldb-s] advance one line in program
+\\[perldb-n] advance one line in program (skip over calls).
+\\[send-perldb-command] used for special printing of an arg at the current point.
+C-x SPACE sets break point at current line."
+  (interactive)
+  (kill-all-local-variables)
+  (setq major-mode 'perldb-mode)
+  (setq mode-name "Inferior Perl")
+  (setq mode-line-process '(": %s"))
+  (use-local-map perldb-mode-map)
+  (make-local-variable 'last-input-start)
+  (setq last-input-start (make-marker))
+  (make-local-variable 'last-input-end)
+  (setq last-input-end (make-marker))
+  (make-local-variable 'perldb-last-frame)
+  (setq perldb-last-frame nil)
+  (make-local-variable 'perldb-last-frame-displayed-p)
+  (setq perldb-last-frame-displayed-p t)
+  (make-local-variable 'perldb-delete-prompt-marker)
+  (setq perldb-delete-prompt-marker nil)
+  (make-local-variable 'perldb-filter-accumulator)
+  (setq perldb-filter-accumulator nil)
+  (make-local-variable 'shell-prompt-pattern)
+  (setq shell-prompt-pattern perldb-prompt-pattern)
+  (run-hooks 'shell-mode-hook 'perldb-mode-hook))
+
+(defvar current-perldb-buffer nil)
+
+(defvar perldb-command-name "perl"
+  "Pathname for executing perl -d.")
+
+(defun end-of-quoted-arg (argstr start end)
+  (let* ((chr (substring argstr start (1+ start)))
+	 (idx (string-match (concat "[^\\]" chr) argstr (1+ start))))
+    (and idx (1+ idx))
+    )
+)
+
+(defun parse-args-helper (arglist argstr start end)
+  (while (and (< start end) (string-match "[ \t\n\f\r\b]"
+					  (substring argstr start (1+ start))))
+    (setq start (1+ start)))
+  (cond
+    ((= start end) arglist)
+    ((string-match "[\"']" (substring argstr start (1+ start)))
+     (let ((next (end-of-quoted-arg argstr start end)))
+       (parse-args-helper (cons (substring argstr (1+ start) next) arglist)
+			  argstr (1+ next) end)))
+    (t (let ((next (string-match "[ \t\n\f\b\r]" argstr start)))
+	 (if next
+	     (parse-args-helper (cons (substring argstr start next) arglist)
+				argstr (1+ next) end)
+	   (cons (substring argstr start) arglist))))
+    )
+  )
+    
+(defun parse-args (args)
+  "Extract arguments from a string ARGS.
+White space separates arguments, with single or double quotes
+used to protect spaces.  A list of strings is returned, e.g.,
+(parse-args \"foo bar 'two args'\") => (\"foo\" \"bar\" \"two args\")."
+  (nreverse (parse-args-helper '() args 0 (length args)))
+)
+
+(defun perldb (path args)
+  "Run perldb on program FILE in buffer *perldb-FILE*.
+The default directory for the current buffer becomes the initial
+working directory, by analogy with  gdb .  If you wish to change this, use
+the Perl command `chdir(DIR)'."
+  (interactive "FRun perl -d on file: \nsCommand line arguments: ")
+  (setq path (expand-file-name path))
+  (let ((file (file-name-nondirectory path))
+	(dir default-directory))
+    (switch-to-buffer (concat "*perldb-" file "*"))
+    (setq default-directory dir)
+    (or (bolp) (newline))
+    (insert "Current directory is " default-directory "\n")
+    (apply 'make-shell
+	   (concat "perldb-" file) perldb-command-name nil "-d" path "-emacs"
+	   (parse-args args))
+    (perldb-mode)
+    (set-process-filter (get-buffer-process (current-buffer)) 'perldb-filter)
+    (set-process-sentinel (get-buffer-process (current-buffer)) 'perldb-sentinel)
+    (perldb-set-buffer)))
+
+(defun perldb-set-buffer ()
+  (cond ((eq major-mode 'perldb-mode)
+	(setq current-perldb-buffer (current-buffer)))))
+
+;; This function is responsible for inserting output from Perl
+;; into the buffer.
+;; Aside from inserting the text, it notices and deletes
+;; each filename-and-line-number;
+;; that Perl prints to identify the selected frame.
+;; It records the filename and line number, and maybe displays that file.
+(defun perldb-filter (proc string)
+  (let ((inhibit-quit t))
+    (if perldb-filter-accumulator
+	(perldb-filter-accumulate-marker proc
+				      (concat perldb-filter-accumulator string))
+	(perldb-filter-scan-input proc string))))
+
+(defun perldb-filter-accumulate-marker (proc string)
+  (setq perldb-filter-accumulator nil)
+  (if (> (length string) 1)
+      (if (= (aref string 1) ?\032)
+	  (let ((end (string-match "\n" string)))
+	    (if end
+		(progn
+		  (let* ((first-colon (string-match ":" string 2))
+			 (second-colon
+			  (string-match ":" string (1+ first-colon))))
+		    (setq perldb-last-frame
+			  (cons (substring string 2 first-colon)
+				(string-to-int
+				 (substring string (1+ first-colon)
+					    second-colon)))))
+		  (setq perldb-last-frame-displayed-p nil)
+		  (perldb-filter-scan-input proc
+					 (substring string (1+ end))))
+	      (setq perldb-filter-accumulator string)))
+	(perldb-filter-insert proc "\032")
+	(perldb-filter-scan-input proc (substring string 1)))
+    (setq perldb-filter-accumulator string)))
+
+(defun perldb-filter-scan-input (proc string)
+  (if (equal string "")
+      (setq perldb-filter-accumulator nil)
+      (let ((start (string-match "\032" string)))
+	(if start
+	    (progn (perldb-filter-insert proc (substring string 0 start))
+		   (perldb-filter-accumulate-marker proc
+						 (substring string start)))
+	    (perldb-filter-insert proc string)))))
+
+(defun perldb-filter-insert (proc string)
+  (let ((moving (= (point) (process-mark proc)))
+	(output-after-point (< (point) (process-mark proc)))
+	(old-buffer (current-buffer))
+	start)
+    (set-buffer (process-buffer proc))
+    (unwind-protect
+	(save-excursion
+	  ;; Insert the text, moving the process-marker.
+	  (goto-char (process-mark proc))
+	  (setq start (point))
+	  (insert string)
+	  (set-marker (process-mark proc) (point))
+	  (perldb-maybe-delete-prompt)
+	  ;; Check for a filename-and-line number.
+	  (perldb-display-frame
+	   ;; Don't display the specified file
+	   ;; unless (1) point is at or after the position where output appears
+	   ;; and (2) this buffer is on the screen.
+	   (or output-after-point
+	       (not (get-buffer-window (current-buffer))))
+	   ;; Display a file only when a new filename-and-line-number appears.
+	   t))
+      (set-buffer old-buffer))
+    (if moving (goto-char (process-mark proc)))))
+
+(defun perldb-sentinel (proc msg)
+  (cond ((null (buffer-name (process-buffer proc)))
+	 ;; buffer killed
+	 ;; Stop displaying an arrow in a source file.
+	 (setq overlay-arrow-position nil)
+	 (set-process-buffer proc nil))
+	((memq (process-status proc) '(signal exit))
+	 ;; Stop displaying an arrow in a source file.
+	 (setq overlay-arrow-position nil)
+	 ;; Fix the mode line.
+	 (setq mode-line-process
+	       (concat ": "
+		       (symbol-name (process-status proc))))
+	 (let* ((obuf (current-buffer)))
+	   ;; save-excursion isn't the right thing if
+	   ;;  process-buffer is current-buffer
+	   (unwind-protect
+	       (progn
+		 ;; Write something in *compilation* and hack its mode line,
+		 (set-buffer (process-buffer proc))
+		 ;; Force mode line redisplay soon
+		 (set-buffer-modified-p (buffer-modified-p))
+		 (if (eobp)
+		     (insert ?\n mode-name " " msg)
+		   (save-excursion
+		     (goto-char (point-max))
+		     (insert ?\n mode-name " " msg)))
+		 ;; If buffer and mode line will show that the process
+		 ;; is dead, we can delete it now.  Otherwise it
+		 ;; will stay around until M-x list-processes.
+		 (delete-process proc))
+	     ;; Restore old buffer, but don't restore old point
+	     ;; if obuf is the perldb buffer.
+	     (set-buffer obuf))))))
+
+
+(defun perldb-refresh ()
+  "Fix up a possibly garbled display, and redraw the arrow."
+  (interactive)
+  (redraw-display)
+  (perldb-display-frame))
+
+(defun perldb-display-frame (&optional nodisplay noauto)
+  "Find, obey and delete the last filename-and-line marker from PERLDB.
+The marker looks like \\032\\032FILENAME:LINE:CHARPOS\\n.
+Obeying it means displaying in another window the specified file and line."
+  (interactive)
+  (perldb-set-buffer)
+  (and perldb-last-frame (not nodisplay)
+       (or (not perldb-last-frame-displayed-p) (not noauto))
+       (progn (perldb-display-line (car perldb-last-frame) (cdr perldb-last-frame))
+	      (setq perldb-last-frame-displayed-p t))))
+
+;; Make sure the file named TRUE-FILE is in a buffer that appears on the screen
+;; and that its line LINE is visible.
+;; Put the overlay-arrow on the line LINE in that buffer.
+
+(defun perldb-display-line (true-file line)
+  (let* ((buffer (find-file-noselect true-file))
+	 (window (display-buffer buffer t))
+	 (pos))
+    (save-excursion
+      (set-buffer buffer)
+      (save-restriction
+	(widen)
+	(goto-line line)
+	(setq pos (point))
+	(setq overlay-arrow-string "=>")
+	(or overlay-arrow-position
+	    (setq overlay-arrow-position (make-marker)))
+	(set-marker overlay-arrow-position (point) (current-buffer)))
+      (cond ((or (< pos (point-min)) (> pos (point-max)))
+	     (widen)
+	     (goto-char pos))))
+    (set-window-point window overlay-arrow-position)))
+
+(defun perldb-call (command)
+  "Invoke perldb COMMAND displaying source in other window."
+  (interactive)
+  (goto-char (point-max))
+  (setq perldb-delete-prompt-marker (point-marker))
+  (perldb-set-buffer)
+  (send-string (get-buffer-process current-perldb-buffer)
+	       (concat command "\n")))
+
+(defun perldb-maybe-delete-prompt ()
+  (if (and perldb-delete-prompt-marker
+	   (> (point-max) (marker-position perldb-delete-prompt-marker)))
+      (let (start)
+	(goto-char perldb-delete-prompt-marker)
+	(setq start (point))
+	(beginning-of-line)
+	(delete-region (point) start)
+	(setq perldb-delete-prompt-marker nil))))
+
+(defun perldb-break ()
+  "Set PERLDB breakpoint at this source line."
+  (interactive)
+  (let ((line (save-restriction
+		(widen)
+		(1+ (count-lines 1 (point))))))
+    (send-string (get-buffer-process current-perldb-buffer)
+		 (concat "b " line "\n"))))
+
+(defun perldb-read-token()
+  "Return a string containing the token found in the buffer at point.
+A token can be a number or an identifier.  If the token is a name prefaced
+by `$', `@', or `%', the leading character is included in the token."
+  (save-excursion
+    (let (begin)
+      (or (looking-at "[$@%]")
+	  (re-search-backward "[^a-zA-Z_0-9]" (point-min) 'move))
+      (setq begin (point))
+      (or (looking-at "[$@%]") (setq begin (+ begin 1)))
+      (forward-char 1)
+      (buffer-substring begin
+			(if (re-search-forward "[^a-zA-Z_0-9]"
+					       (point-max) 'move)
+			       (- (point) 1)
+			  (point)))
+)))
+
+(defvar perldb-commands nil
+  "List of strings or functions used by send-perldb-command.
+It is for customization by the user.")
+
+(defun send-perldb-command (arg)
+  "Issue a Perl debugger command selected by the prefix arg.  A numeric
+arg selects the ARG'th member COMMAND of the list perldb-commands.
+The token under the cursor is passed to the command.  If COMMAND is a
+string, (format COMMAND TOKEN) is inserted at the end of the perldb
+buffer, otherwise (funcall COMMAND TOKEN) is inserted.  If there is
+no such COMMAND, then the token itself is inserted.  For example,
+\"p %s\" is a possible string to be a member of perldb-commands,
+or \"p $ENV{%s}\"."
+  (interactive "P")
+  (let (comm token)
+    (if arg (setq comm (nth arg perldb-commands)))
+    (setq token (perldb-read-token))
+    (if (eq (current-buffer) current-perldb-buffer)
+	(set-mark (point)))
+    (cond (comm
+	   (setq comm
+		 (if (stringp comm) (format comm token) (funcall comm token))))
+	  (t (setq comm token)))
+    (switch-to-buffer-other-window current-perldb-buffer)
+    (goto-char (dot-max))
+    (insert-string comm)))
diff --git a/emacs/perldb.pl b/emacs/perldb.pl
new file mode 100644
index 0000000000..9d07da32c6
--- /dev/null
+++ b/emacs/perldb.pl
@@ -0,0 +1,565 @@
+package DB;
+
+# modified Perl debugger, to be run from Emacs in perldb-mode
+# Ray Lischner (uunet!mntgfx!lisch) as of 5 Nov 1990
+
+$header = '$Header: perldb.pl,v 4.0 91/03/20 01:18:58 lwall Locked $';
+#
+# This file is automatically included if you do perl -d.
+# It's probably not useful to include this yourself.
+#
+# Perl supplies the values for @line and %sub.  It effectively inserts
+# a do DB'DB(<linenum>); in front of every place that can
+# have a breakpoint.  It also inserts a do 'perldb.pl' before the first line.
+#
+# $Log:	perldb.pl,v $
+# Revision 4.0  91/03/20  01:18:58  lwall
+# 4.0 baseline.
+# 
+# Revision 3.0.1.6  91/01/11  18:08:58  lwall
+# patch42: @_ couldn't be accessed from debugger
+# 
+# Revision 3.0.1.5  90/11/10  01:40:26  lwall
+# patch38: the debugger wouldn't stop correctly or do action routines
+# 
+# Revision 3.0.1.4  90/10/15  17:40:38  lwall
+# patch29: added caller
+# patch29: the debugger now understands packages and evals
+# patch29: scripts now run at almost full speed under the debugger
+# patch29: more variables are settable from debugger
+# 
+# Revision 3.0.1.3  90/08/09  04:00:58  lwall
+# patch19: debugger now allows continuation lines
+# patch19: debugger can now dump lists of variables
+# patch19: debugger can now add aliases easily from prompt
+# 
+# Revision 3.0.1.2  90/03/12  16:39:39  lwall
+# patch13: perl -d didn't format stack traces of *foo right
+# patch13: perl -d wiped out scalar return values of subroutines
+# 
+# Revision 3.0.1.1  89/10/26  23:14:02  lwall
+# patch1: RCS expanded an unintended $Header in lib/perldb.pl
+# 
+# Revision 3.0  89/10/18  15:19:46  lwall
+# 3.0 baseline
+# 
+# Revision 2.0  88/06/05  00:09:45  root
+# Baseline version 2.0.
+# 
+#
+
+open(IN, "</dev/tty") || open(IN,  "<&STDIN");	# so we don't dingle stdin
+open(OUT,">/dev/tty") || open(OUT, ">&STDOUT");	# so we don't dongle stdout
+select(OUT);
+$| = 1;				# for DB'OUT
+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";
+
+sub DB {
+    &save;
+    ($package, $filename, $line) = caller;
+    $usercontext = '($@, $!, $[, $,, $/, $\) = @saved;' .
+	"package $package;";		# this won't let them modify, alas
+    local(*dbline) = "_<$filename";
+    $max = $#dbline;
+    if (($stop,$action) = split(/\0/,$dbline{$line})) {
+	if ($stop eq '1') {
+	    $signal |= 1;
+	}
+	else {
+	    $evalarg = "\$DB'signal |= do {$stop;}"; &eval;
+	    $dbline{$line} =~ s/;9($|\0)/$1/;
+	}
+    }
+    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;
+    if ($single || $signal) {
+	$evalarg = $pre, &eval if $pre;
+	print OUT $#stack . " levels deep in subroutine calls!\n"
+	    if $single & 4;
+	$start = $line;
+	while ((print OUT "  DB<", $#hist+1, "> "), $cmd=&gets) {
+	    $single = 0;
+	    $signal = 0;
+	    $cmd eq '' && exit 0;
+	    chop($cmd);
+	    $cmd =~ s/\\$// && do {
+		print OUT "  cont: ";
+		$cmd .= &gets;
+		redo;
+	    };
+	    $cmd =~ /^q$/ && exit 0;
+	    $cmd =~ /^$/ && ($cmd = $laststep);
+	    push(@hist,$cmd) if length($cmd) > 1;
+	    ($i) = split(/\s+/,$cmd);
+	    eval "\$cmd =~ $alias{$i}", print OUT $@ if $alias{$i};
+	    $cmd =~ /^h$/ && do {
+		print OUT "
+T		Stack trace.
+s		Single step.
+n		Next, steps over subroutine calls.
+r		Return from current subroutine.
+c [line]	Continue; optionally inserts a one-time-only breakpoint 
+		at the specified line.
+<CR>		Repeat last n or s.
+l min+incr	List incr+1 lines starting at min.
+l min-max	List lines.
+l line		List line;
+l		List next window.
+-		List previous window.
+w line		List window around line.
+l subname	List subroutine.
+f filename	Switch to filename.
+/pattern/	Search forwards for pattern; final / is optional.
+?pattern?	Search backwards for pattern.
+L		List breakpoints and actions.
+S		List subroutine names.
+t		Toggle trace mode.
+b [line] [condition]
+		Set breakpoint; line defaults to the current execution line; 
+		condition breaks if it evaluates to true, defaults to \'1\'.
+b subname [condition]
+		Set breakpoint at first line of subroutine.
+d [line]	Delete breakpoint.
+D		Delete all breakpoints.
+a [line] command
+		Set an action to be done before the line is executed.
+		Sequence is: check for breakpoint, print line if necessary,
+		do action, prompt user if breakpoint or step, evaluate line.
+A		Delete all actions.
+V [pkg [vars]]	List some (default all) variables in package (default current).
+X [vars]	Same as \"V currentpackage [vars]\".
+< command	Define command before prompt.
+| command	Define command after prompt.
+! number	Redo command (default previous command).
+! -number	Redo number\'th to last command.
+H -number	Display last number commands (default all).
+q or ^D		Quit.
+p expr		Same as \"print DB'OUT expr\" in current package.
+= [alias value]	Define a command alias, or list current aliases.
+command		Execute as a perl statement in current package.
+
+";
+		next; };
+	    $cmd =~ /^t$/ && do {
+		$trace = !$trace;
+		print OUT "Trace = ".($trace?"on":"off")."\n";
+		next; };
+	    $cmd =~ /^S$/ && do {
+		foreach $subname (sort(keys %sub)) {
+		    print OUT $subname,"\n";
+		}
+		next; };
+	    $cmd =~ s/^X\b/V $package/;
+	    $cmd =~ /^V$/ && do {
+		$cmd = 'V $package'; };
+	    $cmd =~ /^V\s*(\S+)\s*(.*)/ && do {
+		$packname = $1;
+		@vars = split(' ',$2);
+		do 'dumpvar.pl' unless defined &main'dumpvar;
+		if (defined &main'dumpvar) {
+		    &main'dumpvar($packname,@vars);
+		}
+		else {
+		    print DB'OUT "dumpvar.pl not available.\n";
+		}
+		next; };
+	    $cmd =~ /^f\s*(.*)/ && do {
+		$file = $1;
+		if (!$file) {
+		    print OUT "The old f command is now the r command.\n";
+		    print OUT "The new f command switches filenames.\n";
+		    next;
+		}
+		if (!defined $_main{'_<' . $file}) {
+		    if (($try) = grep(m#^_<.*$file#, keys %_main)) {
+			$file = substr($try,2);
+			print "\n$file:\n";
+		    }
+		}
+		if (!defined $_main{'_<' . $file}) {
+		    print OUT "There's no code here anything matching $file.\n";
+		    next;
+		}
+		elsif ($file ne $filename) {
+		    *dbline = "_<$file";
+		    $max = $#dbline;
+		    $filename = $file;
+		    $start = 1;
+		    $cmd = "l";
+		} };
+	    $cmd =~ /^l\s*(['A-Za-z_]['\w]*)/ && do {
+		$subname = $1;
+		$subname = "main'" . $subname unless $subname =~ /'/;
+		$subname = "main" . $subname if substr($subname,0,1) eq "'";
+		($file,$subrange) = split(/:/,$sub{$subname});
+		if ($file ne $filename) {
+		    *dbline = "_<$file";
+		    $max = $#dbline;
+		    $filename = $file;
+		}
+		if ($subrange) {
+		    if (eval($subrange) < -$window) {
+			$subrange =~ s/-.*/+/;
+		    }
+		    $cmd = "l $subrange";
+		} else {
+		    print OUT "Subroutine $1 not found.\n";
+		    next;
+		} };
+	    $cmd =~ /^w\s*(\d*)$/ && do {
+		$incr = $window - 1;
+		$start = $1 if $1;
+		$start -= $preview;
+		$cmd = 'l ' . $start . '-' . ($start + $incr); };
+	    $cmd =~ /^-$/ && do {
+		$incr = $window - 1;
+		$cmd = 'l ' . ($start-$window*2) . '+'; };
+	    $cmd =~ /^l$/ && do {
+		$incr = $window - 1;
+		$cmd = 'l ' . $start . '-' . ($start + $incr); };
+	    $cmd =~ /^l\s*(\d*)\+(\d*)$/ && do {
+		$start = $1 if $1;
+		$incr = $2;
+		$incr = $window - 1 unless $incr;
+		$cmd = 'l ' . $start . '-' . ($start + $incr); };
+	    $cmd =~ /^l\s*(([\d\$\.]+)([-,]([\d\$\.]+))?)?/ && do {
+		$end = (!$2) ? $max : ($4 ? $4 : $2);
+		$end = $max if $end > $max;
+		$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;
+		next; };
+	    $cmd =~ /^D$/ && do {
+		print OUT "Deleting all breakpoints...\n";
+		for ($i = 1; $i <= $max ; $i++) {
+		    if (defined $dbline{$i}) {
+			$dbline{$i} =~ s/^[^\0]+//;
+			if ($dbline{$i} =~ s/^\0?$//) {
+			    delete $dbline{$i};
+			}
+		    }
+		}
+		next; };
+	    $cmd =~ /^L$/ && do {
+		for ($i = 1; $i <= $max; $i++) {
+		    if (defined $dbline{$i}) {
+			print OUT "$i:\t", $dbline[$i];
+			($stop,$action) = split(/\0/, $dbline{$i});
+			print OUT "  break if (", $stop, ")\n" 
+			    if $stop;
+			print OUT "  action:  ", $action, "\n" 
+			    if $action;
+			last if $signal;
+		    }
+		}
+		next; };
+	    $cmd =~ /^b\s*(['A-Za-z_]['\w]*)\s*(.*)/ && do {
+		$subname = $1;
+		$cond = $2 || '1';
+		$subname = "$package'" . $subname unless $subname =~ /'/;
+		$subname = "main" . $subname if substr($subname,0,1) eq "'";
+		($filename,$i) = split(/[:-]/, $sub{$subname});
+		if ($i) {
+		    *dbline = "_<$filename";
+		    ++$i while $dbline[$i] == 0 && $i < $#dbline;
+		    $dbline{$i} =~ s/^[^\0]*/$cond/;
+		} else {
+		    print OUT "Subroutine $subname not found.\n";
+		}
+		next; };
+	    $cmd =~ /^b\s*(\d*)\s*(.*)/ && do {
+		$i = ($1?$1:$line);
+		$cond = $2 || '1';
+		if ($dbline[$i] == 0) {
+		    print OUT "Line $i not breakable.\n";
+		} else {
+		    $dbline{$i} =~ s/^[^\0]*/$cond/;
+		}
+		next; };
+	    $cmd =~ /^d\s*(\d+)?/ && do {
+		$i = ($1?$1:$line);
+		$dbline{$i} =~ s/^[^\0]*//;
+		delete $dbline{$i} if $dbline{$i} eq '';
+		next; };
+	    $cmd =~ /^A$/ && do {
+		for ($i = 1; $i <= $max ; $i++) {
+		    if (defined $dbline{$i}) {
+			$dbline{$i} =~ s/\0[^\0]*//;
+			delete $dbline{$i} if $dbline{$i} eq '';
+		    }
+		}
+		next; };
+	    $cmd =~ /^<\s*(.*)/ && do {
+		$pre = do action($1);
+		next; };
+	    $cmd =~ /^>\s*(.*)/ && do {
+		$post = do action($1);
+		next; };
+	    $cmd =~ /^a\s*(\d+)(\s+(.*))?/ && do {
+		$i = $1;
+		if ($dbline[$i] == 0) {
+		    print OUT "Line $i may not have an action.\n";
+		} else {
+		    $dbline{$i} =~ s/\0[^\0]*//;
+		    $dbline{$i} .= "\0" . do action($3);
+		}
+		next; };
+	    $cmd =~ /^n$/ && do {
+		$single = 2;
+		$laststep = $cmd;
+		last; };
+	    $cmd =~ /^s$/ && do {
+		$single = 1;
+		$laststep = $cmd;
+		last; };
+	    $cmd =~ /^c\s*(\d*)\s*$/ && do {
+		$i = $1;
+		if ($i) {
+		    if ($dbline[$i] == 0) {
+		        print OUT "Line $i not breakable.\n";
+			next;
+		    }
+		    $dbline{$i} =~ s/(\0|$)/;9$1/;	# add one-time-only b.p.
+		}
+		for ($i=0; $i <= $#stack; ) {
+		    $stack[$i++] &= ~1;
+		}
+		last; };
+	    $cmd =~ /^r$/ && do {
+		$stack[$#stack] |= 2;
+		last; };
+	    $cmd =~ /^T$/ && do {
+		local($p,$f,$l,$s,$h,$a,@a,@sub);
+		for ($i = 1; ($p,$f,$l,$s,$h,$w) = caller($i); $i++) {
+		    @a = @args;
+		    for (@a) {
+			if (/^StB\000/ && length($_) == length($_main{'_main'})) {
+			    $_ = sprintf("%s",$_);
+			}
+			else {
+			    s/'/\\'/g;
+			    s/([^\0]*)/'$1'/ unless /^-?[\d.]+$/;
+			    s/([\200-\377])/sprintf("M-%c",ord($1)&0177)/eg;
+			    s/([\0-\37\177])/sprintf("^%c",ord($1)^64)/eg;
+			}
+		    }
+		    $w = $w ? '@ = ' : '$ = ';
+		    $a = $h ? '(' . join(', ', @a) . ')' : '';
+		    push(@sub, "$w&$s$a from file $f line $l\n");
+		    last if $signal;
+		}
+		for ($i=0; $i <= $#sub; $i++) {
+		    last if $signal;
+		    print OUT $sub[$i];
+		}
+	        next; };
+	    $cmd =~ /^\/(.*)$/ && do {
+		$inpat = $1;
+		$inpat =~ s:([^\\])/$:$1:;
+		if ($inpat ne "") {
+		    eval '$inpat =~ m'."\n$inpat\n";	
+		    if ($@ ne "") {
+		    	print OUT "$@";
+		    	next;
+		    }
+		    $pat = $inpat;
+		}
+		$end = $start;
+		eval '
+		for (;;) {
+		    ++$start;
+		    $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;
+		    }
+		} ';
+		print OUT "/$pat/: not found\n" if ($start == $end);
+		next; };
+	    $cmd =~ /^\?(.*)$/ && do {
+		$inpat = $1;
+		$inpat =~ s:([^\\])\?$:$1:;
+		if ($inpat ne "") {
+		    eval '$inpat =~ m'."\n$inpat\n";	
+		    if ($@ ne "") {
+		    	print OUT "$@";
+		    	next;
+		    }
+		    $pat = $inpat;
+		}
+		$end = $start;
+		eval '
+		for (;;) {
+		    --$start;
+		    $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;
+		    }
+		} ';
+		print OUT "?$pat?: not found\n" if ($start == $end);
+		next; };
+	    $cmd =~ /^!+\s*(-)?(\d+)?$/ && do {
+		pop(@hist) if length($cmd) > 1;
+		$i = ($1?($#hist-($2?$2:1)):($2?$2:$#hist));
+		$cmd = $hist[$i] . "\n";
+		print OUT $cmd;
+		redo; };
+	    $cmd =~ /^!(.+)$/ && do {
+		$pat = "^$1";
+		pop(@hist) if length($cmd) > 1;
+		for ($i = $#hist; $i; --$i) {
+		    last if $hist[$i] =~ $pat;
+		}
+		if (!$i) {
+		    print OUT "No such command!\n\n";
+		    next;
+		}
+		$cmd = $hist[$i] . "\n";
+		print OUT $cmd;
+		redo; };
+	    $cmd =~ /^H\s*(-(\d+))?/ && do {
+		$end = $2?($#hist-$2):0;
+		$hist = 0 if $hist < 0;
+		for ($i=$#hist; $i>$end; $i--) {
+		    print OUT "$i: ",$hist[$i],"\n"
+			unless $hist[$i] =~ /^.?$/;
+		};
+		next; };
+	    $cmd =~ s/^p( .*)?$/print DB'OUT$1/;
+	    $cmd =~ /^=/ && do {
+		if (local($k,$v) = ($cmd =~ /^=\s*(\S+)\s+(.*)/)) {
+		    $alias{$k}="s~$k~$v~";
+		    print OUT "$k = $v\n";
+		} elsif ($cmd =~ /^=\s*$/) {
+		    foreach $k (sort keys(%alias)) {
+			if (($v = $alias{$k}) =~ s~^s\~$k\~(.*)\~$~$1~) {
+			    print OUT "$k = $v\n";
+			} else {
+			    print OUT "$k\t$alias{$k}\n";
+			};
+		    };
+		};
+		next; };
+	    $evalarg = $cmd; &eval;
+	    print OUT "\n";
+	}
+	if ($post) {
+	    $evalarg = $post; &eval;
+	}
+    }
+    ($@, $!, $[, $,, $/, $\) = @saved;
+}
+
+sub save {
+    @saved = ($@, $!, $[, $,, $/, $\);
+    $[ = 0; $, = ""; $/ = "\n"; $\ = "";
+}
+
+# The following takes its argument via $evalarg to preserve current @_
+
+sub eval {
+    eval "$usercontext $evalarg; &DB'save";
+    print OUT $@;
+}
+
+sub action {
+    local($action) = @_;
+    while ($action =~ s/\\$//) {
+	print OUT "+ ";
+	$action .= &gets;
+    }
+    $action;
+}
+
+sub gets {
+    local($.);
+    <IN>;
+}
+
+sub catch {
+    $signal = 1;
+}
+
+sub sub {
+    push(@stack, $single);
+    $single &= 1;
+    $single |= 4 if $#stack == $deep;
+    if (wantarray) {
+	@i = &$sub;
+	$single |= pop(@stack);
+	@i;
+    }
+    else {
+	$i = &$sub;
+	$single |= pop(@stack);
+	$i;
+    }
+}
+
+$single = 1;			# so it stops on first executable statement
+@hist = ('?');
+$SIG{'INT'} = "DB'catch";
+$deep = 100;		# warning if stack gets this deep
+$window = 10;
+$preview = 3;
+
+@stack = (0);
+@ARGS = @ARGV;
+for (@args) {
+    s/'/\\'/g;
+    s/(.*)/'$1'/ unless /^-?[\d.]+$/;
+}
+
+if (-f '.perldb') {
+    do './.perldb';
+}
+elsif (-f "$ENV{'LOGDIR'}/.perldb") {
+    do "$ENV{'LOGDIR'}/.perldb";
+}
+elsif (-f "$ENV{'HOME'}/.perldb") {
+    do "$ENV{'HOME'}/.perldb";
+}
+
+1;
diff --git a/emacs/tedstuff b/emacs/tedstuff
new file mode 100644
index 0000000000..257bbc8553
--- /dev/null
+++ b/emacs/tedstuff
@@ -0,0 +1,296 @@
+Article 4417 of comp.lang.perl:
+Path: jpl-devvax!elroy.jpl.nasa.gov!decwrl!mcnc!uvaarpa!mmdf
+From: ted@evi.com (Ted Stefanik)
+Newsgroups: comp.lang.perl
+Subject: Correction to Perl fatal error marking in GNU Emacs
+Message-ID: <1991Feb27.065853.15801@uvaarpa.Virginia.EDU>
+Date: 27 Feb 91 06:58:53 GMT
+Sender: mmdf@uvaarpa.Virginia.EDU (Uvaarpa Mail System)
+Reply-To: ted@evi.com (Ted Stefanik)
+Organization: The Internet
+Lines: 282
+
+Reading my own message, it occurred to me that I didn't quite satisfy the
+request of stef@zweig.sun (Stephane Payrard):
+
+| Does anyone has extended perdb/perdb.el to position the
+| point to the first syntax error? It would be cool.
+
+What I posted is a way to use the "M-x compile" command to test perl scripts.
+(Needless to say, the script cannot be not interactive; you can't provide input
+to a *compilation* buffer).  When creating new Perl programs, I use "M-x
+compile" until I'm sure that they are syntatically correct; if syntax errors
+occur, C-x` takes me to each in sequence.  After I'm sure the syntax is
+correct, I start worrying about semantics, and switch to "M-x perldb" if
+necessary.
+
+Therefore, the stuff I posted works great with "M-x compile", but not at all
+with "M-x perldb".
+
+Next, let me update what I posted.  I found that perl's die() command doesn't
+print the same format error message as perl does when it dies with a syntax
+error.   If you put the following in your ".emacs" file, it causes C-x` to
+recognize both kinds of errors:
+
+(load-library "compile")
+(setq compilation-error-regexp
+  "\\([^ :\n]+\\(: *\\|, line \\|(\\)[0-9]+\\)\\|\\([0-9]+ *of *[^ \n]+\\|[^ \n]+ \\(at \\)*line [0-9]+\\)")
+
+Last, so I don't look like a total fool, let me propose a way to satisfy
+Stephane Payrard's original request (repeated again):
+
+| Does anyone has extended perdb/perdb.el to position the
+| point to the first syntax error? It would be cool.
+
+I'm not satisfied with just the "first syntax error".  Perl's parser is better
+than most about not getting out of sync; therefore, if it reports multiple
+errors, you can usually be assured they are all real errors.
+
+So... I hacked in the "next-error" function from "compile.el" to form
+"perldb-next-error".  You can apply the patches at the end of this message
+to add "perldb-next-error" to your "perldb.el".
+
+Notes:
+   1) The patch binds "perldb-next-error" to C-x~ (because ~ is the shift
+      of ` on my keyboard, and C-x~ is not yet taken in my version of EMACS).
+
+   2) "next-error" is meant to work on a single *compilation* buffer; any new
+      "M-x compile" or "M-x grep" command will clear the old *compilation*
+      buffer and reset the compilation-error parser to start at the top of the
+      *compilation* buffer.
+
+     "perldb-next-error", on the other hand, has to deal with multiple
+      *perldb-<foo>* buffers, each of which keep growing.  "perldb-next-error"
+      correctly handles the constantly growing *perldb-<foo>* buffers by
+      keeping track of the last reported error in the "current-perldb-buffer".
+
+      Sadly however, when you invoke a new "M-x perldb" on a different Perl
+      script, "perldb-next-error" will start parsing the new *perldb-<bar>*
+      buffer at the top (even if it was previously parsed), and will completely
+      lose the marker of the last reported error in *perldb-<foo>*.
+
+   3) "perldb-next-error" still uses "compilation-error-regexp" to find
+      fatal errors.  Therefore, both the "M-x compile"/C-x` scheme and
+      the "M-x perldb"/C-x~ scheme can be used to find fatal errors that
+      match the common "compilation-error-regexp".  You *will* want to install
+      that "compilation-error-regexp" stuff into your .emacs file.
+
+   4) The patch was developed and tested with GNU Emacs 18.55.
+
+   5) Since the patch was ripped off from compile.el, the code is (of
+      course) subject to the GNU copyleft.
+
+*** perldb.el.orig	Wed Feb 27 00:44:27 1991
+--- perldb.el	Wed Feb 27 00:44:30 1991
+***************
+*** 199,205 ****
+  
+  (defun perldb-set-buffer ()
+    (cond ((eq major-mode 'perldb-mode)
+! 	(setq current-perldb-buffer (current-buffer)))))
+  
+  ;; This function is responsible for inserting output from Perl
+  ;; into the buffer.
+--- 199,211 ----
+  
+  (defun perldb-set-buffer ()
+    (cond ((eq major-mode 'perldb-mode)
+!          (cond ((not (eq current-perldb-buffer (current-buffer)))
+!                 (perldb-forget-errors)
+!                 (setq perldb-parsing-end 2)) ;; 2 to defeat grep defeater
+!                (t
+!                 (if (> perldb-parsing-end (point-max))
+!                     (setq perldb-parsing-end (max (point-max) 2)))))
+!          (setq current-perldb-buffer (current-buffer)))))
+  
+  ;; This function is responsible for inserting output from Perl
+  ;; into the buffer.
+***************
+*** 291,297 ****
+  	   ;;  process-buffer is current-buffer
+  	   (unwind-protect
+  	       (progn
+! 		 ;; Write something in *compilation* and hack its mode line,
+  		 (set-buffer (process-buffer proc))
+  		 ;; Force mode line redisplay soon
+  		 (set-buffer-modified-p (buffer-modified-p))
+--- 297,303 ----
+  	   ;;  process-buffer is current-buffer
+  	   (unwind-protect
+  	       (progn
+! 		 ;; Write something in *perldb-<foo>* and hack its mode line,
+  		 (set-buffer (process-buffer proc))
+  		 ;; Force mode line redisplay soon
+  		 (set-buffer-modified-p (buffer-modified-p))
+***************
+*** 421,423 ****
+--- 427,593 ----
+      (switch-to-buffer-other-window current-perldb-buffer)
+      (goto-char (dot-max))
+      (insert-string comm)))
++ 
++ (defvar perldb-error-list nil
++   "List of error message descriptors for visiting erring functions.
++ Each error descriptor is a list of length two.
++ Its car is a marker pointing to an error message.
++ Its cadr is a marker pointing to the text of the line the message is about,
++   or nil if that is not interesting.
++ The value may be t instead of a list;
++ this means that the buffer of error messages should be reparsed
++ the next time the list of errors is wanted.")
++ 
++ (defvar perldb-parsing-end nil
++   "Position of end of buffer when last error messages parsed.")
++ 
++ (defvar perldb-error-message "No more fatal Perl errors"
++   "Message to print when no more matches for compilation-error-regexp are found")
++ 
++ (defun perldb-next-error (&optional argp)
++   "Visit next perldb error message and corresponding source code.
++ This operates on the output from the \\[perldb] command.
++ If all preparsed error messages have been processed,
++ the error message buffer is checked for new ones.
++ A non-nil argument (prefix arg, if interactive)
++ means reparse the error message buffer and start at the first error."
++   (interactive "P")
++   (if (or (eq perldb-error-list t)
++ 	  argp)
++       (progn (perldb-forget-errors)
++ 	     (setq perldb-parsing-end 2))) ;; 2 to defeat grep defeater
++   (if perldb-error-list
++       nil
++     (save-excursion
++       (switch-to-buffer current-perldb-buffer)
++       (perldb-parse-errors)))
++   (let ((next-error (car perldb-error-list)))
++     (if (null next-error)
++ 	(error (concat perldb-error-message
++ 		       (if (and (get-buffer-process current-perldb-buffer)
++ 				(eq (process-status
++                                      (get-buffer-process
++                                       current-perldb-buffer))
++ 				    'run))
++ 			   " yet" ""))))
++     (setq perldb-error-list (cdr perldb-error-list))
++     (if (null (car (cdr next-error)))
++ 	nil
++       (switch-to-buffer (marker-buffer (car (cdr next-error))))
++       (goto-char (car (cdr next-error)))
++       (set-marker (car (cdr next-error)) nil))
++     (let* ((pop-up-windows t)
++ 	   (w (display-buffer (marker-buffer (car next-error)))))
++       (set-window-point w (car next-error))
++       (set-window-start w (car next-error)))
++     (set-marker (car next-error) nil)))
++ 
++ ;; Set perldb-error-list to nil, and
++ ;; unchain the markers that point to the error messages and their text,
++ ;; so that they no longer slow down gap motion.
++ ;; This would happen anyway at the next garbage collection,
++ ;; but it is better to do it right away.
++ (defun perldb-forget-errors ()
++   (if (eq perldb-error-list t)
++       (setq perldb-error-list nil))
++   (while perldb-error-list
++     (let ((next-error (car perldb-error-list)))
++       (set-marker (car next-error) nil)
++       (if (car (cdr next-error))
++ 	  (set-marker (car (cdr next-error)) nil)))
++     (setq perldb-error-list (cdr perldb-error-list))))
++ 
++ (defun perldb-parse-errors ()
++   "Parse the current buffer as error messages.
++ This makes a list of error descriptors, perldb-error-list.
++ For each source-file, line-number pair in the buffer,
++ the source file is read in, and the text location is saved in perldb-error-list.
++ The function next-error, assigned to \\[next-error], takes the next error off the list
++ and visits its location."
++   (setq perldb-error-list nil)
++   (message "Parsing error messages...")
++   (let (text-buffer
++ 	last-filename last-linenum)
++     ;; Don't reparse messages already seen at last parse.
++     (goto-char perldb-parsing-end)
++     ;; Don't parse the first two lines as error messages.
++     ;; This matters for grep.
++     (if (bobp)
++ 	(forward-line 2))
++     (while (re-search-forward compilation-error-regexp nil t)
++       (let (linenum filename
++ 	    error-marker text-marker)
++ 	;; Extract file name and line number from error message.
++ 	(save-restriction
++ 	  (narrow-to-region (match-beginning 0) (match-end 0))
++ 	  (goto-char (point-max))
++ 	  (skip-chars-backward "[0-9]")
++ 	  ;; If it's a lint message, use the last file(linenum) on the line.
++ 	  ;; Normally we use the first on the line.
++ 	  (if (= (preceding-char) ?\()
++ 	      (progn
++ 		(narrow-to-region (point-min) (1+ (buffer-size)))
++ 		(end-of-line)
++ 		(re-search-backward compilation-error-regexp)
++ 		(skip-chars-backward "^ \t\n")
++ 		(narrow-to-region (point) (match-end 0))
++ 		(goto-char (point-max))
++ 		(skip-chars-backward "[0-9]")))
++ 	  ;; Are we looking at a "filename-first" or "line-number-first" form?
++ 	  (if (looking-at "[0-9]")
++ 	      (progn
++ 		(setq linenum (read (current-buffer)))
++ 		(goto-char (point-min)))
++ 	    ;; Line number at start, file name at end.
++ 	    (progn
++ 	      (goto-char (point-min))
++ 	      (setq linenum (read (current-buffer)))
++ 	      (goto-char (point-max))
++ 	      (skip-chars-backward "^ \t\n")))
++ 	  (setq filename (perldb-grab-filename)))
++ 	;; Locate the erring file and line.
++ 	(if (and (equal filename last-filename)
++ 		 (= linenum last-linenum))
++ 	    nil
++ 	  (beginning-of-line 1)
++ 	  (setq error-marker (point-marker))
++ 	  ;; text-buffer gets the buffer containing this error's file.
++ 	  (if (not (equal filename last-filename))
++ 	      (setq text-buffer
++ 		    (and (file-exists-p (setq last-filename filename))
++ 			 (find-file-noselect filename))
++ 		    last-linenum 0))
++ 	  (if text-buffer
++ 	      ;; Go to that buffer and find the erring line.
++ 	      (save-excursion
++ 		(set-buffer text-buffer)
++ 		(if (zerop last-linenum)
++ 		    (progn
++ 		      (goto-char 1)
++ 		      (setq last-linenum 1)))
++ 		(forward-line (- linenum last-linenum))
++ 		(setq last-linenum linenum)
++ 		(setq text-marker (point-marker))
++ 		(setq perldb-error-list
++ 		      (cons (list error-marker text-marker)
++ 			    perldb-error-list)))))
++ 	(forward-line 1)))
++     (setq perldb-parsing-end (point-max)))
++   (message "Parsing error messages...done")
++   (setq perldb-error-list (nreverse perldb-error-list)))
++ 
++ (defun perldb-grab-filename ()
++   "Return a string which is a filename, starting at point.
++ Ignore quotes and parentheses around it, as well as trailing colons."
++   (if (eq (following-char) ?\")
++       (save-restriction
++ 	(narrow-to-region (point)
++ 			  (progn (forward-sexp 1) (point)))
++ 	(goto-char (point-min))
++ 	(read (current-buffer)))
++     (buffer-substring (point)
++ 		      (progn
++ 			(skip-chars-forward "^ :,\n\t(")
++ 			(point)))))
++ 
++ (define-key ctl-x-map "~" 'perldb-next-error)
+
+