diff options
| author | Roland McGrath | 1991-10-07 22:49:33 +0000 |
|---|---|---|
| committer | Roland McGrath | 1991-10-07 22:49:33 +0000 |
| commit | d3cb357bbffeba13170d88fd23ee95390c682802 (patch) | |
| tree | 562f2a405078c50b269032c3243b888498f7975b | |
| parent | d6d472d5a363c3e3d178c1e0a9269af7ca7adb8e (diff) | |
| download | emacs-d3cb357bbffeba13170d88fd23ee95390c682802.tar.gz emacs-d3cb357bbffeba13170d88fd23ee95390c682802.zip | |
*** empty log message ***
| -rw-r--r-- | lisp/progmodes/compile.el | 908 |
1 files changed, 606 insertions, 302 deletions
diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el index 8ced79837d1..1d6856ee1b1 100644 --- a/lisp/progmodes/compile.el +++ b/lisp/progmodes/compile.el | |||
| @@ -1,66 +1,108 @@ | |||
| 1 | ;;;!!! dup removal is broken. | ||
| 1 | ;; Run compiler as inferior of Emacs, and parse its error messages. | 2 | ;; Run compiler as inferior of Emacs, and parse its error messages. |
| 2 | ;; Copyright (C) 1985, 1986, 1988, 1989 Free Software Foundation, Inc. | 3 | ;; Copyright (C) 1985-1991 Free Software Foundation, Inc. |
| 3 | 4 | ||
| 4 | ;; This file is part of GNU Emacs. | 5 | ;; This file is part of GNU Emacs. |
| 5 | 6 | ||
| 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, | 7 | ;; GNU Emacs is distributed in the hope that it will be useful, |
| 12 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | 8 | ;; but WITHOUT ANY WARRANTY. No author or distributor |
| 13 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | 9 | ;; accepts responsibility to anyone for the consequences of using it |
| 14 | ;; GNU General Public License for more details. | 10 | ;; or for whether it serves any particular purpose or works at all, |
| 15 | 11 | ;; unless he says so in writing. Refer to the GNU Emacs General Public | |
| 16 | ;; You should have received a copy of the GNU General Public License | 12 | ;; License for full details. |
| 17 | ;; along with GNU Emacs; see the file COPYING. If not, write to | 13 | |
| 18 | ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. | 14 | ;; Everyone is granted permission to copy, modify and redistribute |
| 15 | ;; GNU Emacs, but only under the conditions described in the | ||
| 16 | ;; GNU Emacs General Public License. A copy of this license is | ||
| 17 | ;; supposed to have been given to you along with GNU Emacs so you | ||
| 18 | ;; can know your rights and responsibilities. It should be in a | ||
| 19 | ;; file named COPYING. Among other things, the copyright notice | ||
| 20 | ;; and this notice must be preserved on all copies. | ||
| 19 | 21 | ||
| 20 | (provide 'compile) | 22 | (provide 'compile) |
| 21 | 23 | ||
| 24 | (defconst compilation-window-height nil | ||
| 25 | "*Number of lines in a compilation window. If nil, use Emacs default.") | ||
| 26 | |||
| 22 | (defvar compilation-error-list nil | 27 | (defvar compilation-error-list nil |
| 23 | "List of error message descriptors for visiting erring functions. | 28 | "List of error message descriptors for visiting erring functions. |
| 24 | Each error descriptor is a list of length two. | 29 | Each error descriptor is a cons (or nil). |
| 25 | Its car is a marker pointing to an error message. | 30 | 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, | 31 | If its cdr is a marker, it points to the text of the line the message is about. |
| 27 | or nil if that is not interesting. | 32 | If its cdr is a cons, that cons's car is a cons (DIRECTORY . FILE), specifying |
| 28 | The value may be t instead of a list; | 33 | file the message is about, and its cdr is the number of the line the message |
| 29 | this means that the buffer of error messages should be reparsed | 34 | is about. Or its cdr may be nil if that error is not interesting. |
| 30 | the next time the list of errors is wanted.") | 35 | |
| 36 | The value may be t instead of a list; this means that the buffer of | ||
| 37 | error messages should be reparsed the next time the list of errors is wanted.") | ||
| 31 | 38 | ||
| 32 | (defvar compilation-old-error-list nil | 39 | (defvar compilation-old-error-list nil |
| 33 | "Value of `compilation-error-list' after errors were parsed.") | 40 | "Value of `compilation-error-list' after errors were parsed.") |
| 34 | 41 | ||
| 35 | (defvar compilation-last-error nil | 42 | (defvar compilation-parse-errors-function 'compilation-parse-errors |
| 36 | "List describing the error found by last call to \\[next-error]. | 43 | "Function to call (with no args) to parse error messages from a compilation. |
| 37 | A list of two markers (ERROR-POS CODE-POS), | 44 | It should read in the source files which have errors and set |
| 38 | pointing to the error message and the erroneous code, respectively. | 45 | `compilation-error-list' to a list with an element for each error message |
| 39 | CODE-POS can be nil, if the error message has no specific source location.") | 46 | found. See that variable for more info.") |
| 40 | |||
| 41 | (defvar compilation-parse-errors-hook 'compilation-parse-errors | ||
| 42 | "Function to call (no args) to parse error messages from a compilation. | ||
| 43 | It should read in the source files which have errors | ||
| 44 | and set `compilation-error-list' to a list with an element | ||
| 45 | for each error message found. See that variable for more info.") | ||
| 46 | 47 | ||
| 47 | (defvar compilation-error-buffer nil | 48 | (defvar compilation-buffer-name-function nil |
| 48 | "Current compilation buffer for compilation error processing.") | 49 | "Function to call with one argument, the name of the major mode of the |
| 50 | compilation buffer, to give the buffer a name. It should return a string. | ||
| 51 | If nil, the name \"*compilation*\" is used for compilation buffers, | ||
| 52 | and the name \"*grep*\" is used for grep buffers. | ||
| 53 | \(Actually, the name (concat "*" (downcase major-mode) "*") is used.)") | ||
| 49 | 54 | ||
| 50 | (defvar compilation-parsing-end nil | 55 | (defvar compilation-finish-function nil |
| 51 | "Position of end of buffer when last error messages parsed.") | 56 | "Function to call when a compilation process finishes. |
| 57 | It is called with two arguments: the compilation buffer, and a string | ||
| 58 | describing how the process finished.") | ||
| 52 | 59 | ||
| 53 | (defvar compilation-error-message nil | 60 | (defvar compilation-last-buffer nil |
| 54 | "Message to print when no more matches for compilation-error-regexp are found") | 61 | "The buffer in which the last compilation was started, |
| 62 | or which was used by the last \\[next-error] or \\[compile-goto-error].") | ||
| 55 | 63 | ||
| 56 | ;; The filename excludes colons to avoid confusion when error message | 64 | (defvar compilation-parsing-end nil |
| 57 | ;; starts with digits. | 65 | "Position of end of buffer when last error messages were parsed.") |
| 58 | (defvar compilation-error-regexp | 66 | |
| 59 | "\\([^ :\n]+\\(: *\\|, line \\|(\\)[0-9]+\\)\\|\\([0-9]+ *of *[^ \n]+\\)\\|\\(\"[^ \n]+\",L[0-9]+\\)" | 67 | (defvar compilation-error-message "No more errors" |
| 60 | "Regular expression for filename/linenumber in error in compilation log.") | 68 | "Message to print when no more matches for `compilation-error-regexp-alist' |
| 69 | are found.") | ||
| 70 | |||
| 71 | (defvar compilation-error-regexp-alist | ||
| 72 | '( | ||
| 73 | ;; 4.3BSD grep, cc, lint pass 1: | ||
| 74 | ;; /usr/src/foo/foo.c(8): warning: w may be used before set | ||
| 75 | ;; or GNU utilities | ||
| 76 | ;; foo.c:8: error message | ||
| 77 | ("^\\([^:( \t\n]+\\)[:( \t]+\\([0-9]+\\)[:) \t]" 1 2) | ||
| 78 | ;; 4.3BSD lint pass 2 | ||
| 79 | ;; strcmp: variable # of args. llib-lc(359) :: /usr/src/foo/foo.c(8) | ||
| 80 | ("[ \t:]+\\([^:( \t\n]+\\)[ \t]*[:(]+[ \t]*\\([0-9]+\\)[:) \t]*$" 1 2) | ||
| 81 | ;; 4.3BSD lint pass 3 | ||
| 82 | ;; bloofle defined( /users/wolfgang/foo.c(4) ), but never used | ||
| 83 | ("[ \t(]+\\([^:( \t\n]+\\)[:( \t]+\\([0-9]+\\)[:) \t]+" 1 2) | ||
| 84 | ;; Line 45 of "foo.c": bloofel undefined (who does this?) | ||
| 85 | ("^[Ll]ine[ \t]+\\([0-9]+\\)[ \t]+of[ \t]+\"\\([^\"]+\\)\":" 2 1) | ||
| 86 | ;; Apollo cc, 4.3BSD fc | ||
| 87 | ;; "foo.f", line 3: Error: syntax error near end of statement | ||
| 88 | ("^\"\\([^\"]+\\)\", line \\([0-9]+\\):" 1 2) | ||
| 89 | ;; HP-UX 7.0 fc | ||
| 90 | ;; foo.f :16 some horrible error message | ||
| 91 | ("\\([^ \t:]+\\)[ \t]*:\\([0-9]+\\)" 1 2) | ||
| 92 | ;; IBM AIX PS/2 C version 1.1 | ||
| 93 | ;; ****** Error number 140 in line 8 of file errors.c ****** | ||
| 94 | ("in line \\([0-9]+\\) of file \\([^ ]+[^. ]\\)\\.? " 2 1) | ||
| 95 | ;; IBM AIX lint is too painful to do right this way. File name | ||
| 96 | ;; prefixes entire sections rather than being on each line. | ||
| 97 | ) | ||
| 98 | "Alist (REGEXP FILE-IDX LINE-IDX) of regular expressions to match errors in | ||
| 99 | compilation. If REGEXP matches, the FILE-IDX'th subexpression gives the file | ||
| 100 | name, and the LINE-IDX'th subexpression gives the line number.") | ||
| 61 | 101 | ||
| 62 | (defvar compile-window-height nil | 102 | (defvar compilation-search-path '(nil) |
| 63 | "*Desired height of compilation window. nil means use Emacs default.") | 103 | "List of directories to search for source files named in error messages. |
| 104 | Elements should be directory names, not file names of directories. | ||
| 105 | nil as an element means to try the default directory.") | ||
| 64 | 106 | ||
| 65 | (defvar compile-command "make -k " | 107 | (defvar compile-command "make -k " |
| 66 | "Last shell command used to do a compilation; default for next compilation. | 108 | "Last shell command used to do a compilation; default for next compilation. |
| @@ -75,34 +117,68 @@ You might also use mode hooks to specify it in certain modes, like this: | |||
| 75 | (concat \"make -k \" | 117 | (concat \"make -k \" |
| 76 | buffer-file-name))))))") | 118 | buffer-file-name))))))") |
| 77 | 119 | ||
| 78 | (defvar compilation-search-path '(nil) | 120 | ;;;###autoload |
| 79 | "List of directories to search for source files named in error messages. | 121 | (defvar grep-command "grep -n " |
| 80 | Elements should be directory names, not file names of directories. | 122 | "Last shell command used to do a grep search; default for next search. |
| 81 | nil as an element means to try the default directory.") | 123 | Typically \"grep -n\" or \"egrep -n\". |
| 82 | 124 | \(The \"-n\" option tells grep to output line numbers.)") | |
| 125 | |||
| 126 | (defconst compilation-enter-directory-regexp | ||
| 127 | ": Entering directory `\\\(.*\\\)'$" | ||
| 128 | "Regular expression for a line in the compilation log that | ||
| 129 | changes the current directory. This must contain one \\\(, \\\) pair | ||
| 130 | around the directory name. | ||
| 131 | |||
| 132 | The default value matches lines printed by the `-w' option of GNU Make.") | ||
| 133 | |||
| 134 | (defconst compilation-leave-directory-regexp | ||
| 135 | ": Leaving directory `\\\(.*\\\)'$" | ||
| 136 | "Regular expression for a line in the compilation log that | ||
| 137 | changes the current directory to a previous value. This may | ||
| 138 | contain one \\\(, \\\) pair around the name of the directory | ||
| 139 | being moved from. If it does not, the last directory entered | ||
| 140 | \(by a line matching `compilation-enter-directory-regexp'\) is assumed. | ||
| 141 | |||
| 142 | The default value matches lines printed by the `-w' option of GNU Make.") | ||
| 143 | |||
| 144 | (defvar compilation-directory-stack nil | ||
| 145 | "Stack of directories entered by lines matching | ||
| 146 | \`compilation-enter-directory-regexp' and not yet left by lines matching | ||
| 147 | \`compilation-leave-directory-regexp'. The head element is the directory | ||
| 148 | the compilation was started in.") | ||
| 149 | |||
| 150 | ;;;###autoload | ||
| 83 | (defun compile (command) | 151 | (defun compile (command) |
| 84 | "Compile the program including the current buffer. Default: run `make'. | 152 | "Compile the program including the current buffer. Default: run `make'. |
| 85 | Runs COMMAND, a shell command, in a separate process asynchronously | 153 | Runs COMMAND, a shell command, in a separate process asynchronously |
| 86 | with output going to the buffer `*compilation*'. | 154 | with output going to the buffer `*compilation*'. |
| 155 | |||
| 87 | You can then use the command \\[next-error] to find the next error message | 156 | You can then use the command \\[next-error] to find the next error message |
| 88 | and move to the source code that caused it. | 157 | and move to the source code that caused it. |
| 89 | 158 | ||
| 90 | To run more than one compilation at once, start one and rename the | 159 | To run more than one compilation at once, start one and rename the |
| 91 | `*compilation*' buffer to some other name. Then start the next one." | 160 | \`*compilation*' buffer to some other name with \\[rename-buffer]. |
| 161 | Then start the next one. | ||
| 162 | |||
| 163 | The name used for the buffer is actually whatever is returned by | ||
| 164 | the function in `compilation-buffer-name-function', so you can set that | ||
| 165 | to a function that generates a unique name." | ||
| 92 | (interactive (list (read-string "Compile command: " compile-command))) | 166 | (interactive (list (read-string "Compile command: " compile-command))) |
| 93 | (setq compile-command command) | 167 | (setq compile-command command) |
| 94 | (save-some-buffers nil nil) | 168 | (save-some-buffers nil nil) |
| 95 | (compile-internal compile-command "No more errors") | 169 | (compile-internal compile-command "No more errors")) |
| 96 | (and compile-window-height | ||
| 97 | (= (window-width) (screen-width)) | ||
| 98 | (enlarge-window (- (- (screen-height) (window-height)) | ||
| 99 | compile-window-height) nil))) | ||
| 100 | 170 | ||
| 171 | ;;;###autoload | ||
| 101 | (defun grep (command-args) | 172 | (defun grep (command-args) |
| 102 | "Run grep, with user-specified args, and collect output in a buffer. | 173 | "Run grep, with user-specified args, and collect output in a buffer. |
| 103 | While grep runs asynchronously, you can use the \\[next-error] command | 174 | While grep runs asynchronously, you can use the \\[next-error] command |
| 104 | to find the text that grep hits refer to. It is expected that `grep-command' | 175 | to find the text that grep hits refer to. |
| 105 | has a `-n' flag, so that line numbers are displayed for each match." | 176 | |
| 177 | The variable `grep-command' holds the last grep command run, | ||
| 178 | and is the default for future runs. The command should use the `-n' | ||
| 179 | flag, so that line numbers are displayed for each match. | ||
| 180 | What the user enters in response to the prompt for grep args is | ||
| 181 | appended to everything up to and including the `-n' in `grep-command'." | ||
| 106 | (interactive | 182 | (interactive |
| 107 | (list (read-string (concat "Run " | 183 | (list (read-string (concat "Run " |
| 108 | (substring grep-command 0 | 184 | (substring grep-command 0 |
| @@ -121,156 +197,189 @@ has a `-n' flag, so that line numbers are displayed for each match." | |||
| 121 | "No more grep hits" "grep")) | 197 | "No more grep hits" "grep")) |
| 122 | 198 | ||
| 123 | (defun compile-internal (command error-message | 199 | (defun compile-internal (command error-message |
| 124 | &optional name-of-mode parser regexp) | 200 | &optional name-of-mode parser regexp-alist |
| 201 | name-function) | ||
| 125 | "Run compilation command COMMAND (low level interface). | 202 | "Run compilation command COMMAND (low level interface). |
| 126 | ERROR-MESSAGE is a string to print if the user asks to see another error | 203 | ERROR-MESSAGE is a string to print if the user asks to see another error |
| 127 | and there are no more errors. Third argument NAME-OF-MODE is the name | 204 | and there are no more errors. Third argument NAME-OF-MODE is the name |
| 128 | to display as the major mode in the `*compilation*' buffer. | 205 | to display as the major mode in the compilation buffer. |
| 129 | 206 | ||
| 130 | Fourth arg PARSER is the error parser function (nil means the default). | 207 | Fourth arg PARSER is the error parser function (nil means the default). Fifth |
| 131 | Fifth arg REGEXP is the error message regexp to use (nil means the default). | 208 | arg REGEXP-ALIST is the error message regexp alist to use (nil means the |
| 132 | The defaults for these variables are the global values of | 209 | default). Sixth arg NAME-FUNCTION is a function called to name the buffer (nil |
| 133 | `compilation-parse-errors-hook' and `compilation-error-regexp'." | 210 | means the default). The defaults for these variables are the global values of |
| 134 | (save-excursion | 211 | \`compilation-parse-errors-function', `compilation-error-regexp-alist', and |
| 135 | (set-buffer (get-buffer-create "*compilation*")) | 212 | \`compilation-buffer-name-function', respectively." |
| 136 | (setq buffer-read-only nil) | 213 | (let (outbuf) |
| 137 | (let ((comp-proc (get-buffer-process (current-buffer)))) | ||
| 138 | (if comp-proc | ||
| 139 | (if (or (not (eq (process-status comp-proc) 'run)) | ||
| 140 | (yes-or-no-p "A compilation process is running; kill it? ")) | ||
| 141 | (condition-case () | ||
| 142 | (progn | ||
| 143 | (interrupt-process comp-proc) | ||
| 144 | (sit-for 1) | ||
| 145 | (delete-process comp-proc)) | ||
| 146 | (error nil)) | ||
| 147 | (error "Cannot have two processes in `*compilation*' at once")))) | ||
| 148 | ;; In case *compilation* is current buffer, | ||
| 149 | ;; make sure we get the global values of compilation-error-regexp, etc. | ||
| 150 | (kill-all-local-variables)) | ||
| 151 | (compilation-forget-errors) | ||
| 152 | (start-process-shell-command "compilation" "*compilation*" command) | ||
| 153 | (with-output-to-temp-buffer "*compilation*" | ||
| 154 | (princ "cd ") | ||
| 155 | (princ default-directory) | ||
| 156 | (terpri) | ||
| 157 | (princ command) | ||
| 158 | (terpri)) | ||
| 159 | (let* ((regexp (or regexp compilation-error-regexp)) | ||
| 160 | (parser (or parser compilation-parse-errors-hook)) | ||
| 161 | (thisdir default-directory) | ||
| 162 | (outbuf (get-buffer "*compilation*")) | ||
| 163 | (outwin (get-buffer-window outbuf))) | ||
| 164 | (if (eq outbuf (current-buffer)) | ||
| 165 | (goto-char (point-max))) | ||
| 166 | (set-process-sentinel (get-buffer-process outbuf) | ||
| 167 | 'compilation-sentinel) | ||
| 168 | (save-excursion | 214 | (save-excursion |
| 215 | (or name-of-mode | ||
| 216 | (setq name-of-mode "Compilation")) | ||
| 217 | (setq outbuf | ||
| 218 | (get-buffer-create | ||
| 219 | (funcall (or name-function compilation-buffer-name-function | ||
| 220 | (function (lambda (mode) | ||
| 221 | (concat "*" (downcase mode) "*")))) | ||
| 222 | name-of-mode))) | ||
| 223 | (set-buffer outbuf) | ||
| 224 | (let ((comp-proc (get-buffer-process (current-buffer)))) | ||
| 225 | (if comp-proc | ||
| 226 | (if (or (not (eq (process-status comp-proc) 'run)) | ||
| 227 | (yes-or-no-p | ||
| 228 | "A compilation process is running; kill it? ")) | ||
| 229 | (condition-case () | ||
| 230 | (progn | ||
| 231 | (interrupt-process comp-proc) | ||
| 232 | (sit-for 1) | ||
| 233 | (delete-process comp-proc)) | ||
| 234 | (error nil)) | ||
| 235 | (error "Cannot have two processes in `%s' at once" | ||
| 236 | (buffer-name)) | ||
| 237 | ))) | ||
| 238 | ;; In case the compilation buffer is current, make sure we get the global | ||
| 239 | ;; values of compilation-error-regexp-alist, etc. | ||
| 240 | (kill-all-local-variables)) | ||
| 241 | (let ((regexp-alist (or regexp-alist compilation-error-regexp-alist)) | ||
| 242 | (parser (or parser compilation-parse-errors-function)) | ||
| 243 | (thisdir default-directory) | ||
| 244 | outwin) | ||
| 245 | (save-excursion | ||
| 246 | ;; Clear out the compilation buffer and make it writable. | ||
| 247 | ;; Change its default-directory to the directory where the compilation | ||
| 248 | ;; will happen, and insert a `cd' command to indicate this. | ||
| 249 | (set-buffer outbuf) | ||
| 250 | (setq buffer-read-only nil) | ||
| 251 | (erase-buffer) | ||
| 252 | (setq default-directory thisdir) | ||
| 253 | (insert "cd " thisdir "\n" command "\n") | ||
| 254 | (set-buffer-modified-p nil)) | ||
| 255 | ;; If we're already in the compilation buffer, go to the end | ||
| 256 | ;; of the buffer, so point will track the compilation output. | ||
| 257 | (if (eq outbuf (current-buffer)) | ||
| 258 | (goto-char (point-max))) | ||
| 259 | ;; Pop up the compilation buffer. | ||
| 260 | (setq outwin (display-buffer outbuf)) | ||
| 169 | (set-buffer outbuf) | 261 | (set-buffer outbuf) |
| 170 | (if (or (eq compilation-error-buffer outbuf) | ||
| 171 | (eq compilation-error-list t) | ||
| 172 | (and (null compilation-error-list) | ||
| 173 | (not (and (get-buffer-process compilation-error-buffer) | ||
| 174 | (eq (process-status compilation-error-buffer) | ||
| 175 | 'run))))) | ||
| 176 | (setq compilation-error-list t | ||
| 177 | compilation-error-buffer outbuf)) | ||
| 178 | (setq default-directory thisdir) | ||
| 179 | (compilation-mode) | 262 | (compilation-mode) |
| 263 | (set (make-local-variable 'compilation-parse-errors-function) parser) | ||
| 264 | (set (make-local-variable 'compilation-error-message) error-message) | ||
| 265 | (set (make-local-variable 'compilation-error-regexp-alist) regexp-alist) | ||
| 266 | (setq default-directory thisdir | ||
| 267 | compilation-directory-stack (list default-directory)) | ||
| 180 | (set-window-start outwin (point-min)) | 268 | (set-window-start outwin (point-min)) |
| 181 | (setq mode-name (or name-of-mode "Compilation")) | 269 | (setq mode-name name-of-mode) |
| 182 | (setq buffer-read-only t) | ||
| 183 | (or (eq outwin (selected-window)) | 270 | (or (eq outwin (selected-window)) |
| 184 | (set-window-point outwin (point-min)))))) | 271 | (set-window-point outwin (point-min))) |
| 272 | (and compilation-window-height | ||
| 273 | (= (window-width outwin) (screen-width)) | ||
| 274 | (let ((w (selected-window))) | ||
| 275 | (unwind-protect | ||
| 276 | (progn | ||
| 277 | (select-window outwin) | ||
| 278 | (enlarge-window (- compilation-window-height | ||
| 279 | (window-height)))) | ||
| 280 | (select-window w)))) | ||
| 281 | ;; Start the compilation. | ||
| 282 | (start-process-shell-command (downcase mode-name) outbuf command) | ||
| 283 | (set-process-sentinel (get-buffer-process outbuf) | ||
| 284 | 'compilation-sentinel)) | ||
| 285 | ;; Make it so the next C-x ` will use this buffer. | ||
| 286 | (setq compilation-last-buffer outbuf))) | ||
| 185 | 287 | ||
| 186 | (defvar compilation-mode-map | 288 | (defvar compilation-mode-map |
| 187 | (let ((map (make-sparse-keymap))) | 289 | (let ((map (make-sparse-keymap))) |
| 188 | (define-key map "\C-c\C-c" 'compile-goto-error) | 290 | (define-key map "\C-c\C-c" 'compile-goto-error) |
| 291 | (define-key map "\C-c\C-k" 'kill-compilation) | ||
| 189 | map) | 292 | map) |
| 190 | "Keymap for compilation log buffers.") | 293 | "Keymap for compilation log buffers.") |
| 191 | 294 | ||
| 192 | (defun compilation-mode () | 295 | (defun compilation-mode () |
| 193 | "Major mode for compilation log buffers. | 296 | "Major mode for compilation log buffers. |
| 194 | \\<compilation-mode-map>To visit the source for a line-numbered error, | 297 | \\<compilation-mode-map>To visit the source for a line-numbered error, |
| 195 | move point to the error message line and type \\[compile-goto-error]." | 298 | move point to the error message line and type \\[compile-goto-error]. |
| 299 | To kill the compilation, type \\[kill-compilation]." | ||
| 196 | (interactive) | 300 | (interactive) |
| 197 | (fundamental-mode) | 301 | (fundamental-mode) |
| 198 | (use-local-map compilation-mode-map) | 302 | (use-local-map compilation-mode-map) |
| 199 | (make-local-variable 'compilation-parse-errors-hook) | ||
| 200 | (setq compilation-parse-errors-hook parser) | ||
| 201 | (make-local-variable 'compilation-error-message) | ||
| 202 | (setq compilation-error-message error-message) | ||
| 203 | (make-local-variable 'compilation-error-regexp) | ||
| 204 | (setq compilation-error-regexp regexp) | ||
| 205 | (buffer-disable-undo (current-buffer)) | 303 | (buffer-disable-undo (current-buffer)) |
| 206 | (setq major-mode 'compilation-mode) | 304 | (setq major-mode 'compilation-mode) |
| 207 | (setq mode-name "Compilation") | 305 | (setq mode-name "Compilation") |
| 208 | ;; Make log buffer's mode line show process state | 306 | ;; Make buffer's mode line show process state |
| 209 | (setq mode-line-process '(": %s"))) | 307 | (setq mode-line-process '(": %s")) |
| 308 | (set (make-local-variable 'compilation-error-list) nil) | ||
| 309 | (set (make-local-variable 'compilation-old-error-list) nil) | ||
| 310 | (set (make-local-variable 'compilation-parsing-end) 1) | ||
| 311 | (set (make-local-variable 'compilation-directory-stack) nil) | ||
| 312 | (setq compilation-last-buffer (current-buffer))) | ||
| 210 | 313 | ||
| 211 | ;; Called when compilation process changes state. | 314 | ;; Called when compilation process changes state. |
| 212 | |||
| 213 | (defun compilation-sentinel (proc msg) | 315 | (defun compilation-sentinel (proc msg) |
| 214 | (cond ((null (buffer-name (process-buffer proc))) | 316 | "Sentinel for compilation buffers." |
| 215 | ;; buffer killed | 317 | (let ((buffer (process-buffer proc))) |
| 216 | (set-process-buffer proc nil)) | 318 | (cond ((null (buffer-name buffer)) |
| 217 | ((memq (process-status proc) '(signal exit)) | 319 | ;; buffer killed |
| 218 | (let* ((obuf (current-buffer)) | 320 | (set-process-buffer proc nil)) |
| 219 | omax opoint) | 321 | ((memq (process-status proc) '(signal exit)) |
| 220 | ;; save-excursion isn't the right thing if | 322 | (let ((obuf (current-buffer)) |
| 221 | ;; process-buffer is current-buffer | 323 | omax opoint) |
| 222 | (unwind-protect | 324 | ;; save-excursion isn't the right thing if |
| 223 | (progn | 325 | ;; process-buffer is current-buffer |
| 224 | ;; Write something in *compilation* and hack its mode line, | 326 | (unwind-protect |
| 225 | (set-buffer (process-buffer proc)) | 327 | (progn |
| 226 | (setq omax (point-max) opoint (point)) | 328 | ;; Write something in the compilation buffer |
| 227 | (goto-char (point-max)) | 329 | ;; and hack its mode line. |
| 228 | (insert ?\n mode-name " " msg) | 330 | (set-buffer buffer) |
| 229 | (forward-char -1) | 331 | (setq omax (point-max) |
| 230 | (insert " at " (substring (current-time-string) 0 19)) | 332 | opoint (point)) |
| 231 | (forward-char 1) | 333 | (goto-char omax) |
| 232 | (setq mode-line-process | 334 | (insert ?\n mode-name " " msg) |
| 233 | (concat ": " | 335 | (forward-char -1) |
| 234 | (symbol-name (process-status proc)))) | 336 | (insert " at " (substring (current-time-string) 0 19)) |
| 235 | ;; If buffer and mode line will show that the process | 337 | (forward-char 1) |
| 236 | ;; is dead, we can delete it now. Otherwise it | 338 | (setq mode-line-process |
| 237 | ;; will stay around until M-x list-processes. | 339 | (concat ": " |
| 238 | (delete-process proc)) | 340 | (symbol-name (process-status proc)))) |
| 239 | ;; Force mode line redisplay soon | 341 | ;; Since the buffer and mode line will show that the |
| 240 | (set-buffer-modified-p (buffer-modified-p))) | 342 | ;; process is dead, we can delete it now. Otherwise it |
| 241 | (if (and opoint (< opoint omax)) | 343 | ;; will stay around until M-x list-processes. |
| 242 | (goto-char opoint)) | 344 | (delete-process proc)) |
| 243 | (set-buffer obuf))))) | 345 | ;; Force mode line redisplay soon. |
| 346 | (set-buffer-modified-p (buffer-modified-p))) | ||
| 347 | (if (and opoint (< opoint omax)) | ||
| 348 | (goto-char opoint)) | ||
| 349 | (set-buffer obuf) | ||
| 350 | (if compilation-finish-function | ||
| 351 | (funcall compilation-finish-function buffer msg)) | ||
| 352 | )) | ||
| 353 | ))) | ||
| 244 | 354 | ||
| 245 | (defun kill-compilation () | 355 | (defun kill-compilation () |
| 246 | "Kill the process made by the \\[compile] command." | 356 | "Kill the process made by the \\[compile] command." |
| 247 | (interactive) | 357 | (interactive) |
| 248 | (let ((buffer | 358 | (let ((buffer (compilation-find-buffer))) |
| 249 | (if (assq 'compilation-parse-errors-hook (buffer-local-variables)) | ||
| 250 | (current-buffer) | ||
| 251 | (get-buffer "*compilation*")))) | ||
| 252 | (if (get-buffer-process buffer) | 359 | (if (get-buffer-process buffer) |
| 253 | (interrupt-process (get-buffer-process buffer))))) | 360 | (interrupt-process (get-buffer-process buffer)) |
| 361 | (error "The compilation process is not running.")))) | ||
| 362 | |||
| 254 | 363 | ||
| 255 | ;; Reparse errors or parse more/new errors, if appropriate. | 364 | ;; Parse any new errors in the compilation buffer, |
| 365 | ;; or reparse from the beginning if the user has asked for that. | ||
| 256 | (defun compile-reinitialize-errors (argp) | 366 | (defun compile-reinitialize-errors (argp) |
| 257 | ;; If we are out of errors, or if user says "reparse", | 367 | (save-excursion |
| 258 | ;; or if we are in a different buffer from the known errors, | 368 | (set-buffer compilation-last-buffer) |
| 259 | ;; discard the info we have, to force reparsing. | 369 | ;; If we are out of errors, or if user says "reparse", |
| 260 | (if (or (eq compilation-error-list t) | 370 | ;; discard the info we have, to force reparsing. |
| 261 | (consp argp) | 371 | (if (or (eq compilation-error-list t) |
| 262 | (if (assq 'compilation-parse-errors-hook (buffer-local-variables)) | 372 | (consp argp)) |
| 263 | (not (eq compilation-error-buffer | 373 | (progn (compilation-forget-errors) |
| 264 | (setq compilation-error-buffer (current-buffer)))))) | 374 | (setq compilation-parsing-end 1))) |
| 265 | (progn (compilation-forget-errors) | 375 | (if compilation-error-list |
| 266 | (setq compilation-parsing-end 1))) | 376 | ;; Since compilation-error-list is non-nil, it points to a specific |
| 267 | (if compilation-error-list | 377 | ;; error the user wanted. So don't move it around. |
| 268 | nil | 378 | nil |
| 269 | (save-excursion | 379 | (switch-to-buffer compilation-last-buffer) |
| 270 | (switch-to-buffer compilation-error-buffer) | ||
| 271 | (set-buffer-modified-p nil) | 380 | (set-buffer-modified-p nil) |
| 272 | (let ((at-start (= compilation-parsing-end 1))) | 381 | (let ((at-start (= compilation-parsing-end 1))) |
| 273 | (run-hooks 'compilation-parse-errors-hook) | 382 | (funcall compilation-parse-errors-function) |
| 274 | ;; Remember the entire list for compilation-forget-errors. | 383 | ;; Remember the entire list for compilation-forget-errors. |
| 275 | ;; If this is an incremental parse, append to previous list. | 384 | ;; If this is an incremental parse, append to previous list. |
| 276 | (if at-start | 385 | (if at-start |
| @@ -284,11 +393,23 @@ Use this command in a compilation log buffer. | |||
| 284 | C-u as a prefix arg means to reparse the buffer's error messages first; | 393 | C-u as a prefix arg means to reparse the buffer's error messages first; |
| 285 | other kinds of prefix arguments are ignored." | 394 | other kinds of prefix arguments are ignored." |
| 286 | (interactive "P") | 395 | (interactive "P") |
| 396 | (or (compilation-buffer-p (current-buffer)) | ||
| 397 | (error "Not in a compilation buffer.")) | ||
| 398 | (setq compilation-last-buffer (current-buffer)) | ||
| 287 | (compile-reinitialize-errors argp) | 399 | (compile-reinitialize-errors argp) |
| 288 | (save-excursion | 400 | (save-excursion |
| 289 | (beginning-of-line) | 401 | (beginning-of-line) |
| 402 | ;; Move compilation-error-list to the elt of | ||
| 403 | ;; compilation-old-error-list whose car is the error we want. | ||
| 290 | (setq compilation-error-list | 404 | (setq compilation-error-list |
| 291 | (memq (assoc (point-marker) compilation-old-error-list) | 405 | (memq (let (elt) |
| 406 | (while (not (or (setq elt (assoc (point-marker) | ||
| 407 | compilation-old-error-list)) | ||
| 408 | (eobp))) | ||
| 409 | ;; This line doesn't contain an error. | ||
| 410 | ;; Move forward a line and look again. | ||
| 411 | (forward-line 1)) | ||
| 412 | elt) | ||
| 292 | compilation-old-error-list))) | 413 | compilation-old-error-list))) |
| 293 | ;; Move to another window, so that next-error's window changes | 414 | ;; Move to another window, so that next-error's window changes |
| 294 | ;; result in the desired setup. | 415 | ;; result in the desired setup. |
| @@ -296,6 +417,28 @@ other kinds of prefix arguments are ignored." | |||
| 296 | (other-window -1)) | 417 | (other-window -1)) |
| 297 | (next-error 1)) | 418 | (next-error 1)) |
| 298 | 419 | ||
| 420 | (defun compilation-buffer-p (buffer) | ||
| 421 | (assq 'compilation-error-list (buffer-local-variables buffer))) | ||
| 422 | |||
| 423 | ;; Return a compilation buffer. | ||
| 424 | ;; If the current buffer is a compilation buffer, return it. | ||
| 425 | ;; If compilation-last-buffer is set to a live buffer, use that. | ||
| 426 | ;; Otherwise, look for a compilation buffer and signal an error | ||
| 427 | ;; if there are none. | ||
| 428 | (defun compilation-find-buffer () | ||
| 429 | (if (compilation-buffer-p (current-buffer)) | ||
| 430 | ;; The current buffer is a compilation buffer. | ||
| 431 | (current-buffer) | ||
| 432 | (if (and compilation-last-buffer (buffer-name compilation-last-buffer)) | ||
| 433 | compilation-last-buffer | ||
| 434 | (let ((buffers (buffer-list))) | ||
| 435 | (while (and buffers (not (compilation-buffer-p (car buffers)))) | ||
| 436 | (setq buffers (cdr buffers))) | ||
| 437 | (if buffers | ||
| 438 | (car buffers) | ||
| 439 | (error "No compilation started!")))))) | ||
| 440 | |||
| 441 | ;;;###autoload | ||
| 299 | (defun next-error (&optional argp) | 442 | (defun next-error (&optional argp) |
| 300 | "Visit next compilation error message and corresponding source code. | 443 | "Visit next compilation error message and corresponding source code. |
| 301 | This operates on the output from the \\[compile] command. | 444 | This operates on the output from the \\[compile] command. |
| @@ -314,165 +457,326 @@ output buffer, you stay with that compilation output buffer. | |||
| 314 | Use \\[next-error] in a compilation output buffer to switch to | 457 | Use \\[next-error] in a compilation output buffer to switch to |
| 315 | processing errors from that compilation. | 458 | processing errors from that compilation. |
| 316 | 459 | ||
| 317 | See variables `compilation-parse-errors-hook' and `compilation-error-regexp' | 460 | See variables `compilation-parse-errors-function' and |
| 318 | for customization ideas. When we return, `compilation-last-error' | 461 | \`compilation-error-regexp-alist' for customization ideas." |
| 319 | points to the error message and the erroneous code." | ||
| 320 | (interactive "P") | 462 | (interactive "P") |
| 463 | (setq compilation-last-buffer (compilation-find-buffer)) | ||
| 321 | (compile-reinitialize-errors argp) | 464 | (compile-reinitialize-errors argp) |
| 465 | ;; Make ARGP nil if the prefix arg was just C-u, | ||
| 466 | ;; since that means to reparse the errors, which the | ||
| 467 | ;; compile-reinitialize-errors call just did. | ||
| 468 | ;; Now we are only interested in a numeric prefix arg. | ||
| 322 | (if (consp argp) | 469 | (if (consp argp) |
| 323 | (setq argp nil)) | 470 | (setq argp nil)) |
| 324 | (let* ((next-errors (nthcdr (+ (- (length compilation-old-error-list) | 471 | (let (next-errors next-error) |
| 325 | (length compilation-error-list) | 472 | (save-excursion |
| 326 | 1) | 473 | (set-buffer compilation-last-buffer) |
| 327 | (prefix-numeric-value argp)) | 474 | (setq next-errors (nthcdr (+ (- (length compilation-old-error-list) |
| 328 | compilation-old-error-list)) | 475 | (length compilation-error-list) |
| 329 | (next-error (car next-errors))) | 476 | 1) |
| 330 | (if (null next-error) | 477 | (prefix-numeric-value argp)) |
| 331 | (save-excursion | 478 | compilation-old-error-list) |
| 332 | (if argp (if (> (prefix-numeric-value argp) 0) | 479 | next-error (car next-errors)) |
| 333 | (error "Moved past last error") | 480 | (while |
| 334 | (error "Moved back past first error"))) | ||
| 335 | (set-buffer compilation-error-buffer) | ||
| 336 | (compilation-forget-errors) | ||
| 337 | (error (concat compilation-error-message | ||
| 338 | (if (and (get-buffer-process (current-buffer)) | ||
| 339 | (eq (process-status (current-buffer)) | ||
| 340 | 'run)) | ||
| 341 | " yet" ""))))) | ||
| 342 | (setq compilation-error-list (cdr next-errors)) | ||
| 343 | ;; If we have an error to go to, go there. | ||
| 344 | (if (null (car (cdr next-error))) | ||
| 345 | nil | ||
| 346 | (switch-to-buffer (marker-buffer (car (cdr next-error)))) | ||
| 347 | (goto-char (car (cdr next-error))) | ||
| 348 | ;; If narrowing got in the way of going to the right place, widen. | ||
| 349 | (or (= (point) (car (cdr next-error))) | ||
| 350 | (progn | 481 | (progn |
| 351 | (widen) | 482 | (if (null next-error) |
| 352 | (goto-char (car (cdr next-error)))))) | 483 | (progn |
| 484 | (if argp (if (> (prefix-numeric-value argp) 0) | ||
| 485 | (error "Moved past last error") | ||
| 486 | (error "Moved back past first error"))) | ||
| 487 | (compilation-forget-errors) | ||
| 488 | (error (concat compilation-error-message | ||
| 489 | (and (get-buffer-process (current-buffer)) | ||
| 490 | (eq (process-status | ||
| 491 | (get-buffer-process | ||
| 492 | (current-buffer))) | ||
| 493 | 'run) | ||
| 494 | " yet")))) | ||
| 495 | (setq compilation-error-list (cdr next-errors)) | ||
| 496 | (if (null (cdr next-error)) | ||
| 497 | ;; This error is boring. Go to the next. | ||
| 498 | t | ||
| 499 | (or (markerp (cdr next-error)) | ||
| 500 | ;; This error has a filename/lineno pair. | ||
| 501 | ;; Find the file and turn it into a marker. | ||
| 502 | (let* ((fileinfo (car (cdr next-error))) | ||
| 503 | (buffer (compilation-find-file (cdr fileinfo) | ||
| 504 | (car fileinfo) | ||
| 505 | (car next-error)))) | ||
| 506 | (if (null buffer) | ||
| 507 | ;; We can't find this error's file. | ||
| 508 | ;; Remove all errors in the same file. | ||
| 509 | (progn | ||
| 510 | (setq next-errors compilation-old-error-list) | ||
| 511 | (while next-errors | ||
| 512 | (and (consp (cdr (car next-errors))) | ||
| 513 | (equal (car (cdr (car next-errors))) | ||
| 514 | fileinfo) | ||
| 515 | (progn | ||
| 516 | (set-marker (car (car next-errors)) nil) | ||
| 517 | (setcdr (car next-errors) nil))) | ||
| 518 | (setq next-errors (cdr next-errors))) | ||
| 519 | ;; Look for the next error. | ||
| 520 | t) | ||
| 521 | ;; We found the file. Get a marker for this error. | ||
| 522 | (set-buffer buffer) | ||
| 523 | (save-excursion | ||
| 524 | (save-restriction | ||
| 525 | (widen) | ||
| 526 | (let ((errors compilation-old-error-list) | ||
| 527 | (last-line (cdr (cdr next-error)))) | ||
| 528 | (goto-line last-line) | ||
| 529 | (beginning-of-line) | ||
| 530 | (setcdr next-error (point-marker)) | ||
| 531 | ;; Make all the other error messages referring | ||
| 532 | ;; to the same file have markers into the buffer. | ||
| 533 | (while errors | ||
| 534 | (and (consp (cdr (car errors))) | ||
| 535 | (equal (car (cdr (car errors))) fileinfo) | ||
| 536 | (let ((this (cdr (cdr (car errors)))) | ||
| 537 | (lines (- (cdr (cdr (car errors))) | ||
| 538 | last-line))) | ||
| 539 | (if (eq selective-display t) | ||
| 540 | (if (< lines 0) | ||
| 541 | (re-search-backward "[\n\C-m]" | ||
| 542 | nil 'end | ||
| 543 | (- lines)) | ||
| 544 | (re-search-forward "[\n\C-m]" | ||
| 545 | nil 'end | ||
| 546 | lines)) | ||
| 547 | (forward-line lines)) | ||
| 548 | (setq last-line this) | ||
| 549 | (setcdr (car errors) (point-marker)))) | ||
| 550 | (setq errors (cdr errors))))))))) | ||
| 551 | ;; If we didn't get a marker for this error, | ||
| 552 | ;; go on to the next one. | ||
| 553 | (not (markerp (cdr next-error)))))) | ||
| 554 | (setq next-errors compilation-error-list | ||
| 555 | next-error (car next-errors)))) | ||
| 556 | |||
| 557 | ;; Skip over multiple error messages for the same source location, | ||
| 558 | ;; so the next C-x ` won't go to an error in the same place. | ||
| 559 | (while (and compilation-error-list | ||
| 560 | (equal (cdr (car compilation-error-list)) (cdr next-error))) | ||
| 561 | (setq compilation-error-list (cdr compilation-error-list))) | ||
| 562 | |||
| 563 | ;; We now have a marker for the position of the error. | ||
| 564 | (switch-to-buffer (marker-buffer (cdr next-error))) | ||
| 565 | (goto-char (cdr next-error)) | ||
| 566 | ;; If narrowing got in the way of | ||
| 567 | ;; going to the right place, widen. | ||
| 568 | (or (= (point) (marker-position (cdr next-error))) | ||
| 569 | (progn | ||
| 570 | (widen) | ||
| 571 | (goto-char (cdr next-error)))) | ||
| 572 | |||
| 353 | ;; Show compilation buffer in other window, scrolled to this error. | 573 | ;; Show compilation buffer in other window, scrolled to this error. |
| 354 | (let* ((pop-up-windows t) | 574 | (let* ((pop-up-windows t) |
| 355 | (w (display-buffer (marker-buffer (car next-error))))) | 575 | (w (display-buffer (marker-buffer (car next-error))))) |
| 356 | (set-window-point w (car next-error)) | 576 | (set-window-point w (car next-error)) |
| 357 | (set-window-start w (car next-error))) | 577 | (set-window-start w (car next-error))))) |
| 358 | (setq compilation-last-error next-error))) | 578 | |
| 359 | 579 | ;;;###autoload | |
| 360 | ;; Set compilation-error-list to nil, and | 580 | (define-key ctl-x-map "`" 'next-error) |
| 361 | ;; unchain the markers that point to the error messages and their text, | 581 | |
| 362 | ;; so that they no longer slow down gap motion. | 582 | ;; Find a buffer for file FILENAME. |
| 363 | ;; This would happen anyway at the next garbage collection, | 583 | ;; Search the directories in compilation-search-path. |
| 364 | ;; but it is better to do it right away. | 584 | ;; A nil in compilation-search-path means to try the |
| 585 | ;; current directory, which is passed in DIR. | ||
| 586 | ;; If FILENAME is not found at all, ask the user where to find it. | ||
| 587 | ;; Pop up the buffer containing MARKER and scroll to MARKER if we ask the user. | ||
| 588 | (defun compilation-find-file (filename dir marker) | ||
| 589 | (let ((dirs compilation-search-path) | ||
| 590 | result name) | ||
| 591 | (while (and dirs (null result)) | ||
| 592 | (setq name (expand-file-name filename (or (car dirs) dir)) | ||
| 593 | result (and (file-exists-p name) | ||
| 594 | (find-file-noselect name)) | ||
| 595 | dirs (cdr dirs))) | ||
| 596 | (or result | ||
| 597 | ;; The file doesn't exist. | ||
| 598 | ;; Ask the user where to find it. | ||
| 599 | ;; If he hits C-g, then the next time he does | ||
| 600 | ;; next-error, he'll skip past it. | ||
| 601 | (progn | ||
| 602 | (let* ((pop-up-windows t) | ||
| 603 | (w (display-buffer (marker-buffer marker)))) | ||
| 604 | (set-window-point w marker) | ||
| 605 | (set-window-start w marker)) | ||
| 606 | (setq name | ||
| 607 | (expand-file-name | ||
| 608 | (read-file-name | ||
| 609 | (format "Find this error in: (default %s) " | ||
| 610 | filename) dir filename t))) | ||
| 611 | (if (file-directory-p name) | ||
| 612 | (setq name (concat (file-name-as-directory name) filename))) | ||
| 613 | (if (file-exists-p name) | ||
| 614 | (find-file-noselect name)))))) | ||
| 615 | |||
| 616 | ;; Set compilation-error-list to nil, and unchain the markers that point to the | ||
| 617 | ;; error messages and their text, so that they no longer slow down gap motion. | ||
| 618 | ;; This would happen anyway at the next garbage collection, but it is better to | ||
| 619 | ;; do it the right away. | ||
| 365 | (defun compilation-forget-errors () | 620 | (defun compilation-forget-errors () |
| 366 | (while compilation-old-error-list | 621 | (while compilation-old-error-list |
| 367 | (let ((next-error (car compilation-old-error-list))) | 622 | (let ((next-error (car compilation-old-error-list))) |
| 368 | (set-marker (car next-error) nil) | 623 | (set-marker (car next-error) nil) |
| 369 | (if (car (cdr next-error)) | 624 | (if (markerp (cdr next-error)) |
| 370 | (set-marker (car (cdr next-error)) nil))) | 625 | (set-marker (cdr next-error) nil))) |
| 371 | (setq compilation-old-error-list (cdr compilation-old-error-list))) | 626 | (setq compilation-old-error-list (cdr compilation-old-error-list))) |
| 372 | (setq compilation-error-list nil)) | 627 | (setq compilation-error-list nil) |
| 628 | (while (cdr compilation-directory-stack) | ||
| 629 | (setq compilation-directory-stack (cdr compilation-directory-stack)))) | ||
| 630 | |||
| 631 | |||
| 632 | (defun count-regexp-groupings (regexp) | ||
| 633 | "Return the number of \\( ... \\) groupings in REGEXP (a string)." | ||
| 634 | (let ((groupings 0) | ||
| 635 | (len (length regexp)) | ||
| 636 | (i 0) | ||
| 637 | c) | ||
| 638 | (while (< i len) | ||
| 639 | (setq c (aref regexp i) | ||
| 640 | i (1+ i)) | ||
| 641 | (cond ((= c ?\[) | ||
| 642 | ;; Find the end of this [...]. | ||
| 643 | (while (and (< i len) | ||
| 644 | (not (= (aref regexp i) ?\]))) | ||
| 645 | (setq i (1+ i)))) | ||
| 646 | ((= c ?\\) | ||
| 647 | (if (< i len) | ||
| 648 | (progn | ||
| 649 | (setq c (aref regexp i) | ||
| 650 | i (1+ i)) | ||
| 651 | (if (= c ?\)) | ||
| 652 | ;; We found the end of a grouping, | ||
| 653 | ;; so bump our counter. | ||
| 654 | (setq groupings (1+ groupings)))))))) | ||
| 655 | groupings)) | ||
| 373 | 656 | ||
| 374 | (defun compilation-parse-errors () | 657 | (defun compilation-parse-errors () |
| 375 | "Parse the current buffer as grep, cc or lint error messages. | 658 | "Parse the current buffer as grep, cc or lint error messages. |
| 376 | See variable `compilation-parse-errors-hook' for the interface it uses." | 659 | See variable `compilation-parse-errors-function' for the interface it uses." |
| 377 | (setq compilation-error-list nil) | 660 | (setq compilation-error-list nil) |
| 378 | (message "Parsing error messages...") | 661 | (message "Parsing error messages...") |
| 379 | (let (text-buffer | 662 | (let (text-buffer |
| 380 | last-filename last-linenum) | 663 | regexp enter-group leave-group error-group |
| 664 | alist subexpr error-regexp-groups) | ||
| 665 | |||
| 381 | ;; Don't reparse messages already seen at last parse. | 666 | ;; Don't reparse messages already seen at last parse. |
| 382 | (goto-char compilation-parsing-end) | 667 | (goto-char compilation-parsing-end) |
| 383 | ;; Don't parse the first two lines as error messages. | 668 | ;; Don't parse the first two lines as error messages. |
| 384 | ;; This matters for grep. | 669 | ;; This matters for grep. |
| 385 | (if (bobp) | 670 | (if (bobp) |
| 386 | (forward-line 2)) | 671 | (forward-line 2)) |
| 387 | (while (re-search-forward compilation-error-regexp nil t) | 672 | |
| 388 | (let (linenum filename | 673 | ;; Compile all the regexps we want to search for into one. |
| 389 | error-marker text-marker) | 674 | (setq regexp (concat "\\(" compilation-enter-directory-regexp "\\)\\|" |
| 390 | ;; Extract file name and line number from error message. | 675 | "\\(" compilation-leave-directory-regexp "\\)\\|" |
| 391 | (save-restriction | 676 | "\\(" (mapconcat (function |
| 392 | (narrow-to-region (match-beginning 0) (match-end 0)) | 677 | (lambda (elt) |
| 393 | (goto-char (point-max)) | 678 | (concat "\\(" (car elt) "\\)"))) |
| 394 | (skip-chars-backward "[0-9]") | 679 | compilation-error-regexp-alist |
| 395 | ;; If it's a lint message, use the last file(linenum) on the line. | 680 | "\\|") "\\)")) |
| 396 | ;; Normally we use the first on the line. | 681 | |
| 397 | (if (= (preceding-char) ?\() | 682 | ;; Find out how many \(...\) groupings are in each of the regexps, and set |
| 398 | (progn | 683 | ;; *-GROUP to the grouping containing each constituent regexp (whose |
| 399 | (narrow-to-region (point-min) (1+ (buffer-size))) | 684 | ;; subgroups will come immediately thereafter) of the big regexp we have |
| 400 | (end-of-line) | 685 | ;; just constructed. |
| 401 | (re-search-backward compilation-error-regexp) | 686 | (setq enter-group 1 |
| 402 | (skip-chars-backward "^ \t\n") | 687 | leave-group (+ enter-group |
| 403 | (narrow-to-region (point) (match-end 0)) | 688 | (count-regexp-groupings |
| 404 | (goto-char (point-max)) | 689 | compilation-enter-directory-regexp) |
| 405 | (skip-chars-backward "[0-9]"))) | 690 | 1) |
| 406 | ;; Are we looking at a "filename-first" or "line-number-first" form? | 691 | error-group (+ leave-group |
| 407 | (if (looking-at "[0-9]") | 692 | (count-regexp-groupings |
| 408 | (progn | 693 | compilation-leave-directory-regexp) |
| 409 | (setq linenum (read (current-buffer))) | 694 | 1)) |
| 410 | (goto-char (point-min))) | 695 | |
| 411 | ;; Line number at start, file name at end. | 696 | ;; Compile an alist (IDX FILE LINE), where IDX is the number of the |
| 412 | (progn | 697 | ;; subexpression for an entire error-regexp, and FILE and LINE are the |
| 413 | (goto-char (point-min)) | 698 | ;; numbers for the subexpressions giving the file name and line number. |
| 414 | (setq linenum (read (current-buffer))) | 699 | (setq alist compilation-error-regexp-alist |
| 415 | (goto-char (point-max)) | 700 | subexpr (1+ error-group)) |
| 416 | (skip-chars-backward "^ \t\n"))) | 701 | (while alist |
| 417 | (setq filename (compilation-grab-filename))) | 702 | (setq error-regexp-groups (cons (list subexpr |
| 418 | ;; Locate the erring file and line. | 703 | (+ subexpr (nth 1 (car alist))) |
| 419 | (if (and (equal filename last-filename) | 704 | (+ subexpr (nth 2 (car alist)))) |
| 420 | (= linenum last-linenum)) | 705 | error-regexp-groups)) |
| 421 | nil | 706 | (setq subexpr (+ subexpr 1 (count-regexp-groupings (car (car alist))))) |
| 422 | (beginning-of-line 1) | 707 | (setq alist (cdr alist))) |
| 423 | (setq error-marker (point-marker)) | 708 | |
| 424 | ;; text-buffer gets the buffer containing this error's file. | 709 | (while (re-search-forward regexp nil t) |
| 425 | (if (not (equal filename last-filename)) | 710 | ;; Figure out which constituent regexp matched. |
| 426 | (setq last-filename filename | 711 | (cond ((match-beginning enter-group) |
| 427 | text-buffer (compilation-find-file filename) | 712 | ;; The match was the enter-directory regexp. |
| 428 | last-linenum 0)) | 713 | (let ((dir |
| 429 | (if text-buffer | 714 | (file-name-as-directory |
| 430 | ;; Go to that buffer and find the erring line. | 715 | (expand-file-name |
| 431 | (save-excursion | 716 | (buffer-substring (match-beginning (+ enter-group 1)) |
| 432 | (set-buffer text-buffer) | 717 | (match-end (+ enter-group 1))))))) |
| 433 | (if (zerop last-linenum) | 718 | (setq compilation-directory-stack |
| 434 | (progn | 719 | (cons dir compilation-directory-stack)) |
| 435 | (goto-char 1) | 720 | (and (file-directory-p dir) |
| 436 | (setq last-linenum 1))) | 721 | (setq default-directory dir)))) |
| 437 | (forward-line (- linenum last-linenum)) | 722 | |
| 438 | (setq last-linenum linenum) | 723 | ((match-beginning leave-group) |
| 439 | (setq text-marker (point-marker)) | 724 | ;; The match was the leave-directory regexp. |
| 440 | (setq compilation-error-list | 725 | (let ((beg (match-beginning (+ leave-group 1))) |
| 441 | (cons (list error-marker text-marker) | 726 | (stack compilation-directory-stack)) |
| 442 | compilation-error-list))))) | 727 | (if beg |
| 443 | (forward-line 1))) | 728 | (let ((dir |
| 729 | (file-name-as-directory | ||
| 730 | (expand-file-name | ||
| 731 | (buffer-substring beg | ||
| 732 | (match-end (+ leave-group | ||
| 733 | 1))))))) | ||
| 734 | (while (and stack | ||
| 735 | (not (string-equal (car stack) dir))) | ||
| 736 | (setq stack (cdr stack))))) | ||
| 737 | (setq compilation-directory-stack (cdr stack)) | ||
| 738 | (setq stack (car compilation-directory-stack)) | ||
| 739 | (if stack | ||
| 740 | (setq default-directory stack)) | ||
| 741 | )) | ||
| 742 | |||
| 743 | ((match-beginning error-group) | ||
| 744 | ;; The match was the composite error regexp. | ||
| 745 | ;; Find out which individual regexp matched. | ||
| 746 | (setq alist error-regexp-groups) | ||
| 747 | (while (and alist | ||
| 748 | (null (match-beginning (car (car alist))))) | ||
| 749 | (setq alist (cdr alist))) | ||
| 750 | (if alist | ||
| 751 | (setq alist (car alist)) | ||
| 752 | (error "Impossible regexp match!")) | ||
| 753 | |||
| 754 | ;; Extract the file name and line number from the error message. | ||
| 755 | (let ((filename | ||
| 756 | (cons default-directory | ||
| 757 | (buffer-substring (match-beginning (nth 1 alist)) | ||
| 758 | (match-end (nth 1 alist))))) | ||
| 759 | (linenum (save-restriction | ||
| 760 | (narrow-to-region | ||
| 761 | (match-beginning (nth 2 alist)) | ||
| 762 | (match-end (nth 2 alist))) | ||
| 763 | (goto-char (point-min)) | ||
| 764 | (if (looking-at "[0-9]") | ||
| 765 | (read (current-buffer)))))) | ||
| 766 | ;; Locate the erring file and line. | ||
| 767 | ;; Cons a new elt onto compilation-error-list, | ||
| 768 | ;; giving a marker for the current compilation buffer | ||
| 769 | ;; location, and the file and line number of the error. | ||
| 770 | (save-excursion | ||
| 771 | (beginning-of-line 1) | ||
| 772 | (setq compilation-error-list | ||
| 773 | (cons (cons (point-marker) | ||
| 774 | (cons filename linenum)) | ||
| 775 | compilation-error-list))))) | ||
| 776 | (t | ||
| 777 | (error "Impossible regexp match!")))) | ||
| 444 | (setq compilation-parsing-end (point-max))) | 778 | (setq compilation-parsing-end (point-max))) |
| 445 | (message "Parsing error messages...done") | 779 | (message "Parsing error messages...done") |
| 446 | (setq compilation-error-list (nreverse compilation-error-list))) | 780 | (setq compilation-error-list (nreverse compilation-error-list))) |
| 447 | 781 | ||
| 448 | ;; Find or create a buffer for file FILENAME. | ||
| 449 | ;; Search the directories in compilation-search-path | ||
| 450 | ;; after trying the current directory. | ||
| 451 | (defun compilation-find-file (filename) | ||
| 452 | (let ((dirs compilation-search-path) | ||
| 453 | result) | ||
| 454 | (while (and dirs (null result)) | ||
| 455 | (let ((name (if (car dirs) | ||
| 456 | (concat (car dirs) filename) | ||
| 457 | filename))) | ||
| 458 | (setq result | ||
| 459 | (and (file-exists-p name) | ||
| 460 | (find-file-noselect name)))) | ||
| 461 | (setq dirs (cdr dirs))) | ||
| 462 | result)) | ||
| 463 | |||
| 464 | (defun compilation-grab-filename () | ||
| 465 | "Return a string which is a filename, starting at point. | ||
| 466 | Ignore quotes and parentheses around it, as well as trailing colons." | ||
| 467 | (if (eq (following-char) ?\") | ||
| 468 | (save-restriction | ||
| 469 | (narrow-to-region (point) | ||
| 470 | (progn (forward-sexp 1) (point))) | ||
| 471 | (goto-char (point-min)) | ||
| 472 | (read (current-buffer))) | ||
| 473 | (buffer-substring (point) | ||
| 474 | (progn | ||
| 475 | (skip-chars-forward "^ :,\n\t(") | ||
| 476 | (point))))) | ||
| 477 | |||
| 478 | (define-key ctl-x-map "`" 'next-error) | 782 | (define-key ctl-x-map "`" 'next-error) |