comparison lisp/net/tramp.el @ 92982:afa7a7913261

* 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.

92981:9ee1ca8ab653

updated after changing this variable.

Also see `tramp-file-name-structure'.")

;;;###autoload
(defconst tramp-completion-file-name-regexp-unified
  (if (memq system-type '(cygwin windows-nt))
      "^\\([a-zA-Z]:\\)?/$\\|^\\([a-zA-Z]:\\)?/[^/:][^/]*$"
    "^/$\\|^/[^/:][^/]*$")
  "Value for `tramp-completion-file-name-regexp' for unified remoting.
Emacs (not XEmacs) uses a unified filename syntax for Ange-FTP and
Tramp.  See `tramp-file-name-structure' for more explanations.")

;;;###autoload
(defconst tramp-completion-file-name-regexp-separate
  (if (memq system-type '(cygwin windows-nt))
      "^\\([a-zA-Z]:\\)?/\\([[][^]]*\\)?$"
    "^/\\([[][^]]*\\)?$")
  "Value for `tramp-completion-file-name-regexp' for separate remoting.
XEmacs uses a separate filename syntax for Tramp and EFS.
See `tramp-file-name-structure' for more explanations.")

;;;###autoload
(defconst tramp-completion-file-name-regexp-url
  (if (memq system-type '(cygwin windows-nt))
      "^\\([a-zA-Z]:\\)?/$\\|^\\([a-zA-Z]:\\)?/[^/:]+\\(:\\(/\\(/[^/]*\\)?\\)?\\)?$"
    "^/$\\|^/[^/:]+\\(:\\(/\\(/[^/]*\\)?\\)?\\)?$")
  "Value for `tramp-completion-file-name-regexp' for URL-like remoting.
See `tramp-file-name-structure' for more explanations.")

;;;###autoload
(defconst tramp-completion-file-name-regexp

(defun tramp-do-copy-or-rename-file-via-buffer (op filename newname keep-date)
  "Use an Emacs buffer to copy or rename a file.
First arg OP is either `copy' or `rename' and indicates the operation.
FILENAME is the source file, NEWNAME the target file.
KEEP-DATE is non-nil if NEWNAME should have the same timestamp as FILENAME."
  (let ((modtime (nth 5 (file-attributes filename))))
    (unwind-protect
	(with-temp-buffer
	  (let ((coding-system-for-read 'binary))
	    (insert-file-contents-literally filename))
	  ;; We don't want the target file to be compressed, so we
	  ;; let-bind `jka-compr-inhibit' to t.
	  (let ((coding-system-for-write 'binary)
		(jka-compr-inhibit t))
	    (write-region (point-min) (point-max) newname))))
    ;; KEEP-DATE handling.
    (when keep-date (set-file-times newname modtime))
    ;; Set the mode.
    (set-file-modes newname (file-modes 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
 (op filename newname ok-if-already-exists keep-date preserve-uid-gid)
  "Invokes `cp' or `mv' on the remote system.
OP must be one of `copy' or `rename', indicating `cp' or `mv',

      ;; `expand-file' and alike.
      (insert
       (with-current-buffer (tramp-get-buffer v)
	 (buffer-string))))))

;; CCC is this the right thing to do?
(defun tramp-handle-unhandled-file-name-directory (filename)
  "Like `unhandled-file-name-directory' for Tramp files."
  (expand-file-name "~/"))

;; Canonicalization of file names.

(defun tramp-drop-volume-letter (name)
  "Cut off unnecessary drive letter from file NAME.
The function `tramp-handle-expand-file-name' calls `expand-file-name'
locally on a remote file name.  When the local system is a W32 system
but the remote system is Unix, this introduces a superfluous drive
letter into the file name.  This function removes it.

Doesn't do anything if the NAME does not start with a drive letter."
  (if (and (> (length name) 1)
           (char-equal (aref name 1) ?:)
           (let ((c1 (aref name 0)))
             (or (and (>= c1 ?A) (<= c1 ?Z))
                 (and (>= c1 ?a) (<= c1 ?z)))))
      (substring name 2)
    name))

(defun tramp-handle-expand-file-name (name &optional dir)
  "Like `expand-file-name' for Tramp files.
If the localname part of the given filename starts with \"/../\" then
the result will be a local, non-Tramp, filename."

		    (apply (cdr fn) args)
		  (tramp-run-real-handler operation args))))))
      (setq tramp-locked tl))))

