diff options
| author | Michael Albinus | 2013-10-17 21:39:22 +0200 |
|---|---|---|
| committer | Michael Albinus | 2013-10-17 21:39:22 +0200 |
| commit | 4c1f03efec55c103c97654af339f1dc2bb510b21 (patch) | |
| tree | 7c056ce00fc3bcf1304655e62b82d257be989250 | |
| parent | 642eb8b6afa1c16b134d296ed90fd8fe59dc1d49 (diff) | |
| download | emacs-4c1f03efec55c103c97654af339f1dc2bb510b21.tar.gz emacs-4c1f03efec55c103c97654af339f1dc2bb510b21.zip | |
Code cleanup.
* net/tramp.el (tramp-debug-message): Do not check for connection
buffer.
(tramp-message): Use "vector" connection property.
* net/tramp.el (tramp-rfn-eshadow-update-overlay)
(tramp-equal-remote, tramp-eshell-directory-change)
* net/tramp-adb.el (tramp-adb-handle-copy-file)
(tramp-adb-handle-rename-file)
* net/tramp-cmds.el (tramp-list-remote-buffers)
(tramp-cleanup-connection, tramp-cleanup-this-connection)
* net/tramp-compat.el (tramp-compat-process-running-p)
* net/tramp-ftp.el (tramp-ftp-file-name-handler)
* net/tramp-gvfs.el (tramp-gvfs-handle-copy-file)
(tramp-gvfs-handle-rename-file)
* net/tramp-sh.el (tramp-sh-handle-set-file-times)
(tramp-set-file-uid-gid)
* net/tramp-smb.el (tramp-smb-handle-copy-file)
(tramp-smb-handle-rename-file): Use `tramp-tramp-file-p' instead
of `file-remote-p'.
* net/tramp.el (tramp-connectable-p, tramp-handle-file-remote-p)
* net/tramp-gw.el (tramp-gw-gw-proc-sentinel)
(tramp-gw-aux-proc-sentinel, tramp-gw-process-filter)
(tramp-gw-open-network-stream): Suppress unrelated traces.
* net/tramp-adb.el (tramp-adb-maybe-open-connection)
* net/tramp-gvfs.el (tramp-gvfs-handle-file-notify-add-watch)
* net/tramp-sh.el (tramp-do-copy-or-rename-file-out-of-band)
* net/tramp-smb.el (tramp-smb-maybe-open-connection): Set "vector"
connection property.
* net/tramp-cache.el (top): Suppress traces when reading
presistency file.
* net/tramp-sh.el (tramp-sh-handle-file-notify-add-watch):
Refactor common code. Improve debug message.
(tramp-maybe-open-connection)
* net/tramp-smb.el (tramp-smb-call-winexe): Do not request
connection buffer too early.
* net/tramp-smb.el (tramp-smb-actions-get-acl): New defconst, renamed
from `tramp-smb-actions-with-acl'.
(tramp-smb-actions-set-acl): New defconst.
(tramp-smb-handle-copy-directory)
(tramp-smb-action-get-acl): New defun, renamed from
`tramp-smb-action-with-acl'.
(tramp-smb-action-set-acl): New defun.
(tramp-smb-handle-set-file-acl): Rewrite.
| -rw-r--r-- | lisp/ChangeLog | 53 | ||||
| -rw-r--r-- | lisp/net/tramp-adb.el | 6 | ||||
| -rw-r--r-- | lisp/net/tramp-cache.el | 1 | ||||
| -rw-r--r-- | lisp/net/tramp-cmds.el | 11 | ||||
| -rw-r--r-- | lisp/net/tramp-compat.el | 2 | ||||
| -rw-r--r-- | lisp/net/tramp-ftp.el | 2 | ||||
| -rw-r--r-- | lisp/net/tramp-gvfs.el | 9 | ||||
| -rw-r--r-- | lisp/net/tramp-gw.el | 8 | ||||
| -rw-r--r-- | lisp/net/tramp-sh.el | 35 | ||||
| -rw-r--r-- | lisp/net/tramp-smb.el | 168 | ||||
| -rw-r--r-- | lisp/net/tramp.el | 150 |
11 files changed, 266 insertions, 179 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog index ba8fea8652e..a01d1d58765 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog | |||
| @@ -1,3 +1,56 @@ | |||
| 1 | 2013-10-17 Michael Albinus <michael.albinus@gmx.de> | ||
| 2 | |||
| 3 | Code cleanup. | ||
| 4 | |||
| 5 | * net/tramp.el (tramp-debug-message): Do not check for connection | ||
| 6 | buffer. | ||
| 7 | (tramp-message): Use "vector" connection property. | ||
| 8 | |||
| 9 | * net/tramp.el (tramp-rfn-eshadow-update-overlay) | ||
| 10 | (tramp-equal-remote, tramp-eshell-directory-change) | ||
| 11 | * net/tramp-adb.el (tramp-adb-handle-copy-file) | ||
| 12 | (tramp-adb-handle-rename-file) | ||
| 13 | * net/tramp-cmds.el (tramp-list-remote-buffers) | ||
| 14 | (tramp-cleanup-connection, tramp-cleanup-this-connection) | ||
| 15 | * net/tramp-compat.el (tramp-compat-process-running-p) | ||
| 16 | * net/tramp-ftp.el (tramp-ftp-file-name-handler) | ||
| 17 | * net/tramp-gvfs.el (tramp-gvfs-handle-copy-file) | ||
| 18 | (tramp-gvfs-handle-rename-file) | ||
| 19 | * net/tramp-sh.el (tramp-sh-handle-set-file-times) | ||
| 20 | (tramp-set-file-uid-gid) | ||
| 21 | * net/tramp-smb.el (tramp-smb-handle-copy-file) | ||
| 22 | (tramp-smb-handle-rename-file): Use `tramp-tramp-file-p' instead | ||
| 23 | of `file-remote-p'. | ||
| 24 | |||
| 25 | * net/tramp.el (tramp-connectable-p, tramp-handle-file-remote-p) | ||
| 26 | * net/tramp-gw.el (tramp-gw-gw-proc-sentinel) | ||
| 27 | (tramp-gw-aux-proc-sentinel, tramp-gw-process-filter) | ||
| 28 | (tramp-gw-open-network-stream): Suppress unrelated traces. | ||
| 29 | |||
| 30 | * net/tramp-adb.el (tramp-adb-maybe-open-connection) | ||
| 31 | * net/tramp-gvfs.el (tramp-gvfs-handle-file-notify-add-watch) | ||
| 32 | * net/tramp-sh.el (tramp-do-copy-or-rename-file-out-of-band) | ||
| 33 | * net/tramp-smb.el (tramp-smb-maybe-open-connection): Set "vector" | ||
| 34 | connection property. | ||
| 35 | |||
| 36 | * net/tramp-cache.el (top): Suppress traces when reading | ||
| 37 | presistency file. | ||
| 38 | |||
| 39 | * net/tramp-sh.el (tramp-sh-handle-file-notify-add-watch): | ||
| 40 | Refactor common code. Improve debug message. | ||
| 41 | (tramp-maybe-open-connection) | ||
| 42 | * net/tramp-smb.el (tramp-smb-call-winexe): Do not request | ||
| 43 | connection buffer too early. | ||
| 44 | |||
| 45 | * net/tramp-smb.el (tramp-smb-actions-get-acl): New defconst, renamed | ||
| 46 | from `tramp-smb-actions-with-acl'. | ||
| 47 | (tramp-smb-actions-set-acl): New defconst. | ||
| 48 | (tramp-smb-handle-copy-directory) | ||
| 49 | (tramp-smb-action-get-acl): New defun, renamed from | ||
| 50 | `tramp-smb-action-with-acl'. | ||
| 51 | (tramp-smb-action-set-acl): New defun. | ||
| 52 | (tramp-smb-handle-set-file-acl): Rewrite. | ||
| 53 | |||
| 1 | 2013-10-17 Glenn Morris <rgm@gnu.org> | 54 | 2013-10-17 Glenn Morris <rgm@gnu.org> |
| 2 | 55 | ||
| 3 | * indent.el (indent-rigidly): Fix 2013-10-08 change. (Bug#15635) | 56 | * indent.el (indent-rigidly): Fix 2013-10-08 change. (Bug#15635) |
diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el index 132ffaa27a8..8a53f76ab6f 100644 --- a/lisp/net/tramp-adb.el +++ b/lisp/net/tramp-adb.el | |||
| @@ -662,7 +662,8 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." | |||
| 662 | (if (file-directory-p filename) | 662 | (if (file-directory-p filename) |
| 663 | (tramp-file-name-handler 'copy-directory filename newname keep-date t) | 663 | (tramp-file-name-handler 'copy-directory filename newname keep-date t) |
| 664 | (with-tramp-progress-reporter | 664 | (with-tramp-progress-reporter |
| 665 | (tramp-dissect-file-name (if (file-remote-p filename) filename newname)) | 665 | (tramp-dissect-file-name |
| 666 | (if (tramp-tramp-file-p filename) filename newname)) | ||
| 666 | 0 (format "Copying %s to %s" filename newname) | 667 | 0 (format "Copying %s to %s" filename newname) |
| 667 | 668 | ||
| 668 | (let ((tmpfile (file-local-copy filename))) | 669 | (let ((tmpfile (file-local-copy filename))) |
| @@ -704,7 +705,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." | |||
| 704 | newname (expand-file-name newname)) | 705 | newname (expand-file-name newname)) |
| 705 | 706 | ||
| 706 | (with-parsed-tramp-file-name | 707 | (with-parsed-tramp-file-name |
| 707 | (if (file-remote-p filename) filename newname) nil | 708 | (if (tramp-tramp-file-p filename) filename newname) nil |
| 708 | (with-tramp-progress-reporter | 709 | (with-tramp-progress-reporter |
| 709 | v 0 (format "Renaming %s to %s" newname filename) | 710 | v 0 (format "Renaming %s to %s" newname filename) |
| 710 | 711 | ||
| @@ -1134,6 +1135,7 @@ connection if a previous connection has died for some reason." | |||
| 1134 | (tramp-adb-wait-for-output p 30) | 1135 | (tramp-adb-wait-for-output p 30) |
| 1135 | (unless (eq 'run (process-status p)) | 1136 | (unless (eq 'run (process-status p)) |
| 1136 | (tramp-error vec 'file-error "Terminated!")) | 1137 | (tramp-error vec 'file-error "Terminated!")) |
| 1138 | (tramp-set-connection-property p "vector" vec) | ||
| 1137 | (tramp-compat-set-process-query-on-exit-flag p nil) | 1139 | (tramp-compat-set-process-query-on-exit-flag p nil) |
| 1138 | 1140 | ||
| 1139 | ;; Check whether the properties have been changed. If | 1141 | ;; Check whether the properties have been changed. If |
diff --git a/lisp/net/tramp-cache.el b/lisp/net/tramp-cache.el index ba7cf7a06ef..7a64f907de6 100644 --- a/lisp/net/tramp-cache.el +++ b/lisp/net/tramp-cache.el | |||
| @@ -405,6 +405,7 @@ for all methods. Resulting data are derived from connection history." | |||
| 405 | (with-temp-buffer | 405 | (with-temp-buffer |
| 406 | (insert-file-contents tramp-persistency-file-name) | 406 | (insert-file-contents tramp-persistency-file-name) |
| 407 | (let ((list (read (current-buffer))) | 407 | (let ((list (read (current-buffer))) |
| 408 | (tramp-verbose 0) | ||
| 408 | element key item) | 409 | element key item) |
| 409 | (while (setq element (pop list)) | 410 | (while (setq element (pop list)) |
| 410 | (setq key (pop element)) | 411 | (setq key (pop element)) |
diff --git a/lisp/net/tramp-cmds.el b/lisp/net/tramp-cmds.el index e23ab797c22..2f3dfa4fd7a 100644 --- a/lisp/net/tramp-cmds.el +++ b/lisp/net/tramp-cmds.el | |||
| @@ -48,10 +48,7 @@ | |||
| 48 | nil | 48 | nil |
| 49 | (mapcar | 49 | (mapcar |
| 50 | (lambda (x) | 50 | (lambda (x) |
| 51 | (with-current-buffer x | 51 | (with-current-buffer x (when (tramp-tramp-file-p default-directory) x))) |
| 52 | (when (and (stringp default-directory) | ||
| 53 | (file-remote-p default-directory)) | ||
| 54 | x))) | ||
| 55 | (buffer-list)))) | 52 | (buffer-list)))) |
| 56 | 53 | ||
| 57 | ;;;###tramp-autoload | 54 | ;;;###tramp-autoload |
| @@ -81,8 +78,7 @@ When called interactively, a Tramp connection has to be selected." | |||
| 81 | (completing-read | 78 | (completing-read |
| 82 | "Enter Tramp connection: " connections nil t | 79 | "Enter Tramp connection: " connections nil t |
| 83 | (try-completion "" connections))) | 80 | (try-completion "" connections))) |
| 84 | (when (and name (file-remote-p name)) | 81 | (and (tramp-tramp-file-p name) (tramp-dissect-file-name name)))) |
| 85 | (with-parsed-tramp-file-name name nil v)))) | ||
| 86 | nil nil)) | 82 | nil nil)) |
| 87 | 83 | ||
| 88 | (if (not vec) | 84 | (if (not vec) |
| @@ -113,8 +109,7 @@ When called interactively, a Tramp connection has to be selected." | |||
| 113 | (defun tramp-cleanup-this-connection () | 109 | (defun tramp-cleanup-this-connection () |
| 114 | "Flush all connection related objects of the current buffer's connection." | 110 | "Flush all connection related objects of the current buffer's connection." |
| 115 | (interactive) | 111 | (interactive) |
| 116 | (and (stringp default-directory) | 112 | (and (tramp-tramp-file-p default-directory) |
| 117 | (file-remote-p default-directory) | ||
| 118 | (tramp-cleanup-connection | 113 | (tramp-cleanup-connection |
| 119 | (tramp-dissect-file-name default-directory 'noexpand)))) | 114 | (tramp-dissect-file-name default-directory 'noexpand)))) |
| 120 | 115 | ||
diff --git a/lisp/net/tramp-compat.el b/lisp/net/tramp-compat.el index ca70c1384cb..c5f1882931e 100644 --- a/lisp/net/tramp-compat.el +++ b/lisp/net/tramp-compat.el | |||
| @@ -471,7 +471,7 @@ element is not omitted." | |||
| 471 | 471 | ||
| 472 | ;; Fallback, if there is no Lisp support yet. | 472 | ;; Fallback, if there is no Lisp support yet. |
| 473 | (t (let ((default-directory | 473 | (t (let ((default-directory |
| 474 | (if (file-remote-p default-directory) | 474 | (if (tramp-tramp-file-p default-directory) |
| 475 | (tramp-compat-temporary-file-directory) | 475 | (tramp-compat-temporary-file-directory) |
| 476 | default-directory)) | 476 | default-directory)) |
| 477 | (unix95 (getenv "UNIX95")) | 477 | (unix95 (getenv "UNIX95")) |
diff --git a/lisp/net/tramp-ftp.el b/lisp/net/tramp-ftp.el index 9e1be06a2b1..19475783a3c 100644 --- a/lisp/net/tramp-ftp.el +++ b/lisp/net/tramp-ftp.el | |||
| @@ -172,7 +172,7 @@ pass to the OPERATION." | |||
| 172 | ;; We must copy it locally first, because there is no place in | 172 | ;; We must copy it locally first, because there is no place in |
| 173 | ;; ange-ftp for correct handling. | 173 | ;; ange-ftp for correct handling. |
| 174 | ((and (memq operation '(copy-file rename-file)) | 174 | ((and (memq operation '(copy-file rename-file)) |
| 175 | (file-remote-p (cadr args)) | 175 | (tramp-tramp-file-p (cadr args)) |
| 176 | (not (tramp-ftp-file-name-p (cadr args)))) | 176 | (not (tramp-ftp-file-name-p (cadr args)))) |
| 177 | (let* ((filename (car args)) | 177 | (let* ((filename (car args)) |
| 178 | (newname (cadr args)) | 178 | (newname (cadr args)) |
diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el index d4b7a89ce35..eb2a20d183d 100644 --- a/lisp/net/tramp-gvfs.el +++ b/lisp/net/tramp-gvfs.el | |||
| @@ -630,7 +630,7 @@ is no information where to trace the message.") | |||
| 630 | nil v 'file-error | 630 | nil v 'file-error |
| 631 | "Copying failed, see buffer `%s' for details." (buffer-name))))) | 631 | "Copying failed, see buffer `%s' for details." (buffer-name))))) |
| 632 | 632 | ||
| 633 | (when (file-remote-p newname) | 633 | (when (tramp-tramp-file-p newname) |
| 634 | (with-parsed-tramp-file-name newname nil | 634 | (with-parsed-tramp-file-name newname nil |
| 635 | (tramp-flush-file-property v (file-name-directory localname)) | 635 | (tramp-flush-file-property v (file-name-directory localname)) |
| 636 | (tramp-flush-file-property v localname)))))) | 636 | (tramp-flush-file-property v localname)))))) |
| @@ -938,6 +938,9 @@ is no information where to trace the message.") | |||
| 938 | (if (not (processp p)) | 938 | (if (not (processp p)) |
| 939 | (tramp-error | 939 | (tramp-error |
| 940 | v 'file-notify-error "gvfs-monitor-file failed to start") | 940 | v 'file-notify-error "gvfs-monitor-file failed to start") |
| 941 | (tramp-message | ||
| 942 | v 6 "Run `%s', %S" (mapconcat 'identity (process-command p) " ") p) | ||
| 943 | (tramp-set-connection-property p "vector" v) | ||
| 941 | (tramp-compat-set-process-query-on-exit-flag p nil) | 944 | (tramp-compat-set-process-query-on-exit-flag p nil) |
| 942 | (set-process-filter p 'tramp-gvfs-file-gvfs-monitor-file-process-filter) | 945 | (set-process-filter p 'tramp-gvfs-file-gvfs-monitor-file-process-filter) |
| 943 | (with-current-buffer (process-buffer p) | 946 | (with-current-buffer (process-buffer p) |
| @@ -1061,12 +1064,12 @@ is no information where to trace the message.") | |||
| 1061 | nil v 'file-error | 1064 | nil v 'file-error |
| 1062 | "Renaming failed, see buffer `%s' for details." (buffer-name))))) | 1065 | "Renaming failed, see buffer `%s' for details." (buffer-name))))) |
| 1063 | 1066 | ||
| 1064 | (when (file-remote-p filename) | 1067 | (when (tramp-tramp-file-p filename) |
| 1065 | (with-parsed-tramp-file-name filename nil | 1068 | (with-parsed-tramp-file-name filename nil |
| 1066 | (tramp-flush-file-property v (file-name-directory localname)) | 1069 | (tramp-flush-file-property v (file-name-directory localname)) |
| 1067 | (tramp-flush-file-property v localname))) | 1070 | (tramp-flush-file-property v localname))) |
| 1068 | 1071 | ||
| 1069 | (when (file-remote-p newname) | 1072 | (when (tramp-tramp-file-p newname) |
| 1070 | (with-parsed-tramp-file-name newname nil | 1073 | (with-parsed-tramp-file-name newname nil |
| 1071 | (tramp-flush-file-property v (file-name-directory localname)) | 1074 | (tramp-flush-file-property v (file-name-directory localname)) |
| 1072 | (tramp-flush-file-property v localname)))))) | 1075 | (tramp-flush-file-property v localname)))))) |
diff --git a/lisp/net/tramp-gw.el b/lisp/net/tramp-gw.el index e2c7461228f..2f50cda7383 100644 --- a/lisp/net/tramp-gw.el +++ b/lisp/net/tramp-gw.el | |||
| @@ -96,7 +96,7 @@ | |||
| 96 | (unless (memq (process-status proc) '(run open)) | 96 | (unless (memq (process-status proc) '(run open)) |
| 97 | (tramp-message | 97 | (tramp-message |
| 98 | tramp-gw-vector 4 "Deleting auxiliary process `%s'" tramp-gw-gw-proc) | 98 | tramp-gw-vector 4 "Deleting auxiliary process `%s'" tramp-gw-gw-proc) |
| 99 | (let* (tramp-verbose | 99 | (let* ((tramp-verbose 0) |
| 100 | (p (tramp-get-connection-property proc "process" nil))) | 100 | (p (tramp-get-connection-property proc "process" nil))) |
| 101 | (when (processp p) (delete-process p))))) | 101 | (when (processp p) (delete-process p))))) |
| 102 | 102 | ||
| @@ -111,7 +111,7 @@ | |||
| 111 | (tramp-compat-set-process-query-on-exit-flag proc nil) | 111 | (tramp-compat-set-process-query-on-exit-flag proc nil) |
| 112 | ;; We don't want debug messages, because the corresponding debug | 112 | ;; We don't want debug messages, because the corresponding debug |
| 113 | ;; buffer might be undecided. | 113 | ;; buffer might be undecided. |
| 114 | (let (tramp-verbose) | 114 | (let ((tramp-verbose 0)) |
| 115 | (tramp-set-connection-property tramp-gw-gw-proc "process" proc) | 115 | (tramp-set-connection-property tramp-gw-gw-proc "process" proc) |
| 116 | (tramp-set-connection-property proc "process" tramp-gw-gw-proc)) | 116 | (tramp-set-connection-property proc "process" tramp-gw-gw-proc)) |
| 117 | ;; Set the process-filter functions for both processes. | 117 | ;; Set the process-filter functions for both processes. |
| @@ -125,7 +125,7 @@ | |||
| 125 | (tramp-gw-process-filter tramp-gw-gw-proc s)))))) | 125 | (tramp-gw-process-filter tramp-gw-gw-proc s)))))) |
| 126 | 126 | ||
| 127 | (defun tramp-gw-process-filter (proc string) | 127 | (defun tramp-gw-process-filter (proc string) |
| 128 | (let (tramp-verbose) | 128 | (let ((tramp-verbose 0)) |
| 129 | (process-send-string | 129 | (process-send-string |
| 130 | (tramp-get-connection-property proc "process" nil) string))) | 130 | (tramp-get-connection-property proc "process" nil) string))) |
| 131 | 131 | ||
| @@ -245,7 +245,7 @@ authentication is requested from proxy server, provide it." | |||
| 245 | ;; proxies have a timeout of 60". We wait 65" in order to | 245 | ;; proxies have a timeout of 60". We wait 65" in order to |
| 246 | ;; receive an answer this case. | 246 | ;; receive an answer this case. |
| 247 | (ignore-errors | 247 | (ignore-errors |
| 248 | (let (tramp-verbose) | 248 | (let ((tramp-verbose 0)) |
| 249 | (tramp-wait-for-regexp proc 65 "\r?\n\r?\n"))) | 249 | (tramp-wait-for-regexp proc 65 "\r?\n\r?\n"))) |
| 250 | ;; Check return code. | 250 | ;; Check return code. |
| 251 | (goto-char (point-min)) | 251 | (goto-char (point-min)) |
diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 8ed1c592617..147113ba5a1 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el | |||
| @@ -1300,7 +1300,7 @@ of." | |||
| 1300 | 1300 | ||
| 1301 | (defun tramp-sh-handle-set-file-times (filename &optional time) | 1301 | (defun tramp-sh-handle-set-file-times (filename &optional time) |
| 1302 | "Like `set-file-times' for Tramp files." | 1302 | "Like `set-file-times' for Tramp files." |
| 1303 | (if (file-remote-p filename) | 1303 | (if (tramp-tramp-file-p filename) |
| 1304 | (with-parsed-tramp-file-name filename nil | 1304 | (with-parsed-tramp-file-name filename nil |
| 1305 | (tramp-flush-file-property v localname) | 1305 | (tramp-flush-file-property v localname) |
| 1306 | (let ((time (if (or (null time) (equal time '(0 0))) | 1306 | (let ((time (if (or (null time) (equal time '(0 0))) |
| @@ -1339,7 +1339,7 @@ be non-negative integers." | |||
| 1339 | ;; the majority of cases. | 1339 | ;; the majority of cases. |
| 1340 | ;; Don't modify `last-coding-system-used' by accident. | 1340 | ;; Don't modify `last-coding-system-used' by accident. |
| 1341 | (let ((last-coding-system-used last-coding-system-used)) | 1341 | (let ((last-coding-system-used last-coding-system-used)) |
| 1342 | (if (file-remote-p filename) | 1342 | (if (tramp-tramp-file-p filename) |
| 1343 | (with-parsed-tramp-file-name filename nil | 1343 | (with-parsed-tramp-file-name filename nil |
| 1344 | (if (and (zerop (user-uid)) (tramp-local-host-p v)) | 1344 | (if (and (zerop (user-uid)) (tramp-local-host-p v)) |
| 1345 | ;; If we are root on the local host, we can do it directly. | 1345 | ;; If we are root on the local host, we can do it directly. |
| @@ -2323,6 +2323,7 @@ The method used must be an out-of-band method." | |||
| 2323 | (tramp-message | 2323 | (tramp-message |
| 2324 | orig-vec 6 "%s" | 2324 | orig-vec 6 "%s" |
| 2325 | (mapconcat 'identity (process-command p) " ")) | 2325 | (mapconcat 'identity (process-command p) " ")) |
| 2326 | (tramp-set-connection-property p "vector" orig-vec) | ||
| 2326 | (tramp-compat-set-process-query-on-exit-flag p nil) | 2327 | (tramp-compat-set-process-query-on-exit-flag p nil) |
| 2327 | (tramp-process-actions | 2328 | (tramp-process-actions |
| 2328 | p v nil tramp-actions-copy-out-of-band) | 2329 | p v nil tramp-actions-copy-out-of-band) |
| @@ -2333,7 +2334,8 @@ The method used must be an out-of-band method." | |||
| 2333 | (re-search-backward "tramp_exit_status [0-9]+" nil t) | 2334 | (re-search-backward "tramp_exit_status [0-9]+" nil t) |
| 2334 | (tramp-error | 2335 | (tramp-error |
| 2335 | orig-vec 'file-error | 2336 | orig-vec 'file-error |
| 2336 | "Couldn't find exit status of `%s'" (process-command p))) | 2337 | "Couldn't find exit status of `%s'" |
| 2338 | (mapconcat 'identity (process-command p) " "))) | ||
| 2337 | (skip-chars-forward "^ ") | 2339 | (skip-chars-forward "^ ") |
| 2338 | (unless (zerop (read (current-buffer))) | 2340 | (unless (zerop (read (current-buffer))) |
| 2339 | (forward-line -1) | 2341 | (forward-line -1) |
| @@ -3342,14 +3344,12 @@ Fall back to normal file name handler if no Tramp handler exists." | |||
| 3342 | (setq file-name (expand-file-name file-name)) | 3344 | (setq file-name (expand-file-name file-name)) |
| 3343 | (with-parsed-tramp-file-name file-name nil | 3345 | (with-parsed-tramp-file-name file-name nil |
| 3344 | (let* ((default-directory (file-name-directory file-name)) | 3346 | (let* ((default-directory (file-name-directory file-name)) |
| 3345 | command events filter p) | 3347 | command events filter p sequence) |
| 3346 | (cond | 3348 | (cond |
| 3347 | ;; gvfs-monitor-dir. | 3349 | ;; gvfs-monitor-dir. |
| 3348 | ((setq command (tramp-get-remote-gvfs-monitor-dir v)) | 3350 | ((setq command (tramp-get-remote-gvfs-monitor-dir v)) |
| 3349 | (setq filter 'tramp-sh-file-gvfs-monitor-dir-process-filter | 3351 | (setq filter 'tramp-sh-file-gvfs-monitor-dir-process-filter |
| 3350 | p (start-file-process | 3352 | sequence `(,command ,localname))) |
| 3351 | "gvfs-monitor-dir" (generate-new-buffer " *gvfs-monitor-dir*") | ||
| 3352 | command localname))) | ||
| 3353 | ;; inotifywait. | 3353 | ;; inotifywait. |
| 3354 | ((setq command (tramp-get-remote-inotifywait v)) | 3354 | ((setq command (tramp-get-remote-inotifywait v)) |
| 3355 | (setq filter 'tramp-sh-file-inotifywait-process-filter | 3355 | (setq filter 'tramp-sh-file-inotifywait-process-filter |
| @@ -3359,18 +3359,27 @@ Fall back to normal file name handler if no Tramp handler exists." | |||
| 3359 | "create,modify,move,delete,attrib") | 3359 | "create,modify,move,delete,attrib") |
| 3360 | ((memq 'change flags) "create,modify,move,delete") | 3360 | ((memq 'change flags) "create,modify,move,delete") |
| 3361 | ((memq 'attribute-change flags) "attrib")) | 3361 | ((memq 'attribute-change flags) "attrib")) |
| 3362 | p (start-file-process | 3362 | sequence `(,command "-mq" "-e" ,events ,localname))) |
| 3363 | "inotifywait" (generate-new-buffer " *inotifywait*") | ||
| 3364 | command "-mq" "-e" events localname))) | ||
| 3365 | ;; None. | 3363 | ;; None. |
| 3366 | (t (tramp-error | 3364 | (t (tramp-error |
| 3367 | v 'file-notify-error | 3365 | v 'file-notify-error |
| 3368 | "No file notification program found on %s" | 3366 | "No file notification program found on %s" |
| 3369 | (file-remote-p file-name)))) | 3367 | (file-remote-p file-name)))) |
| 3368 | ;; Start process. | ||
| 3369 | (setq p (apply | ||
| 3370 | 'start-file-process | ||
| 3371 | (file-name-nondirectory command) | ||
| 3372 | (generate-new-buffer | ||
| 3373 | (format " *%s*" (file-name-nondirectory command))) | ||
| 3374 | sequence)) | ||
| 3370 | ;; Return the process object as watch-descriptor. | 3375 | ;; Return the process object as watch-descriptor. |
| 3371 | (if (not (processp p)) | 3376 | (if (not (processp p)) |
| 3372 | (tramp-error | 3377 | (tramp-error |
| 3373 | v 'file-notify-error "`%s' failed to start on remote host" command) | 3378 | v 'file-notify-error |
| 3379 | "`%s' failed to start on remote host" | ||
| 3380 | (mapconcat 'identity sequence " ")) | ||
| 3381 | (tramp-message v 6 "Run `%s', %S" (mapconcat 'identity sequence " ") p) | ||
| 3382 | (tramp-set-connection-property p "vector" v) | ||
| 3374 | (tramp-compat-set-process-query-on-exit-flag p nil) | 3383 | (tramp-compat-set-process-query-on-exit-flag p nil) |
| 3375 | (set-process-filter p filter) | 3384 | (set-process-filter p filter) |
| 3376 | p)))) | 3385 | p)))) |
| @@ -4333,10 +4342,6 @@ connection if a previous connection has died for some reason." | |||
| 4333 | (condition-case err | 4342 | (condition-case err |
| 4334 | (unless (and p (processp p) (memq (process-status p) '(run open))) | 4343 | (unless (and p (processp p) (memq (process-status p) '(run open))) |
| 4335 | 4344 | ||
| 4336 | ;; We call `tramp-get-buffer' in order to get a debug buffer | ||
| 4337 | ;; for messages from the beginning. | ||
| 4338 | (tramp-get-buffer vec) | ||
| 4339 | |||
| 4340 | ;; If `non-essential' is non-nil, don't reopen a new connection. | 4345 | ;; If `non-essential' is non-nil, don't reopen a new connection. |
| 4341 | (when (and (boundp 'non-essential) (symbol-value 'non-essential)) | 4346 | (when (and (boundp 'non-essential) (symbol-value 'non-essential)) |
| 4342 | (throw 'non-essential 'non-essential)) | 4347 | (throw 'non-essential 'non-essential)) |
diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el index 1daf19b47ac..4270ad1671c 100644 --- a/lisp/net/tramp-smb.el +++ b/lisp/net/tramp-smb.el | |||
| @@ -187,11 +187,21 @@ This list is used for tar-like copy of directories. | |||
| 187 | 187 | ||
| 188 | See `tramp-actions-before-shell' for more info.") | 188 | See `tramp-actions-before-shell' for more info.") |
| 189 | 189 | ||
| 190 | (defconst tramp-smb-actions-with-acl | 190 | (defconst tramp-smb-actions-get-acl |
| 191 | '((tramp-password-prompt-regexp tramp-action-password) | 191 | '((tramp-password-prompt-regexp tramp-action-password) |
| 192 | (tramp-wrong-passwd-regexp tramp-action-permission-denied) | 192 | (tramp-wrong-passwd-regexp tramp-action-permission-denied) |
| 193 | (tramp-smb-errors tramp-action-permission-denied) | 193 | (tramp-smb-errors tramp-action-permission-denied) |
| 194 | (tramp-process-alive-regexp tramp-smb-action-with-acl)) | 194 | (tramp-process-alive-regexp tramp-smb-action-get-acl)) |
| 195 | "List of pattern/action pairs. | ||
| 196 | This list is used for smbcacls actions. | ||
| 197 | |||
| 198 | See `tramp-actions-before-shell' for more info.") | ||
| 199 | |||
| 200 | (defconst tramp-smb-actions-set-acl | ||
| 201 | '((tramp-password-prompt-regexp tramp-action-password) | ||
| 202 | (tramp-wrong-passwd-regexp tramp-action-permission-denied) | ||
| 203 | (tramp-smb-errors tramp-action-permission-denied) | ||
| 204 | (tramp-process-alive-regexp tramp-smb-action-set-acl)) | ||
| 195 | "List of pattern/action pairs. | 205 | "List of pattern/action pairs. |
| 196 | This list is used for smbcacls actions. | 206 | This list is used for smbcacls actions. |
| 197 | 207 | ||
| @@ -481,6 +491,7 @@ pass to the OPERATION." | |||
| 481 | 491 | ||
| 482 | (tramp-message | 492 | (tramp-message |
| 483 | v 6 "%s" (mapconcat 'identity (process-command p) " ")) | 493 | v 6 "%s" (mapconcat 'identity (process-command p) " ")) |
| 494 | (tramp-set-connection-property p "vector" v) | ||
| 484 | (tramp-compat-set-process-query-on-exit-flag p nil) | 495 | (tramp-compat-set-process-query-on-exit-flag p nil) |
| 485 | (tramp-process-actions p v nil tramp-smb-actions-with-tar) | 496 | (tramp-process-actions p v nil tramp-smb-actions-with-tar) |
| 486 | 497 | ||
| @@ -521,7 +532,8 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." | |||
| 521 | (setq filename (expand-file-name filename) | 532 | (setq filename (expand-file-name filename) |
| 522 | newname (expand-file-name newname)) | 533 | newname (expand-file-name newname)) |
| 523 | (with-tramp-progress-reporter | 534 | (with-tramp-progress-reporter |
| 524 | (tramp-dissect-file-name (if (file-remote-p filename) filename newname)) | 535 | (tramp-dissect-file-name |
| 536 | (if (tramp-tramp-file-p filename) filename newname)) | ||
| 525 | 0 (format "Copying %s to %s" filename newname) | 537 | 0 (format "Copying %s to %s" filename newname) |
| 526 | 538 | ||
| 527 | (if (file-directory-p filename) | 539 | (if (file-directory-p filename) |
| @@ -667,7 +679,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." | |||
| 667 | method user host | 679 | method user host |
| 668 | (tramp-run-real-handler 'expand-file-name (list localname)))))) | 680 | (tramp-run-real-handler 'expand-file-name (list localname)))))) |
| 669 | 681 | ||
| 670 | (defun tramp-smb-action-with-acl (proc vec) | 682 | (defun tramp-smb-action-get-acl (proc vec) |
| 671 | "Read ACL data from connection buffer." | 683 | "Read ACL data from connection buffer." |
| 672 | (when (not (memq (process-status proc) '(run open))) | 684 | (when (not (memq (process-status proc) '(run open))) |
| 673 | ;; Accept pending output. | 685 | ;; Accept pending output. |
| @@ -734,9 +746,9 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." | |||
| 734 | 746 | ||
| 735 | (tramp-message | 747 | (tramp-message |
| 736 | v 6 "%s" (mapconcat 'identity (process-command p) " ")) | 748 | v 6 "%s" (mapconcat 'identity (process-command p) " ")) |
| 749 | (tramp-set-connection-property p "vector" v) | ||
| 737 | (tramp-compat-set-process-query-on-exit-flag p nil) | 750 | (tramp-compat-set-process-query-on-exit-flag p nil) |
| 738 | (tramp-process-actions p v nil tramp-smb-actions-with-acl) | 751 | (tramp-process-actions p v nil tramp-smb-actions-get-acl) |
| 739 | (tramp-message v 6 "\n%s" (buffer-string)) | ||
| 740 | (when (> (point-max) (point-min)) | 752 | (when (> (point-max) (point-min)) |
| 741 | (tramp-compat-funcall | 753 | (tramp-compat-funcall |
| 742 | 'substring-no-properties (buffer-string))))) | 754 | 'substring-no-properties (buffer-string))))) |
| @@ -1225,11 +1237,12 @@ target of the symlink differ." | |||
| 1225 | (file-exists-p newname)) | 1237 | (file-exists-p newname)) |
| 1226 | (tramp-error | 1238 | (tramp-error |
| 1227 | (tramp-dissect-file-name | 1239 | (tramp-dissect-file-name |
| 1228 | (if (file-remote-p filename) filename newname)) | 1240 | (if (tramp-tramp-file-p filename) filename newname)) |
| 1229 | 'file-already-exists newname)) | 1241 | 'file-already-exists newname)) |
| 1230 | 1242 | ||
| 1231 | (with-tramp-progress-reporter | 1243 | (with-tramp-progress-reporter |
| 1232 | (tramp-dissect-file-name (if (file-remote-p filename) filename newname)) | 1244 | (tramp-dissect-file-name |
| 1245 | (if (tramp-tramp-file-p filename) filename newname)) | ||
| 1233 | 0 (format "Renaming %s to %s" filename newname) | 1246 | 0 (format "Renaming %s to %s" filename newname) |
| 1234 | 1247 | ||
| 1235 | (if (and (not (file-exists-p newname)) | 1248 | (if (and (not (file-exists-p newname)) |
| @@ -1260,67 +1273,85 @@ target of the symlink differ." | |||
| 1260 | (tramp-compat-delete-directory filename 'recursive) | 1273 | (tramp-compat-delete-directory filename 'recursive) |
| 1261 | (delete-file filename))))) | 1274 | (delete-file filename))))) |
| 1262 | 1275 | ||
| 1276 | (defun tramp-smb-action-set-acl (proc vec) | ||
| 1277 | "Read ACL data from connection buffer." | ||
| 1278 | (when (not (memq (process-status proc) '(run open))) | ||
| 1279 | ;; Accept pending output. | ||
| 1280 | (while (tramp-accept-process-output proc 0.1)) | ||
| 1281 | (with-current-buffer (tramp-get-connection-buffer vec) | ||
| 1282 | (tramp-message vec 10 "\n%s" (buffer-string)) | ||
| 1283 | (throw 'tramp-action 'ok)))) | ||
| 1284 | |||
| 1263 | (defun tramp-smb-handle-set-file-acl (filename acl-string) | 1285 | (defun tramp-smb-handle-set-file-acl (filename acl-string) |
| 1264 | "Like `set-file-acl' for Tramp files." | 1286 | "Like `set-file-acl' for Tramp files." |
| 1265 | (with-parsed-tramp-file-name filename nil | 1287 | (ignore-errors |
| 1266 | (when (and (stringp acl-string) (executable-find tramp-smb-acl-program)) | 1288 | (with-parsed-tramp-file-name filename nil |
| 1267 | 1289 | (when (and (stringp acl-string) (executable-find tramp-smb-acl-program)) | |
| 1268 | (setq tramp-current-method (tramp-file-name-method v) | 1290 | (setq tramp-current-method (tramp-file-name-method v) |
| 1269 | tramp-current-user (tramp-file-name-user v) | 1291 | tramp-current-user (tramp-file-name-user v) |
| 1270 | tramp-current-host (tramp-file-name-real-host v)) | 1292 | tramp-current-host (tramp-file-name-real-host v)) |
| 1271 | (tramp-set-file-property v localname "file-acl" 'undef) | 1293 | (tramp-set-file-property v localname "file-acl" 'undef) |
| 1272 | |||
| 1273 | (let* ((real-user (tramp-file-name-real-user v)) | ||
| 1274 | (real-host (tramp-file-name-real-host v)) | ||
| 1275 | (domain (tramp-file-name-domain v)) | ||
| 1276 | (port (tramp-file-name-port v)) | ||
| 1277 | (share (tramp-smb-get-share v)) | ||
| 1278 | (localname (tramp-compat-replace-regexp-in-string | ||
| 1279 | "\\\\" "/" (tramp-smb-get-localname v))) | ||
| 1280 | (args (list (concat "//" real-host "/" share) "-E" "-S" | ||
| 1281 | (tramp-compat-replace-regexp-in-string | ||
| 1282 | "\n" "," acl-string)))) | ||
| 1283 | |||
| 1284 | (if (not (zerop (length real-user))) | ||
| 1285 | (setq args (append args (list "-U" real-user))) | ||
| 1286 | (setq args (append args (list "-N")))) | ||
| 1287 | |||
| 1288 | (when domain (setq args (append args (list "-W" domain)))) | ||
| 1289 | (when port (setq args (append args (list "-p" port)))) | ||
| 1290 | (when tramp-smb-conf | ||
| 1291 | (setq args (append args (list "-s" tramp-smb-conf)))) | ||
| 1292 | (setq | ||
| 1293 | args | ||
| 1294 | (append args (list (shell-quote-argument localname) "2>/dev/null"))) | ||
| 1295 | 1294 | ||
| 1296 | (unwind-protect | 1295 | (let* ((real-user (tramp-file-name-real-user v)) |
| 1297 | (with-temp-buffer | 1296 | (real-host (tramp-file-name-real-host v)) |
| 1298 | ;; Set the transfer process properties. | 1297 | (domain (tramp-file-name-domain v)) |
| 1299 | (tramp-set-connection-property | 1298 | (port (tramp-file-name-port v)) |
| 1300 | v "process-name" (buffer-name (current-buffer))) | 1299 | (share (tramp-smb-get-share v)) |
| 1301 | (tramp-set-connection-property | 1300 | (localname (tramp-compat-replace-regexp-in-string |
| 1302 | v "process-buffer" (current-buffer)) | 1301 | "\\\\" "/" (tramp-smb-get-localname v))) |
| 1303 | 1302 | (args (list (concat "//" real-host "/" share) "-E" "-S" | |
| 1304 | ;; Use an asynchronous processes. By this, password can | 1303 | (tramp-compat-replace-regexp-in-string |
| 1305 | ;; be handled. | 1304 | "\n" "," acl-string)))) |
| 1306 | (let ((p (apply | 1305 | |
| 1307 | 'start-process | 1306 | (if (not (zerop (length real-user))) |
| 1308 | (tramp-get-connection-name v) | 1307 | (setq args (append args (list "-U" real-user))) |
| 1309 | (tramp-get-connection-buffer v) | 1308 | (setq args (append args (list "-N")))) |
| 1310 | tramp-smb-acl-program args))) | 1309 | |
| 1311 | 1310 | (when domain (setq args (append args (list "-W" domain)))) | |
| 1312 | (tramp-message | 1311 | (when port (setq args (append args (list "-p" port)))) |
| 1313 | v 6 "%s" (mapconcat 'identity (process-command p) " ")) | 1312 | (when tramp-smb-conf |
| 1314 | (tramp-compat-set-process-query-on-exit-flag p nil) | 1313 | (setq args (append args (list "-s" tramp-smb-conf)))) |
| 1315 | (tramp-process-actions p v nil tramp-smb-actions-with-acl) | 1314 | (setq |
| 1316 | (tramp-message v 6 "\n%s" (buffer-string)) | 1315 | args |
| 1317 | ;; Success. | 1316 | (append args (list (shell-quote-argument localname) |
| 1318 | (tramp-set-file-property v localname "file-acl" acl-string) | 1317 | "&&" "echo" "tramp_exit_status" "0" |
| 1319 | t)) | 1318 | "||" "echo" "tramp_exit_status" "1"))) |
| 1320 | 1319 | ||
| 1321 | ;; Reset the transfer process properties. | 1320 | (unwind-protect |
| 1322 | (tramp-set-connection-property v "process-name" nil) | 1321 | (with-temp-buffer |
| 1323 | (tramp-set-connection-property v "process-buffer" nil)))))) | 1322 | ;; Set the transfer process properties. |
| 1323 | (tramp-set-connection-property | ||
| 1324 | v "process-name" (buffer-name (current-buffer))) | ||
| 1325 | (tramp-set-connection-property | ||
| 1326 | v "process-buffer" (current-buffer)) | ||
| 1327 | |||
| 1328 | ;; Use an asynchronous processes. By this, password can | ||
| 1329 | ;; be handled. | ||
| 1330 | (let ((p (apply | ||
| 1331 | 'start-process-shell-command | ||
| 1332 | (tramp-get-connection-name v) | ||
| 1333 | (tramp-get-connection-buffer v) | ||
| 1334 | tramp-smb-acl-program args))) | ||
| 1335 | |||
| 1336 | (tramp-message | ||
| 1337 | v 6 "%s" (mapconcat 'identity (process-command p) " ")) | ||
| 1338 | (tramp-set-connection-property p "vector" v) | ||
| 1339 | (tramp-compat-set-process-query-on-exit-flag p nil) | ||
| 1340 | (tramp-process-actions p v nil tramp-smb-actions-set-acl) | ||
| 1341 | (goto-char (point-max)) | ||
| 1342 | (unless (re-search-backward "tramp_exit_status [0-9]+" nil t) | ||
| 1343 | (tramp-error | ||
| 1344 | v 'file-error | ||
| 1345 | "Couldn't find exit status of `%s'" tramp-smb-acl-program)) | ||
| 1346 | (skip-chars-forward "^ ") | ||
| 1347 | (when (zerop (read (current-buffer))) | ||
| 1348 | ;; Success. | ||
| 1349 | (tramp-set-file-property v localname "file-acl" acl-string) | ||
| 1350 | t))) | ||
| 1351 | |||
| 1352 | ;; Reset the transfer process properties. | ||
| 1353 | (tramp-set-connection-property v "process-name" nil) | ||
| 1354 | (tramp-set-connection-property v "process-buffer" nil))))))) | ||
| 1324 | 1355 | ||
| 1325 | (defun tramp-smb-handle-set-file-modes (filename mode) | 1356 | (defun tramp-smb-handle-set-file-modes (filename mode) |
| 1326 | "Like `set-file-modes' for Tramp files." | 1357 | "Like `set-file-modes' for Tramp files." |
| @@ -1819,6 +1850,7 @@ If ARGUMENT is non-nil, use it as argument for | |||
| 1819 | 1850 | ||
| 1820 | (tramp-message | 1851 | (tramp-message |
| 1821 | vec 6 "%s" (mapconcat 'identity (process-command p) " ")) | 1852 | vec 6 "%s" (mapconcat 'identity (process-command p) " ")) |
| 1853 | (tramp-set-connection-property p "vector" vec) | ||
| 1822 | (tramp-compat-set-process-query-on-exit-flag p nil) | 1854 | (tramp-compat-set-process-query-on-exit-flag p nil) |
| 1823 | 1855 | ||
| 1824 | ;; Set variables for computing the prompt for reading password. | 1856 | ;; Set variables for computing the prompt for reading password. |
| @@ -1936,10 +1968,6 @@ Returns nil if an error message has appeared." | |||
| 1936 | (defun tramp-smb-call-winexe (vec) | 1968 | (defun tramp-smb-call-winexe (vec) |
| 1937 | "Apply a remote command, if possible, using `tramp-smb-winexe-program'." | 1969 | "Apply a remote command, if possible, using `tramp-smb-winexe-program'." |
| 1938 | 1970 | ||
| 1939 | ;; We call `tramp-get-buffer' in order to get a debug buffer for | ||
| 1940 | ;; messages. | ||
| 1941 | (tramp-get-buffer vec) | ||
| 1942 | |||
| 1943 | ;; Check for program. | 1971 | ;; Check for program. |
| 1944 | (unless (executable-find tramp-smb-winexe-program) | 1972 | (unless (executable-find tramp-smb-winexe-program) |
| 1945 | (tramp-error | 1973 | (tramp-error |
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index c5d728ba5c7..2cbaf4a1636 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el | |||
| @@ -1433,67 +1433,65 @@ The outline level is equal to the verbosity of the Tramp message." | |||
| 1433 | "Append message to debug buffer. | 1433 | "Append message to debug buffer. |
| 1434 | Message is formatted with FMT-STRING as control string and the remaining | 1434 | Message is formatted with FMT-STRING as control string and the remaining |
| 1435 | ARGUMENTS to actually emit the message (if applicable)." | 1435 | ARGUMENTS to actually emit the message (if applicable)." |
| 1436 | (when (get-buffer (tramp-buffer-name vec)) | 1436 | (with-current-buffer (tramp-get-debug-buffer vec) |
| 1437 | (with-current-buffer (tramp-get-debug-buffer vec) | 1437 | (goto-char (point-max)) |
| 1438 | (goto-char (point-max)) | 1438 | ;; Headline. |
| 1439 | ;; Headline. | 1439 | (when (bobp) |
| 1440 | (when (bobp) | 1440 | (insert |
| 1441 | (insert | 1441 | (format |
| 1442 | (format | 1442 | ";; %sEmacs: %s Tramp: %s -*- mode: outline; -*-" |
| 1443 | ";; %sEmacs: %s Tramp: %s -*- mode: outline; -*-" | 1443 | (if (featurep 'sxemacs) "SX" (if (featurep 'xemacs) "X" "GNU ")) |
| 1444 | (if (featurep 'sxemacs) "SX" (if (featurep 'xemacs) "X" "GNU ")) | 1444 | emacs-version tramp-version))) |
| 1445 | emacs-version tramp-version))) | 1445 | (unless (bolp) |
| 1446 | (unless (bolp) | 1446 | (insert "\n")) |
| 1447 | (insert "\n")) | 1447 | ;; Timestamp. |
| 1448 | ;; Timestamp. | 1448 | (let ((now (current-time))) |
| 1449 | (let ((now (current-time))) | 1449 | (insert (format-time-string "%T." now)) |
| 1450 | (insert (format-time-string "%T." now)) | 1450 | (insert (format "%06d " (nth 2 now)))) |
| 1451 | (insert (format "%06d " (nth 2 now)))) | 1451 | ;; Calling Tramp function. We suppress compat and trace functions |
| 1452 | ;; Calling Tramp function. We suppress compat and trace | 1452 | ;; from being displayed. |
| 1453 | ;; functions from being displayed. | 1453 | (let ((btn 1) btf fn) |
| 1454 | (let ((btn 1) btf fn) | 1454 | (while (not fn) |
| 1455 | (while (not fn) | 1455 | (setq btf (nth 1 (backtrace-frame btn))) |
| 1456 | (setq btf (nth 1 (backtrace-frame btn))) | 1456 | (if (not btf) |
| 1457 | (if (not btf) | 1457 | (setq fn "") |
| 1458 | (setq fn "") | 1458 | (when (symbolp btf) |
| 1459 | (when (symbolp btf) | 1459 | (setq fn (symbol-name btf)) |
| 1460 | (setq fn (symbol-name btf)) | 1460 | (unless |
| 1461 | (unless | 1461 | (and |
| 1462 | (and | 1462 | (string-match "^tramp" fn) |
| 1463 | (string-match "^tramp" fn) | 1463 | (not |
| 1464 | (not | 1464 | (string-match |
| 1465 | (string-match | 1465 | (concat |
| 1466 | (concat | 1466 | "^" |
| 1467 | "^" | 1467 | (regexp-opt |
| 1468 | (regexp-opt | 1468 | '("tramp-backtrace" |
| 1469 | '("tramp-backtrace" | 1469 | "tramp-compat-condition-case-unless-debug" |
| 1470 | "tramp-compat-condition-case-unless-debug" | 1470 | "tramp-compat-funcall" |
| 1471 | "tramp-compat-funcall" | 1471 | "tramp-compat-with-temp-message" |
| 1472 | "tramp-compat-with-temp-message" | 1472 | "tramp-condition-case-unless-debug" |
| 1473 | "tramp-condition-case-unless-debug" | 1473 | "tramp-debug-message" |
| 1474 | "tramp-debug-message" | 1474 | "tramp-error" |
| 1475 | "tramp-error" | 1475 | "tramp-error-with-buffer" |
| 1476 | "tramp-error-with-buffer" | 1476 | "tramp-message" |
| 1477 | "tramp-message" | 1477 | "tramp-user-error") |
| 1478 | "tramp-user-error") | 1478 | t) |
| 1479 | t) | 1479 | "$") |
| 1480 | "$") | 1480 | fn))) |
| 1481 | fn))) | 1481 | (setq fn nil))) |
| 1482 | (setq fn nil))) | 1482 | (setq btn (1+ btn)))) |
| 1483 | (setq btn (1+ btn)))) | 1483 | ;; The following code inserts filename and line number. Should |
| 1484 | ;; The following code inserts filename and line number. | 1484 | ;; be inactive by default, because it is time consuming. |
| 1485 | ;; Should be inactive by default, because it is time | 1485 | ; (let ((ffn (find-function-noselect (intern fn)))) |
| 1486 | ;; consuming. | 1486 | ; (insert |
| 1487 | ; (let ((ffn (find-function-noselect (intern fn)))) | 1487 | ; (format |
| 1488 | ; (insert | 1488 | ; "%s:%d: " |
| 1489 | ; (format | 1489 | ; (file-name-nondirectory (buffer-file-name (car ffn))) |
| 1490 | ; "%s:%d: " | 1490 | ; (with-current-buffer (car ffn) |
| 1491 | ; (file-name-nondirectory (buffer-file-name (car ffn))) | 1491 | ; (1+ (count-lines (point-min) (cdr ffn))))))) |
| 1492 | ; (with-current-buffer (car ffn) | 1492 | (insert (format "%s " fn))) |
| 1493 | ; (1+ (count-lines (point-min) (cdr ffn))))))) | 1493 | ;; The message. |
| 1494 | (insert (format "%s " fn))) | 1494 | (insert (apply 'format fmt-string arguments)))) |
| 1495 | ;; The message. | ||
| 1496 | (insert (apply 'format fmt-string arguments))))) | ||
| 1497 | 1495 | ||
| 1498 | (defvar tramp-message-show-message t | 1496 | (defvar tramp-message-show-message t |
| 1499 | "Show Tramp message in the minibuffer. | 1497 | "Show Tramp message in the minibuffer. |
| @@ -1530,13 +1528,13 @@ applicable)." | |||
| 1530 | arguments)) | 1528 | arguments)) |
| 1531 | ;; Log only when there is a minimum level. | 1529 | ;; Log only when there is a minimum level. |
| 1532 | (when (>= tramp-verbose 4) | 1530 | (when (>= tramp-verbose 4) |
| 1533 | (when (and vec-or-proc | 1531 | ;; Translate proc to vec. |
| 1534 | (processp vec-or-proc) | 1532 | (when (processp vec-or-proc) |
| 1535 | (buffer-name (process-buffer vec-or-proc))) | 1533 | (let ((tramp-verbose 0)) |
| 1536 | (with-current-buffer (process-buffer vec-or-proc) | 1534 | (setq vec-or-proc |
| 1537 | ;; Translate proc to vec. | 1535 | (tramp-get-connection-property vec-or-proc "vector" nil)))) |
| 1538 | (setq vec-or-proc (tramp-dissect-file-name default-directory)))) | 1536 | ;; Do it. |
| 1539 | (when (and vec-or-proc (vectorp vec-or-proc)) | 1537 | (when (vectorp vec-or-proc) |
| 1540 | (apply 'tramp-debug-message | 1538 | (apply 'tramp-debug-message |
| 1541 | vec-or-proc | 1539 | vec-or-proc |
| 1542 | (concat (format "(%d) # " level) fmt-string) | 1540 | (concat (format "(%d) # " level) fmt-string) |
| @@ -1548,7 +1546,7 @@ If VEC-OR-PROC is nil, the buffer *debug tramp* is used. This | |||
| 1548 | function is meant for debugging purposes." | 1546 | function is meant for debugging purposes." |
| 1549 | (if vec-or-proc | 1547 | (if vec-or-proc |
| 1550 | (tramp-message vec-or-proc 10 "\n%s" (with-output-to-string (backtrace))) | 1548 | (tramp-message vec-or-proc 10 "\n%s" (with-output-to-string (backtrace))) |
| 1551 | (if (<= 10 tramp-verbose) | 1549 | (if (>= tramp-verbose 10) |
| 1552 | (with-output-to-temp-buffer "*debug tramp*" (backtrace))))) | 1550 | (with-output-to-temp-buffer "*debug tramp*" (backtrace))))) |
| 1553 | 1551 | ||
| 1554 | (defsubst tramp-error (vec-or-proc signal fmt-string &rest arguments) | 1552 | (defsubst tramp-error (vec-or-proc signal fmt-string &rest arguments) |
| @@ -1821,7 +1819,7 @@ been set up by `rfn-eshadow-setup-minibuffer'." | |||
| 1821 | ;; We do not want to send any remote command. | 1819 | ;; We do not want to send any remote command. |
| 1822 | (non-essential t)) | 1820 | (non-essential t)) |
| 1823 | (when | 1821 | (when |
| 1824 | (file-remote-p | 1822 | (tramp-tramp-file-p |
| 1825 | (tramp-compat-funcall | 1823 | (tramp-compat-funcall |
| 1826 | 'buffer-substring-no-properties end (point-max))) | 1824 | 'buffer-substring-no-properties end (point-max))) |
| 1827 | (save-excursion | 1825 | (save-excursion |
| @@ -2356,7 +2354,8 @@ not in completion mode." | |||
| 2356 | (and (tramp-tramp-file-p filename) | 2354 | (and (tramp-tramp-file-p filename) |
| 2357 | (with-parsed-tramp-file-name filename nil | 2355 | (with-parsed-tramp-file-name filename nil |
| 2358 | (or (not (tramp-completion-mode-p)) | 2356 | (or (not (tramp-completion-mode-p)) |
| 2359 | (let ((p (tramp-get-connection-process v))) | 2357 | (let* ((tramp-verbose 0) |
| 2358 | (p (tramp-get-connection-process v))) | ||
| 2360 | (and p (processp p) (memq (process-status p) '(run open)))))))) | 2359 | (and p (processp p) (memq (process-status p) '(run open)))))))) |
| 2361 | 2360 | ||
| 2362 | ;; Method, host name and user name completion. | 2361 | ;; Method, host name and user name completion. |
| @@ -2934,7 +2933,8 @@ User is always nil." | |||
| 2934 | 2933 | ||
| 2935 | (defun tramp-handle-file-remote-p (filename &optional identification connected) | 2934 | (defun tramp-handle-file-remote-p (filename &optional identification connected) |
| 2936 | "Like `file-remote-p' for Tramp files." | 2935 | "Like `file-remote-p' for Tramp files." |
| 2937 | (let ((tramp-verbose 3)) | 2936 | ;; We do not want traces in the debug buffer. |
| 2937 | (let ((tramp-verbose (min tramp-verbose 3))) | ||
| 2938 | (when (tramp-tramp-file-p filename) | 2938 | (when (tramp-tramp-file-p filename) |
| 2939 | (let* ((v (tramp-dissect-file-name filename)) | 2939 | (let* ((v (tramp-dissect-file-name filename)) |
| 2940 | (p (tramp-get-connection-process v)) | 2940 | (p (tramp-get-connection-process v)) |
| @@ -3663,8 +3663,8 @@ Example: | |||
| 3663 | would yield `t'. On the other hand, the following check results in nil: | 3663 | would yield `t'. On the other hand, the following check results in nil: |
| 3664 | 3664 | ||
| 3665 | (tramp-equal-remote \"/sudo::/etc\" \"/su::/etc\")" | 3665 | (tramp-equal-remote \"/sudo::/etc\" \"/su::/etc\")" |
| 3666 | (and (stringp (file-remote-p file1)) | 3666 | (and (tramp-tramp-file-p file1) |
| 3667 | (stringp (file-remote-p file2)) | 3667 | (tramp-tramp-file-p file2) |
| 3668 | (string-equal (file-remote-p file1) (file-remote-p file2)))) | 3668 | (string-equal (file-remote-p file1) (file-remote-p file2)))) |
| 3669 | 3669 | ||
| 3670 | ;;;###tramp-autoload | 3670 | ;;;###tramp-autoload |
| @@ -4198,7 +4198,7 @@ Only works for Bourne-like shells." | |||
| 4198 | (defun tramp-eshell-directory-change () | 4198 | (defun tramp-eshell-directory-change () |
| 4199 | "Set `eshell-path-env' to $PATH of the host related to `default-directory'." | 4199 | "Set `eshell-path-env' to $PATH of the host related to `default-directory'." |
| 4200 | (setq eshell-path-env | 4200 | (setq eshell-path-env |
| 4201 | (if (file-remote-p default-directory) | 4201 | (if (tramp-tramp-file-p default-directory) |
| 4202 | (with-parsed-tramp-file-name default-directory nil | 4202 | (with-parsed-tramp-file-name default-directory nil |
| 4203 | (mapconcat | 4203 | (mapconcat |
| 4204 | 'identity | 4204 | 'identity |