]> code.delx.au - gnu-emacs/blobdiff - lisp/progmodes/compile.el
(compilation-directory-matcher): Improve previous doc fix.
[gnu-emacs] / lisp / progmodes / compile.el
index 3c63d5f01b1f8f744669e758dba8fa4e13037e4d..15346be53c739588a18372958909177ddf8981aa 100644 (file)
@@ -218,24 +218,31 @@ 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, we disallow filenames exclusively
-     ;; composed of digits.  --Stef
+     ;; 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:].]+: ?\\)?\
-\\([0-9]*[^0-9\n].*?\\): ?\
+\\([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:\\|instantiated from\\)\\)?"
+ *\\([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))
@@ -390,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
@@ -405,10 +412,7 @@ you may also want to change `compilation-page-delimiter'.")
   "Value of `page-delimiter' in Compilation mode.")
 
 (defvar compilation-mode-font-lock-keywords
-   '(;; Don't highlight this as a compilation message.
-     ("^Compilation started at.*"
-      (0 '(face nil message nil help-echo nil mouse-face nil) t))
-     ;; configure output lines.
+   '(;; configure output lines.
      ("^[Cc]hecking \\(?:[Ff]or \\|[Ii]f \\|[Ww]hether \\(?:to \\)?\\)?\\(.+\\)\\.\\.\\. *\\(?:(cached) *\\)?\\(\\(yes\\(?: .+\\)?\\)\\|no\\|\\(.*\\)\\)$"
       (1 font-lock-variable-name-face)
       (2 (compilation-face '(4 . 3))))
@@ -419,7 +423,7 @@ you may also want to change `compilation-page-delimiter'.")
      ("^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)))
@@ -621,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
@@ -1064,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))
@@ -1779,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.
@@ -1823,28 +1842,44 @@ Pop up the buffer containing MARKER and scroll to MARKER if we ask the user."
                           (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.
-        (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 (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-noselect name)))))))
+    (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 very weird: it's not even clear which is the current buffer,
-    ;; so the code below can't be expected to DTRT here.  --Stef
-    (mapcar (function (lambda (ov)
-                        (when (overlay-get ov 'intangible)
-                          (overlay-put ov 'intangible nil))))
-            (overlays-in (point-min) (point-max)))
+    ;; 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)