diff options
Diffstat (limited to 'lisp/net/ange-ftp.el')
| -rw-r--r-- | lisp/net/ange-ftp.el | 40 |
1 files changed, 30 insertions, 10 deletions
diff --git a/lisp/net/ange-ftp.el b/lisp/net/ange-ftp.el index 7428dcd380a..0680581c7cd 100644 --- a/lisp/net/ange-ftp.el +++ b/lisp/net/ange-ftp.el @@ -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) @@ -4361,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) ;;; Define ways of getting at unmodified Emacs primitives, @@ -4528,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) @@ -4549,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. @@ -4560,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))) @@ -6035,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 |