Github/emacs
2
0
Fork 1
mirror of git://git.sv.gnu.org/emacs.git synced 2026-02-16 17:24:23 +00:00
Code Issues Projects Releases Packages Wiki Activity

* lisp/url/url-handlers.el (url-file-handler): Don't assume any url-FOO

Browse source 
function is a good handler for FOO.
(url-copy-file, url-file-local-copy, url-insert-file-contents)
(url-file-name-completion, url-file-name-all-completions)
(url-handlers-create-wrapper): Explicitly register as handler.
This commit is contained in:
Stefan Monnier 2012-09-29 23:26:52 -04:00
parent 38a30d6462
commit 23855148a2
2 changed files with 29 additions and 10 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

8
lisp/url/ChangeLog
View file

@ -1,3 +1,11 @@
2012-09-30 Stefan Monnier <monnier@iro.umontreal.ca>
* url-handlers.el (url-file-handler): Don't assume any url-FOO function
is a good handler for FOO.
(url-copy-file, url-file-local-copy, url-insert-file-contents)
(url-file-name-completion, url-file-name-all-completions)
(url-handlers-create-wrapper): Explicitly register as handler.
2012-09-29 Bastien Guerry <bzg@gnu.org>
* url-util.el (url-insert-entities-in-string)

31
lisp/url/url-handlers.el
View file

@ -137,11 +137,13 @@ like URLs \(Gnus is particularly bad at this\)."
"Function called from the `file-name-handler-alist' routines.
OPERATION is what needs to be done (`file-exists-p', etc). ARGS are
the arguments that would have been passed to OPERATION."
(let ((fn (or (get operation 'url-file-handlers)
(intern-soft (format "url-%s" operation))))
(let ((fn (get operation 'url-file-handlers))
(val nil)
(hooked nil))
(if (and fn (fboundp fn))
(if (and (not fn) (intern-soft (format "url-%s" operation))
(fboundp (intern-soft (format "url-%s" operation))))
(error "Missing URL handler mapping for %s" operation))
(if fn
(setq hooked t
val (save-match-data (apply fn args)))
(setq hooked nil
@ -249,6 +251,7 @@ A prefix arg makes KEEP-TIME non-nil."
(mm-save-part-to-file handle newname)
(kill-buffer buffer)
(mm-destroy-parts handle)))
(put 'copy-file 'url-file-handlers 'url-copy-file)
;;;###autoload
(defun url-file-local-copy (url &rest ignored)
@ -258,6 +261,7 @@ accessible."
(let ((filename (make-temp-file "url")))
(url-copy-file url filename 'ok-if-already-exists)
filename))
(put 'file-local-copy 'url-file-handlers 'url-file-local-copy)
(defun url-insert (buffer &optional beg end)
"Insert the body of a URL object.
@ -300,22 +304,29 @@ They count bytes from the beginning of the body."
;; usual heuristic/rules that we apply to files.
(decode-coding-inserted-region start (point) url visit beg end replace))
(list url (car size-and-charset))))))
(put 'insert-file-contents 'url-file-handlers 'url-insert-file-contents)
(defun url-file-name-completion (url directory &optional predicate)
(error "Unimplemented"))
(put 'file-name-completion 'url-file-handlers 'url-file-name-completion)
(defun url-file-name-all-completions (file directory)
(error "Unimplemented"))
(put 'file-name-all-completions
'url-file-handlers 'url-file-name-all-completions)
;; All other handlers map onto their respective backends.
(defmacro url-handlers-create-wrapper (method args)
`(defun ,(intern (format "url-%s" method)) ,args
,(format "URL file-name-handler wrapper for `%s' call.\n---\n%s" method
(or (documentation method t) "No original documentation."))
(setq url (url-generic-parse-url url))
(when (url-type url)
(funcall (url-scheme-get-property (url-type url) (quote ,method))
,@(remove '&rest (remove '&optional args))))))
`(progn
(defun ,(intern (format "url-%s" method)) ,args
,(format "URL file-name-handler wrapper for `%s' call.\n---\n%s" method
(or (documentation method t) "No original documentation."))
(setq url (url-generic-parse-url url))
(when (url-type url)
(funcall (url-scheme-get-property (url-type url) (quote ,method))
,@(remove '&rest (remove '&optional args)))))
(unless (get ',method 'url-file-handlers)
(put ',method 'url-file-handlers ',(intern (format "url-%s" method))))))
(url-handlers-create-wrapper file-exists-p (url))
(url-handlers-create-wrapper file-attributes (url &optional id-format))