8 files changed, 69 insertions, 45 deletions

diff --git a/lisp/url/ChangeLog b/lisp/url/ChangeLog
index 546af477106..5718346b89b 100644
--- a/lisp/url/ChangeLog
+++ b/lisp/url/ChangeLog
@@ -1,3 +1,27 @@
+2005-06-14  Juanma Barranquero  <lekktu@gmail.com>
+
+        * url-history.el (url-completion-function): Follow error
+        conventions.
+
+2005-06-13  Stefan Monnier  <monnier@iro.umontreal.ca>
+
+        * url-file.el (url-file, url-file-asynch-callback): with-current-buffer.
+
+2005-06-10  Stefan Monnier  <monnier@iro.umontreal.ca>
+
+        * url-dav.el: Remove most autoload cookies.
+        Don't hook into the url-file-handler since it currently breaks all
+        non-HTTP URLs.
+
+        * url-handlers.el (vc-registered): Explicitly disable VC for URL files.
+
+        * url.el (url-retrieve-synchronously): Don't exit precipitously when
+        fetching a file via ange-ftp.
+
+2005-06-10  Juanma Barranquero  <lekktu@gmail.com>
+
+        * url-cookie.el (url-cookie-multiple-line): Fix spelling in docstring.
+
 2005-05-19  Juanma Barranquero  <lekktu@gmail.com>
 
         * url-cookie.el (url-cookie-multiple-line):
diff --git a/lisp/url/url-cookie.el b/lisp/url/url-cookie.el
index 328e60b63bc..7cee222c373 100644
--- a/lisp/url/url-cookie.el
+++ b/lisp/url/url-cookie.el
@@ -73,7 +73,7 @@
 
 (defvar url-cookie-storage nil         "Where cookies are stored.")
 (defvar url-cookie-secure-storage nil  "Where secure cookies are stored.")
-(defcustom url-cookie-file nil            "*Where cookies are stored on disk."
+(defcustom url-cookie-file nil         "*Where cookies are stored on disk."
   :type '(choice (const :tag "Default" :value nil) file)
   :group 'url-file
   :group 'url-cookie)
@@ -86,7 +86,7 @@
 (defcustom url-cookie-multiple-line nil
   "*If nil, HTTP requests put all cookies for the server on one line.
 Some web servers, such as http://www.hotmail.com/, only accept cookies
-when they are on one line.  This is broken behaviour, but just try
+when they are on one line.  This is broken behavior, but just try
 telling Microsoft that."
   :type 'boolean
   :group 'url-cookie)
diff --git a/lisp/url/url-dav.el b/lisp/url/url-dav.el
index a0f1ae1ebe7..a3320f88e96 100644
--- a/lisp/url/url-dav.el
+++ b/lisp/url/url-dav.el
@@ -457,7 +457,6 @@ added to this list, so most requests can just pass in nil."
                "</" (symbol-name tag) ">\n"))))
     (url-dav-process-response (url-retrieve-synchronously url) url)))
 
-;;;###autoload
 (defun url-dav-get-properties (url &optional attributes depth namespaces)
   "Return properties for URL, up to DEPTH levels deep.
 
@@ -487,7 +486,6 @@ identify the owner of a LOCK when requesting it.  This will be shown
 to other users when the DAV:lockdiscovery property is requested, so
 make sure you are comfortable with it leaking to the outside world.")
 
-;;;###autoload
 (defun url-dav-lock-resource (url exclusive &optional depth)
   "Request a lock on URL.  If EXCLUSIVE is non-nil, get an exclusive lock.
 Optional 3rd argument DEPTH says how deep the lock should go, default is 0
@@ -528,7 +526,6 @@ FAILURE-RESULTS is a list of (URL STATUS)."
         (push (list url child-status) failures)))
     (cons successes failures)))
 
-;;;###autoload
 (defun url-dav-active-locks (url &optional depth)
   "Return an assoc list of all active locks on URL."
   (let ((response (url-dav-get-properties url '(DAV:lockdiscovery) depth))
@@ -563,7 +560,6 @@ FAILURE-RESULTS is a list of (URL STATUS)."
                 results)))
     results))
 
-;;;###autoload
 (defun url-dav-unlock-resource (url lock-token)
   "Release the lock on URL represented by LOCK-TOKEN.
 Returns t iff the lock was successfully released."
@@ -624,7 +620,6 @@ Returns t iff the lock was successfully released."
 
 (autoload 'url-http-head-file-attributes "url-http")
 
-;;;###autoload
 (defun url-dav-file-attributes (url &optional id-format)
   (let ((properties (cdar (url-dav-get-properties url)))
         (attributes nil))
@@ -680,7 +675,6 @@ Returns t iff the lock was successfully released."
       (setq attributes (url-http-head-file-attributes url id-format)))
     attributes))
 
-;;;###autoload
 (defun url-dav-save-resource (url obj &optional content-type lock-token)
   "Save OBJ as URL using WebDAV.
 URL must be a fully qualified URL.
@@ -736,7 +730,6 @@ Use with care, and even then think three times.
                                    (concat "(<" ,lock-token ">)"))))))))
 
 
-;;;###autoload
 (defun url-dav-delete-directory (url &optional recursive lock-token)
   "Delete the WebDAV collection URL.
 If optional second argument RECURSIVE is non-nil, then delete all
@@ -761,7 +754,6 @@ files in the collection as well."
            props))
   nil)
 
-;;;###autoload
 (defun url-dav-delete-file (url &optional lock-token)
   "Delete file named URL."
   (let ((props nil)
@@ -781,7 +773,6 @@ files in the collection as well."
           props))
   nil)
 
-;;;###autoload
 (defun url-dav-directory-files (url &optional full match nosort files-only)
   "Return a list of names of files in DIRECTORY.
 There are three optional arguments:
@@ -828,13 +819,11 @@ If NOSORT is non-nil, the list is not sorted--its order is unpredictable.
         files
       (sort files 'string-lessp))))
 
-;;;###autoload
 (defun url-dav-file-directory-p (url)
   "Return t if URL names an existing DAV collection."
   (let ((properties (cdar (url-dav-get-properties url '(DAV:resourcetype)))))
     (eq (plist-get properties 'DAV:resourcetype) 'DAV:collection)))
 
-;;;###autoload
 (defun url-dav-make-directory (url &optional parents)
   "Create the directory DIR and any nonexistent parent dirs."
   (declare (special url-http-response-status))
@@ -864,7 +853,6 @@ If NOSORT is non-nil, the list is not sorted--its order is unpredictable.
         (kill-buffer buffer)))
     result))
 
-;;;###autoload
 (defun url-dav-rename-file (oldname newname &optional overwrite)
   (if (not (and (string-match url-handler-regexp oldname)
                 (string-match url-handler-regexp newname)))
@@ -905,13 +893,11 @@ If NOSORT is non-nil, the list is not sorted--its order is unpredictable.
           props)
     t))
 
-;;;###autoload
 (defun url-dav-file-name-all-completions (file url)
   "Return a list of all completions of file name FILE in directory DIRECTORY.
 These are all file names in directory DIRECTORY which begin with FILE."
   (url-dav-directory-files url nil (concat "^" file ".*")))
 
-;;;###autoload
 (defun url-dav-file-name-completion (file url)
   "Complete file name FILE in directory DIRECTORY.
 Returns the longest string
@@ -951,15 +937,18 @@ Returns nil if DIR contains no name starting with FILE."
   (put op 'url-file-handlers (intern-soft (format "url-dav-%s" op))))
 
 (mapcar 'url-dav-register-handler
-        '(file-name-all-completions
-          file-name-completion
-          rename-file
-          make-directory
-          file-directory-p
-          directory-files
-          delete-file
-          delete-directory
-          file-attributes))
+        ;; These handlers are disabled because they incorrectly presume that
+        ;; the URL specifies an HTTP location and thus break FTP URLs.
+        '(;; file-name-all-completions
+          ;; file-name-completion
+          ;; rename-file
+          ;; make-directory
+          ;; file-directory-p
+          ;; directory-files
+          ;; delete-file
+          ;; delete-directory
+          ;; file-attributes
+          ))
 
 
 ;;; Version Control backend cruft
diff --git a/lisp/url/url-file.el b/lisp/url/url-file.el
index 0aa23acc0ec..c39d255304b 100644
--- a/lisp/url/url-file.el
+++ b/lisp/url/url-file.el
@@ -73,8 +73,7 @@ to them."
             func args
             args efs))
   (let ((size (nth 7 (file-attributes name))))
-    (save-excursion
-      (set-buffer buff)
+    (with-current-buffer buff
       (goto-char (point-max))
       (if (/= -1 size)
           (insert (format "Content-length: %d\n" size)))
@@ -177,9 +176,8 @@ to them."
     (if (file-directory-p filename)
         ;; A directory is done the same whether we are local or remote
         (url-find-file-dired filename)
-      (save-excursion
-        (setq buffer (generate-new-buffer " *url-file*"))
-        (set-buffer buffer)
+      (with-current-buffer
+          (setq buffer (generate-new-buffer " *url-file*"))
         (mm-disable-multibyte)
         (setq url-current-object url)
         (insert "Content-type: " (or content-type "application/octet-stream") "\n")
diff --git a/lisp/url/url-handlers.el b/lisp/url/url-handlers.el
index 68bf0ec7ab5..12db63aade8 100644
--- a/lisp/url/url-handlers.el
+++ b/lisp/url/url-handlers.el
@@ -155,6 +155,9 @@ the arguments that would have been passed to OPERATION."
 ;; These are operations that we do not support yet (DAV!!!)
 (put 'file-writable-p 'url-file-handlers 'ignore)
 (put 'file-symlink-p 'url-file-handlers 'ignore)
+;; Just like for ange-ftp: let's not waste time trying to look for RCS/foo,v
+;; files and such since we can't do anything clever with them anyway.
+(put 'vc-registered 'url-file-handlers 'ignore)
 
 (defun url-handler-expand-file-name (file &optional base)
   (if (file-name-absolute-p file)
diff --git a/lisp/url/url-history.el b/lisp/url/url-history.el
index e2bc9b17f69..3f9a82b9afd 100644
--- a/lisp/url/url-history.el
+++ b/lisp/url/url-history.el
@@ -84,7 +84,7 @@ to run the `url-history-setup-save-timer' function manually."
 (defun url-history-setup-save-timer ()
   "Reset the history list timer."
   (interactive)
-  (ignore-errors 
+  (ignore-errors
     (cond ((fboundp 'cancel-timer) (cancel-timer url-history-timer))
           ((fboundp 'delete-itimer) (delete-itimer url-history-timer))))
   (setq url-history-timer nil)
@@ -192,7 +192,7 @@ user for what type to save as."
          (gethash string url-history-hash-table)
          t))
    (t
-    (error "url-completion-function very confused."))))
+    (error "url-completion-function very confused"))))
 
 (provide 'url-history)
 
diff --git a/lisp/url/url-http.el b/lisp/url/url-http.el
index 16d51a0258c..f5bbf4a7bf4 100644
--- a/lisp/url/url-http.el
+++ b/lisp/url/url-http.el
@@ -500,7 +500,8 @@ should be shown to the user."
                  (url-request-data url-http-data)
                  (url-request-extra-headers url-http-extra-headers))
              (url-retrieve redirect-uri url-callback-function
-                           url-callback-arguments)
+                           (cons redirect-uri
+                                 (cdr url-callback-arguments)))
              (url-mark-buffer-as-dead (current-buffer))))))
       (4                                ; Client error
        ;; 400 Bad Request
@@ -849,7 +850,7 @@ the end of the document."
                   (url-display-percentage nil nil)
                   (goto-char (match-end 1))
                   (if (re-search-forward "^\r*$" nil t)
-                      (message "Saw end of trailers..."))
+                      (url-http-debug "Saw end of trailers..."))
                   (if (url-http-parse-headers)
                       (url-http-activate-callback))))))))))
 
diff --git a/lisp/url/url.el b/lisp/url/url.el
index 05ef85c9300..8b57d885949 100644
--- a/lisp/url/url.el
+++ b/lisp/url/url.el
@@ -170,17 +170,26 @@ no further processing).  URL is either a string or a parsed URL."
                               (url-debug 'retrieval "Synchronous fetching done (%S)" (current-buffer))
                               (setq retrieval-done t
                                     asynch-buffer (current-buffer)))))
-    (let ((proc (and asynch-buffer (get-buffer-process asynch-buffer))))
-      (if (null proc)
-          ;; We do not need to do anything, it was a mailto or something
-          ;; similar that takes processing completely outside of the URL
-          ;; package.
-          nil
+    (if (null asynch-buffer)
+        ;; We do not need to do anything, it was a mailto or something
+        ;; similar that takes processing completely outside of the URL
+        ;; package.
+        nil
+      (let ((proc (get-buffer-process asynch-buffer)))
+        ;; If the access method was synchronous, `retrieval-done' should
+        ;; hopefully already be set to t.  If it is nil, and `proc' is also
+        ;; nil, it implies that the async process is not running in
+        ;; asynch-buffer.  This happens e.g. for FTP files.  In such a case
+        ;; url-file.el should probably set something like a `url-process'
+        ;; buffer-local variable so we can find the exact process that we
+        ;; should be waiting for.  In the mean time, we'll just wait for any
+        ;; process output.
         (while (not retrieval-done)
           (url-debug 'retrieval
                      "Spinning in url-retrieve-synchronously: %S (%S)"
                      retrieval-done asynch-buffer)
-          (if (memq (process-status proc) '(closed exit signal failed))
+          (if (and proc (memq (process-status proc)
+                              '(closed exit signal failed)))
               ;; FIXME: It's not clear whether url-retrieve's callback is
               ;; guaranteed to be called or not.  It seems that url-http
               ;; decides sometimes consciously not to call it, so it's not
@@ -193,7 +202,7 @@ no further processing).  URL is either a string or a parsed URL."
             ;; interrupt it before it got a chance to handle process input.
             ;; `sleep-for' was tried but it lead to other forms of
             ;; hanging.  --Stef
-            (unless (accept-process-output proc)
+            (unless (or (accept-process-output proc) (null proc))
               ;; accept-process-output returned nil, maybe because the process
               ;; exited (and may have been replaced with another).
               (setq proc (get-buffer-process asynch-buffer))))))
@@ -201,9 +210,9 @@ no further processing).  URL is either a string or a parsed URL."
 
 (defun url-mm-callback (&rest ignored)
   (let ((handle (mm-dissect-buffer t)))
-    (save-excursion
-      (url-mark-buffer-as-dead (current-buffer))
-      (set-buffer (generate-new-buffer (url-recreate-url url-current-object)))
+    (url-mark-buffer-as-dead (current-buffer))
+    (with-current-buffer
+        (generate-new-buffer (url-recreate-url url-current-object))
       (if (eq (mm-display-part handle) 'external)
           (progn
             (set-process-sentinel