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 | 122 | |
0f34aa77 | 123 | ;;;###tramp-autoload |
4007ba5b KG |
124 | (defun tramp-ftp-file-name-handler (operation &rest args) |
125 | "Invoke the Ange-FTP handler for OPERATION. | |
126 | First arg specifies the OPERATION, second arg is a list of arguments to | |
127 | pass to the OPERATION." | |
128 | (save-match-data | |
129 | (or (boundp 'ange-ftp-name-format) | |
1b8d1cc7 | 130 | (let (file-name-handler-alist) (require 'ange-ftp))) |
83bbd71b KG |
131 | (let ((ange-ftp-name-format |
132 | (list (nth 0 tramp-file-name-structure) | |
133 | (nth 3 tramp-file-name-structure) | |
134 | (nth 2 tramp-file-name-structure) | |
5ec2cc41 KG |
135 | (nth 4 tramp-file-name-structure))) |
136 | ;; ange-ftp uses `ange-ftp-ftp-name-arg' and `ange-ftp-ftp-name-res' | |
137 | ;; for optimization in `ange-ftp-ftp-name'. If Tramp wasn't active, | |
138 | ;; there could be incorrect values from previous calls in case the | |
139 | ;; "ftp" method is used in the Tramp file name. So we unset | |
140 | ;; those values. | |
141 | (ange-ftp-ftp-name-arg "") | |
142 | (ange-ftp-ftp-name-res nil)) | |
83bbd71b | 143 | (cond |
0f205eee MA |
144 | ;; If argument is a symlink, `file-directory-p' and |
145 | ;; `file-exists-p' call the traversed file recursively. So we | |
146 | ;; cannot disable the file-name-handler this case. We set the | |
147 | ;; connection property "started" in order to put the remote | |
148 | ;; location into the cache, which is helpful for further | |
b08104a0 MA |
149 | ;; completion. We don't use `with-parsed-tramp-file-name', |
150 | ;; because this returns another user but the one declared in | |
151 | ;; "~/.netrc". | |
83bbd71b | 152 | ((memq operation '(file-directory-p file-exists-p)) |
0f205eee | 153 | (if (apply 'ange-ftp-hook-function operation args) |
b08104a0 MA |
154 | (let ((v (tramp-dissect-file-name (car args) t))) |
155 | (aset v 0 tramp-ftp-method) | |
0f205eee MA |
156 | (tramp-set-connection-property v "started" t)) |
157 | nil)) | |
b50dd0d2 | 158 | |
94be87e8 MA |
159 | ;; If the second argument of `copy-file' or `rename-file' is a |
160 | ;; remote file name but via FTP, ange-ftp doesn't check this. | |
161 | ;; We must copy it locally first, because there is no place in | |
162 | ;; ange-ftp for correct handling. | |
163 | ((and (memq operation '(copy-file rename-file)) | |
4c1f03ef | 164 | (tramp-tramp-file-p (cadr args)) |
94be87e8 MA |
165 | (not (tramp-ftp-file-name-p (cadr args)))) |
166 | (let* ((filename (car args)) | |
167 | (newname (cadr args)) | |
258800f8 | 168 | (tmpfile (tramp-compat-make-temp-file filename)) |
94be87e8 | 169 | (args (cddr args))) |
b50dd0d2 MA |
170 | ;; We must set `ok-if-already-exists' to t in the first |
171 | ;; step, because the temp file has been created already. | |
172 | (if (eq operation 'copy-file) | |
173 | (apply operation filename tmpfile t (cdr args)) | |
174 | (apply operation filename tmpfile t)) | |
175 | (unwind-protect | |
176 | (rename-file tmpfile newname (car args)) | |
177 | ;; Cleanup. | |
eba082a2 | 178 | (ignore-errors (delete-file tmpfile))))) |
b50dd0d2 | 179 | |
0f205eee | 180 | ;; Normally, the handlers must be discarded. |
2d8b5d77 MA |
181 | ;; `inhibit-file-name-handlers' isn't sufficient, because the |
182 | ;; local file name could be in Tramp syntax as well (for | |
183 | ;; example, returning VMS file names like "/DISK$CAM:/AAA"). | |
184 | ;; That's why we set also `tramp-mode' to nil. | |
8e303a2f | 185 | (t (let* (;(tramp-mode nil) |
2d8b5d77 | 186 | (inhibit-file-name-handlers |
0f205eee MA |
187 | (list 'tramp-file-name-handler |
188 | 'tramp-completion-file-name-handler | |
189 | (and (eq inhibit-file-name-operation operation) | |
190 | inhibit-file-name-handlers))) | |
191 | (inhibit-file-name-operation operation)) | |
192 | (apply 'ange-ftp-hook-function operation args))))))) | |
4007ba5b | 193 | |
b421decc MA |
194 | ;; It must be a `defsubst' in order to push the whole code into |
195 | ;; tramp-loaddefs.el. Otherwise, there would be recursive autoloading. | |
0f34aa77 MA |
196 | ;;;###tramp-autoload |
197 | (defsubst tramp-ftp-file-name-p (filename) | |
4007ba5b | 198 | "Check if it's a filename that should be forwarded to Ange-FTP." |
2fe4b125 MA |
199 | (string= (tramp-file-name-method (tramp-dissect-file-name filename)) |
200 | tramp-ftp-method)) | |
4007ba5b | 201 | |
0f34aa77 MA |
202 | ;;;###tramp-autoload |
203 | (unless (featurep 'xemacs) | |
204 | (add-to-list 'tramp-foreign-file-name-handler-alist | |
205 | (cons 'tramp-ftp-file-name-p 'tramp-ftp-file-name-handler))) | |
206 | ||
207 | (add-hook 'tramp-unload-hook | |
208 | (lambda () | |
209 | (unload-feature 'tramp-ftp 'force))) | |
4007ba5b KG |
210 | |
211 | (provide 'tramp-ftp) | |
212 | ||
213 | ;;; TODO: | |
214 | ||
03c1ad43 | 215 | ;; * There are no backup files on FTP hosts. |
4007ba5b KG |
216 | |
217 | ;;; tramp-ftp.el ends here |