Fix file-name resolution in *compilation* and *grep* buffers

Resolving symlinks in file names could lead to non-existent files
if some leading directory is a symlink to its parent.
In emacs 28 'expand-file-name' was replaced by 'file-truename' to
solve bug #8035.

* lisp/progmodes/compile.el (safe-expand-file-name): New function.
(compilation-find-file-1): Call 'safe-expand-file-name'.  (Bug#67930)

diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el
index 4af6a96900a9f31c6fa42dbedf26c570522b6793..3002cd1b86c9fb255387658ef15147b346f464d5 100644 (file)
--- a/lisp/progmodes/compile.el
+++ b/lisp/progmodes/compile.el
@@ -3122,7 +3122,16 @@ and overlay is highlighted between MK and END-MK."
       (cancel-timer next-error-highlight-timer))
   (remove-hook 'pre-command-hook
               #'compilation-goto-locus-delete-o))
-\f
+
+(defun safe-expand-file-name (directory filename)
+  "Expand the specified filename using expand-file-name.  If this fails,
+retry with file-truename (see bug #8035)
+Unlike expand-file-name, file-truename follows symlinks which we try to avoid if possible."
+  (let* ((expandedname (expand-file-name filename directory)))
+    (if (file-exists-p expandedname)
+        expandedname
+      (file-truename (file-name-concat directory filename)))))
+
 (defun compilation-find-file-1 (marker filename directory &optional formats)
   (or formats (setq formats '("%s")))
   (let ((dirs compilation-search-path)
@@ -3143,8 +3152,7 @@ and overlay is highlighted between MK and END-MK."
             fmts formats)
       ;; For each directory, try each format string.
       (while (and fmts (null buffer))
-        (setq name (file-truename
-                    (file-name-concat thisdir (format (car fmts) filename)))
+        (setq name (safe-expand-file-name thisdir (format (car fmts) filename))
               buffer (and (file-exists-p name)
                           (find-file-noselect name))
               fmts (cdr fmts)))
@@ -3166,8 +3174,7 @@ and overlay is highlighted between MK and END-MK."
         (setq thisdir (car dirs)
               fmts formats)
         (while (and fmts (null buffer))
-          (setq name (file-truename
-                      (file-name-concat thisdir (format (car fmts) filename)))
+          (setq name (safe-expand-file-name thisdir (format (car fmts) filename))
                 buffer (and (file-exists-p name)
                             (find-file-noselect name))
                 fmts (cdr fmts)))
@@ -3227,8 +3234,7 @@ attempts to find a file whose name is produced by (format FMT FILENAME)."
               (ding) (sit-for 2))
              ((and (file-directory-p name)
                    (not (file-exists-p
-                         (setq name (file-truename
-                                     (file-name-concat name filename))))))
+                         (setq name (safe-expand-file-name name filename)))))
               (message "No `%s' in directory %s" filename origname)
               (ding) (sit-for 2))
              (t