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