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