Mercurial > emacs
annotate lisp/url/url-handlers.el @ 83218:47f53c5c9620
Merged in changes from CVS trunk.
Patches applied:
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-608
Update from CVS
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-609
Update from CVS
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-610
Merge from gnus--rel--5.10
* miles@gnu.org--gnu-2004/gnus--rel--5.10--patch-45
Update from CVS
git-archimport-id: lorentey@elte.hu--2004/emacs--multi-tty--0--patch-258
author | Karoly Lorentey <lorentey@elte.hu> |
---|---|
date | Tue, 12 Oct 2004 07:52:25 +0000 |
parents | d83f49cefda3 01934125951e |
children | 4ee39d9428b0 |
rev | line source |
---|---|
54695 | 1 ;;; url-handlers.el --- file-name-handler stuff for URL loading |
54829
e38bd75fb54e
(url-handler-mode): New minor mode.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54770
diff
changeset
|
2 |
57174
4202aed8aa86
(url-insert-file-contents): Decode contents.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54931
diff
changeset
|
3 ;; Copyright (c) 1996, 1997, 1998, 1999, 2004 Free Software Foundation, Inc. |
54829
e38bd75fb54e
(url-handler-mode): New minor mode.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54770
diff
changeset
|
4 |
54695 | 5 ;; Keywords: comm, data, processes, hypermedia |
6 | |
54829
e38bd75fb54e
(url-handler-mode): New minor mode.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54770
diff
changeset
|
7 ;; This file is part of GNU Emacs. |
e38bd75fb54e
(url-handler-mode): New minor mode.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54770
diff
changeset
|
8 ;; |
e38bd75fb54e
(url-handler-mode): New minor mode.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54770
diff
changeset
|
9 ;; GNU Emacs is free software; you can redistribute it and/or modify |
e38bd75fb54e
(url-handler-mode): New minor mode.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54770
diff
changeset
|
10 ;; it under the terms of the GNU General Public License as published by |
e38bd75fb54e
(url-handler-mode): New minor mode.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54770
diff
changeset
|
11 ;; the Free Software Foundation; either version 2, or (at your option) |
e38bd75fb54e
(url-handler-mode): New minor mode.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54770
diff
changeset
|
12 ;; any later version. |
e38bd75fb54e
(url-handler-mode): New minor mode.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54770
diff
changeset
|
13 ;; |
e38bd75fb54e
(url-handler-mode): New minor mode.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54770
diff
changeset
|
14 ;; GNU Emacs is distributed in the hope that it will be useful, |
e38bd75fb54e
(url-handler-mode): New minor mode.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54770
diff
changeset
|
15 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of |
e38bd75fb54e
(url-handler-mode): New minor mode.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54770
diff
changeset
|
16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
e38bd75fb54e
(url-handler-mode): New minor mode.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54770
diff
changeset
|
17 ;; GNU General Public License for more details. |
e38bd75fb54e
(url-handler-mode): New minor mode.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54770
diff
changeset
|
18 ;; |
e38bd75fb54e
(url-handler-mode): New minor mode.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54770
diff
changeset
|
19 ;; You should have received a copy of the GNU General Public License |
e38bd75fb54e
(url-handler-mode): New minor mode.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54770
diff
changeset
|
20 ;; along with GNU Emacs; see the file COPYING. If not, write to the |
e38bd75fb54e
(url-handler-mode): New minor mode.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54770
diff
changeset
|
21 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, |
e38bd75fb54e
(url-handler-mode): New minor mode.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54770
diff
changeset
|
22 ;; Boston, MA 02111-1307, USA. |
e38bd75fb54e
(url-handler-mode): New minor mode.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54770
diff
changeset
|
23 |
e38bd75fb54e
(url-handler-mode): New minor mode.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54770
diff
changeset
|
24 ;;; Commentary: |
e38bd75fb54e
(url-handler-mode): New minor mode.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54770
diff
changeset
|
25 |
e38bd75fb54e
(url-handler-mode): New minor mode.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54770
diff
changeset
|
26 ;;; Code: |
54695 | 27 |
28 (require 'url) | |
29 (require 'url-parse) | |
30 (require 'url-util) | |
31 (require 'mm-decode) | |
32 (require 'mailcap) | |
33 | |
34 (eval-when-compile | |
35 (require 'cl)) | |
36 | |
37 ;; Implementation status | |
38 ;; --------------------- | |
39 ;; Function Status | |
40 ;; ------------------------------------------------------------ | |
41 ;; add-name-to-file Needs DAV Bindings | |
42 ;; copy-file Broken (assumes 1st item is URL) | |
43 ;; delete-directory Finished (DAV) | |
44 ;; delete-file Finished (DAV) | |
45 ;; diff-latest-backup-file | |
46 ;; directory-file-name unnecessary (what about VMS)? | |
47 ;; directory-files Finished (DAV) | |
48 ;; dired-call-process | |
49 ;; dired-compress-file | |
50 ;; dired-uncache | |
51 ;; expand-file-name Finished | |
52 ;; file-accessible-directory-p | |
53 ;; file-attributes Finished, better with DAV | |
54 ;; file-directory-p Needs DAV, finished | |
55 ;; file-executable-p Finished | |
56 ;; file-exists-p Finished | |
57 ;; file-local-copy | |
58 ;; file-modes | |
59 ;; file-name-all-completions Finished (DAV) | |
60 ;; file-name-as-directory | |
61 ;; file-name-completion Finished (DAV) | |
62 ;; file-name-directory | |
63 ;; file-name-nondirectory | |
64 ;; file-name-sans-versions why? | |
65 ;; file-newer-than-file-p | |
66 ;; file-ownership-preserved-p No way to know | |
67 ;; file-readable-p Finished | |
68 ;; file-regular-p !directory_p | |
69 ;; file-symlink-p Needs DAV bindings | |
70 ;; file-truename Needs DAV bindings | |
71 ;; file-writable-p Check for LOCK? | |
72 ;; find-backup-file-name why? | |
73 ;; get-file-buffer why? | |
74 ;; insert-directory Use DAV | |
75 ;; insert-file-contents Finished | |
76 ;; load | |
77 ;; make-directory Finished (DAV) | |
78 ;; make-symbolic-link Needs DAV bindings | |
79 ;; rename-file Finished (DAV) | |
80 ;; set-file-modes Use mod_dav specific executable flag? | |
81 ;; set-visited-file-modtime Impossible? | |
82 ;; shell-command Impossible? | |
83 ;; unhandled-file-name-directory | |
84 ;; vc-registered Finished (DAV) | |
85 ;; verify-visited-file-modtime | |
86 ;; write-region | |
87 | |
88 (defvar url-handler-regexp | |
89 "\\`\\(https?\\|ftp\\|file\\|nfs\\)://" | |
90 "*A regular expression for matching URLs handled by file-name-handler-alist. | |
91 Some valid URL protocols just do not make sense to visit interactively | |
92 \(about, data, info, irc, mailto, etc\). This regular expression | |
93 avoids conflicts with local files that look like URLs \(Gnus is | |
94 particularly bad at this\).") | |
95 | |
96 ;;;###autoload | |
54829
e38bd75fb54e
(url-handler-mode): New minor mode.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54770
diff
changeset
|
97 (define-minor-mode url-handler-mode |
e38bd75fb54e
(url-handler-mode): New minor mode.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54770
diff
changeset
|
98 "Use URL to handle URL-like file names." |
e38bd75fb54e
(url-handler-mode): New minor mode.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54770
diff
changeset
|
99 :global t |
e38bd75fb54e
(url-handler-mode): New minor mode.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54770
diff
changeset
|
100 (if (not (boundp 'file-name-handler-alist)) |
e38bd75fb54e
(url-handler-mode): New minor mode.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54770
diff
changeset
|
101 ;; Can't be turned ON anyway. |
e38bd75fb54e
(url-handler-mode): New minor mode.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54770
diff
changeset
|
102 (setq url-handler-mode nil) |
e38bd75fb54e
(url-handler-mode): New minor mode.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54770
diff
changeset
|
103 ;; Remove old entry, if any. |
e38bd75fb54e
(url-handler-mode): New minor mode.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54770
diff
changeset
|
104 (setq file-name-handler-alist |
e38bd75fb54e
(url-handler-mode): New minor mode.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54770
diff
changeset
|
105 (delq (rassq 'url-file-handler file-name-handler-alist) |
e38bd75fb54e
(url-handler-mode): New minor mode.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54770
diff
changeset
|
106 file-name-handler-alist)) |
e38bd75fb54e
(url-handler-mode): New minor mode.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54770
diff
changeset
|
107 (if url-handler-mode |
e38bd75fb54e
(url-handler-mode): New minor mode.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54770
diff
changeset
|
108 (push (cons url-handler-regexp 'url-file-handler) |
e38bd75fb54e
(url-handler-mode): New minor mode.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54770
diff
changeset
|
109 file-name-handler-alist)))) |
54695 | 110 |
111 (defun url-run-real-handler (operation args) | |
112 (let ((inhibit-file-name-handlers (cons 'url-file-handler | |
113 (if (eq operation inhibit-file-name-operation) | |
114 inhibit-file-name-handlers))) | |
115 (inhibit-file-name-operation operation)) | |
116 (apply operation args))) | |
117 | |
118 (defun url-file-handler (operation &rest args) | |
119 "Function called from the `file-name-handler-alist' routines. | |
120 OPERATION is what needs to be done (`file-exists-p', etc). ARGS are | |
121 the arguments that would have been passed to OPERATION." | |
122 (let ((fn (or (get operation 'url-file-handlers) | |
123 (intern-soft (format "url-%s" operation)))) | |
124 (val nil) | |
125 (hooked nil)) | |
126 (if (and fn (fboundp fn)) | |
127 (setq hooked t | |
128 val (apply fn args)) | |
129 (setq hooked nil | |
130 val (url-run-real-handler operation args))) | |
131 (url-debug 'handlers "%s %S%S => %S" (if hooked "Hooked" "Real") | |
132 operation args val) | |
133 val)) | |
134 | |
135 (defun url-file-handler-identity (&rest args) | |
136 ;; Identity function | |
137 (car args)) | |
138 | |
139 ;; These are operations that we can fully support | |
140 (put 'file-readable-p 'url-file-handlers 'url-file-exists-p) | |
141 (put 'substitute-in-file-name 'url-file-handlers 'url-file-handler-identity) | |
142 (put 'file-name-absolute-p 'url-file-handlers (lambda (&rest ignored) t)) | |
143 (put 'expand-file-name 'url-file-handlers 'url-handler-expand-file-name) | |
144 | |
145 ;; These are operations that we do not support yet (DAV!!!) | |
146 (put 'file-writable-p 'url-file-handlers 'ignore) | |
147 (put 'file-symlink-p 'url-file-handlers 'ignore) | |
148 | |
149 (defun url-handler-expand-file-name (file &optional base) | |
150 (if (file-name-absolute-p file) | |
151 (expand-file-name file "/") | |
152 (url-expand-file-name file base))) | |
153 | |
154 ;; The actual implementation | |
155 ;;;###autoload | |
156 (defun url-copy-file (url newname &optional ok-if-already-exists keep-time) | |
157 "Copy URL to NEWNAME. Both args must be strings. | |
158 Signals a `file-already-exists' error if file NEWNAME already exists, | |
159 unless a third argument OK-IF-ALREADY-EXISTS is supplied and non-nil. | |
160 A number as third arg means request confirmation if NEWNAME already exists. | |
161 This is what happens in interactive use with M-x. | |
162 Fourth arg KEEP-TIME non-nil means give the new file the same | |
163 last-modified time as the old one. (This works on only some systems.) | |
164 A prefix arg makes KEEP-TIME non-nil." | |
165 (if (and (file-exists-p newname) | |
166 (not ok-if-already-exists)) | |
167 (error "Opening output file: File already exists, %s" newname)) | |
168 (let ((buffer (url-retrieve-synchronously url)) | |
169 (handle nil)) | |
170 (if (not buffer) | |
171 (error "Opening input file: No such file or directory, %s" url)) | |
57174
4202aed8aa86
(url-insert-file-contents): Decode contents.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54931
diff
changeset
|
172 (with-current-buffer buffer |
54695 | 173 (setq handle (mm-dissect-buffer t))) |
174 (mm-save-part-to-file handle newname) | |
175 (kill-buffer buffer) | |
176 (mm-destroy-parts handle))) | |
177 | |
178 ;;;###autoload | |
179 (defun url-file-local-copy (url &rest ignored) | |
180 "Copy URL into a temporary file on this machine. | |
181 Returns the name of the local copy, or nil, if FILE is directly | |
182 accessible." | |
183 (let ((filename (make-temp-name "url"))) | |
184 (url-copy-file url filename) | |
185 filename)) | |
186 | |
187 ;;;###autoload | |
188 (defun url-insert-file-contents (url &optional visit beg end replace) | |
189 (let ((buffer (url-retrieve-synchronously url)) | |
190 (handle nil) | |
191 (data nil)) | |
192 (if (not buffer) | |
193 (error "Opening input file: No such file or directory, %s" url)) | |
194 (if visit (setq buffer-file-name url)) | |
57174
4202aed8aa86
(url-insert-file-contents): Decode contents.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54931
diff
changeset
|
195 (with-current-buffer buffer |
54695 | 196 (setq handle (mm-dissect-buffer t)) |
197 (set-buffer (mm-handle-buffer handle)) | |
57174
4202aed8aa86
(url-insert-file-contents): Decode contents.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54931
diff
changeset
|
198 (setq data (if beg (buffer-substring beg end) |
4202aed8aa86
(url-insert-file-contents): Decode contents.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54931
diff
changeset
|
199 (buffer-string)))) |
54695 | 200 (kill-buffer buffer) |
201 (mm-destroy-parts handle) | |
202 (if replace (delete-region (point-min) (point-max))) | |
203 (save-excursion | |
57174
4202aed8aa86
(url-insert-file-contents): Decode contents.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54931
diff
changeset
|
204 (let ((start (point))) |
4202aed8aa86
(url-insert-file-contents): Decode contents.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54931
diff
changeset
|
205 (insert data) |
4202aed8aa86
(url-insert-file-contents): Decode contents.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54931
diff
changeset
|
206 ;; FIXME: for text/plain data, we sometimes receive a `charset' |
4202aed8aa86
(url-insert-file-contents): Decode contents.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54931
diff
changeset
|
207 ;; annotation which we could use as a hint of the locale in use |
4202aed8aa86
(url-insert-file-contents): Decode contents.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54931
diff
changeset
|
208 ;; at the remote site. Not sure how/if that should be done. --Stef |
4202aed8aa86
(url-insert-file-contents): Decode contents.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54931
diff
changeset
|
209 (decode-coding-inserted-region |
57361
d3a3ba2db17f
(url-insert-file-contents): Use the URL to decide the
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
57174
diff
changeset
|
210 start (point) url visit beg end replace))) |
54695 | 211 (list url (length data)))) |
212 | |
213 (defun url-file-name-completion (url directory) | |
214 (error "Unimplemented")) | |
215 | |
216 (defun url-file-name-all-completions (file directory) | |
217 (error "Unimplemented")) | |
218 | |
219 ;; All other handlers map onto their respective backends. | |
220 (defmacro url-handlers-create-wrapper (method args) | |
221 `(defun ,(intern (format "url-%s" method)) ,args | |
222 ,(format "URL file-name-handler wrapper for `%s' call.\n---\n%s" method | |
223 (or (documentation method t) "No original documentation.")) | |
224 (setq url (url-generic-parse-url url)) | |
225 (when (url-type url) | |
226 (funcall (url-scheme-get-property (url-type url) (quote ,method)) | |
227 ,@(remove '&rest (remove '&optional args)))))) | |
228 | |
229 (url-handlers-create-wrapper file-exists-p (url)) | |
54931
2a15e5a02a89
Use new find-file-hook.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54829
diff
changeset
|
230 (url-handlers-create-wrapper file-attributes (url &optional id-format)) |
54695 | 231 (url-handlers-create-wrapper file-symlink-p (url)) |
232 (url-handlers-create-wrapper file-writable-p (url)) | |
233 (url-handlers-create-wrapper file-directory-p (url)) | |
234 (url-handlers-create-wrapper file-executable-p (url)) | |
235 | |
236 (if (featurep 'xemacs) | |
237 (progn | |
238 ;; XEmacs specific prototypes | |
239 (url-handlers-create-wrapper | |
240 directory-files (url &optional full match nosort files-only)) | |
241 (url-handlers-create-wrapper | |
242 file-truename (url &optional default))) | |
243 ;; Emacs specific prototypes | |
244 (url-handlers-create-wrapper | |
245 directory-files (url &optional full match nosort)) | |
246 (url-handlers-create-wrapper | |
247 file-truename (url &optional counter prev-dirs))) | |
248 | |
54931
2a15e5a02a89
Use new find-file-hook.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54829
diff
changeset
|
249 (add-hook 'find-file-hook 'url-handlers-set-buffer-mode) |
54695 | 250 |
251 (defun url-handlers-set-buffer-mode () | |
252 "Set correct modes for the current buffer if visiting a remote file." | |
253 (and (stringp buffer-file-name) | |
254 (string-match url-handler-regexp buffer-file-name) | |
255 (auto-save-mode 0))) | |
256 | |
257 (provide 'url-handlers) | |
54699 | 258 |
54829
e38bd75fb54e
(url-handler-mode): New minor mode.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54770
diff
changeset
|
259 ;; arch-tag: 7300b99c-cc83-42ff-9147-79b2723c62ac |
e38bd75fb54e
(url-handler-mode): New minor mode.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54770
diff
changeset
|
260 ;;; url-handlers.el ends here |