[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
master 471cc26002d 1/2: Fix file-name resolution in *compilation* and *g
From: |
Eli Zaretskii |
Subject: |
master 471cc26002d 1/2: Fix file-name resolution in *compilation* and *grep* buffers |
Date: |
Sat, 6 Jan 2024 05:34:41 -0500 (EST) |
branch: master
commit 471cc26002d3f6028252c77998272fccf73722ec
Author: Jurgen De Backer <jurgen.de-backer.ext@eurocontrol.int>
Commit: Eli Zaretskii <eliz@gnu.org>
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)
---
lisp/progmodes/compile.el | 20 +++++++++++++-------
1 file changed, 13 insertions(+), 7 deletions(-)
diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el
index 4af6a96900a..3002cd1b86c 100644
--- 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))
-
+
+(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