]> code.delx.au - gnu-emacs/blobdiff - lisp/progmodes/compile.el
(compilation-directory-matcher): Improve previous doc fix.
[gnu-emacs] / lisp / progmodes / compile.el
index f29051ab0b0b61e88183771c0c1cd5eb45297327..15346be53c739588a18372958909177ddf8981aa 100644 (file)
@@ -1,7 +1,7 @@
 ;;; compile.el --- run compiler as inferior of Emacs, parse error messages
 
 ;; Copyright (C) 1985, 1986, 1987, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
-;;   2001, 2002, 2003, 2004, 2005  Free Software Foundation, Inc.
+;;   2001, 2002, 2003, 2004, 2005, 2006  Free Software Foundation, Inc.
 
 ;; Authors: Roland McGrath <roland@gnu.org>,
 ;;         Daniel Pfeiffer <occitan@esperanto.org>
@@ -218,25 +218,37 @@ of[ \t]+\"?\\([a-zA-Z]?:?[^\":\n]+\\)\"?:" 3 2 nil (1))
      nil 1 nil 2 0
      (2 (compilation-face '(3))))
 
-    (gcc-include
-     "^\\(?:In file included\\|                \\) from \
-\\(.+\\):\\([0-9]+\\)\\(?:\\(:\\)\\|\\(,\\)\\)?" 1 2 nil (3 . 4))
-
     (gnu
+     ;; I have no idea what this first line is supposed to match, but it
+     ;; makes things ambiguous with output such as "foo:344:50:blabla" since
+     ;; the "foo" part can match this first line (in which case the file
+     ;; name as "344").  To avoid this, the second line disallows filenames
+     ;; exclusively composed of digits.  --Stef
+     ;; Similarly, we get lots of false positives with messages including
+     ;; times of the form "HH:MM:SS" where MM is taken as a line number, so
+     ;; the last line tries to rule out message where the info after the
+     ;; line number starts with "SS".  --Stef
      "^\\(?:[[:alpha:]][-[:alnum:].]+: ?\\)?\
-\\([/.]*[a-zA-Z]:?[^ \t\n:]*\\|{standard input}\\): ?\
-\\([0-9]+\\)\\([.:]?\\)\\([0-9]+\\)?\
-\\(?:-\\(?:\\([0-9]+\\)\\3\\)?\\.?\\([0-9]+\\)?\\)?:\
+\\([0-9]*[^0-9\n]\\(?:[^\n ]\\| [^-\n]\\)*?\\): ?\
+\\([0-9]+\\)\\(?:\\([.:]\\)\\([0-9]+\\)\\)?\
+\\(?:-\\([0-9]+\\)?\\(?:\\3\\([0-9]+\\)\\)?\\)?:\
 \\(?: *\\(\\(?:Future\\|Runtime\\)?[Ww]arning\\|W:\\)\\|\
- *\\([Ii]nfo\\(?:\\>\\|rmationa?l?\\)\\|I:\\)\\)?"
+ *\\([Ii]nfo\\(?:\\>\\|rmationa?l?\\)\\|I:\\|instantiated from\\)\\|\
+\[0-9]?\\(?:[^0-9\n]\\|$\\)\\|[0-9][0-9][0-9]\\)"
      1 (2 . 5) (4 . 6) (7 . 8))
 
+    ;; The `gnu' style above can incorrectly match gcc's "In file
+    ;; included from" message, so we process that first. -- cyd
+    (gcc-include
+     "^\\(?:In file included\\|                \\) from \
+\\(.+\\):\\([0-9]+\\)\\(?:\\(:\\)\\|\\(,\\)\\)?" 1 2 nil (3 . 4))
+
     (lcc
      "^\\(?:E\\|\\(W\\)\\), \\([^(\n]+\\)(\\([0-9]+\\),[ \t]*\\([0-9]+\\)"
      2 3 4 (1))
 
     (makepp
-     "^makepp: \\(?:\\(?:warning\\(:\\).*?\\|\\(Scanning\\|[LR]e?l?oading makefile\\) \\|.*?\\)\
+     "^makepp: \\(?:\\(?:warning\\(:\\).*?\\|\\(Scanning\\|[LR]e?l?oading makefile\\|Imported\\) \\|.*?\\)\
 `\\(\\(\\S +?\\)\\(?::\\([0-9]+\\)\\)?\\)['(]\\)"
      4 5 nil (1 . 2) 3
      ("`\\(\\(\\S +?\\)\\(?::\\([0-9]+\\)\\)?\\)['(]" nil nil
@@ -293,15 +305,34 @@ File = \\(.+\\), Line = \\([0-9]+\\)\\(?:, Column = \\([0-9]+\\)\\)?"
 \\(?:: \\(warning:\\)?\\|$\\| ),\\)" 1 2 nil (3))
 
     (gcov-file
-     "^ +-:    \\(0\\):Source:\\(.+\\)$" 2 1 nil 0)
-    (gcov-bb-file
-     "^ +-:    \\(0\\):Object:\\(?:.+\\)$" nil 1 nil 0)
-    (gcov-never-called-line
-     "^ +\\(#####\\): +\\([0-9]+\\):.+$" nil 2 nil 2 nil
-     (1 compilation-error-face))
+     "^ *-: *\\(0\\):Source:\\(.+\\)$"
+     2 1 nil 0 nil
+     (1 compilation-line-face prepend) (2 compilation-info-face prepend))
+    (gcov-header
+     "^ *-: *\\(0\\):\\(?:Object\\|Graph\\|Data\\|Runs\\|Programs\\):.+$"
+     nil 1 nil 0 nil
+     (1 compilation-line-face prepend))
+    ;; Underlines over all lines of gcov output are too uncomfortable to read.
+    ;; However, hyperlinks embedded in the lines are useful.
+    ;; So I put default face on the lines; and then put
+    ;; compilation-*-face by manually to eliminate the underlines.
+    ;; The hyperlinks are still effective.
+    (gcov-nomark
+     "^ *-: *\\([1-9]\\|[0-9]\\{2,\\}\\):.*$"
+     nil 1 nil 0 nil
+     (0 'default t)
+     (1 compilation-line-face prepend))
     (gcov-called-line
-     "^ +[-0-9]+: +\\([1-9]\\|[0-9]\\{2,\\}\\):.*$" nil 1 nil 0)
-)
+     "^ *\\([0-9]+\\): *\\([0-9]+\\):.*$"
+     nil 2 nil 0 nil
+     (0 'default t)
+     (1 compilation-info-face prepend) (2 compilation-line-face prepend))
+    (gcov-never-called
+     "^ *\\(#####\\): *\\([0-9]+\\):.*$"
+     nil 2 nil 2 nil
+     (0 'default t)
+     (1 compilation-error-face prepend) (2 compilation-line-face prepend))
+    )
   "Alist of values for `compilation-error-regexp-alist'.")
 
 (defcustom compilation-error-regexp-alist
@@ -331,7 +362,8 @@ beginning of line's indentation.
 FILE can also have the form (FILE FORMAT...), where the FORMATs
 \(e.g. \"%s.c\") will be applied in turn to the recognized file
 name, until a file of that name is found.  Or FILE can also be a
-function to return the filename.
+function that returns (FILENAME) or (RELATIVE-FILENAME . DIRNAME).
+In the former case, FILENAME may be relative or absolute.
 
 LINE can also be of the form (LINE . END-LINE) meaning a range
 of lines.  COLUMN can also be of the form (COLUMN . END-COLUMN)
@@ -365,7 +397,7 @@ be added."
 (defvar compilation-directory-matcher
   '("\\(?:Entering\\|Leavin\\(g\\)\\) directory `\\(.+\\)'$" (2 . 1))
   "A list for tracking when directories are entered or left.
-Nil means not to track directories, e.g. if all file names are absolute.  The
+If nil, do not track directories, e.g. if all file names are absolute.  The
 first element is the REGEXP matching these messages.  It can match any number
 of variants, e.g. different languages.  The remaining elements are all of the
 form (DIR .  LEAVE).  If for any one of these the DIR'th subexpression
@@ -388,9 +420,11 @@ you may also want to change `compilation-page-delimiter'.")
      ("^\\([[:alnum:]_/.+-]+\\)\\(\\[\\([0-9]+\\)\\]\\)?[ \t]*:"
       (1 font-lock-function-name-face) (3 compilation-line-face nil t))
      (" --?o\\(?:utfile\\|utput\\)?[= ]?\\(\\S +\\)" . 1)
-     ("^Compilation \\(finished\\)"
+     ("^Compilation \\(finished\\).*"
+      (0 '(face nil message nil help-echo nil mouse-face nil) t)
       (1 compilation-info-face))
-     ("^Compilation \\(exited abnormally\\|interrupt\\|killed\\|terminated\\)\\(?:.*with code \\([0-9]+\\)\\)?"
+     ("^Compilation \\(exited abnormally\\|interrupt\\|killed\\|terminated\\|segmentation fault\\)\\(?:.*with code \\([0-9]+\\)\\)?.*"
+      (0 '(face nil message nil help-echo nil mouse-face nil) t)
       (1 compilation-error-face)
       (2 compilation-error-face nil t)))
    "Additional things to highlight in Compilation mode.
@@ -452,6 +486,7 @@ You might also use mode hooks to specify it in certain modes, like this:
                        (file-name-sans-extension buffer-file-name))))))"
   :type 'string
   :group 'compilation)
+;;;###autoload(put 'compile-command 'safe-local-variable 'stringp)
 
 ;;;###autoload
 (defcustom compilation-disable-input nil
@@ -490,7 +525,7 @@ starting the compilation process.")
 (defface compilation-error
   '((t :inherit font-lock-warning-face))
   "Face used to highlight compiler errors."
-  :group 'font-lock-highlighting-faces
+  :group 'compilation
   :version "22.1")
 
 (defface compilation-warning
@@ -498,7 +533,7 @@ starting the compilation process.")
     (((class color)) (:foreground "cyan" :weight bold))
     (t (:weight bold)))
   "Face used to highlight compiler warnings."
-  :group 'font-lock-highlighting-faces
+  :group 'compilation
   :version "22.1")
 
 (defface compilation-info
@@ -511,26 +546,29 @@ starting the compilation process.")
     (((class color)) (:foreground "green" :weight bold))
     (t (:weight bold)))
   "Face used to highlight compiler information."
-  :group 'font-lock-highlighting-faces
+  :group 'compilation
   :version "22.1")
 
 (defface compilation-line-number
   '((t :inherit font-lock-variable-name-face))
   "Face for displaying line numbers in compiler messages."
-  :group 'font-lock-highlighting-faces
+  :group 'compilation
   :version "22.1")
 
 (defface compilation-column-number
   '((t :inherit font-lock-type-face))
   "Face for displaying column numbers in compiler messages."
-  :group 'font-lock-highlighting-faces
+  :group 'compilation
   :version "22.1")
 
-(defvar compilation-message-face 'underline
+(defcustom compilation-message-face 'underline
   "Face name to use for whole messages.
 Faces `compilation-error-face', `compilation-warning-face',
 `compilation-info-face', `compilation-line-face' and
-`compilation-column-face' get prepended to this, when applicable.")
+`compilation-column-face' get prepended to this, when applicable."
+  :type 'face
+  :group 'compilation
+  :version "22.1")
 
 (defvar compilation-error-face 'compilation-error
   "Face name to use for file name in error messages.")
@@ -587,7 +625,7 @@ Faces `compilation-error-face', `compilation-warning-face',
                   (cons (match-string-no-properties idx) dir))
       mouse-face highlight
       keymap compilation-button-map
-      help-echo "mouse-2: visit current directory")))
+      help-echo "mouse-2: visit this directory")))
 
 ;; Data type `reverse-ordered-alist' retriever.         This function retrieves the
 ;; KEY element from the ALIST, creating it in the right position if not already
@@ -614,6 +652,7 @@ Faces `compilation-error-face', `compilation-warning-face',
 ;; This function is the central driver, called when font-locking to gather
 ;; all information needed to later jump to corresponding source code.
 ;; Return a property list with all meta information on this error location.
