emacs/tedstuff

   1 Article 4417 of comp.lang.perl:
   2 Path: jpl-devvax!elroy.jpl.nasa.gov!decwrl!mcnc!uvaarpa!mmdf
   3 From: ted@evi.com (Ted Stefanik)
   4 Newsgroups: comp.lang.perl
   5 Subject: Correction to Perl fatal error marking in GNU Emacs
   6 Message-ID: <1991Feb27.065853.15801@uvaarpa.Virginia.EDU>
   7 Date: 27 Feb 91 06:58:53 GMT
   8 Sender: mmdf@uvaarpa.Virginia.EDU (Uvaarpa Mail System)
   9 Reply-To: ted@evi.com (Ted Stefanik)
  10 Organization: The Internet
  11 Lines: 282
  12
  13 Reading my own message, it occurred to me that I didn't quite satisfy the
  14 request of stef@zweig.sun (Stephane Payrard):
  15
  16 | Does anyone has extended perdb/perdb.el to position the
  17 | point to the first syntax error? It would be cool.
  18
  19 What I posted is a way to use the "M-x compile" command to test perl scripts.
  20 (Needless to say, the script cannot be not interactive; you can't provide input
  21 to a *compilation* buffer).  When creating new Perl programs, I use "M-x
  22 compile" until I'm sure that they are syntatically correct; if syntax errors
  23 occur, C-x` takes me to each in sequence.  After I'm sure the syntax is
  24 correct, I start worrying about semantics, and switch to "M-x perldb" if
  25 necessary.
  26
  27 Therefore, the stuff I posted works great with "M-x compile", but not at all
  28 with "M-x perldb".
  29
  30 Next, let me update what I posted.  I found that perl's die() command doesn't
  31 print the same format error message as perl does when it dies with a syntax
  32 error.   If you put the following in your ".emacs" file, it causes C-x` to
  33 recognize both kinds of errors:
  34
  35 (load-library "compile")
  36 (setq compilation-error-regexp
  37   "\\([^ :\n]+\\(: *\\|, line \\|(\\)[0-9]+\\)\\|\\([0-9]+ *of *[^ \n]+\\|[^ \n]+ \\(at \\)*line [0-9]+\\)")
  38
  39 Last, so I don't look like a total fool, let me propose a way to satisfy
  40 Stephane Payrard's original request (repeated again):
  41
  42 | Does anyone has extended perdb/perdb.el to position the
  43 | point to the first syntax error? It would be cool.
  44
  45 I'm not satisfied with just the "first syntax error".  Perl's parser is better
  46 than most about not getting out of sync; therefore, if it reports multiple
  47 errors, you can usually be assured they are all real errors.
  48
  49 So... I hacked in the "next-error" function from "compile.el" to form
  50 "perldb-next-error".  You can apply the patches at the end of this message
  51 to add "perldb-next-error" to your "perldb.el".
  52
  53 Notes:
  54    1) The patch binds "perldb-next-error" to C-x~ (because ~ is the shift
  55       of ` on my keyboard, and C-x~ is not yet taken in my version of EMACS).
  56
  57    2) "next-error" is meant to work on a single *compilation* buffer; any new
  58       "M-x compile" or "M-x grep" command will clear the old *compilation*
  59       buffer and reset the compilation-error parser to start at the top of the
  60       *compilation* buffer.
  61
  62      "perldb-next-error", on the other hand, has to deal with multiple
  63       *perldb-<foo>* buffers, each of which keep growing.  "perldb-next-error"
  64       correctly handles the constantly growing *perldb-<foo>* buffers by
  65       keeping track of the last reported error in the "current-perldb-buffer".
  66
  67       Sadly however, when you invoke a new "M-x perldb" on a different Perl
  68       script, "perldb-next-error" will start parsing the new *perldb-<bar>*
  69       buffer at the top (even if it was previously parsed), and will completely
  70       lose the marker of the last reported error in *perldb-<foo>*.
  71
  72    3) "perldb-next-error" still uses "compilation-error-regexp" to find
  73       fatal errors.  Therefore, both the "M-x compile"/C-x` scheme and
  74       the "M-x perldb"/C-x~ scheme can be used to find fatal errors that
  75       match the common "compilation-error-regexp".  You *will* want to install
  76       that "compilation-error-regexp" stuff into your .emacs file.
  77
  78    4) The patch was developed and tested with GNU Emacs 18.55.
  79
  80    5) Since the patch was ripped off from compile.el, the code is (of
  81       course) subject to the GNU copyleft.
  82
  83 *** perldb.el.orig      Wed Feb 27 00:44:27 1991
  84 --- perldb.el   Wed Feb 27 00:44:30 1991
  85 ***************
  86 *** 199,205 ****
  87
  88   (defun perldb-set-buffer ()
  89     (cond ((eq major-mode 'perldb-mode)
  90 !       (setq current-perldb-buffer (current-buffer)))))
  91   \f
  92   ;; This function is responsible for inserting output from Perl
  93   ;; into the buffer.
  94 --- 199,211 ----
  95
  96   (defun perldb-set-buffer ()
  97     (cond ((eq major-mode 'perldb-mode)
  98 !          (cond ((not (eq current-perldb-buffer (current-buffer)))
  99 !                 (perldb-forget-errors)
 100 !                 (setq perldb-parsing-end 2)) ;; 2 to defeat grep defeater
 101 !                (t
 102 !                 (if (> perldb-parsing-end (point-max))
 103 !                     (setq perldb-parsing-end (max (point-max) 2)))))
 104 !          (setq current-perldb-buffer (current-buffer)))))
 105   \f
 106   ;; This function is responsible for inserting output from Perl
 107   ;; into the buffer.
 108 ***************
 109 *** 291,297 ****
 110            ;;  process-buffer is current-buffer
 111            (unwind-protect
 112                (progn
 113 !                ;; Write something in *compilation* and hack its mode line,
 114                  (set-buffer (process-buffer proc))
 115                  ;; Force mode line redisplay soon
 116                  (set-buffer-modified-p (buffer-modified-p))
 117 --- 297,303 ----
 118            ;;  process-buffer is current-buffer
 119            (unwind-protect
 120                (progn
 121 !                ;; Write something in *perldb-<foo>* and hack its mode line,
 122                  (set-buffer (process-buffer proc))
 123                  ;; Force mode line redisplay soon
 124                  (set-buffer-modified-p (buffer-modified-p))
 125 ***************
 126 *** 421,423 ****
 127 --- 427,593 ----
 128       (switch-to-buffer-other-window current-perldb-buffer)
 129       (goto-char (dot-max))
 130       (insert-string comm)))
 131 + \f
 132 + (defvar perldb-error-list nil
 133 +   "List of error message descriptors for visiting erring functions.
 134 + Each error descriptor is a list of length two.
 135 + Its car is a marker pointing to an error message.
 136 + Its cadr is a marker pointing to the text of the line the message is about,
 137 +   or nil if that is not interesting.
 138 + The value may be t instead of a list;
 139 + this means that the buffer of error messages should be reparsed
 140 + the next time the list of errors is wanted.")
 141 +
 142 + (defvar perldb-parsing-end nil
 143 +   "Position of end of buffer when last error messages parsed.")
 144 +
 145 + (defvar perldb-error-message "No more fatal Perl errors"
 146 +   "Message to print when no more matches for compilation-error-regexp are found")
 147 +
 148 + (defun perldb-next-error (&optional argp)
 149 +   "Visit next perldb error message and corresponding source code.
 150 + This operates on the output from the \\[perldb] command.
 151 + If all preparsed error messages have been processed,
 152 + the error message buffer is checked for new ones.
 153 + A non-nil argument (prefix arg, if interactive)
 154 + means reparse the error message buffer and start at the first error."
 155 +   (interactive "P")
 156 +   (if (or (eq perldb-error-list t)
 157 +         argp)
 158 +       (progn (perldb-forget-errors)
 159 +            (setq perldb-parsing-end 2))) ;; 2 to defeat grep defeater
 160 +   (if perldb-error-list
 161 +       nil
 162 +     (save-excursion
 163 +       (switch-to-buffer current-perldb-buffer)
 164 +       (perldb-parse-errors)))
 165 +   (let ((next-error (car perldb-error-list)))
 166 +     (if (null next-error)
 167 +       (error (concat perldb-error-message
 168 +                      (if (and (get-buffer-process current-perldb-buffer)
 169 +                               (eq (process-status
 170 +                                      (get-buffer-process
 171 +                                       current-perldb-buffer))
 172 +                                   'run))
 173 +                          " yet" ""))))
 174 +     (setq perldb-error-list (cdr perldb-error-list))
 175 +     (if (null (car (cdr next-error)))
 176 +       nil
 177 +       (switch-to-buffer (marker-buffer (car (cdr next-error))))
 178 +       (goto-char (car (cdr next-error)))
 179 +       (set-marker (car (cdr next-error)) nil))
 180 +     (let* ((pop-up-windows t)
 181 +          (w (display-buffer (marker-buffer (car next-error)))))
 182 +       (set-window-point w (car next-error))
 183 +       (set-window-start w (car next-error)))
 184 +     (set-marker (car next-error) nil)))
 185 +
 186 + ;; Set perldb-error-list to nil, and
 187 + ;; unchain the markers that point to the error messages and their text,
 188 + ;; so that they no longer slow down gap motion.
 189 + ;; This would happen anyway at the next garbage collection,
 190 + ;; but it is better to do it right away.
 191 + (defun perldb-forget-errors ()
 192 +   (if (eq perldb-error-list t)
 193 +       (setq perldb-error-list nil))
 194 +   (while perldb-error-list
 195 +     (let ((next-error (car perldb-error-list)))
 196 +       (set-marker (car next-error) nil)
 197 +       (if (car (cdr next-error))
 198 +         (set-marker (car (cdr next-error)) nil)))
 199 +     (setq perldb-error-list (cdr perldb-error-list))))
 200 +
 201 + (defun perldb-parse-errors ()
 202 +   "Parse the current buffer as error messages.
 203 + This makes a list of error descriptors, perldb-error-list.
 204 + For each source-file, line-number pair in the buffer,
 205 + the source file is read in, and the text location is saved in perldb-error-list.
 206 + The function next-error, assigned to \\[next-error], takes the next error off the list
 207 + and visits its location."
 208 +   (setq perldb-error-list nil)
 209 +   (message "Parsing error messages...")
 210 +   (let (text-buffer
 211 +       last-filename last-linenum)
 212 +     ;; Don't reparse messages already seen at last parse.
 213 +     (goto-char perldb-parsing-end)
 214 +     ;; Don't parse the first two lines as error messages.
 215 +     ;; This matters for grep.
 216 +     (if (bobp)
 217 +       (forward-line 2))
 218 +     (while (re-search-forward compilation-error-regexp nil t)
 219 +       (let (linenum filename
 220 +           error-marker text-marker)
 221 +       ;; Extract file name and line number from error message.
 222 +       (save-restriction
 223 +         (narrow-to-region (match-beginning 0) (match-end 0))
 224 +         (goto-char (point-max))
 225 +         (skip-chars-backward "[0-9]")
 226 +         ;; If it's a lint message, use the last file(linenum) on the line.
 227 +         ;; Normally we use the first on the line.
 228 +         (if (= (preceding-char) ?\()
 229 +             (progn
 230 +               (narrow-to-region (point-min) (1+ (buffer-size)))
 231 +               (end-of-line)
 232 +               (re-search-backward compilation-error-regexp)
 233 +               (skip-chars-backward "^ \t\n")
 234 +               (narrow-to-region (point) (match-end 0))
 235 +               (goto-char (point-max))
 236 +               (skip-chars-backward "[0-9]")))
 237 +         ;; Are we looking at a "filename-first" or "line-number-first" form?
 238 +         (if (looking-at "[0-9]")
 239 +             (progn
 240 +               (setq linenum (read (current-buffer)))
 241 +               (goto-char (point-min)))
 242 +           ;; Line number at start, file name at end.
 243 +           (progn
 244 +             (goto-char (point-min))
 245 +             (setq linenum (read (current-buffer)))
 246 +             (goto-char (point-max))
 247 +             (skip-chars-backward "^ \t\n")))
 248 +         (setq filename (perldb-grab-filename)))
 249 +       ;; Locate the erring file and line.
 250 +       (if (and (equal filename last-filename)
 251 +                (= linenum last-linenum))
 252 +           nil
 253 +         (beginning-of-line 1)
 254 +         (setq error-marker (point-marker))
 255 +         ;; text-buffer gets the buffer containing this error's file.
 256 +         (if (not (equal filename last-filename))
 257 +             (setq text-buffer
 258 +                   (and (file-exists-p (setq last-filename filename))
 259 +                        (find-file-noselect filename))
 260 +                   last-linenum 0))
 261 +         (if text-buffer
 262 +             ;; Go to that buffer and find the erring line.
 263 +             (save-excursion
 264 +               (set-buffer text-buffer)
 265 +               (if (zerop last-linenum)
 266 +                   (progn
 267 +                     (goto-char 1)
 268 +                     (setq last-linenum 1)))
 269 +               (forward-line (- linenum last-linenum))
 270 +               (setq last-linenum linenum)
 271 +               (setq text-marker (point-marker))
 272 +               (setq perldb-error-list
 273 +                     (cons (list error-marker text-marker)
 274 +                           perldb-error-list)))))
 275 +       (forward-line 1)))
 276 +     (setq perldb-parsing-end (point-max)))
 277 +   (message "Parsing error messages...done")
 278 +   (setq perldb-error-list (nreverse perldb-error-list)))
 279 +
 280 + (defun perldb-grab-filename ()
 281 +   "Return a string which is a filename, starting at point.
 282 + Ignore quotes and parentheses around it, as well as trailing colons."
 283 +   (if (eq (following-char) ?\")
 284 +       (save-restriction
 285 +       (narrow-to-region (point)
 286 +                         (progn (forward-sexp 1) (point)))
 287 +       (goto-char (point-min))
 288 +       (read (current-buffer)))
 289 +     (buffer-substring (point)
 290 +                     (progn
 291 +                       (skip-chars-forward "^ :,\n\t(")
 292 +                       (point)))))
 293 +
 294 + (define-key ctl-x-map "~" 'perldb-next-error)
 295
 296