home *** CD-ROM | disk | FTP | other *** search
/ The World of Computer Software / World_Of_Computer_Software-02-387-Vol-3of3.iso / p / perl4036.zip / emacs / tedstuff < prev   
Lisp/Scheme  |  1993-02-08  |  12KB  |  297 lines
  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.   
  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.   
  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. + 
  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.  
  297.