home *** CD-ROM | disk | FTP | other *** search
/ Geek Gadgets 1 / ADE-1.bin / ade-dist / emacs-18.59-src.tgz / emacs-18.59-src.tar / fsf / emacs18 / lisp / compile.el < prev    next >
Lisp/Scheme  |  1996-09-28  |  12KB  |  328 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 'compile)
  21.  
  22. (defvar compilation-process nil
  23.   "Process created by compile command, or nil if none exists now.
  24. Note that the process may have been \"deleted\" and still
  25. be the value of this variable.")
  26.  
  27. (defvar compilation-error-list nil
  28.   "List of error message descriptors for visiting erring functions.
  29. Each error descriptor is a list of length two.
  30. Its car is a marker pointing to an error message.
  31. Its cadr is a marker pointing to the text of the line the message is about,
  32.   or nil if that is not interesting.
  33. The value may be t instead of a list;
  34. this means that the buffer of error messages should be reparsed
  35. the next time the list of errors is wanted.")
  36.  
  37. (defvar compilation-parsing-end nil
  38.   "Position of end of buffer when last error messages parsed.")
  39.  
  40. (defvar compilation-error-message nil
  41.   "Message to print when no more matches for compilation-error-regexp are found")
  42.  
  43. ;; The filename excludes colons to avoid confusion when error message
  44. ;; starts with digits.
  45. (defvar compilation-error-regexp
  46.   "^\\([^ :\e]+\\([ :] *\\|, line \\|(\\)[0-9]+\\)\\|\\([0-9]+ *of *[^ \n]+\\)"
  47.   "Regular expression for filename/linenumber in error in compilation log.")
  48.  
  49. (defun compile (command)
  50.   "Compile the program including the current buffer.  Default: run `make'.
  51. Runs COMMAND, a shell command, in a separate process asynchronously
  52. with output going to the buffer *compilation*.
  53. You can then use the command \\[next-error] to find the next error message
  54. and move to the source code that caused it."
  55.   (interactive (list (read-string "Compile command: " compile-command)))
  56.   (setq compile-command command)
  57.   (compile1 compile-command "No more errors"))
  58.  
  59. (defun grep (command)
  60.   "Run grep, with user-specified args, and collect output in a buffer.
  61. While grep runs asynchronously, you can use the \\[next-error] command
  62. to find the text that grep hits refer to."
  63.   (interactive "sRun grep (with args): ")
  64.   (compile1 (concat "grep -n " command (if (eq system-type 'amigaos) " nil:"
  65.                      " /dev/null"))
  66.         "No more grep hits" "grep"))
  67.  
  68. (defun compile1 (command error-message &optional name-of-mode)
  69.   (save-some-buffers)
  70.   (if compilation-process
  71.       (if (or (not (eq (process-status compilation-process) 'run))
  72.           (yes-or-no-p "A compilation process is running; kill it? "))
  73.       (condition-case ()
  74.           (if compilation-process
  75.           (let ((comp-proc compilation-process))
  76.             (interrupt-process comp-proc)
  77.             (sit-for 1)
  78.             (delete-process comp-proc)))
  79.         (error nil))
  80.     (error "Cannot have two compilation processes")))
  81.   (setq compilation-process nil)
  82.   (compilation-forget-errors)
  83.   (setq compilation-error-list t)
  84.   (setq compilation-error-message error-message)
  85.   (setq compilation-process
  86.     (start-process "compilation" "*compilation*"
  87.                shell-file-name
  88.                "-c" (concat "exec " command)))
  89.   (with-output-to-temp-buffer "*compilation*"
  90.     (princ "cd ")
  91.     (princ default-directory)
  92.     (terpri)
  93.     (princ command)
  94.     (terpri))
  95.   (set-process-sentinel compilation-process 'compilation-sentinel)
  96.   (let* ((thisdir default-directory)
  97.      (outbuf (process-buffer compilation-process))
  98.      (outwin (get-buffer-window outbuf))
  99.      (regexp compilation-error-regexp))
  100.     (if (eq outbuf (current-buffer))
  101.     (goto-char (point-max)))
  102.     (save-excursion
  103.       (set-buffer outbuf)
  104.       (buffer-flush-undo outbuf)
  105.       (let ((start (save-excursion (set-buffer outbuf) (point-min))))
  106.     (set-window-start outwin start)
  107.     (or (eq outwin (selected-window))
  108.         (set-window-point outwin start)))
  109.       (setq default-directory thisdir)
  110.       (fundamental-mode)
  111.       (make-local-variable 'compilation-error-regexp)
  112.       (setq compilation-error-regexp regexp)
  113.       (setq mode-name (or name-of-mode "Compilation"))
  114.       ;; Make log buffer's mode line show process state
  115.       (setq mode-line-process '(": %s")))))
  116.  
  117. ;; Called when compilation process changes state.
  118.  
  119. (defun compilation-sentinel (proc msg)
  120.   (cond ((null (buffer-name (process-buffer proc)))
  121.      ;; buffer killed
  122.      (set-process-buffer proc nil))
  123.     ((memq (process-status proc) '(signal exit))
  124.      (let* ((obuf (current-buffer))
  125.         omax opoint)
  126.        ;; save-excursion isn't the right thing if
  127.        ;;  process-buffer is current-buffer
  128.        (unwind-protect
  129.            (progn
  130.          ;; Write something in *compilation* and hack its mode line,
  131.          (set-buffer (process-buffer proc))
  132.          (setq omax (point-max) opoint (point))
  133.          (goto-char (point-max))
  134.          (insert ?\n mode-name " " msg)
  135.          (forward-char -1)
  136.          (insert " at "
  137.              (substring (current-time-string) 0 -5))
  138.          (forward-char 1)
  139.          (setq mode-line-process
  140.                (concat ": "
  141.                    (symbol-name (process-status proc))))
  142.          ;; If buffer and mode line will show that the process
  143.          ;; is dead, we can delete it now.  Otherwise it
  144.          ;; will stay around until M-x list-processes.
  145.          (delete-process proc))
  146.          (setq compilation-process nil)
  147.          ;; Force mode line redisplay soon
  148.          (set-buffer-modified-p (buffer-modified-p)))
  149.        (if (and opoint (< opoint omax))
  150.            (goto-char opoint))
  151.        (set-buffer obuf)))))
  152.  
  153. (defun kill-compilation ()
  154.   "Kill the process made by the \\[compile] command."
  155.   (interactive)
  156.   (if compilation-process
  157.       (interrupt-process compilation-process)))
  158.  
  159. (defun kill-grep ()
  160.   "Kill the process made by the \\[grep] command."
  161.   (interactive)
  162.   (if compilation-process
  163.       (interrupt-process compilation-process)))
  164.  
  165. (defun next-error (&optional argp)
  166.   "Visit next compilation error message and corresponding source code.
  167. This operates on the output from the \\[compile] command.
  168. If all preparsed error messages have been processed,
  169. the error message buffer is checked for new ones.
  170. A non-nil argument (prefix arg, if interactive)
  171. means reparse the error message buffer and start at the first error."
  172.   (interactive "P")
  173.   (if (or (eq compilation-error-list t)
  174.       argp)
  175.       (progn (compilation-forget-errors)
  176.          (setq compilation-parsing-end 1)))
  177.   (if compilation-error-list
  178.       nil
  179.     (save-excursion
  180.       (set-buffer "*compilation*")
  181.       (set-buffer-modified-p nil)
  182.       (compilation-parse-errors)))
  183.   (let ((next-error (car compilation-error-list)))
  184.     (if (null next-error)
  185.     (error (concat compilation-error-message
  186.                (if (and compilation-process
  187.                 (eq (process-status compilation-process)
  188.                     'run))
  189.                " yet" ""))))
  190.     (setq compilation-error-list (cdr compilation-error-list))
  191.     (if (null (car (cdr next-error)))
  192.     nil
  193.       (switch-to-buffer (marker-buffer (car (cdr next-error))))
  194.       (goto-char (car (cdr next-error)))
  195.       (set-marker (car (cdr next-error)) nil))
  196.     (let* ((pop-up-windows t)
  197.        (w (display-buffer (marker-buffer (car next-error)))))
  198.       (set-window-point w (car next-error))
  199.       (if compilation-parse-sasc
  200.       (let ((thiswin (selected-window)))
  201.         (select-window w)
  202.         (vertical-motion -1)
  203.         (set-window-start w (point))
  204.         (select-window thiswin))
  205.     (set-window-start w (car next-error))))
  206.     (set-marker (car next-error) nil)))
  207.  
  208. ;; Set compilation-error-list to nil, and
  209. ;; unchain the markers that point to the error messages and their text,
  210. ;; so that they no longer slow down gap motion.
  211. ;; This would happen anyway at the next garbage collection,
  212. ;; but it is better to do it right away.
  213. (defun compilation-forget-errors ()
  214.   (if (eq compilation-error-list t)
  215.       (setq compilation-error-list nil))
  216.   (while compilation-error-list
  217.     (let ((next-error (car compilation-error-list)))
  218.       (set-marker (car next-error) nil)
  219.       (if (car (cdr next-error))
  220.       (set-marker (car (cdr next-error)) nil)))
  221.     (setq compilation-error-list (cdr compilation-error-list))))
  222.  
  223. (defun compilation-parse-errors ()
  224.   "Parse the current buffer as error messages.
  225. This makes a list of error descriptors, compilation-error-list.
  226. For each source-file, line-number pair in the buffer,
  227. the source file is read in, and the text location is saved in compilation-error-list.
  228. The function next-error, assigned to \\[next-error], takes the next error off the list
  229. and visits its location."
  230.   (setq compilation-error-list nil)
  231.   (message "Parsing error messages...")
  232.   (goto-char (point-min))
  233.   (setq compilation-parse-sasc (search-forward "SAS/C" nil t))
  234.   (let (text-buffer
  235.     last-filename last-linenum)
  236.     ;; Don't reparse messages already seen at last parse.
  237.     (goto-char compilation-parsing-end)
  238.     ;; Don't parse the first two lines as error messages.
  239.     ;; This matters for grep.
  240.     (if (bobp)
  241.     (forward-line 2))
  242.     (while (re-search-forward compilation-error-regexp nil t)
  243.       (let (linenum filename
  244.         error-marker text-marker)
  245.     ;; Extract file name and line number from error message.
  246.     (save-restriction
  247.       (narrow-to-region (match-beginning 0) (match-end 0))
  248.       (goto-char (point-max))
  249.       (skip-chars-backward "[0-9]")
  250.       ;; If it's a lint message, use the last file(linenum) on the line.
  251.       ;; Normally we use the first on the line.
  252.       (if (= (preceding-char) ?\()
  253.           (progn
  254.         (narrow-to-region (point-min) (1+ (buffer-size)))
  255.         (end-of-line)
  256.         (re-search-backward compilation-error-regexp)
  257.         (skip-chars-backward "^ \t\n")
  258.         (narrow-to-region (point) (match-end 0))
  259.         (goto-char (point-max))
  260.         (skip-chars-backward "[0-9]")))
  261.       ;; Are we looking at a "filename-first" or "line-number-first" form?
  262.       (if (looking-at "[0-9]")
  263.           (progn
  264.         (setq linenum (read (current-buffer)))
  265.         (goto-char (point-min)))
  266.         ;; Line number at start, file name at end.
  267.         (progn
  268.           (goto-char (point-min))
  269.           (setq linenum (read (current-buffer)))
  270.           (goto-char (point-max))
  271.           (skip-chars-backward "^ \t\n")))
  272.       (setq filename (compilation-grab-filename)))
  273.     ;; Locate the erring file and line.
  274.     (if (and (equal filename last-filename)
  275.          (= linenum last-linenum))
  276.         nil
  277.       (beginning-of-line 1)
  278.       (setq error-marker (point-marker))
  279.       ;; text-buffer gets the buffer containing this error's file.
  280.       (if (not (equal filename last-filename))
  281.           (setq text-buffer
  282.             (and (file-exists-p (setq last-filename filename))
  283.              (find-file-noselect filename))
  284.             last-linenum 0))
  285.       (if text-buffer
  286.           ;; Go to that buffer and find the erring line.
  287.           (save-excursion
  288.         (set-buffer text-buffer)
  289.         (if (zerop last-linenum)
  290.             (progn
  291.               (goto-char 1)
  292.               (setq last-linenum 1)))
  293.         ;; Move the right number of lines from the old position.
  294.         ;; If we can't move that many, put 0 in last-linenum
  295.         ;; so the next error message will be handled starting from
  296.         ;; scratch.
  297.         (if (eq selective-display t)
  298.             (or (re-search-forward "[\n\C-m]" nil 'end
  299.                        (- linenum last-linenum))
  300.             (setq last-linenum 0))
  301.           (or (= 0 (forward-line (- linenum last-linenum)))
  302.               (setq last-linenum 0)))
  303.         (setq last-linenum linenum)
  304.         (setq text-marker (point-marker))
  305.         (setq compilation-error-list
  306.               (cons (list error-marker text-marker)
  307.                 compilation-error-list)))))
  308.     (forward-line 1)))
  309.     (setq compilation-parsing-end (point-max)))
  310.   (message "Parsing error messages...done")
  311.   (setq compilation-error-list (nreverse compilation-error-list)))
  312.  
  313. (defun compilation-grab-filename ()
  314.   "Return a string which is a filename, starting at point.
  315. Ignore quotes and parentheses around it, as well as trailing colons."
  316.   (if (eq (following-char) ?\")
  317.       (save-restriction
  318.     (narrow-to-region (point)
  319.               (progn (forward-sexp 1) (point)))
  320.     (goto-char (point-min))
  321.     (read (current-buffer)))
  322.     (buffer-substring (point)
  323.               (progn
  324.             (skip-chars-forward "^ :,\n\t(")
  325.             (point)))))
  326.  
  327. (define-key ctl-x-map "`" 'next-error)
  328.