]> code.delx.au - gnu-emacs/blobdiff - lisp/net/tramp-sh.el
* net/dbus.el (dbus-byte-array-to-string): Accept also byte arrays
[gnu-emacs] / lisp / net / tramp-sh.el
index 4bc836b88d52ca11938cf542084eec022076c358..6beece526fff0e6cac8389c0d3097228d641625f 100644 (file)
@@ -419,7 +419,7 @@ as given in your `~/.profile'."
 
 ;;;###tramp-autoload
 (defcustom tramp-remote-process-environment
-  `("HISTFILE=$HOME/.tramp_history" "HISTSIZE=1" "TMOUT=0" "LC_ALL=C"
+  `("HISTFILE=$HOME/.tramp_history" "HISTSIZE=1" "TMOUT=0" "LC_CTYPE=''"
     ,(format "TERM=%s" tramp-terminal-type)
     "EMACS=t" ;; Deprecated.
     ,(format "INSIDE_EMACS='%s,tramp:%s'" emacs-version tramp-version)
@@ -1300,7 +1300,7 @@ of."
 
 (defun tramp-sh-handle-set-file-times (filename &optional time)
   "Like `set-file-times' for Tramp files."
-  (if (file-remote-p filename)
+  (if (tramp-tramp-file-p filename)
       (with-parsed-tramp-file-name filename nil
        (tramp-flush-file-property v localname)
        (let ((time (if (or (null time) (equal time '(0 0)))
@@ -1339,7 +1339,7 @@ be non-negative integers."
   ;; the majority of cases.
   ;; Don't modify `last-coding-system-used' by accident.
   (let ((last-coding-system-used last-coding-system-used))
-    (if (file-remote-p filename)
+    (if (tramp-tramp-file-p filename)
        (with-parsed-tramp-file-name filename nil
          (if (and (zerop (user-uid)) (tramp-local-host-p v))
              ;; If we are root on the local host, we can do it directly.
@@ -1784,21 +1784,21 @@ tramp-sh-handle-file-name-all-completions: internal error accessing `%s': `%s'"
   (with-parsed-tramp-file-name filename v1
     (with-parsed-tramp-file-name newname v2
       (let ((ln (when v1 (tramp-get-remote-ln v1))))
-       (when (and (not ok-if-already-exists)
+       (when (and (numberp ok-if-already-exists)
                   (file-exists-p newname)
-                  (not (numberp ok-if-already-exists))
-                  (y-or-n-p
+                  (yes-or-no-p
                    (format
                     "File %s already exists; make it a new name anyway? "
                     newname)))
          (tramp-error
-          v2 'file-error
-          "add-name-to-file: file %s already exists" newname))
+          v2 'file-error "add-name-to-file: file %s already exists" newname))
+       (when ok-if-already-exists (setq ln (concat ln " -f")))
        (tramp-flush-file-property v2 (file-name-directory v2-localname))
        (tramp-flush-file-property v2 v2-localname)
        (tramp-barf-unless-okay
         v1
-        (format "%s %s %s" ln (tramp-shell-quote-argument v1-localname)
+        (format "%s %s %s" ln
+                (tramp-shell-quote-argument v1-localname)
                 (tramp-shell-quote-argument v2-localname))
         "error with add-name-to-file, see buffer `%s' for details"
         (buffer-name))))))
@@ -1831,18 +1831,20 @@ tramp-sh-handle-file-name-all-completions: internal error accessing `%s': `%s'"
      'copy-file (list filename newname ok-if-already-exists keep-date)))))
 
 (defun tramp-sh-handle-copy-directory
-  (dirname newname &optional keep-date parents _copy-contents)
+  (dirname newname &optional keep-date parents copy-contents)
   "Like `copy-directory' for Tramp files."
   (let ((t1 (tramp-tramp-file-p dirname))
        (t2 (tramp-tramp-file-p newname)))
     (with-parsed-tramp-file-name (if t1 dirname newname) nil
-      (if (and (tramp-get-method-parameter method 'tramp-copy-recursive)
+      (if (and (not copy-contents)
+              (tramp-get-method-parameter method 'tramp-copy-recursive)
               ;; When DIRNAME and NEWNAME are remote, they must have
               ;; the same method.
               (or (null t1) (null t2)
                   (string-equal
                    (tramp-file-name-method (tramp-dissect-file-name dirname))
-                   (tramp-file-name-method (tramp-dissect-file-name newname)))))
+                   (tramp-file-name-method
+                    (tramp-dissect-file-name newname)))))
          ;; scp or rsync DTRT.
          (progn
            (setq dirname (directory-file-name (expand-file-name dirname))
@@ -1859,7 +1861,10 @@ tramp-sh-handle-file-name-all-completions: internal error accessing `%s': `%s'"
             'copy dirname newname keep-date))
        ;; We must do it file-wise.
        (tramp-run-real-handler
-        'copy-directory (list dirname newname keep-date parents)))
+        'copy-directory
+        (if copy-contents
+            (list dirname newname keep-date parents copy-contents)
+          (list dirname newname keep-date parents))))
 
       ;; When newname did exist, we have wrong cached values.
       (when t2
@@ -1983,14 +1988,14 @@ file names."
        ;; In case of `rename', we must flush the cache of the source file.
        (when (and t1 (eq op 'rename))
          (with-parsed-tramp-file-name filename v1
-           (tramp-flush-file-property v1 (file-name-directory localname))
-           (tramp-flush-file-property v1 localname)))
+           (tramp-flush-file-property v1 (file-name-directory v1-localname))
+           (tramp-flush-file-property v1 v1-localname)))
 
        ;; When newname did exist, we have wrong cached values.
        (when t2
          (with-parsed-tramp-file-name newname v2
-           (tramp-flush-file-property v2 (file-name-directory localname))
-           (tramp-flush-file-property v2 localname)))))))
+           (tramp-flush-file-property v2 (file-name-directory v2-localname))
+           (tramp-flush-file-property v2 v2-localname)))))))
 
 (defun tramp-do-copy-or-rename-file-via-buffer (op filename newname keep-date)
   "Use an Emacs buffer to copy or rename a file.
@@ -2008,7 +2013,7 @@ KEEP-DATE is non-nil if NEWNAME should have the same timestamp as FILENAME."
     ;; `jka-compr-inhibit' to t.
     (let ((coding-system-for-write 'binary)
          (jka-compr-inhibit t))
-      (write-region (point-min) (point-max) newname)))
+      (write-region (point-min) (point-max) newname nil 'no-message)))
   ;; KEEP-DATE handling.
   (when keep-date (set-file-times newname (nth 5 (file-attributes filename))))
   ;; Set the mode.
@@ -2323,6 +2328,7 @@ The method used must be an out-of-band method."
                  (tramp-message
                   orig-vec 6 "%s"
                   (mapconcat 'identity (process-command p) " "))
+                 (tramp-set-connection-property p "vector" orig-vec)
                  (tramp-compat-set-process-query-on-exit-flag p nil)
                  (tramp-process-actions
                   p v nil tramp-actions-copy-out-of-band)
@@ -2333,7 +2339,8 @@ The method used must be an out-of-band method."
                      (re-search-backward "tramp_exit_status [0-9]+" nil t)
                    (tramp-error
                     orig-vec 'file-error
-                    "Couldn't find exit status of `%s'" (process-command p)))
+                    "Couldn't find exit status of `%s'"
+                    (mapconcat 'identity (process-command p) " ")))
                  (skip-chars-forward "^ ")
                  (unless (zerop (read (current-buffer)))
                    (forward-line -1)
@@ -2485,6 +2492,7 @@ This is like `dired-recursive-delete-directory' for Tramp files."
   (filename switches &optional wildcard full-directory-p)
   "Like `insert-directory' for Tramp files."
   (setq filename (expand-file-name filename))
+  (unless switches (setq switches ""))
   (with-parsed-tramp-file-name filename nil
     (if (and (featurep 'ls-lisp)
             (not (symbol-value 'ls-lisp-use-insert-directory-program)))
@@ -2511,13 +2519,10 @@ This is like `dired-recursive-delete-directory' for Tramp files."
        (if full-directory-p "yes" "no"))
       ;; If `full-directory-p', we just say `ls -l FILENAME'.
       ;; Else we chdir to the parent directory, then say `ls -ld BASENAME'.
-      ;; "--dired" returns byte positions.  Therefore, the file names
-      ;; must be encoded, which is guaranteed by "LC_ALL=en_US.utf8
-      ;; LC_CTYPE=''".
       (if full-directory-p
          (tramp-send-command
           v
-          (format "env LC_ALL=en_US.utf8 LC_CTYPE='' %s %s %s 2>/dev/null"
+          (format "%s %s %s 2>/dev/null"
                   (tramp-get-ls-command v)
                   switches
                   (if wildcard
@@ -2533,7 +2538,7 @@ This is like `dired-recursive-delete-directory' for Tramp files."
          (tramp-run-real-handler 'file-name-directory (list localname))))
        (tramp-send-command
         v
-        (format "env LC_ALL=en_US.utf8 LC_CTYPE='' %s %s %s 2>/dev/null"
+        (format "%s %s %s 2>/dev/null"
                 (tramp-get-ls-command v)
                 switches
                 (if (or wildcard
@@ -2544,61 +2549,64 @@ This is like `dired-recursive-delete-directory' for Tramp files."
                   (tramp-shell-quote-argument
                    (tramp-run-real-handler
                     'file-name-nondirectory (list localname)))))))
-      (let ((beg (point)))
-       ;; We cannot use `insert-buffer-substring' because the Tramp
-       ;; buffer changes its contents before insertion due to calling
-       ;; `expand-file' and alike.
-       (insert
-        (with-current-buffer (tramp-get-buffer v)
-          (buffer-string)))
-
-       ;; Check for "--dired" output.
-       (forward-line -2)
-       (when (looking-at "//SUBDIRED//")
-         (forward-line -1))
-       (when (looking-at "//DIRED//\\s-+")
-         (let ((databeg (match-end 0))
-               (end (point-at-eol)))
-           ;; Now read the numeric positions of file names.
-           (goto-char databeg)
-           (while (< (point) end)
-             (let ((start (+ beg (read (current-buffer))))
-                   (end (+ beg (read (current-buffer)))))
-               (if (memq (char-after end) '(?\n ?\ ))
-                   ;; End is followed by \n or by " -> ".
-                   (put-text-property start end 'dired-filename t))))))
-       ;; Remove trailing lines.
-       (goto-char (point-at-bol))
-       (while (looking-at "//")
-         (forward-line 1)
-         (delete-region (match-beginning 0) (point)))
-
-       ;; Some busyboxes are reluctant to discard colors.
-       (unless (string-match "color" (tramp-get-connection-property v "ls" ""))
-         (goto-char beg)
-         (while (re-search-forward tramp-color-escape-sequence-regexp nil t)
-           (replace-match "")))
-
-       ;; Decode the output, it could be multibyte.
-       (decode-coding-region
-        beg (point-max)
-        (or file-name-coding-system
-            (and (boundp 'default-file-name-coding-system)
-                 (symbol-value 'default-file-name-coding-system))))
-
-       ;; The inserted file could be from somewhere else.
-       (when (and (not wildcard) (not full-directory-p))
-         (goto-char (point-max))
-         (when (file-symlink-p filename)
-           (goto-char (search-backward "->" beg 'noerror)))
-         (search-backward
-          (if (zerop (length (file-name-nondirectory filename)))
-              "."
-            (file-name-nondirectory filename))
-          beg 'noerror)
-         (replace-match (file-relative-name filename) t))
 
-       (goto-char (point-max))))))
+      (save-restriction
+       (let ((beg (point)))
+         (narrow-to-region (point) (point))
+         ;; We cannot use `insert-buffer-substring' because the Tramp
+         ;; buffer changes its contents before insertion due to calling
+         ;; `expand-file' and alike.
+         (insert
+          (with-current-buffer (tramp-get-buffer v)
+            (buffer-string)))
+
+         ;; Check for "--dired" output.
+         (forward-line -2)
+         (when (looking-at "//SUBDIRED//")
+           (forward-line -1))
+         (when (looking-at "//DIRED//\\s-+")
+           (let ((databeg (match-end 0))
+                 (end (point-at-eol)))
+             ;; Now read the numeric positions of file names.
+             (goto-char databeg)
+             (while (< (point) end)
+               (let ((start (+ beg (read (current-buffer))))
+                     (end (+ beg (read (current-buffer)))))
+                 (if (memq (char-after end) '(?\n ?\ ))
+                     ;; End is followed by \n or by " -> ".
+                     (put-text-property start end 'dired-filename t))))))
+         ;; Remove trailing lines.
+         (goto-char (point-at-bol))
+         (while (looking-at "//")
+           (forward-line 1)
+           (delete-region (match-beginning 0) (point)))
+
+         ;; Some busyboxes are reluctant to discard colors.
+         (unless (string-match "color" (tramp-get-connection-property v "ls" ""))
+           (goto-char beg)
+           (while (re-search-forward tramp-color-escape-sequence-regexp nil t)
+             (replace-match "")))
+
+         ;; Decode the output, it could be multibyte.
+         (decode-coding-region
+          beg (point-max)
+          (or file-name-coding-system
+              (and (boundp 'default-file-name-coding-system)
+                   (symbol-value 'default-file-name-coding-system))))
+
+         ;; The inserted file could be from somewhere else.
+         (when (and (not wildcard) (not full-directory-p))
+           (goto-char (point-max))
+           (when (file-symlink-p filename)
+             (goto-char (search-backward "->" beg 'noerror)))
+           (search-backward
+            (if (zerop (length (file-name-nondirectory filename)))
+                "."
+              (file-name-nondirectory filename))
+            beg 'noerror)
+           (replace-match (file-relative-name filename) t))
+
+         (goto-char (point-max)))))))
 
 ;; Canonicalization of file names.
 
@@ -2922,7 +2930,8 @@ the result will be a local, non-Tramp, filename."
                      ;; epa-file gets confused.
                      (let (file-name-handler-alist
                            (coding-system-for-write 'binary))
-                       (write-region (point-min) (point-max) tmpfile)))
+                       (write-region
+                        (point-min) (point-max) tmpfile nil 'no-message)))
 
                  ;; If tramp-decoding-function is not defined for this
                  ;; method, we invoke tramp-decoding-command instead.
@@ -2932,7 +2941,8 @@ the result will be a local, non-Tramp, filename."
                    (let (file-name-handler-alist
                          (coding-system-for-write 'binary))
                      (with-current-buffer (tramp-get-buffer v)
-                       (write-region (point-min) (point-max) tmpfile2)))
+                       (write-region
+                        (point-min) (point-max) tmpfile2 nil 'no-message)))
                    (unwind-protect
                        (tramp-call-local-coding-command
                         loc-dec tmpfile2 tmpfile)
@@ -3339,14 +3349,12 @@ Fall back to normal file name handler if no Tramp handler exists."
   (setq file-name (expand-file-name file-name))
   (with-parsed-tramp-file-name file-name nil
     (let* ((default-directory (file-name-directory file-name))
-          command events filter p)
+          command events filter p sequence)
       (cond
        ;; gvfs-monitor-dir.
        ((setq command (tramp-get-remote-gvfs-monitor-dir v))
        (setq filter 'tramp-sh-file-gvfs-monitor-dir-process-filter
-             p (start-file-process
-                "gvfs-monitor-dir" (generate-new-buffer " *gvfs-monitor-dir*")
-                command localname)))
+             sequence `(,command ,localname)))
        ;; inotifywait.
        ((setq command (tramp-get-remote-inotifywait v))
        (setq filter 'tramp-sh-file-inotifywait-process-filter
@@ -3356,18 +3364,27 @@ Fall back to normal file name handler if no Tramp handler exists."
                "create,modify,move,delete,attrib")
               ((memq 'change flags) "create,modify,move,delete")
               ((memq 'attribute-change flags) "attrib"))
-             p (start-file-process
-                 "inotifywait" (generate-new-buffer " *inotifywait*")
-                 command "-mq" "-e" events localname)))
+             sequence `(,command "-mq" "-e" ,events ,localname)))
        ;; None.
        (t (tramp-error
           v 'file-notify-error
           "No file notification program found on %s"
           (file-remote-p file-name))))
+      ;; Start process.
+      (setq p (apply
+              'start-file-process
+              (file-name-nondirectory command)
+              (generate-new-buffer
+               (format " *%s*" (file-name-nondirectory command)))
+              sequence))
       ;; Return the process object as watch-descriptor.
       (if (not (processp p))
          (tramp-error
-          v 'file-notify-error "`%s' failed to start on remote host" command)
+          v 'file-notify-error
+          "`%s' failed to start on remote host"
+          (mapconcat 'identity sequence " "))
+       (tramp-message v 6 "Run `%s', %S" (mapconcat 'identity sequence " ") p)
+       (tramp-set-connection-property p "vector" v)
        (tramp-compat-set-process-query-on-exit-flag p nil)
        (set-process-filter p filter)
        p))))
@@ -3871,7 +3888,8 @@ process to set up.  VEC specifies the connection."
   ;; Set the environment.
   (tramp-message vec 5 "Setting default environment")
 
-  (let ((env (copy-sequence tramp-remote-process-environment))
+  (let ((env (append `(,(tramp-get-remote-locale vec))
+                    (copy-sequence tramp-remote-process-environment)))
        unset item)
     (while env
       (setq item (tramp-compat-split-string (car env) "="))
@@ -4330,10 +4348,6 @@ connection if a previous connection has died for some reason."
     (condition-case err
        (unless (and p (processp p) (memq (process-status p) '(run open)))
 
-         ;; We call `tramp-get-buffer' in order to get a debug buffer
-         ;; for messages from the beginning.
-         (tramp-get-buffer vec)
-
          ;; If `non-essential' is non-nil, don't reopen a new connection.
          (when (and (boundp 'non-essential) (symbol-value 'non-essential))
            (throw 'non-essential 'non-essential))
@@ -4354,7 +4368,7 @@ connection if a previous connection has died for some reason."
              (when (and p (processp p))
                (delete-process p))
              (setenv "TERM" tramp-terminal-type)
-             (setenv "LC_ALL" "C")
+             (setenv "LC_ALL" "en_US.utf8")
              (setenv "PROMPT_COMMAND")
              (setenv "PS1" tramp-initial-end-of-output)
              (let* ((target-alist (tramp-compute-multi-hops vec))
@@ -4464,7 +4478,7 @@ connection if a previous connection has died for some reason."
                          tramp-current-user   (or g-user   l-user)
                          tramp-current-host   (or g-host   l-host))
 
-                   ;; Replace login-args place holders.
+                   ;; Replace `login-args' place holders.
                    (setq
                     l-host (or l-host "")
                     l-user (or l-user "")
@@ -4813,6 +4827,21 @@ Return ATTR."
           x))
        remote-path)))))
 
+(defun tramp-get-remote-locale (vec)
+  (with-tramp-connection-property vec "locale"
+    (tramp-send-command vec "locale -a")
+    (let ((candidates '("en_US.utf8" "C.utf8" "C"))
+         locale)
+      (with-current-buffer (tramp-get-connection-buffer vec)
+       (while candidates
+         (goto-char (point-min))
+         (if (string-match (concat "^" (car candidates) "$") (buffer-string))
+             (setq locale (car candidates)
+                   candidates nil)
+           (setq candidates (cdr candidates)))))
+      ;; Return value.
+      (when locale (format "LC_ALL=%s" locale)))))
+
 (defun tramp-get-ls-command (vec)
   (with-tramp-connection-property vec "ls"
     (tramp-message vec 5 "Finding a suitable `ls' command")