Mercurial > hg > xemacs-beta
comparison lisp/packages/compile.el @ 0:376386a54a3c r19-14
Import from CVS: tag r19-14
| author | cvs |
|---|---|
| date | Mon, 13 Aug 2007 08:45:50 +0200 |
| parents | |
| children | ac2d302a0011 |
comparison
equal
deleted
inserted
replaced
| -1:000000000000 | 0:376386a54a3c |
|---|---|
| 1 ;;; compile.el --- run compiler as inferior of Emacs, parse error messages. | |
| 2 | |
| 3 ;; Copyright (C) 1985, 86, 87, 93, 94, 1995 Free Software Foundation, Inc. | |
| 4 ;; Copyright (C) 1995 Tinker Systems and INS Engineering Corp. | |
| 5 | |
| 6 ;; Author: Roland McGrath <roland@prep.ai.mit.edu> | |
| 7 ;; Maintainer: FSF | |
| 8 ;; Keywords: tools, processes | |
| 9 | |
| 10 ;; This file is part of XEmacs. | |
| 11 | |
| 12 ;; XEmacs is free software; you can redistribute it and/or modify it | |
| 13 ;; under the terms of the GNU General Public License as published by | |
| 14 ;; the Free Software Foundation; either version 2, or (at your option) | |
| 15 ;; any later version. | |
| 16 | |
| 17 ;; XEmacs is distributed in the hope that it will be useful, but | |
| 18 ;; WITHOUT ANY WARRANTY; without even the implied warranty of | |
| 19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU | |
| 20 ;; General Public License for more details. | |
| 21 | |
| 22 ;; You should have received a copy of the GNU General Public License | |
| 23 ;; along with XEmacs; see the file COPYING. If not, write to the Free | |
| 24 ;; Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. | |
| 25 | |
| 26 ;;; Synched up with: FSF 19.30. | |
| 27 | |
| 28 ;;; Commentary: | |
| 29 | |
| 30 ;; This package provides the compile and grep facilities documented in | |
| 31 ;; the Emacs user's manual. | |
| 32 | |
| 33 ;;; Code: | |
| 34 | |
| 35 ;;;###autoload | |
| 36 (defvar compilation-mode-hook nil | |
| 37 "*List of hook functions run by `compilation-mode' (see `run-hooks').") | |
| 38 | |
| 39 ;;;###autoload | |
| 40 (defvar compilation-window-height nil | |
| 41 "*Number of lines in a compilation window. If nil, use Emacs default.") | |
| 42 | |
| 43 (defvar compilation-error-list 'invalid ; only valid buffer-local | |
| 44 "List of error message descriptors for visiting erring functions. | |
| 45 Each error descriptor is a cons (or nil). Its car is a marker pointing to | |
| 46 an error message. If its cdr is a marker, it points to the text of the | |
| 47 line the message is about. If its cdr is a cons, it is a list | |
| 48 \(\(DIRECTORY . FILE\) LINE [COLUMN]\). Or its cdr may be nil if that | |
| 49 error is not interesting. | |
| 50 | |
| 51 The value may be t instead of a list; this means that the buffer of | |
| 52 error messages should be reparsed the next time the list of errors is wanted. | |
| 53 | |
| 54 Some other commands (like `diff') use this list to control the error | |
| 55 message tracking facilites; if you change its structure, you should make | |
| 56 sure you also change those packages. Perhaps it is better not to change | |
| 57 it at all.") | |
| 58 | |
| 59 (defvar compilation-old-error-list nil | |
| 60 "Value of `compilation-error-list' after errors were parsed.") | |
| 61 | |
| 62 (defvar compilation-parse-errors-function 'compilation-parse-errors | |
| 63 "Function to call to parse error messages from a compilation. | |
| 64 It takes args LIMIT-SEARCH and FIND-AT-LEAST. | |
| 65 If LIMIT-SEARCH is non-nil, don't bother parsing past that location. | |
| 66 If FIND-AT-LEAST is non-nil, don't bother parsing after finding that | |
| 67 many new errors. | |
| 68 It should read in the source files which have errors and set | |
| 69 `compilation-error-list' to a list with an element for each error message | |
| 70 found. See that variable for more info.") | |
| 71 | |
| 72 ;;;###autoload | |
| 73 (defvar compilation-buffer-name-function nil | |
| 74 "Function to compute the name of a compilation buffer. | |
| 75 The function receives one argument, the name of the major mode of the | |
| 76 compilation buffer. It should return a string. | |
| 77 nil means compute the name with `(concat \"*\" (downcase major-mode) \"*\")'.") | |
| 78 | |
| 79 ;;;###autoload | |
| 80 (defvar compilation-finish-function nil | |
| 81 "*Function to call when a compilation process finishes. | |
| 82 It is called with two arguments: the compilation buffer, and a string | |
| 83 describing how the process finished.") | |
| 84 | |
| 85 (defvar compilation-last-buffer nil | |
| 86 "The most recent compilation buffer. | |
| 87 A buffer becomes most recent when its compilation is started | |
| 88 or when it is used with \\[next-error] or \\[compile-goto-error].") | |
| 89 | |
| 90 (defvar compilation-in-progress nil | |
| 91 "List of compilation processes now running.") | |
| 92 (or (assq 'compilation-in-progress minor-mode-alist) | |
| 93 (setq minor-mode-alist (cons '(compilation-in-progress " Compiling") | |
| 94 minor-mode-alist))) | |
| 95 | |
| 96 (defvar compilation-always-signal-completion nil | |
| 97 "Always give an audible signal upon compilation completion. | |
| 98 By default that signal is only given if the bottom of the compilation | |
| 99 buffer is not visible in its window.") | |
| 100 | |
| 101 (defvar compilation-parsing-end nil | |
| 102 "Position of end of buffer when last error messages were parsed.") | |
| 103 | |
| 104 (defvar compilation-error-message "No more errors" | |
| 105 "Message to print when no more matches are found.") | |
| 106 | |
| 107 (defvar compilation-num-errors-found) | |
| 108 | |
| 109 (defvar compilation-error-regexp-alist | |
| 110 '( | |
| 111 ;; NOTE! See also grep-regexp-alist, below. | |
| 112 | |
| 113 ;; 4.3BSD grep, cc, lint pass 1: | |
| 114 ;; /usr/src/foo/foo.c(8): warning: w may be used before set | |
| 115 ;; or GNU utilities: | |
| 116 ;; foo.c:8: error message | |
| 117 ;; or HP-UX 7.0 fc: | |
| 118 ;; foo.f :16 some horrible error message | |
| 119 ;; or GNU utilities with column (GNAT 1.82): | |
| 120 ;; foo.adb:2:1: Unit name does not match file name | |
| 121 ;; | |
| 122 ;; We'll insist that the number be followed by a colon or closing | |
| 123 ;; paren, because otherwise this matches just about anything | |
| 124 ;; containing a number with spaces around it. | |
| 125 ("\n\ | |
| 126 \\([^:( \t\n]+\\)[:(][ \t]*\\([0-9]+\\)\\([) \t]\\|\ | |
| 127 :\\([^0-9\n]\\|\\([0-9]+:\\)\\)\\)" 1 2 5) | |
| 128 | |
| 129 ;; Borland C++: | |
| 130 ;; Error ping.c 15: Unable to open include file 'sys/types.h' | |
| 131 ;; Warning ping.c 68: Call to function 'func' with no prototype | |
| 132 ("\n\\(Error\\|Warning\\) \\([^:( \t\n]+\\)\ | |
| 133 \\([0-9]+\\)\\([) \t]\\|:[^0-9\n]\\)" 2 3) | |
| 134 | |
| 135 ;; 4.3BSD lint pass 2 | |
| 136 ;; strcmp: variable # of args. llib-lc(359) :: /usr/src/foo/foo.c(8) | |
| 137 ("[ \t:]\\([^:( \t\n]+\\)[:(](+[ \t]*\\([0-9]+\\))[:) \t]*$" 1 2) | |
| 138 | |
| 139 ;; 4.3BSD lint pass 3 | |
| 140 ;; bloofle defined( /users/wolfgang/foo.c(4) ), but never used | |
| 141 ;; This used to be | |
| 142 ;; ("[ \t(]+\\([^:( \t\n]+\\)[:( \t]+\\([0-9]+\\)[:) \t]+" 1 2) | |
| 143 ;; which is regexp Impressionism - it matches almost anything! | |
| 144 ("([ \t]*\\([^:( \t\n]+\\)[:(][ \t]*\\([0-9]+\\))" 1 2) | |
| 145 | |
| 146 ;; Ultrix 3.0 f77: | |
| 147 ;; fort: Severe: addstf.f, line 82: Missing operator or delimiter symbol | |
| 148 ;; Some SGI cc version: | |
| 149 ;; cfe: Warning 835: foo.c, line 2: something | |
| 150 ("\n\\(cfe\\|fort\\): [^:\n]*: \\([^ \n]*\\), line \\([0-9]+\\):" 2 3) | |
| 151 ;; Error on line 3 of t.f: Execution error unclassifiable statement | |
| 152 ;; Unknown who does this: | |
| 153 ;; Line 45 of "foo.c": bloofel undefined | |
| 154 ;; Absoft FORTRAN 77 Compiler 3.1.3 | |
| 155 ;; error on line 19 of fplot.f: spelling error? | |
| 156 ;; warning on line 17 of fplot.f: data type is undefined for variable d | |
| 157 ("\\(\n\\|on \\)[Ll]ine[ \t]+\\([0-9]+\\)[ \t]+\ | |
| 158 of[ \t]+\"?\\([^\":\n]+\\)\"?:" 3 2) | |
| 159 | |
| 160 ;; Apollo cc, 4.3BSD fc: | |
| 161 ;; "foo.f", line 3: Error: syntax error near end of statement | |
| 162 ;; IBM RS6000: | |
| 163 ;; "vvouch.c", line 19.5: 1506-046 (S) Syntax error. | |
| 164 ;; Unknown compiler: | |
| 165 ;; File "foobar.ml", lines 5-8, characters 20-155: blah blah | |
| 166 ;; Microtec mcc68k: | |
| 167 ;; "foo.c", line 32 pos 1; (E) syntax error; unexpected symbol: "lossage" | |
| 168 ;; GNAT (as of July 94): | |
| 169 ;; "foo.adb", line 2(11): warning: file name does not match ... | |
| 170 ("\"\\([^,\" \n\t]+\\)\", lines? \\([0-9]+\\)[:., (-]" 1 2) | |
| 171 | |
| 172 ;; MIPS RISC CC - the one distributed with Ultrix: | |
| 173 ;; ccom: Error: foo.c, line 2: syntax error | |
| 174 ;; DEC AXP OSF/1 cc | |
| 175 ;; /usr/lib/cmplrs/cc/cfe: Error: foo.c: 1: blah blah | |
| 176 ("rror: \\([^,\" \n\t]+\\)[,:] \\(line \\)?\\([0-9]+\\):" 1 3) | |
| 177 | |
| 178 ;; IBM AIX PS/2 C version 1.1: | |
| 179 ;; ****** Error number 140 in line 8 of file errors.c ****** | |
| 180 ("in line \\([0-9]+\\) of file \\([^ \n]+[^. \n]\\)\\.? " 2 1) | |
| 181 ;; IBM AIX lint is too painful to do right this way. File name | |
| 182 ;; prefixes entire sections rather than being on each line. | |
| 183 | |
| 184 ;; Lucid Compiler, lcc 3.x | |
| 185 ;; E, file.cc(35,52) Illegal operation on pointers | |
| 186 ("\n[EW], \\([^(\n]*\\)(\\([0-9]+\\),[ \t]*\\([0-9]+\\)" 1 2 3) | |
| 187 | |
| 188 ;; GNU messages with program name and optional column number. | |
| 189 ("\n[^0-9 \n\t:]+:[ \t]*\\([^ \n\t:]+\\):\ | |
| 190 \\([0-9]+\\):\\(\\([0-9]+\\)[: \t]\\)?" 1 2 4) | |
| 191 | |
| 192 ;; jwz: | |
| 193 ;; IRIX 5.2 | |
| 194 ;; cfe: Warning 712: foo.c, line 2: illegal combination of pointer and ... | |
| 195 (" \\([^ \n,]+\\), line \\([0-9]+\\):" 1 2) | |
| 196 ;; IRIX 5.2 | |
| 197 ;; cfe: Warning 600: xfe.c: 170: Not in a conditional directive while ... | |
| 198 (": \\([^ \n,]+\\): \\([0-9]+\\):" 1 2) | |
| 199 | |
| 200 ;; Cray C compiler error messages | |
| 201 ("\n\\(cc\\| cft\\)-[0-9]+ c\\(c\\|f77\\): ERROR \\([^,\n]+, \\)* File = \\([^,\n]+\\), Line = \\([0-9]+\\)" 4 5) | |
| 202 | |
| 203 ;; IBM C/C++ Tools 2.01: | |
| 204 ;; foo.c(2:0) : informational EDC0804: Function foo is not referenced. | |
| 205 ;; foo.c(3:8) : warning EDC0833: Implicit return statement encountered. | |
| 206 ;; foo.c(5:5) : error EDC0350: Syntax error. | |
| 207 ("\n\\([^( \n\t]+\\)(\\([0-9]+\\):\\([0-9]+\\)) : " 1 2 3) | |
| 208 | |
| 209 ;; Sun ada (VADS, Solaris): | |
| 210 ;; /home3/xdhar/rcds_rc/main.a, line 361, char 6:syntax error: "," inserted | |
| 211 ("\n\\([^, ]+\\), line \\([0-9]+\\), char \\([0-9]+\\)[:., \(-]" 1 2 3) | |
| 212 ) | |
| 213 "Alist that specifies how to match errors in compiler output. | |
| 214 Each elt has the form (REGEXP FILE-IDX LINE-IDX [COLUMN-IDX FILE-FORMAT...]) | |
| 215 If REGEXP matches, the FILE-IDX'th subexpression gives the file name, and | |
| 216 the LINE-IDX'th subexpression gives the line number. If COLUMN-IDX is | |
| 217 given, the COLUMN-IDX'th subexpression gives the column number on that line. | |
| 218 If any FILE-FORMAT is given, each is a format string to produce a file name to | |
| 219 try; %s in the string is replaced by the text matching the FILE-IDX'th | |
| 220 subexpression.") | |
| 221 | |
| 222 (defvar compilation-read-command t | |
| 223 "If not nil, M-x compile reads the compilation command to use. | |
| 224 Otherwise, M-x compile just uses the value of `compile-command'.") | |
| 225 | |
| 226 (defvar compilation-ask-about-save t | |
| 227 "If not nil, M-x compile asks which buffers to save before compiling. | |
| 228 Otherwise, it saves all modified buffers without asking.") | |
| 229 | |
| 230 (defvar grep-regexp-alist | |
| 231 '(("^\\([^:( \t\n]+\\)[:( \t]+\\([0-9]+\\)[:) \t]" 1 2)) | |
| 232 "Regexp used to match grep hits. See `compilation-error-regexp-alist'.") | |
| 233 | |
| 234 (defvar grep-command "grep -n " | |
| 235 "Last grep command used in \\[grep]; default for next grep.") | |
| 236 | |
| 237 ;;;###autoload | |
| 238 (defvar compilation-search-path '(nil) | |
| 239 "*List of directories to search for source files named in error messages. | |
| 240 Elements should be directory names, not file names of directories. | |
| 241 nil as an element means to try the default directory.") | |
| 242 | |
| 243 (defvar compile-command "make -k " | |
| 244 "Last shell command used to do a compilation; default for next compilation. | |
| 245 | |
| 246 Sometimes it is useful for files to supply local values for this variable. | |
| 247 You might also use mode hooks to specify it in certain modes, like this: | |
| 248 | |
| 249 (setq c-mode-hook | |
| 250 '(lambda () (or (file-exists-p \"makefile\") (file-exists-p \"Makefile\") | |
| 251 (progn (make-local-variable 'compile-command) | |
| 252 (setq compile-command | |
| 253 (concat \"make -k \" | |
| 254 buffer-file-name))))))") | |
| 255 | |
| 256 (defvar compilation-enter-directory-regexp | |
| 257 ": Entering directory `\\(.*\\)'$" | |
| 258 "Regular expression matching lines that indicate a new current directory. | |
| 259 This must contain one \\(, \\) pair around the directory name. | |
| 260 | |
| 261 The default value matches lines printed by the `-w' option of GNU Make.") | |
| 262 | |
| 263 (defvar compilation-leave-directory-regexp | |
| 264 ": Leaving directory `\\(.*\\)'$" | |
| 265 "Regular expression matching lines that indicate restoring current directory. | |
| 266 This may contain one \\(, \\) pair around the name of the directory | |
| 267 being moved from. If it does not, the last directory entered \(by a | |
| 268 line matching `compilation-enter-directory-regexp'\) is assumed. | |
| 269 | |
| 270 The default value matches lines printed by the `-w' option of GNU Make.") | |
| 271 | |
| 272 (defvar compilation-directory-stack nil | |
| 273 "Stack of previous directories for `compilation-leave-directory-regexp'. | |
| 274 The head element is the directory the compilation was started in.") | |
| 275 | |
| 276 (defvar compilation-exit-message-function nil "\ | |
| 277 If non-nil, called when a compilation process dies to return a status message. | |
| 278 This should be a function a two arguments as passed to a process sentinel | |
| 279 \(see `set-process-sentinel\); it returns a cons (MESSAGE . MODELINE) of the | |
| 280 strings to write into the compilation buffer, and to put in its mode line.") | |
| 281 | |
| 282 ;; History of compile commands. | |
| 283 (defvar compile-history nil) | |
| 284 ;; History of grep commands. | |
| 285 (defvar grep-history nil) | |
| 286 | |
| 287 (defconst compilation-font-lock-keywords (purecopy | |
| 288 (list | |
| 289 '("^[-_.\"A-Za-z0-9/+]+\\(:\\|, line \\)[0-9]+: \\([wW]arning:\\).*$" . | |
| 290 font-lock-keyword-face) | |
| 291 '("^[-_.\"A-Za-z0-9/+]+\\(: *\\|, line \\)[0-9]+:.*$" . font-lock-function-name-face) | |
| 292 '("^[^:\n]+-[a-zA-Z][^:\n]+$" . font-lock-doc-string-face) | |
| 293 '("\\(^[-_.\"A-Za-z0-9/+]+\\)\\(: *\\|, line \\)[0-9]+" 1 font-lock-string-face t) | |
| 294 '("^[-_.\"A-Za-z0-9/+]+\\(: *[0-9]+\\|, line [0-9]+\\)" 1 bold t) | |
| 295 )) | |
| 296 "Additional expressions to highlight in Compilation mode.") | |
| 297 | |
| 298 ;FSF's version. Ours looks better. | |
| 299 ;(defvar compilation-font-lock-keywords | |
| 300 ; ;; This regexp needs a bit of rewriting. What is the third grouping for? | |
| 301 ; '(("^\\([^ \n:]*:\\([0-9]+:\\)+\\)\\(.*\\)$" 1 font-lock-function-name-face)) | |
| 302 ;;;; ("^\\([^\n:]*:\\([0-9]+:\\)+\\)\\(.*\\)$" 0 font-lock-keyword-face keep) | |
| 303 ; "Additional expressions to highlight in Compilation mode.") | |
| 304 (put 'compilation-mode 'font-lock-defaults | |
| 305 '(compilation-font-lock-keywords t)) | |
| 306 | |
| 307 | |
| 308 ;;;###autoload | |
| 309 (defun compile (command) | |
| 310 "Compile the program including the current buffer. Default: run `make'. | |
| 311 Runs COMMAND, a shell command, in a separate process asynchronously | |
| 312 with output going to the buffer `*compilation*'. | |
| 313 | |
| 314 You can then use the command \\[next-error] to find the next error message | |
| 315 and move to the source code that caused it. | |
| 316 | |
| 317 Interactively, prompts for the command if `compilation-read-command' is | |
| 318 non-nil; otherwise uses `compile-command'. With prefix arg, always prompts. | |
| 319 | |
| 320 To run more than one compilation at once, start one and rename the | |
| 321 \`*compilation*' buffer to some other name with \\[rename-buffer]. | |
| 322 Then start the next one. | |
| 323 | |
| 324 The name used for the buffer is actually whatever is returned by | |
| 325 the function in `compilation-buffer-name-function', so you can set that | |
| 326 to a function that generates a unique name." | |
| 327 (interactive | |
| 328 (if (or compilation-read-command current-prefix-arg) | |
| 329 (list (read-shell-command "Compile command: " | |
| 330 compile-command | |
| 331 ;; #### minibuffer code should do this | |
| 332 (if (equal (car compile-history) | |
| 333 compile-command) | |
| 334 '(compile-history . 1) | |
| 335 'compile-history))) | |
| 336 (list compile-command))) | |
| 337 (setq compile-command command) | |
| 338 (save-some-buffers (not compilation-ask-about-save) nil) | |
| 339 (compile-internal compile-command "No more errors")) | |
| 340 | |
| 341 ;;; run compile with the default command line | |
| 342 (defun recompile () | |
| 343 "Re-compile the program including the current buffer." | |
| 344 (interactive) | |
| 345 (save-some-buffers (not compilation-ask-about-save) nil) | |
| 346 (compile-internal compile-command "No more errors")) | |
| 347 | |
| 348 ;; The system null device. (Should reference NULL_DEVICE from C.) | |
| 349 (defvar grep-null-device "/dev/null" "The system null device.") | |
| 350 | |
| 351 ;;;###autoload | |
| 352 (defun grep (command-args) | |
| 353 "Run grep, with user-specified args, and collect output in a buffer. | |
| 354 While grep runs asynchronously, you can use the \\[next-error] command | |
| 355 to find the text that grep hits refer to. | |
| 356 | |
| 357 This command uses a special history list for its arguments, so you can | |
| 358 easily repeat a grep command." | |
| 359 (interactive | |
| 360 (list (read-shell-command "Run grep (like this): " | |
| 361 grep-command 'grep-history))) | |
| 362 (let ((buf (compile-internal (concat command-args " " grep-null-device) | |
| 363 "No more grep hits" "grep" | |
| 364 ;; Give it a simpler regexp to match. | |
| 365 nil grep-regexp-alist))) | |
| 366 (save-excursion | |
| 367 (set-buffer buf) | |
| 368 (set (make-local-variable 'compilation-exit-message-function) | |
| 369 (lambda (proc msg) | |
| 370 (let ((code (process-exit-status proc))) | |
| 371 (if (eq (process-status proc) 'exit) | |
| 372 (cond ((zerop code) | |
| 373 '("finished (matches found)\n" . "matched")) | |
| 374 ((= code 1) | |
| 375 '("finished with no matches found\n" . "no match")) | |
| 376 (t | |
| 377 (cons msg code))) | |
| 378 (cons msg code)))))))) | |
| 379 | |
| 380 (defun compile-internal (command error-message | |
| 381 &optional name-of-mode parser regexp-alist | |
| 382 name-function) | |
| 383 "Run compilation command COMMAND (low level interface). | |
| 384 ERROR-MESSAGE is a string to print if the user asks to see another error | |
| 385 and there are no more errors. Third argument NAME-OF-MODE is the name | |
| 386 to display as the major mode in the compilation buffer. | |
| 387 | |
| 388 Fourth arg PARSER is the error parser function (nil means the default). Fifth | |
| 389 arg REGEXP-ALIST is the error message regexp alist to use (nil means the | |
| 390 default). Sixth arg NAME-FUNCTION is a function called to name the buffer (nil | |
| 391 means the default). The defaults for these variables are the global values of | |
| 392 \`compilation-parse-errors-function', `compilation-error-regexp-alist', and | |
| 393 \`compilation-buffer-name-function', respectively. | |
| 394 | |
| 395 Returns the compilation buffer created." | |
| 396 (let (outbuf) | |
| 397 (save-excursion | |
| 398 (or name-of-mode | |
| 399 (setq name-of-mode "Compilation")) | |
| 400 (setq outbuf | |
| 401 (get-buffer-create | |
| 402 (funcall (or name-function compilation-buffer-name-function | |
| 403 (function (lambda (mode) | |
| 404 (concat "*" (downcase mode) "*")))) | |
| 405 name-of-mode))) | |
| 406 (set-buffer outbuf) | |
| 407 (let ((comp-proc (get-buffer-process (current-buffer)))) | |
| 408 (if comp-proc | |
| 409 (if (or (not (eq (process-status comp-proc) 'run)) | |
| 410 (yes-or-no-p | |
| 411 (format "A %s process is running; kill it? " | |
| 412 name-of-mode))) | |
| 413 (condition-case () | |
| 414 (progn | |
| 415 (interrupt-process comp-proc) | |
| 416 (sit-for 1) | |
| 417 (delete-process comp-proc)) | |
| 418 (error nil)) | |
| 419 (error "Cannot have two processes in `%s' at once" | |
| 420 (buffer-name)) | |
| 421 ))) | |
| 422 ;; In case the compilation buffer is current, make sure we get the global | |
| 423 ;; values of compilation-error-regexp-alist, etc. | |
| 424 (kill-all-local-variables)) | |
| 425 (let ((regexp-alist (or regexp-alist compilation-error-regexp-alist)) | |
| 426 (parser (or parser compilation-parse-errors-function)) | |
| 427 (thisdir default-directory) | |
| 428 (buffer-save (current-buffer)) | |
| 429 outwin) | |
| 430 | |
| 431 ;; Pop up the compilation buffer. | |
| 432 (setq outwin (display-buffer outbuf)) | |
| 433 | |
| 434 (unwind-protect | |
| 435 (progn | |
| 436 ;; Clear out the compilation buffer and make it writable. | |
| 437 ;; Change its default-directory to the directory where the compilation | |
| 438 ;; will happen, and insert a `cd' command to indicate this. | |
| 439 (set-buffer outbuf) | |
| 440 | |
| 441 (setq buffer-read-only nil) | |
| 442 (buffer-disable-undo (current-buffer)) | |
| 443 (erase-buffer) | |
| 444 (buffer-enable-undo (current-buffer)) | |
| 445 (setq default-directory thisdir) | |
| 446 (insert "cd " thisdir "\n" command "\n") | |
| 447 (set-buffer-modified-p nil) | |
| 448 | |
| 449 ;; set it so the window will scroll to show compile output | |
| 450 (save-window-excursion | |
| 451 (select-window outwin) | |
| 452 (goto-char (point-max))) | |
| 453 | |
| 454 (compilation-mode name-of-mode) | |
| 455 ;; (setq buffer-read-only t) ;;; Non-ergonomic. | |
| 456 (set (make-local-variable 'compile-command) command) | |
| 457 (set (make-local-variable 'compilation-parse-errors-function) parser) | |
| 458 (set (make-local-variable 'compilation-error-message) error-message) | |
| 459 (set (make-local-variable 'compilation-error-regexp-alist) regexp-alist) | |
| 460 (setq default-directory thisdir | |
| 461 compilation-directory-stack (list default-directory)) | |
| 462 (set-window-start outwin (point-min)) | |
| 463 (setq mode-name name-of-mode) | |
| 464 ; (or (eq outwin (selected-window)) | |
| 465 ; (set-window-point outwin (point-min))) | |
| 466 (compilation-set-window-height outwin) | |
| 467 | |
| 468 ;; Set up the menus | |
| 469 | |
| 470 ;; Start the compilation. | |
| 471 (if (fboundp 'start-process) | |
| 472 (let* ((process-environment (cons "EMACS=t" process-environment)) | |
| 473 (proc (start-process-shell-command (downcase mode-name) | |
| 474 outbuf | |
| 475 command))) | |
| 476 (set-process-sentinel proc 'compilation-sentinel) | |
| 477 (set-process-filter proc 'compilation-filter) | |
| 478 (set-marker (process-mark proc) (point) outbuf) | |
| 479 (setq compilation-in-progress | |
| 480 (cons proc compilation-in-progress))) | |
| 481 ;; No asynchronous processes available | |
| 482 (message (format "Executing `%s'..." command)) | |
| 483 (sit-for 0) ;; Force redisplay | |
| 484 (let ((status (call-process shell-file-name nil outbuf nil "-c" | |
| 485 command)))) | |
| 486 (message (format "Executing `%s'...done" command)))) | |
| 487 (set-buffer buffer-save))) | |
| 488 | |
| 489 ;; Make it so the next C-x ` will use this buffer. | |
| 490 (setq compilation-last-buffer outbuf))) | |
| 491 | |
| 492 ;; Set the height of WINDOW according to compilation-window-height. | |
| 493 (defun compilation-set-window-height (window) | |
| 494 (and compilation-window-height | |
| 495 (= (window-width window) (frame-width (window-frame window))) | |
| 496 ;; If window is alone in its frame, aside from a minibuffer, | |
| 497 ;; don't change its height. | |
| 498 (not (eq window (frame-root-window (window-frame window)))) | |
| 499 ;; This save-excursion prevents us from changing the current buffer, | |
| 500 ;; which might not be the same as the selected window's buffer. | |
| 501 (save-excursion | |
| 502 (let ((w (selected-window))) | |
| 503 (unwind-protect | |
| 504 (progn | |
| 505 (select-window window) | |
| 506 (enlarge-window (- compilation-window-height | |
| 507 (window-height)))) | |
| 508 (select-window w)))))) | |
| 509 | |
| 510 (defvar compilation-minor-mode-map | |
| 511 (let ((map (make-sparse-keymap))) | |
| 512 (set-keymap-name map 'compilation-minor-mode-map) | |
| 513 (define-key map "\C-c\C-c" 'compile-goto-error) | |
| 514 (define-key map "\C-m" 'compile-goto-error) | |
| 515 (define-key map "\C-c\C-k" 'kill-compilation) | |
| 516 (define-key map "\M-n" 'compilation-next-error) | |
| 517 (define-key map "\M-p" 'compilation-previous-error) | |
| 518 (define-key map "\M-{" 'compilation-previous-file) | |
| 519 (define-key map "\M-}" 'compilation-next-file) | |
| 520 map) | |
| 521 "Keymap for `compilation-minor-mode'.") | |
| 522 | |
| 523 (defvar compilation-mode-map | |
| 524 (let ((map (make-sparse-keymap))) | |
| 525 (set-keymap-parents map (list compilation-minor-mode-map)) | |
| 526 (set-keymap-name map 'compilation-mode-map) | |
| 527 (define-key map " " 'scroll-up) | |
| 528 (define-key map "\^?" 'scroll-down) | |
| 529 (define-key map 'button2 'compile-mouse-goto-error) | |
| 530 map) | |
| 531 "Keymap for compilation log buffers. | |
| 532 `compilation-minor-mode-map' is a parent of this.") | |
| 533 | |
| 534 ;;; XEmacs menus | |
| 535 | |
| 536 (defun compilation-errors-exist-p (&optional buffer) | |
| 537 "Whether we are in a state where the `next-error' command will work, | |
| 538 that is, whether there exist (or may exist) error targets in the *compile* | |
| 539 or *grep* buffers." | |
| 540 (or buffer | |
| 541 (setq buffer (condition-case nil | |
| 542 (compilation-find-buffer) | |
| 543 (error nil)))) | |
| 544 (and buffer | |
| 545 (compilation-buffer-p buffer) | |
| 546 (save-excursion | |
| 547 (set-buffer buffer) | |
| 548 ;; Has errors on the list, or needs to be parsed. | |
| 549 ;; But don't parse it now! | |
| 550 (or (not (null compilation-error-list)) | |
| 551 (< compilation-parsing-end (point-max)))))) | |
| 552 | |
| 553 (defvar Compilation-mode-popup-menu | |
| 554 '("Compilation Mode Commands" | |
| 555 :filter compile-menu-filter | |
| 556 ["Compile..." compile t] | |
| 557 ["Recompile" recompile t] | |
| 558 ["Kill Compilation" kill-compilation (get-buffer-process (current-buffer))] | |
| 559 "---" | |
| 560 ["Goto Error" compile-goto-error (compilation-errors-exist-p)] | |
| 561 ["Next Error" next-error (compilation-errors-exist-p)] | |
| 562 ["Previous Error" previous-error (compilation-errors-exist-p)] | |
| 563 ["First Error" first-error (compilation-errors-exist-p)] | |
| 564 )) | |
| 565 | |
| 566 (defvar Compilation-mode-menubar-menu | |
| 567 (cons "Compile" (cdr Compilation-mode-popup-menu))) | |
| 568 | |
| 569 (defvar grep-mode-popup-menu | |
| 570 '("Grep Mode Commands" | |
| 571 :filter grep-menu-filter | |
| 572 ["Grep..." grep t] | |
| 573 ["Repeat Grep" recompile t] | |
| 574 ["Kill Grep" kill-compilation (get-buffer-process (current-buffer))] | |
| 575 "---" | |
| 576 ["Goto Match" compile-goto-error (default-value 'compilation-error-list)] | |
| 577 ["Next Match" next-error (default-value 'compilation-error-list)] | |
| 578 ["Previous Match" previous-error (default-value 'compilation-error-list)] | |
| 579 ["First Match" first-error (default-value 'compilation-error-list)] | |
| 580 )) | |
| 581 | |
| 582 (defvar grep-mode-menubar-menu | |
| 583 (cons "Grep" (cdr grep-mode-popup-menu))) | |
| 584 | |
| 585 (defun compile-menu-filter-1 (menu history-list item-name command-name) | |
| 586 (let ((submenu (mapcar #'(lambda (string) | |
| 587 (vector string | |
| 588 (list command-name string) | |
| 589 t)) | |
| 590 history-list)) | |
| 591 (existing (assoc item-name menu))) | |
| 592 (if existing | |
| 593 (progn | |
| 594 (setcdr existing submenu) | |
| 595 menu) | |
| 596 (nconc menu (list (cons item-name submenu)))))) | |
| 597 | |
| 598 (defun compile-menu-filter (menu) | |
| 599 (compile-menu-filter-1 menu compile-history "Compile History" 'compile)) | |
| 600 | |
| 601 (defun grep-menu-filter (menu) | |
| 602 (compile-menu-filter-1 menu grep-history "Grep History" 'grep)) | |
| 603 | |
| 604 (defun compilation-mode (&optional name-of-mode) | |
| 605 "Major mode for compilation log buffers. | |
| 606 \\<compilation-mode-map>To visit the source for a line-numbered error, | |
| 607 move point to the error message line and type \\[compile-goto-error], | |
| 608 or click on the line with \\[compile-mouse-goto-error]. | |
| 609 There is a menu of commands on \\[compile-popup-menu]. | |
| 610 To kill the compilation, type \\[kill-compilation]. | |
| 611 | |
| 612 Runs `compilation-mode-hook' with `run-hooks' (which see)." | |
| 613 (interactive) | |
| 614 (kill-all-local-variables) | |
| 615 (use-local-map compilation-mode-map) | |
| 616 (setq major-mode 'compilation-mode | |
| 617 mode-name "Compilation") | |
| 618 (compilation-setup) | |
| 619 (font-lock-set-defaults) | |
| 620 (if (not name-of-mode) nil | |
| 621 (let ((sym (intern (concat name-of-mode "-mode-popup-menu")))) | |
| 622 (if (boundp sym) | |
| 623 (setq mode-popup-menu (symbol-value sym)))) | |
| 624 (if (featurep 'menubar) | |
| 625 (progn | |
| 626 ;; make a local copy of the menubar, so our modes don't | |
| 627 ;; change the global menubar | |
| 628 (set-buffer-menubar current-menubar) | |
| 629 (let ((sym (intern (concat name-of-mode "-mode-menubar-menu")))) | |
| 630 (if (boundp sym) | |
| 631 (add-submenu nil (symbol-value sym))))))) | |
| 632 (run-hooks 'compilation-mode-hook)) | |
| 633 | |
| 634 ;; XEmacs addition, hacked by Mly | |
| 635 (defun compilation-mode-motion-hook (event) | |
| 636 (mode-motion-highlight-internal | |
| 637 event | |
| 638 #'beginning-of-line | |
| 639 #'(lambda () | |
| 640 (let* ((p (point)) | |
| 641 (e (progn (end-of-line) (point))) | |
| 642 (l (progn | |
| 643 (if (or (eq compilation-error-list 't) | |
| 644 (>= p compilation-parsing-end)) | |
| 645 ;; #### Does it suck too badly to have mouse-movement | |
| 646 ;; #### over a buffer parse errors in that buffer?? | |
| 647 (save-window-excursion | |
| 648 (compile-reinitialize-errors nil p))) | |
| 649 (if (and compilation-error-list | |
| 650 (<= (car (car compilation-error-list)) p)) | |
| 651 ;; Perhaps save time by only searching tail | |
| 652 compilation-error-list | |
| 653 compilation-old-error-list)))) | |
| 654 (if (catch 'found | |
| 655 (while l | |
| 656 (let ((x (marker-position (car (car l))))) | |
| 657 (cond ((< x p) | |
| 658 (setq l (cdr l))) | |
| 659 ((<= x e) | |
| 660 (throw 'found t)) | |
| 661 (t | |
| 662 (throw 'found nil))))) | |
| 663 nil) | |
| 664 (goto-char e) | |
| 665 (goto-char p)))))) | |
| 666 | |
| 667 ;; Prepare the buffer for the compilation parsing commands to work. | |
| 668 (defun compilation-setup () | |
| 669 ;; Make the buffer's mode line show process state. | |
| 670 (setq mode-line-process '(":%s")) | |
| 671 (set (make-local-variable 'compilation-error-list) nil) | |
| 672 (set (make-local-variable 'compilation-old-error-list) nil) | |
| 673 (set (make-local-variable 'compilation-parsing-end) 1) | |
| 674 (set (make-local-variable 'compilation-directory-stack) nil) | |
| 675 (setq compilation-last-buffer (current-buffer)) | |
| 676 ;; XEmacs change: highlight lines, install menubar. | |
| 677 (require 'mode-motion) | |
| 678 (setq mode-motion-hook 'compilation-mode-motion-hook) | |
| 679 (make-local-variable 'mouse-track-click-hook) | |
| 680 (add-hook 'mouse-track-click-hook 'compile-mouse-maybe-goto-error) | |
| 681 ) | |
| 682 | |
| 683 (defvar compilation-minor-mode nil | |
| 684 "Non-nil when in compilation-minor-mode. | |
| 685 In this minor mode, all the error-parsing commands of the | |
| 686 Compilation major mode are available.") | |
| 687 (make-variable-buffer-local 'compilation-minor-mode) | |
| 688 | |
| 689 (or (assq 'compilation-minor-mode minor-mode-alist) | |
| 690 (setq minor-mode-alist (cons '(compilation-minor-mode " Compilation") | |
| 691 minor-mode-alist))) | |
| 692 (or (assq 'compilation-minor-mode minor-mode-map-alist) | |
| 693 (setq minor-mode-map-alist (cons (cons 'compilation-minor-mode | |
| 694 compilation-minor-mode-map) | |
| 695 minor-mode-map-alist))) | |
| 696 | |
| 697 ;;;###autoload | |
| 698 (defun compilation-minor-mode (&optional arg) | |
| 699 "Toggle compilation minor mode. | |
| 700 With arg, turn compilation mode on if and only if arg is positive. | |
| 701 See `compilation-mode'. | |
| 702 ! \\{compilation-mode-map}" | |
| 703 (interactive "P") | |
| 704 (if (setq compilation-minor-mode (if (null arg) | |
| 705 (null compilation-minor-mode) | |
| 706 (> (prefix-numeric-value arg) 0))) | |
| 707 (compilation-setup))) | |
| 708 | |
| 709 ;; Called when compilation process changes state. | |
| 710 (defun compilation-sentinel (proc msg) | |
| 711 "Sentinel for compilation buffers." | |
| 712 (let* ((buffer (process-buffer proc)) | |
| 713 (window (get-buffer-window buffer))) | |
| 714 (if (memq (process-status proc) '(signal exit)) | |
| 715 (progn | |
| 716 (if (null (buffer-name buffer)) | |
| 717 ;; buffer killed | |
| 718 (set-process-buffer proc nil) | |
| 719 (let ((obuf (current-buffer)) | |
| 720 omax opoint estatus) | |
| 721 ;; save-excursion isn't the right thing if | |
| 722 ;; process-buffer is current-buffer | |
| 723 (unwind-protect | |
| 724 (progn | |
| 725 ;; Write something in the compilation buffer | |
| 726 ;; and hack its mode line. | |
| 727 (set-buffer buffer) | |
| 728 (let ((buffer-read-only nil) | |
| 729 (status (if compilation-exit-message-function | |
| 730 (funcall compilation-exit-message-function | |
| 731 proc msg) | |
| 732 (cons msg (process-exit-status proc))))) | |
| 733 (setq omax (point-max) | |
| 734 opoint (point)) | |
| 735 (goto-char omax) | |
| 736 ;; Record where we put the message, so we can ignore it | |
| 737 ;; later on. | |
| 738 (insert ?\n mode-name " " (car status)) | |
| 739 (forward-char -1) | |
| 740 (insert " at " (substring (current-time-string) 0 19)) | |
| 741 (forward-char 1) | |
| 742 (setq mode-line-process | |
| 743 (concat ":" | |
| 744 (symbol-name (process-status proc)) | |
| 745 (if (zerop (process-exit-status proc)) | |
| 746 " OK" | |
| 747 (setq estatus | |
| 748 (format " [exit-status %d]" | |
| 749 (process-exit-status proc)))) | |
| 750 )) | |
| 751 ;; XEmacs - tedium should let you know when it's ended... | |
| 752 (if (and (not compilation-always-signal-completion) | |
| 753 window | |
| 754 (pos-visible-in-window-p (point-max) window)) | |
| 755 nil ; assume that the user will see it... | |
| 756 (ding t 'ready) | |
| 757 (message "Compilation process completed%s." | |
| 758 (or estatus " successfully") | |
| 759 )) | |
| 760 ;; Since the buffer and mode line will show that the | |
| 761 ;; process is dead, we can delete it now. Otherwise it | |
| 762 ;; will stay around until M-x list-processes. | |
| 763 (delete-process proc) | |
| 764 ;; Force mode line redisplay soon. | |
| 765 (redraw-modeline)) | |
| 766 (if (and opoint (< opoint omax)) | |
| 767 (goto-char opoint)) | |
| 768 (if compilation-finish-function | |
| 769 (funcall compilation-finish-function buffer msg))) | |
| 770 (set-buffer obuf)))) | |
| 771 (setq compilation-in-progress (delq proc compilation-in-progress)) | |
| 772 )))) | |
| 773 | |
| 774 (defun compilation-filter (proc string) | |
| 775 "Process filter for compilation buffers. | |
| 776 Just inserts the text, but uses `insert-before-markers'." | |
| 777 (if (buffer-name (process-buffer proc)) | |
| 778 (save-excursion | |
| 779 (set-buffer (process-buffer proc)) | |
| 780 (let ((buffer-read-only nil)) | |
| 781 (save-excursion | |
| 782 (goto-char (process-mark proc)) | |
| 783 (insert-before-markers string) | |
| 784 (set-marker (process-mark proc) (point))))))) | |
| 785 | |
| 786 ;; Return the cdr of compilation-old-error-list for the error containing point. | |
| 787 (defun compile-error-at-point () | |
| 788 (compile-reinitialize-errors nil (point)) | |
| 789 (let ((errors compilation-old-error-list)) | |
| 790 (while (and errors | |
| 791 (> (point) (car (car errors)))) | |
| 792 (setq errors (cdr errors))) | |
| 793 errors)) | |
| 794 | |
| 795 (defun compilation-buffer-p (buffer) | |
| 796 (save-excursion | |
| 797 (set-buffer buffer) | |
| 798 (or compilation-minor-mode (eq major-mode 'compilation-mode)))) | |
| 799 | |
| 800 (defun compilation-next-error (n) | |
| 801 "Move point to the next error in the compilation buffer. | |
| 802 Does NOT find the source line like \\[next-error]." | |
| 803 (interactive "p") | |
| 804 (or (compilation-buffer-p (current-buffer)) | |
| 805 (error "Not in a compilation buffer.")) | |
| 806 (setq compilation-last-buffer (current-buffer)) | |
| 807 | |
| 808 (let ((errors (compile-error-at-point))) | |
| 809 | |
| 810 ;; Move to the error after the one containing point. | |
| 811 (goto-char (car (if (< n 0) | |
| 812 (let ((i 0) | |
| 813 (e compilation-old-error-list)) | |
| 814 ;; See how many cdrs away ERRORS is from the start. | |
| 815 (while (not (eq e errors)) | |
| 816 (setq i (1+ i) | |
| 817 e (cdr e))) | |
| 818 (if (> (- n) i) | |
| 819 (error "Moved back past first error") | |
| 820 (nth (+ i n) compilation-old-error-list))) | |
| 821 (let ((compilation-error-list (cdr errors))) | |
| 822 (compile-reinitialize-errors nil nil n) | |
| 823 (if compilation-error-list | |
| 824 (nth (1- n) compilation-error-list) | |
| 825 (error "Moved past last error")))))))) | |
| 826 | |
| 827 (defun compilation-previous-error (n) | |
| 828 "Move point to the previous error in the compilation buffer. | |
| 829 Does NOT find the source line like \\[next-error]." | |
| 830 (interactive "p") | |
| 831 (compilation-next-error (- n))) | |
| 832 | |
| 833 | |
| 834 ;; Given an elt of `compilation-error-list', return an object representing | |
| 835 ;; the referenced file which is equal to (but not necessarily eq to) what | |
| 836 ;; this function would return for another error in the same file. | |
| 837 (defsubst compilation-error-filedata (data) | |
| 838 (setq data (cdr data)) | |
| 839 (if (markerp data) | |
| 840 (marker-buffer data) | |
| 841 (car data))) | |
| 842 | |
| 843 ;; Return a string describing a value from compilation-error-filedata. | |
| 844 ;; This value is not necessarily useful as a file name, but should be | |
| 845 ;; indicative to the user of what file's errors are being referred to. | |
| 846 (defsubst compilation-error-filedata-file-name (filedata) | |
| 847 (if (bufferp filedata) | |
| 848 (buffer-file-name filedata) | |
| 849 (car filedata))) | |
| 850 | |
| 851 (defun compilation-next-file (n) | |
| 852 "Move point to the next error for a different file than the current one." | |
| 853 (interactive "p") | |
| 854 (or (compilation-buffer-p (current-buffer)) | |
| 855 (error "Not in a compilation buffer.")) | |
| 856 (setq compilation-last-buffer (current-buffer)) | |
| 857 | |
| 858 (let ((reversed (< n 0)) | |
| 859 errors filedata) | |
| 860 | |
| 861 (if (not reversed) | |
| 862 (setq errors (or (compile-error-at-point) | |
| 863 (error "Moved past last error"))) | |
| 864 | |
| 865 ;; Get a reversed list of the errors up through the one containing point. | |
| 866 (compile-reinitialize-errors nil (point)) | |
| 867 (setq errors (reverse compilation-old-error-list) | |
| 868 n (- n)) | |
| 869 | |
| 870 ;; Ignore errors after point. (car ERRORS) will be the error | |
| 871 ;; containing point, (cadr ERRORS) the one before it. | |
| 872 (while (and errors | |
| 873 (< (point) (car (car errors)))) | |
| 874 (setq errors (cdr errors)))) | |
| 875 | |
| 876 (while (> n 0) | |
| 877 (setq filedata (compilation-error-filedata (car errors))) | |
| 878 | |
| 879 ;; Skip past the following errors for this file. | |
| 880 (while (equal filedata | |
| 881 (compilation-error-filedata | |
| 882 (car (or errors | |
| 883 (if reversed | |
| 884 (error "%s the first erring file" | |
| 885 (compilation-error-filedata-file-name | |
| 886 filedata)) | |
| 887 (let ((compilation-error-list nil)) | |
| 888 ;; Parse some more. | |
| 889 (compile-reinitialize-errors nil nil 2) | |
| 890 (setq errors compilation-error-list))) | |
| 891 (error "%s is the last erring file" | |
| 892 (compilation-error-filedata-file-name | |
| 893 filedata)))))) | |
| 894 (setq errors (cdr errors))) | |
| 895 | |
| 896 (setq n (1- n))) | |
| 897 | |
| 898 ;; Move to the following error. | |
| 899 (goto-char (car (car (or errors | |
| 900 (if reversed | |
| 901 (error "This is the first erring file") | |
| 902 (let ((compilation-error-list nil)) | |
| 903 ;; Parse the last one. | |
| 904 (compile-reinitialize-errors nil nil 1) | |
| 905 compilation-error-list)))))))) | |
| 906 | |
| 907 (defun compilation-previous-file (n) | |
| 908 "Move point to the previous error for a different file than the current one." | |
| 909 (interactive "p") | |
| 910 (compilation-next-file (- n))) | |
| 911 | |
| 912 | |
| 913 (defun kill-compilation () | |
| 914 "Kill the process made by the \\[compile] command." | |
| 915 (interactive) | |
| 916 (let ((buffer (compilation-find-buffer))) | |
| 917 (if (get-buffer-process buffer) | |
| 918 (interrupt-process (get-buffer-process buffer)) | |
| 919 (error "The compilation process is not running.")))) | |
| 920 | |
| 921 | |
| 922 ;; Parse any new errors in the compilation buffer, | |
| 923 ;; or reparse from the beginning if the user has asked for that. | |
| 924 (defun compile-reinitialize-errors (reparse | |
| 925 &optional limit-search find-at-least) | |
| 926 (save-excursion | |
| 927 ;; XEmacs change: Below we made a change to possibly change the | |
| 928 ;; selected window. If we don't save and restore the old window | |
| 929 ;; then if we get an error such as 'no more errors' we'll end up | |
| 930 ;; in the compilation buffer. | |
| 931 (save-window-excursion | |
| 932 (set-buffer compilation-last-buffer) | |
| 933 ;; If we are out of errors, or if user says "reparse", | |
| 934 ;; discard the info we have, to force reparsing. | |
| 935 (if (or (eq compilation-error-list t) | |
| 936 reparse) | |
| 937 (compilation-forget-errors)) | |
| 938 (if (and compilation-error-list | |
| 939 (or (not limit-search) | |
| 940 (> compilation-parsing-end limit-search)) | |
| 941 (or (not find-at-least) | |
| 942 (>= (length compilation-error-list) find-at-least))) | |
| 943 ;; Since compilation-error-list is non-nil, it points to a specific | |
| 944 ;; error the user wanted. So don't move it around. | |
| 945 nil | |
| 946 | |
| 947 ;; XEmacs change: if the compilation buffer is already visible | |
| 948 ;; in a window, use that instead of thrashing the display. | |
| 949 (let ((w (get-buffer-window compilation-last-buffer))) | |
| 950 (if w | |
| 951 (select-window w) | |
| 952 (switch-to-buffer compilation-last-buffer))) | |
| 953 | |
| 954 (set-buffer-modified-p nil) | |
| 955 (if (< compilation-parsing-end (point-max)) | |
| 956 ;; compilation-error-list might be non-nil if we have a non-nil | |
| 957 ;; LIMIT-SEARCH or FIND-AT-LEAST arg. In that case its value | |
| 958 ;; records the current position in the error list, and we must | |
| 959 ;; preserve that after reparsing. | |
| 960 (let ((error-list-pos compilation-error-list)) | |
| 961 (funcall compilation-parse-errors-function | |
| 962 limit-search | |
| 963 (and find-at-least | |
| 964 ;; We only need enough new parsed errors to reach | |
| 965 ;; FIND-AT-LEAST errors past the current | |
| 966 ;; position. | |
| 967 (- find-at-least (length compilation-error-list)))) | |
| 968 ;; Remember the entire list for compilation-forget-errors. If | |
| 969 ;; this is an incremental parse, append to previous list. If | |
| 970 ;; we are parsing anew, compilation-forget-errors cleared | |
| 971 ;; compilation-old-error-list above. | |
| 972 (setq compilation-old-error-list | |
| 973 (nconc compilation-old-error-list compilation-error-list)) | |
| 974 (if error-list-pos | |
| 975 ;; We started in the middle of an existing list of parsed | |
| 976 ;; errors before parsing more; restore that position. | |
| 977 (setq compilation-error-list error-list-pos)) | |
| 978 )))))) | |
| 979 | |
| 980 (defun compile-goto-error (&optional argp) | |
| 981 "Visit the source for the error message point is on. | |
| 982 Use this command in a compilation log buffer. Sets the mark at point there. | |
| 983 \\[universal-argument] as a prefix arg means to reparse the buffer's error messages first; | |
| 984 other kinds of prefix arguments are ignored." | |
| 985 (interactive "P") | |
| 986 (or (compilation-buffer-p (current-buffer)) | |
| 987 (error "Not in a compilation buffer.")) | |
| 988 (setq compilation-last-buffer (current-buffer)) | |
| 989 (compile-reinitialize-errors (consp argp) (point)) | |
| 990 | |
| 991 ;; Move to bol; the marker for the error on this line will point there. | |
| 992 (beginning-of-line) | |
| 993 | |
| 994 ;; Move compilation-error-list to the elt of compilation-old-error-list | |
| 995 ;; we want. | |
| 996 (setq compilation-error-list compilation-old-error-list) | |
| 997 (while (and compilation-error-list | |
| 998 (> (point) (car (car compilation-error-list)))) | |
| 999 (setq compilation-error-list (cdr compilation-error-list))) | |
| 1000 | |
| 1001 ;; Move to another window, so that next-error's window changes | |
| 1002 ;; result in the desired setup. | |
| 1003 (or (one-window-p) | |
| 1004 (progn | |
| 1005 (other-window -1) | |
| 1006 ;; other-window changed the selected buffer, | |
| 1007 ;; but we didn't want to do that. | |
| 1008 (set-buffer compilation-last-buffer))) | |
| 1009 | |
| 1010 (push-mark) | |
| 1011 (next-error 1)) | |
| 1012 | |
| 1013 ;; XEmacs addition | |
| 1014 (defun compile-mouse-goto-error (event) | |
| 1015 "Visit the source for the error under the mouse. | |
| 1016 Use this command in a compilation log buffer." | |
| 1017 (interactive "e") | |
| 1018 (mouse-set-point event) | |
| 1019 (beginning-of-line) | |
| 1020 (compile-goto-error)) | |
| 1021 | |
| 1022 ;; XEmacs addition | |
| 1023 (defun compile-mouse-maybe-goto-error (event &optional click-count) | |
| 1024 (interactive "e") | |
| 1025 (if (equal (event-button event) 2) | |
| 1026 (let ((buffer (current-buffer)) | |
| 1027 (point (point)) | |
| 1028 (config (current-window-configuration))) | |
| 1029 (condition-case nil | |
| 1030 (progn | |
| 1031 (compile-mouse-goto-error event) | |
| 1032 t) | |
| 1033 (error | |
| 1034 (set-window-configuration config) | |
| 1035 (set-buffer buffer) | |
| 1036 (goto-char point) | |
| 1037 nil))))) | |
| 1038 | |
| 1039 ;; Return a compilation buffer. | |
| 1040 ;; If the current buffer is a compilation buffer, return it. | |
| 1041 ;; If compilation-last-buffer is set to a live buffer, use that. | |
| 1042 ;; Otherwise, look for a compilation buffer and signal an error | |
| 1043 ;; if there are none. | |
| 1044 (defun compilation-find-buffer (&optional other-buffer) | |
| 1045 (if (and (not other-buffer) | |
| 1046 (compilation-buffer-p (current-buffer))) | |
| 1047 ;; The current buffer is a compilation buffer. | |
| 1048 (current-buffer) | |
| 1049 (if (and compilation-last-buffer (buffer-name compilation-last-buffer) | |
| 1050 (or (not other-buffer) (not (eq compilation-last-buffer | |
| 1051 (current-buffer))))) | |
| 1052 compilation-last-buffer | |
| 1053 (let ((buffers (buffer-list))) | |
| 1054 (while (and buffers (or (not (compilation-buffer-p (car buffers))) | |
| 1055 (and other-buffer | |
| 1056 (eq (car buffers) (current-buffer))))) | |
| 1057 (setq buffers (cdr buffers))) | |
| 1058 (if buffers | |
| 1059 (car buffers) | |
| 1060 (or (and other-buffer | |
| 1061 (compilation-buffer-p (current-buffer)) | |
| 1062 ;; The current buffer is a compilation buffer. | |
| 1063 (progn | |
| 1064 (if other-buffer | |
| 1065 (message "This is the only compilation buffer.")) | |
| 1066 (current-buffer))) | |
| 1067 (error "No compilation started!"))))))) | |
| 1068 | |
| 1069 ;;;###autoload | |
| 1070 (defun next-error (&optional argp) | |
| 1071 "Visit next compilation error message and corresponding source code. | |
| 1072 This operates on the output from the \\[compile] command. | |
| 1073 If all preparsed error messages have been processed, | |
| 1074 the error message buffer is checked for new ones. | |
| 1075 | |
| 1076 A prefix arg specifies how many error messages to move; | |
| 1077 negative means move back to previous error messages. | |
| 1078 Just C-u as a prefix means reparse the error message buffer | |
| 1079 and start at the first error. | |
| 1080 | |
| 1081 \\[next-error] normally applies to the most recent compilation started, | |
| 1082 but as long as you are in the middle of parsing errors from one compilation | |
| 1083 output buffer, you stay with that compilation output buffer. | |
| 1084 | |
| 1085 Use \\[next-error] in a compilation output buffer to switch to | |
| 1086 processing errors from that compilation. | |
| 1087 | |
| 1088 See variables `compilation-parse-errors-function' and | |
| 1089 \`compilation-error-regexp-alist' for customization ideas." | |
| 1090 (interactive "P") | |
| 1091 (setq compilation-last-buffer (compilation-find-buffer)) | |
| 1092 (compilation-goto-locus (compilation-next-error-locus | |
| 1093 ;; We want to pass a number here only if | |
| 1094 ;; we got a numeric prefix arg, not just C-u. | |
| 1095 (and (not (consp argp)) | |
| 1096 (prefix-numeric-value argp)) | |
| 1097 (consp argp)))) | |
| 1098 | |
| 1099 ;; XEmacs change | |
| 1100 ;;;###autoload | |
| 1101 (defun previous-error (&optional argp) | |
| 1102 "Visit previous compilation error message and corresponding source code. | |
| 1103 This operates on the output from the \\[compile] command." | |
| 1104 (interactive "P") | |
| 1105 (next-error (cond ((null argp) -1) | |
| 1106 ((numberp argp) (- argp)) | |
| 1107 (t argp)))) | |
| 1108 | |
| 1109 ;;;###autoload | |
| 1110 (defun first-error () | |
| 1111 "Reparse the error message buffer and start at the first error | |
| 1112 Visit corresponding source code. | |
| 1113 This operates on the output from the \\[compile] command." | |
| 1114 (interactive) | |
| 1115 (next-error '(4))) | |
| 1116 | |
| 1117 (defun compilation-next-error-locus (&optional move reparse silent) | |
| 1118 "Visit next compilation error and return locus in corresponding source code. | |
| 1119 This operates on the output from the \\[compile] command. | |
| 1120 If all preparsed error messages have been processed, | |
| 1121 the error message buffer is checked for new ones. | |
| 1122 | |
| 1123 Returns a cons (ERROR . SOURCE) of two markers: ERROR is a marker at the | |
| 1124 location of the error message in the compilation buffer, and SOURCE is a | |
| 1125 marker at the location in the source code indicated by the error message. | |
| 1126 | |
| 1127 Optional first arg MOVE says how many error messages to move forwards (or | |
| 1128 backwards, if negative); default is 1. Optional second arg REPARSE, if | |
| 1129 non-nil, says to reparse the error message buffer and reset to the first | |
| 1130 error (plus MOVE - 1). If optional third argument SILENT is non-nil, return | |
| 1131 nil instead of raising an error if there are no more errors. | |
| 1132 | |
| 1133 The current buffer should be the desired compilation output buffer." | |
| 1134 (or move (setq move 1)) | |
| 1135 (compile-reinitialize-errors reparse nil (and (not reparse) | |
| 1136 (if (< move 1) 0 (1- move)))) | |
| 1137 (let (next-errors next-error) | |
| 1138 (catch 'no-next-error | |
| 1139 (save-excursion | |
| 1140 (set-buffer compilation-last-buffer) | |
| 1141 ;; compilation-error-list points to the "current" error. | |
| 1142 (setq next-errors | |
| 1143 (if (> move 0) | |
| 1144 (nthcdr (1- move) | |
| 1145 compilation-error-list) | |
| 1146 ;; Zero or negative arg; we need to move back in the list. | |
| 1147 (let ((n (1- move)) | |
| 1148 (i 0) | |
| 1149 (e compilation-old-error-list)) | |
| 1150 ;; See how many cdrs away the current error is from the start. | |
| 1151 (while (not (eq e compilation-error-list)) | |
| 1152 (setq i (1+ i) | |
| 1153 e (cdr e))) | |
| 1154 (if (> (- n) i) | |
| 1155 (error "Moved back past first error") | |
| 1156 (nthcdr (+ i n) compilation-old-error-list)))) | |
| 1157 next-error (car next-errors)) | |
| 1158 (while | |
| 1159 (if (null next-error) | |
| 1160 (progn | |
| 1161 (and move (/= move 1) | |
| 1162 (error (if (> move 0) | |
| 1163 "Moved past last error" | |
| 1164 "Moved back past first error"))) | |
| 1165 ;; Forget existing error messages if compilation has finished. | |
| 1166 ;;; XEmacs change by Barry Warsaw. | |
| 1167 ;;; Without this, if you get a "no more errors" error, then you can't do | |
| 1168 ;;; previous-error or goto-error until you kill the buffer. | |
| 1169 ; (if (not (and (get-buffer-process (current-buffer)) | |
| 1170 ; (eq (process-status | |
| 1171 ; (get-buffer-process | |
| 1172 ; (current-buffer))) | |
| 1173 ; 'run))) | |
| 1174 ; (compilation-forget-errors)) | |
| 1175 (if silent | |
| 1176 (throw 'no-next-error nil) | |
| 1177 (error (concat compilation-error-message | |
| 1178 (and (get-buffer-process (current-buffer)) | |
| 1179 (eq (process-status (get-buffer-process | |
| 1180 (current-buffer))) | |
| 1181 'run) | |
| 1182 " yet"))))) | |
| 1183 (setq compilation-error-list (cdr next-errors)) | |
| 1184 (if (null (cdr next-error)) | |
| 1185 ;; This error is boring. Go to the next. | |
| 1186 t | |
| 1187 (or (markerp (cdr next-error)) | |
| 1188 ;; This error has a filename/lineno pair. | |
| 1189 ;; Find the file and turn it into a marker. | |
| 1190 (let* ((fileinfo (car (cdr next-error))) | |
| 1191 (cbuf (current-buffer)) ;XEmacs addition | |
| 1192 (buffer (apply 'compilation-find-file | |
| 1193 (car next-error) fileinfo))) | |
| 1194 (if (null buffer) | |
| 1195 ;; We can't find this error's file. | |
| 1196 ;; Remove all errors in the same file. | |
| 1197 (progn | |
| 1198 (setq next-errors compilation-old-error-list) | |
| 1199 (while next-errors | |
| 1200 (and (consp (cdr (car next-errors))) | |
| 1201 (equal (car (cdr (car next-errors))) | |
| 1202 fileinfo) | |
| 1203 (progn | |
| 1204 (set-marker (car (car next-errors)) nil) | |
| 1205 (setcdr (car next-errors) nil))) | |
| 1206 (setq next-errors (cdr next-errors))) | |
| 1207 ;; Look for the next error. | |
| 1208 t) | |
| 1209 ;; We found the file. Get a marker for this error. | |
| 1210 ;; compilation-old-error-list is a buffer-local | |
| 1211 ;; variable, so we must be careful to extract its value | |
| 1212 ;; before switching to the source file buffer. | |
| 1213 (let ((errors compilation-old-error-list) | |
| 1214 (last-line (nth 1 (cdr next-error))) | |
| 1215 (column (nth 2 (cdr next-error)))) | |
| 1216 (set-buffer buffer) | |
| 1217 (save-excursion | |
| 1218 (save-restriction | |
| 1219 (widen) | |
| 1220 (goto-line last-line) | |
| 1221 (if (and column (> column 0)) | |
| 1222 ;; Columns in error msgs are 1-origin. | |
| 1223 (move-to-column (1- column)) | |
| 1224 (beginning-of-line)) | |
| 1225 (setcdr next-error (point-marker)) | |
| 1226 ;; Make all the other error messages referring | |
| 1227 ;; to the same file have markers into the buffer. | |
| 1228 (while errors | |
| 1229 (and (consp (cdr (car errors))) | |
| 1230 (equal (car (cdr (car errors))) fileinfo) | |
| 1231 (let* ((this (nth 1 (cdr (car errors)))) | |
| 1232 (column (nth 2 (cdr (car errors)))) | |
| 1233 (lines (- this last-line))) | |
| 1234 (if (eq selective-display t) | |
| 1235 ;; When selective-display is t, | |
| 1236 ;; each C-m is a line boundary, | |
| 1237 ;; as well as each newline. | |
| 1238 (if (< lines 0) | |
| 1239 (re-search-backward "[\n\C-m]" | |
| 1240 nil 'end | |
| 1241 (- lines)) | |
| 1242 (re-search-forward "[\n\C-m]" | |
| 1243 nil 'end | |
| 1244 lines)) | |
| 1245 (forward-line lines)) | |
| 1246 (if (and column (> column 1)) | |
| 1247 (move-to-column (1- column)) | |
| 1248 (beginning-of-line)) | |
| 1249 (setq last-line this) | |
| 1250 (setcdr (car errors) (point-marker)))) | |
| 1251 (setq errors (cdr errors))))) | |
| 1252 ;; XEmacs addition | |
| 1253 (set-buffer cbuf))))) | |
| 1254 ;; If we didn't get a marker for this error, or this | |
| 1255 ;; marker's buffer was killed, go on to the next one. | |
| 1256 (or (not (markerp (cdr next-error))) | |
| 1257 (not (marker-buffer (cdr next-error)))))) | |
| 1258 (setq next-errors compilation-error-list | |
| 1259 next-error (car next-errors))) | |
| 1260 | |
| 1261 ;; XEmacs -- move this inside save-excursion | |
| 1262 ;; Skip over multiple error messages for the same source location, | |
| 1263 ;; so the next C-x ` won't go to an error in the same place. | |
| 1264 (while (and compilation-error-list | |
| 1265 (equal (cdr (car compilation-error-list)) | |
| 1266 (cdr next-error))) | |
| 1267 (setq compilation-error-list (cdr compilation-error-list))) | |
| 1268 )) | |
| 1269 | |
| 1270 ;; XEmacs change: If a new window has to be displayed, select the other | |
| 1271 ;; window to avoid swapping the position of the compilation error buffer. | |
| 1272 (and next-error (get-buffer-window (marker-buffer (car next-error))) | |
| 1273 (progn | |
| 1274 (select-window (get-buffer-window (marker-buffer (car next-error)))) | |
| 1275 (other-window -1))) | |
| 1276 | |
| 1277 ;; We now have a marker for the position of the error source code. | |
| 1278 ;; NEXT-ERROR is a cons (ERROR . SOURCE) of two markers. | |
| 1279 next-error)) | |
| 1280 | |
| 1281 (defun compilation-goto-locus (next-error) | |
| 1282 "Jump to an error locus returned by `compilation-next-error-locus'. | |
| 1283 Takes one argument, a cons (ERROR . SOURCE) of two markers. | |
| 1284 Selects a window with point at SOURCE, with another window displaying ERROR." | |
| 1285 ;; XEmacs: this code is horrendous, and makes windows do all sorts of | |
| 1286 ;; weird things when you're using separate frames for the compilation | |
| 1287 ;; and source buffer. | |
| 1288 ; (if (and (window-dedicated-p (selected-window)) | |
| 1289 ; (eq (selected-window) (frame-root-window))) | |
| 1290 ; (switch-to-buffer-other-frame (marker-buffer (cdr next-error))) | |
| 1291 ; (switch-to-buffer (marker-buffer (cdr next-error)))) | |
| 1292 ; (goto-char (cdr next-error)) | |
| 1293 ; ;; If narrowing got in the way of | |
| 1294 ; ;; going to the right place, widen. | |
| 1295 ; (or (= (point) (marker-position (cdr next-error))) | |
| 1296 ; (progn | |
| 1297 ; (widen) | |
| 1298 ; (goto-char (cdr next-error)))) | |
| 1299 ; | |
| 1300 ; ;; Show compilation buffer in other window, scrolled to this error. | |
| 1301 ; (let* ((pop-up-windows t) | |
| 1302 ; (w (or (get-buffer-window (marker-buffer (car next-error)) 'visible) | |
| 1303 ; (display-buffer (marker-buffer (car next-error)))))) | |
| 1304 ; (set-window-point w (car next-error)) | |
| 1305 ; (set-window-start w (car next-error)) | |
| 1306 ; (compilation-set-window-height w))) | |
| 1307 | |
| 1308 (let* ((pop-up-windows t) | |
| 1309 (compilation-buffer (marker-buffer (car next-error))) | |
| 1310 (source-buffer (marker-buffer (cdr next-error))) | |
| 1311 ;; make sure compilation buffer is visible ... | |
| 1312 (compilation-window | |
| 1313 ;; Use an existing window if it is in a visible frame. | |
| 1314 (or (get-buffer-window compilation-buffer 'visible) | |
| 1315 ;; Pop up a window. | |
| 1316 (display-buffer compilation-buffer)))) | |
| 1317 | |
| 1318 ;; now, make the compilation buffer **STAY WHERE IT IS** and | |
| 1319 ;; make sure the source buffer is visible | |
| 1320 | |
| 1321 (select-window compilation-window) | |
| 1322 (pop-to-buffer source-buffer) | |
| 1323 | |
| 1324 ;; now put things aright in the compilation window. | |
| 1325 (set-window-point compilation-window (car next-error)) | |
| 1326 (set-window-start compilation-window (car next-error)) | |
| 1327 (compilation-set-window-height compilation-window) | |
| 1328 | |
| 1329 ;; now put things aright in the source window. | |
| 1330 | |
| 1331 (set-buffer source-buffer) | |
| 1332 (goto-char (cdr next-error)) | |
| 1333 ;; If narrowing got in the way of | |
| 1334 ;; going to the right place, widen. | |
| 1335 (or (= (point) (marker-position (cdr next-error))) | |
| 1336 (progn | |
| 1337 (widen) | |
| 1338 (goto-char (cdr next-error)))))) | |
| 1339 | |
| 1340 ;;;###autoload (define-key ctl-x-map "`" 'next-error) | |
| 1341 | |
| 1342 ;; Find a buffer for file FILENAME. | |
| 1343 ;; Search the directories in compilation-search-path. | |
| 1344 ;; A nil in compilation-search-path means to try the | |
| 1345 ;; current directory, which is passed in DIR. | |
| 1346 ;; If FILENAME is not found at all, ask the user where to find it. | |
| 1347 ;; Pop up the buffer containing MARKER and scroll to MARKER if we ask the user. | |
| 1348 (defun compilation-find-file (marker filename dir &rest formats) | |
| 1349 (or formats (setq formats '("%s"))) | |
| 1350 (let ((dirs compilation-search-path) | |
| 1351 buffer thisdir fmts name) | |
| 1352 (if (file-name-absolute-p filename) | |
| 1353 ;; The file name is absolute. Use its explicit directory as | |
| 1354 ;; the first in the search path, and strip it from FILENAME. | |
| 1355 (setq filename (abbreviate-file-name (expand-file-name filename)) | |
| 1356 dirs (cons (file-name-directory filename) dirs) | |
| 1357 filename (file-name-nondirectory filename))) | |
| 1358 ;; Now search the path. | |
| 1359 (while (and dirs (null buffer)) | |
| 1360 (setq thisdir (or (car dirs) dir) | |
| 1361 fmts formats) | |
| 1362 ;; For each directory, try each format string. | |
| 1363 (while (and fmts (null buffer)) | |
| 1364 (setq name (expand-file-name (format (car fmts) filename) thisdir) | |
| 1365 buffer (and (file-exists-p name) | |
| 1366 (find-file-noselect name)) | |
| 1367 fmts (cdr fmts))) | |
| 1368 (setq dirs (cdr dirs))) | |
| 1369 (or buffer | |
| 1370 ;; The file doesn't exist. | |
| 1371 ;; Ask the user where to find it. | |
| 1372 ;; If he hits C-g, then the next time he does | |
| 1373 ;; next-error, he'll skip past it. | |
| 1374 (let* ((pop-up-windows t) | |
| 1375 (w (display-buffer (marker-buffer marker)))) | |
| 1376 (set-window-point w marker) | |
| 1377 (set-window-start w marker) | |
| 1378 (let ((name (expand-file-name | |
| 1379 (read-file-name | |
| 1380 (format "Find this error in: (default %s) " | |
| 1381 filename) | |
| 1382 dir filename t)))) | |
| 1383 (if (file-directory-p name) | |
| 1384 (setq name (expand-file-name filename name))) | |
| 1385 (and (file-exists-p name) | |
| 1386 (find-file-noselect name))))))) | |
| 1387 | |
| 1388 ;; Set compilation-error-list to nil, and unchain the markers that point to the | |
| 1389 ;; error messages and their text, so that they no longer slow down gap motion. | |
| 1390 ;; This would happen anyway at the next garbage collection, but it is better to | |
| 1391 ;; do it right away. | |
| 1392 (defun compilation-forget-errors () | |
| 1393 (while compilation-old-error-list | |
| 1394 (let ((next-error (car compilation-old-error-list))) | |
| 1395 (set-marker (car next-error) nil) | |
| 1396 (if (markerp (cdr next-error)) | |
| 1397 (set-marker (cdr next-error) nil))) | |
| 1398 (setq compilation-old-error-list (cdr compilation-old-error-list))) | |
| 1399 (setq compilation-error-list nil | |
| 1400 compilation-directory-stack nil | |
| 1401 compilation-parsing-end 1)) | |
| 1402 | |
| 1403 | |
| 1404 (defun count-regexp-groupings (regexp) | |
| 1405 "Return the number of \\( ... \\) groupings in REGEXP (a string)." | |
| 1406 (let ((groupings 0) | |
| 1407 (len (length regexp)) | |
| 1408 (i 0) | |
| 1409 c) | |
| 1410 (while (< i len) | |
| 1411 (setq c (aref regexp i) | |
| 1412 i (1+ i)) | |
| 1413 (cond ((= c ?\[) | |
| 1414 ;; Find the end of this [...]. | |
| 1415 (while (and (< i len) | |
| 1416 (not (= (aref regexp i) ?\]))) | |
| 1417 (setq i (1+ i)))) | |
| 1418 ((= c ?\\) | |
| 1419 (if (< i len) | |
| 1420 (progn | |
| 1421 (setq c (aref regexp i) | |
| 1422 i (1+ i)) | |
| 1423 (if (= c ?\)) | |
| 1424 ;; We found the end of a grouping, | |
| 1425 ;; so bump our counter. | |
| 1426 (setq groupings (1+ groupings)))))))) | |
| 1427 groupings)) | |
| 1428 | |
| 1429 (defun compilation-parse-errors (limit-search find-at-least) | |
| 1430 "Parse the current buffer as grep, cc or lint error messages. | |
| 1431 See variable `compilation-parse-errors-function' for the interface it uses." | |
| 1432 (setq compilation-error-list nil) | |
| 1433 (message "Parsing error messages...") | |
| 1434 (let (;;text-buffer -- unused | |
| 1435 orig orig-expanded parent-expanded | |
| 1436 regexp enter-group leave-group error-group | |
| 1437 alist subexpr error-regexp-groups | |
| 1438 (found-desired nil) | |
| 1439 (compilation-num-errors-found 0)) | |
| 1440 | |
| 1441 ;; Don't reparse messages already seen at last parse. | |
| 1442 (goto-char compilation-parsing-end) | |
| 1443 ;; Don't parse the first two lines as error messages. | |
| 1444 ;; This matters for grep. | |
| 1445 (if (bobp) | |
| 1446 (progn | |
| 1447 (forward-line 2) | |
| 1448 ;; Move back so point is before the newline. | |
| 1449 ;; This matters because some error regexps use \n instead of ^ | |
| 1450 ;; to be faster. | |
| 1451 (forward-char -1))) | |
| 1452 | |
| 1453 ;; Compile all the regexps we want to search for into one. | |
| 1454 (setq regexp (concat "\\(" compilation-enter-directory-regexp "\\)\\|" | |
| 1455 "\\(" compilation-leave-directory-regexp "\\)\\|" | |
| 1456 "\\(" (mapconcat (function | |
| 1457 (lambda (elt) | |
| 1458 (concat "\\(" (car elt) "\\)"))) | |
| 1459 compilation-error-regexp-alist | |
| 1460 "\\|") "\\)")) | |
| 1461 | |
| 1462 ;; Find out how many \(...\) groupings are in each of the regexps, and set | |
| 1463 ;; *-GROUP to the grouping containing each constituent regexp (whose | |
| 1464 ;; subgroups will come immediately thereafter) of the big regexp we have | |
| 1465 ;; just constructed. | |
| 1466 (setq enter-group 1 | |
| 1467 leave-group (+ enter-group | |
| 1468 (count-regexp-groupings | |
| 1469 compilation-enter-directory-regexp) | |
| 1470 1) | |
| 1471 error-group (+ leave-group | |
| 1472 (count-regexp-groupings | |
| 1473 compilation-leave-directory-regexp) | |
| 1474 1)) | |
| 1475 | |
| 1476 ;; Compile an alist (IDX FILE LINE [COL]), where IDX is the number of | |
| 1477 ;; the subexpression for an entire error-regexp, and FILE and LINE (and | |
| 1478 ;; possibly COL) are the numbers for the subexpressions giving the file | |
| 1479 ;; name and line number (and possibly column number). | |
| 1480 (setq alist (or compilation-error-regexp-alist | |
| 1481 (error "compilation-error-regexp-alist is empty!")) | |
| 1482 subexpr (1+ error-group)) | |
| 1483 (while alist | |
| 1484 (setq error-regexp-groups (cons (list subexpr | |
| 1485 (+ subexpr (nth 1 (car alist))) | |
| 1486 (+ subexpr (nth 2 (car alist))) | |
| 1487 ;;#### This is buggy in FSFmacs | |
| 1488 (let ((col (nth 3 (car alist)))) | |
| 1489 (and col | |
| 1490 (+ subexpr col)))) | |
| 1491 error-regexp-groups)) | |
| 1492 (setq subexpr (+ subexpr 1 (count-regexp-groupings (car (car alist))))) | |
| 1493 (setq alist (cdr alist))) | |
| 1494 | |
| 1495 ;; Set up now the expanded, abbreviated directory variables | |
| 1496 ;; that compile-abbreviate-directory will need, so we can | |
| 1497 ;; compute them just once here. | |
| 1498 (setq orig (abbreviate-file-name default-directory) | |
| 1499 orig-expanded (abbreviate-file-name | |
| 1500 (file-truename default-directory)) | |
| 1501 parent-expanded (abbreviate-file-name | |
| 1502 (expand-file-name "../" orig-expanded))) | |
| 1503 | |
| 1504 (while (and (not found-desired) | |
| 1505 ;; We don't just pass LIMIT-SEARCH to re-search-forward | |
| 1506 ;; because we want to find matches containing LIMIT-SEARCH | |
| 1507 ;; but which extend past it. | |
| 1508 (re-search-forward regexp nil t)) | |
| 1509 | |
| 1510 ;; Figure out which constituent regexp matched. | |
| 1511 (cond ((match-beginning enter-group) | |
| 1512 ;; The match was the enter-directory regexp. | |
| 1513 (let ((dir | |
| 1514 (file-name-as-directory | |
| 1515 (expand-file-name | |
| 1516 (buffer-substring (match-beginning (+ enter-group 1)) | |
| 1517 (match-end (+ enter-group 1))))))) | |
| 1518 ;; The directory name in the "entering" message | |
| 1519 ;; is a truename. Try to convert it to a form | |
| 1520 ;; like what the user typed in. | |
| 1521 (setq dir | |
| 1522 (compile-abbreviate-directory dir orig orig-expanded | |
| 1523 parent-expanded)) | |
| 1524 (setq compilation-directory-stack | |
| 1525 (cons dir compilation-directory-stack)) | |
| 1526 (and (file-directory-p dir) | |
| 1527 (setq default-directory dir))) | |
| 1528 | |
| 1529 (and limit-search (>= (point) limit-search) | |
| 1530 ;; The user wanted a specific error, and we're past it. | |
| 1531 ;; We do this check here (and in the leave-group case) | |
| 1532 ;; rather than at the end of the loop because if the last | |
| 1533 ;; thing seen is an error message, we must carefully | |
| 1534 ;; discard the last error when it is the first in a new | |
| 1535 ;; file (see below in the error-group case). | |
| 1536 (setq found-desired t))) | |
| 1537 | |
| 1538 ((match-beginning leave-group) | |
| 1539 ;; The match was the leave-directory regexp. | |
| 1540 (let ((beg (match-beginning (+ leave-group 1))) | |
| 1541 (stack compilation-directory-stack)) | |
| 1542 (if beg | |
| 1543 (let ((dir | |
| 1544 (file-name-as-directory | |
| 1545 (expand-file-name | |
| 1546 (buffer-substring beg | |
| 1547 (match-end (+ leave-group | |
| 1548 1))))))) | |
| 1549 ;; The directory name in the "leaving" message | |
| 1550 ;; is a truename. Try to convert it to a form | |
| 1551 ;; like what the user typed in. | |
| 1552 (setq dir | |
| 1553 (compile-abbreviate-directory dir orig orig-expanded | |
| 1554 parent-expanded)) | |
| 1555 (while (and stack | |
| 1556 (not (string-equal (car stack) dir))) | |
| 1557 (setq stack (cdr stack))))) | |
| 1558 (setq compilation-directory-stack (cdr stack)) | |
| 1559 (setq stack (car compilation-directory-stack)) | |
| 1560 (if stack | |
| 1561 (setq default-directory stack)) | |
| 1562 ) | |
| 1563 | |
| 1564 (and limit-search (>= (point) limit-search) | |
| 1565 ;; The user wanted a specific error, and we're past it. | |
| 1566 ;; We do this check here (and in the enter-group case) | |
| 1567 ;; rather than at the end of the loop because if the last | |
| 1568 ;; thing seen is an error message, we must carefully | |
| 1569 ;; discard the last error when it is the first in a new | |
| 1570 ;; file (see below in the error-group case). | |
| 1571 (setq found-desired t))) | |
| 1572 | |
| 1573 ((match-beginning error-group) | |
| 1574 ;; The match was the composite error regexp. | |
| 1575 ;; Find out which individual regexp matched. | |
| 1576 (setq alist error-regexp-groups) | |
| 1577 (while (and alist | |
| 1578 (null (match-beginning (car (car alist))))) | |
| 1579 (setq alist (cdr alist))) | |
| 1580 (if alist | |
| 1581 (setq alist (car alist)) | |
| 1582 (error "compilation-parse-errors: impossible regexp match!")) | |
| 1583 | |
| 1584 ;; Extract the file name and line number from the error message. | |
| 1585 (let ((beginning-of-match (match-beginning 0)) ;looking-at nukes | |
| 1586 (filename (buffer-substring (match-beginning (nth 1 alist)) | |
| 1587 (match-end (nth 1 alist)))) | |
| 1588 (linenum (string-to-int | |
| 1589 (buffer-substring | |
| 1590 (match-beginning (nth 2 alist)) | |
| 1591 (match-end (nth 2 alist))))) | |
| 1592 (column (and (nth 3 alist) | |
| 1593 (match-beginning (nth 3 alist)) | |
| 1594 (string-to-int | |
| 1595 (buffer-substring | |
| 1596 (match-beginning (nth 3 alist)) | |
| 1597 (match-end (nth 3 alist))))))) | |
| 1598 | |
| 1599 ;; Check for a comint-file-name-prefix and prepend it if | |
| 1600 ;; appropriate. (This is very useful for | |
| 1601 ;; compilation-minor-mode in an rlogin-mode buffer.) | |
| 1602 (and (boundp 'comint-file-name-prefix) | |
| 1603 ;; If the file name is relative, default-directory will | |
| 1604 ;; already contain the comint-file-name-prefix (done by | |
| 1605 ;; compile-abbreviate-directory). | |
| 1606 (file-name-absolute-p filename) | |
| 1607 (setq filename (concat comint-file-name-prefix filename))) | |
| 1608 (setq filename (cons filename (cons default-directory | |
| 1609 (nthcdr 4 alist)))) | |
| 1610 | |
| 1611 | |
| 1612 ;; Locate the erring file and line. | |
| 1613 ;; Cons a new elt onto compilation-error-list, | |
| 1614 ;; giving a marker for the current compilation buffer | |
| 1615 ;; location, and the file and line number of the error. | |
| 1616 (save-excursion | |
| 1617 ;; Save as the start of the error the beginning of the | |
| 1618 ;; line containing the match unless the match starts at a | |
| 1619 ;; newline, in which case the beginning of the next line. | |
| 1620 (goto-char beginning-of-match) | |
| 1621 (forward-line (if (eolp) 1 0)) | |
| 1622 (let ((this (cons (point-marker) | |
| 1623 (list filename linenum column)))) | |
| 1624 ;; Don't add the same source line more than once. | |
| 1625 (if (equal (cdr this) (cdr (car compilation-error-list))) | |
| 1626 nil | |
| 1627 (setq compilation-error-list | |
| 1628 (cons this | |
| 1629 compilation-error-list)) | |
| 1630 (setq compilation-num-errors-found | |
| 1631 (1+ compilation-num-errors-found))))) | |
| 1632 (and (or (and find-at-least (> compilation-num-errors-found | |
| 1633 find-at-least)) | |
| 1634 (and limit-search (>= (point) limit-search))) | |
| 1635 ;; We have found as many new errors as the user wants, | |
| 1636 ;; or past the buffer position he indicated. We | |
| 1637 ;; continue to parse until we have seen all the | |
| 1638 ;; consecutive errors in the same file, so the error | |
| 1639 ;; positions will be recorded as markers in this buffer | |
| 1640 ;; that might change. | |
| 1641 (cdr compilation-error-list) ; Must check at least two. | |
| 1642 (not (equal (car (cdr (nth 0 compilation-error-list))) | |
| 1643 (car (cdr (nth 1 compilation-error-list))))) | |
| 1644 (progn | |
| 1645 ;; Discard the error just parsed, so that the next | |
| 1646 ;; parsing run can get it and the following errors in | |
| 1647 ;; the same file all at once. If we didn't do this, we | |
| 1648 ;; would have the same problem we are trying to avoid | |
| 1649 ;; with the test above, just delayed until the next run! | |
| 1650 (setq compilation-error-list | |
| 1651 (cdr compilation-error-list)) | |
| 1652 (goto-char beginning-of-match) | |
| 1653 (setq found-desired t))) | |
| 1654 ) | |
| 1655 ) | |
| 1656 (t | |
| 1657 (error "compilation-parse-errors: known groups didn't match!"))) | |
| 1658 | |
| 1659 (message "Parsing error messages...%d (%d%% of buffer)" | |
| 1660 compilation-num-errors-found | |
| 1661 (/ (* 100 (point)) (point-max))) | |
| 1662 | |
| 1663 (and limit-search (>= (point) limit-search) | |
| 1664 ;; The user wanted a specific error, and we're past it. | |
| 1665 (setq found-desired t))) | |
| 1666 (setq compilation-parsing-end (if found-desired | |
| 1667 (point) | |
| 1668 ;; We have searched the whole buffer. | |
| 1669 (point-max)))) | |
| 1670 (setq compilation-error-list (nreverse compilation-error-list)) | |
| 1671 (message "Parsing error messages...done")) | |
| 1672 | |
| 1673 ;; If directory DIR is a subdir of ORIG or of ORIG's parent, | |
| 1674 ;; return a relative name for it starting from ORIG or its parent. | |
| 1675 ;; ORIG-EXPANDED is an expanded version of ORIG. | |
| 1676 ;; PARENT-EXPANDED is an expanded version of ORIG's parent. | |
| 1677 ;; Those two args could be computed here, but we run faster by | |
| 1678 ;; having the caller compute them just once. | |
| 1679 (defun compile-abbreviate-directory (dir orig orig-expanded parent-expanded) | |
| 1680 ;; Apply canonical abbreviations to DIR first thing. | |
| 1681 ;; Those abbreviations are already done in the other arguments passed. | |
| 1682 (setq dir (abbreviate-file-name dir)) | |
| 1683 | |
| 1684 ;; Check for a comint-file-name-prefix and prepend it if appropriate. | |
| 1685 ;; (This is very useful for compilation-minor-mode in an rlogin-mode | |
| 1686 ;; buffer.) | |
| 1687 (if (boundp 'comint-file-name-prefix) | |
| 1688 (setq dir (concat comint-file-name-prefix dir))) | |
| 1689 | |
| 1690 (if (and (> (length dir) (length orig-expanded)) | |
| 1691 (string= orig-expanded | |
| 1692 (substring dir 0 (length orig-expanded)))) | |
| 1693 (setq dir | |
| 1694 (concat orig | |
| 1695 (substring dir (length orig-expanded))))) | |
| 1696 (if (and (> (length dir) (length parent-expanded)) | |
| 1697 (string= parent-expanded | |
| 1698 (substring dir 0 (length parent-expanded)))) | |
| 1699 (setq dir | |
| 1700 (concat (file-name-directory | |
| 1701 (directory-file-name orig)) | |
| 1702 (substring dir (length parent-expanded))))) | |
| 1703 dir) | |
| 1704 | |
| 1705 | |
| 1706 (provide 'compile) | |
| 1707 | |
| 1708 ;;; compile.el ends here |