aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorMichael Albinus2017-05-28 23:44:10 +0200
committerMichael Albinus2017-05-28 23:44:10 +0200
commite7bb7cc29bc27b368a066c088943c93b1c689b23 (patch)
tree228e28975ce1c0202be9a0f160d5f827e87f5ce5
parent288b3ca2e519903653b9bc88d281ecd9f6b162a4 (diff)
downloademacs-e7bb7cc29bc27b368a066c088943c93b1c689b23.tar.gz
emacs-e7bb7cc29bc27b368a066c088943c93b1c689b23.zip
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.
-rw-r--r--lisp/net/tramp-adb.el35
-rw-r--r--lisp/net/tramp-cache.el13
-rw-r--r--lisp/net/tramp-gvfs.el4
-rw-r--r--lisp/net/tramp.el108
-rw-r--r--test/lisp/net/tramp-tests.el4
5 files changed, 95 insertions, 69 deletions
diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el
index e9a3d001341..23aa90186a6 100644
--- a/lisp/net/tramp-adb.el
+++ b/lisp/net/tramp-adb.el
@@ -200,9 +200,9 @@ pass to the OPERATION."
200 ;; That's why we use `start-process'. 200 ;; That's why we use `start-process'.
201 (let ((p (start-process 201 (let ((p (start-process
202 tramp-adb-program (current-buffer) tramp-adb-program "devices")) 202 tramp-adb-program (current-buffer) tramp-adb-program "devices"))
203 (v (tramp-make-tramp-file-name 203 (v (make-tramp-file-name
204 tramp-adb-method tramp-current-user nil 204 :method tramp-adb-method :user tramp-current-user
205 tramp-current-host nil nil nil)) 205 :host tramp-current-host))
206 result) 206 result)
207 (tramp-message v 6 "%s" (mapconcat 'identity (process-command p) " ")) 207 (tramp-message v 6 "%s" (mapconcat 'identity (process-command p) " "))
208 (process-put p 'adjust-window-size-function 'ignore) 208 (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\"
1069 (tramp-flush-connection-property nil) 1069 (tramp-flush-connection-property nil)
1070 (with-tramp-connection-property (tramp-get-connection-process vec) "device" 1070 (with-tramp-connection-property (tramp-get-connection-process vec) "device"
1071 (let* ((host (tramp-file-name-host vec)) 1071 (let* ((host (tramp-file-name-host vec))
1072 (port (tramp-file-name-port vec)) 1072 (port (tramp-file-name-port-or-default vec))
1073 (devices (mapcar 'cadr (tramp-adb-parse-device-names nil)))) 1073 (devices (mapcar 'cadr (tramp-adb-parse-device-names nil))))
1074 (replace-regexp-in-string 1074 (replace-regexp-in-string
1075 tramp-prefix-port-format ":" 1075 tramp-prefix-port-format ":"
@@ -1170,7 +1170,9 @@ FMT and ARGS are passed to `error'."
1170 (delete-process proc) 1170 (delete-process proc)
1171 (tramp-error proc 'file-error "Process `%s' not available, try again" proc)) 1171 (tramp-error proc 'file-error "Process `%s' not available, try again" proc))
1172 (with-current-buffer (process-buffer proc) 1172 (with-current-buffer (process-buffer proc)
1173 (if (tramp-wait-for-regexp proc timeout tramp-adb-prompt) 1173 (if (tramp-wait-for-regexp
1174 proc timeout
1175 (tramp-get-connection-property proc "prompt" tramp-adb-prompt))
1174 (let (buffer-read-only) 1176 (let (buffer-read-only)
1175 (goto-char (point-min)) 1177 (goto-char (point-min))
1176 ;; ADB terminal sends "^H" sequences. 1178 ;; ADB terminal sends "^H" sequences.
@@ -1179,20 +1181,25 @@ FMT and ARGS are passed to `error'."
1179 (delete-region (point-min) (point))) 1181 (delete-region (point-min) (point)))
1180 ;; Delete the prompt. 1182 ;; Delete the prompt.
1181 (goto-char (point-min)) 1183 (goto-char (point-min))
1182 (when (re-search-forward tramp-adb-prompt (point-at-eol) t) 1184 (when (re-search-forward
1185 (tramp-get-connection-property proc "prompt" tramp-adb-prompt)
1186 (point-at-eol) t)
1183 (forward-line 1) 1187 (forward-line 1)
1184 (delete-region (point-min) (point))) 1188 (delete-region (point-min) (point)))
1185 (goto-char (point-max)) 1189 (goto-char (point-max))
1186 (re-search-backward tramp-adb-prompt nil t) 1190 (re-search-backward
1191 (tramp-get-connection-property proc "prompt" tramp-adb-prompt) nil t)
1187 (delete-region (point) (point-max))) 1192 (delete-region (point) (point-max)))
1188 (if timeout 1193 (if timeout
1189 (tramp-error 1194 (tramp-error
1190 proc 'file-error 1195 proc 'file-error
1191 "[[Remote adb prompt `%s' not found in %d secs]]" 1196 "[[Remote adb prompt `%s' not found in %d secs]]"
1192 tramp-adb-prompt timeout) 1197 (tramp-get-connection-property proc "prompt" tramp-adb-prompt)
1198 timeout)
1193 (tramp-error 1199 (tramp-error
1194 proc 'file-error 1200 proc 'file-error
1195 "[[Remote prompt `%s' not found]]" tramp-adb-prompt))))) 1201 "[[Remote prompt `%s' not found]]"
1202 (tramp-get-connection-property proc "prompt" tramp-adb-prompt))))))
1196 1203
1197(defun tramp-adb-maybe-open-connection (vec) 1204(defun tramp-adb-maybe-open-connection (vec)
1198 "Maybe open a connection VEC. 1205 "Maybe open a connection VEC.
@@ -1228,7 +1235,9 @@ connection if a previous connection has died for some reason."
1228 (p (let ((default-directory 1235 (p (let ((default-directory
1229 (tramp-compat-temporary-file-directory))) 1236 (tramp-compat-temporary-file-directory)))
1230 (apply 'start-process (tramp-get-connection-name vec) buf 1237 (apply 'start-process (tramp-get-connection-name vec) buf
1231 tramp-adb-program args)))) 1238 tramp-adb-program args)))
1239 (prompt (md5 (concat (prin1-to-string process-environment)
1240 (current-time-string)))))
1232 (tramp-message 1241 (tramp-message
1233 vec 6 "%s" (mapconcat 'identity (process-command p) " ")) 1242 vec 6 "%s" (mapconcat 'identity (process-command p) " "))
1234 ;; Wait for initial prompt. 1243 ;; Wait for initial prompt.
@@ -1239,6 +1248,12 @@ connection if a previous connection has died for some reason."
1239 (process-put p 'adjust-window-size-function 'ignore) 1248 (process-put p 'adjust-window-size-function 'ignore)
1240 (set-process-query-on-exit-flag p nil) 1249 (set-process-query-on-exit-flag p nil)
1241 1250
1251 ;; Change prompt.
1252 (tramp-set-connection-property
1253 p "prompt" (regexp-quote (format "///%s#$" prompt)))
1254 (tramp-adb-send-command
1255 vec (format "PS1=\"///\"\"%s\"\"#$\"" prompt))
1256
1242 ;; Check whether the properties have been changed. If 1257 ;; Check whether the properties have been changed. If
1243 ;; yes, this is a strong indication that we must expire all 1258 ;; yes, this is a strong indication that we must expire all
1244 ;; connection properties. We start again. 1259 ;; connection properties. We start again.
diff --git a/lisp/net/tramp-cache.el b/lisp/net/tramp-cache.el
index a863860abf1..415cde2fc8a 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."
326 ;; (substring-no-properties 326 ;; (substring-no-properties
327 ;; (cl-struct-slot-value 'tramp-file-name slot key)))))) 327 ;; (cl-struct-slot-value 'tramp-file-name slot key))))))
328 (dotimes (i (length key)) 328 (dotimes (i (length key))
329 (when (stringp (aref key i)) 329 (when (stringp (elt key i))
330 (aset key i (substring-no-properties (aref key i)))))) 330 (setf (elt key i) (substring-no-properties (elt key i))))))
331 (when (stringp key) 331 (when (stringp key)
332 (setq key (substring-no-properties key))) 332 (setq key (substring-no-properties key)))
333 (when (stringp value) 333 (when (stringp value)
@@ -373,12 +373,15 @@ used to cache connection properties of the local machine."
373 ;; Remove temporary data. If there is the key "login-as", we 373 ;; Remove temporary data. If there is the key "login-as", we
374 ;; don't save either, because all other properties might 374 ;; don't save either, because all other properties might
375 ;; depend on the login name, and we want to give the 375 ;; depend on the login name, and we want to give the
376 ;; possibility to use another login name later on. 376 ;; possibility to use another login name later on. Key
377 ;; "started" exists for the "ftp" method only, which must be
378 ;; be kept persistent.
377 (maphash 379 (maphash
378 (lambda (key value) 380 (lambda (key value)
379 (if (and (tramp-file-name-p key) 381 (if (and (tramp-file-name-p key) value
380 (not (tramp-file-name-localname key)) 382 (not (tramp-file-name-localname key))
381 (not (gethash "login-as" value))) 383 (not (gethash "login-as" value))
384 (not (gethash "started" value)))
382 (progn 385 (progn
383 (remhash "process-name" value) 386 (remhash "process-name" value)
384 (remhash "process-buffer" value) 387 (remhash "process-buffer" value)
diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el
index c016c7e0274..d031c73c3f7 100644
--- a/lisp/net/tramp-gvfs.el
+++ b/lisp/net/tramp-gvfs.el
@@ -788,7 +788,9 @@ file names."
788 (when (string-match "\\`\\(~\\)\\(/\\|\\'\\)" localname) 788 (when (string-match "\\`\\(~\\)\\(/\\|\\'\\)" localname)
789 (save-match-data 789 (save-match-data
790 (tramp-gvfs-maybe-open-connection 790 (tramp-gvfs-maybe-open-connection
791 (tramp-make-tramp-file-name method user domain host port "/" hop))) 791 (make-tramp-file-name
792 :method method :user user :domain domain
793 :host host :port port :localname "/" :hop hop)))
792 (setq localname 794 (setq localname
793 (replace-match 795 (replace-match
794 (tramp-get-connection-property v "default-location" "~") 796 (tramp-get-connection-property v "default-location" "~")
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index e75305b637f..05d197fce08 100644
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -857,8 +857,9 @@ Derived from `tramp-postfix-host-format'."
857 "\\(" (tramp-method-regexp) "\\)" (tramp-postfix-method-regexp) 857 "\\(" (tramp-method-regexp) "\\)" (tramp-postfix-method-regexp)
858 "\\(?:" "\\(" tramp-user-regexp "\\)" tramp-postfix-user-regexp "\\)?" 858 "\\(?:" "\\(" tramp-user-regexp "\\)" tramp-postfix-user-regexp "\\)?"
859 "\\(" "\\(?:" tramp-host-regexp "\\|" 859 "\\(" "\\(?:" tramp-host-regexp "\\|"
860 (tramp-prefix-ipv6-regexp) "\\(?:" tramp-ipv6-regexp "\\)?" 860 (tramp-prefix-ipv6-regexp)
861 (tramp-postfix-ipv6-regexp) "\\)" 861 "\\(?:" tramp-ipv6-regexp "\\)?"
862 (tramp-postfix-ipv6-regexp) "\\)?"
862 "\\(?:" tramp-prefix-port-regexp tramp-port-regexp "\\)?" "\\)?")) 863 "\\(?:" tramp-prefix-port-regexp tramp-port-regexp "\\)?" "\\)?"))
863 864
864(defun tramp-file-name-structure () 865(defun tramp-file-name-structure ()
@@ -1135,7 +1136,7 @@ calling HANDLER.")
1135;; data structure. 1136;; data structure.
1136 1137
1137;; The basic structure for remote file names. We use a list :type, 1138;; The basic structure for remote file names. We use a list :type,
1138;; otherwise the persistent data are not read in tramp-cache.el. 1139;; in order to be compatible with Emacs 24 and 25.
1139(cl-defstruct (tramp-file-name (:type list) :named) 1140(cl-defstruct (tramp-file-name (:type list) :named)
1140 method user domain host port localname hop) 1141 method user domain host port localname hop)
1141 1142
@@ -1155,6 +1156,12 @@ calling HANDLER.")
1155 tramp-prefix-port-format) 1156 tramp-prefix-port-format)
1156 (tramp-file-name-port vec)))) 1157 (tramp-file-name-port vec))))
1157 1158
1159(defun tramp-file-name-port-or-default (vec)
1160 "Return port component of VEC.
1161If nil, return `tramp-default-port'."
1162 (or (tramp-file-name-port vec)
1163 (tramp-get-method-parameter vec 'tramp-default-port)))
1164
1158(defun tramp-file-name-equal-p (vec1 vec2) 1165(defun tramp-file-name-equal-p (vec1 vec2)
1159 "Check, whether VEC1 and VEC2 denote the same `tramp-file-name'." 1166 "Check, whether VEC1 and VEC2 denote the same `tramp-file-name'."
1160 (and (tramp-file-name-p vec1) (tramp-file-name-p vec2) 1167 (and (tramp-file-name-p vec1) (tramp-file-name-p vec2)
@@ -1294,16 +1301,9 @@ values."
1294 user (tramp-find-user method user host) 1301 user (tramp-find-user method user host)
1295 host (tramp-find-host method user host))) 1302 host (tramp-find-host method user host)))
1296 1303
1297 (apply 1304 (make-tramp-file-name
1298 'make-tramp-file-name 1305 :method method :user user :domain domain :host host :port port
1299 (append 1306 :localname (or localname "") :hop hop)))))
1300 (unless (zerop (length method)) `(:method ,method))
1301 (unless (zerop (length user)) `(:user ,user))
1302 (unless (zerop (length domain)) `(:domain ,domain))
1303 (unless (zerop (length host)) `(:host ,host))
1304 (unless (zerop (length port)) `(:port ,port))
1305 `(:localname ,(or localname ""))
1306 (unless (zerop (length hop)) `(:hop ,hop))))))))
1307 1307
1308(defun tramp-buffer-name (vec) 1308(defun tramp-buffer-name (vec)
1309 "A name for the connection buffer VEC." 1309 "A name for the connection buffer VEC."
@@ -2878,38 +2878,42 @@ User is always nil."
2878 ;; There isn't. So we must check, in case there's a connection already. 2878 ;; There isn't. So we must check, in case there's a connection already.
2879 (and (tramp-connectable-p filename) 2879 (and (tramp-connectable-p filename)
2880 (with-tramp-connection-property v "case-insensitive" 2880 (with-tramp-connection-property v "case-insensitive"
2881 ;; The idea is to compare a file with lower case letters 2881 (with-tramp-progress-reporter v 5 "Checking case-insensitive"
2882 ;; with the same file with upper case letters. 2882 ;; The idea is to compare a file with lower case letters
2883 (let ((candidate 2883 ;; with the same file with upper case letters.
2884 (tramp-compat-file-name-unquote 2884 (let ((candidate
2885 (directory-file-name filename))) 2885 (tramp-compat-file-name-unquote
2886 tmpfile) 2886 (directory-file-name filename)))
2887 ;; Check, whether we find an existing file with lower case 2887 tmpfile)
2888 ;; letters. This avoids us to create a temporary file. 2888 ;; Check, whether we find an existing file with lower
2889 (while (and (string-match 2889 ;; case letters. This avoids us to create a temporary
2890 "[a-z]" (file-remote-p candidate 'localname)) 2890 ;; file.
2891 (not (file-exists-p candidate))) 2891 (while (and (string-match
2892 (setq candidate 2892 "[a-z]" (file-remote-p candidate 'localname))
2893 (directory-file-name (file-name-directory candidate)))) 2893 (not (file-exists-p candidate)))
2894 ;; Nothing found, so we must use a temporary file for 2894 (setq candidate
2895 ;; comparison. `make-nearby-temp-file' is added to 2895 (directory-file-name (file-name-directory candidate))))
2896 ;; Emacs 26+ like `file-name-case-insensitive-p', so 2896 ;; Nothing found, so we must use a temporary file for
2897 ;; there is no compatibility problem calling it. 2897 ;; comparison. `make-nearby-temp-file' is added to
2898 (unless 2898 ;; Emacs 26+ like `file-name-case-insensitive-p', so
2899 (string-match "[a-z]" (file-remote-p candidate 'localname)) 2899 ;; there is no compatibility problem calling it.
2900 (setq tmpfile 2900 (unless
2901 (let ((default-directory (file-name-directory filename))) 2901 (string-match "[a-z]" (file-remote-p candidate 'localname))
2902 (tramp-compat-funcall 'make-nearby-temp-file "tramp.")) 2902 (setq tmpfile
2903 candidate tmpfile)) 2903 (let ((default-directory
2904 ;; Check for the existence of the same file with upper 2904 (file-name-directory filename)))
2905 ;; case letters. 2905 (tramp-compat-funcall
2906 (unwind-protect 2906 'make-nearby-temp-file "tramp."))
2907 (file-exists-p 2907 candidate tmpfile))
2908 (concat 2908 ;; Check for the existence of the same file with upper
2909 (file-remote-p candidate) 2909 ;; case letters.
2910 (upcase (file-remote-p candidate 'localname)))) 2910 (unwind-protect
2911 ;; Cleanup. 2911 (file-exists-p
2912 (when tmpfile (delete-file tmpfile))))))))) 2912 (concat
2913 (file-remote-p candidate)
2914 (upcase (file-remote-p candidate 'localname))))
2915 ;; Cleanup.
2916 (when tmpfile (delete-file tmpfile))))))))))
2913 2917
2914(defun tramp-handle-file-name-completion 2918(defun tramp-handle-file-name-completion
2915 (filename directory &optional predicate) 2919 (filename directory &optional predicate)
@@ -4131,9 +4135,10 @@ PROGRAM is nil is trapped also, returning 1. Furthermore, traces
4131are written with verbosity of 6." 4135are written with verbosity of 6."
4132 (let ((default-directory (tramp-compat-temporary-file-directory)) 4136 (let ((default-directory (tramp-compat-temporary-file-directory))
4133 (v (or vec 4137 (v (or vec
4134 (tramp-make-tramp-file-name 4138 (make-tramp-file-name
4135 tramp-current-method tramp-current-user tramp-current-domain 4139 :method tramp-current-method :user tramp-current-user
4136 tramp-current-host tramp-current-port nil nil))) 4140 :domain tramp-current-domain :host tramp-current-host
4141 :port tramp-current-port)))
4137 (destination (if (eq destination t) (current-buffer) destination)) 4142 (destination (if (eq destination t) (current-buffer) destination))
4138 output error result) 4143 output error result)
4139 (tramp-message 4144 (tramp-message
@@ -4167,9 +4172,10 @@ PROGRAM is nil is trapped also, returning 1. Furthermore, traces
4167are written with verbosity of 6." 4172are written with verbosity of 6."
4168 (let ((default-directory (tramp-compat-temporary-file-directory)) 4173 (let ((default-directory (tramp-compat-temporary-file-directory))
4169 (v (or vec 4174 (v (or vec
4170 (tramp-make-tramp-file-name 4175 (make-tramp-file-name
4171 tramp-current-method tramp-current-user tramp-current-domain 4176 :method tramp-current-method :user tramp-current-user
4172 tramp-current-host tramp-current-port nil nil))) 4177 :domain tramp-current-domain :host tramp-current-host
4178 :port tramp-current-port)))
4173 (buffer (if (eq buffer t) (current-buffer) buffer)) 4179 (buffer (if (eq buffer t) (current-buffer) buffer))
4174 result) 4180 result)
4175 (tramp-message 4181 (tramp-message
diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el
index 7a12aae1bf2..8c97fafa3e6 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."
1510(ert-deftest tramp-test03-file-name-defaults () 1510(ert-deftest tramp-test03-file-name-defaults ()
1511 "Check default values for some methods." 1511 "Check default values for some methods."
1512 ;; Default values in tramp-adb.el. 1512 ;; Default values in tramp-adb.el.
1513 (should (string-equal (file-remote-p "/adb::" 'host) nil)) 1513 (should (string-equal (file-remote-p "/adb::" 'host) ""))
1514 ;; Default values in tramp-ftp.el. 1514 ;; Default values in tramp-ftp.el.
1515 (should (string-equal (file-remote-p "/-:ftp.host:" 'method) "ftp")) 1515 (should (string-equal (file-remote-p "/-:ftp.host:" 'method) "ftp"))
1516 (dolist (u '("ftp" "anonymous")) 1516 (dolist (u '("ftp" "anonymous"))
@@ -1626,7 +1626,7 @@ handled properly. BODY shall not contain a timeout."
1626 :expected-result :failed 1626 :expected-result :failed
1627 (skip-unless (tramp--test-enabled)) 1627 (skip-unless (tramp--test-enabled))
1628 ;; File names with a share behave differently. 1628 ;; File names with a share behave differently.
1629 (when (tramp--test-afp-or-smb-p) 1629 (when (or (tramp--test-adb-p) (tramp--test-afp-or-smb-p))
1630 (setf (ert-test-expected-result-type 1630 (setf (ert-test-expected-result-type
1631 (ert-get-test 'tramp-test05-expand-file-name-relative)) 1631 (ert-get-test 'tramp-test05-expand-file-name-relative))
1632 :passed)) 1632 :passed))