1;;; compile.el --- run compiler as inferior of Emacs, parse error messages. 2 3;; Copyright (C) 1985, 86, 87, 93, 94 Free Software Foundation, Inc. 4 5;; Author: Roland McGrath <roland@prep.ai.mit.edu> 6;; Maintainer: FSF 7;; Keywords: tools, processes 8 9;; This file is part of GNU Emacs. 10 11;; GNU Emacs is free software; you can redistribute it and/or modify 12;; it under the terms of the GNU General Public License as published by 13;; the Free Software Foundation; either version 2, or (at your option) 14;; any later version. 15 16;; GNU Emacs is distributed in the hope that it will be useful, 17;; but WITHOUT ANY WARRANTY; without even the implied warranty of 18;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 19;; GNU General Public License for more details. 20 21;; You should have received a copy of the GNU General Public License 22;; along with GNU Emacs; see the file COPYING. If not, write to 23;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. 24 25;;; Commentary: 26 27;; This package provides the compile and grep facilities documented in 28;; the Emacs user's manual. 29 30;;; Code: 31 32;;;###autoload 33(defvar compilation-mode-hook nil 34 "*List of hook functions run by `compilation-mode' (see `run-hooks').") 35 36;;;###autoload 37(defconst compilation-window-height nil 38 "*Number of lines in a compilation window. If nil, use Emacs default.") 39 40(defvar compilation-error-list nil 41 "List of error message descriptors for visiting erring functions. 42Each error descriptor is a cons (or nil). Its car is a marker pointing to 43an error message. If its cdr is a marker, it points to the text of the 44line the message is about. If its cdr is a cons, it is a list 45\(\(DIRECTORY . FILE\) LINE [COLUMN]\). Or its cdr may be nil if that 46error is not interesting. 47 48The value may be t instead of a list; this means that the buffer of 49error messages should be reparsed the next time the list of errors is wanted. 50 51Some other commands (like `diff') use this list to control the error 52message tracking facilites; if you change its structure, you should make 53sure you also change those packages. Perhaps it is better not to change 54it at all.") 55 56(defvar compilation-old-error-list nil 57 "Value of `compilation-error-list' after errors were parsed.") 58 59(defvar compilation-parse-errors-function 'compilation-parse-errors 60 "Function to call to parse error messages from a compilation. 61It takes args LIMIT-SEARCH and FIND-AT-LEAST. 62If LIMIT-SEARCH is non-nil, don't bother parsing past that location. 63If FIND-AT-LEAST is non-nil, don't bother parsing after finding that 64many new errors. 65It should read in the source files which have errors and set 66`compilation-error-list' to a list with an element for each error message 67found. See that variable for more info.") 68 69;;;###autoload 70(defvar compilation-buffer-name-function nil 71 "Function to compute the name of a compilation buffer. 72The function receives one argument, the name of the major mode of the 73compilation buffer. It should return a string. 74nil means compute the name with `(concat \"*\" (downcase major-mode) \"*\")'.") 75 76;;;###autoload 77(defvar compilation-finish-function nil 78 "*Function to call when a compilation process finishes. 79It is called with two arguments: the compilation buffer, and a string 80describing how the process finished.") 81 82(defvar compilation-last-buffer nil 83 "The most recent compilation buffer. 84A buffer becomes most recent when its compilation is started 85or when it is used with \\[next-error] or \\[compile-goto-error].") 86 87(defvar compilation-in-progress nil 88 "List of compilation processes now running.") 89(or (assq 'compilation-in-progress minor-mode-alist) 90 (setq minor-mode-alist (cons '(compilation-in-progress " Compiling") 91 minor-mode-alist))) 92 93(defvar compilation-parsing-end nil 94 "Position of end of buffer when last error messages were parsed.") 95 96(defvar compilation-error-message "No more errors" 97 "Message to print when no more matches are found.") 98 99(defvar compilation-num-errors-found) 100 101(defvar compilation-error-regexp-alist 102 '( 103 ;; NOTE! This first one is repeated in grep-regexp-alist, below. 104 105 ;; 4.3BSD grep, cc, lint pass 1: 106 ;; /usr/src/foo/foo.c(8): warning: w may be used before set 107 ;; or GNU utilities: 108 ;; foo.c:8: error message 109 ;; or HP-UX 7.0 fc: 110 ;; foo.f :16 some horrible error message 111 ;; 112 ;; We'll insist that the number be followed by a colon or closing 113 ;; paren, because otherwise this matches just about anything 114 ;; containing a number with spaces around it. 115 ("\n\\([^:( \t\n]+\\)[:(][ \t]*\\([0-9]+\\)[:) \t]" 1 2) 116 117 ;; 4.3BSD lint pass 2 118 ;; strcmp: variable # of args. llib-lc(359) :: /usr/src/foo/foo.c(8) 119 ("[ \t:]\\([^:( \t\n]+\\)[:(](+[ \t]*\\([0-9]+\\))[:) \t]*$" 1 2) 120 121 ;; 4.3BSD lint pass 3 122 ;; bloofle defined( /users/wolfgang/foo.c(4) ), but never used 123 ;; This used to be 124 ;; ("[ \t(]+\\([^:( \t\n]+\\)[:( \t]+\\([0-9]+\\)[:) \t]+" 1 2) 125 ;; which is regexp Impressionism - it matches almost anything! 126 ("([ \t]*\\([^:( \t\n]+\\)[:(][ \t]*\\([0-9]+\\))" 1 2) 127 128 ;; Ultrix 3.0 f77: 129 ;; fort: Severe: addstf.f, line 82: Missing operator or delimiter symbol 130 ("\nfort: [^:\n]*: \\([^ \n]*\\), line \\([0-9]+\\):" 1 2) 131 ;; Error on line 3 of t.f: Execution error unclassifiable statement 132 ;; Unknown who does this: 133 ;; Line 45 of "foo.c": bloofel undefined 134 ;; Absoft FORTRAN 77 Compiler 3.1.3 135 ;; error on line 19 of fplot.f: spelling error? 136 ;; warning on line 17 of fplot.f: data type is undefined for variable d 137 ("\\(\n\\|on \\)[Ll]ine[ \t]+\\([0-9]+\\)[ \t]+\ 138of[ \t]+\"?\\([^\":\n]+\\)\"?:" 3 2) 139 140 ;; Apollo cc, 4.3BSD fc: 141 ;; "foo.f", line 3: Error: syntax error near end of statement 142 ;; IBM RS6000: 143 ;; "vvouch.c", line 19.5: 1506-046 (S) Syntax error. 144 ;; Unknown compiler: 145 ;; File "foobar.ml", lines 5-8, characters 20-155: blah blah 146 ;; Microtec mcc68k: 147 ;; "foo.c", line 32 pos 1; (E) syntax error; unexpected symbol: "lossage" 148 ("\"\\([^,\" \n\t]+\\)\", lines? \\([0-9]+\\)[:., -]" 1 2) 149 150 ;; MIPS RISC CC - the one distributed with Ultrix: 151 ;; ccom: Error: foo.c, line 2: syntax error 152 ;; DEC AXP OSF/1 cc 153 ;; /usr/lib/cmplrs/cc/cfe: Error: foo.c: 1: blah blah 154 ("rror: \\([^,\" \n\t]+\\)[,:] \\(line \\)?\\([0-9]+\\):" 1 3) 155 156 ;; IBM AIX PS/2 C version 1.1: 157 ;; ****** Error number 140 in line 8 of file errors.c ****** 158 ("in line \\([0-9]+\\) of file \\([^ \n]+[^. \n]\\)\\.? " 2 1) 159 ;; IBM AIX lint is too painful to do right this way. File name 160 ;; prefixes entire sections rather than being on each line. 161 162 ;; Lucid Compiler, lcc 3.x 163 ;; E, file.cc(35,52) Illegal operation on pointers 164 ("\n[EW], \\([^(\n]*\\)(\\([0-9]+\\),[ \t]*\\([0-9]+\\)" 1 2 3) 165 166 ) 167 "Alist that specifies how to match errors in compiler output. 168Each element has the form (REGEXP FILE-IDX LINE-IDX [COLUMN-IDX]). 169If REGEXP matches, the FILE-IDX'th subexpression gives the file name, and 170the LINE-IDX'th subexpression gives the line number. If COLUMN-IDX is 171given, the COLUMN-IDX'th subexpression gives the column number on that line.") 172 173(defvar compilation-read-command t 174 "If not nil, M-x compile reads the compilation command to use. 175Otherwise, M-x compile just uses the value of `compile-command'.") 176 177(defvar compilation-ask-about-save t 178 "If not nil, M-x compile asks which buffers to save before compiling. 179Otherwise, it saves all modified buffers without asking.") 180 181(defvar grep-regexp-alist 182 '(("^\\([^:( \t\n]+\\)[:( \t]+\\([0-9]+\\)[:) \t]" 1 2)) 183 "Regexp used to match grep hits. See `compilation-error-regexp-alist'.") 184 185(defvar grep-command "grep -n " 186 "Last grep command used in \\{grep}; default for next grep.") 187 188;;;###autoload 189(defvar compilation-search-path '(nil) 190 "*List of directories to search for source files named in error messages. 191Elements should be directory names, not file names of directories. 192nil as an element means to try the default directory.") 193 194(defvar compile-command "make -k " 195 "Last shell command used to do a compilation; default for next compilation. 196 197Sometimes it is useful for files to supply local values for this variable. 198You might also use mode hooks to specify it in certain modes, like this: 199 200 (setq c-mode-hook 201 '(lambda () (or (file-exists-p \"makefile\") (file-exists-p \"Makefile\") 202 (progn (make-local-variable 'compile-command) 203 (setq compile-command 204 (concat \"make -k \" 205 buffer-file-name))))))") 206 207(defconst compilation-enter-directory-regexp 208 ": Entering directory `\\(.*\\)'$" 209 "Regular expression matching lines that indicate a new current directory. 210This must contain one \\(, \\) pair around the directory name. 211 212The default value matches lines printed by the `-w' option of GNU Make.") 213 214(defconst compilation-leave-directory-regexp 215 ": Leaving directory `\\(.*\\)'$" 216 "Regular expression matching lines that indicate restoring current directory. 217This may contain one \\(, \\) pair around the name of the directory 218being moved from. If it does not, the last directory entered \(by a 219line matching `compilation-enter-directory-regexp'\) is assumed. 220 221The default value matches lines printed by the `-w' option of GNU Make.") 222 223(defvar compilation-directory-stack nil 224 "Stack of previous directories for `compilation-leave-directory-regexp'. 225The head element is the directory the compilation was started in.") 226 227;; History of compile commands. 228(defvar compile-history nil) 229;; History of grep commands. 230(defvar grep-history nil) 231 232;;;###autoload 233(defun compile (command) 234 "Compile the program including the current buffer. Default: run `make'. 235Runs COMMAND, a shell command, in a separate process asynchronously 236with output going to the buffer `*compilation*'. 237 238You can then use the command \\[next-error] to find the next error message 239and move to the source code that caused it. 240 241To run more than one compilation at once, start one and rename the 242\`*compilation*' buffer to some other name with \\[rename-buffer]. 243Then start the next one. 244 245The name used for the buffer is actually whatever is returned by 246the function in `compilation-buffer-name-function', so you can set that 247to a function that generates a unique name." 248 (interactive 249 (if compilation-read-command 250 (list (read-from-minibuffer "Compile command: " 251 compile-command nil nil 252 '(compile-history . 1))) 253 (list compile-command))) 254 (setq compile-command command) 255 (save-some-buffers (not compilation-ask-about-save) nil) 256 (compile-internal compile-command "No more errors")) 257 258;;;###autoload 259(defun grep (command-args) 260 "Run grep, with user-specified args, and collect output in a buffer. 261While grep runs asynchronously, you can use the \\[next-error] command 262to find the text that grep hits refer to. 263 264This command uses a special history list for its arguments, so you can 265easily repeat a grep command." 266 (interactive 267 (list (read-from-minibuffer "Run grep (like this): " 268 grep-command nil nil 'grep-history))) 269 (compile-internal (concat command-args " /dev/null") 270 "No more grep hits" "grep" 271 ;; Give it a simpler regexp to match. 272 nil grep-regexp-alist)) 273 274(defun compile-internal (command error-message 275 &optional name-of-mode parser regexp-alist 276 name-function) 277 "Run compilation command COMMAND (low level interface). 278ERROR-MESSAGE is a string to print if the user asks to see another error 279and there are no more errors. Third argument NAME-OF-MODE is the name 280to display as the major mode in the compilation buffer. 281 282Fourth arg PARSER is the error parser function (nil means the default). Fifth 283arg REGEXP-ALIST is the error message regexp alist to use (nil means the 284default). Sixth arg NAME-FUNCTION is a function called to name the buffer (nil 285means the default). The defaults for these variables are the global values of 286\`compilation-parse-errors-function', `compilation-error-regexp-alist', and 287\`compilation-buffer-name-function', respectively. 288 289Returns the compilation buffer created." 290 (let (outbuf) 291 (save-excursion 292 (or name-of-mode 293 (setq name-of-mode "Compilation")) 294 (setq outbuf 295 (get-buffer-create 296 (funcall (or name-function compilation-buffer-name-function 297 (function (lambda (mode) 298 (concat "*" (downcase mode) "*")))) 299 name-of-mode))) 300 (set-buffer outbuf) 301 (let ((comp-proc (get-buffer-process (current-buffer)))) 302 (if comp-proc 303 (if (or (not (eq (process-status comp-proc) 'run)) 304 (yes-or-no-p 305 (format "A %s process is running; kill it? " 306 name-of-mode))) 307 (condition-case () 308 (progn 309 (interrupt-process comp-proc) 310 (sit-for 1) 311 (delete-process comp-proc)) 312 (error nil)) 313 (error "Cannot have two processes in `%s' at once" 314 (buffer-name)) 315 ))) 316 ;; In case the compilation buffer is current, make sure we get the global 317 ;; values of compilation-error-regexp-alist, etc. 318 (kill-all-local-variables)) 319 (let ((regexp-alist (or regexp-alist compilation-error-regexp-alist)) 320 (parser (or parser compilation-parse-errors-function)) 321 (thisdir default-directory) 322 outwin) 323 (save-excursion 324 ;; Clear out the compilation buffer and make it writable. 325 ;; Change its default-directory to the directory where the compilation 326 ;; will happen, and insert a `cd' command to indicate this. 327 (set-buffer outbuf) 328 (setq buffer-read-only nil) 329 (erase-buffer) 330 (setq default-directory thisdir) 331 (insert "cd " thisdir "\n" command "\n") 332 (set-buffer-modified-p nil)) 333 ;; If we're already in the compilation buffer, go to the end 334 ;; of the buffer, so point will track the compilation output. 335 (if (eq outbuf (current-buffer)) 336 (goto-char (point-max))) 337 ;; Pop up the compilation buffer. 338 (setq outwin (display-buffer outbuf)) 339 (save-excursion 340 (set-buffer outbuf) 341 (compilation-mode) 342 (buffer-disable-undo (current-buffer)) 343 ;; (setq buffer-read-only t) ;;; Non-ergonomic. 344 (set (make-local-variable 'compilation-parse-errors-function) parser) 345 (set (make-local-variable 'compilation-error-message) error-message) 346 (set (make-local-variable 'compilation-error-regexp-alist) regexp-alist) 347 (setq default-directory thisdir 348 compilation-directory-stack (list default-directory)) 349 (set-window-start outwin (point-min)) 350 (setq mode-name name-of-mode) 351 (or (eq outwin (selected-window)) 352 (set-window-point outwin (point-min))) 353 (and compilation-window-height 354 (= (window-width outwin) (frame-width)) 355 (let ((w (selected-window))) 356 (unwind-protect 357 (progn 358 (select-window outwin) 359 (enlarge-window (- compilation-window-height 360 (window-height)))) 361 (select-window w)))) 362 ;; Start the compilation. 363 (if (fboundp 'start-process) 364 (let ((proc (start-process-shell-command (downcase mode-name) 365 outbuf 366 command))) 367 (set-process-sentinel proc 'compilation-sentinel) 368 (set-process-filter proc 'compilation-filter) 369 (set-marker (process-mark proc) (point) outbuf) 370 (setq compilation-in-progress 371 (cons proc compilation-in-progress))) 372 ;; No asynchronous processes available 373 (message (format "Executing `%s'..." command)) 374 (let ((status (call-process shell-file-name nil outbuf nil "-c" 375 command)))) 376 (message (format "Executing `%s'...done" command))))) 377 ;; Make it so the next C-x ` will use this buffer. 378 (setq compilation-last-buffer outbuf))) 379 380(defvar compilation-minor-mode-map 381 (let ((map (make-sparse-keymap))) 382 (define-key map [mouse-2] 'compile-mouse-goto-error) 383 (define-key map "\C-c\C-c" 'compile-goto-error) 384 (define-key map "\C-c\C-k" 'kill-compilation) 385 (define-key map "\M-n" 'compilation-next-error) 386 (define-key map "\M-p" 'compilation-previous-error) 387 (define-key map "\M-{" 'compilation-previous-file) 388 (define-key map "\M-}" 'compilation-next-file) 389 map) 390 "Keymap for `compilation-minor-mode'.") 391 392(defvar compilation-mode-map 393 (let ((map (cons 'keymap compilation-minor-mode-map))) 394 (define-key map " " 'scroll-up) 395 (define-key map "\^?" 'scroll-down) 396 map) 397 "Keymap for compilation log buffers. 398`compilation-minor-mode-map' is a cdr of this.") 399 400(defun compilation-mode () 401 "Major mode for compilation log buffers. 402\\<compilation-mode-map>To visit the source for a line-numbered error, 403move point to the error message line and type \\[compile-goto-error]. 404To kill the compilation, type \\[kill-compilation]. 405 406Runs `compilation-mode-hook' with `run-hooks' (which see)." 407 (interactive) 408 (fundamental-mode) 409 (use-local-map compilation-mode-map) 410 (setq major-mode 'compilation-mode 411 mode-name "Compilation") 412 (compilation-setup) 413 (run-hooks 'compilation-mode-hook)) 414 415;; Prepare the buffer for the compilation parsing commands to work. 416(defun compilation-setup () 417 ;; Make the buffer's mode line show process state. 418 (setq mode-line-process '(":%s")) 419 (set (make-local-variable 'compilation-error-list) nil) 420 (set (make-local-variable 'compilation-old-error-list) nil) 421 (set (make-local-variable 'compilation-parsing-end) 1) 422 (set (make-local-variable 'compilation-directory-stack) nil) 423 (setq compilation-last-buffer (current-buffer))) 424 425(defvar compilation-minor-mode nil 426 "Non-nil when in compilation-minor-mode. 427In this minor mode, all the error-parsing commands of the 428Compilation major mode are available.") 429(make-variable-buffer-local 'compilation-minor-mode) 430 431(or (assq 'compilation-minor-mode minor-mode-alist) 432 (setq minor-mode-alist (cons '(compilation-minor-mode " Compilation") 433 minor-mode-alist))) 434(or (assq 'compilation-minor-mode minor-mode-map-alist) 435 (setq minor-mode-map-alist (cons (cons 'compilation-minor-mode 436 compilation-minor-mode-map) 437 minor-mode-map-alist))) 438 439;;;###autoload 440(defun compilation-minor-mode (&optional arg) 441 "Toggle compilation minor mode. 442With arg, turn compilation mode on if and only if arg is positive. 443See `compilation-mode'." 444 (interactive "P") 445 (if (setq compilation-minor-mode (if (null arg) 446 (null compilation-minor-mode) 447 (> (prefix-numeric-value arg) 0))) 448 (compilation-setup))) 449 450;; Called when compilation process changes state. 451(defun compilation-sentinel (proc msg) 452 "Sentinel for compilation buffers." 453 (let ((buffer (process-buffer proc))) 454 (if (memq (process-status proc) '(signal exit)) 455 (progn 456 (if (null (buffer-name buffer)) 457 ;; buffer killed 458 (set-process-buffer proc nil) 459 (let ((obuf (current-buffer)) 460 omax opoint) 461 ;; save-excursion isn't the right thing if 462 ;; process-buffer is current-buffer 463 (unwind-protect 464 (progn 465 ;; Write something in the compilation buffer 466 ;; and hack its mode line. 467 (set-buffer buffer) 468 (let ((buffer-read-only nil)) 469 (setq omax (point-max) 470 opoint (point)) 471 (goto-char omax) 472 ;; Record where we put the message, so we can ignore it 473 ;; later on. 474 (insert ?\n mode-name " " msg) 475 (forward-char -1) 476 (insert " at " (substring (current-time-string) 0 19)) 477 (forward-char 1) 478 (setq mode-line-process 479 (concat ":" 480 (symbol-name (process-status proc)))) 481 ;; Since the buffer and mode line will show that the 482 ;; process is dead, we can delete it now. Otherwise it 483 ;; will stay around until M-x list-processes. 484 (delete-process proc) 485 ;; Force mode line redisplay soon. 486 (set-buffer-modified-p (buffer-modified-p))) 487 (if (and opoint (< opoint omax)) 488 (goto-char opoint)) 489 (if compilation-finish-function 490 (funcall compilation-finish-function buffer msg))) 491 (set-buffer obuf)))) 492 (setq compilation-in-progress (delq proc compilation-in-progress)) 493 )))) 494 495(defun compilation-filter (proc string) 496 "Process filter for compilation buffers. 497Just inserts the text, but uses `insert-before-markers'." 498 (save-excursion 499 (set-buffer (process-buffer proc)) 500 (let ((buffer-read-only nil)) 501 (save-excursion 502 (goto-char (process-mark proc)) 503 (insert-before-markers string) 504 (set-marker (process-mark proc) (point)))))) 505 506;; Return the cdr of compilation-old-error-list for the error containing point. 507(defun compile-error-at-point () 508 (compile-reinitialize-errors nil (point)) 509 (let ((errors compilation-old-error-list)) 510 (while (and errors 511 (> (point) (car (car errors)))) 512 (setq errors (cdr errors))) 513 errors)) 514 515(defsubst compilation-buffer-p (buffer) 516 (assq 'compilation-error-list (buffer-local-variables buffer))) 517 518(defun compilation-next-error (n) 519 "Move point to the next error in the compilation buffer. 520Does NOT find the source line like \\[next-error]." 521 (interactive "p") 522 (or (compilation-buffer-p (current-buffer)) 523 (error "Not in a compilation buffer.")) 524 (setq compilation-last-buffer (current-buffer)) 525 526 (let ((errors (compile-error-at-point))) 527 528 ;; Move to the error after the one containing point. 529 (goto-char (car (if (< n 0) 530 (let ((i 0) 531 (e compilation-old-error-list)) 532 ;; See how many cdrs away ERRORS is from the start. 533 (while (not (eq e errors)) 534 (setq i (1+ i) 535 e (cdr e))) 536 (if (> (- n) i) 537 (error "Moved back past first error") 538 (nth (+ i n) compilation-old-error-list))) 539 (let ((compilation-error-list (cdr errors))) 540 (compile-reinitialize-errors nil nil n) 541 (if compilation-error-list 542 (nth (1- n) compilation-error-list) 543 (error "Moved past last error")))))))) 544 545(defun compilation-previous-error (n) 546 "Move point to the previous error in the compilation buffer. 547Does NOT find the source line like \\[next-error]." 548 (interactive "p") 549 (compilation-next-error (- n))) 550 551 552;; Given an elt of `compilation-error-list', return an object representing 553;; the referenced file which is equal to (but not necessarily eq to) what 554;; this function would return for another error in the same file. 555(defsubst compilation-error-filedata (data) 556 (setq data (cdr data)) 557 (if (markerp data) 558 (marker-buffer data) 559 (car data))) 560 561;; Return a string describing a value from compilation-error-filedata. 562;; This value is not necessarily useful as a file name, but should be 563;; indicative to the user of what file's errors are being referred to. 564(defsubst compilation-error-filedata-file-name (filedata) 565 (if (bufferp filedata) 566 (buffer-file-name filedata) 567 (car filedata))) 568 569(defun compilation-next-file (n) 570 "Move point to the next error for a different file than the current one." 571 (interactive "p") 572 (or (compilation-buffer-p (current-buffer)) 573 (error "Not in a compilation buffer.")) 574 (setq compilation-last-buffer (current-buffer)) 575 576 (let ((reversed (< n 0)) 577 errors filedata) 578 579 (if (not reversed) 580 (setq errors (or (compile-error-at-point) 581 (error "Moved past last error"))) 582 583 ;; Get a reversed list of the errors up through the one containing point. 584 (compile-reinitialize-errors nil (point)) 585 (setq errors (reverse compilation-old-error-list) 586 n (- n)) 587 588 ;; Ignore errors after point. (car ERRORS) will be the error 589 ;; containing point, (cadr ERRORS) the one before it. 590 (while (and errors 591 (< (point) (car (car errors)))) 592 (setq errors (cdr errors)))) 593 594 (while (> n 0) 595 (setq filedata (compilation-error-filedata (car errors))) 596 597 ;; Skip past the following errors for this file. 598 (while (equal filedata 599 (compilation-error-filedata 600 (car (or errors 601 (if reversed 602 (error "%s the first erring file" 603 (compilation-error-filedata-file-name 604 filedata)) 605 (let ((compilation-error-list nil)) 606 ;; Parse some more. 607 (compile-reinitialize-errors nil nil 2) 608 (setq errors compilation-error-list))) 609 (error "%s is the last erring file" 610 (compilation-error-filedata-file-name 611 filedata)))))) 612 (setq errors (cdr errors))) 613 614 (setq n (1- n))) 615 616 ;; Move to the following error. 617 (goto-char (car (car (or errors 618 (if reversed 619 (error "This is the first erring file") 620 (let ((compilation-error-list nil)) 621 ;; Parse the last one. 622 (compile-reinitialize-errors nil nil 1) 623 compilation-error-list)))))))) 624 625(defun compilation-previous-file (n) 626 "Move point to the previous error for a different file than the current one." 627 (interactive "p") 628 (compilation-next-file (- n))) 629 630 631(defun kill-compilation () 632 "Kill the process made by the \\[compile] command." 633 (interactive) 634 (let ((buffer (compilation-find-buffer))) 635 (if (get-buffer-process buffer) 636 (interrupt-process (get-buffer-process buffer)) 637 (error "The compilation process is not running.")))) 638 639 640;; Parse any new errors in the compilation buffer, 641;; or reparse from the beginning if the user has asked for that. 642(defun compile-reinitialize-errors (reparse 643 &optional limit-search find-at-least) 644 (save-excursion 645 (set-buffer compilation-last-buffer) 646 ;; If we are out of errors, or if user says "reparse", 647 ;; discard the info we have, to force reparsing. 648 (if (or (eq compilation-error-list t) 649 reparse) 650 (compilation-forget-errors)) 651 (if (and compilation-error-list 652 (or (not limit-search) 653 (> compilation-parsing-end limit-search)) 654 (or (not find-at-least) 655 (>= (length compilation-error-list) find-at-least))) 656 ;; Since compilation-error-list is non-nil, it points to a specific 657 ;; error the user wanted. So don't move it around. 658 nil 659 ;; This was here for a long time (before my rewrite); why? --roland 660 ;;(switch-to-buffer compilation-last-buffer) 661 (set-buffer-modified-p nil) 662 (if (< compilation-parsing-end (point-max)) 663 ;; compilation-error-list might be non-nil if we have a non-nil 664 ;; LIMIT-SEARCH or FIND-AT-LEAST arg. In that case its value 665 ;; records the current position in the error list, and we must 666 ;; preserve that after reparsing. 667 (let ((error-list-pos compilation-error-list)) 668 (funcall compilation-parse-errors-function 669 limit-search 670 (and find-at-least 671 ;; We only need enough new parsed errors to reach 672 ;; FIND-AT-LEAST errors past the current 673 ;; position. 674 (- find-at-least (length compilation-error-list)))) 675 ;; Remember the entire list for compilation-forget-errors. If 676 ;; this is an incremental parse, append to previous list. If 677 ;; we are parsing anew, compilation-forget-errors cleared 678 ;; compilation-old-error-list above. 679 (setq compilation-old-error-list 680 (nconc compilation-old-error-list compilation-error-list)) 681 (if error-list-pos 682 ;; We started in the middle of an existing list of parsed 683 ;; errors before parsing more; restore that position. 684 (setq compilation-error-list error-list-pos)) 685 ))))) 686 687(defun compile-mouse-goto-error (event) 688 (interactive "e") 689 (save-excursion 690 (set-buffer (window-buffer (posn-window (event-end event)))) 691 (goto-char (posn-point (event-end event))) 692 693 (or (compilation-buffer-p (current-buffer)) 694 (error "Not in a compilation buffer.")) 695 (setq compilation-last-buffer (current-buffer)) 696 (compile-reinitialize-errors nil (point)) 697 698 ;; Move to bol; the marker for the error on this line will point there. 699 (beginning-of-line) 700 701 ;; Move compilation-error-list to the elt of compilation-old-error-list 702 ;; we want. 703 (setq compilation-error-list compilation-old-error-list) 704 (while (and compilation-error-list 705 (> (point) (car (car compilation-error-list)))) 706 (setq compilation-error-list (cdr compilation-error-list))) 707 (or compilation-error-list 708 (error "No error to go to"))) 709 (select-window (posn-window (event-end event))) 710 ;; Move to another window, so that next-error's window changes 711 ;; result in the desired setup. 712 (or (one-window-p) 713 (progn 714 (other-window -1) 715 ;; other-window changed the selected buffer, 716 ;; but we didn't want to do that. 717 (set-buffer compilation-last-buffer))) 718 719 (push-mark) 720 (next-error 1)) 721 722(defun compile-goto-error (&optional argp) 723 "Visit the source for the error message point is on. 724Use this command in a compilation log buffer. Sets the mark at point there. 725\\[universal-argument] as a prefix arg means to reparse the buffer's error messages first; 726other kinds of prefix arguments are ignored." 727 (interactive "P") 728 (or (compilation-buffer-p (current-buffer)) 729 (error "Not in a compilation buffer.")) 730 (setq compilation-last-buffer (current-buffer)) 731 (compile-reinitialize-errors (consp argp) (point)) 732 733 ;; Move to bol; the marker for the error on this line will point there. 734 (beginning-of-line) 735 736 ;; Move compilation-error-list to the elt of compilation-old-error-list 737 ;; we want. 738 (setq compilation-error-list compilation-old-error-list) 739 (while (and compilation-error-list 740 (> (point) (car (car compilation-error-list)))) 741 (setq compilation-error-list (cdr compilation-error-list))) 742 743 ;; Move to another window, so that next-error's window changes 744 ;; result in the desired setup. 745 (or (one-window-p) 746 (progn 747 (other-window -1) 748 ;; other-window changed the selected buffer, 749 ;; but we didn't want to do that. 750 (set-buffer compilation-last-buffer))) 751 752 (push-mark) 753 (next-error 1)) 754 755;; Return a compilation buffer. 756;; If the current buffer is a compilation buffer, return it. 757;; If compilation-last-buffer is set to a live buffer, use that. 758;; Otherwise, look for a compilation buffer and signal an error 759;; if there are none. 760(defun compilation-find-buffer (&optional other-buffer) 761 (if (and (not other-buffer) 762 (compilation-buffer-p (current-buffer))) 763 ;; The current buffer is a compilation buffer. 764 (current-buffer) 765 (if (and compilation-last-buffer (buffer-name compilation-last-buffer) 766 (or (not other-buffer) (not (eq compilation-last-buffer 767 (current-buffer))))) 768 compilation-last-buffer 769 (let ((buffers (buffer-list))) 770 (while (and buffers (or (not (compilation-buffer-p (car buffers))) 771 (and other-buffer 772 (eq (car buffers) (current-buffer))))) 773 (setq buffers (cdr buffers))) 774 (if buffers 775 (car buffers) 776 (or (and other-buffer 777 (compilation-buffer-p (current-buffer)) 778 ;; The current buffer is a compilation buffer. 779 (progn 780 (if other-buffer 781 (message "This is the only compilation buffer.")) 782 (current-buffer))) 783 (error "No compilation started!"))))))) 784 785;;;###autoload 786(defun next-error (&optional argp) 787 "Visit next compilation error message and corresponding source code. 788This operates on the output from the \\[compile] command. 789If all preparsed error messages have been processed, 790the error message buffer is checked for new ones. 791 792A prefix arg specifies how many error messages to move; 793negative means move back to previous error messages. 794Just C-u as a prefix means reparse the error message buffer 795and start at the first error. 796 797\\[next-error] normally applies to the most recent compilation started, 798but as long as you are in the middle of parsing errors from one compilation 799output buffer, you stay with that compilation output buffer. 800 801Use \\[next-error] in a compilation output buffer to switch to 802processing errors from that compilation. 803 804See variables `compilation-parse-errors-function' and 805\`compilation-error-regexp-alist' for customization ideas." 806 (interactive "P") 807 (setq compilation-last-buffer (compilation-find-buffer)) 808 (compilation-goto-locus (compilation-next-error-locus 809 ;; We want to pass a number here only if 810 ;; we got a numeric prefix arg, not just C-u. 811 (and (not (consp argp)) 812 (prefix-numeric-value argp)) 813 (consp argp)))) 814;;;###autoload (define-key ctl-x-map "`" 'next-error) 815 816(defun compilation-next-error-locus (&optional move reparse) 817 "Visit next compilation error and return locus in corresponding source code. 818This operates on the output from the \\[compile] command. 819If all preparsed error messages have been processed, 820the error message buffer is checked for new ones. 821 822Returns a cons (ERROR . SOURCE) of two markers: ERROR is a marker at the 823location of the error message in the compilation buffer, and SOURCE is a 824marker at the location in the source code indicated by the error message. 825 826Optional first arg MOVE says how many error messages to move forwards (or 827backwards, if negative); default is 1. Optional second arg REPARSE, if 828non-nil, says to reparse the error message buffer and reset to the first 829error (plus MOVE - 1). 830 831The current buffer should be the desired compilation output buffer." 832 (or move (setq move 1)) 833 (compile-reinitialize-errors reparse nil (and (not reparse) 834 (if (< move 1) 0 (1- move)))) 835 (let (next-errors next-error) 836 (save-excursion 837 (set-buffer compilation-last-buffer) 838 ;; compilation-error-list points to the "current" error. 839 (setq next-errors 840 (if (> move 0) 841 (nthcdr (1- move) 842 compilation-error-list) 843 ;; Zero or negative arg; we need to move back in the list. 844 (let ((n (1- move)) 845 (i 0) 846 (e compilation-old-error-list)) 847 ;; See how many cdrs away the current error is from the start. 848 (while (not (eq e compilation-error-list)) 849 (setq i (1+ i) 850 e (cdr e))) 851 (if (> (- n) i) 852 (error "Moved back past first error") 853 (nthcdr (+ i n) compilation-old-error-list)))) 854 next-error (car next-errors)) 855 (while 856 (if (null next-error) 857 (progn 858 (and move (/= move 1) 859 (error (if (> move 0) 860 "Moved past last error") 861 "Moved back past first error")) 862 (compilation-forget-errors) 863 (error (concat compilation-error-message 864 (and (get-buffer-process (current-buffer)) 865 (eq (process-status 866 (get-buffer-process 867 (current-buffer))) 868 'run) 869 " yet")))) 870 (setq compilation-error-list (cdr next-errors)) 871 (if (null (cdr next-error)) 872 ;; This error is boring. Go to the next. 873 t 874 (or (markerp (cdr next-error)) 875 ;; This error has a filename/lineno pair. 876 ;; Find the file and turn it into a marker. 877 (let* ((fileinfo (car (cdr next-error))) 878 (buffer (compilation-find-file (cdr fileinfo) 879 (car fileinfo) 880 (car next-error)))) 881 (if (null buffer) 882 ;; We can't find this error's file. 883 ;; Remove all errors in the same file. 884 (progn 885 (setq next-errors compilation-old-error-list) 886 (while next-errors 887 (and (consp (cdr (car next-errors))) 888 (equal (car (cdr (car next-errors))) 889 fileinfo) 890 (progn 891 (set-marker (car (car next-errors)) nil) 892 (setcdr (car next-errors) nil))) 893 (setq next-errors (cdr next-errors))) 894 ;; Look for the next error. 895 t) 896 ;; We found the file. Get a marker for this error. 897 ;; compilation-old-error-list is a buffer-local 898 ;; variable, so we must be careful to extract its value 899 ;; before switching to the source file buffer. 900 (let ((errors compilation-old-error-list) 901 (last-line (nth 1 (cdr next-error))) 902 (column (nth 2 (cdr next-error)))) 903 (set-buffer buffer) 904 (save-excursion 905 (save-restriction 906 (widen) 907 (goto-line last-line) 908 (if column 909 (move-to-column column) 910 (beginning-of-line)) 911 (setcdr next-error (point-marker)) 912 ;; Make all the other error messages referring 913 ;; to the same file have markers into the buffer. 914 (while errors 915 (and (consp (cdr (car errors))) 916 (equal (car (cdr (car errors))) fileinfo) 917 (let* ((this (nth 1 (cdr (car errors)))) 918 (column (nth 2 (cdr (car errors)))) 919 (lines (- this last-line))) 920 (if (eq selective-display t) 921 ;; When selective-display is t, 922 ;; each C-m is a line boundary, 923 ;; as well as each newline. 924 (if (< lines 0) 925 (re-search-backward "[\n\C-m]" 926 nil 'end 927 (- lines)) 928 (re-search-forward "[\n\C-m]" 929 nil 'end 930 lines)) 931 (forward-line lines)) 932 (if column 933 (move-to-column column)) 934 (setq last-line this) 935 (setcdr (car errors) (point-marker)))) 936 (setq errors (cdr errors))))))))) 937 ;; If we didn't get a marker for this error, or this 938 ;; marker's buffer was killed, go on to the next one. 939 (or (not (markerp (cdr next-error))) 940 (not (marker-buffer (cdr next-error)))))) 941 (setq next-errors compilation-error-list 942 next-error (car next-errors)))) 943 944 ;; Skip over multiple error messages for the same source location, 945 ;; so the next C-x ` won't go to an error in the same place. 946 (while (and compilation-error-list 947 (equal (cdr (car compilation-error-list)) (cdr next-error))) 948 (setq compilation-error-list (cdr compilation-error-list))) 949 950 ;; We now have a marker for the position of the error source code. 951 ;; NEXT-ERROR is a cons (ERROR . SOURCE) of two markers. 952 next-error)) 953 954(defun compilation-goto-locus (next-error) 955 "Jump to an error locus returned by `compilation-next-error-locus'. 956Takes one argument, a cons (ERROR . SOURCE) of two markers. 957Selects a window with point at SOURCE, with another window displaying ERROR." 958 (if (and (window-dedicated-p (selected-window)) 959 (eq (selected-window) (frame-root-window))) 960 (switch-to-buffer-other-frame (marker-buffer (cdr next-error))) 961 (switch-to-buffer (marker-buffer (cdr next-error)))) 962 (goto-char (cdr next-error)) 963 ;; If narrowing got in the way of 964 ;; going to the right place, widen. 965 (or (= (point) (marker-position (cdr next-error))) 966 (progn 967 (widen) 968 (goto-char (cdr next-error)))) 969 970 ;; Show compilation buffer in other window, scrolled to this error. 971 (let* ((pop-up-windows t) 972 (w (display-buffer (marker-buffer (car next-error))))) 973 (set-window-point w (car next-error)) 974 (set-window-start w (car next-error)))) 975 976;; Find a buffer for file FILENAME. 977;; Search the directories in compilation-search-path. 978;; A nil in compilation-search-path means to try the 979;; current directory, which is passed in DIR. 980;; If FILENAME is not found at all, ask the user where to find it. 981;; Pop up the buffer containing MARKER and scroll to MARKER if we ask the user. 982(defun compilation-find-file (filename dir marker) 983 (let ((dirs compilation-search-path) 984 result name) 985 (while (and dirs (null result)) 986 (setq name (expand-file-name filename (or (car dirs) dir)) 987 result (and (file-exists-p name) 988 (find-file-noselect name)) 989 dirs (cdr dirs))) 990 (or result 991 ;; The file doesn't exist. 992 ;; Ask the user where to find it. 993 ;; If he hits C-g, then the next time he does 994 ;; next-error, he'll skip past it. 995 (progn 996 (let* ((pop-up-windows t) 997 (w (display-buffer (marker-buffer marker)))) 998 (set-window-point w marker) 999 (set-window-start w marker)) 1000 (setq name 1001 (expand-file-name 1002 (read-file-name 1003 (format "Find this error in: (default %s) " 1004 filename) dir filename t))) 1005 (if (file-directory-p name) 1006 (setq name (concat (file-name-as-directory name) filename))) 1007 (if (file-exists-p name) 1008 (find-file-noselect name)))))) 1009 1010;; Set compilation-error-list to nil, and unchain the markers that point to the 1011;; error messages and their text, so that they no longer slow down gap motion. 1012;; This would happen anyway at the next garbage collection, but it is better to 1013;; do it right away. 1014(defun compilation-forget-errors () 1015 (while compilation-old-error-list 1016 (let ((next-error (car compilation-old-error-list))) 1017 (set-marker (car next-error) nil) 1018 (if (markerp (cdr next-error)) 1019 (set-marker (cdr next-error) nil))) 1020 (setq compilation-old-error-list (cdr compilation-old-error-list))) 1021 (setq compilation-error-list nil 1022 compilation-directory-stack nil 1023 compilation-parsing-end 1)) 1024 1025 1026(defun count-regexp-groupings (regexp) 1027 "Return the number of \\( ... \\) groupings in REGEXP (a string)." 1028 (let ((groupings 0) 1029 (len (length regexp)) 1030 (i 0) 1031 c) 1032 (while (< i len) 1033 (setq c (aref regexp i) 1034 i (1+ i)) 1035 (cond ((= c ?\[) 1036 ;; Find the end of this [...]. 1037 (while (and (< i len) 1038 (not (= (aref regexp i) ?\]))) 1039 (setq i (1+ i)))) 1040 ((= c ?\\) 1041 (if (< i len) 1042 (progn 1043 (setq c (aref regexp i) 1044 i (1+ i)) 1045 (if (= c ?\)) 1046 ;; We found the end of a grouping, 1047 ;; so bump our counter. 1048 (setq groupings (1+ groupings)))))))) 1049 groupings)) 1050 1051(defun compilation-parse-errors (limit-search find-at-least) 1052 "Parse the current buffer as grep, cc or lint error messages. 1053See variable `compilation-parse-errors-function' for the interface it uses." 1054 (setq compilation-error-list nil) 1055 (message "Parsing error messages...") 1056 (let (text-buffer orig orig-expanded parent-expanded 1057 regexp enter-group leave-group error-group 1058 alist subexpr error-regexp-groups 1059 (found-desired nil) 1060 (compilation-num-errors-found 0)) 1061 1062 ;; Don't reparse messages already seen at last parse. 1063 (goto-char compilation-parsing-end) 1064 ;; Don't parse the first two lines as error messages. 1065 ;; This matters for grep. 1066 (if (bobp) 1067 (progn 1068 (forward-line 2) 1069 ;; Move back so point is before the newline. 1070 ;; This matters because some error regexps use \n instead of ^ 1071 ;; to be faster. 1072 (forward-char -1))) 1073 1074 ;; Compile all the regexps we want to search for into one. 1075 (setq regexp (concat "\\(" compilation-enter-directory-regexp "\\)\\|" 1076 "\\(" compilation-leave-directory-regexp "\\)\\|" 1077 "\\(" (mapconcat (function 1078 (lambda (elt) 1079 (concat "\\(" (car elt) "\\)"))) 1080 compilation-error-regexp-alist 1081 "\\|") "\\)")) 1082 1083 ;; Find out how many \(...\) groupings are in each of the regexps, and set 1084 ;; *-GROUP to the grouping containing each constituent regexp (whose 1085 ;; subgroups will come immediately thereafter) of the big regexp we have 1086 ;; just constructed. 1087 (setq enter-group 1 1088 leave-group (+ enter-group 1089 (count-regexp-groupings 1090 compilation-enter-directory-regexp) 1091 1) 1092 error-group (+ leave-group 1093 (count-regexp-groupings 1094 compilation-leave-directory-regexp) 1095 1)) 1096 1097 ;; Compile an alist (IDX FILE LINE [COL]), where IDX is the number of 1098 ;; the subexpression for an entire error-regexp, and FILE and LINE (and 1099 ;; possibly COL) are the numbers for the subexpressions giving the file 1100 ;; name and line number (and possibly column number). 1101 (setq alist (or compilation-error-regexp-alist 1102 (error "compilation-error-regexp-alist is empty!")) 1103 subexpr (1+ error-group)) 1104 (while alist 1105 (setq error-regexp-groups 1106 (cons (list subexpr 1107 (+ subexpr (nth 1 (car alist))) 1108 (+ subexpr (nth 2 (car alist))) 1109 (and (nth 3 (car alist)) 1110 (+ subexpr (nth 3 (car alist))))) 1111 error-regexp-groups)) 1112 (setq subexpr (+ subexpr 1 (count-regexp-groupings (car (car alist))))) 1113 (setq alist (cdr alist))) 1114 1115 (setq orig default-directory) 1116 (setq orig-expanded (file-truename orig)) 1117 (setq parent-expanded (expand-file-name "../" orig-expanded)) 1118 1119 (while (and (not found-desired) 1120 ;; We don't just pass LIMIT-SEARCH to re-search-forward 1121 ;; because we want to find matches containing LIMIT-SEARCH 1122 ;; but which extend past it. 1123 (re-search-forward regexp nil t)) 1124 1125 ;; Figure out which constituent regexp matched. 1126 (cond ((match-beginning enter-group) 1127 ;; The match was the enter-directory regexp. 1128 (let ((dir 1129 (file-name-as-directory 1130 (expand-file-name 1131 (buffer-substring (match-beginning (+ enter-group 1)) 1132 (match-end (+ enter-group 1))))))) 1133 ;; The directory name in the "entering" message 1134 ;; is a truename. Try to convert it to a form 1135 ;; like what the user typed in. 1136 (setq dir 1137 (compile-abbreviate-directory dir orig orig-expanded 1138 parent-expanded)) 1139 (setq compilation-directory-stack 1140 (cons dir compilation-directory-stack)) 1141 (and (file-directory-p dir) 1142 (setq default-directory dir))) 1143 1144 (and limit-search (>= (point) limit-search) 1145 ;; The user wanted a specific error, and we're past it. 1146 ;; We do this check here (and in the leave-group case) 1147 ;; rather than at the end of the loop because if the last 1148 ;; thing seen is an error message, we must carefully 1149 ;; discard the last error when it is the first in a new 1150 ;; file (see below in the error-group case). 1151 (setq found-desired t))) 1152 1153 ((match-beginning leave-group) 1154 ;; The match was the leave-directory regexp. 1155 (let ((beg (match-beginning (+ leave-group 1))) 1156 (stack compilation-directory-stack)) 1157 (if beg 1158 (let ((dir 1159 (file-name-as-directory 1160 (expand-file-name 1161 (buffer-substring beg 1162 (match-end (+ leave-group 1163 1))))))) 1164 ;; The directory name in the "entering" message 1165 ;; is a truename. Try to convert it to a form 1166 ;; like what the user typed in. 1167 (setq dir 1168 (compile-abbreviate-directory dir orig orig-expanded 1169 parent-expanded)) 1170 (while (and stack 1171 (not (string-equal (car stack) dir))) 1172 (setq stack (cdr stack))))) 1173 (setq compilation-directory-stack (cdr stack)) 1174 (setq stack (car compilation-directory-stack)) 1175 (if stack 1176 (setq default-directory stack)) 1177 ) 1178 1179 (and limit-search (>= (point) limit-search) 1180 ;; The user wanted a specific error, and we're past it. 1181 ;; We do this check here (and in the enter-group case) 1182 ;; rather than at the end of the loop because if the last 1183 ;; thing seen is an error message, we must carefully 1184 ;; discard the last error when it is the first in a new 1185 ;; file (see below in the error-group case). 1186 (setq found-desired t))) 1187 1188 ((match-beginning error-group) 1189 ;; The match was the composite error regexp. 1190 ;; Find out which individual regexp matched. 1191 (setq alist error-regexp-groups) 1192 (while (and alist 1193 (null (match-beginning (car (car alist))))) 1194 (setq alist (cdr alist))) 1195 (if alist 1196 (setq alist (car alist)) 1197 (error "compilation-parse-errors: impossible regexp match!")) 1198 1199 ;; Extract the file name and line number from the error message. 1200 (let ((beginning-of-match (match-beginning 0)) ;looking-at nukes 1201 (filename (buffer-substring (match-beginning (nth 1 alist)) 1202 (match-end (nth 1 alist)))) 1203 (linenum (string-to-int 1204 (buffer-substring 1205 (match-beginning (nth 2 alist)) 1206 (match-end (nth 2 alist))))) 1207 (column (and (nth 3 alist) 1208 (string-to-int 1209 (buffer-substring 1210 (match-beginning (nth 3 alist)) 1211 (match-end (nth 3 alist))))))) 1212 1213 ;; Check for a comint-file-name-prefix and prepend it if 1214 ;; appropriate. (This is very useful for 1215 ;; compilation-minor-mode in an rlogin-mode buffer.) 1216 (and (boundp 'comint-file-name-prefix) 1217 ;; If the file name is relative, default-directory will 1218 ;; already contain the comint-file-name-prefix (done by 1219 ;; compile-abbreviate-directory). 1220 (file-name-absolute-p filename) 1221 (setq filename (concat comint-file-name-prefix filename))) 1222 (setq filename (cons default-directory filename)) 1223 1224 ;; Locate the erring file and line. 1225 ;; Cons a new elt onto compilation-error-list, 1226 ;; giving a marker for the current compilation buffer 1227 ;; location, and the file and line number of the error. 1228 (save-excursion 1229 (beginning-of-line 1) 1230 (let ((this (cons (point-marker) 1231 (list filename linenum column)))) 1232 ;; Don't add the same source line more than once. 1233 (if (equal (cdr this) (cdr (car compilation-error-list))) 1234 nil 1235 (setq compilation-error-list 1236 (cons this 1237 compilation-error-list)) 1238 (setq compilation-num-errors-found 1239 (1+ compilation-num-errors-found))))) 1240 (and (or (and find-at-least (> compilation-num-errors-found 1241 find-at-least)) 1242 (and limit-search (>= (point) limit-search))) 1243 ;; We have found as many new errors as the user wants, 1244 ;; or past the buffer position he indicated. We 1245 ;; continue to parse until we have seen all the 1246 ;; consecutive errors in the same file, so the error 1247 ;; positions will be recorded as markers in this buffer 1248 ;; that might change. 1249 (cdr compilation-error-list) ; Must check at least two. 1250 (not (equal (car (cdr (nth 0 compilation-error-list))) 1251 (car (cdr (nth 1 compilation-error-list))))) 1252 (progn 1253 ;; Discard the error just parsed, so that the next 1254 ;; parsing run can get it and the following errors in 1255 ;; the same file all at once. If we didn't do this, we 1256 ;; would have the same problem we are trying to avoid 1257 ;; with the test above, just delayed until the next run! 1258 (setq compilation-error-list 1259 (cdr compilation-error-list)) 1260 (goto-char beginning-of-match) 1261 (setq found-desired t))) 1262 ) 1263 ) 1264 (t 1265 (error "compilation-parse-errors: known groups didn't match!"))) 1266 1267 (message "Parsing error messages...%d (%.0f%% of buffer)" 1268 compilation-num-errors-found 1269 ;; Use floating-point because (* 100 (point)) frequently 1270 ;; exceeds the range of Emacs Lisp integers. 1271 (/ (* 100.0 (point)) (point-max))) 1272 1273 (and limit-search (>= (point) limit-search) 1274 ;; The user wanted a specific error, and we're past it. 1275 (setq found-desired t))) 1276 (setq compilation-parsing-end (if found-desired 1277 (point) 1278 ;; We have searched the whole buffer. 1279 (point-max)))) 1280 (setq compilation-error-list (nreverse compilation-error-list)) 1281 (message "Parsing error messages...done")) 1282 1283;; If directory DIR is a subdir of ORIG or of ORIG's parent, 1284;; return a relative name for it starting from ORIG or its parent. 1285;; ORIG-EXPANDED is an expanded version of ORIG. 1286;; PARENT-EXPANDED is an expanded version of ORIG's parent. 1287;; Those two args could be computed here, but we run faster by 1288;; having the caller compute them just once. 1289(defun compile-abbreviate-directory (dir orig orig-expanded parent-expanded) 1290 ;; Check for a comint-file-name-prefix and prepend it if appropriate. 1291 ;; (This is very useful for compilation-minor-mode in an rlogin-mode 1292 ;; buffer.) 1293 (if (boundp 'comint-file-name-prefix) 1294 (setq dir (concat comint-file-name-prefix dir))) 1295 1296 (if (and (> (length dir) (length orig-expanded)) 1297 (string= orig-expanded 1298 (substring dir 0 (length orig-expanded)))) 1299 (setq dir 1300 (concat orig 1301 (substring dir (length orig-expanded))))) 1302 (if (and (> (length dir) (length parent-expanded)) 1303 (string= parent-expanded 1304 (substring dir 0 (length parent-expanded)))) 1305 (setq dir 1306 (concat (file-name-directory 1307 (directory-file-name orig)) 1308 (substring dir (length parent-expanded))))) 1309 dir) 1310 1311(provide 'compile) 1312 1313;;; compile.el ends here 1314