From 024d5b0c41aa9963f87c50372ecca2c3883918bb Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Tue, 15 Nov 2016 20:50:49 +0100 Subject: [PATCH] Implement file name handler for `file-name-case-insensitive-p' * doc/lispref/files.texi (Truenames): `file-name-case-insensitive-p' is also applicable for remote hosts. * lisp/net/tramp.el (tramp-methods): Improve docstring. (tramp-file-name-for-operation): Add `file-name-case-insensitive-p'. (tramp-handle-file-name-case-insensitive-p): New defun. * lisp/net/tramp-smb.el (tramp-methods) : Add `tramp-case-insensitive' entry. * lisp/net/tramp-adb.el (tramp-adb-file-name-handler-alist) * lisp/net/tramp-gvfs.el (tramp-gvfs-file-name-handler-alist) * lisp/net/tramp-sh.el (tramp-sh-file-name-handler-alist) * lisp/net/tramp-smb.el (tramp-smb-file-name-handler-alist) : Add handler. (Bug#22300, Bug#24441) --- doc/lispref/files.texi | 4 +++- lisp/net/tramp-adb.el | 1 + lisp/net/tramp-gvfs.el | 1 + lisp/net/tramp-sh.el | 1 + lisp/net/tramp-smb.el | 8 +++++-- lisp/net/tramp.el | 53 +++++++++++++++++++++++++++++++++++++++--- 6 files changed, 62 insertions(+), 6 deletions(-) diff --git a/doc/lispref/files.texi b/doc/lispref/files.texi index 70c7177e064..e189da9fbe2 100644 --- a/doc/lispref/files.texi +++ b/doc/lispref/files.texi @@ -1154,7 +1154,9 @@ on Mac OS X. Currently this function always returns @code{nil} on platforms other than MS-DOS, MS-Windows, Cygwin, and Mac OS X. It does not detect case-insensitivity of mounted filesystems, such as Samba shares or -NFS-mounted Windows volumes. +NFS-mounted Windows volumes. On remote hosts, it assumes @code{t} for +the @samp{smb} method. For all other connection methods, runtime +tests are performed. @end defun @defun file-in-directory-p file dir diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el index 1aae0ecfffd..f03f50bb009 100644 --- a/lisp/net/tramp-adb.el +++ b/lisp/net/tramp-adb.el @@ -126,6 +126,7 @@ It is used for TCP/IP devices." (file-modes . tramp-handle-file-modes) (file-name-all-completions . tramp-adb-handle-file-name-all-completions) (file-name-as-directory . tramp-handle-file-name-as-directory) + (file-name-case-insensitive-p . tramp-handle-file-name-case-insensitive-p) (file-name-completion . tramp-handle-file-name-completion) (file-name-directory . tramp-handle-file-name-directory) (file-name-nondirectory . tramp-handle-file-name-nondirectory) diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el index a84097cfc4d..d87de467c67 100644 --- a/lisp/net/tramp-gvfs.el +++ b/lisp/net/tramp-gvfs.el @@ -480,6 +480,7 @@ Every entry is a list (NAME ADDRESS).") (file-modes . tramp-handle-file-modes) (file-name-all-completions . tramp-gvfs-handle-file-name-all-completions) (file-name-as-directory . tramp-handle-file-name-as-directory) + (file-name-case-insensitive-p . tramp-handle-file-name-case-insensitive-p) (file-name-completion . tramp-handle-file-name-completion) (file-name-directory . tramp-handle-file-name-directory) (file-name-nondirectory . tramp-handle-file-name-nondirectory) diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 1682b16fe02..9496ebf7563 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -1027,6 +1027,7 @@ of command line.") (file-modes . tramp-handle-file-modes) (file-name-all-completions . tramp-sh-handle-file-name-all-completions) (file-name-as-directory . tramp-handle-file-name-as-directory) + (file-name-case-insensitive-p . tramp-handle-file-name-case-insensitive-p) (file-name-completion . tramp-handle-file-name-completion) (file-name-directory . tramp-handle-file-name-directory) (file-name-nondirectory . tramp-handle-file-name-nondirectory) diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el index 7c600702cae..61796a25bb3 100644 --- a/lisp/net/tramp-smb.el +++ b/lisp/net/tramp-smb.el @@ -49,7 +49,9 @@ ;; This is just a guess. We don't know whether the share "C$" ;; is available for public use, and whether the user has write ;; access. - (tramp-tmpdir "/C$/Temp")))) + (tramp-tmpdir "/C$/Temp") + ;; Another guess. We might implement a better check later on. + (tramp-case-insensitive t)))) ;; Add a default for `tramp-default-method-alist'. Rule: If there is ;; a domain in USER, it must be the SMB method. @@ -243,6 +245,7 @@ See `tramp-actions-before-shell' for more info.") (file-modes . tramp-handle-file-modes) (file-name-all-completions . tramp-smb-handle-file-name-all-completions) (file-name-as-directory . tramp-handle-file-name-as-directory) + (file-name-case-insensitive-p . tramp-handle-file-name-case-insensitive-p) (file-name-completion . tramp-handle-file-name-completion) (file-name-directory . tramp-handle-file-name-directory) (file-name-nondirectory . tramp-handle-file-name-nondirectory) @@ -501,7 +504,8 @@ pass to the OPERATION." ;; target. (make-directory (expand-file-name - ".." (concat tmpdir localname)) 'parents) + ".." (concat tmpdir localname)) + 'parents) (make-symbolic-link newname (directory-file-name (concat tmpdir localname)))) diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 5d56fdf1104..b0391ec7714 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -255,6 +255,11 @@ pair of the form (KEY VALUE). The following KEYs are defined: In general, the global default value shall be used, but for some methods, like \"su\" or \"sudo\", a shorter timeout might be desirable. + * `tramp-case-insensitive' + Whether the remote file system handles file names case insensitive. + Only a non-nil value counts, the default value nil means to + perform further checks on the remote host. See + `tramp-connection-properties' for a way to overwrite this. What does all this mean? Well, you should specify `tramp-login-program' for all methods; this program is used to log in to the remote site. Then, @@ -1919,8 +1924,7 @@ ARGS are the arguments OPERATION has been called with." file-accessible-directory-p file-attributes file-directory-p file-executable-p file-exists-p file-local-copy file-modes - file-name-as-directory file-name-case-insensitive-p - file-name-directory + file-name-as-directory file-name-directory file-name-nondirectory file-name-sans-versions file-ownership-preserved-p file-readable-p file-regular-p file-remote-p file-symlink-p file-truename @@ -1931,7 +1935,9 @@ ARGS are the arguments OPERATION has been called with." unhandled-file-name-directory vc-registered ;; Emacs 24+ only. file-acl file-notify-add-watch file-selinux-context - set-file-acl set-file-selinux-context)) + set-file-acl set-file-selinux-context + ;; Emacs 26+ only. + file-name-case-insensitive-p)) (if (file-name-absolute-p (nth 0 args)) (nth 0 args) (expand-file-name (nth 0 args)))) @@ -2888,6 +2894,47 @@ User is always nil." 'file-name-as-directory (list (or (tramp-file-name-localname v) "")))) (tramp-file-name-hop v)))) +(defun tramp-handle-file-name-case-insensitive-p (filename) + "Like `file-name-case-insensitive-p' for Tramp files." + ;; We make it a connection property, assuming that all file systems + ;; on the remote host behave similar. This might be wrong for + ;; mounted NFS directories or SMB/AFP shares; such more granular + ;; tests will be added in case they are needed. + (setq filename (expand-file-name filename)) + (with-parsed-tramp-file-name filename nil + (or ;; Maybe there is a default value. + (tramp-get-method-parameter v 'tramp-case-insensitive) + + ;; There isn't. So we must check. + (with-tramp-connection-property v "case-insensitive" + ;; The idea is to compare a file with lower case letters with + ;; the same file with upper case letters. + (let ((candidate (directory-file-name filename)) + tmpfile) + ;; Check, whether we find an existing file with lower case + ;; letters. This avoids us to create a temporary file. + (while (and (string-match "[a-z]" (file-remote-p candidate 'localname)) + (not (file-exists-p candidate))) + (setq candidate + (directory-file-name (file-name-directory candidate)))) + ;; Nothing found, so we must use a temporary file for + ;; comparision. `make-nearby-temp-file' is added to Emacs + ;; 26+ like `file-name-case-insensitive-p', so there is no + ;; compatibility problem calling it. + (unless (string-match "[a-z]" (file-remote-p candidate 'localname)) + (setq tmpfile + (let ((default-directory (file-name-directory filename))) + (tramp-compat-funcall 'make-nearby-temp-file "tramp.")) + candidate tmpfile)) + ;; Check for the existence of the same file with upper case letters. + (unwind-protect + (file-exists-p + (concat + (file-remote-p candidate) + (upcase (file-remote-p candidate 'localname)))) + ;; Cleanup. + (when tmpfile (delete-file tmpfile)))))))) + (defun tramp-handle-file-name-completion (filename directory &optional predicate) "Like `file-name-completion' for Tramp files." -- 2.39.5