home *** CD-ROM | disk | FTP | other *** search
/ Otherware / Otherware_1_SB_Development.iso / amiga / utility / text / emacs.lha / emacs / lisp / amiga-compile.el < prev    next >
Lisp/Scheme  |  1991-12-21  |  8KB  |  216 lines
  1. ;; Run compiler as inferior of Emacs, and parse its error messages.
  2. ;; Copyright (C) 1985, 1986 Free Software Foundation, Inc.
  3.  
  4. ;; This file is part of GNU Emacs.
  5.  
  6. ;; GNU Emacs is free software; you can redistribute it and/or modify
  7. ;; it under the terms of the GNU General Public License as published by
  8. ;; the Free Software Foundation; either version 1, or (at your option)
  9. ;; any later version.
  10.  
  11. ;; GNU Emacs is distributed in the hope that it will be useful,
  12. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  13. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14. ;; GNU General Public License for more details.
  15.  
  16. ;; You should have received a copy of the GNU General Public License
  17. ;; along with GNU Emacs; see the file COPYING.  If not, write to
  18. ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  19.  
  20. (provide 'amiga-compile)
  21.  
  22. (defvar compilation-error-list nil
  23.   "List of error message descriptors for visiting erring functions.
  24. Each error descriptor is a list of length two.
  25. Its car is a marker pointing to an error message.
  26. Its cadr is a marker pointing to the text of the line the message is about,
  27.   or nil if that is not interesting.
  28. The value may be t instead of a list;
  29. this means that the buffer of error messages should be reparsed
  30. the next time the list of errors is wanted.")
  31.  
  32. (defvar compilation-parsing-end nil
  33.   "Position of end of buffer when last error messages parsed.")
  34.  
  35. (defvar compilation-error-message nil
  36.   "Message to print when no more matches for compilation-error-regexp are found")
  37.  
  38. ;; The filename excludes colons to avoid confusion when error message
  39. ;; starts with digits.
  40. (defvar compilation-error-regexp
  41.   "^[^ ]+ [0-9]+"
  42.   "Regular expression for filename/linenumber in error in compilation log.")
  43.  
  44. (defun compile (command)
  45.   "Compile the program including the current buffer.  Default: run `make'.
  46. Runs COMMAND synchronously
  47. with output going to the buffer *compilation*.
  48. You can then use the command \\[next-error] to find the next error message
  49. and move to the source code that caused it."
  50.   (interactive (list (read-string "Compile command: " compile-command)))
  51.   (setq compile-command command)
  52.   (compile1 compile-command "No more errors"))
  53.  
  54. (defun grep (command)
  55.   "Run grep, with user-specified args, and collect output in a buffer.
  56. While grep runs synchronously, you can use the \\[next-error] command
  57. to find the text that grep hits refer to."
  58.   (interactive "sRun grep (with args): ")
  59.   (compile1 (concat "grep -n " command " /dev/null")
  60.         "No more grep hits" "grep"))
  61.  
  62. (defun compile1 (command error-message &optional name-of-mode)
  63.   (save-some-buffers)
  64.   (compilation-forget-errors)
  65.   (setq compilation-error-list t)
  66.   (setq compilation-error-message error-message)
  67.   (kill-buffer  "*compilation*")
  68.   (let ((end-cmd (string-match "[ \t]" command)))
  69.     (if (not end-cmd) (setq end-cmd (length command)))
  70.     (call-process (substring command 0 end-cmd) nil
  71.           (get-buffer-create "*compilation*") t
  72.           (substring command end-cmd))))
  73.  
  74. (defun next-error (&optional argp)
  75.   "Visit next compilation error message and corresponding source code.
  76. This operates on the output from the \\[compile] command.
  77. If all preparsed error messages have been processed,
  78. the error message buffer is checked for new ones.
  79. A non-nil argument (prefix arg, if interactive)
  80. means reparse the error message buffer and start at the first error."
  81.   (interactive "P")
  82.   (if (or (eq compilation-error-list t)
  83.       argp)
  84.       (progn (compilation-forget-errors)
  85.          (setq compilation-parsing-end 1)))
  86.   (if compilation-error-list
  87.       nil
  88.     (save-excursion
  89.       (set-buffer "*compilation*")
  90.       (set-buffer-modified-p nil)
  91.       (compilation-parse-errors)))
  92.   (let ((next-error (car compilation-error-list)))
  93.     (if (null next-error)
  94.     (error compilation-error-message))
  95.     (setq compilation-error-list (cdr compilation-error-list))
  96.     (if (null (car (cdr next-error)))
  97.     nil
  98.       (switch-to-buffer (marker-buffer (car (cdr next-error))))
  99.       (goto-char (car (cdr next-error)))
  100.       (set-marker (car (cdr next-error)) nil))
  101.     (let* ((pop-up-windows t)
  102.        (w (display-buffer (marker-buffer (car next-error)))))
  103.       (set-window-point w (car next-error))
  104.       (set-window-start w (car next-error)))
  105.     (set-marker (car next-error) nil)))
  106.  
  107. ;; Set compilation-error-list to nil, and
  108. ;; unchain the markers that point to the error messages and their text,
  109. ;; so that they no longer slow down gap motion.
  110. ;; This would happen anyway at the next garbage collection,
  111. ;; but it is better to do it right away.
  112. (defun compilation-forget-errors ()
  113.   (if (eq compilation-error-list t)
  114.       (setq compilation-error-list nil))
  115.   (while compilation-error-list
  116.     (let ((next-error (car compilation-error-list)))
  117.       (set-marker (car next-error) nil)
  118.       (if (car (cdr next-error))
  119.       (set-marker (car (cdr next-error)) nil)))
  120.     (setq compilation-error-list (cdr compilation-error-list))))
  121.  
  122. (defun compilation-parse-errors ()
  123.   "Parse the current buffer as error messages.
  124. This makes a list of error descriptors, compilation-error-list.
  125. For each source-file, line-number pair in the buffer,
  126. the source file is read in, and the text location is saved in compilation-error-list.
  127. The function next-error, assigned to \\[next-error], takes the next error off the list
  128. and visits its location."
  129.   (setq compilation-error-list nil)
  130.   (message "Parsing error messages...")
  131.   (let (text-buffer
  132.     last-filename last-linenum)
  133.     ;; Don't reparse messages already seen at last parse.
  134.     (goto-char compilation-parsing-end)
  135.     ;; Don't parse the first two lines as error messages.
  136.     ;; This matters for grep.
  137.     (if (bobp)
  138.     (forward-line 2))
  139.     (while (re-search-forward compilation-error-regexp nil t)
  140.       (let (linenum filename
  141.         error-marker text-marker)
  142.     ;; Extract file name and line number from error message.
  143.     (save-restriction
  144.       (narrow-to-region (match-beginning 0) (match-end 0))
  145.       (goto-char (point-max))
  146.       (skip-chars-backward "[0-9]")
  147.       ;; If it's a lint message, use the last file(linenum) on the line.
  148.       ;; Normally we use the first on the line.
  149.       (if (= (preceding-char) ?\()
  150.           (progn
  151.         (narrow-to-region (point-min) (1+ (buffer-size)))
  152.         (end-of-line)
  153.         (re-search-backward compilation-error-regexp)
  154.         (skip-chars-backward "^ \t\n")
  155.         (narrow-to-region (point) (match-end 0))
  156.         (goto-char (point-max))
  157.         (skip-chars-backward "[0-9]")))
  158.       ;; Are we looking at a "filename-first" or "line-number-first" form?
  159.       (if (looking-at "[0-9]")
  160.           (progn
  161.         (setq linenum (read (current-buffer)))
  162.         (goto-char (point-min)))
  163.         ;; Line number at start, file name at end.
  164.         (progn
  165.           (goto-char (point-min))
  166.           (setq linenum (read (current-buffer)))
  167.           (goto-char (point-max))
  168.           (skip-chars-backward "^ \t\n")))
  169.       (setq filename (compilation-grab-filename)))
  170.     ;; Locate the erring file and line.
  171.     (if (and (equal filename last-filename)
  172.          (= linenum last-linenum))
  173.         nil
  174.       (beginning-of-line 1)
  175.       (setq error-marker (point-marker))
  176.       ;; text-buffer gets the buffer containing this error's file.
  177.       (if (not (equal filename last-filename))
  178.           (setq text-buffer
  179.             (and (file-exists-p (setq last-filename filename))
  180.              (find-file-noselect filename))
  181.             last-linenum 0))
  182.       (if text-buffer
  183.           ;; Go to that buffer and find the erring line.
  184.           (save-excursion
  185.         (set-buffer text-buffer)
  186.         (if (zerop last-linenum)
  187.             (progn
  188.               (goto-char 1)
  189.               (setq last-linenum 1)))
  190.         (forward-line (- linenum last-linenum))
  191.         (setq last-linenum linenum)
  192.         (setq text-marker (point-marker))
  193.         (setq compilation-error-list
  194.               (cons (list error-marker text-marker)
  195.                 compilation-error-list)))))
  196.     (forward-line 1)))
  197.     (setq compilation-parsing-end (point-max)))
  198.   (message "Parsing error messages...done")
  199.   (setq compilation-error-list (nreverse compilation-error-list)))
  200.  
  201. (defun compilation-grab-filename ()
  202.   "Return a string which is a filename, starting at point.
  203. Ignore quotes and parentheses around it, as well as trailing colons."
  204.   (if (eq (following-char) ?\")
  205.       (save-restriction
  206.     (narrow-to-region (point)
  207.               (progn (forward-sexp 1) (point)))
  208.     (goto-char (point-min))
  209.     (read (current-buffer)))
  210.     (buffer-substring (point)
  211.               (progn
  212.             (skip-chars-forward "^ :,\n\t(")
  213.             (point)))))
  214.  
  215. (define-key ctl-x-map "`" 'next-error)
  216.