;; 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,
(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
(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)
;;;###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
;; 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,
;; 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)
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.
(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)))
(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