[Emacs-diffs] master 1ca436a: Make compilation mode work with warnings from compiled buffer functions

[Alan Mackenzie]

branch: master
commit 1ca436a33c7de612e44409841d6bed0fe6268141
Author: Alan Mackenzie <address@hidden>
Commit: Alan Mackenzie <address@hidden>

    Make compilation mode work with warnings from compiled buffer functions
    
    In particular, warning messages from compile_defun now contain the source
    buffer name and line and column numbers.  Typing CR on such a warning now
    moves to the pertinent place in the source buffer.
    
    This fixes bug #33475
    
    * lisp/emacs-lisp/bytecomp.el (top-level): Require compile.elc?.
    (emacs-lisp-compilation-file-name-or-buffer)
    (emacs-lisp-compilation-parse-errors-filename-function): New
    variables/constants.
    (emacs-lisp-compilation-mode): New mode derived from compilation-mode.
    (byte-compile-log-file): Check byte-compile-current-file for being a string,
    not merely non-nil.  Change wording in message from "buffer" to "in buffer".
    Go into emacs-lisp-compilation-mode rather than the plain compilation-mode.
    (compile-defun): Bind byte-compile-current-file to current-buffer, not nil.
    
    * lisp/progmodes/compilation-mode
    (compilation-parse-errors-filename-function): Amend comments to specify that
    this function may return a buffer, and that it need not save the match data.
    (Several places): Amend comments to allow for the use of a buffer rather 
than
    a file name.
    (compilation-next-error-function): If the "file name" in file struct is
    actually a buffer, use it rather than compilation-find-file's result.
    (compilation-get-file-structure): save-match-data around the call to
    compilation-parse-errors-filename-function.  Only call
    command-line-normalize-file-name when `filename' is a string.
---
 lisp/emacs-lisp/bytecomp.el | 32 +++++++++++++++++++++++++-----
 lisp/progmodes/compile.el   | 47 ++++++++++++++++++++++++++++-----------------
 2 files changed, 56 insertions(+), 23 deletions(-)

diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
index 15f31dd..f60ccda 100644
--- a/lisp/emacs-lisp/bytecomp.el
+++ b/lisp/emacs-lisp/bytecomp.el
@@ -124,6 +124,7 @@
 (require 'backquote)
 (require 'macroexp)
 (require 'cconv)
+(require 'compile)
 ;; Refrain from using cl-lib at run-time here, since it otherwise prevents
 ;; us from emitting warnings when compiling files which use cl-lib without
 ;; requiring it! (bug#30635)
@@ -1006,6 +1007,24 @@ Each function's symbol gets added to 
`byte-compile-noruntime-functions'."
 
 ;;; byte compiler messages
 
