master bced4d26d9: Tolerate tilde in remote file names when needed

[Michael Albinus]

branch: master
commit bced4d26d99db9277284e4a37830d81172b82736
Author: Michael Albinus <michael.albinus@gmx.de>
Commit: Michael Albinus <michael.albinus@gmx.de>

    Tolerate tilde in remote file names when needed
    
    * lisp/net/tramp.el (tramp-tolerate-tilde): New defvar.
    (tramp-handle-expand-file-name):
    * lisp/net/tramp-gvfs.el (tramp-gvfs-handle-expand-file-name):
    Respect it.
    
    * lisp/net/tramp-adb.el (tramp-adb-tolerate-tilde):
    * lisp/net/tramp-sshfs.el (tramp-sshfs-tolerate-tilde): New defuns.
    Advice `shell-mode' with them.
    (tramp-methods) <sshfs>: Add "-t -t" to `tramp-login-args'.
---
 lisp/net/tramp-adb.el   | 18 ++++++++++++++++++
 lisp/net/tramp-gvfs.el  |  6 +++++-
 lisp/net/tramp-sshfs.el | 21 ++++++++++++++++++++-
 lisp/net/tramp.el       | 11 +++++++++--
 4 files changed, 52 insertions(+), 4 deletions(-)

diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el
index 75e6b7179b..85cd2d9bc1 100644
--- a/lisp/net/tramp-adb.el
+++ b/lisp/net/tramp-adb.el
@@ -1364,6 +1364,24 @@ connection if a previous connection has died for some 
reason."
    `(:application tramp :protocol ,tramp-adb-method)
    'tramp-adb-connection-local-default-shell-profile))
 
+;; `shell-mode' tries to open remote files like "/adb::~/.history".
+;; This fails, because the tilde cannot be expanded.  Tell
+;; `tramp-handle-expand-file-name' to tolerate this.
+(defun tramp-adb-tolerate-tilde (orig-fun)
+  "Advice for `shell-mode' to tolerate tilde in remote file names."
+  (let ((tramp-tolerate-tilde
+        (or tramp-tolerate-tilde
+            (equal (file-remote-p default-directory 'method)
+                   tramp-adb-method))))
+    (funcall orig-fun)))
+
+(add-function
+ :around  (symbol-function #'shell-mode) #'tramp-adb-tolerate-tilde)
+(add-hook 'tramp-adb-unload-hook
+         (lambda ()
+           (remove-function
+            (symbol-function #'shell-mode) #'tramp-adb-tolerate-tilde)))
+
 (add-hook 'tramp-unload-hook
          (lambda ()
            (unload-feature 'tramp-adb 'force)))
diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el
index d3634b0cc2..23290de685 100644
--- a/lisp/net/tramp-gvfs.el
+++ b/lisp/net/tramp-gvfs.el
@@ -1151,6 +1151,10 @@ file names."
                (replace-match
                 (tramp-get-connection-property v "default-location" "~")
                 nil t localname 1))))
+      ;; Tilde expansion is not possible.
+      (when (and (not tramp-tolerate-tilde)
+                (string-match-p "\\`\\(~[^/]*\\)\\(.*\\)\\'" localname))
+       (tramp-error v 'file-error "Cannot expand tilde in file `%s'" name))
       (unless (tramp-run-real-handler #'file-name-absolute-p (list localname))
        (setq localname (concat "/" localname)))
       ;; We do not pass "/..".
@@ -1168,7 +1172,7 @@ file names."
       ;; Do normal `expand-file-name' (this does "/./" and "/../"),
       ;; unless there are tilde characters in file name.
       (tramp-make-tramp-file-name
-       v (if (string-match-p "\\`~" localname)
+       v (if (string-match-p "\\`\\(~[^/]*\\)\\(.*\\)\\'" localname)
             localname
           (tramp-run-real-handler #'expand-file-name (list localname)))))))
 
diff --git a/lisp/net/tramp-sshfs.el b/lisp/net/tramp-sshfs.el
index 72837793de..664dbc31b1 100644
--- a/lisp/net/tramp-sshfs.el
+++ b/lisp/net/tramp-sshfs.el
@@ -55,7 +55,8 @@
                ;; These are for remote processes.
                 (tramp-login-program        "ssh")
                 (tramp-login-args           (("-q")("-l" "%u") ("-p" "%p")
-                                            ("-e" "none") ("%h") ("%l")))
+                                            ("-e" "none") ("-t" "-t")
+                                            ("%h") ("%l")))
                 (tramp-direct-async         t)
                 (tramp-remote-shell         ,tramp-default-remote-shell)
                 (tramp-remote-shell-login   ("-l"))
@@ -411,6 +412,24 @@ connection if a previous connection has died for some 
reason."
   (with-tramp-connection-property
       vec "gid-string" (tramp-get-local-gid 'string)))
 
+;; `shell-mode' tries to open remote files like "/sshfs:user@host:~/.history".
+;; This fails, because the tilde cannot be expanded.  Tell
+;; `tramp-handle-expand-file-name' to tolerate this.
+(defun tramp-sshfs-tolerate-tilde (orig-fun)
+  "Advice for `shell-mode' to tolerate tilde in remote file names."
+  (let ((tramp-tolerate-tilde
+        (or tramp-tolerate-tilde
+            (equal (file-remote-p default-directory 'method)
+                   tramp-sshfs-method))))
+    (funcall orig-fun)))
+
+(add-function
+ :around  (symbol-function #'shell-mode) #'tramp-sshfs-tolerate-tilde)
+(add-hook 'tramp-sshfs-unload-hook
+         (lambda ()
+           (remove-function
+            (symbol-function #'shell-mode) #'tramp-sshfs-tolerate-tilde)))
+
 (add-hook 'tramp-unload-hook
          (lambda ()
            (unload-feature 'tramp-sshfs 'force)))
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index f93ca7601a..32712efb3e 100644
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -3458,6 +3458,10 @@ User is always nil."
       (if (file-directory-p dir) dir (file-name-directory dir)) nil
     (tramp-flush-directory-properties v localname)))
 
+(defvar tramp-tolerate-tilde nil
+  "Indicator, that not expandable tilde shall be tolerated.
+Let-bind it when necessary.")
+
 (defun tramp-handle-expand-file-name (name &optional dir)
   "Like `expand-file-name' for Tramp files."
   ;; If DIR is not given, use DEFAULT-DIRECTORY or "/".
@@ -3475,7 +3479,8 @@ User is always nil."
       (unless (tramp-run-real-handler #'file-name-absolute-p (list localname))
        (setq localname (concat "/" localname)))
       ;; Tilde expansion is not possible.
-      (when (string-match-p "\\`\\(~[^/]*\\)\\(.*\\)\\'" localname)
+      (when (and (not tramp-tolerate-tilde)
+                (string-match-p "\\`\\(~[^/]*\\)\\(.*\\)\\'" localname))
        (tramp-error v 'file-error "Cannot expand tilde in file `%s'" name))
       ;; Do not keep "/..".
       (when (string-match-p "^/\\.\\.?$" localname)
@@ -3486,7 +3491,9 @@ User is always nil."
       (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))))))))
+           (if (string-match-p "\\`\\(~[^/]*\\)\\(.*\\)\\'" localname)
+               localname
+             (tramp-run-real-handler #'expand-file-name (list 
localname)))))))))
 
 (defun tramp-handle-file-accessible-directory-p (filename)
   "Like `file-accessible-directory-p' for Tramp files."