diff options
| author | Michael Albinus | 2008-03-15 21:54:02 +0000 |
|---|---|---|
| committer | Michael Albinus | 2008-03-15 21:54:02 +0000 |
| commit | 8a798e4193f7c571c393f26b0d0159bc5b1e3311 (patch) | |
| tree | a791450da0046eef7cd09da4892e6e8dac350638 | |
| parent | e3ea58b7ea4bde720c47d1d04ca06c1e935ba7e2 (diff) | |
| download | emacs-8a798e4193f7c571c393f26b0d0159bc5b1e3311.tar.gz emacs-8a798e4193f7c571c393f26b0d0159bc5b1e3311.zip | |
* tramp.el (tramp-root-regexp): New defconst.
(tramp-completion-file-name-regexp-unified)
(tramp-completion-file-name-regexp-separate)
(tramp-completion-file-name-regexp-url): Use it.
(tramp-do-copy-or-rename-file-via-buffer): Set
`enable-multibyte-characters' to nil. Set `jka-compr-inhibit' to
t for `insert-file-contents-literally'.
(tramp-drop-volume-letter): Rewrite, using `tramp-root-regexp'.
Autoload it.
(tramp-completion-file-name-handler-post-function): New defconst.
(tramp-completion-file-name-handler): Use it.
(tramp-maybe-open-connection): Update calls to
`tramp-flush-connection-property' for removed 2nd argument.
| -rw-r--r-- | lisp/net/tramp.el | 111 |
1 files changed, 60 insertions, 51 deletions
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index e2df6ae99c8..e0bb3244e1b 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el | |||
| @@ -1265,28 +1265,32 @@ updated after changing this variable. | |||
| 1265 | Also see `tramp-file-name-structure'.") | 1265 | Also see `tramp-file-name-structure'.") |
| 1266 | 1266 | ||
| 1267 | ;;;###autoload | 1267 | ;;;###autoload |
| 1268 | (defconst tramp-completion-file-name-regexp-unified | 1268 | (defconst tramp-root-regexp |
| 1269 | (if (memq system-type '(cygwin windows-nt)) | 1269 | (if (memq system-type '(cygwin windows-nt)) |
| 1270 | "^\\([a-zA-Z]:\\)?/$\\|^\\([a-zA-Z]:\\)?/[^/:][^/]*$" | 1270 | "^/$\\|^\\([a-zA-Z]:\\)?\\(/\\|\\\\\\(\\\\\\)?\\)" |
| 1271 | "^/$\\|^/[^/:][^/]*$") | 1271 | "^/$\\|^/") |
| 1272 | "Beginning of an incomplete Tramp file name. | ||
| 1273 | Usually, it is just \"^/\". On W32 systems, there might be a | ||
| 1274 | volume letter, which will be removed by `tramp-drop-volume-letter'. | ||
| 1275 | It could be either \"^x:/\", either \"^x:\\\\\".") | ||
| 1276 | |||
| 1277 | ;;;###autoload | ||
| 1278 | (defconst tramp-completion-file-name-regexp-unified | ||
| 1279 | (concat tramp-root-regexp "[^/]*$") | ||
| 1272 | "Value for `tramp-completion-file-name-regexp' for unified remoting. | 1280 | "Value for `tramp-completion-file-name-regexp' for unified remoting. |
| 1273 | Emacs (not XEmacs) uses a unified filename syntax for Ange-FTP and | 1281 | GNU Emacs uses a unified filename syntax for Tramp and Ange-FTP. |
| 1274 | Tramp. See `tramp-file-name-structure' for more explanations.") | 1282 | See `tramp-file-name-structure' for more explanations.") |
| 1275 | 1283 | ||
| 1276 | ;;;###autoload | 1284 | ;;;###autoload |
| 1277 | (defconst tramp-completion-file-name-regexp-separate | 1285 | (defconst tramp-completion-file-name-regexp-separate |
| 1278 | (if (memq system-type '(cygwin windows-nt)) | 1286 | (concat tramp-root-regexp "[[][^]]*$") |
| 1279 | "^\\([a-zA-Z]:\\)?/\\([[][^]]*\\)?$" | ||
| 1280 | "^/\\([[][^]]*\\)?$") | ||
| 1281 | "Value for `tramp-completion-file-name-regexp' for separate remoting. | 1287 | "Value for `tramp-completion-file-name-regexp' for separate remoting. |
| 1282 | XEmacs uses a separate filename syntax for Tramp and EFS. | 1288 | XEmacs uses a separate filename syntax for Tramp and EFS. |
| 1283 | See `tramp-file-name-structure' for more explanations.") | 1289 | See `tramp-file-name-structure' for more explanations.") |
| 1284 | 1290 | ||
| 1285 | ;;;###autoload | 1291 | ;;;###autoload |
| 1286 | (defconst tramp-completion-file-name-regexp-url | 1292 | (defconst tramp-completion-file-name-regexp-url |
| 1287 | (if (memq system-type '(cygwin windows-nt)) | 1293 | (concat tramp-root-regexp "[^/:]+\\(:\\(/\\(/[^/]*\\)?\\)?\\)?$") |
| 1288 | "^\\([a-zA-Z]:\\)?/$\\|^\\([a-zA-Z]:\\)?/[^/:]+\\(:\\(/\\(/[^/]*\\)?\\)?\\)?$" | ||
| 1289 | "^/$\\|^/[^/:]+\\(:\\(/\\(/[^/]*\\)?\\)?\\)?$") | ||
| 1290 | "Value for `tramp-completion-file-name-regexp' for URL-like remoting. | 1294 | "Value for `tramp-completion-file-name-regexp' for URL-like remoting. |
| 1291 | See `tramp-file-name-structure' for more explanations.") | 1295 | See `tramp-file-name-structure' for more explanations.") |
| 1292 | 1296 | ||
| @@ -3051,23 +3055,24 @@ and `rename'. FILENAME and NEWNAME must be absolute file names." | |||
| 3051 | First arg OP is either `copy' or `rename' and indicates the operation. | 3055 | First arg OP is either `copy' or `rename' and indicates the operation. |
| 3052 | FILENAME is the source file, NEWNAME the target file. | 3056 | FILENAME is the source file, NEWNAME the target file. |
| 3053 | KEEP-DATE is non-nil if NEWNAME should have the same timestamp as FILENAME." | 3057 | KEEP-DATE is non-nil if NEWNAME should have the same timestamp as FILENAME." |
| 3054 | (let ((modtime (nth 5 (file-attributes filename)))) | 3058 | (with-temp-buffer |
| 3055 | (unwind-protect | 3059 | ;; We must disable multibyte, because binary data shall not be |
| 3056 | (with-temp-buffer | 3060 | ;; converted. |
| 3057 | (let ((coding-system-for-read 'binary)) | 3061 | (set-buffer-multibyte nil) |
| 3058 | (insert-file-contents-literally filename)) | 3062 | (let ((coding-system-for-read 'binary) |
| 3059 | ;; We don't want the target file to be compressed, so we | 3063 | (jka-compr-inhibit t)) |
| 3060 | ;; let-bind `jka-compr-inhibit' to t. | 3064 | (insert-file-contents-literally filename)) |
| 3061 | (let ((coding-system-for-write 'binary) | 3065 | ;; We don't want the target file to be compressed, so we let-bind |
| 3062 | (jka-compr-inhibit t)) | 3066 | ;; `jka-compr-inhibit' to t. |
| 3063 | (write-region (point-min) (point-max) newname)))) | 3067 | (let ((coding-system-for-write 'binary) |
| 3064 | ;; KEEP-DATE handling. | 3068 | (jka-compr-inhibit t)) |
| 3065 | (when keep-date (set-file-times newname modtime)) | 3069 | (write-region (point-min) (point-max) newname))) |
| 3066 | ;; Set the mode. | 3070 | ;; KEEP-DATE handling. |
| 3067 | (set-file-modes newname (file-modes filename)) | 3071 | (when keep-date (set-file-times newname (nth 5 (file-attributes filename)))) |
| 3068 | ;; If the operation was `rename', delete the original file. | 3072 | ;; Set the mode. |
| 3069 | (unless (eq op 'copy) | 3073 | (set-file-modes newname (file-modes filename)) |
| 3070 | (delete-file filename)))) | 3074 | ;; If the operation was `rename', delete the original file. |
| 3075 | (unless (eq op 'copy) (delete-file filename))) | ||
| 3071 | 3076 | ||
| 3072 | (defun tramp-do-copy-or-rename-file-directly | 3077 | (defun tramp-do-copy-or-rename-file-directly |
| 3073 | (op filename newname ok-if-already-exists keep-date preserve-uid-gid) | 3078 | (op filename newname ok-if-already-exists keep-date preserve-uid-gid) |
| @@ -3485,13 +3490,15 @@ This is like `dired-recursive-delete-directory' for Tramp files." | |||
| 3485 | (with-current-buffer (tramp-get-buffer v) | 3490 | (with-current-buffer (tramp-get-buffer v) |
| 3486 | (buffer-string)))))) | 3491 | (buffer-string)))))) |
| 3487 | 3492 | ||
| 3488 | ;; CCC is this the right thing to do? | ||
| 3489 | (defun tramp-handle-unhandled-file-name-directory (filename) | 3493 | (defun tramp-handle-unhandled-file-name-directory (filename) |
| 3490 | "Like `unhandled-file-name-directory' for Tramp files." | 3494 | "Like `unhandled-file-name-directory' for Tramp files." |
| 3495 | ;; With Emacs 23, we could simply return `nil'. But we must keep it | ||
| 3496 | ;; for backward compatibility. | ||
| 3491 | (expand-file-name "~/")) | 3497 | (expand-file-name "~/")) |
| 3492 | 3498 | ||
| 3493 | ;; Canonicalization of file names. | 3499 | ;; Canonicalization of file names. |
| 3494 | 3500 | ||
| 3501 | ;;;###autoload | ||
| 3495 | (defun tramp-drop-volume-letter (name) | 3502 | (defun tramp-drop-volume-letter (name) |
| 3496 | "Cut off unnecessary drive letter from file NAME. | 3503 | "Cut off unnecessary drive letter from file NAME. |
| 3497 | The function `tramp-handle-expand-file-name' calls `expand-file-name' | 3504 | The function `tramp-handle-expand-file-name' calls `expand-file-name' |
| @@ -3500,13 +3507,10 @@ but the remote system is Unix, this introduces a superfluous drive | |||
| 3500 | letter into the file name. This function removes it. | 3507 | letter into the file name. This function removes it. |
| 3501 | 3508 | ||
| 3502 | Doesn't do anything if the NAME does not start with a drive letter." | 3509 | Doesn't do anything if the NAME does not start with a drive letter." |
| 3503 | (if (and (> (length name) 1) | 3510 | (save-match-data |
| 3504 | (char-equal (aref name 1) ?:) | 3511 | (if (and (stringp name) (string-match tramp-root-regexp name)) |
| 3505 | (let ((c1 (aref name 0))) | 3512 | (replace-match "/" nil nil name) |
| 3506 | (or (and (>= c1 ?A) (<= c1 ?Z)) | 3513 | name))) |
| 3507 | (and (>= c1 ?a) (<= c1 ?z))))) | ||
| 3508 | (substring name 2) | ||
| 3509 | name)) | ||
| 3510 | 3514 | ||
| 3511 | (defun tramp-handle-expand-file-name (name &optional dir) | 3515 | (defun tramp-handle-expand-file-name (name &optional dir) |
| 3512 | "Like `expand-file-name' for Tramp files. | 3516 | "Like `expand-file-name' for Tramp files. |
| @@ -4489,20 +4493,25 @@ Fall back to normal file name handler if no Tramp handler exists." | |||
| 4489 | (setq tramp-locked tl)))) | 4493 | (setq tramp-locked tl)))) |
| 4490 | 4494 | ||
| 4491 | ;;;###autoload | 4495 | ;;;###autoload |
| 4496 | (defconst tramp-completion-file-name-handler-post-function | ||
| 4497 | (if (and (featurep 'xemacs) (memq system-type '(cygwin windows-nt))) | ||
| 4498 | 'tramp-drop-volume-letter | ||
| 4499 | 'identity) | ||
| 4500 | "Function to be called on the result of `tramp-completion-file-name-handler'. | ||
| 4501 | For GNU Emacs, handling of `file-name-all-completions' and | ||
| 4502 | `file-name-completion' is sufficient. In the XEmacs case, there | ||
| 4503 | are more disturbing drive letters.") | ||
| 4504 | |||
| 4505 | ;;;###autoload | ||
| 4492 | (progn (defun tramp-completion-file-name-handler (operation &rest args) | 4506 | (progn (defun tramp-completion-file-name-handler (operation &rest args) |
| 4493 | "Invoke Tramp file name completion handler. | 4507 | "Invoke Tramp file name completion handler. |
| 4494 | Falls back to normal file name handler if no Tramp file name handler exists." | 4508 | Falls back to normal file name handler if no Tramp file name handler exists." |
| 4495 | ;; (setq edebug-trace t) | 4509 | (funcall |
| 4496 | ;; (edebug-trace "%s" (with-output-to-string (backtrace))) | 4510 | tramp-completion-file-name-handler-post-function |
| 4497 | 4511 | (let ((fn (assoc operation tramp-completion-file-name-handler-alist))) | |
| 4498 | ;; (mapcar 'trace-function-background | 4512 | (if fn |
| 4499 | ;; (mapcar 'intern | 4513 | (save-match-data (apply (cdr fn) args)) |
| 4500 | ;; (all-completions "tramp-" obarray 'functionp))) | 4514 | (tramp-completion-run-real-handler operation args)))))) |
| 4501 | |||
| 4502 | (let ((fn (assoc operation tramp-completion-file-name-handler-alist))) | ||
| 4503 | (if fn | ||
| 4504 | (save-match-data (apply (cdr fn) args)) | ||
| 4505 | (tramp-completion-run-real-handler operation args))))) | ||
| 4506 | 4515 | ||
| 4507 | ;;;###autoload | 4516 | ;;;###autoload |
| 4508 | (defsubst tramp-register-file-name-handler () | 4517 | (defsubst tramp-register-file-name-handler () |
| @@ -5652,8 +5661,8 @@ seconds. If not, it produces an error message with the given ERROR-ARGS." | |||
| 5652 | (when (memq (process-status proc) '(stop exit signal)) | 5661 | (when (memq (process-status proc) '(stop exit signal)) |
| 5653 | (tramp-flush-connection-property proc) | 5662 | (tramp-flush-connection-property proc) |
| 5654 | ;; The "Connection closed" and "exit" messages disturb the output | 5663 | ;; The "Connection closed" and "exit" messages disturb the output |
| 5655 | ;; for asynchronous processes. That's why we have echoed the Tramp | 5664 | ;; for asynchronous processes. That's why we have echoed the |
| 5656 | ;; prompt at the end. Trailing messages can be removed. | 5665 | ;; Tramp prompt at the end. Trailing messages can be removed. |
| 5657 | (let ((buf (process-buffer proc))) | 5666 | (let ((buf (process-buffer proc))) |
| 5658 | (when (buffer-live-p buf) | 5667 | (when (buffer-live-p buf) |
| 5659 | (with-current-buffer buf | 5668 | (with-current-buffer buf |
| @@ -6149,8 +6158,8 @@ connection if a previous connection has died for some reason." | |||
| 6149 | ;; The error will be catched locally. | 6158 | ;; The error will be catched locally. |
| 6150 | (tramp-error vec 'file-error "Awake did fail"))) | 6159 | (tramp-error vec 'file-error "Awake did fail"))) |
| 6151 | (file-error | 6160 | (file-error |
| 6152 | (tramp-flush-connection-property vec nil) | 6161 | (tramp-flush-connection-property vec) |
| 6153 | (tramp-flush-connection-property p nil) | 6162 | (tramp-flush-connection-property p) |
| 6154 | (delete-process p) | 6163 | (delete-process p) |
| 6155 | (setq p nil))) | 6164 | (setq p nil))) |
| 6156 | 6165 | ||