home *** CD-ROM | disk | FTP | other *** search
/ Otherware / Otherware_1_SB_Development.iso / amiga / utility / text / emacsb1.lzh / emacs-18.58 / lisp / amiga-compile.el < prev    next >
Encoding:
Text File  |  1992-04-29  |  8.4 KB  |  226 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.   (with-output-to-temp-buffer "*compilation*"
  68.     (princ "cd ")
  69.     (princ default-directory)
  70.     (terpri)
  71.     (princ command)
  72.     (terpri))
  73.   (let ((thisbuf (current-buffer)))
  74.     (set-buffer "*compilation*")
  75.     (goto-char (point-max))
  76.     (set-buffer thisbuf))
  77.   (call-process shell-file-name nil (get-buffer-create "*compilation*") t
  78.         "-c" command))
  79.  
  80. (defun next-error (&optional argp)
  81.   "Visit next compilation error message and corresponding source code.
  82. This operates on the output from the \\[compile] command.
  83. If all preparsed error messages have been processed,
  84. the error message buffer is checked for new ones.
  85. A non-nil argument (prefix arg, if interactive)
  86. means reparse the error message buffer and start at the first error."
  87.   (interactive "P")
  88.   (if (or (eq compilation-error-list t)
  89.       argp)
  90.       (progn (compilation-forget-errors)
  91.          (setq compilation-parsing-end 1)))
  92.   (if compilation-error-list
  93.       nil
  94.     (save-excursion
  95.       (set-buffer "*compilation*")
  96.       (set-buffer-modified-p nil)
  97.       (compilation-parse-errors)))
  98.   (let ((next-error (car compilation-error-list)))
  99.     (if (null next-error)
  100.     (error compilation-error-message))
  101.     (setq compilation-error-list (cdr compilation-error-list))
  102.     (if (null (car (cdr next-error)))
  103.     nil
  104.       (switch-to-buffer (marker-buffer (car (cdr next-error))))
  105.       (goto-char (car (cdr next-error)))
  106.       (set-marker (car (cdr next-error)) nil))
  107.     (let* ((pop-up-windows t)
  108.        (w (display-buffer (marker-buffer (car next-error)))))
  109.       (set-window-point w (car next-error))
  110.       (let ((thiswin (selected-window)))
  111.     (select-window w)
  112.     (vertical-motion -1)
  113.     (set-window-start w (point))
  114.     (select-window thiswin)))
  115.     (set-marker (car next-error) nil)))
  116.  
  117. ;; Set compilation-error-list to nil, and
  118. ;; unchain the markers that point to the error messages and their text,
  119. ;; so that they no longer slow down gap motion.
  120. ;; This would happen anyway at the next garbage collection,
  121. ;; but it is better to do it right away.
  122. (defun compilation-forget-errors ()
  123.   (if (eq compilation-error-list t)
  124.       (setq compilation-error-list nil))
  125.   (while compilation-error-list
  126.     (let ((next-error (car compilation-error-list)))
  127.       (set-marker (car next-error) nil)
  128.       (if (car (cdr next-error))
  129.       (set-marker (car (cdr next-error)) nil)))
  130.     (setq compilation-error-list (cdr compilation-error-list))))
  131.  
  132. (defun compilation-parse-errors ()
  133.   "Parse the current buffer as error messages.
  134. This makes a list of error descriptors, compilation-error-list.
  135. For each source-file, line-number pair in the buffer,
  136. the source file is read in, and the text location is saved in compilation-error-list.
  137. The function next-error, assigned to \\[next-error], takes the next error off the list
  138. and visits its location."
  139.   (setq compilation-error-list nil)
  140.   (message "Parsing error messages...")
  141.   (let (text-buffer
  142.     last-filename last-linenum)
  143.     ;; Don't reparse messages already seen at last parse.
  144.     (goto-char compilation-parsing-end)
  145.     ;; Don't parse the first two lines as error messages.
  146.     ;; This matters for grep.
  147.     (if (bobp)
  148.     (forward-line 2))
  149.     (while (re-search-forward compilation-error-regexp nil t)
  150.       (let (linenum filename
  151.         error-marker text-marker)
  152.     ;; Extract file name and line number from error message.
  153.     (save-restriction
  154.       (narrow-to-region (match-beginning 0) (match-end 0))
  155.       (goto-char (point-max))
  156.       (skip-chars-backward "[0-9]")
  157.       ;; If it's a lint message, use the last file(linenum) on the line.
  158.       ;; Normally we use the first on the line.
  159.       (if (= (preceding-char) ?\()
  160.           (progn
  161.         (narrow-to-region (point-min) (1+ (buffer-size)))
  162.         (end-of-line)
  163.         (re-search-backward compilation-error-regexp)
  164.         (skip-chars-backward "^ \t\n")
  165.         (narrow-to-region (point) (match-end 0))
  166.         (goto-char (point-max))
  167.         (skip-chars-backward "[0-9]")))
  168.       ;; Are we looking at a "filename-first" or "line-number-first" form?
  169.       (if (looking-at "[0-9]")
  170.           (progn
  171.         (setq linenum (read (current-buffer)))
  172.         (goto-char (point-min)))
  173.         ;; Line number at start, file name at end.
  174.         (progn
  175.           (goto-char (point-min))
  176.           (setq linenum (read (current-buffer)))
  177.           (goto-char (point-max))
  178.           (skip-chars-backward "^ \t\n")))
  179.       (setq filename (compilation-grab-filename)))
  180.     ;; Locate the erring file and line.
  181.     (if (and (equal filename last-filename)
  182.          (= linenum last-linenum))
  183.         nil
  184.       (beginning-of-line 1)
  185.       (setq error-marker (point-marker))
  186.       ;; text-buffer gets the buffer containing this error's file.
  187.       (if (not (equal filename last-filename))
  188.           (setq text-buffer
  189.             (and (file-exists-p (setq last-filename filename))
  190.              (find-file-noselect filename))
  191.             last-linenum 0))
  192.       (if text-buffer
  193.           ;; Go to that buffer and find the erring line.
  194.           (save-excursion
  195.         (set-buffer text-buffer)
  196.         (if (zerop last-linenum)
  197.             (progn
  198.               (goto-char 1)
  199.               (setq last-linenum 1)))
  200.         (forward-line (- linenum last-linenum))
  201.         (setq last-linenum linenum)
  202.         (setq text-marker (point-marker))
  203.         (setq compilation-error-list
  204.               (cons (list error-marker text-marker)
  205.                 compilation-error-list)))))
  206.     (forward-line 1)))
  207.     (setq compilation-parsing-end (point-max)))
  208.   (message "Parsing error messages...done")
  209.   (setq compilation-error-list (nreverse compilation-error-list)))
  210.  
  211. (defun compilation-grab-filename ()
  212.   "Return a string which is a filename, starting at point.
  213. Ignore quotes and parentheses around it, as well as trailing colons."
  214.   (if (eq (following-char) ?\")
  215.       (save-restriction
  216.     (narrow-to-region (point)
  217.               (progn (forward-sexp 1) (point)))
  218.     (goto-char (point-min))
  219.     (read (current-buffer)))
  220.     (buffer-substring (point)
  221.               (progn
  222.             (skip-chars-forward "^ :,\n\t(")
  223.             (point)))))
  224.  
  225. (define-key ctl-x-map "`" 'next-error)
  226.