;;; ange-ftp.el --- transparent FTP support for GNU Emacs
;; Copyright (C) 1989, 1990, 1991, 1992, 1993, 1994, 1995, 1996, 1998,
-;; 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
+;; 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
;; Author: Andy Norman (ange@hplb.hpl.hp.com)
;; Maintainer: FSF
;; This file is part of GNU Emacs.
-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; 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)
-;; any later version.
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; you would type:
;; C-x C-f /anonymous@ymir.claremont.edu:CSV/POLICY/RULES.MEM
;;
-;; A legal VMS filename is of the form: FILE.TYPE;##
+;; A valid VMS filename is of the form: FILE.TYPE;##
;; where FILE can be up to 39 characters
;; TYPE can be up to 39 characters
;; ## is a version number (an integer between 1 and 32,767)
(defun ange-ftp-quote-string (string)
"Quote any characters in STRING that may confuse the ftp process."
- (apply 'concat
- (mapcar (lambda (char)
- ;; This is said to be wrong; ftp is said to
- ;; need quoting only for ", and that by doubling it.
- ;; But experiment says this kind of quoting is correct
- ;; when talking to ftp on GNU/Linux systems.
- (if (or (<= char ? )
- (> char ?\~)
- (= char ?\")
- (= char ?\\))
- (vector ?\\ char)
- (vector char)))
- string)))
+ ;; This is said to be wrong; ftp is said to need quoting only for ",
+ ;; and that by doubling it. But experiment says UNIX-style kind of
+ ;; quoting is correct when talking to ftp on GNU/Linux systems, and
+ ;; W32-style kind of quoting on, yes, W32 systems.
+ (if (stringp string)
+ (shell-quote-argument string)
+ ""))
(defun ange-ftp-barf-if-not-directory (directory)
(or (file-directory-p directory)
(ange-ftp-send-cmd
t-host
t-user
- (list 'put (or temp2 filename) t-name)
+ (list 'put (or temp2 (ange-ftp-quote-string filename)) t-name)
(or msg
(if (and temp2 f-parsed)
(format "Putting %s" newname)
(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
;; Calculate default-unhandled-directory for a given ange-ftp buffer.
(defun ange-ftp-unhandled-file-name-directory (filename)
- (file-name-directory ange-ftp-tmp-name-template))
+ nil)
\f
;; Need the following functions for making filenames of compressed
;;;###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)
;; We can handle process-file in a restricted way (just for chown).
-;; Nothing possible for start-file-process.
+;; 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)
(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
HCoop / bpt / emacs.git / blobdiff