1 ;;; url-handlers.el --- file-name-handler stuff for URL loading
3 ;; Copyright (c) 1996,97,98,1999,2004 Free Software Foundation, Inc.
4 ;; Copyright (c) 1993 - 1996 by William M. Perry <wmperry@cs.indiana.edu>
6 ;; Keywords: comm, data, processes, hypermedia
8 ;; This file is part of GNU Emacs.
10 ;; GNU Emacs is free software; you can redistribute it and/or modify
11 ;; it under the terms of the GNU General Public License as published by
12 ;; the Free Software Foundation; either version 2, or (at your option)
15 ;; GNU Emacs is distributed in the hope that it will be useful,
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18 ;; GNU General Public License for more details.
20 ;; You should have received a copy of the GNU General Public License
21 ;; along with GNU Emacs; see the file COPYING. If not, write to the
22 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
23 ;; Boston, MA 02111-1307, USA.
38 ;; Implementation status
39 ;; ---------------------
41 ;; ------------------------------------------------------------
42 ;; add-name-to-file Needs DAV Bindings
43 ;; copy-file Broken (assumes 1st item is URL)
44 ;; delete-directory Finished (DAV)
45 ;; delete-file Finished (DAV)
46 ;; diff-latest-backup-file
47 ;; directory-file-name unnecessary (what about VMS)?
48 ;; directory-files Finished (DAV)
50 ;; dired-compress-file
52 ;; expand-file-name Finished
53 ;; file-accessible-directory-p
54 ;; file-attributes Finished, better with DAV
55 ;; file-directory-p Needs DAV, finished
56 ;; file-executable-p Finished
57 ;; file-exists-p Finished
60 ;; file-name-all-completions Finished (DAV)
61 ;; file-name-as-directory
62 ;; file-name-completion Finished (DAV)
63 ;; file-name-directory
64 ;; file-name-nondirectory
65 ;; file-name-sans-versions why?
66 ;; file-newer-than-file-p
67 ;; file-ownership-preserved-p No way to know
68 ;; file-readable-p Finished
69 ;; file-regular-p !directory_p
70 ;; file-symlink-p Needs DAV bindings
71 ;; file-truename Needs DAV bindings
72 ;; file-writable-p Check for LOCK?
73 ;; find-backup-file-name why?
74 ;; get-file-buffer why?
75 ;; insert-directory Use DAV
76 ;; insert-file-contents Finished
78 ;; make-directory Finished (DAV)
79 ;; make-symbolic-link Needs DAV bindings
80 ;; rename-file Finished (DAV)
81 ;; set-file-modes Use mod_dav specific executable flag?
82 ;; set-visited-file-modtime Impossible?
83 ;; shell-command Impossible?
84 ;; unhandled-file-name-directory
85 ;; vc-registered Finished (DAV)
86 ;; verify-visited-file-modtime
89 (defvar url-handler-regexp
90 "\\`\\(https?\\|ftp\\|file\\|nfs\\)://"
91 "*A regular expression for matching URLs handled by file-name-handler-alist.
92 Some valid URL protocols just do not make sense to visit interactively
93 \(about, data, info, irc, mailto, etc\). This regular expression
94 avoids conflicts with local files that look like URLs \(Gnus is
95 particularly bad at this\).")
98 (define-minor-mode url-handler-mode
99 "Use URL to handle URL-like file names."
101 (if (not (boundp 'file-name-handler-alist
))
102 ;; Can't be turned ON anyway.
103 (setq url-handler-mode nil
)
104 ;; Remove old entry, if any.
105 (setq file-name-handler-alist
106 (delq (rassq 'url-file-handler file-name-handler-alist
)
107 file-name-handler-alist
))
109 (push (cons url-handler-regexp
'url-file-handler
)
110 file-name-handler-alist
))))
112 (defun url-run-real-handler (operation args
)
113 (let ((inhibit-file-name-handlers (cons 'url-file-handler
114 (if (eq operation inhibit-file-name-operation
)
115 inhibit-file-name-handlers
)))
116 (inhibit-file-name-operation operation
))
117 (apply operation args
)))
119 (defun url-file-handler (operation &rest args
)
120 "Function called from the `file-name-handler-alist' routines.
121 OPERATION is what needs to be done (`file-exists-p', etc). ARGS are
122 the arguments that would have been passed to OPERATION."
123 (let ((fn (or (get operation
'url-file-handlers
)
124 (intern-soft (format "url-%s" operation
))))
127 (if (and fn
(fboundp fn
))
131 val
(url-run-real-handler operation args
)))
132 (url-debug 'handlers
"%s %S%S => %S" (if hooked
"Hooked" "Real")
136 (defun url-file-handler-identity (&rest args
)
140 ;; These are operations that we can fully support
141 (put 'file-readable-p
'url-file-handlers
'url-file-exists-p
)
142 (put 'substitute-in-file-name
'url-file-handlers
'url-file-handler-identity
)
143 (put 'file-name-absolute-p
'url-file-handlers
(lambda (&rest ignored
) t
))
144 (put 'expand-file-name
'url-file-handlers
'url-handler-expand-file-name
)
146 ;; These are operations that we do not support yet (DAV!!!)
147 (put 'file-writable-p
'url-file-handlers
'ignore
)
148 (put 'file-symlink-p
'url-file-handlers
'ignore
)
150 (defun url-handler-expand-file-name (file &optional base
)
151 (if (file-name-absolute-p file
)
152 (expand-file-name file
"/")
153 (url-expand-file-name file base
)))
155 ;; The actual implementation
157 (defun url-copy-file (url newname
&optional ok-if-already-exists keep-time
)
158 "Copy URL to NEWNAME. Both args must be strings.
159 Signals a `file-already-exists' error if file NEWNAME already exists,
160 unless a third argument OK-IF-ALREADY-EXISTS is supplied and non-nil.
161 A number as third arg means request confirmation if NEWNAME already exists.
162 This is what happens in interactive use with M-x.
163 Fourth arg KEEP-TIME non-nil means give the new file the same
164 last-modified time as the old one. (This works on only some systems.)
165 A prefix arg makes KEEP-TIME non-nil."
166 (if (and (file-exists-p newname
)
167 (not ok-if-already-exists
))
168 (error "Opening output file: File already exists, %s" newname
))
169 (let ((buffer (url-retrieve-synchronously url
))
172 (error "Opening input file: No such file or directory, %s" url
))
175 (setq handle
(mm-dissect-buffer t
)))
176 (mm-save-part-to-file handle newname
)
178 (mm-destroy-parts handle
)))
181 (defun url-file-local-copy (url &rest ignored
)
182 "Copy URL into a temporary file on this machine.
183 Returns the name of the local copy, or nil, if FILE is directly
185 (let ((filename (make-temp-name "url")))
186 (url-copy-file url filename
)
190 (defun url-insert-file-contents (url &optional visit beg end replace
)
191 (let ((buffer (url-retrieve-synchronously url
))
195 (error "Opening input file: No such file or directory, %s" url
))
196 (if visit
(setq buffer-file-name url
))
199 (setq handle
(mm-dissect-buffer t
))
200 (set-buffer (mm-handle-buffer handle
))
202 (setq data
(buffer-substring beg end
))
203 (setq data
(buffer-string))))
205 (mm-destroy-parts handle
)
206 (if replace
(delete-region (point-min) (point-max)))
209 (list url
(length data
))))
211 (defun url-file-name-completion (url directory
)
212 (error "Unimplemented"))
214 (defun url-file-name-all-completions (file directory
)
215 (error "Unimplemented"))
217 ;; All other handlers map onto their respective backends.
218 (defmacro url-handlers-create-wrapper
(method args
)
219 `(defun ,(intern (format "url-%s" method
)) ,args
220 ,(format "URL file-name-handler wrapper for `%s' call.\n---\n%s" method
221 (or (documentation method t
) "No original documentation."))
222 (setq url
(url-generic-parse-url url
))
224 (funcall (url-scheme-get-property (url-type url
) (quote ,method
))
225 ,@(remove '&rest
(remove '&optional args
))))))
227 (url-handlers-create-wrapper file-exists-p
(url))
228 (url-handlers-create-wrapper file-attributes
(url &optional id-format
))
229 (url-handlers-create-wrapper file-symlink-p
(url))
230 (url-handlers-create-wrapper file-writable-p
(url))
231 (url-handlers-create-wrapper file-directory-p
(url))
232 (url-handlers-create-wrapper file-executable-p
(url))
234 (if (featurep 'xemacs
)
236 ;; XEmacs specific prototypes
237 (url-handlers-create-wrapper
238 directory-files
(url &optional full match nosort files-only
))
239 (url-handlers-create-wrapper
240 file-truename
(url &optional default
)))
241 ;; Emacs specific prototypes
242 (url-handlers-create-wrapper
243 directory-files
(url &optional full match nosort
))
244 (url-handlers-create-wrapper
245 file-truename
(url &optional counter prev-dirs
)))
247 (add-hook 'find-file-hook
'url-handlers-set-buffer-mode
)
249 (defun url-handlers-set-buffer-mode ()
250 "Set correct modes for the current buffer if visiting a remote file."
251 (and (stringp buffer-file-name
)
252 (string-match url-handler-regexp buffer-file-name
)
255 (provide 'url-handlers
)
257 ;; arch-tag: 7300b99c-cc83-42ff-9147-79b2723c62ac
258 ;;; url-handlers.el ends here