297 lines
12 KiB
Plaintext
297 lines
12 KiB
Plaintext
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)
|
||
|
||
|