diff options
| author | Michael Albinus | 2018-12-07 17:21:03 +0100 |
|---|---|---|
| committer | Michael Albinus | 2018-12-07 17:21:03 +0100 |
| commit | 294b2c2bb71f1f7e7024a854d4a4ae43785d9594 (patch) | |
| tree | e3b6aa389cc0000bfcdedf16ecb1918ae7fc5780 | |
| parent | e4a8f6ebbf4e8cf4d87d5b7b9940b61b51073fd3 (diff) | |
| download | emacs-294b2c2bb71f1f7e7024a854d4a4ae43785d9594.tar.gz emacs-294b2c2bb71f1f7e7024a854d4a4ae43785d9594.zip | |
Refactor some Tramp functions
* lisp/net/tramp-compat.el (tramp-compat-file-local-name): New defsubst.
(tramp-compat-file-name-quoted-p, tramp-compat-file-name-quote)
(tramp-compat-file-name-unquote):
* lisp/net/tramp.el (tramp-handle-file-name-case-insensitive-p)
(tramp-handle-file-truename, tramp-get-remote-tmpdir):
* lisp/net/tramp-adb.el (tramp-adb-handle-copy-file)
(tramp-adb-handle-rename-file, tramp-adb-handle-exec-path):
* lisp/net/tramp-sh.el (tramp-do-copy-or-rename-file-directly)
(tramp-sh-handle-exec-path, tramp-find-inline-encoding)
(tramp-get-remote-touch): Use it.
* lisp/net/tramp-adb.el (tramp-adb-file-name-handler-alist):
Use `tramp-handle-expand-file-name'.
(tramp-adb-handle-expand-file-name): Move to tramp.el.
(tramp-adb-handle-file-writable-p): Adapt docstring.
* lisp/net/tramp-gvfs.el (tramp-gvfs-file-name-handler-alist):
Use `tramp-handle-file-local-copy', `tramp-handle-file-writable-p'
and `tramp-handle-write-region'.
(tramp-gvfs-handle-file-local-copy)
(tramp-gvfs-handle-file-writable-p)
(tramp-gvfs-handle-write-region): Move to tramp.el.
* lisp/net/tramp-rclone.el: Dont't require `tramp-adb' and
`tramp-gvfs' anymore.
(tramp-rclone-file-name-handler-alist):
Use `tramp-handle-expand-file-name', `tramp-handle-file-local-copy',
`tramp-handle-file-writable-p' and `tramp-handle-write-region'.
(tramp-rclone-handle-directory-files): Simplify.
* lisp/net/tramp.el (tramp-methods): Extend docstring.
(tramp-parse-netrc): Require `netrc'.
(tramp-handle-expand-file-name, tramp-handle-file-local-copy)
(tramp-handle-file-writable-p, tramp-handle-write-region): New defuns.
| -rw-r--r-- | lisp/net/tramp-adb.el | 36 | ||||
| -rw-r--r-- | lisp/net/tramp-compat.el | 18 | ||||
| -rw-r--r-- | lisp/net/tramp-gvfs.el | 69 | ||||
| -rw-r--r-- | lisp/net/tramp-rclone.el | 32 | ||||
| -rw-r--r-- | lisp/net/tramp-sh.el | 11 | ||||
| -rw-r--r-- | lisp/net/tramp.el | 130 | ||||
| -rw-r--r-- | lisp/net/zeroconf.el | 33 |
7 files changed, 183 insertions, 146 deletions
diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el index 76bcdf09419..7906ec9f7cf 100644 --- a/lisp/net/tramp-adb.el +++ b/lisp/net/tramp-adb.el | |||
| @@ -108,7 +108,7 @@ It is used for TCP/IP devices." | |||
| 108 | (dired-compress-file . ignore) | 108 | (dired-compress-file . ignore) |
| 109 | (dired-uncache . tramp-handle-dired-uncache) | 109 | (dired-uncache . tramp-handle-dired-uncache) |
| 110 | (exec-path . tramp-adb-handle-exec-path) | 110 | (exec-path . tramp-adb-handle-exec-path) |
| 111 | (expand-file-name . tramp-adb-handle-expand-file-name) | 111 | (expand-file-name . tramp-handle-expand-file-name) |
| 112 | (file-accessible-directory-p . tramp-handle-file-accessible-directory-p) | 112 | (file-accessible-directory-p . tramp-handle-file-accessible-directory-p) |
| 113 | (file-acl . ignore) | 113 | (file-acl . ignore) |
| 114 | (file-attributes . tramp-adb-handle-file-attributes) | 114 | (file-attributes . tramp-adb-handle-file-attributes) |
| @@ -226,28 +226,6 @@ pass to the OPERATION." | |||
| 226 | result) | 226 | result) |
| 227 | result)))) | 227 | result)))) |
| 228 | 228 | ||
| 229 | (defun tramp-adb-handle-expand-file-name (name &optional dir) | ||
| 230 | "Like `expand-file-name' for Tramp files." | ||
| 231 | ;; If DIR is not given, use DEFAULT-DIRECTORY or "/". | ||
| 232 | (setq dir (or dir default-directory "/")) | ||
| 233 | ;; Unless NAME is absolute, concat DIR and NAME. | ||
| 234 | (unless (file-name-absolute-p name) | ||
| 235 | (setq name (concat (file-name-as-directory dir) name))) | ||
| 236 | ;; If NAME is not a Tramp file, run the real handler. | ||
| 237 | (if (not (tramp-tramp-file-p name)) | ||
| 238 | (tramp-run-real-handler 'expand-file-name (list name nil)) | ||
| 239 | ;; Dissect NAME. | ||
| 240 | (with-parsed-tramp-file-name name nil | ||
| 241 | (unless (tramp-run-real-handler 'file-name-absolute-p (list localname)) | ||
| 242 | (setq localname (concat "/" localname))) | ||
| 243 | ;; Do normal `expand-file-name' (this does "/./" and "/../"). | ||
| 244 | ;; `default-directory' is bound, because on Windows there would | ||
| 245 | ;; be problems with UNC shares or Cygwin mounts. | ||
| 246 | (let ((default-directory (tramp-compat-temporary-file-directory))) | ||
| 247 | (tramp-make-tramp-file-name | ||
| 248 | v (tramp-drop-volume-letter | ||
| 249 | (tramp-run-real-handler 'expand-file-name (list localname)))))))) | ||
| 250 | |||
| 251 | (defun tramp-adb-handle-file-system-info (filename) | 229 | (defun tramp-adb-handle-file-system-info (filename) |
| 252 | "Like `file-system-info' for Tramp files." | 230 | "Like `file-system-info' for Tramp files." |
| 253 | (ignore-errors | 231 | (ignore-errors |
| @@ -640,7 +618,7 @@ Emacs dired can't find files." | |||
| 640 | tmpfile))) | 618 | tmpfile))) |
| 641 | 619 | ||
| 642 | (defun tramp-adb-handle-file-writable-p (filename) | 620 | (defun tramp-adb-handle-file-writable-p (filename) |
| 643 | "Like `tramp-sh-handle-file-writable-p'. | 621 | "Like `file-writable-p' for Tramp files. |
| 644 | But handle the case, if the \"test\" command is not available." | 622 | But handle the case, if the \"test\" command is not available." |
| 645 | (with-parsed-tramp-file-name filename nil | 623 | (with-parsed-tramp-file-name filename nil |
| 646 | (with-tramp-file-property v localname "file-writable-p" | 624 | (with-tramp-file-property v localname "file-writable-p" |
| @@ -754,8 +732,8 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." | |||
| 754 | v 0 (format "Copying %s to %s" filename newname) | 732 | v 0 (format "Copying %s to %s" filename newname) |
| 755 | 733 | ||
| 756 | (if (and t1 t2 (tramp-equal-remote filename newname)) | 734 | (if (and t1 t2 (tramp-equal-remote filename newname)) |
| 757 | (let ((l1 (file-remote-p filename 'localname)) | 735 | (let ((l1 (tramp-compat-file-local-name filename)) |
| 758 | (l2 (file-remote-p newname 'localname))) | 736 | (l2 (tramp-compat-file-local-name newname))) |
| 759 | (when (and (not ok-if-already-exists) | 737 | (when (and (not ok-if-already-exists) |
| 760 | (file-exists-p newname)) | 738 | (file-exists-p newname)) |
| 761 | (tramp-error v 'file-already-exists newname)) | 739 | (tramp-error v 'file-already-exists newname)) |
| @@ -835,8 +813,8 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." | |||
| 835 | (if (and t1 t2 | 813 | (if (and t1 t2 |
| 836 | (tramp-equal-remote filename newname) | 814 | (tramp-equal-remote filename newname) |
| 837 | (not (file-directory-p filename))) | 815 | (not (file-directory-p filename))) |
| 838 | (let ((l1 (file-remote-p filename 'localname)) | 816 | (let ((l1 (tramp-compat-file-local-name filename)) |
| 839 | (l2 (file-remote-p newname 'localname))) | 817 | (l2 (tramp-compat-file-local-name newname))) |
| 840 | (when (and (not ok-if-already-exists) | 818 | (when (and (not ok-if-already-exists) |
| 841 | (file-exists-p newname)) | 819 | (file-exists-p newname)) |
| 842 | (tramp-error v 'file-already-exists newname)) | 820 | (tramp-error v 'file-already-exists newname)) |
| @@ -1132,7 +1110,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." | |||
| 1132 | (read (current-buffer))) | 1110 | (read (current-buffer))) |
| 1133 | ":" 'omit))) | 1111 | ":" 'omit))) |
| 1134 | ;; The equivalent to `exec-directory'. | 1112 | ;; The equivalent to `exec-directory'. |
| 1135 | `(,(file-remote-p default-directory 'localname)))) | 1113 | `(,(tramp-compat-file-local-name default-directory)))) |
| 1136 | 1114 | ||
| 1137 | (defun tramp-adb-get-device (vec) | 1115 | (defun tramp-adb-get-device (vec) |
| 1138 | "Return full host name from VEC to be used in shell execution. | 1116 | "Return full host name from VEC to be used in shell execution. |
diff --git a/lisp/net/tramp-compat.el b/lisp/net/tramp-compat.el index 9e02ebb24dd..01377240ad5 100644 --- a/lisp/net/tramp-compat.el +++ b/lisp/net/tramp-compat.el | |||
| @@ -187,15 +187,23 @@ This is a string of ten letters or dashes as in ls -l." | |||
| 187 | (if (get 'file-missing 'error-conditions) 'file-missing 'file-error) | 187 | (if (get 'file-missing 'error-conditions) 'file-missing 'file-error) |
| 188 | "The error symbol for the `file-missing' error.") | 188 | "The error symbol for the `file-missing' error.") |
| 189 | 189 | ||
| 190 | ;; `file-name-quoted-p', `file-name-quote' and `file-name-unquote' are | 190 | ;; `file-local-name', `file-name-quoted-p', `file-name-quote' and |
| 191 | ;; introduced in Emacs 26. | 191 | ;; `file-name-unquote' are introduced in Emacs 26. |
| 192 | (eval-and-compile | 192 | (eval-and-compile |
| 193 | (if (fboundp 'file-local-name) | ||
| 194 | (defalias 'tramp-compat-file-local-name 'file-local-name) | ||
| 195 | (defsubst tramp-compat-file-local-name (name) | ||
| 196 | "Return the local name component of NAME. | ||
| 197 | It returns a file name which can be used directly as argument of | ||
| 198 | `process-file', `start-file-process', or `shell-command'." | ||
| 199 | (or (file-remote-p name 'localname) name))) | ||
| 200 | |||
| 193 | (if (fboundp 'file-name-quoted-p) | 201 | (if (fboundp 'file-name-quoted-p) |
| 194 | (defalias 'tramp-compat-file-name-quoted-p 'file-name-quoted-p) | 202 | (defalias 'tramp-compat-file-name-quoted-p 'file-name-quoted-p) |
| 195 | (defsubst tramp-compat-file-name-quoted-p (name) | 203 | (defsubst tramp-compat-file-name-quoted-p (name) |
| 196 | "Whether NAME is quoted with prefix \"/:\". | 204 | "Whether NAME is quoted with prefix \"/:\". |
| 197 | If NAME is a remote file name, check the local part of NAME." | 205 | If NAME is a remote file name, check the local part of NAME." |
| 198 | (string-prefix-p "/:" (or (file-remote-p name 'localname) name)))) | 206 | (string-prefix-p "/:" (tramp-compat-file-local-name name)))) |
| 199 | 207 | ||
| 200 | (if (fboundp 'file-name-quote) | 208 | (if (fboundp 'file-name-quote) |
| 201 | (defalias 'tramp-compat-file-name-quote 'file-name-quote) | 209 | (defalias 'tramp-compat-file-name-quote 'file-name-quote) |
| @@ -205,14 +213,14 @@ If NAME is a remote file name, the local part of NAME is quoted." | |||
| 205 | (if (tramp-compat-file-name-quoted-p name) | 213 | (if (tramp-compat-file-name-quoted-p name) |
| 206 | name | 214 | name |
| 207 | (concat | 215 | (concat |
| 208 | (file-remote-p name) "/:" (or (file-remote-p name 'localname) name))))) | 216 | (file-remote-p name) "/:" (tramp-compat-file-local-name name))))) |
| 209 | 217 | ||
| 210 | (if (fboundp 'file-name-unquote) | 218 | (if (fboundp 'file-name-unquote) |
| 211 | (defalias 'tramp-compat-file-name-unquote 'file-name-unquote) | 219 | (defalias 'tramp-compat-file-name-unquote 'file-name-unquote) |
| 212 | (defsubst tramp-compat-file-name-unquote (name) | 220 | (defsubst tramp-compat-file-name-unquote (name) |
| 213 | "Remove quotation prefix \"/:\" from file NAME. | 221 | "Remove quotation prefix \"/:\" from file NAME. |
| 214 | If NAME is a remote file name, the local part of NAME is unquoted." | 222 | If NAME is a remote file name, the local part of NAME is unquoted." |
| 215 | (let ((localname (or (file-remote-p name 'localname) name))) | 223 | (let ((localname (tramp-compat-file-local-name name))) |
| 216 | (when (tramp-compat-file-name-quoted-p localname) | 224 | (when (tramp-compat-file-name-quoted-p localname) |
| 217 | (setq | 225 | (setq |
| 218 | localname (if (= (length localname) 2) "/" (substring localname 2)))) | 226 | localname (if (= (length localname) 2) "/" (substring localname 2)))) |
diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el index 82118724716..e034f7bba56 100644 --- a/lisp/net/tramp-gvfs.el +++ b/lisp/net/tramp-gvfs.el | |||
| @@ -546,7 +546,7 @@ It has been changed in GVFS 1.14.") | |||
| 546 | (file-executable-p . tramp-gvfs-handle-file-executable-p) | 546 | (file-executable-p . tramp-gvfs-handle-file-executable-p) |
| 547 | (file-exists-p . tramp-handle-file-exists-p) | 547 | (file-exists-p . tramp-handle-file-exists-p) |
| 548 | (file-in-directory-p . tramp-handle-file-in-directory-p) | 548 | (file-in-directory-p . tramp-handle-file-in-directory-p) |
| 549 | (file-local-copy . tramp-gvfs-handle-file-local-copy) | 549 | (file-local-copy . tramp-handle-file-local-copy) |
| 550 | (file-modes . tramp-handle-file-modes) | 550 | (file-modes . tramp-handle-file-modes) |
| 551 | (file-name-all-completions . tramp-gvfs-handle-file-name-all-completions) | 551 | (file-name-all-completions . tramp-gvfs-handle-file-name-all-completions) |
| 552 | (file-name-as-directory . tramp-handle-file-name-as-directory) | 552 | (file-name-as-directory . tramp-handle-file-name-as-directory) |
| @@ -567,7 +567,7 @@ It has been changed in GVFS 1.14.") | |||
| 567 | (file-symlink-p . tramp-handle-file-symlink-p) | 567 | (file-symlink-p . tramp-handle-file-symlink-p) |
| 568 | (file-system-info . tramp-gvfs-handle-file-system-info) | 568 | (file-system-info . tramp-gvfs-handle-file-system-info) |
| 569 | (file-truename . tramp-handle-file-truename) | 569 | (file-truename . tramp-handle-file-truename) |
| 570 | (file-writable-p . tramp-gvfs-handle-file-writable-p) | 570 | (file-writable-p . tramp-handle-file-writable-p) |
| 571 | (find-backup-file-name . tramp-handle-find-backup-file-name) | 571 | (find-backup-file-name . tramp-handle-find-backup-file-name) |
| 572 | ;; `get-file-buffer' performed by default handler. | 572 | ;; `get-file-buffer' performed by default handler. |
| 573 | (insert-directory . tramp-handle-insert-directory) | 573 | (insert-directory . tramp-handle-insert-directory) |
| @@ -592,7 +592,7 @@ It has been changed in GVFS 1.14.") | |||
| 592 | (unhandled-file-name-directory . ignore) | 592 | (unhandled-file-name-directory . ignore) |
| 593 | (vc-registered . ignore) | 593 | (vc-registered . ignore) |
| 594 | (verify-visited-file-modtime . tramp-handle-verify-visited-file-modtime) | 594 | (verify-visited-file-modtime . tramp-handle-verify-visited-file-modtime) |
| 595 | (write-region . tramp-gvfs-handle-write-region)) | 595 | (write-region . tramp-handle-write-region)) |
| 596 | "Alist of handler functions for Tramp GVFS method. | 596 | "Alist of handler functions for Tramp GVFS method. |
| 597 | Operations not mentioned here will be handled by the default Emacs primitives.") | 597 | Operations not mentioned here will be handled by the default Emacs primitives.") |
| 598 | 598 | ||
| @@ -1132,17 +1132,6 @@ If FILE-SYSTEM is non-nil, return file system attributes." | |||
| 1132 | (with-tramp-file-property v localname "file-executable-p" | 1132 | (with-tramp-file-property v localname "file-executable-p" |
| 1133 | (tramp-check-cached-permissions v ?x)))) | 1133 | (tramp-check-cached-permissions v ?x)))) |
| 1134 | 1134 | ||
| 1135 | (defun tramp-gvfs-handle-file-local-copy (filename) | ||
| 1136 | "Like `file-local-copy' for Tramp files." | ||
| 1137 | (with-parsed-tramp-file-name filename nil | ||
| 1138 | (unless (file-exists-p filename) | ||
| 1139 | (tramp-error | ||
| 1140 | v tramp-file-missing | ||
| 1141 | "Cannot make local copy of non-existing file `%s'" filename)) | ||
| 1142 | (let ((tmpfile (tramp-compat-make-temp-file filename))) | ||
| 1143 | (copy-file filename tmpfile 'ok-if-already-exists 'keep-time) | ||
| 1144 | tmpfile))) | ||
| 1145 | |||
| 1146 | (defun tramp-gvfs-handle-file-name-all-completions (filename directory) | 1135 | (defun tramp-gvfs-handle-file-name-all-completions (filename directory) |
| 1147 | "Like `file-name-all-completions' for Tramp files." | 1136 | "Like `file-name-all-completions' for Tramp files." |
| 1148 | (unless (string-match-p "/" filename) | 1137 | (unless (string-match-p "/" filename) |
| @@ -1280,16 +1269,6 @@ file-notify events." | |||
| 1280 | (- (string-to-number size) (string-to-number used)) | 1269 | (- (string-to-number size) (string-to-number used)) |
| 1281 | (string-to-number free)))))) | 1270 | (string-to-number free)))))) |
| 1282 | 1271 | ||
| 1283 | (defun tramp-gvfs-handle-file-writable-p (filename) | ||
| 1284 | "Like `file-writable-p' for Tramp files." | ||
| 1285 | (with-parsed-tramp-file-name filename nil | ||
| 1286 | (with-tramp-file-property v localname "file-writable-p" | ||
| 1287 | (if (file-exists-p filename) | ||
| 1288 | (tramp-check-cached-permissions v ?w) | ||
| 1289 | ;; If file doesn't exist, check if directory is writable. | ||
| 1290 | (and (file-directory-p (file-name-directory filename)) | ||
| 1291 | (file-writable-p (file-name-directory filename))))))) | ||
| 1292 | |||
| 1293 | (defun tramp-gvfs-handle-make-directory (dir &optional parents) | 1272 | (defun tramp-gvfs-handle-make-directory (dir &optional parents) |
| 1294 | "Like `make-directory' for Tramp files." | 1273 | "Like `make-directory' for Tramp files." |
| 1295 | (setq dir (directory-file-name (expand-file-name dir))) | 1274 | (setq dir (directory-file-name (expand-file-name dir))) |
| @@ -1324,48 +1303,6 @@ file-notify events." | |||
| 1324 | (tramp-run-real-handler | 1303 | (tramp-run-real-handler |
| 1325 | 'rename-file (list filename newname ok-if-already-exists)))) | 1304 | 'rename-file (list filename newname ok-if-already-exists)))) |
| 1326 | 1305 | ||
| 1327 | (defun tramp-gvfs-handle-write-region | ||
| 1328 | (start end filename &optional append visit lockname mustbenew) | ||
| 1329 | "Like `write-region' for Tramp files." | ||
| 1330 | (setq filename (expand-file-name filename)) | ||
| 1331 | (with-parsed-tramp-file-name filename nil | ||
| 1332 | (when (and mustbenew (file-exists-p filename) | ||
| 1333 | (or (eq mustbenew 'excl) | ||
| 1334 | (not | ||
| 1335 | (y-or-n-p | ||
| 1336 | (format "File %s exists; overwrite anyway? " filename))))) | ||
| 1337 | (tramp-error v 'file-already-exists filename)) | ||
| 1338 | |||
| 1339 | (let ((tmpfile (tramp-compat-make-temp-file filename))) | ||
| 1340 | (when (and append (file-exists-p filename)) | ||
| 1341 | (copy-file filename tmpfile 'ok)) | ||
| 1342 | ;; We say `no-message' here because we don't want the visited file | ||
| 1343 | ;; modtime data to be clobbered from the temp file. We call | ||
| 1344 | ;; `set-visited-file-modtime' ourselves later on. | ||
| 1345 | (tramp-run-real-handler | ||
| 1346 | 'write-region (list start end tmpfile append 'no-message lockname)) | ||
| 1347 | (condition-case nil | ||
| 1348 | (rename-file tmpfile filename 'ok-if-already-exists) | ||
| 1349 | (error | ||
| 1350 | (delete-file tmpfile) | ||
| 1351 | (tramp-error | ||
| 1352 | v 'file-error "Couldn't write region to `%s'" filename)))) | ||
| 1353 | |||
| 1354 | (tramp-flush-file-properties v (file-name-directory localname)) | ||
| 1355 | (tramp-flush-file-properties v localname) | ||
| 1356 | |||
| 1357 | ;; Set file modification time. | ||
| 1358 | (when (or (eq visit t) (stringp visit)) | ||
| 1359 | (set-visited-file-modtime | ||
| 1360 | (tramp-compat-file-attribute-modification-time | ||
| 1361 | (file-attributes filename)))) | ||
| 1362 | |||
| 1363 | ;; The end. | ||
| 1364 | (when (and (null noninteractive) | ||
| 1365 | (or (eq visit t) (null visit) (stringp visit))) | ||
| 1366 | (tramp-message v 0 "Wrote %s" filename)) | ||
| 1367 | (run-hooks 'tramp-handle-write-region-hook))) | ||
| 1368 | |||
| 1369 | 1306 | ||
| 1370 | ;; File name conversions. | 1307 | ;; File name conversions. |
| 1371 | 1308 | ||
diff --git a/lisp/net/tramp-rclone.el b/lisp/net/tramp-rclone.el index 3f3cac8ebc2..5ea42c07bf2 100644 --- a/lisp/net/tramp-rclone.el +++ b/lisp/net/tramp-rclone.el | |||
| @@ -31,17 +31,13 @@ | |||
| 31 | ;; A remote file under rclone control has the form | 31 | ;; A remote file under rclone control has the form |
| 32 | ;; "/rclone:<remote>:/path/to/file". <remote> is the name of a | 32 | ;; "/rclone:<remote>:/path/to/file". <remote> is the name of a |
| 33 | ;; storage system in rclone's configuration. Therefore, such a remote | 33 | ;; storage system in rclone's configuration. Therefore, such a remote |
| 34 | ;; file name does not know any user or port specification. | 34 | ;; file name does not know of any user or port specification. |
| 35 | 35 | ||
| 36 | ;;; Code: | 36 | ;;; Code: |
| 37 | 37 | ||
| 38 | (eval-when-compile (require 'cl-lib)) | 38 | (eval-when-compile (require 'cl-lib)) |
| 39 | (require 'tramp) | 39 | (require 'tramp) |
| 40 | 40 | ||
| 41 | ;; TODDDDDDDDDO: REPLACE | ||
| 42 | (require 'tramp-adb) | ||
| 43 | (require 'tramp-gvfs) | ||
| 44 | |||
| 45 | ;;;###tramp-autoload | 41 | ;;;###tramp-autoload |
| 46 | (defconst tramp-rclone-method "rclone" | 42 | (defconst tramp-rclone-method "rclone" |
| 47 | "When this method name is used, forward all calls to rclone mounts.") | 43 | "When this method name is used, forward all calls to rclone mounts.") |
| @@ -86,7 +82,7 @@ | |||
| 86 | (dired-compress-file . ignore) | 82 | (dired-compress-file . ignore) |
| 87 | (dired-uncache . tramp-handle-dired-uncache) | 83 | (dired-uncache . tramp-handle-dired-uncache) |
| 88 | (exec-path . ignore) | 84 | (exec-path . ignore) |
| 89 | (expand-file-name . tramp-adb-handle-expand-file-name) | 85 | (expand-file-name . tramp-handle-expand-file-name) |
| 90 | (file-accessible-directory-p . tramp-handle-file-accessible-directory-p) | 86 | (file-accessible-directory-p . tramp-handle-file-accessible-directory-p) |
| 91 | (file-acl . ignore) | 87 | (file-acl . ignore) |
| 92 | (file-attributes . tramp-rclone-handle-file-attributes) | 88 | (file-attributes . tramp-rclone-handle-file-attributes) |
| @@ -95,7 +91,7 @@ | |||
| 95 | (file-executable-p . tramp-rclone-handle-file-executable-p) | 91 | (file-executable-p . tramp-rclone-handle-file-executable-p) |
| 96 | (file-exists-p . tramp-handle-file-exists-p) | 92 | (file-exists-p . tramp-handle-file-exists-p) |
| 97 | (file-in-directory-p . tramp-handle-file-in-directory-p) | 93 | (file-in-directory-p . tramp-handle-file-in-directory-p) |
| 98 | (file-local-copy . tramp-gvfs-handle-file-local-copy) | 94 | (file-local-copy . tramp-handle-file-local-copy) |
| 99 | (file-modes . tramp-handle-file-modes) | 95 | (file-modes . tramp-handle-file-modes) |
| 100 | (file-name-all-completions . tramp-rclone-handle-file-name-all-completions) | 96 | (file-name-all-completions . tramp-rclone-handle-file-name-all-completions) |
| 101 | (file-name-as-directory . tramp-handle-file-name-as-directory) | 97 | (file-name-as-directory . tramp-handle-file-name-as-directory) |
| @@ -116,7 +112,7 @@ | |||
| 116 | (file-symlink-p . tramp-handle-file-symlink-p) | 112 | (file-symlink-p . tramp-handle-file-symlink-p) |
| 117 | (file-system-info . tramp-rclone-handle-file-system-info) | 113 | (file-system-info . tramp-rclone-handle-file-system-info) |
| 118 | (file-truename . tramp-handle-file-truename) | 114 | (file-truename . tramp-handle-file-truename) |
| 119 | (file-writable-p . tramp-gvfs-handle-file-writable-p) | 115 | (file-writable-p . tramp-handle-file-writable-p) |
| 120 | (find-backup-file-name . tramp-handle-find-backup-file-name) | 116 | (find-backup-file-name . tramp-handle-find-backup-file-name) |
| 121 | ;; `get-file-buffer' performed by default handler. | 117 | ;; `get-file-buffer' performed by default handler. |
| 122 | (insert-directory . tramp-handle-insert-directory) | 118 | (insert-directory . tramp-handle-insert-directory) |
| @@ -141,7 +137,7 @@ | |||
| 141 | (unhandled-file-name-directory . ignore) | 137 | (unhandled-file-name-directory . ignore) |
| 142 | (vc-registered . ignore) | 138 | (vc-registered . ignore) |
| 143 | (verify-visited-file-modtime . tramp-handle-verify-visited-file-modtime) | 139 | (verify-visited-file-modtime . tramp-handle-verify-visited-file-modtime) |
| 144 | (write-region . tramp-gvfs-handle-write-region)) | 140 | (write-region . tramp-handle-write-region)) |
| 145 | "Alist of handler functions for Tramp RCLONE method. | 141 | "Alist of handler functions for Tramp RCLONE method. |
| 146 | Operations not mentioned here will be handled by the default Emacs primitives.") | 142 | Operations not mentioned here will be handled by the default Emacs primitives.") |
| 147 | 143 | ||
| @@ -328,12 +324,10 @@ file names." | |||
| 328 | (tramp-rclone-local-file-name directory) full match))) | 324 | (tramp-rclone-local-file-name directory) full match))) |
| 329 | ;; Massage the result. | 325 | ;; Massage the result. |
| 330 | (when full | 326 | (when full |
| 331 | (let* ((quoted (tramp-compat-file-name-quoted-p directory)) | 327 | (let ((local (concat "^" (regexp-quote (tramp-rclone-mount-point v)))) |
| 332 | (local | 328 | (remote (funcall (if (tramp-compat-file-name-quoted-p directory) |
| 333 | (concat "^" (regexp-quote (tramp-rclone-mount-point v)))) | 329 | 'tramp-compat-file-name-quote 'identity) |
| 334 | (remote | 330 | (file-remote-p directory)))) |
| 335 | (funcall (if quoted 'tramp-compat-file-name-quote 'identity) | ||
| 336 | (file-remote-p directory)))) | ||
| 337 | (setq result | 331 | (setq result |
| 338 | (mapcar | 332 | (mapcar |
| 339 | (lambda (x) (replace-regexp-in-string local remote x)) | 333 | (lambda (x) (replace-regexp-in-string local remote x)) |
| @@ -427,8 +421,7 @@ file names." | |||
| 427 | (insert-file-contents | 421 | (insert-file-contents |
| 428 | (tramp-rclone-local-file-name filename) visit beg end replace))) | 422 | (tramp-rclone-local-file-name filename) visit beg end replace))) |
| 429 | (prog1 | 423 | (prog1 |
| 430 | (list (expand-file-name filename) | 424 | (list (expand-file-name filename) (cadr result)) |
| 431 | (cadr result)) | ||
| 432 | (when visit (setq buffer-file-name filename))))) | 425 | (when visit (setq buffer-file-name filename))))) |
| 433 | 426 | ||
| 434 | (defun tramp-rclone-handle-make-directory (dir &optional parents) | 427 | (defun tramp-rclone-handle-make-directory (dir &optional parents) |
| @@ -609,10 +602,7 @@ connection if a previous connection has died for some reason." | |||
| 609 | 602 | ||
| 610 | ;;; TODO: | 603 | ;;; TODO: |
| 611 | 604 | ||
| 612 | ;; * Refactor tramp-gvfs.el in order to move used functions to | 605 | ;; * If possible, get rid of "rclone mount". Maybe it is more |
| 613 | ;; tramp.el. | ||
| 614 | ;; | ||
| 615 | ;; * If possible, get rid of rclone mount. Maybe it is more | ||
| 616 | ;; performant then. | 606 | ;; performant then. |
| 617 | 607 | ||
| 618 | ;;; tramp-rclone.el ends here | 608 | ;;; tramp-rclone.el ends here |
diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 3f426bb0405..a6e9d299a87 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el | |||
| @@ -2192,8 +2192,8 @@ the uid and gid from FILENAME." | |||
| 2192 | v 'file-error | 2192 | v 'file-error |
| 2193 | "Unknown operation `%s', must be `copy' or `rename'" | 2193 | "Unknown operation `%s', must be `copy' or `rename'" |
| 2194 | op)))) | 2194 | op)))) |
| 2195 | (localname1 (if t1 (file-remote-p filename 'localname) filename)) | 2195 | (localname1 (tramp-compat-file-local-name filename)) |
| 2196 | (localname2 (if t2 (file-remote-p newname 'localname) newname)) | 2196 | (localname2 (tramp-compat-file-local-name newname)) |
| 2197 | (prefix (file-remote-p (if t1 filename newname))) | 2197 | (prefix (file-remote-p (if t1 filename newname))) |
| 2198 | cmd-result) | 2198 | cmd-result) |
| 2199 | (when (and (eq op 'copy) (file-directory-p filename)) | 2199 | (when (and (eq op 'copy) (file-directory-p filename)) |
| @@ -3087,7 +3087,7 @@ the result will be a local, non-Tramp, file name." | |||
| 3087 | (append | 3087 | (append |
| 3088 | (tramp-get-remote-path (tramp-dissect-file-name default-directory)) | 3088 | (tramp-get-remote-path (tramp-dissect-file-name default-directory)) |
| 3089 | ;; The equivalent to `exec-directory'. | 3089 | ;; The equivalent to `exec-directory'. |
| 3090 | `(,(file-remote-p default-directory 'localname)))) | 3090 | `(,(tramp-compat-file-local-name default-directory)))) |
| 3091 | 3091 | ||
| 3092 | (defun tramp-sh-handle-file-local-copy (filename) | 3092 | (defun tramp-sh-handle-file-local-copy (filename) |
| 3093 | "Like `file-local-copy' for Tramp files." | 3093 | "Like `file-local-copy' for Tramp files." |
| @@ -4448,8 +4448,7 @@ Goes through the list `tramp-local-coding-commands' and | |||
| 4448 | (format-spec | 4448 | (format-spec |
| 4449 | value | 4449 | value |
| 4450 | (format-spec-make | 4450 | (format-spec-make |
| 4451 | ?t | 4451 | ?t (tramp-compat-file-local-name tmpfile))))) |
| 4452 | (file-remote-p tmpfile 'localname))))) | ||
| 4453 | (tramp-maybe-send-script vec value name) | 4452 | (tramp-maybe-send-script vec value name) |
| 4454 | (setq rem-dec name))) | 4453 | (setq rem-dec name))) |
| 4455 | (tramp-message | 4454 | (tramp-message |
| @@ -5531,7 +5530,7 @@ This command is returned only if `delete-by-moving-to-trash' is non-nil." | |||
| 5531 | "%s -t %s %s" | 5530 | "%s -t %s %s" |
| 5532 | result | 5531 | result |
| 5533 | (format-time-string "%Y%m%d%H%M.%S") | 5532 | (format-time-string "%Y%m%d%H%M.%S") |
| 5534 | (file-remote-p tmpfile 'localname)))) | 5533 | (tramp-compat-file-local-name tmpfile)))) |
| 5535 | (delete-file tmpfile)) | 5534 | (delete-file tmpfile)) |
| 5536 | result))) | 5535 | result))) |
| 5537 | 5536 | ||
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 02870faf649..a44abfdcbbd 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el | |||
| @@ -169,6 +169,7 @@ See the variable `tramp-encoding-shell' for more information." | |||
| 169 | This is a list of entries of the form (NAME PARAM1 PARAM2 ...). | 169 | This is a list of entries of the form (NAME PARAM1 PARAM2 ...). |
| 170 | Each NAME stands for a remote access method. Each PARAM is a | 170 | Each NAME stands for a remote access method. Each PARAM is a |
| 171 | pair of the form (KEY VALUE). The following KEYs are defined: | 171 | pair of the form (KEY VALUE). The following KEYs are defined: |
| 172 | |||
| 172 | * `tramp-remote-shell' | 173 | * `tramp-remote-shell' |
| 173 | This specifies the shell to use on the remote host. This | 174 | This specifies the shell to use on the remote host. This |
| 174 | MUST be a Bourne-like shell. It is normally not necessary to | 175 | MUST be a Bourne-like shell. It is normally not necessary to |
| @@ -177,19 +178,23 @@ pair of the form (KEY VALUE). The following KEYs are defined: | |||
| 177 | for it. Also note that \"/bin/sh\" exists on all Unixen, | 178 | for it. Also note that \"/bin/sh\" exists on all Unixen, |
| 178 | this might not be true for the value that you decide to use. | 179 | this might not be true for the value that you decide to use. |
| 179 | You Have Been Warned. | 180 | You Have Been Warned. |
| 181 | |||
| 180 | * `tramp-remote-shell-login' | 182 | * `tramp-remote-shell-login' |
| 181 | This specifies the arguments to let `tramp-remote-shell' run | 183 | This specifies the arguments to let `tramp-remote-shell' run |
| 182 | as a login shell. It defaults to (\"-l\"), but some shells, | 184 | as a login shell. It defaults to (\"-l\"), but some shells, |
| 183 | like ksh, require another argument. See | 185 | like ksh, require another argument. See |
| 184 | `tramp-connection-properties' for a way to overwrite the | 186 | `tramp-connection-properties' for a way to overwrite the |
| 185 | default value. | 187 | default value. |
| 188 | |||
| 186 | * `tramp-remote-shell-args' | 189 | * `tramp-remote-shell-args' |
| 187 | For implementation of `shell-command', this specifies the | 190 | For implementation of `shell-command', this specifies the |
| 188 | arguments to let `tramp-remote-shell' run a single command. | 191 | arguments to let `tramp-remote-shell' run a single command. |
| 192 | |||
| 189 | * `tramp-login-program' | 193 | * `tramp-login-program' |
| 190 | This specifies the name of the program to use for logging in to the | 194 | This specifies the name of the program to use for logging in to the |
| 191 | remote host. This may be the name of rsh or a workalike program, | 195 | remote host. This may be the name of rsh or a workalike program, |
| 192 | or the name of telnet or a workalike, or the name of su or a workalike. | 196 | or the name of telnet or a workalike, or the name of su or a workalike. |
| 197 | |||
| 193 | * `tramp-login-args' | 198 | * `tramp-login-args' |
| 194 | This specifies the list of arguments to pass to the above | 199 | This specifies the list of arguments to pass to the above |
| 195 | mentioned program. Please note that this is a list of list of arguments, | 200 | mentioned program. Please note that this is a list of list of arguments, |
| @@ -205,59 +210,88 @@ pair of the form (KEY VALUE). The following KEYs are defined: | |||
| 205 | `tramp-make-tramp-temp-file'. \"%k\" indicates the keep-date | 210 | `tramp-make-tramp-temp-file'. \"%k\" indicates the keep-date |
| 206 | parameter of a program, if exists. \"%c\" adds additional | 211 | parameter of a program, if exists. \"%c\" adds additional |
| 207 | `tramp-ssh-controlmaster-options' options for the first hop. | 212 | `tramp-ssh-controlmaster-options' options for the first hop. |
| 213 | The existence of `tramp-login-args', combined with the absence of | ||
| 214 | `tramp-copy-args', is an indication that the method is capable of | ||
| 215 | multi-hops. | ||
| 216 | |||
| 208 | * `tramp-login-env' | 217 | * `tramp-login-env' |
| 209 | A list of environment variables and their values, which will | 218 | A list of environment variables and their values, which will |
| 210 | be set when calling `tramp-login-program'. | 219 | be set when calling `tramp-login-program'. |
| 220 | |||
| 211 | * `tramp-async-args' | 221 | * `tramp-async-args' |
| 212 | When an asynchronous process is started, we know already that | 222 | When an asynchronous process is started, we know already that |
| 213 | the connection works. Therefore, we can pass additional | 223 | the connection works. Therefore, we can pass additional |
| 214 | parameters to suppress diagnostic messages, in order not to | 224 | parameters to suppress diagnostic messages, in order not to |
| 215 | tamper the process output. | 225 | tamper the process output. |
| 226 | |||
| 216 | * `tramp-copy-program' | 227 | * `tramp-copy-program' |
| 217 | This specifies the name of the program to use for remotely copying | 228 | This specifies the name of the program to use for remotely copying |
| 218 | the file; this might be the absolute filename of scp or the name of | 229 | the file; this might be the absolute filename of scp or the name of |
| 219 | a workalike program. It is always applied on the local host. | 230 | a workalike program. It is always applied on the local host. |
| 231 | |||
| 220 | * `tramp-copy-args' | 232 | * `tramp-copy-args' |
| 221 | This specifies the list of parameters to pass to the above mentioned | 233 | This specifies the list of parameters to pass to the above mentioned |
| 222 | program, the hints for `tramp-login-args' also apply here. | 234 | program, the hints for `tramp-login-args' also apply here. |
| 235 | |||
| 223 | * `tramp-copy-env' | 236 | * `tramp-copy-env' |
| 224 | A list of environment variables and their values, which will | 237 | A list of environment variables and their values, which will |
| 225 | be set when calling `tramp-copy-program'. | 238 | be set when calling `tramp-copy-program'. |
| 239 | |||
| 226 | * `tramp-remote-copy-program' | 240 | * `tramp-remote-copy-program' |
| 227 | The listener program to be applied on remote side, if needed. | 241 | The listener program to be applied on remote side, if needed. |
| 242 | |||
| 228 | * `tramp-remote-copy-args' | 243 | * `tramp-remote-copy-args' |
| 229 | The list of parameters to pass to the listener program, the hints | 244 | The list of parameters to pass to the listener program, the hints |
| 230 | for `tramp-login-args' also apply here. Additionally, \"%r\" could | 245 | for `tramp-login-args' also apply here. Additionally, \"%r\" could |
| 231 | be used here and in `tramp-copy-args'. It denotes a randomly | 246 | be used here and in `tramp-copy-args'. It denotes a randomly |
| 232 | chosen port for the remote listener. | 247 | chosen port for the remote listener. |
| 248 | |||
| 233 | * `tramp-copy-keep-date' | 249 | * `tramp-copy-keep-date' |
| 234 | This specifies whether the copying program when the preserves the | 250 | This specifies whether the copying program when the preserves the |
| 235 | timestamp of the original file. | 251 | timestamp of the original file. |
| 252 | |||
| 236 | * `tramp-copy-keep-tmpfile' | 253 | * `tramp-copy-keep-tmpfile' |
| 237 | This specifies whether a temporary local file shall be kept | 254 | This specifies whether a temporary local file shall be kept |
| 238 | for optimization reasons (useful for \"rsync\" methods). | 255 | for optimization reasons (useful for \"rsync\" methods). |
| 256 | |||
| 239 | * `tramp-copy-recursive' | 257 | * `tramp-copy-recursive' |
| 240 | Whether the operation copies directories recursively. | 258 | Whether the operation copies directories recursively. |
| 259 | |||
| 241 | * `tramp-default-port' | 260 | * `tramp-default-port' |
| 242 | The default port of a method. | 261 | The default port of a method. |
| 262 | |||
| 243 | * `tramp-tmpdir' | 263 | * `tramp-tmpdir' |
| 244 | A directory on the remote host for temporary files. If not | 264 | A directory on the remote host for temporary files. If not |
| 245 | specified, \"/tmp\" is taken as default. | 265 | specified, \"/tmp\" is taken as default. |
| 266 | |||
| 246 | * `tramp-connection-timeout' | 267 | * `tramp-connection-timeout' |
| 247 | This is the maximum time to be spent for establishing a connection. | 268 | This is the maximum time to be spent for establishing a connection. |
| 248 | In general, the global default value shall be used, but for | 269 | In general, the global default value shall be used, but for |
| 249 | some methods, like \"su\" or \"sudo\", a shorter timeout | 270 | some methods, like \"su\" or \"sudo\", a shorter timeout |
| 250 | might be desirable. | 271 | might be desirable. |
| 272 | |||
| 251 | * `tramp-session-timeout' | 273 | * `tramp-session-timeout' |
| 252 | How long a Tramp connection keeps open before being disconnected. | 274 | How long a Tramp connection keeps open before being disconnected. |
| 253 | This is useful for methods like \"su\" or \"sudo\", which | 275 | This is useful for methods like \"su\" or \"sudo\", which |
| 254 | shouldn't run an open connection in the background forever. | 276 | shouldn't run an open connection in the background forever. |
| 277 | |||
| 255 | * `tramp-case-insensitive' | 278 | * `tramp-case-insensitive' |
| 256 | Whether the remote file system handles file names case insensitive. | 279 | Whether the remote file system handles file names case insensitive. |
| 257 | Only a non-nil value counts, the default value nil means to | 280 | Only a non-nil value counts, the default value nil means to |
| 258 | perform further checks on the remote host. See | 281 | perform further checks on the remote host. See |
| 259 | `tramp-connection-properties' for a way to overwrite this. | 282 | `tramp-connection-properties' for a way to overwrite this. |
| 260 | 283 | ||
| 284 | * `tramp-mount-args' | ||
| 285 | * `tramp-copyto-args' | ||
| 286 | * `tramp-moveto-args' | ||
| 287 | * `tramp-about-args' | ||
| 288 | These parameters, a list of list like `tramp-login-args', are used | ||
| 289 | for the \"rclone\" method, and are appended to the respective | ||
| 290 | \"rclone\" commands. In general, they shouldn't be changed inside | ||
| 291 | `tramp-methods'; it is recommended to change their values via | ||
| 292 | `tramp-connection-properties'. Unlike `tramp-login-args' there is | ||
| 293 | no pattern replacement. | ||
| 294 | |||
| 261 | What does all this mean? Well, you should specify `tramp-login-program' | 295 | What does all this mean? Well, you should specify `tramp-login-program' |
| 262 | for all methods; this program is used to log in to the remote site. Then, | 296 | for all methods; this program is used to log in to the remote site. Then, |
| 263 | there are two ways to actually transfer the files between the local and the | 297 | there are two ways to actually transfer the files between the local and the |
| @@ -2993,6 +3027,7 @@ Host is always \"localhost\"." | |||
| 2993 | (defun tramp-parse-netrc (filename) | 3027 | (defun tramp-parse-netrc (filename) |
| 2994 | "Return a list of (user host) tuples allowed to access. | 3028 | "Return a list of (user host) tuples allowed to access. |
| 2995 | User may be nil." | 3029 | User may be nil." |
| 3030 | (require 'netrc) | ||
| 2996 | (mapcar | 3031 | (mapcar |
| 2997 | (lambda (item) | 3032 | (lambda (item) |
| 2998 | (and (assoc "machine" item) | 3033 | (and (assoc "machine" item) |
| @@ -3101,6 +3136,28 @@ User is always nil." | |||
| 3101 | (if (file-directory-p dir) dir (file-name-directory dir)) nil | 3136 | (if (file-directory-p dir) dir (file-name-directory dir)) nil |
| 3102 | (tramp-flush-directory-properties v localname))) | 3137 | (tramp-flush-directory-properties v localname))) |
| 3103 | 3138 | ||
| 3139 | (defun tramp-handle-expand-file-name (name &optional dir) | ||
| 3140 | "Like `expand-file-name' for Tramp files." | ||
| 3141 | ;; If DIR is not given, use DEFAULT-DIRECTORY or "/". | ||
| 3142 | (setq dir (or dir default-directory "/")) | ||
| 3143 | ;; Unless NAME is absolute, concat DIR and NAME. | ||
| 3144 | (unless (file-name-absolute-p name) | ||
| 3145 | (setq name (concat (file-name-as-directory dir) name))) | ||
| 3146 | ;; If NAME is not a Tramp file, run the real handler. | ||
| 3147 | (if (not (tramp-tramp-file-p name)) | ||
| 3148 | (tramp-run-real-handler 'expand-file-name (list name nil)) | ||
| 3149 | ;; Dissect NAME. | ||
| 3150 | (with-parsed-tramp-file-name name nil | ||
| 3151 | (unless (tramp-run-real-handler 'file-name-absolute-p (list localname)) | ||
| 3152 | (setq localname (concat "/" localname))) | ||
| 3153 | ;; Do normal `expand-file-name' (this does "/./" and "/../"). | ||
| 3154 | ;; `default-directory' is bound, because on Windows there would | ||
| 3155 | ;; be problems with UNC shares or Cygwin mounts. | ||
| 3156 | (let ((default-directory (tramp-compat-temporary-file-directory))) | ||
| 3157 | (tramp-make-tramp-file-name | ||
| 3158 | v (tramp-drop-volume-letter | ||
| 3159 | (tramp-run-real-handler 'expand-file-name (list localname)))))))) | ||
| 3160 | |||
| 3104 | (defun tramp-handle-file-accessible-directory-p (filename) | 3161 | (defun tramp-handle-file-accessible-directory-p (filename) |
| 3105 | "Like `file-accessible-directory-p' for Tramp files." | 3162 | "Like `file-accessible-directory-p' for Tramp files." |
| 3106 | (and (file-directory-p filename) | 3163 | (and (file-directory-p filename) |
| @@ -3136,6 +3193,17 @@ User is always nil." | |||
| 3136 | (file-remote-p (expand-file-name directory))) | 3193 | (file-remote-p (expand-file-name directory))) |
| 3137 | (tramp-run-real-handler 'file-in-directory-p (list filename directory)))) | 3194 | (tramp-run-real-handler 'file-in-directory-p (list filename directory)))) |
| 3138 | 3195 | ||
| 3196 | (defun tramp-handle-file-local-copy (filename) | ||
| 3197 | "Like `file-local-copy' for Tramp files." | ||
| 3198 | (with-parsed-tramp-file-name filename nil | ||
| 3199 | (unless (file-exists-p filename) | ||
| 3200 | (tramp-error | ||
| 3201 | v tramp-file-missing | ||
| 3202 | "Cannot make local copy of non-existing file `%s'" filename)) | ||
| 3203 | (let ((tmpfile (tramp-compat-make-temp-file filename))) | ||
| 3204 | (copy-file filename tmpfile 'ok-if-already-exists 'keep-time) | ||
| 3205 | tmpfile))) | ||
| 3206 | |||
| 3139 | (defun tramp-handle-file-modes (filename) | 3207 | (defun tramp-handle-file-modes (filename) |
| 3140 | "Like `file-modes' for Tramp files." | 3208 | "Like `file-modes' for Tramp files." |
| 3141 | (let ((truename (or (file-truename filename) filename))) | 3209 | (let ((truename (or (file-truename filename) filename))) |
| @@ -3184,7 +3252,7 @@ User is always nil." | |||
| 3184 | ;; lower case letters. This avoids us to create a | 3252 | ;; lower case letters. This avoids us to create a |
| 3185 | ;; temporary file. | 3253 | ;; temporary file. |
| 3186 | (while (and (string-match-p | 3254 | (while (and (string-match-p |
| 3187 | "[a-z]" (file-remote-p candidate 'localname)) | 3255 | "[a-z]" (tramp-compat-file-local-name candidate)) |
| 3188 | (not (file-exists-p candidate))) | 3256 | (not (file-exists-p candidate))) |
| 3189 | (setq candidate | 3257 | (setq candidate |
| 3190 | (directory-file-name | 3258 | (directory-file-name |
| @@ -3195,7 +3263,7 @@ User is always nil." | |||
| 3195 | ;; so there is no compatibility problem calling it. | 3263 | ;; so there is no compatibility problem calling it. |
| 3196 | (unless | 3264 | (unless |
| 3197 | (string-match-p | 3265 | (string-match-p |
| 3198 | "[a-z]" (file-remote-p candidate 'localname)) | 3266 | "[a-z]" (tramp-compat-file-local-name candidate)) |
| 3199 | (setq tmpfile | 3267 | (setq tmpfile |
| 3200 | (let ((default-directory | 3268 | (let ((default-directory |
| 3201 | (file-name-directory filename))) | 3269 | (file-name-directory filename))) |
| @@ -3208,7 +3276,7 @@ User is always nil." | |||
| 3208 | (file-exists-p | 3276 | (file-exists-p |
| 3209 | (concat | 3277 | (concat |
| 3210 | (file-remote-p candidate) | 3278 | (file-remote-p candidate) |
| 3211 | (upcase (file-remote-p candidate 'localname)))) | 3279 | (upcase (tramp-compat-file-local-name candidate)))) |
| 3212 | ;; Cleanup. | 3280 | ;; Cleanup. |
| 3213 | (when tmpfile (delete-file tmpfile))))))))))) | 3281 | (when tmpfile (delete-file tmpfile))))))))))) |
| 3214 | 3282 | ||
| @@ -3341,7 +3409,17 @@ User is always nil." | |||
| 3341 | (tramp-error | 3409 | (tramp-error |
| 3342 | v1 'file-error | 3410 | v1 'file-error |
| 3343 | "Maximum number (%d) of symlinks exceeded" numchase-limit))) | 3411 | "Maximum number (%d) of symlinks exceeded" numchase-limit))) |
| 3344 | (file-remote-p (directory-file-name result) 'localname))))))) | 3412 | (tramp-compat-file-local-name (directory-file-name result)))))))) |
| 3413 | |||
| 3414 | (defun tramp-handle-file-writable-p (filename) | ||
| 3415 | "Like `file-writable-p' for Tramp files." | ||
| 3416 | (with-parsed-tramp-file-name filename nil | ||
| 3417 | (with-tramp-file-property v localname "file-writable-p" | ||
| 3418 | (if (file-exists-p filename) | ||
| 3419 | (tramp-check-cached-permissions v ?w) | ||
| 3420 | ;; If file doesn't exist, check if directory is writable. | ||
| 3421 | (and (file-directory-p (file-name-directory filename)) | ||
| 3422 | (file-writable-p (file-name-directory filename))))))) | ||
| 3345 | 3423 | ||
| 3346 | (defun tramp-handle-find-backup-file-name (filename) | 3424 | (defun tramp-handle-find-backup-file-name (filename) |
| 3347 | "Like `find-backup-file-name' for Tramp files." | 3425 | "Like `find-backup-file-name' for Tramp files." |
| @@ -3717,6 +3795,48 @@ of." | |||
| 3717 | ;; only if that agrees with the buffer's record. | 3795 | ;; only if that agrees with the buffer's record. |
| 3718 | (t (tramp-compat-time-equal-p mt tramp-time-doesnt-exist)))))))) | 3796 | (t (tramp-compat-time-equal-p mt tramp-time-doesnt-exist)))))))) |
| 3719 | 3797 | ||
| 3798 | (defun tramp-handle-write-region | ||
| 3799 | (start end filename &optional append visit lockname mustbenew) | ||
| 3800 | "Like `write-region' for Tramp files." | ||
| 3801 | (setq filename (expand-file-name filename)) | ||
| 3802 | (with-parsed-tramp-file-name filename nil | ||
| 3803 | (when (and mustbenew (file-exists-p filename) | ||
| 3804 | (or (eq mustbenew 'excl) | ||
| 3805 | (not | ||
| 3806 | (y-or-n-p | ||
| 3807 | (format "File %s exists; overwrite anyway? " filename))))) | ||
| 3808 | (tramp-error v 'file-already-exists filename)) | ||
| 3809 | |||
| 3810 | (let ((tmpfile (tramp-compat-make-temp-file filename))) | ||
| 3811 | (when (and append (file-exists-p filename)) | ||
| 3812 | (copy-file filename tmpfile 'ok)) | ||
| 3813 | ;; We say `no-message' here because we don't want the visited file | ||
| 3814 | ;; modtime data to be clobbered from the temp file. We call | ||
| 3815 | ;; `set-visited-file-modtime' ourselves later on. | ||
| 3816 | (tramp-run-real-handler | ||
| 3817 | 'write-region (list start end tmpfile append 'no-message lockname)) | ||
| 3818 | (condition-case nil | ||
| 3819 | (rename-file tmpfile filename 'ok-if-already-exists) | ||
| 3820 | (error | ||
| 3821 | (delete-file tmpfile) | ||
| 3822 | (tramp-error | ||
| 3823 | v 'file-error "Couldn't write region to `%s'" filename)))) | ||
| 3824 | |||
| 3825 | (tramp-flush-file-properties v (file-name-directory localname)) | ||
| 3826 | (tramp-flush-file-properties v localname) | ||
| 3827 | |||
| 3828 | ;; Set file modification time. | ||
| 3829 | (when (or (eq visit t) (stringp visit)) | ||
| 3830 | (set-visited-file-modtime | ||
| 3831 | (tramp-compat-file-attribute-modification-time | ||
| 3832 | (file-attributes filename)))) | ||
| 3833 | |||
| 3834 | ;; The end. | ||
| 3835 | (when (and (null noninteractive) | ||
| 3836 | (or (eq visit t) (null visit) (stringp visit))) | ||
| 3837 | (tramp-message v 0 "Wrote %s" filename)) | ||
| 3838 | (run-hooks 'tramp-handle-write-region-hook))) | ||
| 3839 | |||
| 3720 | ;; This is used in tramp-gvfs.el and tramp-sh.el. | 3840 | ;; This is used in tramp-gvfs.el and tramp-sh.el. |
| 3721 | (defconst tramp-gio-events | 3841 | (defconst tramp-gio-events |
| 3722 | '("attribute-changed" "changed" "changes-done-hint" | 3842 | '("attribute-changed" "changed" "changes-done-hint" |
| @@ -4344,7 +4464,7 @@ This handles also chrooted environments, which are not regarded as local." | |||
| 4344 | (tramp-make-tramp-file-name | 4464 | (tramp-make-tramp-file-name |
| 4345 | vec (or (tramp-get-method-parameter vec 'tramp-tmpdir) "/tmp")))) | 4465 | vec (or (tramp-get-method-parameter vec 'tramp-tmpdir) "/tmp")))) |
| 4346 | (or (and (file-directory-p dir) (file-writable-p dir) | 4466 | (or (and (file-directory-p dir) (file-writable-p dir) |
| 4347 | (file-remote-p dir 'localname)) | 4467 | (tramp-compat-file-local-name dir)) |
| 4348 | (tramp-error vec 'file-error "Directory %s not accessible" dir)) | 4468 | (tramp-error vec 'file-error "Directory %s not accessible" dir)) |
| 4349 | dir))) | 4469 | dir))) |
| 4350 | 4470 | ||
diff --git a/lisp/net/zeroconf.el b/lisp/net/zeroconf.el index 0a3f2777b9a..25a8dea4316 100644 --- a/lisp/net/zeroconf.el +++ b/lisp/net/zeroconf.el | |||
| @@ -528,22 +528,27 @@ DOMAIN is nil, the local domain is used." | |||
| 528 | zeroconf-avahi-current-domain | 528 | zeroconf-avahi-current-domain |
| 529 | zeroconf-avahi-flags-unspec)))) | 529 | zeroconf-avahi-flags-unspec)))) |
| 530 | 530 | ||
| 531 | (defvar zeroconf-service-type-browser-handler-running nil | ||
| 532 | "Prevent infinite recursion in `zeroconf-service-type-browser-handler'.") | ||
| 533 | |||
| 531 | (defun zeroconf-service-type-browser-handler (&rest val) | 534 | (defun zeroconf-service-type-browser-handler (&rest val) |
| 532 | "Registered service type browser handler at the Avahi daemon." | 535 | "Registered service type browser handler at the Avahi daemon." |
| 533 | (when zeroconf-debug | 536 | (unless zeroconf-service-type-browser-handler-running |
| 534 | (message "zeroconf-service-type-browser-handler: %s %S" | 537 | (let ((zeroconf-service-type-browser-handler-running t)) |
| 535 | (dbus-event-member-name last-input-event) val)) | 538 | (when zeroconf-debug |
| 536 | (cond | 539 | (message "zeroconf-service-type-browser-handler: %s %S" |
| 537 | ((string-equal (dbus-event-member-name last-input-event) "ItemNew") | 540 | (dbus-event-member-name last-input-event) val)) |
| 538 | ;; Parameters: (interface protocol type domain flags) | 541 | (cond |
| 539 | ;; Register a service browser. | 542 | ((string-equal (dbus-event-member-name last-input-event) "ItemNew") |
| 540 | (let ((object-path (zeroconf-register-service-browser (nth 2 val)))) | 543 | ;; Parameters: (interface protocol type domain flags) |
| 541 | ;; Register the signals. | 544 | ;; Register a service browser. |
| 542 | (dolist (member '("ItemNew" "ItemRemove" "Failure")) | 545 | (let ((object-path (zeroconf-register-service-browser (nth 2 val)))) |
| 543 | (dbus-register-signal | 546 | ;; Register the signals. |
| 544 | :system zeroconf-service-avahi object-path | 547 | (dolist (member '("ItemNew" "ItemRemove" "Failure")) |
| 545 | zeroconf-interface-avahi-service-browser member | 548 | (dbus-register-signal |
| 546 | 'zeroconf-service-browser-handler)))))) | 549 | :system zeroconf-service-avahi object-path |
| 550 | zeroconf-interface-avahi-service-browser member | ||
| 551 | 'zeroconf-service-browser-handler)))))))) | ||
| 547 | 552 | ||
| 548 | (defun zeroconf-register-service-browser (type) | 553 | (defun zeroconf-register-service-browser (type) |
| 549 | "Register a service browser at the Avahi daemon." | 554 | "Register a service browser at the Avahi daemon." |