Merge from emacs--rel--22, gnus--devo--0

[bpt/emacs.git] / lisp / net / ange-ftp.el

diff --git a/lisp/net/ange-ftp.el b/lisp/net/ange-ftp.el
index 19041d0..432effe 100644 (file)
--- a/lisp/net/ange-ftp.el
+++ b/lisp/net/ange-ftp.el
@@ -11,7 +11,7 @@
 
 ;; GNU Emacs is free software; you can redistribute it and/or modify
 ;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
+;; the Free Software Foundation; either version 3, or (at your option)
 ;; any later version.
 
 ;; GNU Emacs is distributed in the hope that it will be useful,
@@ -1005,7 +1005,7 @@ Don't use any other value."
                 (const :tag "Allow" 1)))
 
 (defcustom ange-ftp-try-passive-mode nil
-  "It t, try to use passive mode in ftp, if the client program supports it."
+  "If t, try to use passive mode in ftp, if the client program supports it."
   :group 'ange-ftp
   :type 'boolean
   :version "21.1")
@@ -2599,7 +2599,7 @@ away in the internal cache."
            (if wildcard
                (progn
                  (ange-ftp-cd host user (file-name-directory name))
-                 (setq lscmd (list 'dir file temp lsargs)))
+                 (setq lscmd (list 'ls file temp lsargs)))
              (setq lscmd (list 'dir name temp lsargs)))
            (unwind-protect
                (if (car (setq result (ange-ftp-send-cmd
@@ -3813,7 +3813,7 @@ Value is (0 0) if the modification time cannot be determined."
     (ange-ftp-call-cont cont result line)))
 
 (defun ange-ftp-copy-file (filename newname &optional ok-if-already-exists
-                                   keep-date)
+                                   keep-date preserve-uid-gid)
   (interactive "fCopy file: \nFCopy %s to file: \np")
   (ange-ftp-copy-file-internal filename
                               newname
@@ -4132,8 +4132,19 @@ directory, so that Emacs will know its current contents."
                                       (format "Getting %s" fn1))
          tmp1))))
 
-(defun ange-ftp-file-remote-p (file)
-  (ange-ftp-replace-name-component file ""))
+(defun ange-ftp-file-remote-p (file &optional identification connected)
+  (let* ((parsed (ange-ftp-ftp-name file))
+        (host (nth 0 parsed))
+        (user (nth 1 parsed)))
+    (and (or (not connected)
+            (let ((proc (get-process (ange-ftp-ftp-process-buffer host user))))
+              (and proc (processp proc)
+                   (memq (process-status proc) '(run open)))))
+        (cond
+         ((eq identification 'method) (and parsed "ftp"))
+         ((eq identification 'user) user)
+         ((eq identification 'host) host)
+         (t (ange-ftp-replace-name-component file ""))))))
 
 (defun ange-ftp-load (file &optional noerror nomessage nosuffix)
   (if (ange-ftp-ftp-name file)
@@ -4274,7 +4285,12 @@ NEWNAME should be the name to give the new compressed or uncompressed file.")
 ;;;###autoload
 (defun ange-ftp-hook-function (operation &rest args)
   (let ((fn (get operation 'ange-ftp)))
-    (if fn (save-match-data (apply fn args))
+    (if fn
+       ;; Catch also errors in process-filter.
+       (condition-case err
+           (let ((debug-on-error t))
+             (save-match-data (apply fn args)))
+         (error (signal (car err) (cdr err))))
       (ange-ftp-run-real-handler operation args))))
 
 ;; The following code is commented out because Tramp now deals with
@@ -4356,11 +4372,20 @@ NEWNAME should be the name to give the new compressed or uncompressed file.")
 ;; Treat each name as its own truename.
 (put 'file-truename 'ange-ftp 'identity)
 
+;; We must return non-nil in order to mask our inability to do the job.
+;; Otherwise there are errors when applied to the target file during
+;; copying from a (localhost) Tramp file.
+(put 'set-file-modes 'ange-ftp 'ignore)
+(put 'set-file-times 'ange-ftp 'ignore)
+
 ;; Turn off RCS/SCCS processing to save time.
 ;; This returns nil for any file name as argument.
 (put 'vc-registered 'ange-ftp 'null)
 
-(put 'dired-call-process 'ange-ftp 'ange-ftp-dired-call-process)
+;; We can handle process-file in a restricted way (just for chown).
+;; Nothing possible for `start-file-process'.
+(put 'process-file 'ange-ftp 'ange-ftp-process-file)
+(put 'start-file-process 'ange-ftp 'ignore)
 (put 'shell-command 'ange-ftp 'ange-ftp-shell-command)
 \f
 ;;; Define ways of getting at unmodified Emacs primitives,
@@ -4523,8 +4548,8 @@ NEWNAME should be the name to give the new compressed or uncompressed file.")
       ;; default-directory is in ange-ftp syntax for remote file names.
       (ange-ftp-real-shell-command command output-buffer error-buffer))))
 
-;;; This is the handler for call-process.
-(defun ange-ftp-dired-call-process (program discard &rest arguments)
+;;; This is the handler for process-file.
+(defun ange-ftp-process-file (program infile buffer display &rest arguments)
   ;; PROGRAM is always one of those below in the cond in dired.el.
   ;; The ARGUMENTS are (nearly) always files.
   (if (ange-ftp-ftp-name default-directory)
@@ -4544,7 +4569,7 @@ NEWNAME should be the name to give the new compressed or uncompressed file.")
                   1)
        (error (insert (format "%s\n" (nth 1 oops)))
               1))
-    (apply 'call-process program nil (not discard) nil arguments)))
+    (apply 'call-process program infile buffer display arguments)))
 
 ;; Handle an attempt to run chmod on a remote file
 ;; by using the ftp chmod command.
@@ -4555,7 +4580,7 @@ NEWNAME should be the name to give the new compressed or uncompressed file.")
        (rest (cdr args)))
     (if (equal "--" (car rest))
        (setq rest (cdr rest)))
-    (mapcar
+    (mapc
      (lambda (file)
        (setq file (expand-file-name file))
        (let ((parsed (ange-ftp-ftp-name file)))
@@ -6030,8 +6055,8 @@ Other orders of $ and _ seem to all work just fine.")
     (puthash ".." t tbl)
     ;; add all additional pubsets, if not listing one of them
     (if (not (member pubset ange-ftp-bs2000-additional-pubsets))
-       (mapcar (lambda (pubset) (puthash pubset t tbl))
-               ange-ftp-bs2000-additional-pubsets))
+       (mapc (lambda (pubset) (puthash pubset t tbl))
+             ange-ftp-bs2000-additional-pubsets))
     tbl))
 
 (add-to-list 'ange-ftp-parse-list-func-alist