From 471cc26002d3f6028252c77998272fccf73722ec Mon Sep 17 00:00:00 2001 From: Jurgen De Backer Date: Thu, 4 Jan 2024 11:10:56 +0000 Subject: [PATCH] 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 -- 2.39.2