master e568c3845c: Add more compilation-auto-jump-to-first-error options

[Lars Ingebrigtsen]

branch: master
commit e568c3845cd98b702ce23bdef1b22e088769c9cd
Author: Lars Ingebrigtsen <larsi@gnus.org>
Commit: Lars Ingebrigtsen <larsi@gnus.org>

    Add more compilation-auto-jump-to-first-error options
    
    * doc/emacs/building.texi (Compilation Mode): Document it.
    * lisp/progmodes/compile.el
    (compilation-auto-jump-to-first-error): Extend type.
    (compilation--file-known-p): New function.
    (compilation-auto-jump): Use it to support the new values
    (bug#8228).
    (compilation-find-file-1): Factored out into own function.
    (compilation-find-file): Factored out from here.
---
 doc/emacs/building.texi   |  4 ++-
 etc/NEWS                  |  6 +++++
 lisp/progmodes/compile.el | 65 +++++++++++++++++++++++++++++++++++------------
 3 files changed, 58 insertions(+), 17 deletions(-)

diff --git a/doc/emacs/building.texi b/doc/emacs/building.texi
index 994ad46033..892117e2e8 100644
--- a/doc/emacs/building.texi
+++ b/doc/emacs/building.texi
@@ -178,7 +178,9 @@ list of customization variables and faces.
   If you change the variable
 @code{compilation-auto-jump-to-first-error} to a non-@code{nil} value,
 Emacs automatically visits the locus of the first error message that
-appears in the @file{*compilation*} buffer.
+appears in the @file{*compilation*} buffer.  (This variable can also
+have the values @code{if-location-known} and @code{first-known}, which
+modifies whether to automatically visit.)
 
   Compilation mode provides the following additional commands.  These
 commands can also be used in @file{*grep*} buffers, where the
diff --git a/etc/NEWS b/etc/NEWS
index 8404a3616e..45682998db 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -810,6 +810,12 @@ which is a change in behaviour from previous Emacs 
versions.
 
 ** Compile
 
++++
+*** The 'compilation-auto-jump-to-first-error' has been extended.
+It can now have the additional values 'if-location-known' (which will
+only jump if the location of the first error is known), and
+'first-known' (which will jump to the first known error location).
+
 +++
 *** New user option 'compilation-max-output-line-length'.
 Lines longer than this will have the ends hidden, with a button to
diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el
index 2c5f4687ac..5545b4cd4a 100644
--- a/lisp/progmodes/compile.el
+++ b/lisp/progmodes/compile.el
@@ -951,7 +951,10 @@ Faces `compilation-error-face', `compilation-warning-face',
 
 (defcustom compilation-auto-jump-to-first-error nil
   "If non-nil, automatically jump to the first error during compilation."
-  :type 'boolean
+  :type '(choice (const :tag "Never" nil)
+                 (const :tag "Always" t)
+                 (const :tag "If location known" if-location-known)
+                 (const :tag "First known location" first-known))
   :version "23.1")
 
 (defvar-local compilation-auto-jump-to-next nil
@@ -1182,14 +1185,39 @@ POS and RES.")
              l2
            (setcdr l1 (cons (list ,key) l2)))))))
 
+(defun compilation--file-known-p ()
+  "Say whether the file under point can be found."
+  (when-let* ((msg (get-text-property (point) 'compilation-message))
+              (loc (compilation--message->loc msg))
+              (elem (compilation-find-file-1
+                     (point-marker)
+                     (caar (compilation--loc->file-struct loc))
+                     (cadr (car (compilation--loc->file-struct loc)))
+                     (compilation--file-struct->formats
+                      (compilation--loc->file-struct loc)))))
+    (car elem)))
+
 (defun compilation-auto-jump (buffer pos)
   (when (buffer-live-p buffer)
     (with-current-buffer buffer
       (goto-char pos)
       (let ((win (get-buffer-window buffer 0)))
         (if win (set-window-point win pos)))
-      (if compilation-auto-jump-to-first-error
-         (compile-goto-error)))))
+      (when compilation-auto-jump-to-first-error
+        (cl-case compilation-auto-jump-to-first-error
+          ('if-location-known
+           (when (compilation--file-known-p)
+            (compile-goto-error)))
+          ('first-known
+           (let (match)
+             (while (and (not (compilation--file-known-p))
+                         (setq match (text-property-search-forward
+                                      'compilation-message nil nil t)))
+               (goto-char (prop-match-beginning match))))
+           (when (compilation--file-known-p)
+            (compile-goto-error)))
+          (otherwise
+           (compile-goto-error)))))))
 
 ;; This function is the central driver, called when font-locking to gather
 ;; all information needed to later jump to corresponding source code.
@@ -2974,19 +3002,7 @@ and overlay is highlighted between MK and END-MK."
   (remove-hook 'pre-command-hook
               #'compilation-goto-locus-delete-o))
 
-(defun compilation-find-file (marker filename directory &rest formats)
-  "Find a buffer for file FILENAME.
-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 where to find the file.
-Search the directories in `compilation-search-path'.
-A nil in `compilation-search-path' means to try the
-\"current\" directory, which is passed in DIRECTORY.
-If DIRECTORY is relative, it is combined with `default-directory'.
-If DIRECTORY is nil, that means use `default-directory'.
-FORMATS, if given, is a list of formats to reformat FILENAME when
-looking for it: for each element FMT in FORMATS, this function
-attempts to find a file whose name is produced by (format FMT FILENAME)."
+(defun compilation-find-file-1 (marker filename directory &optional formats)
   (or formats (setq formats '("%s")))
   (let ((dirs compilation-search-path)
         (spec-dir (if directory
@@ -3035,6 +3051,23 @@ attempts to find a file whose name is produced by 
(format FMT FILENAME)."
                             (find-file-noselect name))
                 fmts (cdr fmts)))
         (setq dirs (cdr dirs))))
+    (list buffer spec-dir)))
+
+(defun compilation-find-file (marker filename directory &rest formats)
+  "Find a buffer for file FILENAME.
+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 where to find the file.
+Search the directories in `compilation-search-path'.
+A nil in `compilation-search-path' means to try the
+\"current\" directory, which is passed in DIRECTORY.
+If DIRECTORY is relative, it is combined with `default-directory'.
+If DIRECTORY is nil, that means use `default-directory'.
+FORMATS, if given, is a list of formats to reformat FILENAME when
+looking for it: for each element FMT in FORMATS, this function
+attempts to find a file whose name is produced by (format FMT FILENAME)."
+  (pcase-let ((`(,buffer ,spec-dir)
+               (compilation-find-file-1 marker filename directory formats)))
     (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.