[Emacs-diffs] master e7bb7cc: Some tweaks, almost all for Tramp adb method

[Michael Albinus]

branch: master
commit e7bb7cc29bc27b368a066c088943c93b1c689b23
Author: Michael Albinus <address@hidden>
Commit: Michael Albinus <address@hidden>

    Some tweaks, almost all for Tramp adb method
    
    * lisp/net/tramp-adb.el (tramp-adb-parse-device-names):
    Use `make-tramp-file-name'.
    (tramp-adb-get-device): Use `tramp-file-name-port-or-default'.
    (tramp-adb-maybe-open-connection): Set "prompt" property.
    (tramp-adb-wait-for-output): Use it.
    
    * lisp/net/tramp-cache.el (tramp-cache-print): Use `elt'.
    (tramp-dump-connection-properties): Check also that there are
    properties to be saved.  Don't save "started" property of
    "ftp" method.
    
    * lisp/net/tramp-gvfs.el (tramp-gvfs-handle-expand-file-name):
    Use `make-tramp-file-name'.
    
    * lisp/net/tramp.el (tramp-remote-file-name-spec-regexp):
    Host could be empty.
    (tramp-file-name-port-or-default): New defun.
    (tramp-dissect-file-name): Simplify `make-tramp-file-name' call.
    (tramp-handle-file-name-case-insensitive-p): Use a progress reporter.
    (tramp-call-process, tramp-call-process-region):
    Use `make-tramp-file-name'.
    
    * test/lisp/net/tramp-tests.el (tramp-test03-file-name-defaults):
    Revert change from 2017-05-24.
    (tramp-test05-expand-file-name-relative): Let it also pass for
    "adb" method.
---
 lisp/net/tramp-adb.el        |  35 ++++++++++----
 lisp/net/tramp-cache.el      |  13 ++++--
 lisp/net/tramp-gvfs.el       |   4 +-
 lisp/net/tramp.el            | 108 +++++++++++++++++++++++--------------------
 test/lisp/net/tramp-tests.el |   4 +-
 5 files changed, 95 insertions(+), 69 deletions(-)

diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el
index e9a3d00..23aa901 100644
--- a/lisp/net/tramp-adb.el
+++ b/lisp/net/tramp-adb.el
@@ -200,9 +200,9 @@ pass to the OPERATION."
       ;; That's why we use `start-process'.
       (let ((p (start-process
                tramp-adb-program (current-buffer) tramp-adb-program "devices"))
-           (v (tramp-make-tramp-file-name
-               tramp-adb-method tramp-current-user nil
-               tramp-current-host nil nil nil))
+           (v (make-tramp-file-name
+               :method tramp-adb-method :user tramp-current-user
+               :host tramp-current-host))
            result)
        (tramp-message v 6 "%s" (mapconcat 'identity (process-command p) " "))
        (process-put p 'adjust-window-size-function 'ignore)
@@ -1069,7 +1069,7 @@ E.g. a host name \"192.168.1.1#5555\" returns 
\"192.168.1.1:5555\"
   (tramp-flush-connection-property nil)
   (with-tramp-connection-property (tramp-get-connection-process vec) "device"
     (let* ((host (tramp-file-name-host vec))
-          (port (tramp-file-name-port vec))
+          (port (tramp-file-name-port-or-default vec))
           (devices (mapcar 'cadr (tramp-adb-parse-device-names nil))))
       (replace-regexp-in-string
        tramp-prefix-port-format ":"
@@ -1170,7 +1170,9 @@ FMT and ARGS are passed to `error'."
     (delete-process proc)
     (tramp-error proc 'file-error "Process `%s' not available, try again" 
proc))
   (with-current-buffer (process-buffer proc)
-    (if (tramp-wait-for-regexp proc timeout tramp-adb-prompt)
+    (if (tramp-wait-for-regexp
+        proc timeout
+        (tramp-get-connection-property proc "prompt" tramp-adb-prompt))
        (let (buffer-read-only)
          (goto-char (point-min))
          ;; ADB terminal sends "^H" sequences.
@@ -1179,20 +1181,25 @@ FMT and ARGS are passed to `error'."
            (delete-region (point-min) (point)))
          ;; Delete the prompt.
          (goto-char (point-min))
-         (when (re-search-forward tramp-adb-prompt (point-at-eol) t)
+         (when (re-search-forward
+               (tramp-get-connection-property proc "prompt" tramp-adb-prompt)
+               (point-at-eol) t)
            (forward-line 1)
            (delete-region (point-min) (point)))
          (goto-char (point-max))
-         (re-search-backward tramp-adb-prompt nil t)
+         (re-search-backward
+          (tramp-get-connection-property proc "prompt" tramp-adb-prompt) nil t)
          (delete-region (point) (point-max)))
       (if timeout
          (tramp-error
           proc 'file-error
           "[[Remote adb prompt `%s' not found in %d secs]]"
-          tramp-adb-prompt timeout)
+          (tramp-get-connection-property proc "prompt" tramp-adb-prompt)
+          timeout)
        (tramp-error
         proc 'file-error
-        "[[Remote prompt `%s' not found]]" tramp-adb-prompt)))))
+        "[[Remote prompt `%s' not found]]"
+        (tramp-get-connection-property proc "prompt" tramp-adb-prompt))))))
 
 (defun tramp-adb-maybe-open-connection (vec)
   "Maybe open a connection VEC.
@@ -1228,7 +1235,9 @@ connection if a previous connection has died for some 
reason."
                 (p (let ((default-directory
                            (tramp-compat-temporary-file-directory)))
                      (apply 'start-process (tramp-get-connection-name vec) buf
-                            tramp-adb-program args))))
+                            tramp-adb-program args)))
+                (prompt (md5 (concat (prin1-to-string process-environment)
+                                     (current-time-string)))))
            (tramp-message
             vec 6 "%s" (mapconcat 'identity (process-command p) " "))
            ;; Wait for initial prompt.
@@ -1239,6 +1248,12 @@ connection if a previous connection has died for some 
reason."
            (process-put p 'adjust-window-size-function 'ignore)
            (set-process-query-on-exit-flag p nil)
 
+           ;; Change prompt.
+           (tramp-set-connection-property
+            p "prompt" (regexp-quote (format "///%s#$" prompt)))
+           (tramp-adb-send-command
+            vec (format "PS1=\"///\"\"%s\"\"#$\"" prompt))
+
            ;; Check whether the properties have been changed.  If
            ;; yes, this is a strong indication that we must expire all
            ;; connection properties.  We start again.
diff --git a/lisp/net/tramp-cache.el b/lisp/net/tramp-cache.el
index a863860..415cde2 100644
--- a/lisp/net/tramp-cache.el
+++ b/lisp/net/tramp-cache.el
@@ -326,8 +326,8 @@ used to cache connection properties of the local machine."
           ;;        (substring-no-properties
           ;;         (cl-struct-slot-value 'tramp-file-name slot key))))))
           (dotimes (i (length key))
-            (when (stringp (aref key i))
-              (aset key i (substring-no-properties (aref key i))))))
+            (when (stringp (elt key i))
+              (setf (elt key i) (substring-no-properties (elt key i))))))
         (when (stringp key)
           (setq key (substring-no-properties key)))
         (when (stringp value)
@@ -373,12 +373,15 @@ used to cache connection properties of the local machine."
        ;; Remove temporary data.  If there is the key "login-as", we
        ;; don't save either, because all other properties might
        ;; depend on the login name, and we want to give the
-       ;; possibility to use another login name later on.
+       ;; possibility to use another login name later on.  Key
+       ;; "started" exists for the "ftp" method only, which must be
+       ;; be kept persistent.
        (maphash
         (lambda (key value)
-          (if (and (tramp-file-name-p key)
+          (if (and (tramp-file-name-p key) value
                    (not (tramp-file-name-localname key))
-                   (not (gethash "login-as" value)))
+                   (not (gethash "login-as" value))
+                   (not (gethash "started" value)))
               (progn
                 (remhash "process-name" value)
                 (remhash "process-buffer" value)
diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el
index c016c7e..d031c73 100644
--- a/lisp/net/tramp-gvfs.el
+++ b/lisp/net/tramp-gvfs.el
@@ -788,7 +788,9 @@ file names."
       (when (string-match "\\`\\(~\\)\\(/\\|\\'\\)" localname)
        (save-match-data
          (tramp-gvfs-maybe-open-connection
-          (tramp-make-tramp-file-name method user domain host port "/" hop)))
+          (make-tramp-file-name
+           :method method :user user :domain domain
+           :host host :port port :localname "/" :hop hop)))
        (setq localname
              (replace-match
               (tramp-get-connection-property v "default-location" "~")
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index e75305b..05d197f 100644
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -857,8 +857,9 @@ Derived from `tramp-postfix-host-format'."
            "\\("   (tramp-method-regexp) "\\)" (tramp-postfix-method-regexp)
    "\\(?:" "\\("   tramp-user-regexp     "\\)" tramp-postfix-user-regexp "\\)?"
    "\\("   "\\(?:" tramp-host-regexp     "\\|"
-                  (tramp-prefix-ipv6-regexp)  "\\(?:" tramp-ipv6-regexp "\\)?"
-                                               (tramp-postfix-ipv6-regexp) 
"\\)"
+                  (tramp-prefix-ipv6-regexp)
+                  "\\(?:" tramp-ipv6-regexp "\\)?"
+                   (tramp-postfix-ipv6-regexp) "\\)?"
           "\\(?:" tramp-prefix-port-regexp    tramp-port-regexp "\\)?" "\\)?"))
 
 (defun tramp-file-name-structure ()
@@ -1135,7 +1136,7 @@ calling HANDLER.")
 ;; data structure.
 
 ;; The basic structure for remote file names.  We use a list :type,
-;; otherwise the persistent data are not read in tramp-cache.el.
+;; in order to be compatible with Emacs 24 and 25.
 (cl-defstruct (tramp-file-name (:type list) :named)
   method user domain host port localname hop)
 
@@ -1155,6 +1156,12 @@ calling HANDLER.")
                 tramp-prefix-port-format)
            (tramp-file-name-port vec))))
 
+(defun tramp-file-name-port-or-default (vec)
+  "Return port component of VEC.
+If nil, return `tramp-default-port'."
+  (or (tramp-file-name-port vec)
+      (tramp-get-method-parameter vec 'tramp-default-port)))
+
 (defun tramp-file-name-equal-p (vec1 vec2)
   "Check, whether VEC1 and VEC2 denote the same `tramp-file-name'."
   (and (tramp-file-name-p vec1) (tramp-file-name-p vec2)
@@ -1294,16 +1301,9 @@ values."
                user (tramp-find-user method user host)
                host (tramp-find-host method user host)))
 
-       (apply
-        'make-tramp-file-name
-        (append
-         (unless (zerop (length method)) `(:method ,method))
-         (unless (zerop (length user))   `(:user ,user))
-         (unless (zerop (length domain)) `(:domain ,domain))
-         (unless (zerop (length host))   `(:host ,host))
-         (unless (zerop (length port))   `(:port ,port))
-         `(:localname ,(or localname ""))
-         (unless (zerop (length hop))     `(:hop ,hop))))))))
+       (make-tramp-file-name
+        :method method :user user :domain domain :host host :port port
+        :localname (or localname "") :hop hop)))))
 
 (defun tramp-buffer-name (vec)
   "A name for the connection buffer VEC."
@@ -2878,38 +2878,42 @@ User is always nil."
      ;; There isn't. So we must check, in case there's a connection already.
      (and (tramp-connectable-p filename)
           (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
-                  (tramp-compat-file-name-unquote
-                   (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
-              ;; comparison.  `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)))))))))
+           (with-tramp-progress-reporter v 5 "Checking case-insensitive"
+              ;; The idea is to compare a file with lower case letters
+              ;; with the same file with upper case letters.
+              (let ((candidate
+                    (tramp-compat-file-name-unquote
+                     (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
+               ;; comparison.  `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)
@@ -4131,9 +4135,10 @@ PROGRAM is nil is trapped also, returning 1.  
Furthermore, traces
 are written with verbosity of 6."
   (let ((default-directory  (tramp-compat-temporary-file-directory))
        (v (or vec
-              (tramp-make-tramp-file-name
-               tramp-current-method tramp-current-user tramp-current-domain
-               tramp-current-host tramp-current-port nil nil)))
+              (make-tramp-file-name
+               :method tramp-current-method :user tramp-current-user
+               :domain tramp-current-domain :host tramp-current-host
+               :port tramp-current-port)))
        (destination (if (eq destination t) (current-buffer) destination))
        output error result)
     (tramp-message
@@ -4167,9 +4172,10 @@ PROGRAM is nil is trapped also, returning 1.  
Furthermore, traces
 are written with verbosity of 6."
   (let ((default-directory  (tramp-compat-temporary-file-directory))
        (v (or vec
-              (tramp-make-tramp-file-name
-               tramp-current-method tramp-current-user tramp-current-domain
-               tramp-current-host tramp-current-port nil nil)))
+              (make-tramp-file-name
+               :method tramp-current-method :user tramp-current-user
+               :domain tramp-current-domain :host tramp-current-host
+               :port tramp-current-port)))
        (buffer (if (eq buffer t) (current-buffer) buffer))
        result)
     (tramp-message
diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el
index 7a12aae..8c97faf 100644
--- a/test/lisp/net/tramp-tests.el
+++ b/test/lisp/net/tramp-tests.el
@@ -1510,7 +1510,7 @@ handled properly.  BODY shall not contain a timeout."
 (ert-deftest tramp-test03-file-name-defaults ()
   "Check default values for some methods."
   ;; Default values in tramp-adb.el.
-  (should (string-equal (file-remote-p "/adb::" 'host) nil))
+  (should (string-equal (file-remote-p "/adb::" 'host) ""))
   ;; Default values in tramp-ftp.el.
   (should (string-equal (file-remote-p "/-:ftp.host:" 'method) "ftp"))
   (dolist (u '("ftp" "anonymous"))
@@ -1626,7 +1626,7 @@ handled properly.  BODY shall not contain a timeout."
   :expected-result :failed
   (skip-unless (tramp--test-enabled))
   ;; File names with a share behave differently.
-  (when (tramp--test-afp-or-smb-p)
+  (when (or (tramp--test-adb-p) (tramp--test-afp-or-smb-p))
     (setf (ert-test-expected-result-type
           (ert-get-test 'tramp-test05-expand-file-name-relative))
          :passed))