aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorMichael Albinus2008-03-15 21:54:02 +0000
committerMichael Albinus2008-03-15 21:54:02 +0000
commit8a798e4193f7c571c393f26b0d0159bc5b1e3311 (patch)
treea791450da0046eef7cd09da4892e6e8dac350638
parente3ea58b7ea4bde720c47d1d04ca06c1e935ba7e2 (diff)
downloademacs-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.el111
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.
1265Also see `tramp-file-name-structure'.") 1265Also 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.
1273Usually, it is just \"^/\". On W32 systems, there might be a
1274volume letter, which will be removed by `tramp-drop-volume-letter'.
1275It 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.
1273Emacs (not XEmacs) uses a unified filename syntax for Ange-FTP and 1281GNU Emacs uses a unified filename syntax for Tramp and Ange-FTP.
1274Tramp. See `tramp-file-name-structure' for more explanations.") 1282See `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.
1282XEmacs uses a separate filename syntax for Tramp and EFS. 1288XEmacs uses a separate filename syntax for Tramp and EFS.
1283See `tramp-file-name-structure' for more explanations.") 1289See `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.
1291See `tramp-file-name-structure' for more explanations.") 1295See `tramp-file-name-structure' for more explanations.")
1292 1296
@@ -3051,23 +3055,24 @@ and `rename'. FILENAME and NEWNAME must be absolute file names."
3051First arg OP is either `copy' or `rename' and indicates the operation. 3055First arg OP is either `copy' or `rename' and indicates the operation.
3052FILENAME is the source file, NEWNAME the target file. 3056FILENAME is the source file, NEWNAME the target file.
3053KEEP-DATE is non-nil if NEWNAME should have the same timestamp as FILENAME." 3057KEEP-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.
3497The function `tramp-handle-expand-file-name' calls `expand-file-name' 3504The 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
3500letter into the file name. This function removes it. 3507letter into the file name. This function removes it.
3501 3508
3502Doesn't do anything if the NAME does not start with a drive letter." 3509Doesn'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'.
4501For GNU Emacs, handling of `file-name-all-completions' and
4502`file-name-completion' is sufficient. In the XEmacs case, there
4503are 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.
4494Falls back to normal file name handler if no Tramp file name handler exists." 4508Falls 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