+
 (defun compilation-error-properties (file line end-line col end-col type fmt)
   (unless (< (next-single-property-change (match-beginning 0) 'directory nil (point))
             (point))
@@ -628,11 +667,22 @@ Faces `compilation-error-face', `compilation-warning-face',
                                    (get-text-property dir 'directory)))))
            (setq file (cons file (car dir)))))
       ;; This message didn't mention one, get it from previous
-      (setq file (previous-single-property-change (point) 'message)
-           file (or (if file
-                        (car (nth 2 (car (or (get-text-property (1- file) 'message)
-                                        (get-text-property file 'message))))))
-                    '("*unknown*"))))
+      (let ((prev-pos
+            ;; Find the previous message.
+            (previous-single-property-change (point) 'message)))
+       (if prev-pos
+           ;; Get the file structure that belongs to it.
+           (let* ((prev
+                   (or (get-text-property (1- prev-pos) 'message)
+                       (get-text-property prev-pos 'message)))
+                  (prev-struct
+                   (car (nth 2 (car prev)))))
+             ;; Construct FILE . DIR from that.
+             (if prev-struct
+                 (setq file (cons (car prev-struct)
+                                  (cadr prev-struct))))))
+       (unless file
+         (setq file '("*unknown*")))))
     ;; All of these fields are optional, get them only if we have an index, and
     ;; it matched some part of the message.
     (and line
@@ -695,24 +745,25 @@ FMTS is a list of format specs for transforming the file name.
       (setq marker (nth 3 (cadr marker-line))
            marker-line (or (car marker-line) 1))
       (with-current-buffer (marker-buffer marker)
-       (save-restriction
-         (widen)
-         (goto-char (marker-position marker))
-         (when (or end-col end-line)
-           (beginning-of-line (- (or end-line line) marker-line -1))
-           (if (or (null end-col) (< end-col 0))
-               (end-of-line)
-             (compilation-move-to-column
-              end-col compilation-error-screen-columns))
-           (setq end-marker (list (point-marker))))
-         (beginning-of-line (if end-line
-                                (- line end-line -1)
-                              (- loc marker-line -1)))
-         (if col
-             (compilation-move-to-column
-              col compilation-error-screen-columns)
-           (forward-to-indentation 0))
-         (setq marker (list (point-marker))))))
+       (save-excursion
+         (save-restriction
+           (widen)
+           (goto-char (marker-position marker))
+           (when (or end-col end-line)
+             (beginning-of-line (- (or end-line line) marker-line -1))
+             (if (or (null end-col) (< end-col 0))
+                 (end-of-line)
+               (compilation-move-to-column
+                end-col compilation-error-screen-columns))
+             (setq end-marker (list (point-marker))))
+           (beginning-of-line (if end-line
+                                  (- line end-line -1)
+                                (- loc marker-line -1)))
+           (if col
+               (compilation-move-to-column
+                col compilation-error-screen-columns)
+             (forward-to-indentation 0))
+           (setq marker (list (point-marker)))))))
 
     (setq loc (compilation-assq line (cdr file-struct)))
     (if end-line
@@ -887,19 +938,20 @@ visible rather than the beginning."
   :group 'compilation)
 
 
-(defun compilation-buffer-name (mode-name name-function)
+(defun compilation-buffer-name (mode-name mode-command name-function)
   "Return the name of a compilation buffer to use.
 If NAME-FUNCTION is non-nil, call it with one argument MODE-NAME
 to determine the buffer name.
 Likewise if `compilation-buffer-name-function' is non-nil.
-If current buffer is in Compilation mode for the same mode name
+If current buffer is the mode MODE-COMMAND,
 return the name of the current buffer, so that it gets reused.
 Otherwise, construct a buffer name from MODE-NAME."
   (cond (name-function
         (funcall name-function mode-name))
        (compilation-buffer-name-function
         (funcall compilation-buffer-name-function mode-name))
-       ((eq major-mode (nth 1 compilation-arguments))
+       ((and (eq mode-command major-mode)
+             (eq major-mode (nth 1 compilation-arguments)))
         (buffer-name))
        (t
         (concat "*" (downcase mode-name) "*"))))
@@ -948,7 +1000,7 @@ Returns the compilation buffer created."
     (with-current-buffer
        (setq outbuf
              (get-buffer-create
-              (compilation-buffer-name name-of-mode name-function)))
+              (compilation-buffer-name name-of-mode mode name-function)))
       (let ((comp-proc (get-buffer-process (current-buffer))))
        (if comp-proc
            (if (or (not (eq (process-status comp-proc) 'run))
@@ -1016,7 +1068,8 @@ Returns the compilation buffer created."
                              (window-width))))
              ;; Set the EMACS variable, but
              ;; don't override users' setting of $EMACS.
-             (unless (getenv "EMACS") '("EMACS=t"))
+             (unless (getenv "EMACS")
+               (list (concat "EMACS=" invocation-directory invocation-name)))
              (copy-sequence process-environment))))
        (set (make-local-variable 'compilation-arguments)
             (list command mode name-function highlight-regexp))
@@ -1321,19 +1374,18 @@ Optional argument MINOR indicates this is called from
   ;; jit-lock might fontify some things too late.
   (set (make-local-variable 'font-lock-support-mode) nil)
   (set (make-local-variable 'font-lock-maximum-size) nil)
-  (let ((fld font-lock-defaults))
-    (if (and minor fld)
+  (if minor
+      (let ((fld font-lock-defaults))
        (font-lock-add-keywords nil (compilation-mode-font-lock-keywords))
-      (setq font-lock-defaults '(compilation-mode-font-lock-keywords t)))
-    (if minor
        (if font-lock-mode
            (if fld
                (font-lock-fontify-buffer)
              (font-lock-change-mode)
              (turn-on-font-lock))
-         (turn-on-font-lock))
-      ;; maybe defer font-lock till after derived mode is set up
-      (run-mode-hooks 'compilation-turn-on-font-lock))))
+         (turn-on-font-lock)))
+    (setq font-lock-defaults '(compilation-mode-font-lock-keywords t))
+    ;; maybe defer font-lock till after derived mode is set up
+    (run-mode-hooks 'compilation-turn-on-font-lock)))
 
 ;;;###autoload
 (define-minor-mode compilation-shell-minor-mode
@@ -1540,7 +1592,7 @@ Use this command in a compilation log buffer.  Sets the mark at point there."
       (dired-other-window (car (get-text-property (point) 'directory)))
     (push-mark)
     (setq compilation-current-error (point))
-    (next-error 0)))
+    (next-error-internal)))
 
 ;; Return a compilation buffer.
 ;; If the current buffer is a compilation buffer, return it.
@@ -1665,37 +1717,20 @@ displays at the top of the window; there is no arrow."
   "Jump to an error corresponding to MSG at MK.
 All arguments are markers.  If END-MK is non-nil, mark is set there
 and overlay is highlighted between MK and END-MK."
-  (if (eq (window-buffer (selected-window))
-         (marker-buffer msg))
-      ;; If the compilation buffer window is selected,
-      ;; keep the compilation buffer in this window;
-      ;; display the source in another window.
-      (let ((pop-up-windows t))
-       (pop-to-buffer (marker-buffer mk)))
-    (if (window-dedicated-p (selected-window))
-       (pop-to-buffer (marker-buffer mk))
-      (switch-to-buffer (marker-buffer mk))))
-  ;; If narrowing gets in the way of going to the right place, widen.
-  (unless (eq (goto-char mk) (point))
-    (widen)
-    (goto-char mk))
-  (if end-mk
-      (push-mark end-mk t)
-    (if mark-active (setq mark-active)))
-  ;; If hideshow got in the way of
-  ;; seeing the right place, open permanently.
-  (dolist (ov (overlays-at (point)))
-    (when (eq 'hs (overlay-get ov 'invisible))
-      (delete-overlay ov)
-      (goto-char mk)))
-
   ;; Show compilation buffer in other window, scrolled to this error.
-  (let* ((pop-up-windows t)
-        ;; Use an existing window if it is in a visible frame.
+  (let* ((from-compilation-buffer (eq (window-buffer (selected-window))
+                                      (marker-buffer msg)))
+         ;; Use an existing window if it is in a visible frame.
          (pre-existing (get-buffer-window (marker-buffer msg) 0))
-         (w (let ((display-buffer-reuse-frames t))
-              ;; Pop up a window.
-              (display-buffer (marker-buffer msg))))
+         (w (if (and from-compilation-buffer pre-existing)
+                ;; Calling display-buffer here may end up (partly) hiding
+                ;; the error location if the two buffers are in two
+                ;; different frames.  So don't do it if it's not necessary.
+                pre-existing
+              (let ((display-buffer-reuse-frames t)
+                    (pop-up-windows t))
+               ;; Pop up a window.
+                (display-buffer (marker-buffer msg)))))
         (highlight-regexp (with-current-buffer (marker-buffer msg)
                             ;; also do this while we change buffer
                             (compilation-set-window w msg)
@@ -1705,6 +1740,29 @@ and overlay is highlighted between MK and END-MK."
     ;; creating a new window.
     (unless pre-existing (compilation-set-window-height w))
 
+    (if from-compilation-buffer
+        ;; If the compilation buffer window was selected,
+        ;; keep the compilation buffer in this window;
+        ;; display the source in another window.
+        (let ((pop-up-windows t))
+          (pop-to-buffer (marker-buffer mk) 'other-window))
+      (if (window-dedicated-p (selected-window))
+          (pop-to-buffer (marker-buffer mk))
+        (switch-to-buffer (marker-buffer mk))))
+    ;; If narrowing gets in the way of going to the right place, widen.
+    (unless (eq (goto-char mk) (point))
+      (widen)
+      (goto-char mk))
+    (if end-mk
+        (push-mark end-mk t)
+      (if mark-active (setq mark-active)))
+    ;; If hideshow got in the way of
+    ;; seeing the right place, open permanently.
+    (dolist (ov (overlays-at (point)))
+      (when (eq 'hs (overlay-get ov 'invisible))
+        (delete-overlay ov)
+        (goto-char mk)))
+
     (when highlight-regexp
       (if (timerp next-error-highlight-timer)
          (cancel-timer next-error-highlight-timer))
@@ -1726,17 +1784,31 @@ and overlay is highlighted between MK and END-MK."
                                (current-buffer)))
              (move-overlay compilation-highlight-overlay
                            (point) end (current-buffer)))
-           (if (numberp next-error-highlight)
-               (setq next-error-highlight-timer
-                     (run-at-time next-error-highlight nil 'delete-overlay
-                                  compilation-highlight-overlay)))
-           (if (not (or (eq next-error-highlight t)
-                        (numberp next-error-highlight)))
-               (delete-overlay compilation-highlight-overlay))))))
+           (if (or (eq next-error-highlight t)
+                   (numberp next-error-highlight))
+               ;; We want highlighting: delete overlay on next input.
+               (add-hook 'pre-command-hook
+                         'compilation-goto-locus-delete-o)
+             ;; We don't want highlighting: delete overlay now.
+             (delete-overlay compilation-highlight-overlay))
+           ;; We want highlighting for a limited time:
+           ;; set up a timer to delete it.
+           (when (numberp next-error-highlight)
+             (setq next-error-highlight-timer
+                   (run-at-time next-error-highlight nil
+                                'compilation-goto-locus-delete-o)))))))
     (when (and (eq next-error-highlight 'fringe-arrow))
+      ;; We want a fringe arrow (instead of highlighting).
       (setq next-error-overlay-arrow-position
            (copy-marker (line-beginning-position))))))
 
+(defun compilation-goto-locus-delete-o ()
+  (delete-overlay compilation-highlight-overlay)
+  ;; Get rid of timer and hook that would try to do this again.
+  (if (timerp next-error-highlight-timer)
+      (cancel-timer next-error-highlight-timer))
+  (remove-hook 'pre-command-hook
+              'compilation-goto-locus-delete-o))
 \f
 (defun compilation-find-file (marker filename directory &rest formats)
   "Find a buffer for file FILENAME.
@@ -1748,49 +1820,67 @@ If DIRECTORY. is nil, that means use `default-directory'.
 If FILENAME is not found at all, ask the user where to find it.
 Pop up the buffer containing MARKER and scroll to MARKER if we ask the user."
   (or formats (setq formats '("%s")))
-  (save-excursion
-    (let ((dirs compilation-search-path)
-         (spec-dir (if directory
-                       (expand-file-name directory)
-                     default-directory))
-         buffer thisdir fmts name)
-      (if (file-name-absolute-p filename)
-         ;; The file name is absolute.  Use its explicit directory as
-         ;; the first in the search path, and strip it from FILENAME.
-         (setq filename (abbreviate-file-name (expand-file-name filename))
-               dirs (cons (file-name-directory filename) dirs)
-               filename (file-name-nondirectory filename)))
-      ;; Now search the path.
-      (while (and dirs (null buffer))
-       (setq thisdir (or (car dirs) spec-dir)
-             fmts formats)
-       ;; For each directory, try each format string.
-       (while (and fmts (null buffer))
-         (setq name (expand-file-name (format (car fmts) filename) thisdir)
-               buffer (and (file-exists-p name)
-                           (find-file-noselect name))
-               fmts (cdr fmts)))
-       (setq dirs (cdr dirs)))
-      (or buffer
-         ;; The file doesn't exist.  Ask the user where to find it.
-         (let ((pop-up-windows t))
-           (compilation-set-window (display-buffer (marker-buffer marker))
-                                   marker)
-           (let ((name (expand-file-name
-                        (read-file-name
-                         (format "Find this %s in: (default %s) "
-                                 compilation-error filename)
-                         spec-dir filename t))))
-             (if (file-directory-p name)
-                 (setq name (expand-file-name filename name)))
-             (setq buffer (and (file-exists-p name)
-                               (find-file name))))))
-      ;; Make intangible overlays tangible.
-      (mapcar (function (lambda (ov)
-                         (when (overlay-get ov 'intangible)
-                           (overlay-put ov 'intangible nil))))
-             (overlays-in (point-min) (point-max)))
-      buffer)))
+  (let ((dirs compilation-search-path)
+        (spec-dir (if directory
+                      (expand-file-name directory)
+                    default-directory))
+        buffer thisdir fmts name)
+    (if (file-name-absolute-p filename)
+        ;; The file name is absolute.  Use its explicit directory as
+        ;; the first in the search path, and strip it from FILENAME.
+        (setq filename (abbreviate-file-name (expand-file-name filename))
+              dirs (cons (file-name-directory filename) dirs)
+              filename (file-name-nondirectory filename)))
+    ;; Now search the path.
+    (while (and dirs (null buffer))
+      (setq thisdir (or (car dirs) spec-dir)
+            fmts formats)
+      ;; For each directory, try each format string.
+      (while (and fmts (null buffer))
+        (setq name (expand-file-name (format (car fmts) filename) thisdir)
+              buffer (and (file-exists-p name)
+                          (find-file-noselect name))
+              fmts (cdr fmts)))
+      (setq dirs (cdr dirs)))
+    (while (null buffer)    ;Repeat until the user selects an existing file.
+      ;; The file doesn't exist.  Ask the user where to find it.
+      (save-excursion            ;This save-excursion is probably not right.
+        (let ((pop-up-windows t))
+          (compilation-set-window (display-buffer (marker-buffer marker))
+                                  marker)
+          (let* ((name (read-file-name
+                        (format "Find this %s in (default %s): "
+                                compilation-error filename)
+                        spec-dir filename t nil
+                        ;; Try to make sure the user can only select
+                        ;; a valid answer.  This predicate may be ignored,
+                        ;; tho, so we still have to double-check afterwards.
+                        ;; TODO: We should probably fix read-file-name so
+                        ;; that it never ignores this predicate, even when
+                        ;; using popup dialog boxes.
+                        (lambda (name)
+                          (if (file-directory-p name)
+                              (setq name (expand-file-name filename name)))
+                          (file-exists-p name))))
+                 (origname name))
+            (cond
+             ((not (file-exists-p name))
+              (message "Cannot find file `%s'" name)
+              (ding) (sit-for 2))
+             ((and (file-directory-p name)
+                   (not (file-exists-p
+                         (setq name (expand-file-name filename name)))))
+              (message "No `%s' in directory %s" filename origname)
+              (ding) (sit-for 2))
+             (t
+              (setq buffer (find-file-noselect name))))))))
+    ;; Make intangible overlays tangible.
+    ;; This is weird: it's not even clear which is the current buffer,
+    ;; so the code below can't be expected to DTRT here.  -- Stef
+    (dolist (ov (overlays-in (point-min) (point-max)))
+      (when (overlay-get ov 'intangible)
+        (overlay-put ov 'intangible nil)))
+    buffer))
 
 (defun compilation-get-file-structure (file &optional fmt)
   "Retrieve FILE's file-structure or create a new one.