Commit 8a798e41 authored by Michael Albinus's avatar Michael Albinus
Browse files

* 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.
parent e3ea58b7
...@@ -1265,28 +1265,32 @@ updated after changing this variable. ...@@ -1265,28 +1265,32 @@ updated after changing this variable.
Also see `tramp-file-name-structure'.") Also see `tramp-file-name-structure'.")
;;;###autoload ;;;###autoload
(defconst tramp-completion-file-name-regexp-unified (defconst tramp-root-regexp
(if (memq system-type '(cygwin windows-nt)) (if (memq system-type '(cygwin windows-nt))
"^\\([a-zA-Z]:\\)?/$\\|^\\([a-zA-Z]:\\)?/[^/:][^/]*$" "^/$\\|^\\([a-zA-Z]:\\)?\\(/\\|\\\\\\(\\\\\\)?\\)"
"^/$\\|^/[^/:][^/]*$") "^/$\\|^/")
"Beginning of an incomplete Tramp file name.
Usually, it is just \"^/\". On W32 systems, there might be a
volume letter, which will be removed by `tramp-drop-volume-letter'.
It could be either \"^x:/\", either \"^x:\\\\\".")
;;;###autoload
(defconst tramp-completion-file-name-regexp-unified
(concat tramp-root-regexp "[^/]*$")
"Value for `tramp-completion-file-name-regexp' for unified remoting. "Value for `tramp-completion-file-name-regexp' for unified remoting.
Emacs (not XEmacs) uses a unified filename syntax for Ange-FTP and GNU Emacs uses a unified filename syntax for Tramp and Ange-FTP.
Tramp. See `tramp-file-name-structure' for more explanations.") See `tramp-file-name-structure' for more explanations.")
;;;###autoload ;;;###autoload
(defconst tramp-completion-file-name-regexp-separate (defconst tramp-completion-file-name-regexp-separate
(if (memq system-type '(cygwin windows-nt)) (concat tramp-root-regexp "[[][^]]*$")
"^\\([a-zA-Z]:\\)?/\\([[][^]]*\\)?$"
"^/\\([[][^]]*\\)?$")
"Value for `tramp-completion-file-name-regexp' for separate remoting. "Value for `tramp-completion-file-name-regexp' for separate remoting.
XEmacs uses a separate filename syntax for Tramp and EFS. XEmacs uses a separate filename syntax for Tramp and EFS.
See `tramp-file-name-structure' for more explanations.") See `tramp-file-name-structure' for more explanations.")
;;;###autoload ;;;###autoload
(defconst tramp-completion-file-name-regexp-url (defconst tramp-completion-file-name-regexp-url
(if (memq system-type '(cygwin windows-nt)) (concat tramp-root-regexp "[^/:]+\\(:\\(/\\(/[^/]*\\)?\\)?\\)?$")
"^\\([a-zA-Z]:\\)?/$\\|^\\([a-zA-Z]:\\)?/[^/:]+\\(:\\(/\\(/[^/]*\\)?\\)?\\)?$"
"^/$\\|^/[^/:]+\\(:\\(/\\(/[^/]*\\)?\\)?\\)?$")
"Value for `tramp-completion-file-name-regexp' for URL-like remoting. "Value for `tramp-completion-file-name-regexp' for URL-like remoting.
See `tramp-file-name-structure' for more explanations.") See `tramp-file-name-structure' for more explanations.")
...@@ -3051,23 +3055,24 @@ and `rename'. FILENAME and NEWNAME must be absolute file names." ...@@ -3051,23 +3055,24 @@ and `rename'. FILENAME and NEWNAME must be absolute file names."
First arg OP is either `copy' or `rename' and indicates the operation. First arg OP is either `copy' or `rename' and indicates the operation.
FILENAME is the source file, NEWNAME the target file. FILENAME is the source file, NEWNAME the target file.
KEEP-DATE is non-nil if NEWNAME should have the same timestamp as FILENAME." KEEP-DATE is non-nil if NEWNAME should have the same timestamp as FILENAME."
(let ((modtime (nth 5 (file-attributes filename)))) (with-temp-buffer
(unwind-protect ;; We must disable multibyte, because binary data shall not be
(with-temp-buffer ;; converted.
(let ((coding-system-for-read 'binary)) (set-buffer-multibyte nil)
(insert-file-contents-literally filename)) (let ((coding-system-for-read 'binary)
;; We don't want the target file to be compressed, so we (jka-compr-inhibit t))
;; let-bind `jka-compr-inhibit' to t. (insert-file-contents-literally filename))
(let ((coding-system-for-write 'binary) ;; We don't want the target file to be compressed, so we let-bind
(jka-compr-inhibit t)) ;; `jka-compr-inhibit' to t.
(write-region (point-min) (point-max) newname)))) (let ((coding-system-for-write 'binary)
;; KEEP-DATE handling. (jka-compr-inhibit t))
(when keep-date (set-file-times newname modtime)) (write-region (point-min) (point-max) newname)))
;; Set the mode. ;; KEEP-DATE handling.
(set-file-modes newname (file-modes filename)) (when keep-date (set-file-times newname (nth 5 (file-attributes filename))))
;; If the operation was `rename', delete the original file. ;; Set the mode.
(unless (eq op 'copy) (set-file-modes newname (file-modes filename))
(delete-file filename)))) ;; If the operation was `rename', delete the original file.
(unless (eq op 'copy) (delete-file filename)))
(defun tramp-do-copy-or-rename-file-directly (defun tramp-do-copy-or-rename-file-directly
(op filename newname ok-if-already-exists keep-date preserve-uid-gid) (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,13 +3490,15 @@ This is like `dired-recursive-delete-directory' for Tramp files."
(with-current-buffer (tramp-get-buffer v) (with-current-buffer (tramp-get-buffer v)
(buffer-string)))))) (buffer-string))))))
;; CCC is this the right thing to do?
(defun tramp-handle-unhandled-file-name-directory (filename) (defun tramp-handle-unhandled-file-name-directory (filename)
"Like `unhandled-file-name-directory' for Tramp files." "Like `unhandled-file-name-directory' for Tramp files."
;; With Emacs 23, we could simply return `nil'. But we must keep it
;; for backward compatibility.
(expand-file-name "~/")) (expand-file-name "~/"))
;; Canonicalization of file names. ;; Canonicalization of file names.
;;;###autoload
(defun tramp-drop-volume-letter (name) (defun tramp-drop-volume-letter (name)
"Cut off unnecessary drive letter from file NAME. "Cut off unnecessary drive letter from file NAME.
The function `tramp-handle-expand-file-name' calls `expand-file-name' 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,13 +3507,10 @@ but the remote system is Unix, this introduces a superfluous drive
letter into the file name. This function removes it. letter into the file name. This function removes it.
Doesn't do anything if the NAME does not start with a drive letter." Doesn't do anything if the NAME does not start with a drive letter."
(if (and (> (length name) 1) (save-match-data
(char-equal (aref name 1) ?:) (if (and (stringp name) (string-match tramp-root-regexp name))
(let ((c1 (aref name 0))) (replace-match "/" nil nil name)
(or (and (>= c1 ?A) (<= c1 ?Z)) name)))
(and (>= c1 ?a) (<= c1 ?z)))))
(substring name 2)
name))
(defun tramp-handle-expand-file-name (name &optional dir) (defun tramp-handle-expand-file-name (name &optional dir)
"Like `expand-file-name' for Tramp files. "Like `expand-file-name' for Tramp files.
...@@ -4488,21 +4492,26 @@ Fall back to normal file name handler if no Tramp handler exists." ...@@ -4488,21 +4492,26 @@ Fall back to normal file name handler if no Tramp handler exists."
(tramp-run-real-handler operation args)))))) (tramp-run-real-handler operation args))))))
(setq tramp-locked tl)))) (setq tramp-locked tl))))
;;;###autoload
(defconst tramp-completion-file-name-handler-post-function
(if (and (featurep 'xemacs) (memq system-type '(cygwin windows-nt)))
'tramp-drop-volume-letter
'identity)
"Function to be called on the result of `tramp-completion-file-name-handler'.
For GNU Emacs, handling of `file-name-all-completions' and
`file-name-completion' is sufficient. In the XEmacs case, there
are more disturbing drive letters.")
;;;###autoload ;;;###autoload
(progn (defun tramp-completion-file-name-handler (operation &rest args) (progn (defun tramp-completion-file-name-handler (operation &rest args)
"Invoke Tramp file name completion handler. "Invoke Tramp file name completion handler.
Falls back to normal file name handler if no Tramp file name handler exists." Falls back to normal file name handler if no Tramp file name handler exists."
;; (setq edebug-trace t) (funcall
;; (edebug-trace "%s" (with-output-to-string (backtrace))) tramp-completion-file-name-handler-post-function
(let ((fn (assoc operation tramp-completion-file-name-handler-alist)))
;; (mapcar 'trace-function-background (if fn
;; (mapcar 'intern (save-match-data (apply (cdr fn) args))
;; (all-completions "tramp-" obarray 'functionp))) (tramp-completion-run-real-handler operation args))))))
(let ((fn (assoc operation tramp-completion-file-name-handler-alist)))
(if fn
(save-match-data (apply (cdr fn) args))
(tramp-completion-run-real-handler operation args)))))
;;;###autoload ;;;###autoload
(defsubst tramp-register-file-name-handler () (defsubst tramp-register-file-name-handler ()
...@@ -5652,8 +5661,8 @@ seconds. If not, it produces an error message with the given ERROR-ARGS." ...@@ -5652,8 +5661,8 @@ seconds. If not, it produces an error message with the given ERROR-ARGS."
(when (memq (process-status proc) '(stop exit signal)) (when (memq (process-status proc) '(stop exit signal))
(tramp-flush-connection-property proc) (tramp-flush-connection-property proc)
;; The "Connection closed" and "exit" messages disturb the output ;; The "Connection closed" and "exit" messages disturb the output
;; for asynchronous processes. That's why we have echoed the Tramp ;; for asynchronous processes. That's why we have echoed the
;; prompt at the end. Trailing messages can be removed. ;; Tramp prompt at the end. Trailing messages can be removed.
(let ((buf (process-buffer proc))) (let ((buf (process-buffer proc)))
(when (buffer-live-p buf) (when (buffer-live-p buf)
(with-current-buffer buf (with-current-buffer buf
...@@ -6149,8 +6158,8 @@ connection if a previous connection has died for some reason." ...@@ -6149,8 +6158,8 @@ connection if a previous connection has died for some reason."
;; The error will be catched locally. ;; The error will be catched locally.
(tramp-error vec 'file-error "Awake did fail"))) (tramp-error vec 'file-error "Awake did fail")))
(file-error (file-error
(tramp-flush-connection-property vec nil) (tramp-flush-connection-property vec)
(tramp-flush-connection-property p nil) (tramp-flush-connection-property p)
(delete-process p) (delete-process p)
(setq p nil))) (setq p nil)))
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment