* lisp/url/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.

diff --git a/lisp/url/ChangeLog b/lisp/url/ChangeLog
index 279db5ee3e4492591192f6507445a02559727b15..a00d748a4a456a8e6dcd7ff0a37122030f1eb478 100644 (file)
--- a/lisp/url/ChangeLog
+++ b/lisp/url/ChangeLog
@@ -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)

diff --git a/lisp/url/url-handlers.el b/lisp/url/url-handlers.el
index f731f614d1382483305d6a77c45a334c05e7dcb6..796980afbd5e08ce88d0faf22eba38aa1ce9a78f 100644 (file)
--- a/lisp/url/url-handlers.el
+++ b/lisp/url/url-handlers.el
@@ -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))