From: Michael Albinus Date: Fri, 2 Jul 2021 12:51:23 +0000 (+0200) Subject: Implement another fix for bug#49229 X-Git-Tag: emacs-28.0.90~1974 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=225ca617b70d3c70376c2d9bf38ced2f2323b26e;p=emacs.git Implement another fix for bug#49229 * lisp/minibuffer.el (read-file-name-default): Respect remote files. (Bug#49229) * lisp/net/tramp-sh.el (tramp-sh-handle-expand-file-name): Handle special file names on MS Windows. * lisp/net/tramp.el (tramp-file-name-handler): Revert patch. (Bug#49229) --- diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index 71a2177c9b1..813ce14c59b 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -3161,6 +3161,7 @@ See `read-file-name' for the meaning of the arguments." (unless val (error "No file name specified")) (if (and default-filename + (not (file-remote-p dir)) (string-equal val (if (consp insdef) (car insdef) insdef))) (setq val default-filename)) (setq val (substitute-in-file-name val)) diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index ebd0fbfd2d9..88caa2fb7ba 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -2667,56 +2667,63 @@ the result will be a local, non-Tramp, file name." (setq dir (or dir default-directory "/")) ;; Handle empty NAME. (when (zerop (length name)) (setq name ".")) - ;; Unless NAME is absolute, concat DIR and NAME. - (unless (file-name-absolute-p name) - (setq name (concat (file-name-as-directory dir) name))) - ;; If connection is not established yet, run the real handler. - (if (not (tramp-connectable-p name)) - (tramp-run-real-handler #'expand-file-name (list name nil)) - ;; Dissect NAME. - (with-parsed-tramp-file-name name nil - (unless (tramp-run-real-handler #'file-name-absolute-p (list localname)) - (setq localname (concat "~/" localname))) - ;; Tilde expansion if necessary. This needs a shell which - ;; groks tilde expansion! The function `tramp-find-shell' is - ;; supposed to find such a shell on the remote host. Please - ;; tell me about it when this doesn't work on your system. - (when (string-match "\\`\\(~[^/]*\\)\\(.*\\)\\'" localname) - (let ((uname (match-string 1 localname)) - (fname (match-string 2 localname))) - ;; We cannot simply apply "~/", because under sudo "~/" is - ;; expanded to the local user home directory but to the - ;; root home directory. On the other hand, using always - ;; the default user name for tilde expansion is not - ;; appropriate either, because ssh and companions might - ;; use a user name from the config file. - (when (and (string-equal uname "~") - (string-match-p "\\`su\\(do\\)?\\'" method)) - (setq uname (concat uname user))) - (setq uname - (with-tramp-connection-property v uname - (tramp-send-command - v (format "cd %s && pwd" (tramp-shell-quote-argument uname))) - (with-current-buffer (tramp-get-buffer v) - (goto-char (point-min)) - (buffer-substring (point) (point-at-eol))))) - (setq localname (concat uname fname)))) - ;; There might be a double slash, for example when "~/" - ;; expands to "/". Remove this. - (while (string-match "//" localname) - (setq localname (replace-match "/" t t localname))) - ;; Do not keep "/..". - (when (string-match-p "^/\\.\\.?$" localname) - (setq localname "/")) - ;; No tilde characters in file name, do normal - ;; `expand-file-name' (this does "/./" and "/../"). - ;; `default-directory' is bound, because on Windows there would - ;; be problems with UNC shares or Cygwin mounts. - (let ((default-directory (tramp-compat-temporary-file-directory))) - (tramp-make-tramp-file-name - v (tramp-drop-volume-letter - (tramp-run-real-handler - #'expand-file-name (list localname)))))))) + ;; On MS Windows, some special file names are not returned properly + ;; by `file-name-absolute-p'. + (if (and (eq system-type 'windows-nt) + (string-match-p + (concat "^\\([[:alpha:]]:\\|" null-device "$\\)") name)) + (tramp-run-real-handler #'expand-file-name (list name dir)) + ;; Unless NAME is absolute, concat DIR and NAME. + (unless (file-name-absolute-p name) + (setq name (concat (file-name-as-directory dir) name))) + ;; If connection is not established yet, run the real handler. + (if (not (tramp-connectable-p name)) + (tramp-run-real-handler #'expand-file-name (list name nil)) + ;; Dissect NAME. + (with-parsed-tramp-file-name name nil + (unless (tramp-run-real-handler #'file-name-absolute-p (list localname)) + (setq localname (concat "~/" localname))) + ;; Tilde expansion if necessary. This needs a shell which + ;; groks tilde expansion! The function `tramp-find-shell' is + ;; supposed to find such a shell on the remote host. Please + ;; tell me about it when this doesn't work on your system. + (when (string-match "\\`\\(~[^/]*\\)\\(.*\\)\\'" localname) + (let ((uname (match-string 1 localname)) + (fname (match-string 2 localname))) + ;; We cannot simply apply "~/", because under sudo "~/" is + ;; expanded to the local user home directory but to the + ;; root home directory. On the other hand, using always + ;; the default user name for tilde expansion is not + ;; appropriate either, because ssh and companions might + ;; use a user name from the config file. + (when (and (string-equal uname "~") + (string-match-p "\\`su\\(do\\)?\\'" method)) + (setq uname (concat uname user))) + (setq uname + (with-tramp-connection-property v uname + (tramp-send-command + v + (format "cd %s && pwd" (tramp-shell-quote-argument uname))) + (with-current-buffer (tramp-get-buffer v) + (goto-char (point-min)) + (buffer-substring (point) (point-at-eol))))) + (setq localname (concat uname fname)))) + ;; There might be a double slash, for example when "~/" + ;; expands to "/". Remove this. + (while (string-match "//" localname) + (setq localname (replace-match "/" t t localname))) + ;; Do not keep "/..". + (when (string-match-p "^/\\.\\.?$" localname) + (setq localname "/")) + ;; No tilde characters in file name, do normal + ;; `expand-file-name' (this does "/./" and "/../"). + ;; `default-directory' is bound, because on Windows there + ;; would be problems with UNC shares or Cygwin mounts. + (let ((default-directory (tramp-compat-temporary-file-directory))) + (tramp-make-tramp-file-name + v (tramp-drop-volume-letter + (tramp-run-real-handler + #'expand-file-name (list localname))))))))) ;;; Remote commands: diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index ee7e0cf2c3b..75e44551ef9 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -2610,14 +2610,7 @@ Fall back to normal file name handler if no Tramp file name handler exists." ;; When `tramp-mode' is not enabled, or the file name is quoted, ;; we don't do anything. - ;; When operation is `expand-file-name', and the first argument - ;; is a local absolute file name, we end also here. Handle the - ;; MS Windows case. - (funcall - (if (and (eq operation 'expand-file-name) - (not (string-match-p "\\`[[:alpha:]]:/" (car args)))) - #'tramp-drop-volume-letter #'identity) - (tramp-run-real-handler operation args))))) + (tramp-run-real-handler operation args)))) (defun tramp-completion-file-name-handler (operation &rest args) "Invoke Tramp file name completion handler for OPERATION and ARGS.