diff options
Diffstat (limited to 'emacs/tedstuff')
| -rw-r--r-- | emacs/tedstuff | 296 |
1 files changed, 296 insertions, 0 deletions
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) + + |