;;;###autoload
(progn (defun tramp-completion-file-name-handler (operation &rest args)
  "Invoke Tramp file name completion handler.
Falls back to normal file name handler if no Tramp file name handler exists."
;;  (setq edebug-trace t)
;;  (edebug-trace "%s" (with-output-to-string (backtrace)))

;;  (mapcar 'trace-function-background
;;	  (mapcar 'intern
;;		  (all-completions "tramp-" obarray 'functionp)))

  (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
(defsubst tramp-register-file-name-handler ()
  "Add Tramp file name handler to `file-name-handler-alist'."
  ;; Remove autoloaded handler from file name handler alist.  Useful,

(defun tramp-process-sentinel (proc event)
  "Process sentinel for Tramp processes."
  (when (memq (process-status proc) '(stop exit signal))
    (tramp-flush-connection-property proc)
    ;; The "Connection closed" and "exit" messages disturb the output
    ;; for asynchronous processes. That's why we have echoed the Tramp
    ;; prompt at the end.  Trailing messages can be removed.
    (let ((buf (process-buffer proc)))
      (when (buffer-live-p buf)
        (with-current-buffer buf
          (goto-char (point-max))
          (re-search-backward

	  (unless (and (memq (process-status p) '(run open))
		       (tramp-wait-for-output p 10))
	    ;; The error will be catched locally.
	    (tramp-error vec 'file-error "Awake did fail")))
      (file-error
       (tramp-flush-connection-property vec nil)
       (tramp-flush-connection-property p nil)
       (delete-process p)
       (setq p nil)))

    ;; New connection must be opened.
    (unless (and p (processp p) (memq (process-status p) '(run open)))

92982:afa7a7913261

updated after changing this variable.

Also see `tramp-file-name-structure'.")

;;;###autoload
(defconst tramp-root-regexp
  (if (memq system-type '(cygwin windows-nt))
      "^/$\\|^\\([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.
GNU Emacs uses a unified filename syntax for Tramp and Ange-FTP.
See `tramp-file-name-structure' for more explanations.")

;;;###autoload
(defconst tramp-completion-file-name-regexp-separate
  (concat tramp-root-regexp "[[][^]]*$")
  "Value for `tramp-completion-file-name-regexp' for separate remoting.
XEmacs uses a separate filename syntax for Tramp and EFS.
See `tramp-file-name-structure' for more explanations.")

;;;###autoload
(defconst tramp-completion-file-name-regexp-url
  (concat tramp-root-regexp "[^/:]+\\(:\\(/\\(/[^/]*\\)?\\)?\\)?$")
  "Value for `tramp-completion-file-name-regexp' for URL-like remoting.
See `tramp-file-name-structure' for more explanations.")

;;;###autoload
(defconst tramp-completion-file-name-regexp

(defun tramp-do-copy-or-rename-file-via-buffer (op filename newname keep-date)
  "Use an Emacs buffer to copy or rename a file.
First arg OP is either `copy' or `rename' and indicates the operation.
FILENAME is the source file, NEWNAME the target file.
KEEP-DATE is non-nil if NEWNAME should have the same timestamp as FILENAME."
  (with-temp-buffer
    ;; We must disable multibyte, because binary data shall not be
    ;; converted.
    (set-buffer-multibyte nil)
    (let ((coding-system-for-read 'binary)
	  (jka-compr-inhibit t))
      (insert-file-contents-literally filename))
    ;; We don't want the target file to be compressed, so we let-bind
    ;; `jka-compr-inhibit' to t.
    (let ((coding-system-for-write 'binary)
	  (jka-compr-inhibit t))
      (write-region (point-min) (point-max) newname)))
  ;; KEEP-DATE handling.
  (when keep-date (set-file-times newname (nth 5 (file-attributes filename))))
  ;; Set the mode.
  (set-file-modes newname (file-modes 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
 (op filename newname ok-if-already-exists keep-date preserve-uid-gid)
  "Invokes `cp' or `mv' on the remote system.
OP must be one of `copy' or `rename', indicating `cp' or `mv',

      ;; `expand-file' and alike.
      (insert
       (with-current-buffer (tramp-get-buffer v)
	 (buffer-string))))))

(defun tramp-handle-unhandled-file-name-directory (filename)
  "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 "~/"))

;; Canonicalization of file names.

;;;###autoload
(defun tramp-drop-volume-letter (name)
  "Cut off unnecessary drive letter from file NAME.
The function `tramp-handle-expand-file-name' calls `expand-file-name'
locally on a remote file name.  When the local system is a W32 system
but the remote system is Unix, this introduces a superfluous drive
letter into the file name.  This function removes it.

Doesn't do anything if the NAME does not start with a drive letter."
  (save-match-data
    (if (and (stringp name) (string-match tramp-root-regexp name))
	(replace-match "/" nil nil name)
      name)))

(defun tramp-handle-expand-file-name (name &optional dir)
  "Like `expand-file-name' for Tramp files.
If the localname part of the given filename starts with \"/../\" then
the result will be a local, non-Tramp, filename."

		    (apply (cdr fn) args)
		  (tramp-run-real-handler operation args))))))
      (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
(progn (defun tramp-completion-file-name-handler (operation &rest args)
  "Invoke Tramp file name completion handler.
Falls back to normal file name handler if no Tramp file name handler exists."
  (funcall
   tramp-completion-file-name-handler-post-function
   (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
(defsubst tramp-register-file-name-handler ()
  "Add Tramp file name handler to `file-name-handler-alist'."
  ;; Remove autoloaded handler from file name handler alist.  Useful,

(defun tramp-process-sentinel (proc event)
  "Process sentinel for Tramp processes."
  (when (memq (process-status proc) '(stop exit signal))
    (tramp-flush-connection-property proc)
    ;; The "Connection closed" and "exit" messages disturb the output
    ;; for asynchronous processes.  That's why we have echoed the
    ;; Tramp prompt at the end.  Trailing messages can be removed.
    (let ((buf (process-buffer proc)))
      (when (buffer-live-p buf)
        (with-current-buffer buf
          (goto-char (point-max))
          (re-search-backward

	  (unless (and (memq (process-status p) '(run open))
		       (tramp-wait-for-output p 10))
	    ;; The error will be catched locally.
	    (tramp-error vec 'file-error "Awake did fail")))
      (file-error
       (tramp-flush-connection-property vec)
       (tramp-flush-connection-property p)
       (delete-process p)
       (setq p nil)))

    ;; New connection must be opened.
    (unless (and p (processp p) (memq (process-status p) '(run open)))