X-Git-Url: https://git.hcoop.net/bpt/emacs.git/blobdiff_plain/2536fb611876d5526fe40b9bee2a16e2836d4ff3..40f185ca85f2129ec33446791be2999d714f35ff:/lisp/net/ange-ftp.el diff --git a/lisp/net/ange-ftp.el b/lisp/net/ange-ftp.el index 24a30603bb..432effe554 100644 --- 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, @@ -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 @@ -4285,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 @@ -4367,12 +4372,18 @@ 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) ;; 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) @@ -4569,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))) @@ -6044,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