+(defun emacs-lisp-compilation-file-name-or-buffer (str)
+  "Return file name or buffer given by STR.
+If STR is a \"normal\" filename, just return it.
+If STR is something like \"Buffer foo.el\", return #<buffer foo.el>
+\(if it is still live) or the string \"foo.el\" otherwise."
+  (if (string-match "Buffer \\(.*\\)\\'" str)
+      (or (get-buffer (match-string-no-properties 1 str))
+          (match-string-no-properties 1 str))
+    str))
+
+(defconst emacs-lisp-compilation-parse-errors-filename-function
+  'emacs-lisp-compilation-file-name-or-buffer
+  "The value for `compilation-parse-errors-filename-function' for when
+we go into emacs-lisp-compilation-mode.")
+
+(define-compilation-mode emacs-lisp-compilation-mode "elisp-compile"
+  "The variant of `compilation-mode' used for emacs-lisp error buffers")
+
 (defvar byte-compile-current-form nil)
 (defvar byte-compile-dest-file nil)
 (defvar byte-compile-current-file nil)
@@ -1160,12 +1179,14 @@ Each function's symbol gets added to 
`byte-compile-noruntime-functions'."
 ;; Return the position of the start of the page in the log buffer.
 ;; But do nothing in batch mode.
 (defun byte-compile-log-file ()
-  (and (not (equal byte-compile-current-file byte-compile-last-logged-file))
+  (and (not
+        (and (get-buffer byte-compile-log-buffer)
+             (equal byte-compile-current-file byte-compile-last-logged-file)))
        (not noninteractive)
        (with-current-buffer (get-buffer-create byte-compile-log-buffer)
         (goto-char (point-max))
         (let* ((inhibit-read-only t)
-               (dir (and byte-compile-current-file
+               (dir (and (stringp byte-compile-current-file)
                          (file-name-directory byte-compile-current-file)))
                (was-same (equal default-directory dir))
                pt)
@@ -1180,7 +1201,7 @@ Each function's symbol gets added to 
`byte-compile-noruntime-functions'."
               (insert "\f\nCompiling "
                       (if (stringp byte-compile-current-file)
                           (concat "file " byte-compile-current-file)
-                        (concat "buffer "
+                        (concat "in buffer "
                                  (buffer-name byte-compile-current-file)))
                       " at " (current-time-string) "\n")
             (insert "\f\nCompiling no file at " (current-time-string) "\n"))
@@ -1192,7 +1213,8 @@ Each function's symbol gets added to 
`byte-compile-noruntime-functions'."
           (setq byte-compile-last-logged-file byte-compile-current-file
                 byte-compile-last-warned-form nil)
           ;; Do this after setting default-directory.
-          (unless (derived-mode-p 'compilation-mode) (compilation-mode))
+          (unless (derived-mode-p 'compilation-mode)
+             (emacs-lisp-compilation-mode))
           (compilation-forget-errors)
           pt))))
 
@@ -1981,7 +2003,7 @@ With argument ARG, insert value in current buffer after 
the form."
   (save-excursion
     (end-of-defun)
     (beginning-of-defun)
-    (let* ((byte-compile-current-file nil)
+    (let* ((byte-compile-current-file (current-buffer))
           (byte-compile-current-buffer (current-buffer))
           (byte-compile-read-position (point))
           (byte-compile-last-position byte-compile-read-position)
diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el
index 7e7c18f..973d3a0 100644
--- a/lisp/progmodes/compile.el
+++ b/lisp/progmodes/compile.el
@@ -83,7 +83,10 @@ buffer.  This enables a major-mode to specify its own 
value.")
 (defvar compilation-parse-errors-filename-function nil
   "Function to call to post-process filenames while parsing error messages.
 It takes one arg FILENAME which is the name of a file as found
-in the compilation output, and should return a transformed file name.")
+in the compilation output, and should return a transformed file name
+or a buffer, the one which was compiled.")
+;; Note: the compilation-parse-errors-filename-function need not save the
+;; match data.
 
 ;;;###autoload
 (defvar compilation-process-setup-function nil
@@ -550,7 +553,8 @@ 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 that returns (FILENAME) or (RELATIVE-FILENAME . DIRNAME).
-In the former case, FILENAME may be relative or absolute.
+In the former case, FILENAME may be relative or absolute, or it may
+be a buffer.
 
 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)
@@ -944,10 +948,11 @@ from a different message."
 ;;   FILE-STRUCTURE is a list of
 ;;   ((FILENAME DIRECTORY) FORMATS (LINE LOC ...) ...)
 
-;; FILENAME is a string parsed from an error message.  DIRECTORY is a string
-;; obtained by following directory change messages.  DIRECTORY will be nil for
-;; an absolute filename.  FORMATS is a list of formats to apply to FILENAME if
-;; a file of that name can't be found.
+;; FILENAME is a string parsed from an error message, or the buffer which was
+;; compiled.  DIRECTORY is a string obtained by following directory change
+;; messages.  DIRECTORY will be nil for an absolute filename or a buffer.
+;; FORMATS is a list of formats to apply to FILENAME if a file of that name
+;; can't be found.
 ;; The rest of the list is an alist of elements with LINE as key.  The keys
 ;; are either nil or line numbers.  If present, nil comes first, followed by
 ;; the numbers in decreasing order.  The LOCs for each line are again an alist
@@ -1180,7 +1185,8 @@ just char-counts."
   "Get the meta-info that will be added as text-properties.
 LINE, END-LINE, COL, END-COL are integers or nil.
 TYPE can be 0, 1, or 2, meaning error, warning, or just info.
-FILE should be (FILENAME) or (RELATIVE-FILENAME . DIRNAME) or nil.
+FILE should be (FILENAME) or (RELATIVE-FILENAME . DIRNAME) or (BUFFER) or
+nil.
 FMTS is a list of format specs for transforming the file name.
  (See `compilation-error-regexp-alist'.)"
   (unless file (setq file '("*unknown*")))
@@ -2493,12 +2499,14 @@ This is the value of `next-error-function' in 
Compilation buffers."
                  ;;            (setq timestamp compilation-buffer-modtime)))
                  )
       (with-current-buffer
-          (apply #'compilation-find-file
-                 marker
-                 (caar (compilation--loc->file-struct loc))
-                 (cadr (car (compilation--loc->file-struct loc)))
-                 (compilation--file-struct->formats
-                  (compilation--loc->file-struct loc)))
+          (if (bufferp (caar (compilation--loc->file-struct loc)))
+              (caar (compilation--loc->file-struct loc))
+            (apply #'compilation-find-file
+                   marker
+                   (caar (compilation--loc->file-struct loc))
+                   (cadr (car (compilation--loc->file-struct loc)))
+                   (compilation--file-struct->formats
+                    (compilation--loc->file-struct loc))))
         (let ((screen-columns
                ;; Obey the compilation-error-screen-columns of the target
                ;; buffer if its major mode set it buffer-locally.
@@ -2810,18 +2818,21 @@ TRUE-DIRNAME is the `file-truename' of DIRNAME, if 
given."
                       (concat comint-file-name-prefix spec-directory))))))
 
        ;; If compilation-parse-errors-filename-function is
-       ;; defined, use it to process the filename.
+       ;; defined, use it to process the filename.  The result might be a
+       ;; buffer.
        (when compilation-parse-errors-filename-function
-         (setq filename
-               (funcall compilation-parse-errors-filename-function
-                        filename)))
+          (save-match-data
+           (setq filename
+                 (funcall compilation-parse-errors-filename-function
+                          filename))))
 
        ;; Some compilers (e.g. Sun's java compiler, reportedly) produce bogus
        ;; file names like "./bar//foo.c" for file "bar/foo.c";
        ;; expand-file-name will collapse these into "/foo.c" and fail to find
        ;; the appropriate file.  So we look for doubled slashes in the file
        ;; name and fix them.
-       (setq filename (command-line-normalize-file-name filename))
+       (if (stringp filename)
+            (setq filename (command-line-normalize-file-name filename)))
 
        ;; Store it for the possibly unnormalized name
        (puthash file