From ae46edff68e8d5729207ed849df83ecb039e11bb Mon Sep 17 00:00:00 2001 From: Liu Hui Date: Mon, 7 Jul 2025 17:45:18 +0800 Subject: [PATCH] Add option 'ffap-prefer-remote-file' (bug#78925) This option only affects absolute filenames that are found by ffap-file-at-point in buffers with remote default directory. The handling of relative filenames in above buffers remains unchanged: ffap-file-at-point returns the relative filename, which can be converted to a remote absolute filename by subsequent callers (e.g. ffap) using expand-file-name. * lisp/ffap.el (ffap-prefer-remote-file): New user option. (ffap-file-exists-string): Add an optional argument to allow the check of existence of absolute filename on the remote host. (ffap-file-at-point): Always find remote files in remote context if the new option is non-nil. * test/lisp/ffap-tests.el (ffap-test-remote): Add a test. * etc/NEWS: Announce the change. --- etc/NEWS | 6 ++++ lisp/ffap.el | 74 +++++++++++++++++++++++++++-------------- test/lisp/ffap-tests.el | 22 ++++++++++++ 3 files changed, 77 insertions(+), 25 deletions(-) diff --git a/etc/NEWS b/etc/NEWS index 5457ed3c4d4..b3c2287589a 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2248,6 +2248,12 @@ which already takes this argument for a single attribute. This is useful when you want the face attributes to be absolute and not 'unspecified'. +--- +*** New user option 'ffap-prefer-remote-file'. +If non-nil, ffap always finds remote files in buffers with remote +'default-directory'. If nil, ffap finds local files first for absolute +filenames in above buffers. The default is nil. + --- ** Flymake diff --git a/lisp/ffap.el b/lisp/ffap.el index 10afcd9514a..64c2c780672 100644 --- a/lisp/ffap.el +++ b/lisp/ffap.el @@ -199,6 +199,16 @@ Sensible values are nil, \"news\", or \"mailto\"." ) :group 'ffap) +(defcustom ffap-prefer-remote-file nil + "Whether to prefer remote files in remote context. +If non-nil, ffap always finds remote files in buffers with remote +`default-directory'. If nil, ffap finds local files first for absolute +filenames in above buffers. Relative filenames are not affected by this +option." + :type 'boolean + :group 'ffap + :version "31.1") + (defvar ffap-max-region-length 1024 "Maximum active region length. When the region is active and larger than this value, @@ -488,7 +498,7 @@ Returned values: (defvar ffap-compression-suffixes '(".gz" ".Z") ; .z is mostly dead "List of suffixes tried by `ffap-file-exists-string'.") -(defun ffap-file-exists-string (file &optional nomodify) +(defun ffap-file-exists-string (file &optional nomodify remote-host) ;; Early jka-compr versions modified file-exists-p to return the ;; filename, maybe modified by adding a suffix like ".gz". That ;; broke the interface of file-exists-p, so it was later dropped. @@ -496,23 +506,33 @@ Returned values: "Return FILE (maybe modified) if the file exists, else nil. When using jka-compr (a.k.a. `auto-compression-mode'), the returned name may have a suffix added from `ffap-compression-suffixes'. -The optional NOMODIFY argument suppresses the extra search." - (cond - ((or (not file) ; quietly reject nil - (zerop (length file))) ; and also "" - nil) - ((file-exists-p file) file) ; try unmodified first - ;; three reasons to suppress search: - (nomodify nil) - ((not (rassq 'jka-compr-handler file-name-handler-alist)) nil) - ((member (file-name-extension file t) ffap-compression-suffixes) nil) - (t ; ok, do the search - (let ((list ffap-compression-suffixes) try ret) - (while list - (if (file-exists-p (setq try (concat file (car list)))) - (setq ret try list nil) - (setq list (cdr list)))) - ret)))) +The optional NOMODIFY argument suppresses the extra search. + +The optional argument REMOTE-HOST, if non-nil, should be a string +returned by `file-remote-p'. If it is non-nil and FILE is absolute, +check whether FILE exists on REMOTE-HOST. The returned name uses +REMOTE-HOST as the prefix if the file exists." + (let ((non-essential t)) + (cond + ((or (not file) ; quietly reject nil + (zerop (length file))) ; and also "" + nil) + ((and remote-host ; prepend remote host to file + (file-name-absolute-p file) + (setq file (concat remote-host file)) + nil)) + ((file-exists-p file) file) + ;; three reasons to suppress search: + (nomodify nil) + ((not (rassq 'jka-compr-handler file-name-handler-alist)) nil) + ((member (file-name-extension file t) ffap-compression-suffixes) nil) + (t ; ok, do the search + (let ((list ffap-compression-suffixes) try ret) + (while list + (if (file-exists-p (setq try (concat file (car list)))) + (setq ret try list nil) + (setq list (cdr list)))) + ret))))) (defun ffap-file-remote-p (filename) "If FILENAME looks remote, return it (maybe slightly improved)." @@ -1465,6 +1485,8 @@ which may actually result in an URL rather than a filename." string)) (abs (file-name-absolute-p name)) (default-directory default-directory) + (remote-p (and ffap-prefer-remote-file + (file-remote-p default-directory))) (oname name)) (unwind-protect (cond @@ -1484,10 +1506,11 @@ which may actually result in an URL rather than a filename." ;; Accept remote names without actual checking (too slow): ((and abs (ffap-file-remote-p name))) ;; Ok, not remote, try the existence test even if it is absolute: - ((and abs (ffap-file-exists-string name))) + ((and abs (ffap-file-exists-string name nil remote-p))) ;; Try stripping off line numbers. ((and abs (string-match ":[0-9]" name) - (ffap-file-exists-string (substring name 0 (match-beginning 0))))) + (ffap-file-exists-string (substring name 0 (match-beginning 0)) + nil remote-p))) ;; If it contains a colon, get rid of it (and return if exists) ((and (string-match path-separator name) (let ((this-name (ffap-string-at-point 'nocolon))) @@ -1495,7 +1518,7 @@ which may actually result in an URL rather than a filename." ;; the empty string. (when (> (length this-name) 0) (setq name this-name) - (ffap-file-exists-string name))))) + (ffap-file-exists-string name nil remote-p))))) ;; File does not exist, try the alist: ((let ((alist ffap-alist) tem try case-fold-search) (while (and alist (not try)) @@ -1510,7 +1533,7 @@ which may actually result in an URL rather than a filename." (setq try (or (ffap-url-p try) ; not a file! (ffap-file-remote-p try) - (ffap-file-exists-string try)))))) + (ffap-file-exists-string try nil remote-p)))))) try)) ;; Try adding a leading "/" (common omission in ftp file names). ;; Note that this uses oname, which still has any colon part. @@ -1543,17 +1566,18 @@ which may actually result in an URL rather than a filename." (string-match ffap-dired-wildcards name) abs (ffap-file-exists-string (file-name-directory - (directory-file-name name))) + (directory-file-name name)) + nil remote-p) name)) ;; Try all parent directories by deleting the trailing directory ;; name until existing directory is found or name stops changing ((let ((dir name)) (while (and dir - (not (ffap-file-exists-string dir)) + (not (ffap-file-exists-string dir nil remote-p)) (not (equal dir (setq dir (file-name-directory (directory-file-name dir))))))) (and (not (string= dir "/")) - (ffap-file-exists-string dir)))) + (ffap-file-exists-string dir nil remote-p)))) ) (set-match-data data)))) diff --git a/test/lisp/ffap-tests.el b/test/lisp/ffap-tests.el index ea5e745bfaf..2bf5d8c79cd 100644 --- a/test/lisp/ffap-tests.el +++ b/test/lisp/ffap-tests.el @@ -25,6 +25,7 @@ (require 'cl-lib) (require 'ert) +(require 'tramp) (require 'ert-x) (require 'ffap) @@ -289,6 +290,27 @@ End of search list. (should (member (expand-file-name "/Applications/Xcode.app/Contents/Developer/Toolchains/XcodeDefault.xctoolchain/usr/lib/clang/15.0.0/include") (ffap--c-path))))) +(ert-deftest ffap-test-remote () + (skip-unless + (ignore-errors + (and + (file-remote-p ert-remote-temporary-file-directory) + (file-directory-p ert-remote-temporary-file-directory) + (file-writable-p ert-remote-temporary-file-directory)))) + (let* ((ffap-prefer-remote-file t) + (default-directory + (expand-file-name ert-remote-temporary-file-directory)) + (test-file (expand-file-name "ffap-test" default-directory))) + (with-temp-buffer + (ignore-errors (make-empty-file test-file)) + (insert (file-local-name test-file)) + (should (equal (ffap-file-at-point) test-file)) + (erase-buffer) + (insert (concat "/usr/bin:" (file-local-name test-file))) + (should (equal (ffap-file-at-point) test-file)) + (delete-file test-file) + (should (equal (ffap-file-at-point) default-directory))))) + (provide 'ffap-tests) ;;; ffap-tests.el ends here