Mercurial > emacs
annotate lisp/url/url-handlers.el @ 96987:359d8fb73538
(PURESIZE_CHECKING_RATIO): New macro.
(PURESIZE): Use it.
author | Stefan Monnier <monnier@iro.umontreal.ca> |
---|---|
date | Thu, 24 Jul 2008 20:26:48 +0000 |
parents | 7369ded3b436 |
children | a9dc0e7c3f2b |
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 |
64748
875dcc490074
Update years in copyright notice; nfc.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
64084
diff
changeset
|
3 ;; Copyright (C) 1996, 1997, 1998, 1999, 2004, |
79720 | 4 ;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc. |
54829
e38bd75fb54e
(url-handler-mode): New minor mode.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54770
diff
changeset
|
5 |
54695 | 6 ;; Keywords: comm, data, processes, hypermedia |
7 | |
54829
e38bd75fb54e
(url-handler-mode): New minor mode.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54770
diff
changeset
|
8 ;; This file is part of GNU Emacs. |
e38bd75fb54e
(url-handler-mode): New minor mode.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54770
diff
changeset
|
9 ;; |
94668
8259d0d8e107
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
91586
diff
changeset
|
10 ;; GNU Emacs is free software: you can redistribute it and/or modify |
54829
e38bd75fb54e
(url-handler-mode): New minor mode.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54770
diff
changeset
|
11 ;; it under the terms of the GNU General Public License as published by |
94668
8259d0d8e107
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
91586
diff
changeset
|
12 ;; the Free Software Foundation, either version 3 of the License, or |
8259d0d8e107
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
91586
diff
changeset
|
13 ;; (at your option) any later version. |
8259d0d8e107
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
91586
diff
changeset
|
14 |
54829
e38bd75fb54e
(url-handler-mode): New minor mode.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54770
diff
changeset
|
15 ;; 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
|
16 ;; 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
|
17 ;; 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
|
18 ;; GNU General Public License for more details. |
94668
8259d0d8e107
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
91586
diff
changeset
|
19 |
54829
e38bd75fb54e
(url-handler-mode): New minor mode.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54770
diff
changeset
|
20 ;; You should have received a copy of the GNU General Public License |
94668
8259d0d8e107
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
91586
diff
changeset
|
21 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. |
54829
e38bd75fb54e
(url-handler-mode): New minor mode.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54770
diff
changeset
|
22 |
e38bd75fb54e
(url-handler-mode): New minor mode.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54770
diff
changeset
|
23 ;;; Commentary: |
e38bd75fb54e
(url-handler-mode): New minor mode.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54770
diff
changeset
|
24 |
e38bd75fb54e
(url-handler-mode): New minor mode.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54770
diff
changeset
|
25 ;;; Code: |
54695 | 26 |
58900
96433f173a6e
Don't `require' everything eagerly.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
57427
diff
changeset
|
27 ;; (require 'url) |
86926
9b76416252fe
(top-level): Always require url-parse, not just when compiling.
Glenn Morris <rgm@gnu.org>
parents:
78222
diff
changeset
|
28 (require 'url-parse) |
58900
96433f173a6e
Don't `require' everything eagerly.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
57427
diff
changeset
|
29 ;; (require 'url-util) |
96433f173a6e
Don't `require' everything eagerly.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
57427
diff
changeset
|
30 (eval-when-compile (require 'mm-decode)) |
96433f173a6e
Don't `require' everything eagerly.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
57427
diff
changeset
|
31 ;; (require 'mailcap) |
96433f173a6e
Don't `require' everything eagerly.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
57427
diff
changeset
|
32 ;; The following functions in the byte compiler's warnings are known not |
96433f173a6e
Don't `require' everything eagerly.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
57427
diff
changeset
|
33 ;; to cause any real problem for the following reasons: |
96433f173a6e
Don't `require' everything eagerly.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
57427
diff
changeset
|
34 ;; - mm-save-part-to-file, mm-destroy-parts: always used |
96433f173a6e
Don't `require' everything eagerly.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
57427
diff
changeset
|
35 ;; after mm-dissect-buffer and defined in the same file. |
96433f173a6e
Don't `require' everything eagerly.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
57427
diff
changeset
|
36 ;; The following are autoloaded instead of `require'd to avoid eagerly |
96433f173a6e
Don't `require' everything eagerly.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
57427
diff
changeset
|
37 ;; loading all of URL when turning on url-handler-mode in the .emacs. |
96433f173a6e
Don't `require' everything eagerly.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
57427
diff
changeset
|
38 (autoload 'url-expand-file-name "url-expand" "Convert url to a fully specified url, and canonicalize it.") |
96433f173a6e
Don't `require' everything eagerly.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
57427
diff
changeset
|
39 (autoload 'mm-dissect-buffer "mm-decode" "Dissect the current buffer and return a list of MIME handles.") |
96433f173a6e
Don't `require' everything eagerly.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
57427
diff
changeset
|
40 (autoload 'url-scheme-get-property "url-methods" "Get property of a URL SCHEME.") |
54695 | 41 |
42 ;; Implementation status | |
43 ;; --------------------- | |
44 ;; Function Status | |
45 ;; ------------------------------------------------------------ | |
46 ;; add-name-to-file Needs DAV Bindings | |
47 ;; copy-file Broken (assumes 1st item is URL) | |
48 ;; delete-directory Finished (DAV) | |
49 ;; delete-file Finished (DAV) | |
50 ;; diff-latest-backup-file | |
51 ;; directory-file-name unnecessary (what about VMS)? | |
52 ;; directory-files Finished (DAV) | |
53 ;; dired-call-process | |
54 ;; dired-compress-file | |
55 ;; dired-uncache | |
56 ;; expand-file-name Finished | |
57 ;; file-accessible-directory-p | |
58 ;; file-attributes Finished, better with DAV | |
59 ;; file-directory-p Needs DAV, finished | |
60 ;; file-executable-p Finished | |
61 ;; file-exists-p Finished | |
62 ;; file-local-copy | |
63 ;; file-modes | |
64 ;; file-name-all-completions Finished (DAV) | |
65 ;; file-name-as-directory | |
66 ;; file-name-completion Finished (DAV) | |
67 ;; file-name-directory | |
68 ;; file-name-nondirectory | |
69 ;; file-name-sans-versions why? | |
70 ;; file-newer-than-file-p | |
71 ;; file-ownership-preserved-p No way to know | |
72 ;; file-readable-p Finished | |
73 ;; file-regular-p !directory_p | |
91586
cac14d4ce88f
* url-handlers.el (file-remote-p): Add handler.
Michael Albinus <michael.albinus@gmx.de>
parents:
91582
diff
changeset
|
74 ;; file-remote-p Finished |
54695 | 75 ;; file-symlink-p Needs DAV bindings |
76 ;; file-truename Needs DAV bindings | |
77 ;; file-writable-p Check for LOCK? | |
78 ;; find-backup-file-name why? | |
79 ;; get-file-buffer why? | |
80 ;; insert-directory Use DAV | |
81 ;; insert-file-contents Finished | |
82 ;; load | |
83 ;; make-directory Finished (DAV) | |
84 ;; make-symbolic-link Needs DAV bindings | |
85 ;; rename-file Finished (DAV) | |
86 ;; set-file-modes Use mod_dav specific executable flag? | |
87 ;; set-visited-file-modtime Impossible? | |
88 ;; shell-command Impossible? | |
89 ;; unhandled-file-name-directory | |
90 ;; vc-registered Finished (DAV) | |
91 ;; verify-visited-file-modtime | |
92 ;; write-region | |
93 | |
94 (defvar url-handler-regexp | |
95 "\\`\\(https?\\|ftp\\|file\\|nfs\\)://" | |
96486
7369ded3b436
Typo and docstring fixes.
Juanma Barranquero <lekktu@gmail.com>
parents:
95402
diff
changeset
|
96 "*A regular expression for matching URLs handled by `file-name-handler-alist'. |
54695 | 97 Some valid URL protocols just do not make sense to visit interactively |
98 \(about, data, info, irc, mailto, etc\). This regular expression | |
99 avoids conflicts with local files that look like URLs \(Gnus is | |
100 particularly bad at this\).") | |
101 | |
102 ;;;###autoload | |
54829
e38bd75fb54e
(url-handler-mode): New minor mode.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54770
diff
changeset
|
103 (define-minor-mode url-handler-mode |
e38bd75fb54e
(url-handler-mode): New minor mode.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54770
diff
changeset
|
104 "Use URL to handle URL-like file names." |
61290
507abf822567
(url-handler-mode): Specify :group.
Lute Kamstra <lute@gnu.org>
parents:
58900
diff
changeset
|
105 :global t :group 'url |
54829
e38bd75fb54e
(url-handler-mode): New minor mode.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54770
diff
changeset
|
106 (if (not (boundp 'file-name-handler-alist)) |
e38bd75fb54e
(url-handler-mode): New minor mode.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54770
diff
changeset
|
107 ;; Can't be turned ON anyway. |
e38bd75fb54e
(url-handler-mode): New minor mode.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54770
diff
changeset
|
108 (setq url-handler-mode nil) |
e38bd75fb54e
(url-handler-mode): New minor mode.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54770
diff
changeset
|
109 ;; Remove old entry, if any. |
e38bd75fb54e
(url-handler-mode): New minor mode.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54770
diff
changeset
|
110 (setq file-name-handler-alist |
e38bd75fb54e
(url-handler-mode): New minor mode.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54770
diff
changeset
|
111 (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
|
112 file-name-handler-alist)) |
e38bd75fb54e
(url-handler-mode): New minor mode.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54770
diff
changeset
|
113 (if url-handler-mode |
e38bd75fb54e
(url-handler-mode): New minor mode.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54770
diff
changeset
|
114 (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
|
115 file-name-handler-alist)))) |
54695 | 116 |
117 (defun url-run-real-handler (operation args) | |
118 (let ((inhibit-file-name-handlers (cons 'url-file-handler | |
119 (if (eq operation inhibit-file-name-operation) | |
120 inhibit-file-name-handlers))) | |
121 (inhibit-file-name-operation operation)) | |
122 (apply operation args))) | |
123 | |
79726
b1e1fa55b0a6
* url-handlers.el (url-file-handler): Autoload.
Michael Albinus <michael.albinus@gmx.de>
parents:
79720
diff
changeset
|
124 ;;;###autoload |
54695 | 125 (defun url-file-handler (operation &rest args) |
126 "Function called from the `file-name-handler-alist' routines. | |
127 OPERATION is what needs to be done (`file-exists-p', etc). ARGS are | |
128 the arguments that would have been passed to OPERATION." | |
129 (let ((fn (or (get operation 'url-file-handlers) | |
130 (intern-soft (format "url-%s" operation)))) | |
131 (val nil) | |
132 (hooked nil)) | |
133 (if (and fn (fboundp fn)) | |
134 (setq hooked t | |
135 val (apply fn args)) | |
136 (setq hooked nil | |
137 val (url-run-real-handler operation args))) | |
138 (url-debug 'handlers "%s %S%S => %S" (if hooked "Hooked" "Real") | |
139 operation args val) | |
140 val)) | |
141 | |
142 (defun url-file-handler-identity (&rest args) | |
143 ;; Identity function | |
144 (car args)) | |
145 | |
146 ;; These are operations that we can fully support | |
147 (put 'file-readable-p 'url-file-handlers 'url-file-exists-p) | |
148 (put 'substitute-in-file-name 'url-file-handlers 'url-file-handler-identity) | |
149 (put 'file-name-absolute-p 'url-file-handlers (lambda (&rest ignored) t)) | |
150 (put 'expand-file-name 'url-file-handlers 'url-handler-expand-file-name) | |
69716
73f175471c73
(url-handler-directory-file-name): New handler.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
67976
diff
changeset
|
151 (put 'directory-file-name 'url-file-handlers 'url-handler-directory-file-name) |
79901
5b75d8186a05
(unhandled-file-name-directory): Add handler.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
79726
diff
changeset
|
152 (put 'unhandled-file-name-directory 'url-file-handlers 'url-handler-unhandled-file-name-directory) |
91586
cac14d4ce88f
* url-handlers.el (file-remote-p): Add handler.
Michael Albinus <michael.albinus@gmx.de>
parents:
91582
diff
changeset
|
153 (put 'file-remote-p 'url-file-handlers 'url-handler-file-remote-p) |
69716
73f175471c73
(url-handler-directory-file-name): New handler.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
67976
diff
changeset
|
154 ;; (put 'file-name-as-directory 'url-file-handlers 'url-handler-file-name-as-directory) |
54695 | 155 |
156 ;; These are operations that we do not support yet (DAV!!!) | |
157 (put 'file-writable-p 'url-file-handlers 'ignore) | |
158 (put 'file-symlink-p 'url-file-handlers 'ignore) | |
63287
3e75cb9c1c5b
(vc-registered): Explicitly disable VC for URL files.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
61290
diff
changeset
|
159 ;; Just like for ange-ftp: let's not waste time trying to look for RCS/foo,v |
3e75cb9c1c5b
(vc-registered): Explicitly disable VC for URL files.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
61290
diff
changeset
|
160 ;; files and such since we can't do anything clever with them anyway. |
3e75cb9c1c5b
(vc-registered): Explicitly disable VC for URL files.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
61290
diff
changeset
|
161 (put 'vc-registered 'url-file-handlers 'ignore) |
54695 | 162 |
163 (defun url-handler-expand-file-name (file &optional base) | |
69716
73f175471c73
(url-handler-directory-file-name): New handler.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
67976
diff
changeset
|
164 ;; When we see "/foo/bar" in a file whose working dir is "http://bla/bla", |
73f175471c73
(url-handler-directory-file-name): New handler.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
67976
diff
changeset
|
165 ;; there are two interpretations possible: either it's a local "/foo/bar" |
73f175471c73
(url-handler-directory-file-name): New handler.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
67976
diff
changeset
|
166 ;; or it's "http:/bla/foo/bar". When working with URLs, the second |
73f175471c73
(url-handler-directory-file-name): New handler.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
67976
diff
changeset
|
167 ;; interpretation is the right one, but when working with Emacs file |
73f175471c73
(url-handler-directory-file-name): New handler.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
67976
diff
changeset
|
168 ;; names, the first is preferred. |
54695 | 169 (if (file-name-absolute-p file) |
170 (expand-file-name file "/") | |
171 (url-expand-file-name file base))) | |
172 | |
69716
73f175471c73
(url-handler-directory-file-name): New handler.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
67976
diff
changeset
|
173 ;; directory-file-name and file-name-as-directory are kind of hard to |
73f175471c73
(url-handler-directory-file-name): New handler.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
67976
diff
changeset
|
174 ;; implement really right for URLs since URLs can have repeated / chars. |
73f175471c73
(url-handler-directory-file-name): New handler.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
67976
diff
changeset
|
175 ;; We'd want the following behavior: |
73f175471c73
(url-handler-directory-file-name): New handler.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
67976
diff
changeset
|
176 ;; idempotence: (d-f-n (d-f-n X) == (d-f-n X) |
73f175471c73
(url-handler-directory-file-name): New handler.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
67976
diff
changeset
|
177 ;; idempotence: (f-n-a-d (f-n-a-d X) == (f-n-a-d X) |
73f175471c73
(url-handler-directory-file-name): New handler.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
67976
diff
changeset
|
178 ;; reversible: (d-f-n (f-n-a-d (d-f-n X))) == (d-f-n X) |
73f175471c73
(url-handler-directory-file-name): New handler.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
67976
diff
changeset
|
179 ;; reversible: (f-n-a-d (d-f-n (f-n-a-d X))) == (f-n-a-d X) |
73f175471c73
(url-handler-directory-file-name): New handler.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
67976
diff
changeset
|
180 (defun url-handler-directory-file-name (dir) |
73f175471c73
(url-handler-directory-file-name): New handler.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
67976
diff
changeset
|
181 ;; When there's more than a single /, just don't touch the slashes at all. |
73f175471c73
(url-handler-directory-file-name): New handler.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
67976
diff
changeset
|
182 (if (string-match "//\\'" dir) dir |
73f175471c73
(url-handler-directory-file-name): New handler.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
67976
diff
changeset
|
183 (url-run-real-handler 'directory-file-name (list dir)))) |
73f175471c73
(url-handler-directory-file-name): New handler.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
67976
diff
changeset
|
184 |
79901
5b75d8186a05
(unhandled-file-name-directory): Add handler.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
79726
diff
changeset
|
185 (defun url-handler-unhandled-file-name-directory (filename) |
91582
9c08b66c6c21
(url-handler-unhandled-file-name-directory):
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
87903
diff
changeset
|
186 (let ((url (url-generic-parse-url filename))) |
9c08b66c6c21
(url-handler-unhandled-file-name-directory):
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
87903
diff
changeset
|
187 (if (equal (url-type url) "file") |
9c08b66c6c21
(url-handler-unhandled-file-name-directory):
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
87903
diff
changeset
|
188 ;; `file' URLs are actually local. The filename part may be "" |
9c08b66c6c21
(url-handler-unhandled-file-name-directory):
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
87903
diff
changeset
|
189 ;; which really stands for "/". |
9c08b66c6c21
(url-handler-unhandled-file-name-directory):
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
87903
diff
changeset
|
190 ;; FIXME: maybe we should check that the host part is "" or "localhost" |
9c08b66c6c21
(url-handler-unhandled-file-name-directory):
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
87903
diff
changeset
|
191 ;; or some name that represents the local host? |
9c08b66c6c21
(url-handler-unhandled-file-name-directory):
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
87903
diff
changeset
|
192 (or (file-name-directory (url-filename url)) "/") |
9c08b66c6c21
(url-handler-unhandled-file-name-directory):
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
87903
diff
changeset
|
193 ;; All other URLs are not expected to be directly accessible from |
9c08b66c6c21
(url-handler-unhandled-file-name-directory):
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
87903
diff
changeset
|
194 ;; a local process. |
9c08b66c6c21
(url-handler-unhandled-file-name-directory):
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
87903
diff
changeset
|
195 nil))) |
79901
5b75d8186a05
(unhandled-file-name-directory): Add handler.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
79726
diff
changeset
|
196 |
91586
cac14d4ce88f
* url-handlers.el (file-remote-p): Add handler.
Michael Albinus <michael.albinus@gmx.de>
parents:
91582
diff
changeset
|
197 (defun url-handler-file-remote-p (filename &optional identification connected) |
cac14d4ce88f
* url-handlers.el (file-remote-p): Add handler.
Michael Albinus <michael.albinus@gmx.de>
parents:
91582
diff
changeset
|
198 (let ((url (url-generic-parse-url filename))) |
cac14d4ce88f
* url-handlers.el (file-remote-p): Add handler.
Michael Albinus <michael.albinus@gmx.de>
parents:
91582
diff
changeset
|
199 (if (and (url-type url) (not (equal (url-type url) "file"))) |
cac14d4ce88f
* url-handlers.el (file-remote-p): Add handler.
Michael Albinus <michael.albinus@gmx.de>
parents:
91582
diff
changeset
|
200 ;; Maybe we can find a suitable check for CONNECTED. For now, |
cac14d4ce88f
* url-handlers.el (file-remote-p): Add handler.
Michael Albinus <michael.albinus@gmx.de>
parents:
91582
diff
changeset
|
201 ;; we ignore it. |
cac14d4ce88f
* url-handlers.el (file-remote-p): Add handler.
Michael Albinus <michael.albinus@gmx.de>
parents:
91582
diff
changeset
|
202 (cond |
cac14d4ce88f
* url-handlers.el (file-remote-p): Add handler.
Michael Albinus <michael.albinus@gmx.de>
parents:
91582
diff
changeset
|
203 ((eq identification 'method) (url-type url)) |
cac14d4ce88f
* url-handlers.el (file-remote-p): Add handler.
Michael Albinus <michael.albinus@gmx.de>
parents:
91582
diff
changeset
|
204 ((eq identification 'user) (url-user url)) |
cac14d4ce88f
* url-handlers.el (file-remote-p): Add handler.
Michael Albinus <michael.albinus@gmx.de>
parents:
91582
diff
changeset
|
205 ((eq identification 'host) (url-host url)) |
cac14d4ce88f
* url-handlers.el (file-remote-p): Add handler.
Michael Albinus <michael.albinus@gmx.de>
parents:
91582
diff
changeset
|
206 ((eq identification 'localname) (url-filename url)) |
cac14d4ce88f
* url-handlers.el (file-remote-p): Add handler.
Michael Albinus <michael.albinus@gmx.de>
parents:
91582
diff
changeset
|
207 (t (url-recreate-url |
cac14d4ce88f
* url-handlers.el (file-remote-p): Add handler.
Michael Albinus <michael.albinus@gmx.de>
parents:
91582
diff
changeset
|
208 (url-parse-make-urlobj (url-type url) (url-user url) nil |
cac14d4ce88f
* url-handlers.el (file-remote-p): Add handler.
Michael Albinus <michael.albinus@gmx.de>
parents:
91582
diff
changeset
|
209 (url-host url) (url-port url))))) |
cac14d4ce88f
* url-handlers.el (file-remote-p): Add handler.
Michael Albinus <michael.albinus@gmx.de>
parents:
91582
diff
changeset
|
210 ;; If there is no URL type, or it is a "file://" URL, the |
cac14d4ce88f
* url-handlers.el (file-remote-p): Add handler.
Michael Albinus <michael.albinus@gmx.de>
parents:
91582
diff
changeset
|
211 ;; filename is expected to be non remote. A more subtle check |
cac14d4ce88f
* url-handlers.el (file-remote-p): Add handler.
Michael Albinus <michael.albinus@gmx.de>
parents:
91582
diff
changeset
|
212 ;; for "file://" URLs could be applied, as said in |
cac14d4ce88f
* url-handlers.el (file-remote-p): Add handler.
Michael Albinus <michael.albinus@gmx.de>
parents:
91582
diff
changeset
|
213 ;; `url-handler-unhandled-file-name-directory'. |
cac14d4ce88f
* url-handlers.el (file-remote-p): Add handler.
Michael Albinus <michael.albinus@gmx.de>
parents:
91582
diff
changeset
|
214 nil))) |
cac14d4ce88f
* url-handlers.el (file-remote-p): Add handler.
Michael Albinus <michael.albinus@gmx.de>
parents:
91582
diff
changeset
|
215 |
54695 | 216 ;; The actual implementation |
217 ;;;###autoload | |
218 (defun url-copy-file (url newname &optional ok-if-already-exists keep-time) | |
219 "Copy URL to NEWNAME. Both args must be strings. | |
220 Signals a `file-already-exists' error if file NEWNAME already exists, | |
221 unless a third argument OK-IF-ALREADY-EXISTS is supplied and non-nil. | |
222 A number as third arg means request confirmation if NEWNAME already exists. | |
223 This is what happens in interactive use with M-x. | |
224 Fourth arg KEEP-TIME non-nil means give the new file the same | |
225 last-modified time as the old one. (This works on only some systems.) | |
226 A prefix arg makes KEEP-TIME non-nil." | |
227 (if (and (file-exists-p newname) | |
228 (not ok-if-already-exists)) | |
229 (error "Opening output file: File already exists, %s" newname)) | |
230 (let ((buffer (url-retrieve-synchronously url)) | |
231 (handle nil)) | |
232 (if (not buffer) | |
233 (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
|
234 (with-current-buffer buffer |
54695 | 235 (setq handle (mm-dissect-buffer t))) |
236 (mm-save-part-to-file handle newname) | |
237 (kill-buffer buffer) | |
238 (mm-destroy-parts handle))) | |
239 | |
240 ;;;###autoload | |
241 (defun url-file-local-copy (url &rest ignored) | |
242 "Copy URL into a temporary file on this machine. | |
243 Returns the name of the local copy, or nil, if FILE is directly | |
244 accessible." | |
69716
73f175471c73
(url-handler-directory-file-name): New handler.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
67976
diff
changeset
|
245 (let ((filename (make-temp-file "url"))) |
72520
97366e4e79a5
(url-file-local-copy): Tell url-copy-file that the dest file will already exist.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
70240
diff
changeset
|
246 (url-copy-file url filename 'ok-if-already-exists) |
54695 | 247 filename)) |
248 | |
70240
00c538418054
(url-insert): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
69716
diff
changeset
|
249 (defun url-insert (buffer &optional beg end) |
00c538418054
(url-insert): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
69716
diff
changeset
|
250 "Insert the body of a URL object. |
00c538418054
(url-insert): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
69716
diff
changeset
|
251 BUFFER should be a complete URL buffer as returned by `url-retrieve'. |
00c538418054
(url-insert): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
69716
diff
changeset
|
252 If the headers specify a coding-system, it is applied to the body before it is inserted. |
00c538418054
(url-insert): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
69716
diff
changeset
|
253 Returns a list of the form (SIZE CHARSET), where SIZE is the size in bytes |
00c538418054
(url-insert): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
69716
diff
changeset
|
254 of the inserted text and CHARSET is the charset that was specified in the header, |
00c538418054
(url-insert): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
69716
diff
changeset
|
255 or nil if none was found. |
00c538418054
(url-insert): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
69716
diff
changeset
|
256 BEG and END can be used to only insert a subpart of the body. |
00c538418054
(url-insert): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
69716
diff
changeset
|
257 They count bytes from the beginning of the body." |
00c538418054
(url-insert): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
69716
diff
changeset
|
258 (let* ((handle (with-current-buffer buffer (mm-dissect-buffer t))) |
00c538418054
(url-insert): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
69716
diff
changeset
|
259 (data (with-current-buffer (mm-handle-buffer handle) |
00c538418054
(url-insert): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
69716
diff
changeset
|
260 (if beg |
00c538418054
(url-insert): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
69716
diff
changeset
|
261 (buffer-substring (+ (point-min) beg) |
00c538418054
(url-insert): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
69716
diff
changeset
|
262 (if end (+ (point-min) end) (point-max))) |
00c538418054
(url-insert): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
69716
diff
changeset
|
263 (buffer-string)))) |
00c538418054
(url-insert): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
69716
diff
changeset
|
264 (charset (mail-content-type-get (mm-handle-type handle) |
00c538418054
(url-insert): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
69716
diff
changeset
|
265 'charset))) |
00c538418054
(url-insert): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
69716
diff
changeset
|
266 (mm-destroy-parts handle) |
00c538418054
(url-insert): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
69716
diff
changeset
|
267 (if charset |
00c538418054
(url-insert): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
69716
diff
changeset
|
268 (insert (mm-decode-string data (mm-charset-to-coding-system charset))) |
00c538418054
(url-insert): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
69716
diff
changeset
|
269 (insert data)) |
00c538418054
(url-insert): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
69716
diff
changeset
|
270 (list (length data) charset))) |
00c538418054
(url-insert): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
69716
diff
changeset
|
271 |
54695 | 272 ;;;###autoload |
273 (defun url-insert-file-contents (url &optional visit beg end replace) | |
70240
00c538418054
(url-insert): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
69716
diff
changeset
|
274 (let ((buffer (url-retrieve-synchronously url))) |
54695 | 275 (if (not buffer) |
276 (error "Opening input file: No such file or directory, %s" url)) | |
277 (if visit (setq buffer-file-name url)) | |
278 (save-excursion | |
70240
00c538418054
(url-insert): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
69716
diff
changeset
|
279 (let* ((start (point)) |
00c538418054
(url-insert): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
69716
diff
changeset
|
280 (size-and-charset (url-insert buffer beg end))) |
00c538418054
(url-insert): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
69716
diff
changeset
|
281 (kill-buffer buffer) |
00c538418054
(url-insert): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
69716
diff
changeset
|
282 (when replace |
00c538418054
(url-insert): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
69716
diff
changeset
|
283 (delete-region (point-min) start) |
00c538418054
(url-insert): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
69716
diff
changeset
|
284 (delete-region (point) (point-max))) |
00c538418054
(url-insert): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
69716
diff
changeset
|
285 (unless (cadr size-and-charset) |
00c538418054
(url-insert): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
69716
diff
changeset
|
286 ;; If the headers don't specify any particular charset, use the |
00c538418054
(url-insert): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
69716
diff
changeset
|
287 ;; usual heuristic/rules that we apply to files. |
00c538418054
(url-insert): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
69716
diff
changeset
|
288 (decode-coding-inserted-region start (point) url visit beg end replace)) |
00c538418054
(url-insert): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
69716
diff
changeset
|
289 (list url (car size-and-charset)))))) |
54695 | 290 |
95402
6f0d3ea7dbbe
(url-file-name-completion): Add missing argument.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
94668
diff
changeset
|
291 (defun url-file-name-completion (url directory &optional predicate) |
54695 | 292 (error "Unimplemented")) |
293 | |
294 (defun url-file-name-all-completions (file directory) | |
295 (error "Unimplemented")) | |
296 | |
297 ;; All other handlers map onto their respective backends. | |
298 (defmacro url-handlers-create-wrapper (method args) | |
299 `(defun ,(intern (format "url-%s" method)) ,args | |
300 ,(format "URL file-name-handler wrapper for `%s' call.\n---\n%s" method | |
301 (or (documentation method t) "No original documentation.")) | |
302 (setq url (url-generic-parse-url url)) | |
303 (when (url-type url) | |
304 (funcall (url-scheme-get-property (url-type url) (quote ,method)) | |
305 ,@(remove '&rest (remove '&optional args)))))) | |
306 | |
307 (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
|
308 (url-handlers-create-wrapper file-attributes (url &optional id-format)) |
54695 | 309 (url-handlers-create-wrapper file-symlink-p (url)) |
310 (url-handlers-create-wrapper file-writable-p (url)) | |
311 (url-handlers-create-wrapper file-directory-p (url)) | |
312 (url-handlers-create-wrapper file-executable-p (url)) | |
66225 | 313 (url-handlers-create-wrapper directory-files (url &optional full match nosort)) |
314 (url-handlers-create-wrapper file-truename (url &optional counter prev-dirs)) | |
54695 | 315 |
54931
2a15e5a02a89
Use new find-file-hook.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54829
diff
changeset
|
316 (add-hook 'find-file-hook 'url-handlers-set-buffer-mode) |
54695 | 317 |
318 (defun url-handlers-set-buffer-mode () | |
319 "Set correct modes for the current buffer if visiting a remote file." | |
320 (and (stringp buffer-file-name) | |
321 (string-match url-handler-regexp buffer-file-name) | |
322 (auto-save-mode 0))) | |
323 | |
324 (provide 'url-handlers) | |
54699 | 325 |
54829
e38bd75fb54e
(url-handler-mode): New minor mode.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54770
diff
changeset
|
326 ;; arch-tag: 7300b99c-cc83-42ff-9147-79b2723c62ac |
e38bd75fb54e
(url-handler-mode): New minor mode.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54770
diff
changeset
|
327 ;;; url-handlers.el ends here |