Commit | Line | Data |
---|---|---|
bce04fee | 1 | ;;; tramp-ftp.el --- Tramp convenience functions for Ange-FTP |
4007ba5b | 2 | |
ba318903 | 3 | ;; Copyright (C) 2002-2014 Free Software Foundation, Inc. |
4007ba5b | 4 | |
d2a2c17f | 5 | ;; Author: Michael Albinus <michael.albinus@gmx.de> |
4007ba5b | 6 | ;; Keywords: comm, processes |
bd78fa1d | 7 | ;; Package: tramp |
4007ba5b KG |
8 | |
9 | ;; This file is part of GNU Emacs. | |
10 | ||
874a927a | 11 | ;; GNU Emacs is free software: you can redistribute it and/or modify |
4007ba5b | 12 | ;; it under the terms of the GNU General Public License as published by |
874a927a GM |
13 | ;; the Free Software Foundation, either version 3 of the License, or |
14 | ;; (at your option) any later version. | |
4007ba5b KG |
15 | |
16 | ;; GNU Emacs is distributed in the hope that it will be useful, | |
17 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
18 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
19 | ;; GNU General Public License for more details. | |
20 | ||
21 | ;; You should have received a copy of the GNU General Public License | |
874a927a | 22 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. |
4007ba5b KG |
23 | |
24 | ;;; Commentary: | |
25 | ||
5ec2cc41 KG |
26 | ;; Convenience functions for calling Ange-FTP from Tramp. |
27 | ;; Most of them are displaced from tramp.el. | |
4007ba5b KG |
28 | |
29 | ;;; Code: | |
30 | ||
31 | (require 'tramp) | |
32 | ||
b74f0d96 | 33 | ;; Pacify byte-compiler. |
efe78a6c | 34 | (eval-when-compile |
efe78a6c | 35 | (require 'cl) |
f95527c8 MA |
36 | (require 'custom)) |
37 | (defvar ange-ftp-ftp-name-arg) | |
38 | (defvar ange-ftp-ftp-name-res) | |
39 | (defvar ange-ftp-name-format) | |
4007ba5b KG |
40 | |
41 | ;; Disable Ange-FTP from file-name-handler-alist. | |
42 | ;; To handle EFS, the following functions need to be dealt with: | |
43 | ;; | |
44 | ;; * dired-before-readin-hook contains efs-dired-before-readin | |
45 | ;; * file-name-handler-alist contains efs-file-handler-function | |
46 | ;; and efs-root-handler-function and efs-sifn-handler-function | |
47 | ;; * find-file-hooks contains efs-set-buffer-mode | |
48 | ;; | |
49 | ;; But it won't happen for EFS since the XEmacs maintainers | |
50 | ;; don't want to use a unified filename syntax. | |
51 | (defun tramp-disable-ange-ftp () | |
52 | "Turn Ange-FTP off. | |
53 | This is useful for unified remoting. See | |
2fe4b125 MA |
54 | `tramp-file-name-structure' for details. Requests suitable for |
55 | Ange-FTP will be forwarded to Ange-FTP. Also see the variables | |
4007ba5b KG |
56 | `tramp-ftp-method', `tramp-default-method', and |
57 | `tramp-default-method-alist'. | |
58 | ||
59 | This function is not needed in Emacsen which include Tramp, but is | |
60 | present for backward compatibility." | |
61 | (let ((a1 (rassq 'ange-ftp-hook-function file-name-handler-alist)) | |
62 | (a2 (rassq 'ange-ftp-completion-hook-function file-name-handler-alist))) | |
63 | (setq file-name-handler-alist | |
64 | (delete a1 (delete a2 file-name-handler-alist))))) | |
a69c01a0 MA |
65 | |
66 | (eval-after-load "ange-ftp" | |
67 | '(when (functionp 'tramp-disable-ange-ftp) | |
68 | (tramp-disable-ange-ftp))) | |
69 | ||
70 | ;;;###autoload | |
71 | (defun tramp-ftp-enable-ange-ftp () | |
72 | ;; The following code is commented out in Ange-FTP. | |
73 | ||
74 | ;;; This regexp takes care of real ange-ftp file names (with a slash | |
75 | ;;; and colon). | |
76 | ;;; Don't allow the host name to end in a period--some systems use /.: | |
77 | (or (assoc "^/[^/:]*[^/:.]:" file-name-handler-alist) | |
78 | (setq file-name-handler-alist | |
79 | (cons '("^/[^/:]*[^/:.]:" . ange-ftp-hook-function) | |
80 | file-name-handler-alist))) | |
81 | ||
82 | ;;; This regexp recognizes absolute filenames with only one component, | |
83 | ;;; for the sake of hostname completion. | |
84 | (or (assoc "^/[^/:]*\\'" file-name-handler-alist) | |
85 | (setq file-name-handler-alist | |
86 | (cons '("^/[^/:]*\\'" . ange-ftp-completion-hook-function) | |
87 | file-name-handler-alist))) | |
88 | ||
89 | ;;; This regexp recognizes absolute filenames with only one component | |
90 | ;;; on Windows, for the sake of hostname completion. | |
91 | (and (memq system-type '(ms-dos windows-nt)) | |
92 | (or (assoc "^[a-zA-Z]:/[^/:]*\\'" file-name-handler-alist) | |
93 | (setq file-name-handler-alist | |
94 | (cons '("^[a-zA-Z]:/[^/:]*\\'" . | |
95 | ange-ftp-completion-hook-function) | |
96 | file-name-handler-alist))))) | |
97 | ||
98 | (add-hook 'tramp-ftp-unload-hook 'tramp-ftp-enable-ange-ftp) | |
4007ba5b KG |
99 | |
100 | ;; Define FTP method ... | |
0f34aa77 MA |
101 | ;;;###tramp-autoload |
102 | (defconst tramp-ftp-method "ftp" | |
fb7ada5f | 103 | "When this method name is used, forward all calls to Ange-FTP.") |
4007ba5b KG |
104 | |
105 | ;; ... and add it to the method list. | |
0f34aa77 MA |
106 | ;;;###tramp-autoload |
107 | (unless (featurep 'xemacs) | |
b191c9d9 | 108 | (add-to-list 'tramp-methods (cons tramp-ftp-method nil)) |
4007ba5b | 109 | |
b191c9d9 MA |
110 | ;; Add some defaults for `tramp-default-method-alist'. |
111 | (add-to-list 'tramp-default-method-alist | |
112 | (list "\\`ftp\\." nil tramp-ftp-method)) | |
113 | (add-to-list 'tramp-default-method-alist | |
114 | (list nil "\\`\\(anonymous\\|ftp\\)\\'" tramp-ftp-method))) | |
4007ba5b KG |
115 | |
116 | ;; Add completion function for FTP method. | |
f8f91c2b MA |
117 | ;;;###tramp-autoload |
118 | (eval-after-load 'tramp | |
119 | '(tramp-set-completion-function | |
120 | tramp-ftp-method | |
121 | '((tramp-parse-netrc "~/.netrc")))) | |
00d6fd04 MA |
122 | |
123 | ;; If there is URL syntax, `substitute-in-file-name' needs special | |
124 | ;; handling. | |
125 | (put 'substitute-in-file-name 'ange-ftp 'tramp-handle-substitute-in-file-name) | |
2d8b5d77 | 126 | (add-hook 'tramp-ftp-unload-hook |
4f91a816 SM |
127 | (lambda () |
128 | (setplist 'substitute-in-file-name | |
129 | (delete 'ange-ftp | |
130 | (delete 'tramp-handle-substitute-in-file-name | |
131 | (symbol-plist | |
132 | 'substitute-in-file-name)))))) | |
4007ba5b | 133 | |
0f34aa77 | 134 | ;;;###tramp-autoload |
4007ba5b KG |
135 | (defun tramp-ftp-file-name-handler (operation &rest args) |
136 | "Invoke the Ange-FTP handler for OPERATION. | |
137 | First arg specifies the OPERATION, second arg is a list of arguments to | |
138 | pass to the OPERATION." | |
139 | (save-match-data | |
140 | (or (boundp 'ange-ftp-name-format) | |
1b8d1cc7 | 141 | (let (file-name-handler-alist) (require 'ange-ftp))) |
83bbd71b KG |
142 | (let ((ange-ftp-name-format |
143 | (list (nth 0 tramp-file-name-structure) | |
144 | (nth 3 tramp-file-name-structure) | |
145 | (nth 2 tramp-file-name-structure) | |
5ec2cc41 KG |
146 | (nth 4 tramp-file-name-structure))) |
147 | ;; ange-ftp uses `ange-ftp-ftp-name-arg' and `ange-ftp-ftp-name-res' | |
148 | ;; for optimization in `ange-ftp-ftp-name'. If Tramp wasn't active, | |
149 | ;; there could be incorrect values from previous calls in case the | |
150 | ;; "ftp" method is used in the Tramp file name. So we unset | |
151 | ;; those values. | |
152 | (ange-ftp-ftp-name-arg "") | |
153 | (ange-ftp-ftp-name-res nil)) | |
83bbd71b | 154 | (cond |
0f205eee MA |
155 | ;; If argument is a symlink, `file-directory-p' and |
156 | ;; `file-exists-p' call the traversed file recursively. So we | |
157 | ;; cannot disable the file-name-handler this case. We set the | |
158 | ;; connection property "started" in order to put the remote | |
159 | ;; location into the cache, which is helpful for further | |
b08104a0 MA |
160 | ;; completion. We don't use `with-parsed-tramp-file-name', |
161 | ;; because this returns another user but the one declared in | |
162 | ;; "~/.netrc". | |
83bbd71b | 163 | ((memq operation '(file-directory-p file-exists-p)) |
0f205eee | 164 | (if (apply 'ange-ftp-hook-function operation args) |
b08104a0 MA |
165 | (let ((v (tramp-dissect-file-name (car args) t))) |
166 | (aset v 0 tramp-ftp-method) | |
0f205eee MA |
167 | (tramp-set-connection-property v "started" t)) |
168 | nil)) | |
b50dd0d2 | 169 | |
94be87e8 MA |
170 | ;; If the second argument of `copy-file' or `rename-file' is a |
171 | ;; remote file name but via FTP, ange-ftp doesn't check this. | |
172 | ;; We must copy it locally first, because there is no place in | |
173 | ;; ange-ftp for correct handling. | |
174 | ((and (memq operation '(copy-file rename-file)) | |
4c1f03ef | 175 | (tramp-tramp-file-p (cadr args)) |
94be87e8 MA |
176 | (not (tramp-ftp-file-name-p (cadr args)))) |
177 | (let* ((filename (car args)) | |
178 | (newname (cadr args)) | |
258800f8 | 179 | (tmpfile (tramp-compat-make-temp-file filename)) |
94be87e8 | 180 | (args (cddr args))) |
b50dd0d2 MA |
181 | ;; We must set `ok-if-already-exists' to t in the first |
182 | ;; step, because the temp file has been created already. | |
183 | (if (eq operation 'copy-file) | |
184 | (apply operation filename tmpfile t (cdr args)) | |
185 | (apply operation filename tmpfile t)) | |
186 | (unwind-protect | |
187 | (rename-file tmpfile newname (car args)) | |
188 | ;; Cleanup. | |
eba082a2 | 189 | (ignore-errors (delete-file tmpfile))))) |
b50dd0d2 | 190 | |
0f205eee | 191 | ;; Normally, the handlers must be discarded. |
2d8b5d77 MA |
192 | ;; `inhibit-file-name-handlers' isn't sufficient, because the |
193 | ;; local file name could be in Tramp syntax as well (for | |
194 | ;; example, returning VMS file names like "/DISK$CAM:/AAA"). | |
195 | ;; That's why we set also `tramp-mode' to nil. | |
8e303a2f | 196 | (t (let* (;(tramp-mode nil) |
2d8b5d77 | 197 | (inhibit-file-name-handlers |
0f205eee MA |
198 | (list 'tramp-file-name-handler |
199 | 'tramp-completion-file-name-handler | |
200 | (and (eq inhibit-file-name-operation operation) | |
201 | inhibit-file-name-handlers))) | |
202 | (inhibit-file-name-operation operation)) | |
203 | (apply 'ange-ftp-hook-function operation args))))))) | |
4007ba5b | 204 | |
b421decc MA |
205 | ;; It must be a `defsubst' in order to push the whole code into |
206 | ;; tramp-loaddefs.el. Otherwise, there would be recursive autoloading. | |
0f34aa77 MA |
207 | ;;;###tramp-autoload |
208 | (defsubst tramp-ftp-file-name-p (filename) | |
4007ba5b | 209 | "Check if it's a filename that should be forwarded to Ange-FTP." |
2fe4b125 MA |
210 | (string= (tramp-file-name-method (tramp-dissect-file-name filename)) |
211 | tramp-ftp-method)) | |
4007ba5b | 212 | |
0f34aa77 MA |
213 | ;;;###tramp-autoload |
214 | (unless (featurep 'xemacs) | |
215 | (add-to-list 'tramp-foreign-file-name-handler-alist | |
216 | (cons 'tramp-ftp-file-name-p 'tramp-ftp-file-name-handler))) | |
217 | ||
218 | (add-hook 'tramp-unload-hook | |
219 | (lambda () | |
220 | (unload-feature 'tramp-ftp 'force))) | |
4007ba5b KG |
221 | |
222 | (provide 'tramp-ftp) | |
223 | ||
224 | ;;; TODO: | |
225 | ||
03c1ad43 | 226 | ;; * There are no backup files on FTP hosts. |
4007ba5b KG |
227 | |
228 | ;;; tramp-ftp.el ends here |