Revision: miles@gnu.org--gnu-2004/emacs--unicode--0--patch-57

Merge from emacs--cvs-trunk--0

Patches applied:

 * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-594
 - miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-598
   Update from CVS

 * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-599
   Merge from gnus--rel--5.10

 * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-600
 - miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-602
   Update from CVS

 * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-603
   Merge from gnus--rel--5.10

 * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-604
 - miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-609
   Update from CVS

 * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-610
   Merge from gnus--rel--5.10

 * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-611
 - miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-614
   Update from CVS

 * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-615
   Merge from gnus--rel--5.10

 * miles@gnu.org--gnu-2004/gnus--rel--5.10--patch-42
   Update from CVS

 * miles@gnu.org--gnu-2004/gnus--rel--5.10--patch-43
   Merge from emacs--cvs-trunk--0

 * miles@gnu.org--gnu-2004/gnus--rel--5.10--patch-44
 - miles@gnu.org--gnu-2004/gnus--rel--5.10--patch-46
   Update from CVS

 * miles@gnu.org--gnu-2004/gnus--rel--5.10--patch-47
   Merge from emacs--cvs-trunk--0

 * miles@gnu.org--gnu-2004/gnus--rel--5.10--patch-48
   Update from CVS

 * miles@gnu.org--gnu-2004/gnus--rel--5.10--patch-49
   Add {arch}/=commit-merge-make-log

 * miles@gnu.org--gnu-2004/gnus--rel--5.10--patch-50
   {arch}/=commit-merge-make-log: Don't die if there are no ChangeLog changes

23 files changed, 3504 insertions, 14 deletions

diff --git a/lisp/url/ChangeLog b/lisp/url/ChangeLog
index 69851ac5046..91a6c869a21 100644
--- a/lisp/url/ChangeLog
+++ b/lisp/url/ChangeLog
@@ -1,3 +1,64 @@
+2004-10-12  Simon Josefsson  <jas@extundo.com>
+
+        * url-vars.el (url-gateway-method): Add new method `tls'.
+
+        * url-news.el (url-snews): Use nntp-open-tls-stream if
+        url-gateway-method is tls.
+
+        * url-ldap.el (url-ldap-certificate-formatter): Use
+        tls-certificate-information if ssl.el is not available.
+
+        * url-https.el (url-https-create-secure-wrapper): Use tls if ssl
+        is not available.
+
+        * url-gw.el (url-open-stream): Support tls url-gateway-method.
+        (url-open-stream): Likewise.
+
+2004-10-10  Lars Hansen  <larsh@math.ku.dk>
+
+        * url-auth.el: Fix copyright notice.
+
+        * url-cache.el: Fix copyright notice.
+
+        * url-cookie.el: Fix copyright notice.
+
+        * url-dired.el: Fix copyright notice.
+
+        * url-file.el: Fix copyright notice.
+
+        * url-ftp.el: Fix copyright notice.
+
+        * url-handlers.el: Fix copyright notice.
+
+        * url-history.el: Fix copyright notice.
+
+        * url-irc.el: Fix copyright notice.
+
+        * url-mailto.el: Fix copyright notice.
+
+        * url-methods.el: Fix copyright notice.
+
+        * url-misc.el: Fix copyright notice.
+
+        * url-news.el: Fix copyright notice.
+
+        * url-nfs.el: Fix copyright notice.
+
+        * url-parse.el: Fix copyright notice.
+
+        * url-privacy.el: Fix copyright notice.
+
+        * url-vars.el: Fix copyright notice.
+
+        * url.el: Fix copyright notice.
+
+        * url-util.el: Fix copyright notice.
+
+2004-10-06  Stefan Monnier  <monnier@iro.umontreal.ca>
+
+        * url-handlers.el (url-insert-file-contents): Use the URL to decide the
+        encoding, not the buffer-file-name (which might not even exist).
+
 2004-09-20  Stefan Monnier  <monnier@iro.umontreal.ca>
 
         * url-handlers.el (url-insert-file-contents): Decode contents.
diff --git a/lisp/url/url-auth.el b/lisp/url/url-auth.el
new file mode 100644
index 00000000000..39bb730bebc
--- /dev/null
+++ b/lisp/url/url-auth.el
@@ -0,0 +1,316 @@
+;;; url-auth.el --- Uniform Resource Locator authorization modules
+;; Keywords: comm, data, processes, hypermedia
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Copyright (c) 1996 - 1999 Free Software Foundation, Inc.
+;;;
+;;; This file is part of GNU Emacs.
+;;;
+;;; GNU Emacs is free software; you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 2, or (at your option)
+;;; any later version.
+;;;
+;;; GNU Emacs is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Emacs; see the file COPYING.  If not, write to the
+;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;;; Boston, MA 02111-1307, USA.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(require 'url-vars)
+(require 'url-parse)
+(autoload 'url-warn "url")
+
+(defsubst url-auth-user-prompt (url realm)
+  "String to usefully prompt for a username."
+  (concat "Username [for "
+          (or realm (url-truncate-url-for-viewing
+                     (url-recreate-url url)
+                     (- (window-width) 10 20)))
+          "]: "))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Basic authorization code
+;;; ------------------------
+;;; This implements the BASIC authorization type.  See the online
+;;; documentation at
+;;; http://www.w3.org/hypertext/WWW/AccessAuthorization/Basic.html
+;;; for the complete documentation on this type.
+;;;
+;;; This is very insecure, but it works as a proof-of-concept
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(defvar url-basic-auth-storage 'url-http-real-basic-auth-storage
+  "Where usernames and passwords are stored.
+
+Must be a symbol pointing to another variable that will actually store
+the information.  The value of this variable is an assoc list of assoc
+lists.  The first assoc list is keyed by the server name.  The cdr of
+this is an assoc list based on the 'directory' specified by the url we
+are looking up.")
+
+(defun url-basic-auth (url &optional prompt overwrite realm args)
+  "Get the username/password for the specified URL.
+If optional argument PROMPT is non-nil, ask for the username/password
+to use for the url and its descendants.  If optional third argument
+OVERWRITE is non-nil, overwrite the old username/password pair if it
+is found in the assoc list.  If REALM is specified, use that as the realm
+instead of the pathname inheritance method."
+  (let* ((href (if (stringp url)
+                   (url-generic-parse-url url)
+                 url))
+         (server (url-host href))
+         (port (url-port href))
+         (path (url-filename href))
+         user pass byserv retval data)
+    (setq server (format "%s:%d" server port)
+          path (cond
+                (realm realm)
+                ((string-match "/$" path) path)
+                (t (url-basepath path)))
+          byserv (cdr-safe (assoc server
+                                  (symbol-value url-basic-auth-storage))))
+    (cond
+     ((and prompt (not byserv))
+      (setq user (read-string (url-auth-user-prompt url realm)
+                              (user-real-login-name))
+            pass (funcall url-passwd-entry-func "Password: "))
+      (set url-basic-auth-storage
+           (cons (list server
+                       (cons path
+                             (setq retval
+                                   (base64-encode-string
+                                    (format "%s:%s" user pass)))))
+                 (symbol-value url-basic-auth-storage))))
+     (byserv
+      (setq retval (cdr-safe (assoc path byserv)))
+      (if (and (not retval)
+               (string-match "/" path))
+          (while (and byserv (not retval))
+            (setq data (car (car byserv)))
+            (if (or (not (string-match "/" data)) ; Its a realm - take it!
+                    (and
+                     (>= (length path) (length data))
+                     (string= data (substring path 0 (length data)))))
+                (setq retval (cdr (car byserv))))
+            (setq byserv (cdr byserv))))
+      (if (or (and (not retval) prompt) overwrite)
+          (progn
+            (setq user (read-string (url-auth-user-prompt url realm)
+                                    (user-real-login-name))
+                  pass (funcall url-passwd-entry-func "Password: ")
+                  retval (base64-encode-string (format "%s:%s" user pass))
+                  byserv (assoc server (symbol-value url-basic-auth-storage)))
+            (setcdr byserv
+                    (cons (cons path retval) (cdr byserv))))))
+     (t (setq retval nil)))
+    (if retval (setq retval (concat "Basic " retval)))
+    retval))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Digest authorization code
+;;; ------------------------
+;;; This implements the DIGEST authorization type.  See the internet draft
+;;; ftp://ds.internic.net/internet-drafts/draft-ietf-http-digest-aa-01.txt
+;;; for the complete documentation on this type.
+;;;
+;;; This is very secure
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(defvar url-digest-auth-storage nil
+  "Where usernames and passwords are stored.  Its value is an assoc list of
+assoc lists.  The first assoc list is keyed by the server name.  The cdr of
+this is an assoc list based on the 'directory' specified by the url we are
+looking up.")
+
+(defun url-digest-auth-create-key (username password realm method uri)
+  "Create a key for digest authentication method"
+  (let* ((info (if (stringp uri)
+                   (url-generic-parse-url uri)
+                 uri))
+         (a1 (md5 (concat username ":" realm ":" password)))
+         (a2 (md5 (concat method ":" (url-filename info)))))
+    (list a1 a2)))
+
+(defun url-digest-auth (url &optional prompt overwrite realm args)
+  "Get the username/password for the specified URL.
+If optional argument PROMPT is non-nil, ask for the username/password
+to use for the url and its descendants.  If optional third argument
+OVERWRITE is non-nil, overwrite the old username/password pair if it
+is found in the assoc list.  If REALM is specified, use that as the realm
+instead of hostname:portnum."
+  (if args
+      (let* ((href (if (stringp url)
+                       (url-generic-parse-url url)
+                     url))
+             (server (url-host href))
+             (port (url-port href))
+             (path (url-filename href))
+             user pass byserv retval data)
+        (setq path (cond
+                    (realm realm)
+                    ((string-match "/$" path) path)
+                    (t (url-basepath path)))
+              server (format "%s:%d" server port)
+              byserv (cdr-safe (assoc server url-digest-auth-storage)))
+        (cond
+         ((and prompt (not byserv))
+          (setq user (read-string (url-auth-user-prompt url realm)
+                                  (user-real-login-name))
+                pass (funcall url-passwd-entry-func "Password: ")
+                url-digest-auth-storage
+                (cons (list server
+                            (cons path
+                                  (setq retval
+                                        (cons user
+                                              (url-digest-auth-create-key
+                                               user pass realm
+                                               (or url-request-method "GET")
+                                               url)))))
+                      url-digest-auth-storage)))
+         (byserv
+          (setq retval (cdr-safe (assoc path byserv)))
+          (if (and (not retval)         ; no exact match, check directories
+                   (string-match "/" path)) ; not looking for a realm
+              (while (and byserv (not retval))
+                (setq data (car (car byserv)))
+                (if (or (not (string-match "/" data))
+                        (and
+                         (>= (length path) (length data))
+                         (string= data (substring path 0 (length data)))))
+                    (setq retval (cdr (car byserv))))
+                (setq byserv (cdr byserv))))
+          (if (or (and (not retval) prompt) overwrite)
+              (progn
+                (setq user (read-string (url-auth-user-prompt url realm)
+                                        (user-real-login-name))
+                      pass (funcall url-passwd-entry-func "Password: ")
+                      retval (setq retval
+                                   (cons user
+                                         (url-digest-auth-create-key
+                                          user pass realm
+                                          (or url-request-method "GET")
+                                          url)))
+                      byserv (assoc server url-digest-auth-storage))
+                (setcdr byserv
+                        (cons (cons path retval) (cdr byserv))))))
+         (t (setq retval nil)))
+        (if retval
+            (let ((nonce (or (cdr-safe (assoc "nonce" args)) "nonegiven"))
+                  (opaque (or (cdr-safe (assoc "opaque" args)) "nonegiven")))
+              (format
+               (concat "Digest username=\"%s\", realm=\"%s\","
+                       "nonce=\"%s\", uri=\"%s\","
+                       "response=\"%s\", opaque=\"%s\"")
+               (nth 0 retval) realm nonce (url-filename href)
+               (md5 (concat (nth 1 retval) ":" nonce ":"
+                            (nth 2 retval))) opaque))))))
+
+(defvar url-registered-auth-schemes nil
+  "A list of the registered authorization schemes and various and sundry
+information associated with them.")
+
+;;;###autoload
+(defun url-get-authentication (url realm type prompt &optional args)
+  "Return an authorization string suitable for use in the WWW-Authenticate
+header in an HTTP/1.0 request.
+
+URL    is the url you are requesting authorization to.  This can be either a
+       string representing the URL, or the parsed representation returned by
+       `url-generic-parse-url'
+REALM  is the realm at a specific site we are looking for.  This should be a
+       string specifying the exact realm, or nil or the symbol 'any' to
+       specify that the filename portion of the URL should be used as the
+       realm
+TYPE   is the type of authentication to be returned.  This is either a string
+       representing the type (basic, digest, etc), or nil or the symbol 'any'
+       to specify that any authentication is acceptable.  If requesting 'any'
+       the strongest matching authentication will be returned.  If this is
+       wrong, its no big deal, the error from the server will specify exactly
+       what type of auth to use
+PROMPT is boolean - specifies whether to ask the user for a username/password
+       if one cannot be found in the cache"
+  (if (not realm)
+      (setq realm (cdr-safe (assoc "realm" args))))
+  (if (stringp url)
+      (setq url (url-generic-parse-url url)))
+  (if (or (null type) (eq type 'any))
+      ;; Whooo doogies!
+      ;; Go through and get _all_ the authorization strings that could apply
+      ;; to this URL, store them along with the 'rating' we have in the list
+      ;; of schemes, then sort them so that the 'best' is at the front of the
+      ;; list, then get the car, then get the cdr.
+      ;; Zooom zooom zoooooom
+      (cdr-safe
+       (car-safe
+        (sort
+         (mapcar
+          (function
+           (lambda (scheme)
+             (if (fboundp (car (cdr scheme)))
+                 (cons (cdr (cdr scheme))
+                       (funcall (car (cdr scheme)) url nil nil realm))
+               (cons 0 nil))))
+          url-registered-auth-schemes)
+         (function
+          (lambda (x y)
+            (cond
+             ((null (cdr x)) nil)
+             ((and (cdr x) (null (cdr y))) t)
+             ((and (cdr x) (cdr y))
+              (>= (car x) (car y)))
+             (t nil)))))))
+    (if (symbolp type) (setq type (symbol-name type)))
+    (let* ((scheme (car-safe
+                    (cdr-safe (assoc (downcase type)
+                                     url-registered-auth-schemes)))))
+      (if (and scheme (fboundp scheme))
+          (funcall scheme url prompt
+                   (and prompt
+                        (funcall scheme url nil nil realm args))
+                   realm args)))))
+
+;;;###autoload
+(defun url-register-auth-scheme (type &optional function rating)
+  "Register an HTTP authentication method.
+
+TYPE     is a string or symbol specifying the name of the method.   This
+         should be the same thing you expect to get returned in an Authenticate
+         header in HTTP/1.0 - it will be downcased.
+FUNCTION is the function to call to get the authorization information.  This
+         defaults to `url-?-auth', where ? is TYPE
+RATING   a rating between 1 and 10 of the strength of the authentication.
+         This is used when asking for the best authentication for a specific
+         URL.  The item with the highest rating is returned."
+  (let* ((type (cond
+                ((stringp type) (downcase type))
+                ((symbolp type) (downcase (symbol-name type)))
+                (t (error "Bad call to `url-register-auth-scheme'"))))
+         (function (or function (intern (concat "url-" type "-auth"))))
+         (rating (cond
+                  ((null rating) 2)
+                  ((stringp rating) (string-to-int rating))
+                  (t rating)))
+         (node (assoc type url-registered-auth-schemes)))
+    (if (not (fboundp function))
+        (url-warn 'security
+                  (format (concat
+                           "Tried to register `%s' as an auth scheme"
+                           ", but it is not a function!") function)))
+
+    (if node
+        (setcdr node (cons function rating))
+      (setq url-registered-auth-schemes
+            (cons (cons type (cons function rating))
+                  url-registered-auth-schemes)))))
+
+(defun url-auth-registered (scheme)
+  ;; Return non-nil iff SCHEME is registered as an auth type
+  (assoc scheme url-registered-auth-schemes))
+
+(provide 'url-auth)
+
+;;; arch-tag: 04058625-616d-44e4-9dbf-4b46b00b2a91
diff --git a/lisp/url/url-cache.el b/lisp/url/url-cache.el
new file mode 100644
index 00000000000..1e3374639e1
--- /dev/null
+++ b/lisp/url/url-cache.el
@@ -0,0 +1,202 @@
+;;; url-cache.el --- Uniform Resource Locator retrieval tool
+;; Keywords: comm, data, processes, hypermedia
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Copyright (c) 1996 - 1999 Free Software Foundation, Inc.
+;;;
+;;; This file is part of GNU Emacs.
+;;;
+;;; GNU Emacs is free software; you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 2, or (at your option)
+;;; any later version.
+;;;
+;;; GNU Emacs is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Emacs; see the file COPYING.  If not, write to the
+;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;;; Boston, MA 02111-1307, USA.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(require 'url-parse)
+(require 'url-util)
+
+(defcustom url-cache-directory
+  (expand-file-name "cache" url-configuration-directory)
+  "*The directory where cache files should be stored."
+  :type 'directory
+  :group 'url-file)
+
+;; Cache manager
+(defun url-cache-file-writable-p (file)
+  "Follows the documentation of `file-writable-p', unlike `file-writable-p'."
+  (and (file-writable-p file)
+       (if (file-exists-p file)
+           (not (file-directory-p file))
+         (file-directory-p (file-name-directory file)))))
+                
+(defun url-cache-prepare (file)
+  "Makes it possible to cache data in FILE.
+Creates any necessary parent directories, deleting any non-directory files
+that would stop this.  Returns nil if parent directories can not be
+created.  If FILE already exists as a non-directory, it changes
+permissions of FILE or deletes FILE to make it possible to write a new
+version of FILE.  Returns nil if this can not be done.  Returns nil if
+FILE already exists as a directory.  Otherwise, returns t, indicating that
+FILE can be created or overwritten."
+  (cond
+   ((url-cache-file-writable-p file)
+    t)
+   ((file-directory-p file)
+    nil)
+   (t
+    (condition-case ()
+        (or (make-directory (file-name-directory file) t) t)
+      (error nil)))))
+
+;;;###autoload
+(defun url-store-in-cache (&optional buff)
+  "Store buffer BUFF in the cache."
+  (if (not (and buff (get-buffer buff)))
+      nil
+    (save-excursion
+      (and buff (set-buffer buff))
+      (let* ((fname (url-cache-create-filename (url-view-url t))))
+        (if (url-cache-prepare fname)
+            (let ((coding-system-for-write 'binary))
+              (write-region (point-min) (point-max) fname nil 5)))))))
+        
+;;;###autoload
+(defun url-is-cached (url)
+  "Return non-nil if the URL is cached."
+  (let* ((fname (url-cache-create-filename url))
+         (attribs (file-attributes fname)))
+    (and fname                          ; got a filename
+         (file-exists-p fname)          ; file exists
+         (not (eq (nth 0 attribs) t))   ; Its not a directory
+         (nth 5 attribs))))             ; Can get last mod-time
+
+(defun url-cache-create-filename-human-readable (url)
+  "Return a filename in the local cache for URL"
+  (if url
+      (let* ((url (if (vectorp url) (url-recreate-url url) url))
+             (urlobj (url-generic-parse-url url))
+             (protocol (url-type urlobj))
+             (hostname (url-host urlobj))
+             (host-components
+              (cons
+               (user-real-login-name)
+               (cons (or protocol "file")
+                     (reverse (split-string (or hostname "localhost")
+                                            (eval-when-compile
+                                              (regexp-quote ".")))))))
+             (fname    (url-filename urlobj)))
+        (if (and fname (/= (length fname) 0) (= (aref fname 0) ?/))
+            (setq fname (substring fname 1 nil)))
+        (if fname
+            (let ((slash nil))
+              (setq fname
+                    (mapconcat
+                     (function
+                      (lambda (x)
+                        (cond
+                         ((and (= ?/ x) slash)
+                          (setq slash nil)
+                          "%2F")
+                         ((= ?/ x)
+                          (setq slash t)
+                          "/")
+                         (t
+                          (setq slash nil)
+                          (char-to-string x))))) fname ""))))
+
+        (setq fname (and fname
+                         (mapconcat
+                          (function (lambda (x)
+                                      (if (= x ?~) "" (char-to-string x))))
+                          fname ""))
+              fname (cond
+                     ((null fname) nil)
+                     ((or (string= "" fname) (string= "/" fname))
+                      url-directory-index-file)
+                     ((= (string-to-char fname) ?/)
+                      (if (string= (substring fname -1 nil) "/")
+                          (concat fname url-directory-index-file)
+                        (substring fname 1 nil)))
+                     (t
+                      (if (string= (substring fname -1 nil) "/")
+                          (concat fname url-directory-index-file)
+                        fname))))
+        (and fname
+             (expand-file-name fname
+                               (expand-file-name
+                                (mapconcat 'identity host-components "/")
+                                url-cache-directory))))))
+
+(defun url-cache-create-filename-using-md5 (url)
+  "Create a cached filename using MD5.
+Very fast if you have an `md5' primitive function, suitably fast otherwise."
+  (require 'md5)
+  (if url
+      (let* ((url (if (vectorp url) (url-recreate-url url) url))
+             (checksum (md5 url))
+             (urlobj (url-generic-parse-url url))
+             (protocol (url-type urlobj))
+             (hostname (url-host urlobj))
+             (host-components
+              (cons
+               (user-real-login-name)
+               (cons (or protocol "file")
+                     (nreverse
+                      (delq nil
+                            (split-string (or hostname "localhost")
+                                          (eval-when-compile
+                                            (regexp-quote "."))))))))
+             (fname    (url-filename urlobj)))
+        (and fname
+             (expand-file-name checksum
+                               (expand-file-name
+                                (mapconcat 'identity host-components "/")
+                                url-cache-directory))))))
+
+(defcustom url-cache-creation-function 'url-cache-create-filename-using-md5
+  "*What function to use to create a cached filename."
+  :type '(choice (const :tag "MD5 of filename (low collision rate)"
+                        :value url-cache-create-filename-using-md5)
+                 (const :tag "Human readable filenames (higher collision rate)"
+                        :value url-cache-create-filename-human-readable)
+                 (function :tag "Other"))
+  :group 'url-cache)
+
+(defun url-cache-create-filename (url)
+  (funcall url-cache-creation-function url))
+
+;;;###autoload
+(defun url-cache-extract (fnam)
+  "Extract FNAM from the local disk cache"
+  (erase-buffer)
+  (insert-file-contents-literally fnam))
+
+;;;###autoload
+(defun url-cache-expired (url mod)
+  "Return t iff a cached file has expired."
+  (let* ((urlobj (if (vectorp url) url (url-generic-parse-url url)))
+         (type (url-type urlobj)))
+    (cond
+     (url-standalone-mode
+      (not (file-exists-p (url-cache-create-filename url))))
+     ((string= type "http")
+      t)
+     ((member type '("file" "ftp"))
+      (if (or (equal mod '(0 0)) (not mod))
+          t
+        (or (> (nth 0 mod) (nth 0 (current-time)))
+            (> (nth 1 mod) (nth 1 (current-time))))))
+     (t nil))))
+
+(provide 'url-cache)
+
+;;; arch-tag: 95b050a6-8e81-4f23-8e63-191b9d1d657c
diff --git a/lisp/url/url-cookie.el b/lisp/url/url-cookie.el
new file mode 100644
index 00000000000..9f7db867597
--- /dev/null
+++ b/lisp/url/url-cookie.el
@@ -0,0 +1,466 @@
+;;; url-cookie.el --- Netscape Cookie support
+
+;; Copyright (c) 1996 - 1999,2004  Free Software Foundation, Inc.
+
+;; Keywords: comm, data, processes, hypermedia
+
+;; This file is part of GNU Emacs.
+;;
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+;;
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;;; Code:
+
+(require 'timezone)
+(require 'url-util)
+(require 'url-parse)
+(eval-when-compile (require 'cl))
+
+;; See http://home.netscape.com/newsref/std/cookie_spec.html for the
+;; 'open standard' defining this crap.
+;;
+;; A cookie is stored internally as a vector of 7 slots
+;; [ 'cookie name value expires path domain secure ]
+
+(defsubst url-cookie-name    (cookie) (aref cookie 1))
+(defsubst url-cookie-value   (cookie) (aref cookie 2))
+(defsubst url-cookie-expires (cookie) (aref cookie 3))
+(defsubst url-cookie-path    (cookie) (aref cookie 4))
+(defsubst url-cookie-domain  (cookie) (aref cookie 5))
+(defsubst url-cookie-secure  (cookie) (aref cookie 6))
+
+(defsubst url-cookie-set-name    (cookie val) (aset cookie 1 val))
+(defsubst url-cookie-set-value   (cookie val) (aset cookie 2 val))
+(defsubst url-cookie-set-expires (cookie val) (aset cookie 3 val))
+(defsubst url-cookie-set-path    (cookie val) (aset cookie 4 val))
+(defsubst url-cookie-set-domain  (cookie val) (aset cookie 5 val))
+(defsubst url-cookie-set-secure  (cookie val) (aset cookie 6 val))
+(defsubst url-cookie-retrieve-arg (key args) (nth 1 (memq key args)))
+
+(defsubst url-cookie-create (&rest args)
+  (let ((retval (make-vector 7 nil)))
+    (aset retval 0 'cookie)
+    (url-cookie-set-name retval (url-cookie-retrieve-arg :name args))
+    (url-cookie-set-value retval (url-cookie-retrieve-arg :value args))
+    (url-cookie-set-expires retval (url-cookie-retrieve-arg :expires args))
+    (url-cookie-set-path retval (url-cookie-retrieve-arg :path args))
+    (url-cookie-set-domain retval (url-cookie-retrieve-arg :domain args))
+    (url-cookie-set-secure retval (url-cookie-retrieve-arg :secure args))
+    retval))
+
+(defun url-cookie-p (obj)
+  (and (vectorp obj) (= (length obj) 7) (eq (aref obj 0) 'cookie)))
+
+(defgroup url-cookie nil
+  "URL cookies"
+  :prefix "url-"
+  :prefix "url-cookie-"
+  :group 'url)
+
+(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."
+  :type '(choice (const :tag "Default" :value nil) file)
+  :group 'url-file
+  :group 'url-cookie)
+
+(defcustom url-cookie-confirmation nil
+  "*If non-nil, confirmation by the user is required to accept HTTP cookies."
+  :type 'boolean
+  :group 'url-cookie)
+
+(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
+telling Microsoft that.")
+
+(defvar url-cookies-changed-since-last-save nil
+  "Whether the cookies list has changed since the last save operation.")
+
+;;;###autoload
+(defun url-cookie-parse-file (&optional fname)
+  (setq fname (or fname url-cookie-file))
+  (condition-case ()
+      (load fname nil t)
+    (error (message "Could not load cookie file %s" fname))))
+
+(defun url-cookie-clean-up (&optional secure)
+  (let* (
+         (var (if secure 'url-cookie-secure-storage 'url-cookie-storage))
+         (val (symbol-value var))
+         (cur nil)
+         (new nil)
+         (cookies nil)
+         (cur-cookie nil)
+         (new-cookies nil)
+         )
+    (while val
+      (setq cur (car val)
+            val (cdr val)
+            new-cookies nil
+            cookies (cdr cur))
+      (while cookies
+        (setq cur-cookie (car cookies)
+              cookies (cdr cookies))
+        (if (or (not (url-cookie-p cur-cookie))
+                (url-cookie-expired-p cur-cookie)
+                (null (url-cookie-expires cur-cookie)))
+            nil
+          (setq new-cookies (cons cur-cookie new-cookies))))
+      (if (not new-cookies)
+          nil
+        (setcdr cur new-cookies)
+        (setq new (cons cur new))))
+    (set var new)))
+
+;;;###autoload
+(defun url-cookie-write-file (&optional fname)
+  (setq fname (or fname url-cookie-file))
+  (cond
+   ((not url-cookies-changed-since-last-save) nil)
+   ((not (file-writable-p fname))
+    (message "Cookies file %s (see variable `url-cookie-file') is unwritable." fname))
+   (t
+    (url-cookie-clean-up)
+    (url-cookie-clean-up t)
+    (save-excursion
+      (set-buffer (get-buffer-create " *cookies*"))
+      (erase-buffer)
+      (fundamental-mode)
+      (insert ";; Emacs-W3 HTTP cookies file\n"
+              ";; Automatically generated file!!! DO NOT EDIT!!!\n\n"
+              "(setq url-cookie-storage\n '")
+      (pp url-cookie-storage (current-buffer))
+      (insert ")\n(setq url-cookie-secure-storage\n '")
+      (pp url-cookie-secure-storage (current-buffer))
+      (insert ")\n")
+      (write-file fname)
+      (kill-buffer (current-buffer))))))
+
+(defun url-cookie-store (name value &optional expires domain path secure)
+  "Store a netscape-style cookie."
+  (let* ((storage (if secure url-cookie-secure-storage url-cookie-storage))
+         (tmp storage)
+         (cur nil)
+         (found-domain nil))
+
+    ;; First, look for a matching domain
+    (setq found-domain (assoc domain storage))
+
+    (if found-domain
+        ;; Need to either stick the new cookie in existing domain storage
+        ;; or possibly replace an existing cookie if the names match.
+        (progn
+          (setq storage (cdr found-domain)
+                tmp nil)
+          (while storage
+            (setq cur (car storage)
+                  storage (cdr storage))
+            (if (and (equal path (url-cookie-path cur))
+                     (equal name (url-cookie-name cur)))
+                (progn
+                  (url-cookie-set-expires cur expires)
+                  (url-cookie-set-value cur value)
+                  (setq tmp t))))
+          (if (not tmp)
+              ;; New cookie
+              (setcdr found-domain (cons
+                                    (url-cookie-create :name name
+                                                       :value value
+                                                       :expires expires
+                                                       :domain domain
+                                                       :path path
+                                                       :secure secure)
+                                    (cdr found-domain)))))
+      ;; Need to add a new top-level domain
+      (setq tmp (url-cookie-create :name name
+                                   :value value
+                                   :expires expires
+                                   :domain domain
+                                   :path path
+                                   :secure secure))
+      (cond
+       (storage
+        (setcdr storage (cons (list domain tmp) (cdr storage))))
+       (secure
+        (setq url-cookie-secure-storage (list (list domain tmp))))
+       (t
+        (setq url-cookie-storage (list (list domain tmp))))))))
+
+(defun url-cookie-expired-p (cookie)
+  (let* (
+         (exp (url-cookie-expires cookie))
+         (cur-date (and exp (timezone-parse-date (current-time-string))))
+         (exp-date (and exp (timezone-parse-date exp)))
+         (cur-greg (and cur-date (timezone-absolute-from-gregorian
+                                  (string-to-int (aref cur-date 1))
+                                  (string-to-int (aref cur-date 2))
+                                  (string-to-int (aref cur-date 0)))))
+         (exp-greg (and exp (timezone-absolute-from-gregorian
+                             (string-to-int (aref exp-date 1))
+                             (string-to-int (aref exp-date 2))
+                             (string-to-int (aref exp-date 0)))))
+         (diff-in-days (and exp (- cur-greg exp-greg)))
+         )
+    (cond
+     ((not exp) nil)                    ; No expiry == expires at browser quit
+     ((< diff-in-days 0) nil)           ; Expires sometime after today
+     ((> diff-in-days 0) t)             ; Expired before today
+     (t                                 ; Expires sometime today, check times
+      (let* ((cur-time (timezone-parse-time (aref cur-date 3)))
+             (exp-time (timezone-parse-time (aref exp-date 3)))
+             (cur-norm (+ (* 360 (string-to-int (aref cur-time 2)))
+                          (*  60 (string-to-int (aref cur-time 1)))
+                          (*   1 (string-to-int (aref cur-time 0)))))
+             (exp-norm (+ (* 360 (string-to-int (aref exp-time 2)))
+                          (*  60 (string-to-int (aref exp-time 1)))
+                          (*   1 (string-to-int (aref exp-time 0))))))
+        (> (- cur-norm exp-norm) 1))))))
+
+;;;###autoload
+(defun url-cookie-retrieve (host path &optional secure)
+  "Retrieve all the netscape-style cookies for a specified HOST and PATH."
+  (let ((storage (if secure
+                     (append url-cookie-secure-storage url-cookie-storage)
+                   url-cookie-storage))
+        (case-fold-search t)
+        (cookies nil)
+        (cur nil)
+        (retval nil)
+        (path-regexp nil))
+    (while storage
+      (setq cur (car storage)
+            storage (cdr storage)
+            cookies (cdr cur))
+      (if (and (car cur)
+               (string-match (concat "^.*" (regexp-quote (car cur)) "$") host))
+          ;; The domains match - a possible hit!
+          (while cookies
+            (setq cur (car cookies)
+                  cookies (cdr cookies)
+                  path-regexp (concat "^" (regexp-quote
+                                           (url-cookie-path cur))))
+            (if (and (string-match path-regexp path)
+                     (not (url-cookie-expired-p cur)))
+                (setq retval (cons cur retval))))))
+    retval))
+
+;;;###autolaod
+(defun url-cookie-generate-header-lines (host path secure)
+  (let* ((cookies (url-cookie-retrieve host path secure))
+        (retval nil)
+        (cur nil)
+        (chunk nil))
+    ;; Have to sort this for sending most specific cookies first
+    (setq cookies (and cookies
+                       (sort cookies
+                             (function
+                              (lambda (x y)
+                                (> (length (url-cookie-path x))
+                                   (length (url-cookie-path y))))))))
+    (while cookies
+      (setq cur (car cookies)
+            cookies (cdr cookies)
+            chunk (format "%s=%s" (url-cookie-name cur) (url-cookie-value cur))
+            retval (if (and url-cookie-multiple-line
+                            (< 80 (+ (length retval) (length chunk) 4)))
+                       (concat retval "\r\nCookie: " chunk)
+                     (if retval
+                         (concat retval "; " chunk)
+                       (concat "Cookie: " chunk)))))
+    (if retval
+        (concat retval "\r\n")
+      "")))
+
+(defvar url-cookie-two-dot-domains
+  (concat "\\.\\("
+   (mapconcat 'identity (list "com" "edu" "net" "org" "gov" "mil" "int")
+              "\\|")
+   "\\)$")
+  "A regexp of top level domains that only require two matching
+'.'s in the domain name in order to set a cookie.")
+
+(defcustom url-cookie-trusted-urls nil
+  "*A list of regular expressions matching URLs to always accept cookies from."
+  :type '(repeat regexp)
+  :group 'url-cookie)
+
+(defcustom url-cookie-untrusted-urls nil
+  "*A list of regular expressions matching URLs to never accept cookies from."
+  :type '(repeat regexp)
+  :group 'url-cookie)
+
+(defun url-cookie-host-can-set-p (host domain)
+  (let ((numdots 0)
+        (tmp domain)
+        (last nil)
+        (case-fold-search t)
+        (mindots 3))
+    (while (setq last (string-match "\\." domain last))
+      (setq numdots (1+ numdots)
+            last (1+ last)))
+    (if (string-match url-cookie-two-dot-domains domain)
+        (setq mindots 2))
+    (cond
+     ((string= host domain)             ; Apparently netscape lets you do this
+      t)
+     ((>= numdots mindots)              ; We have enough dots in domain name
+      ;; Need to check and make sure the host is actually _in_ the
+      ;; domain it wants to set a cookie for though.
+      (string-match (concat (regexp-quote domain) "$") host))
+     (t
+      nil))))
+
+;;;###autoload
+(defun url-cookie-handle-set-cookie (str)
+  (setq url-cookies-changed-since-last-save t)
+  (let* ((args (url-parse-args str t))
+         (case-fold-search t)
+         (secure (and (assoc-string "secure" args t) t))
+         (domain (or (cdr-safe (assoc-string "domain" args t))
+                     (url-host url-current-object)))
+         (current-url (url-view-url t))
+         (trusted url-cookie-trusted-urls)
+         (untrusted url-cookie-untrusted-urls)
+         (expires (cdr-safe (assoc-string "expires" args t)))
+         (path (or (cdr-safe (assoc-string "path" args t))
+                   (file-name-directory
+                    (url-filename url-current-object))))
+         (rest nil))
+    (while args
+      (if (not (member (downcase (car (car args)))
+                       '("secure" "domain" "expires" "path")))
+          (setq rest (cons (car args) rest)))
+      (setq args (cdr args)))
+
+    ;; Sometimes we get dates that the timezone package cannot handle very
+    ;; gracefully - take care of this here, instead of in url-cookie-expired-p
+    ;; to speed things up.
+    (if (and expires
+             (string-match
+              (concat "^[^,]+, +\\(..\\)-\\(...\\)-\\(..\\) +"
+                      "\\(..:..:..\\) +\\[*\\([^\]]+\\)\\]*$")
+              expires))
+        (setq expires (concat (match-string 1 expires) " "
+                              (match-string 2 expires) " "
+                              (match-string 3 expires) " "
+                              (match-string 4 expires) " ["
+                              (match-string 5 expires) "]")))
+
+    ;; This one is for older Emacs/XEmacs variants that don't
+    ;; understand this format without tenths of a second in it.
+    ;; Wednesday, 30-Dec-2037 16:00:00 GMT
+    ;;       - vs -
+    ;; Wednesday, 30-Dec-2037 16:00:00.00 GMT
+    (if (and expires
+             (string-match
+              "\\([0-9]+\\)-\\([A-Za-z]+\\)-\\([0-9]+\\)[ \t]+\\([0-9]+:[0-9]+:[0-9]+\\)\\(\\.[0-9]+\\)*[ \t]+\\([-+a-zA-Z0-9]+\\)"
+              expires))
+        (setq expires (concat (match-string 1 expires) "-"      ; day
+                              (match-string 2 expires) "-"      ; month
+                              (match-string 3 expires) " "      ; year
+                              (match-string 4 expires) ".00 " ; hour:minutes:seconds
+                              (match-string 6 expires)))) ":" ; timezone
+
+    (while (consp trusted)
+      (if (string-match (car trusted) current-url)
+          (setq trusted (- (match-end 0) (match-beginning 0)))
+        (pop trusted)))
+    (while (consp untrusted)
+      (if (string-match (car untrusted) current-url)
+          (setq untrusted (- (match-end 0) (match-beginning 0)))
+        (pop untrusted)))
+    (if (and trusted untrusted)
+        ;; Choose the more specific match
+        (if (> trusted untrusted)
+            (setq untrusted nil)
+          (setq trusted nil)))
+    (cond
+     (untrusted
+      ;; The site was explicity marked as untrusted by the user
+      nil)
+     ((or (eq url-privacy-level 'paranoid)
+          (and (listp url-privacy-level) (memq 'cookies url-privacy-level)))
+      ;; user never wants cookies
+      nil)
+     ((and url-cookie-confirmation
+           (not trusted)
+           (save-window-excursion
+             (with-output-to-temp-buffer "*Cookie Warning*"
+               (mapcar
+                (function
+                 (lambda (x)
+                   (princ (format "%s - %s" (car x) (cdr x))))) rest))
+             (prog1
+                 (not (funcall url-confirmation-func
+                               (format "Allow %s to set these cookies? "
+                                       (url-host url-current-object))))
+               (if (get-buffer "*Cookie Warning*")
+                   (kill-buffer "*Cookie Warning*")))))
+      ;; user wants to be asked, and declined.
+      nil)
+     ((url-cookie-host-can-set-p (url-host url-current-object) domain)
+      ;; Cookie is accepted by the user, and passes our security checks
+      (let ((cur nil))
+        (while rest
+          (setq cur (pop rest))
+          (url-cookie-store (car cur) (cdr cur)
+                            expires domain path secure))))
+     (t
+      (message "%s tried to set a cookie for domain %s - rejected."
+               (url-host url-current-object) domain)))))
+
+(defvar url-cookie-timer nil)
+
+(defcustom url-cookie-save-interval 3600
+  "*The number of seconds between automatic saves of cookies.
+Default is 1 hour.  Note that if you change this variable outside of
+the `customize' interface after `url-do-setup' has been run, you need
+to run the `url-cookie-setup-save-timer' function manually."
+  :set (function (lambda (var val)
+                   (set-default var val)
+                   (and (featurep 'url)
+                        (fboundp 'url-cookie-setup-save-timer)
+                        (url-cookie-setup-save-timer))))
+  :type 'integer
+  :group 'url)
+
+;;;###autoload
+(defun url-cookie-setup-save-timer ()
+  "Reset the cookie saver timer."
+  (interactive)
+  (ignore-errors
+    (cond ((fboundp 'cancel-timer) (cancel-timer url-cookie-timer))
+          ((fboundp 'delete-itimer) (delete-itimer url-cookie-timer))))
+  (setq url-cookie-timer nil)
+  (if url-cookie-save-interval
+      (setq url-cookie-timer
+            (cond
+             ((fboundp 'run-at-time)
+              (run-at-time url-cookie-save-interval
+                           url-cookie-save-interval
+                           'url-cookie-write-file))
+             ((fboundp 'start-itimer)
+              (start-itimer "url-cookie-saver" 'url-cookie-write-file
+                            url-cookie-save-interval
+                            url-cookie-save-interval))))))
+
+(provide 'url-cookie)
+
+;; arch-tag: 2568751b-6452-4398-aa2d-303edadb54d7
+;;; url-cookie.el ends here
diff --git a/lisp/url/url-dired.el b/lisp/url/url-dired.el
new file mode 100644
index 00000000000..73307412e1e
--- /dev/null
+++ b/lisp/url/url-dired.el
@@ -0,0 +1,100 @@
+;;; url-dired.el --- URL Dired minor mode
+;; Keywords: comm, files
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Copyright (c) 1996 - 1999 Free Software Foundation, Inc.
+;;;
+;;; This file is part of GNU Emacs.
+;;;
+;;; GNU Emacs is free software; you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 2, or (at your option)
+;;; any later version.
+;;;
+;;; GNU Emacs is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Emacs; see the file COPYING.  If not, write to the
+;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;;; Boston, MA 02111-1307, USA.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(autoload 'w3-fetch "w3")
+(autoload 'w3-open-local "w3")
+(autoload 'dired-get-filename "dired")
+
+(defvar url-dired-minor-mode-map
+  (let ((map (make-sparse-keymap)))
+    (define-key map "\C-m" 'url-dired-find-file)
+    (if (featurep 'xemacs)
+        (define-key map [button2] 'url-dired-find-file-mouse)
+      (define-key map [mouse-2] 'url-dired-find-file-mouse))
+    map)
+  "Keymap used when browsing directories.")
+
+(defvar url-dired-minor-mode nil
+  "Whether we are in url-dired-minor-mode")
+
+(make-variable-buffer-local 'url-dired-minor-mode)
+
+(defun url-dired-find-file ()
+  "In dired, visit the file or directory named on this line, using Emacs-W3."
+  (interactive)
+  (let ((filename (dired-get-filename)))
+    (cond ((string-match "/\\(.*@.*\\):\\(/.*\\)" filename)
+           (w3-fetch (concat "file://" (match-string 1 filename) (match-string 2 filename))))
+          (t
+           (w3-open-local filename)))))
+
+(defun url-dired-find-file-mouse (event)
+  "In dired, visit the file or directory name you click on, using Emacs-W3."
+  (interactive "@e")
+  (mouse-set-point event)
+  (url-dired-find-file))
+
+(defun url-dired-minor-mode (&optional arg)
+  "Minor mode for directory browsing with Emacs-W3."
+  (interactive "P")
+  (cond
+   ((null arg)
+    (setq url-dired-minor-mode (not url-dired-minor-mode)))
+   ((equal 0 arg)
+    (setq url-dired-minor-mode nil))
+   (t
+    (setq url-dired-minor-mode t))))
+
+(if (not (fboundp 'add-minor-mode))
+    (defun add-minor-mode (toggle name &optional keymap after toggle-fun)
+      "Add a minor mode to `minor-mode-alist' and `minor-mode-map-alist'.
+TOGGLE is a symbol which is used as the variable which toggle the minor mode,
+NAME is the name that should appear in the modeline (it should be a string
+beginning with a space), KEYMAP is a keymap to make active when the minor
+mode is active, and AFTER is the toggling symbol used for another minor
+mode.  If AFTER is non-nil, then it is used to position the new mode in the
+minor-mode alists.  TOGGLE-FUN specifies an interactive function that
+is called to toggle the mode on and off; this affects what appens when
+button2 is pressed on the mode, and when button3 is pressed somewhere
+in the list of modes.  If TOGGLE-FUN is nil and TOGGLE names an
+interactive function, TOGGLE is used as the toggle function.
+
+Example:  (add-minor-mode 'view-minor-mode \" View\" view-mode-map)"
+      (if (not (assq toggle minor-mode-alist))
+          (setq minor-mode-alist (cons (list toggle name) minor-mode-alist)))
+      (if (and keymap (not (assq toggle minor-mode-map-alist)))
+          (setq minor-mode-map-alist (cons (cons toggle keymap)
+                                           minor-mode-map-alist)))))
+
+(add-minor-mode 'url-dired-minor-mode " URL" url-dired-minor-mode-map)
+
+(defun url-find-file-dired (dir)
+  "\"Edit\" directory DIR, but with additional URL-friendly bindings."
+  (interactive "DURL Dired (directory): ")
+  (find-file dir)
+  (url-dired-minor-mode t))
+
+(provide 'url-dired)
+
+;;; arch-tag: 2694f21a-43e1-4391-b3cb-cf6e5349f15f
diff --git a/lisp/url/url-file.el b/lisp/url/url-file.el
index 77c2e74555f..0aa23acc0ec 100644
--- a/lisp/url/url-file.el
+++ b/lisp/url/url-file.el
@@ -1,7 +1,6 @@
 ;;; url-file.el --- File retrieval code
 
 ;; Copyright (c) 1996 - 1999,2004  Free Software Foundation, Inc.
-;; Copyright (c) 1993 - 1996 by William M. Perry <wmperry@cs.indiana.edu>
 
 ;; Keywords: comm, data, processes
 
diff --git a/lisp/url/url-ftp.el b/lisp/url/url-ftp.el
new file mode 100644
index 00000000000..4346f3910b1
--- /dev/null
+++ b/lisp/url/url-ftp.el
@@ -0,0 +1,42 @@
+;;; url-ftp.el --- FTP wrapper
+;; Keywords: comm, data, processes
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Copyright (c) 1996 - 1999 Free Software Foundation, Inc.
+;;;
+;;; This file is part of GNU Emacs.
+;;;
+;;; GNU Emacs is free software; you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 2, or (at your option)
+;;; any later version.
+;;;
+;;; GNU Emacs is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Emacs; see the file COPYING.  If not, write to the
+;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;;; Boston, MA 02111-1307, USA.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;; We knew not what we did when we overloaded 'file' to mean 'file'
+;; and 'ftp' back in the dark ages of the web.
+;;
+;; This stub file is just here to please the auto-scheme-loading code
+;; in url-methods.el and just maps everything onto the code in
+;; url-file.
+
+(require 'url-parse)
+(require 'url-file)
+
+(defconst url-ftp-default-port 21 "Default FTP port.")
+(defconst url-ftp-asynchronous-p t "FTP transfers are asynchronous.")
+(defalias 'url-ftp-expand-file-name 'url-default-expander)
+(defalias 'url-ftp 'url-file)
+
+(provide 'url-ftp)
+
+;;; arch-tag: 9c3e70c4-350f-4d4a-bb51-a1e9b459e7dc
diff --git a/lisp/url/url-gw.el b/lisp/url/url-gw.el
new file mode 100644
index 00000000000..608827d7cee
--- /dev/null
+++ b/lisp/url/url-gw.el
@@ -0,0 +1,268 @@
+;;; url-gw.el --- Gateway munging for URL loading
+;; Author: Bill Perry <wmperry@gnu.org>
+;; Keywords: comm, data, processes
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Copyright (c) 1997, 1998, 2004 Free Software Foundation, Inc.
+;;;
+;;; This file is part of GNU Emacs.
+;;;
+;;; GNU Emacs is free software; you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 2, or (at your option)
+;;; any later version.
+;;;
+;;; GNU Emacs is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Emacs; see the file COPYING.  If not, write to the
+;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;;; Boston, MA 02111-1307, USA.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(eval-when-compile (require 'cl))
+(require 'url-vars)
+
+;; Fixme: support SSH explicitly or via a url-gateway-rlogin-program?
+
+(autoload 'socks-open-network-stream "socks")
+(autoload 'open-ssl-stream "ssl")
+(autoload 'open-tls-stream "tls")
+
+(defgroup url-gateway nil
+  "URL gateway variables"
+  :group 'url)
+
+(defcustom url-gateway-local-host-regexp nil
+  "*A regular expression specifying local hostnames/machines."
+  :type '(choice (const nil) regexp)
+  :group 'url-gateway)
+
+(defcustom url-gateway-prompt-pattern
+  "^[^#$%>;]*[#$%>;] *" ;; "bash\\|\$ *\r?$\\|> *\r?"
+  "*A regular expression matching a shell prompt."
+  :type 'regexp
+  :group 'url-gateway)
+
+(defcustom url-gateway-rlogin-host nil
+  "*What hostname to actually rlog into before doing a telnet."
+  :type '(choice (const nil) string)
+  :group 'url-gateway)
+
+(defcustom url-gateway-rlogin-user-name nil
+  "*Username to log into the remote machine with when using rlogin."
+  :type '(choice (const nil) string)
+  :group 'url-gateway)
+
+(defcustom url-gateway-rlogin-parameters '("telnet" "-8")
+  "*Parameters to `url-open-rlogin'.
+This list will be used as the parameter list given to rsh."
+  :type '(repeat string)
+  :group 'url-gateway)
+
+(defcustom url-gateway-telnet-host nil
+  "*What hostname to actually login to before doing a telnet."
+  :type '(choice (const nil) string)
+  :group 'url-gateway)
+
+(defcustom url-gateway-telnet-parameters '("exec" "telnet" "-8")
+  "*Parameters to `url-open-telnet'.
+This list will be executed as a command after logging in via telnet."
+  :type '(repeat string)
+  :group 'url-gateway)
+
+(defcustom url-gateway-telnet-login-prompt "^\r*.?login:"
+  "*Prompt that tells us we should send our username when loggin in w/telnet."
+  :type 'regexp
+  :group 'url-gateway)
+
+(defcustom url-gateway-telnet-password-prompt "^\r*.?password:"
+  "*Prompt that tells us we should send our password when loggin in w/telnet."
+  :type 'regexp
+  :group 'url-gateway)
+
+(defcustom url-gateway-telnet-user-name nil
+  "User name to log in via telnet with."
+  :type '(choice (const nil) string)
+  :group 'url-gateway)
+
+(defcustom url-gateway-telnet-password nil
+  "Password to use to log in via telnet with."
+  :type '(choice (const nil) string)
+  :group 'url-gateway)
+
+(defcustom url-gateway-broken-resolution nil
+  "*Whether to use nslookup to resolve hostnames.
+This should be used when your version of Emacs cannot correctly use DNS,
+but your machine can.  This usually happens if you are running a statically
+linked Emacs under SunOS 4.x"
+  :type 'boolean
+  :group 'url-gateway)
+
+(defcustom url-gateway-nslookup-program "nslookup"
+  "*If non-NIL then a string naming nslookup program."
+  :type '(choice (const :tag "None" :value nil) string)
+  :group 'url-gateway)
+
+;; Stolen from ange-ftp
+;;;###autoload
+(defun url-gateway-nslookup-host (host)
+  "Attempt to resolve the given HOST using nslookup if possible."
+  (interactive "sHost:  ")
+  (if url-gateway-nslookup-program
+      (let ((proc (start-process " *nslookup*" " *nslookup*"
+                                 url-gateway-nslookup-program host))
+            (res host))
+        (process-kill-without-query proc)
+        (save-excursion
+          (set-buffer (process-buffer proc))
+          (while (memq (process-status proc) '(run open))
+            (accept-process-output proc))
+          (goto-char (point-min))
+          (if (re-search-forward "Name:.*\nAddress: *\\(.*\\)$" nil t)
+              (setq res (buffer-substring (match-beginning 1)
+                                          (match-end 1))))
+          (kill-buffer (current-buffer)))
+        res)
+    host))
+
+;; Stolen from red gnus nntp.el
+(defun url-wait-for-string (regexp proc)
+  "Wait until string matching REGEXP arrives in process PROC's buffer."
+  (let ((buf (current-buffer)))
+    (goto-char (point-min))
+    (while (not (re-search-forward regexp nil t))
+      (accept-process-output proc)
+      (set-buffer buf)
+      (goto-char (point-min)))))
+
+;; Stolen from red gnus nntp.el
+(defun url-open-rlogin (name buffer host service)
+  "Open a connection using rsh."
+  (if (not (stringp service))
+      (setq service (int-to-string service)))
+  (let ((proc (if url-gateway-rlogin-user-name
+                  (start-process
+                   name buffer "rsh"
+                   url-gateway-rlogin-host "-l" url-gateway-rlogin-user-name
+                   (mapconcat 'identity
+                              (append url-gateway-rlogin-parameters
+                                      (list host service)) " "))
+                (start-process
+                 name buffer "rsh" url-gateway-rlogin-host
+                 (mapconcat 'identity
+                            (append url-gateway-rlogin-parameters
+                                    (list host service))
+                            " ")))))
+    (set-buffer buffer)
+    (url-wait-for-string "^\r*200" proc)
+    (beginning-of-line)
+    (delete-region (point-min) (point))
+    proc))
+
+;; Stolen from red gnus nntp.el
+(defun url-open-telnet (name buffer host service)
+  (if (not (stringp service))
+      (setq service (int-to-string service)))
+  (save-excursion
+    (set-buffer (get-buffer-create buffer))
+    (erase-buffer)
+    (let ((proc (start-process name buffer "telnet" "-8"))
+          (case-fold-search t))
+      (when (memq (process-status proc) '(open run))
+        (process-send-string proc "set escape \^X\n")
+        (process-send-string proc (concat
+                                   "open " url-gateway-telnet-host "\n"))
+        (url-wait-for-string url-gateway-telnet-login-prompt proc)
+        (process-send-string
+         proc (concat
+               (or url-gateway-telnet-user-name
+                   (setq url-gateway-telnet-user-name (read-string "login: ")))
+               "\n"))
+        (url-wait-for-string url-gateway-telnet-password-prompt proc)
+        (process-send-string
+         proc (concat
+               (or url-gateway-telnet-password
+                   (setq url-gateway-telnet-password
+                         (funcall url-passwd-entry-func "Password: ")))
+               "\n"))
+        (erase-buffer)
+        (url-wait-for-string url-gateway-prompt-pattern proc)
+        (process-send-string
+         proc (concat (mapconcat 'identity
+                                 (append url-gateway-telnet-parameters
+                                         (list host service)) " ") "\n"))
+        (url-wait-for-string "^\r*Escape character.*\r*\n+" proc)
+        (delete-region (point-min) (match-end 0))
+        (process-send-string proc "\^]\n")
+        (url-wait-for-string "^telnet" proc)
+        (process-send-string proc "mode character\n")
+        (accept-process-output proc 1)
+        (sit-for 1)
+        (goto-char (point-min))
+        (forward-line 1)
+        (delete-region (point) (point-max)))
+      proc)))
+
+;;;###autoload
+(defun url-open-stream (name buffer host service)
+  "Open a stream to HOST, possibly via a gateway.
+Args per `open-network-stream'.
+Will not make a connexion if `url-gateway-unplugged' is non-nil."
+  (unless url-gateway-unplugged
+    (let ((gw-method (if (and url-gateway-local-host-regexp
+                              (not (eq 'tls url-gateway-method))
+                              (not (eq 'ssl url-gateway-method))
+                              (string-match
+                               url-gateway-local-host-regexp
+                               host))
+                         'native
+                       url-gateway-method))
+;;;     ;; This hack is for OS/2 Emacs so that it will not do bogus CRLF
+;;;     ;; conversions while trying to be 'helpful'
+;;;     (tcp-binary-process-output-services (if (stringp service)
+;;;                                             (list service)
+;;;                                           (list service
+;;;                                                 (int-to-string service))))
+
+          ;; An attempt to deal with denied connections, and attempt
+          ;; to reconnect
+          (cur-retries 0)
+          (retry t)
+          (errobj nil)
+          (conn nil))
+
+      ;; If the user told us to do DNS for them, do it.
+      (if url-gateway-broken-resolution
+          (setq host (url-gateway-nslookup-host host)))
+
+      (condition-case errobj
+          ;; This is a clean way to ensure the new process inherits the
+          ;; right coding systems in both Emacs and XEmacs.
+          (let ((coding-system-for-read 'binary)
+                (coding-system-for-write 'binary))
+            (setq conn (case gw-method
+                         (tls
+                          (open-tls-stream name buffer host service))
+                         (ssl
+                          (open-ssl-stream name buffer host service))
+                         ((native)
+                          (open-network-stream name buffer host service))
+                         (socks
+                          (socks-open-network-stream name buffer host service))
+                         (telnet
+                          (url-open-telnet name buffer host service))
+                         (rlogin
+                          (url-open-rlogin name buffer host service))
+                         (otherwise
+                          (error "Bad setting of url-gateway-method: %s"
+                                 url-gateway-method)))))
+        (error
+         (setq conn nil)))
+      conn)))
+
+(provide 'url-gw)
+
+;;; arch-tag: 1c4c0317-6d03-45b8-b3f3-838bd8f9d838
diff --git a/lisp/url/url-handlers.el b/lisp/url/url-handlers.el
index 56497b00119..db961b9c27e 100644
--- a/lisp/url/url-handlers.el
+++ b/lisp/url/url-handlers.el
@@ -1,7 +1,6 @@
 ;;; url-handlers.el --- file-name-handler stuff for URL loading
 
 ;; Copyright (c) 1996, 1997, 1998, 1999, 2004  Free Software Foundation, Inc.
-;; Copyright (c) 1993 - 1996 by William M. Perry <wmperry@cs.indiana.edu>
 
 ;; Keywords: comm, data, processes, hypermedia
 
@@ -208,7 +207,7 @@ accessible."
         ;; annotation which we could use as a hint of the locale in use
         ;; at the remote site.  Not sure how/if that should be done.  --Stef
         (decode-coding-inserted-region
-         start (point) buffer-file-name visit beg end replace)))
+         start (point) url visit beg end replace)))
     (list url (length data))))
 
 (defun url-file-name-completion (url directory)
diff --git a/lisp/url/url-history.el b/lisp/url/url-history.el
new file mode 100644
index 00000000000..6a2d87cfbc1
--- /dev/null
+++ b/lisp/url/url-history.el
@@ -0,0 +1,199 @@
+;;; url-history.el --- Global history tracking for URL package
+
+;; Copyright (c) 1996 - 1999,2004  Free Software Foundation, Inc.
+
+;; Keywords: comm, data, processes, hypermedia
+
+;; This file is part of GNU Emacs.
+;;
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+;;
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;;; Code:
+
+;; This can get a recursive require.
+;;(require 'url)
+(eval-when-compile (require 'cl))
+(require 'url-parse)
+(autoload 'url-do-setup "url")
+
+(defgroup url-history nil
+  "History variables in the URL package"
+  :prefix "url-history"
+  :group 'url)
+
+(defcustom url-history-track nil
+  "*Controls whether to keep a list of all the URLS being visited.
+If non-nil, url will keep track of all the URLS visited.
+If eq to `t', then the list is saved to disk at the end of each emacs
+session."
+  :type 'boolean
+  :group 'url-history)
+
+(defcustom url-history-file nil
+  "*The global history file for the URL package.
+This file contains a list of all the URLs you have visited.  This file
+is parsed at startup and used to provide URL completion."
+  :type '(choice (const :tag "Default" :value nil) file)
+  :group 'url-history)
+
+(defcustom url-history-save-interval 3600
+  "*The number of seconds between automatic saves of the history list.
+Default is 1 hour.  Note that if you change this variable outside of
+the `customize' interface after `url-do-setup' has been run, you need
+to run the `url-history-setup-save-timer' function manually."
+  :set (function (lambda (var val)
+                   (set-default var val)
+                   (and (featurep 'url)
+                        (fboundp 'url-history-setup-save-timer)
+                        (let ((def (symbol-function
+                                    'url-history-setup-save-timer)))
+                          (not (and (listp def) (eq 'autoload (car def)))))
+                        (url-history-setup-save-timer))))
+  :type 'integer
+  :group 'url-history)
+
+(defvar url-history-timer nil)
+
+(defvar url-history-list nil
+  "List of urls visited this session.")
+
+(defvar url-history-changed-since-last-save nil
+  "Whether the history list has changed since the last save operation.")
+
+(defvar url-history-hash-table nil
+  "Hash table for global history completion.")
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;;;###autoload
+(defun url-history-setup-save-timer ()
+  "Reset the history list timer."
+  (interactive)
+  (ignore-errors 
+    (cond ((fboundp 'cancel-timer) (cancel-timer url-history-timer))
+          ((fboundp 'delete-itimer) (delete-itimer url-history-timer))))
+  (setq url-history-timer nil)
+  (if url-history-save-interval
+      (setq url-history-timer
+            (cond
+             ((fboundp 'run-at-time)
+              (run-at-time url-history-save-interval
+                           url-history-save-interval
+                           'url-history-save-history))
+             ((fboundp 'start-itimer)
+              (start-itimer "url-history-saver" 'url-history-save-history
+                            url-history-save-interval
+                            url-history-save-interval))))))
+
+;;;###autoload
+(defun url-history-parse-history (&optional fname)
+  "Parse a history file stored in FNAME."
+  ;; Parse out the mosaic global history file for completions, etc.
+  (or fname (setq fname (expand-file-name url-history-file)))
+  (cond
+   ((not (file-exists-p fname))
+    (message "%s does not exist." fname))
+   ((not (file-readable-p fname))
+    (message "%s is unreadable." fname))
+   (t
+    (condition-case nil
+        (load fname nil t)
+      (error (message "Could not load %s" fname)))))
+  (if (not url-history-hash-table)
+      (setq url-history-hash-table (make-hash-table :size 31 :test 'equal))))
+
+(defun url-history-update-url (url time)
+  (setq url-history-changed-since-last-save t)
+  (puthash (if (vectorp url) (url-recreate-url url) url) time url-history-hash-table))
+
+;;;###autoload
+(defun url-history-save-history (&optional fname)
+  "Write the global history file into `url-history-file'.
+The type of data written is determined by what is in the file to begin
+with.  If the type of storage cannot be determined, then prompt the
+user for what type to save as."
+  (interactive)
+  (or fname (setq fname (expand-file-name url-history-file)))
+  (cond
+   ((not url-history-changed-since-last-save) nil)
+   ((not (file-writable-p fname))
+    (message "%s is unwritable." fname))
+   (t
+    (let ((make-backup-files nil)
+          (version-control nil)
+          (require-final-newline t))
+      (save-excursion
+        (set-buffer (get-buffer-create " *url-tmp*"))
+        (erase-buffer)
+        (let ((count 0))
+          (maphash (function
+                       (lambda (key value)
+                         (while (string-match "[\r\n]+" key)
+                           (setq key (concat (substring key 0 (match-beginning 0))
+                                             (substring key (match-end 0) nil))))
+                         (setq count (1+ count))
+                         (insert "(puthash \"" key "\""
+                                 (if (not (stringp value)) " '" "")
+                                 (prin1-to-string value)
+                                 " url-history-hash-table)\n")))
+                      url-history-hash-table)
+          (goto-char (point-min))
+          (insert (format
+                   "(setq url-history-hash-table (make-hash-table :size %d :test 'equal))\n"
+                   (/ count 4)))
+          (goto-char (point-max))
+          (insert "\n")
+          (write-file fname))
+        (kill-buffer (current-buffer))))))
+  (setq url-history-changed-since-last-save nil))
+
+(defun url-have-visited-url (url)
+  (url-do-setup)
+  (gethash url url-history-hash-table nil))
+
+(defun url-completion-function (string predicate function)
+  (url-do-setup)
+  (cond
+   ((eq function nil)
+    (let ((list nil))
+      (maphash (function (lambda (key val)
+                              (setq list (cons (cons key val)
+                                               list))))
+                  url-history-hash-table)
+      (try-completion string (nreverse list) predicate)))
+   ((eq function t)
+    (let ((stub (concat "^" (regexp-quote string)))
+          (retval nil))
+      (maphash
+       (function
+        (lambda (url time)
+          (if (string-match stub url)
+              (setq retval (cons url retval)))))
+       url-history-hash-table)
+      retval))
+   ((eq function 'lambda)
+    (and url-history-hash-table
+         (gethash string url-history-hash-table)
+         t))
+   (t
+    (error "url-completion-function very confused."))))
+
+(provide 'url-history)
+
+;; arch-tag: fbbbaf63-db36-4e88-bc9f-2939aa93afb2
+;;; url-history.el ends here
diff --git a/lisp/url/url-https.el b/lisp/url/url-https.el
index 11b2593ea80..9631aeb18e4 100644
--- a/lisp/url/url-https.el
+++ b/lisp/url/url-https.el
@@ -1,4 +1,4 @@
-;;; url-https.el --- HTTP over SSL routines
+;;; url-https.el --- HTTP over SSL/TLS routines
 
 ;; Copyright (c) 1999, 2004 Free Software Foundation, Inc.
 
@@ -30,6 +30,7 @@
 (require 'url-parse)
 (require 'url-cookie)
 (require 'url-http)
+(require 'tls)
 
 (defconst url-https-default-port 443 "Default HTTPS port.")
 (defconst url-https-asynchronous-p t "HTTPS retrievals are asynchronous.")
@@ -38,12 +39,11 @@
 (defmacro url-https-create-secure-wrapper (method args)
   `(defun ,(intern (format (if method "url-https-%s" "url-https") method)) ,args
     ,(format "HTTPS wrapper around `%s' call." (or method "url-http"))
-    (condition-case ()
-        (require 'ssl)
-      (error
-       (error "HTTPS support could not find `ssl' library")))
-    (let ((url-gateway-method 'ssl))
-      ( ,(intern (format (if method "url-http-%s" "url-http") method)) ,@(remove '&rest (remove '&optional args))))))
+    (let ((url-gateway-method (condition-case ()
+                                  (require 'ssl)
+                                (error 'tls))))
+      (,(intern (format (if method "url-http-%s" "url-http") method))
+       ,@(remove '&rest (remove '&optional args))))))
 
 (url-https-create-secure-wrapper nil (url callback cbargs))
 (url-https-create-secure-wrapper file-exists-p (url))
diff --git a/lisp/url/url-irc.el b/lisp/url/url-irc.el
new file mode 100644
index 00000000000..a4b195f253f
--- /dev/null
+++ b/lisp/url/url-irc.el
@@ -0,0 +1,76 @@
+;;; url-irc.el --- IRC URL interface
+;; Keywords: comm, data, processes
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Copyright (c) 1996 - 1999 Free Software Foundation, Inc.
+;;;
+;;; This file is part of GNU Emacs.
+;;;
+;;; GNU Emacs is free software; you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 2, or (at your option)
+;;; any later version.
+;;;
+;;; GNU Emacs is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Emacs; see the file COPYING.  If not, write to the
+;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;;; Boston, MA 02111-1307, USA.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;;; IRC URLs are defined in http://www.w3.org/Addressing/draft-mirashi-url-irc-01.txt
+
+(require 'url-vars)
+(require 'url-parse)
+
+(defconst url-irc-default-port 6667 "Default port for IRC connections")
+
+(defcustom url-irc-function 'url-irc-zenirc
+  "*Function to actually open an IRC connection.
+Should be a function that takes several argument:
+    HOST - the hostname of the IRC server to contact
+    PORT - the port number of the IRC server to contact
+ CHANNEL - What channel on the server to visit right away (can be nil)
+    USER - What username to use
+PASSWORD - What password to use"
+  :type '(choice (const :tag "ZEN IRC" :value 'url-irc-zenirc)
+                 (function :tag "Other"))
+  :group 'url)
+
+(defun url-irc-zenirc (host port channel user password)
+  (let ((zenirc-buffer-name (if (and user host port)
+                                (format "%s@%s:%d" user host port)
+                              (format "%s:%d" host port)))
+        (zenirc-server-alist
+         (list
+          (list host port password nil user))))
+    (zenirc)
+    (goto-char (point-max))
+    (if (not channel)
+        nil
+      (insert "/join " channel)
+      (zenirc-send-line))))
+
+;;;###autoload
+(defun url-irc (url)
+  (let* ((host (url-host url))
+         (port (string-to-int (url-port url)))
+         (pass (url-password url))
+         (user (url-user url))
+         (chan (url-filename url)))
+    (if (url-target url)
+        (setq chan (concat chan "#" (url-target url))))
+    (if (string-match "^/" chan)
+        (setq chan (substring chan 1 nil)))
+    (if (= (length chan) 0)
+        (setq chan nil))
+    (funcall url-irc-function host port chan user pass)
+    nil))
+    
+(provide 'url-irc)
+
+;;; arch-tag: 2e5eecf8-9eb3-436b-9fbd-c26f2fb2bf3e
diff --git a/lisp/url/url-ldap.el b/lisp/url/url-ldap.el
new file mode 100644
index 00000000000..24a3ade4922
--- /dev/null
+++ b/lisp/url/url-ldap.el
@@ -0,0 +1,240 @@
+;;; url-ldap.el --- LDAP Uniform Resource Locator retrieval code
+;; Copyright (c) 1998 - 1999, 2004 Free Software Foundation, Inc.
+
+;; Keywords: comm, data, processes
+
+;; This file is part of GNU Emacs.
+;;
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+;;
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;;; Code:
+
+(require 'url-vars)
+(require 'url-parse)
+(require 'url-util)
+(require 'ldap)
+(autoload 'tls-certificate-information "tls")
+
+;; This has been implemented from RFC2255 'The LDAP URL Format' (Dec 1997)
+;;
+;; basic format is: ldap://host:port/dn?attributes?scope?filter?extensions
+;;
+;; Test URLs:
+;; ldap://ldap.itd.umich.edu/cn%3Dumbflabmanager%2C%20ou%3DUser%20Groups%2C%20ou%3DGroups%2C%20o%3DUniversity%20of%20Michigan%2C%20c%3DUS
+;; ldap://ldap.itd.umich.edu/o=University%20of%20Michigan,c=US
+;;
+;; For simple queries, I have verified compatibility with Netscape
+;; Communicator v4.5 under GNU/Linux.
+;;
+;; For anything _useful_ though, like specifying the attributes,
+;; scope, filter, or extensions, netscape claims the URL format is
+;; unrecognized.  So I don't think it supports anything other than the
+;; defaults (scope=base,attributes=*,filter=(objectClass=*)
+
+(defconst url-ldap-default-port 389 "Default LDAP port.")
+(defalias 'url-ldap-expand-file-name 'url-default-expander)
+
+(defvar url-ldap-pretty-names
+  '(("l"           . "City")
+    ("objectclass" . "Object Class")
+    ("o"           . "Organization")
+    ("ou"          . "Organizational Unit")
+    ("cn"          . "Name")
+    ("sn"          . "Last Name")
+    ("givenname"   . "First Name")
+    ("mail"        . "Email")
+    ("title"       . "Title")
+    ("c"           . "Country")
+    ("postalcode"  . "ZIP Code")
+    ("telephonenumber"          . "Phone Number")
+    ("facsimiletelephonenumber" . "Fax")
+    ("postaladdress"            . "Mailing Address")
+    ("description"              . "Notes"))
+  "*An assoc list mapping LDAP attribute names to pretty descriptions of them.")
+
+(defvar url-ldap-attribute-formatters
+  '(("mail"       . (lambda (x) (format "<a href='mailto:%s'>%s</a>" x x)))
+    ("owner"      . url-ldap-dn-formatter)
+    ("creatorsname" . url-ldap-dn-formatter)
+    ("jpegphoto"     . url-ldap-image-formatter)
+    ("usercertificate" . url-ldap-certificate-formatter)
+    ("modifiersname" . url-ldap-dn-formatter)
+    ("namingcontexts" . url-ldap-dn-formatter)
+    ("defaultnamingcontext" . url-ldap-dn-formatter)
+    ("member"     . url-ldap-dn-formatter))
+  "*An assoc list mapping LDAP attribute names to pretty formatters for them.")
+
+(defsubst url-ldap-attribute-pretty-name (n)
+  (or (cdr-safe (assoc (downcase n) url-ldap-pretty-names)) n))
+
+(defsubst url-ldap-attribute-pretty-desc (n v)
+  (if (string-match "^\\([^;]+\\);" n)
+      (setq n (match-string 1 n)))
+  (funcall (or (cdr-safe (assoc (downcase n) url-ldap-attribute-formatters)) 'identity) v))
+
+(defun url-ldap-dn-formatter (dn)
+  (concat "<a href='/"
+          (url-hexify-string dn)
+          "'>" dn "</a>"))
+
+(defun url-ldap-certificate-formatter (data)
+  (condition-case ()
+      (require 'ssl)
+    (error nil))
+  (let ((vals (if (fboundp 'ssl-certificate-information)
+                  (ssl-certificate-information data)
+                (tls-certificate-information data))))
+    (if (not vals)
+        "<b>Unable to parse certificate</b>"
+      (concat "<table border=0>\n"
+              (mapconcat
+               (lambda (ava)
+                 (format "<tr><td>%s</td><td>%s</td></tr>\n" (car ava) (cdr ava)))
+               vals "\n")
+              "</table>\n"))))
+
+(defun url-ldap-image-formatter (data)
+  (format "<img alt='JPEG Photo' src='data:image/jpeg;base64,%s'>"
+          (url-hexify-string (base64-encode-string data))))
+
+;; FIXME: This needs sorting out for the Emacs LDAP functions, specifically
+;; calls of ldap-open, ldap-close, ldap-search-internal
+;;;###autoload
+(defun url-ldap (url)
+  (save-excursion
+    (set-buffer (generate-new-buffer " *url-ldap*"))
+    (setq url-current-object url)
+    (insert "Content-type: text/html\r\n\r\n")
+    (if (not (fboundp 'ldap-search-internal))
+        (insert "<html>\n"
+                " <head>\n"
+                "  <title>LDAP Not Supported</title>\n"
+                "  <base href='" (url-recreate-url url) "'>\n"
+                " </head>\n"
+                " <body>\n"
+                "  <h1>LDAP Not Supported</h1>\n"
+                "  <p>\n"
+                "    This version of Emacs does not support LDAP.\n"
+                "  </p>\n"
+                " </body>\n"
+                "</html>\n")
+      (let* ((binddn nil)
+             (data (url-filename url))
+             (host (url-host url))
+             (port (url-port url))
+             (base-object nil)
+             (attributes nil)
+             (scope nil)
+             (filter nil)
+             (extensions nil)
+             (connection nil)
+             (results nil)
+             (extract-dn (and (fboundp 'function-max-args)
+                              (= (function-max-args 'ldap-search-internal) 7))))
+
+        ;; Get rid of leading /
+        (if (string-match "^/" data)
+            (setq data (substring data 1)))
+
+        (setq data (mapcar (lambda (x) (if (/= (length x) 0) x nil)) (split-string data "\\?"))
+              base-object (nth 0 data)
+              attributes (nth 1 data)
+              scope (nth 2 data)
+              filter (nth 3 data)
+              extensions (nth 4 data))
+
+        ;; fill in the defaults
+        (setq base-object (url-unhex-string (or base-object ""))
+              scope (intern (url-unhex-string (or scope "base")))
+              filter (url-unhex-string (or filter "(objectClass=*)")))
+
+        (if (not (memq scope '(base one tree)))
+            (error "Malformed LDAP URL: Unknown scope: %S" scope))
+
+        ;; Convert to the internal LDAP support scoping names.
+        (setq scope (cdr (assq scope '((base . base) (one . onelevel) (sub . subtree)))))
+
+        (if attributes
+            (setq attributes (mapcar 'url-unhex-string (split-string attributes ","))))
+
+        ;; Parse out the exentions
+        (if extensions
+            (setq extensions (mapcar (lambda (ext)
+                                       (if (string-match "\\([^=]*\\)=\\(.*\\)" ext)
+                                           (cons (match-string 1 ext) (match-string 2 ext))
+                                         (cons ext ext)))
+                                     (split-string extensions ","))
+                  extensions (mapcar (lambda (ext)
+                                       (cons (url-unhex-string (car ext))
+                                             (url-unhex-string (cdr ext))))
+                                     extensions)))
+
+        (setq binddn (cdr-safe (or (assoc "bindname" extensions)
+                                   (assoc "!bindname" extensions))))
+    
+        ;; Now, let's actually do something with it.
+        (setq connection (ldap-open host (if binddn (list 'binddn binddn)))
+              results (if extract-dn
+                          (ldap-search-internal connection filter base-object scope attributes nil t)
+                        (ldap-search-internal connection filter base-object scope attributes nil)))
+                      
+        (ldap-close connection)
+        (insert "<html>\n"
+                " <head>\n"
+                "  <title>LDAP Search Results</title>\n"
+                "  <base href='" (url-recreate-url url) "'>\n"
+                " </head>\n"
+                " <body>\n"
+                "  <h1>" (int-to-string (length results)) " matches</h1>\n")
+
+        (mapc (lambda (obj)
+                (insert "  <hr>\n"
+                        "  <table border=1>\n")
+                (if extract-dn
+                    (insert "   <tr><th colspan=2>" (car obj) "</th></tr>\n"))
+                (mapc (lambda (attr)
+                        (if (= (length (cdr attr)) 1)
+                            ;; single match, easy
+                            (insert "   <tr><td>"
+                                    (url-ldap-attribute-pretty-name (car attr))
+                                    "</td><td>"
+                                    (url-ldap-attribute-pretty-desc (car attr) (car (cdr attr)))
+                                    "</td></tr>\n")
+                          ;; Multiple matches, slightly uglier
+                          (insert "   <tr>\n"
+                                  (format "    <td valign=top>")
+                                  (url-ldap-attribute-pretty-name (car attr)) "</td><td>"
+                                  (mapconcat (lambda (x)
+                                               (url-ldap-attribute-pretty-desc (car attr) x))
+                                             (cdr attr)
+                                             "<br>\n")
+                                  "</td>"
+                                  "   </tr>\n")))
+                      (if extract-dn (cdr obj) obj))
+                (insert "  </table>\n"))
+              results)
+
+        (insert "  <hr>\n"
+                " </body>\n"
+                "</html>\n")))
+    (current-buffer)))
+
+(provide 'url-ldap)
+
+;; arch-tag: 6230e21c-41ae-4174-bd83-82c835676fc8
+;;; url-ldap.el ends here
diff --git a/lisp/url/url-mailto.el b/lisp/url/url-mailto.el
new file mode 100644
index 00000000000..bcb6bad4179
--- /dev/null
+++ b/lisp/url/url-mailto.el
@@ -0,0 +1,131 @@
+;;; url-mail.el --- Mail Uniform Resource Locator retrieval code
+
+;; Copyright (c) 1996 - 1999 Free Software Foundation, Inc.
+
+;; Keywords: comm, data, processes
+
+;; This file is part of GNU Emacs.
+;;
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+;;
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;;; Code:
+
+(eval-when-compile (require 'cl))
+(require 'url-vars)
+(require 'url-parse)
+(require 'url-util)
+
+;;;###autoload
+(defun url-mail (&rest args)
+  (interactive "P")
+  (if (fboundp 'message-mail)
+      (apply 'message-mail args)
+    (or (apply 'mail args)
+        (error "Mail aborted"))))
+
+(defun url-mail-goto-field (field)
+  (if (not field)
+      (goto-char (point-max))
+    (let ((dest nil)
+          (lim nil)
+          (case-fold-search t))
+      (save-excursion
+        (goto-char (point-min))
+        (if (re-search-forward (regexp-quote mail-header-separator) nil t)
+            (setq lim (match-beginning 0)))
+        (goto-char (point-min))
+        (if (re-search-forward (concat "^" (regexp-quote field) ":") lim t)
+            (setq dest (match-beginning 0))))
+      (if dest
+          (progn
+            (goto-char dest)
+            (end-of-line))
+        (goto-char lim)
+        (insert (capitalize field) ": ")
+        (save-excursion
+          (insert "\n"))))))
+
+;;;###autoload
+(defun url-mailto (url)
+  "Handle the mailto: URL syntax."
+  (if (url-user url)
+      ;; malformed mailto URL (mailto://wmperry@gnu.org instead of
+      ;; mailto:wmperry@gnu.org
+      (url-set-filename url (concat (url-user url) "@" (url-filename url))))
+  (setq url (url-filename url))
+  (let (to args source-url subject func headers-start)
+    (if (string-match (regexp-quote "?") url)
+        (setq headers-start (match-end 0)
+              to (url-unhex-string (substring url 0 (match-beginning 0)))
+              args (url-parse-query-string
+                    (substring url headers-start nil) t))
+      (setq to (url-unhex-string url)))
+    (setq source-url (url-view-url t))
+    (if (and url-request-data (not (assoc "subject" args)))
+        (setq args (cons (list "subject"
+                               (concat "Automatic submission from "
+                                       url-package-name "/"
+                                       url-package-version)) args)))
+    (if (and source-url (not (assoc "x-url-from" args)))
+        (setq args (cons (list "x-url-from" source-url) args)))
+
+    (if (assoc "to" args)
+        (push to (cdr (assoc "to" args)))
+      (setq args (cons (list "to" to) args)))
+    (setq subject (cdr-safe (assoc "subject" args)))
+    (if (fboundp url-mail-command) (funcall url-mail-command) (mail))
+    (while args
+      (if (string= (caar args) "body")
+          (progn
+            (goto-char (point-max))
+            (insert (mapconcat 'identity (cdar args) "\n")))
+        (url-mail-goto-field (caar args))
+        (setq func (intern-soft (concat "mail-" (caar args))))
+        (insert (mapconcat 'identity (cdar args) ", ")))
+      (setq args (cdr args)))
+    ;; (url-mail-goto-field "User-Agent")
+;;     (insert url-package-name "/" url-package-version " URL/" url-version)
+    (if (not url-request-data)
+        (progn
+          (set-buffer-modified-p nil)
+          (if subject
+              (url-mail-goto-field nil)
+            (url-mail-goto-field "subject")))
+      (if url-request-extra-headers
+          (mapconcat
+           (lambda (x)
+             (url-mail-goto-field (car x))
+             (insert (cdr x)))
+           url-request-extra-headers ""))
+      (goto-char (point-max))
+      (insert url-request-data)
+      ;; It seems Microsoft-ish to send without warning.
+      ;; Fixme: presumably this should depend on a privacy setting.
+      (if (y-or-n-p "Send this auto-generated mail? ")
+          (cond ((eq url-mail-command 'compose-mail)
+                 (funcall (get mail-user-agent 'sendfunc) nil))
+                ;; otherwise, we can't be sure
+                ((fboundp 'message-send-and-exit)
+                 (message-send-and-exit))
+                (t (mail-send-and-exit nil)))))
+    nil))
+
+(provide 'url-mailto)
+
+;; arch-tag: 7b7ad52e-8760-497b-9444-75fae14e34c5
+;;; url-mailto.el ends here
diff --git a/lisp/url/url-methods.el b/lisp/url/url-methods.el
new file mode 100644
index 00000000000..75d746f3e3f
--- /dev/null
+++ b/lisp/url/url-methods.el
@@ -0,0 +1,150 @@
+;;; url-methods.el --- Load URL schemes as needed
+
+;; Copyright (c) 1996,1997,1998,1999,2004  Free Software Foundation, Inc.
+
+;; Keywords: comm, data, processes, hypermedia
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+;;
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;;; Code:
+
+(eval-when-compile
+  (require 'cl))
+
+;; This loads up some of the small, silly URLs that I really don't
+;; want to bother putting in their own separate files.
+(require 'url-parse)
+
+(defvar url-scheme-registry (make-hash-table :size 7 :test 'equal))
+
+(defconst url-scheme-methods
+  '((default-port      . variable)
+    (asynchronous-p    . variable)
+    (expand-file-name  . function)
+    (file-exists-p     . function)
+    (file-attributes   . function)
+    (parse-url         . function)
+    (file-symlink-p    . function)
+    (file-writable-p   . function)
+    (file-directory-p  . function)
+    (file-executable-p . function)
+    (directory-files   . function)
+    (file-truename     . function))
+  "Assoc-list of methods that each URL loader can provide.")
+
+(defconst url-scheme-default-properties
+  (list 'name "unknown"
+        'loader 'url-scheme-default-loader
+        'default-port 0
+        'expand-file-name 'url-identity-expander
+        'parse-url 'url-generic-parse-url
+        'asynchronous-p nil
+        'file-directory-p 'ignore
+        'file-truename (lambda (&rest args)
+                         (url-recreate-url (car args)))
+        'file-exists-p 'ignore
+        'file-attributes 'ignore))
+
+(defun url-scheme-default-loader (url &optional callback cbargs)
+  "Signal an error for an unknown URL scheme."
+  (error "Unkown URL scheme: %s" (url-type url)))
+
+(defun url-scheme-register-proxy (scheme)
+  "Automatically find a proxy for SCHEME and put it in `url-proxy-services'."
+  (let* ((env-var (concat scheme "_proxy"))
+         (env-proxy (or (getenv (upcase env-var))
+                        (getenv (downcase env-var))))
+         (cur-proxy (assoc scheme url-proxy-services))
+         (urlobj nil))
+
+    ;; Store any proxying information - this will not overwrite an old
+    ;; entry, so that people can still set this information in their
+    ;; .emacs file
+    (cond
+     (cur-proxy nil)                    ; Keep their old settings
+     ((null env-proxy) nil)             ; No proxy setup
+     ;; First check if its something like hostname:port
+     ((string-match "^\\([^:]+\\):\\([0-9]+\\)$" env-proxy)
+      (setq urlobj (url-generic-parse-url nil)) ; Get a blank object
+      (url-set-type urlobj "http")
+      (url-set-host urlobj (match-string 1 env-proxy))
+      (url-set-port urlobj (string-to-number (match-string 2 env-proxy))))
+     ;; Then check if its a fully specified URL
+     ((string-match url-nonrelative-link env-proxy)
+      (setq urlobj (url-generic-parse-url env-proxy))
+      (url-set-type urlobj "http")
+      (url-set-target urlobj nil))
+     ;; Finally, fall back on the assumption that its just a hostname
+     (t
+      (setq urlobj (url-generic-parse-url nil)) ; Get a blank object
+      (url-set-type urlobj "http")
+      (url-set-host urlobj env-proxy)))
+
+     (if (and (not cur-proxy) urlobj)
+         (progn
+           (setq url-proxy-services
+                 (cons (cons scheme (format "%s:%d" (url-host urlobj)
+                                            (url-port urlobj)))
+                       url-proxy-services))
+           (message "Using a proxy for %s..." scheme)))))
+
+(defun url-scheme-get-property (scheme property)
+  "Get property of a URL SCHEME.
+Will automatically try to load a backend from url-SCHEME.el if
+it has not already been loaded."
+  (setq scheme (downcase scheme))
+  (let ((desc (gethash scheme url-scheme-registry)))
+    (if (not desc)
+        (let* ((stub (concat "url-" scheme))
+               (loader (intern stub)))
+          (condition-case ()
+              (require loader)
+            (error nil))
+          (if (fboundp loader)
+              (progn
+                ;; Found the module to handle <scheme> URLs
+                (url-scheme-register-proxy scheme)
+                (setq desc (list 'name scheme
+                                 'loader loader))
+                (dolist (cell url-scheme-methods)
+                  (let ((symbol (intern-soft (format "%s-%s" stub (car cell))))
+                        (type (cdr cell)))
+                    (if symbol
+                        (case type
+                          (function
+                           ;; Store the symbol name of a function
+                           (if (fboundp symbol)
+                               (setq desc (plist-put desc (car cell) symbol))))
+                          (variable
+                           ;; Store the VALUE of a variable
+                           (if (boundp symbol)
+                               (setq desc (plist-put desc (car cell)
+                                                     (symbol-value symbol)))))
+                          (otherwise
+                           (error "Malformed url-scheme-methods entry: %S"
+                                  cell))))))
+                (puthash scheme desc url-scheme-registry)))))
+    (or (plist-get desc property)
+        (plist-get url-scheme-default-properties property))))
+
+(provide 'url-methods)
+
+;; arch-tag: 336863f8-5a07-4906-9be5-b3c6bcebbe67
+;;; url-methods.el ends here
diff --git a/lisp/url/url-misc.el b/lisp/url/url-misc.el
new file mode 100644
index 00000000000..ff2f1282137
--- /dev/null
+++ b/lisp/url/url-misc.el
@@ -0,0 +1,117 @@
+;;; url-misc.el --- Misc Uniform Resource Locator retrieval code
+;; Keywords: comm, data, processes
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Copyright (c) 1996,1997,1998,1999,2002 Free Software Foundation, Inc.
+;;;
+;;; This file is part of GNU Emacs.
+;;;
+;;; GNU Emacs is free software; you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 2, or (at your option)
+;;; any later version.
+;;;
+;;; GNU Emacs is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Emacs; see the file COPYING.  If not, write to the
+;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;;; Boston, MA 02111-1307, USA.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(require 'url-vars)
+(require 'url-parse)
+(autoload 'Info-goto-node "info" "" t)
+(autoload 'man "man" nil t)
+
+;;;###autoload
+(defun url-man (url)
+  "Fetch a Unix manual page URL."
+  (man (url-filename url))
+  nil)
+
+;;;###autoload
+(defun url-info (url)
+  "Fetch a GNU Info URL."
+  ;; Fetch an info node
+  (let* ((fname (url-filename url))
+         (node (url-unhex-string (or (url-target url) "Top"))))
+    (if (and fname node)
+        (Info-goto-node (concat "(" fname ")" node))
+      (error "Malformed url: %s" (url-recreate-url url)))
+    nil))
+
+(defun url-do-terminal-emulator (type server port user)
+  (terminal-emulator
+   (generate-new-buffer (format "%s%s" (if user (concat user "@") "") server))
+   (case type
+     (rlogin "rlogin")
+     (telnet "telnet")
+     (tn3270 "tn3270")
+     (otherwise
+      (error "Unknown terminal emulator required: %s" type)))
+   (case type
+     (rlogin
+      (if user
+          (list server "-l" user)
+        (list server)))
+     (telnet
+      (if user (message "Please log in as user: %s" user))
+      (if port
+          (list server port)
+        (list server)))
+     (tn3270
+      (if user (message "Please log in as user: %s" user))
+      (list server)))))
+
+;;;###autoload
+(defun url-generic-emulator-loader (url)
+  (let* ((type (intern (downcase (url-type url))))
+         (server (url-host url))
+         (name (url-user url))
+         (port (url-port url)))
+    (url-do-terminal-emulator type server port name))
+  nil)
+
+;;;###autoload
+(defalias 'url-rlogin 'url-generic-emulator-loader)
+;;;###autoload
+(defalias 'url-telnet 'url-generic-emulator-loader)
+;;;###autoload
+(defalias 'url-tn3270 'url-generic-emulator-loader)
+
+;; RFC 2397
+;;;###autoload
+(defun url-data (url)
+  "Fetch a data URL (RFC 2397)."
+  (let ((mediatype nil)
+        ;; The mediatype may need to be hex-encoded too -- see the RFC.
+        (desc (url-unhex-string (url-filename url)))
+        (encoding "8bit")
+        (data nil))
+    (save-excursion
+      (if (not (string-match "\\([^,]*\\)?," desc))
+          (error "Malformed data URL: %s" desc)
+        (setq mediatype (match-string 1 desc))
+        (if (and mediatype (string-match ";base64\\'" mediatype))
+            (setq mediatype (substring mediatype 0 (match-beginning 0))
+                  encoding "base64"))
+        (if (or (null mediatype)
+                (eq ?\; (aref mediatype 0)))
+          (setq mediatype (concat "text/plain" mediatype)))
+        (setq data (url-unhex-string (substring desc (match-end 0)))))
+      (set-buffer (generate-new-buffer " *url-data*"))
+      (mm-disable-multibyte)
+      (insert (format "Content-Length: %d\n" (length data))
+              "Content-Type: " mediatype "\n"
+              "Content-Encoding: " encoding "\n"
+              "\n")
+      (if data (insert data))
+      (current-buffer))))
+
+(provide 'url-misc)
+
+;;; arch-tag: 8c544e1b-d8bc-40a6-b319-f1f37fef65a0
diff --git a/lisp/url/url-news.el b/lisp/url/url-news.el
new file mode 100644
index 00000000000..59364c9ccd0
--- /dev/null
+++ b/lisp/url/url-news.el
@@ -0,0 +1,135 @@
+;;; url-news.el --- News Uniform Resource Locator retrieval code
+;; Keywords: comm, data, processes
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Copyright (c) 1996 - 1999, 2004 Free Software Foundation, Inc.
+;;;
+;;; This file is part of GNU Emacs.
+;;;
+;;; GNU Emacs is free software; you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 2, or (at your option)
+;;; any later version.
+;;;
+;;; GNU Emacs is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Emacs; see the file COPYING.  If not, write to the
+;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;;; Boston, MA 02111-1307, USA.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(require 'url-vars)
+(require 'url-util)
+(require 'url-parse)
+(require 'nntp)
+(autoload 'url-warn "url")
+(autoload 'gnus-group-read-ephemeral-group "gnus-group")
+(eval-when-compile (require 'cl))
+
+(defgroup url-news nil
+  "News related options"
+  :group 'url)
+
+(defun url-news-open-host (host port user pass)
+  (if (fboundp 'nnheader-init-server-buffer)
+      (nnheader-init-server-buffer))
+  (nntp-open-server host (list (string-to-int port)))
+  (if (and user pass)
+      (progn
+        (nntp-send-command "^.*\r?\n" "AUTHINFO USER" user)
+        (nntp-send-command "^.*\r?\n" "AUTHINFO PASS" pass)
+        (if (not (nntp-server-opened host))
+            (url-warn 'url (format "NNTP authentication to `%s' as `%s' failed"
+                                   host user))))))
+
+(defun url-news-fetch-message-id (host message-id)
+  (let ((buf (generate-new-buffer " *url-news*")))
+    (if (eq ?> (aref message-id (1- (length message-id))))
+        nil
+      (setq message-id (concat "<" message-id ">")))
+    (if (cdr-safe (nntp-request-article message-id nil host buf))
+        ;; Successfully retrieved the article
+        nil
+      (save-excursion
+        (set-buffer buf)
+        (insert "Content-type: text/html\n\n"
+                "<html>\n"
+                " <head>\n"
+                "  <title>Error</title>\n"
+                " </head>\n"
+                " <body>\n"
+                "  <div>\n"
+                "   <h1>Error requesting article...</h1>\n"
+                "   <p>\n"
+                "    The status message returned by the NNTP server was:"
+                "<br><hr>\n"
+                "    <xmp>\n"
+                (nntp-status-message)
+                "    </xmp>\n"
+                "   </p>\n"
+                "   <p>\n"
+                "    If you If you feel this is an error, <a href=\""
+                "mailto:" url-bug-address "\">send mail</a>\n"
+                "   </p>\n"
+                "  </div>\n"
+                " </body>\n"
+                "</html>\n"
+                "<!-- Automatically generated by URL v" url-version " -->\n"
+                )))
+    buf))
+
+(defun url-news-fetch-newsgroup (newsgroup host)
+  (declare (special gnus-group-buffer))
+  (if (string-match "^/+" newsgroup)
+      (setq newsgroup (substring newsgroup (match-end 0))))
+  (if (string-match "/+$" newsgroup)
+      (setq newsgroup (substring newsgroup 0 (match-beginning 0))))
+
+  ;; This saves us from checking new news if Gnus is already running
+  ;; FIXME - is it relatively safe to use gnus-alive-p here? FIXME
+  (if (or (not (get-buffer gnus-group-buffer))
+          (save-excursion
+            (set-buffer gnus-group-buffer)
+            (not (eq major-mode 'gnus-group-mode))))
+      (gnus))
+  (set-buffer gnus-group-buffer)
+  (goto-char (point-min))
+  (gnus-group-read-ephemeral-group newsgroup
+                                   (list 'nntp host
+                                         'nntp-open-connection-function
+                                         nntp-open-connection-function)
+                                   nil
+                                   (cons (current-buffer) 'browse)))
+  
+;;;###autoload
+(defun url-news (url)
+  ;; Find a news reference
+  (let* ((host (or (url-host url) url-news-server))
+         (port (url-port url))
+         (article-brackets nil)
+         (buf nil)
+         (article (url-filename url)))
+    (url-news-open-host host port (url-user url) (url-password url))
+    (setq article (url-unhex-string article))
+    (cond
+     ((string-match "@" article)        ; Its a specific article
+      (setq buf (url-news-fetch-message-id host article)))
+     ((string= article "")              ; List all newsgroups
+      (gnus))
+     (t                                 ; Whole newsgroup
+      (url-news-fetch-newsgroup article host)))
+    buf))
+
+;;;###autoload
+(defun url-snews (url)
+  (let ((nntp-open-connection-function (if (eq 'tls url-gateway-method)
+                                           nntp-open-tls-stream
+                                         nntp-open-ssl-stream)))
+    (url-news url)))
+
+(provide 'url-news)
+
+;;; arch-tag: 8975be13-04e8-4d38-bfff-47918e3ad311
diff --git a/lisp/url/url-nfs.el b/lisp/url/url-nfs.el
index d068341b1c2..3b834bba75f 100644
--- a/lisp/url/url-nfs.el
+++ b/lisp/url/url-nfs.el
@@ -1,7 +1,6 @@
 ;;; url-nfs.el --- NFS URL interface
 
-;; Copyright (c) 1996,97,98,1999,2004  Free Software Foundation, Inc.
-;; Copyright (c) 1996 by William M. Perry <wmperry@cs.indiana.edu>
+;; Copyright (c) 1996,1997,1998,1999,2004  Free Software Foundation, Inc.
 
 ;; Keywords: comm, data, processes
 
diff --git a/lisp/url/url-parse.el b/lisp/url/url-parse.el
new file mode 100644
index 00000000000..97348ab5db2
--- /dev/null
+++ b/lisp/url/url-parse.el
@@ -0,0 +1,210 @@
+;;; url-parse.el --- Uniform Resource Locator parser
+
+;; Copyright (c) 1996,1997,1998,1999,2004  Free Software Foundation, Inc.
+
+;; Keywords: comm, data, processes
+
+;; This file is part of GNU Emacs.
+;;
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+;;
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;;; Code:
+
+(require 'url-vars)
+
+(autoload 'url-scheme-get-property "url-methods")
+
+(defmacro url-type (urlobj)
+  `(aref ,urlobj 0))
+
+(defmacro url-user (urlobj)
+  `(aref ,urlobj 1))
+
+(defmacro url-password (urlobj)
+  `(aref ,urlobj 2))
+
+(defmacro url-host (urlobj)
+  `(aref ,urlobj 3))
+
+(defmacro url-port (urlobj)
+  `(or (aref ,urlobj 4)
+      (if (url-fullness ,urlobj)
+          (url-scheme-get-property (url-type ,urlobj) 'default-port))))
+
+(defmacro url-filename (urlobj)
+  `(aref ,urlobj 5))
+
+(defmacro url-target (urlobj)
+  `(aref ,urlobj 6))
+
+(defmacro url-attributes (urlobj)
+  `(aref ,urlobj 7))
+
+(defmacro url-fullness (urlobj)
+  `(aref ,urlobj 8))
+
+(defmacro url-set-type (urlobj type)
+  `(aset ,urlobj 0 ,type))
+
+(defmacro url-set-user (urlobj user)
+  `(aset ,urlobj 1 ,user))
+
+(defmacro url-set-password (urlobj pass)
+  `(aset ,urlobj 2 ,pass))
+
+(defmacro url-set-host (urlobj host)
+  `(aset ,urlobj 3 ,host))
+
+(defmacro url-set-port (urlobj port)
+  `(aset ,urlobj 4 ,port))
+
+(defmacro url-set-filename (urlobj file)
+  `(aset ,urlobj 5 ,file))
+
+(defmacro url-set-target (urlobj targ)
+  `(aset ,urlobj 6 ,targ))
+
+(defmacro url-set-attributes (urlobj targ)
+  `(aset ,urlobj 7 ,targ))
+
+(defmacro url-set-full (urlobj val)
+  `(aset ,urlobj 8 ,val))
+  
+;;;###autoload
+(defun url-recreate-url (urlobj)
+  "Recreate a URL string from the parsed URLOBJ."
+  (concat (url-type urlobj) ":" (if (url-host urlobj) "//" "")
+          (if (url-user urlobj)
+              (concat (url-user urlobj)
+                      (if (url-password urlobj)
+                          (concat ":" (url-password urlobj)))
+                      "@"))
+          (url-host urlobj)
+          (if (and (url-port urlobj)
+                   (not (equal (url-port urlobj)
+                               (url-scheme-get-property (url-type urlobj) 'default-port))))
+              (format ":%d" (url-port urlobj)))
+          (or (url-filename urlobj) "/")
+          (if (url-target urlobj)
+              (concat "#" (url-target urlobj)))
+          (if (url-attributes urlobj)
+              (concat ";"
+                      (mapconcat
+                       (function
+                        (lambda (x)
+                          (if (cdr x)
+                              (concat (car x) "=" (cdr x))
+                            (car x)))) (url-attributes urlobj) ";")))))
+
+;;;###autoload
+(defun url-generic-parse-url (url)
+  "Return a vector of the parts of URL.
+Format is:
+\[TYPE USER PASSWORD HOST PORT FILE TARGET ATTRIBUTES FULL\]"
+  (cond
+   ((null url)
+    (make-vector 9 nil))
+   ((or (not (string-match url-nonrelative-link url))
+        (= ?/ (string-to-char url)))
+    (let ((retval (make-vector 9 nil)))
+      (url-set-filename retval url)
+      (url-set-full retval nil)
+      retval))
+   (t
+    (save-excursion
+      (set-buffer (get-buffer-create " *urlparse*"))
+      (set-syntax-table url-parse-syntax-table)
+      (let ((save-pos nil)
+            (prot nil)
+            (user nil)
+            (pass nil)
+            (host nil)
+            (port nil)
+            (file nil)
+            (refs nil)
+            (attr nil)
+            (full nil)
+            (inhibit-read-only t))
+        (erase-buffer)
+        (insert url)
+        (goto-char (point-min))
+        (setq save-pos (point))
+        (if (not (looking-at "//"))
+            (progn
+              (skip-chars-forward "a-zA-Z+.\\-")
+              (downcase-region save-pos (point))
+              (setq prot (buffer-substring save-pos (point)))
+              (skip-chars-forward ":")
+              (setq save-pos (point))))
+
+        ;; We are doing a fully specified URL, with hostname and all
+        (if (looking-at "//")
+            (progn
+              (setq full t)
+              (forward-char 2)
+              (setq save-pos (point))
+              (skip-chars-forward "^/")
+              (setq host (buffer-substring save-pos (point)))
+              (if (string-match "^\\([^@]+\\)@" host)
+                  (setq user (match-string 1 host)
+                        host (substring host (match-end 0) nil)))
+              (if (and user (string-match "\\([^:]+\\):\\(.*\\)" user))
+                  (setq pass (match-string 2 user)
+                        user (match-string 1 user)))
+              (if (string-match ":\\([0-9+]+\\)" host)
+                  (setq port (string-to-int (match-string 1 host))
+                        host (substring host 0 (match-beginning 0))))
+              (if (string-match ":$" host)
+                  (setq host (substring host 0 (match-beginning 0))))
+              (setq host (downcase host)
+                    save-pos (point))))
+
+        (if (not port)
+            (setq port (url-scheme-get-property prot 'default-port)))
+
+        ;; Gross hack to preserve ';' in data URLs
+
+        (setq save-pos (point))
+
+        (if (string= "data" prot)
+            (goto-char (point-max))
+          ;; Now check for references
+          (skip-chars-forward "^#")
+          (if (eobp)
+              nil
+            (delete-region
+             (point)
+             (progn
+               (skip-chars-forward "#")
+               (setq refs (buffer-substring (point) (point-max)))
+               (point-max))))
+          (goto-char save-pos)
+          (skip-chars-forward "^;")
+          (if (not (eobp))
+              (setq attr (url-parse-args (buffer-substring (point) (point-max)) t)
+                    attr (nreverse attr))))
+
+        (setq file (buffer-substring save-pos (point)))
+        (if (and host (string-match "%[0-9][0-9]" host))
+            (setq host (url-unhex-string host)))
+        (vector prot user pass host port file refs attr full))))))
+
+(provide 'url-parse)
+
+;; arch-tag: f338325f-71ab-4bee-93cc-78fb9a03d403
+;;; url-parse.el ends here
diff --git a/lisp/url/url-privacy.el b/lisp/url/url-privacy.el
new file mode 100644
index 00000000000..cb64cfbd4fc
--- /dev/null
+++ b/lisp/url/url-privacy.el
@@ -0,0 +1,81 @@
+;;; url-privacy.el --- Global history tracking for URL package
+;; Keywords: comm, data, processes, hypermedia
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Copyright (c) 1996 - 1999 Free Software Foundation, Inc.
+;;;
+;;; This file is part of GNU Emacs.
+;;;
+;;; GNU Emacs is free software; you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 2, or (at your option)
+;;; any later version.
+;;;
+;;; GNU Emacs is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Emacs; see the file COPYING.  If not, write to the
+;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;;; Boston, MA 02111-1307, USA.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(eval-when-compile (require 'cl))
+(require 'url-vars)
+
+(if (fboundp 'device-type)
+    (defalias 'url-device-type 'device-type)
+  (defun url-device-type (&optional device) (or window-system 'tty)))
+
+;;;###autoload
+(defun url-setup-privacy-info ()
+  (interactive)
+  (setq url-system-type
+        (cond
+         ((or (eq url-privacy-level 'paranoid)
+              (and (listp url-privacy-level)
+                   (memq 'os url-privacy-level)))
+          nil)
+         ;; First, we handle the inseparable OS/Windowing system
+         ;; combinations
+         ((eq system-type 'Apple-Macintosh) "Macintosh")
+         ((eq system-type 'next-mach) "NeXT")
+         ((eq system-type 'windows-nt) "Windows-NT; 32bit")
+         ((eq system-type 'ms-windows) "Windows; 16bit")
+         ((eq system-type 'ms-dos) "MS-DOS; 32bit")
+         ((memq (url-device-type) '(win32 w32)) "Windows; 32bit")
+         ((eq (url-device-type) 'pm) "OS/2; 32bit")
+         (t
+          (case (url-device-type)
+            (x "X11")
+            (ns "OpenStep")
+            (tty "TTY")
+            (otherwise nil)))))
+
+  (setq url-personal-mail-address (or url-personal-mail-address
+                                      user-mail-address
+                                      (format "%s@%s"  (user-real-login-name)
+                                              (system-name))))
+
+  (if (or (memq url-privacy-level '(paranoid high))
+          (and (listp url-privacy-level)
+               (memq 'email url-privacy-level)))
+      (setq url-personal-mail-address nil))
+
+  (setq url-os-type
+        (cond
+         ((or (eq url-privacy-level 'paranoid)
+              (and (listp url-privacy-level)
+                   (memq 'os url-privacy-level)))
+          nil)
+         ((boundp 'system-configuration)
+          system-configuration)
+         ((boundp 'system-type)
+          (symbol-name system-type))
+         (t nil))))
+
+(provide 'url-privacy)
+
+;;; arch-tag: fdaf95e4-98f0-4680-94c3-f3eadafabe1d
diff --git a/lisp/url/url-util.el b/lisp/url/url-util.el
index d4a3733eab5..5d1f73e0d5d 100644
--- a/lisp/url/url-util.el
+++ b/lisp/url/url-util.el
@@ -1,7 +1,6 @@
 ;;; url-util.el --- Miscellaneous helper routines for URL library
 
-;; Copyright (c) 1996,97,98,99,2001,2004  Free Software Foundation, Inc.
-;; Copyright (c) 1993 - 1996 by William M. Perry <wmperry@cs.indiana.edu>
+;; Copyright (c) 1996,1997,1998,1999,2001,2004  Free Software Foundation, Inc.
 
 ;; Author: Bill Perry <wmperry@gnu.org>
 ;; Keywords: comm, data, processes
diff --git a/lisp/url/url-vars.el b/lisp/url/url-vars.el
new file mode 100644
index 00000000000..a33d8ba43e3
--- /dev/null
+++ b/lisp/url/url-vars.el
@@ -0,0 +1,431 @@
+;;; url-vars.el --- Variables for Uniform Resource Locator tool
+;; Keywords: comm, data, processes, hypermedia
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Copyright (c) 1996,1997,1998,1999,2001,2004 Free Software Foundation, Inc.
+;;;
+;;; This file is part of GNU Emacs.
+;;;
+;;; GNU Emacs is free software; you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 2, or (at your option)
+;;; any later version.
+;;;
+;;; GNU Emacs is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Emacs; see the file COPYING.  If not, write to the
+;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;;; Boston, MA 02111-1307, USA.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(require 'mm-util)
+
+(defconst url-version "Emacs"
+  "Version number of URL package.")
+
+(defgroup url nil
+  "Uniform Resource Locator tool"
+  :version "21.4"
+  :group 'hypermedia)
+
+(defgroup url-file nil
+  "URL storage"
+  :prefix "url-"
+  :group 'url)
+
+(defgroup url-cache nil
+  "URL cache"
+  :prefix "url-"
+  :prefix "url-cache-"
+  :group 'url)
+
+(defgroup url-mime nil
+  "MIME options of URL"
+  :prefix "url-"
+  :group 'url)
+
+(defgroup url-hairy nil
+  "Hairy options of URL"
+  :prefix "url-"
+  :group 'url)
+
+
+(defvar url-current-object nil
+  "A parsed representation of the current url.")
+
+(defvar url-current-mime-headers nil
+  "A parsed representation of the MIME headers for the current url.")
+
+(mapcar 'make-variable-buffer-local
+        '(
+          url-current-object
+          url-current-referer
+          url-current-mime-headers
+          ))
+
+(defcustom url-honor-refresh-requests t
+  "*Whether to do automatic page reloads.
+These are done at the request of the document author or the server via
+the `Refresh' header in an HTTP response.  If nil, no refresh
+requests will be honored.  If t, all refresh requests will be honored.
+If non-nil and not t, the user will be asked for each refresh
+request."
+  :type '(choice (const :tag "off" nil)
+                 (const :tag "on" t)
+                 (const :tag "ask" 'ask))
+  :group 'url-hairy)
+
+(defcustom url-automatic-caching nil
+  "*If non-nil, all documents will be automatically cached to the local disk."
+  :type 'boolean
+  :group 'url-cache)
+
+;; Fixme: sanitize this.
+(defcustom url-cache-expired
+  (lambda (t1 t2) (>= (- (car t2) (car t1)) 5))
+  "*A function determining if a cached item has expired.
+It takes two times (numbers) as its arguments, and returns non-nil if
+the second time is 'too old' when compared to the first time."
+  :type 'function
+  :group 'url-cache)
+
+(defconst url-bug-address "bug-gnu-emacs@gnu.org"
+  "Where to send bug reports.")
+
+(defcustom url-personal-mail-address nil
+  "*Your full email address.
+This is what is sent to HTTP servers as the FROM field in an HTTP
+request."
+  :type '(choice (const :tag "Unspecified" nil) string)
+  :group 'url)
+
+(defcustom url-directory-index-file "index.html"
+  "*The filename to look for when indexing a directory.
+If this file exists, and is readable, then it will be viewed instead of
+using `dired' to view the directory."
+  :type 'string
+  :group 'url-file)
+
+;; Fixme: this should have a setter which calls url-setup-privacy-info.
+(defcustom url-privacy-level '(email)
+  "*How private you want your requests to be.
+HTTP has header fields for various information about the user, including
+operating system information, email addresses, the last page you visited, etc.
+This variable controls how much of this information is sent.
+
+This should a symbol or a list.
+Valid values if a symbol are:
+none     -- Send all information
+low      -- Don't send the last location
+high     -- Don't send the email address or last location
+paranoid -- Don't send anything
+
+If a list, this should be a list of symbols of what NOT to send.
+Valid symbols are:
+email    -- the email address
+os       -- the operating system info
+lastloc  -- the last location
+agent    -- Do not send the User-Agent string
+cookie   -- never accept HTTP cookies
+
+Samples:
+
+ (setq url-privacy-level 'high)
+ (setq url-privacy-level '(email lastloc))    ;; equivalent to 'high
+ (setq url-privacy-level '(os))
+
+::NOTE::
+This variable controls several other variables and is _NOT_ automatically
+updated.  Call the function `url-setup-privacy-info' after modifying this
+variable."
+  :type '(radio (const :tag "None (you believe in the basic goodness of humanity)"
+                       :value none)
+                (const :tag "Low (do not reveal last location)"
+                       :value low)
+                (const :tag "High (no email address or last location)"
+                       :value high)
+                (const :tag "Paranoid (reveal nothing!)"
+                       :value paranoid)
+                (checklist :tag "Custom"
+                           (const :tag "Email address" :value email)
+                           (const :tag "Operating system" :value os)
+                           (const :tag "Last location" :value lastloc)
+                           (const :tag "Browser identification" :value agent)
+                           (const :tag "No cookies" :value cookie)))
+  :group 'url)
+
+(defvar url-inhibit-uncompression nil "Do not do decompression if non-nil.")
+
+(defcustom url-uncompressor-alist '((".z"  . "x-gzip")
+                                    (".gz" . "x-gzip")
+                                    (".uue" . "x-uuencoded")
+                                    (".hqx" . "x-hqx")
+                                    (".Z"  . "x-compress")
+                                    (".bz2"  . "x-bzip2"))
+  "*An alist of file extensions and appropriate content-transfer-encodings."
+  :type '(repeat (cons :format "%v"
+                       (string :tag "Extension")
+                       (string :tag "Encoding")))
+  :group 'url-mime)
+
+(defcustom url-mail-command (if (fboundp 'compose-mail)
+                                'compose-mail
+                              'url-mail)
+  "*This function will be called whenever url needs to send mail.
+It should enter a mail-mode-like buffer in the current window.
+The commands `mail-to' and `mail-subject' should still work in this
+buffer, and it should use `mail-header-separator' if possible."
+  :type 'function
+  :group 'url)
+
+(defcustom url-proxy-services nil
+  "*An alist of schemes and proxy servers that gateway them.
+Looks like ((\"http\" . \"hostname:portnumber\") ...).  This is set up
+from the ACCESS_proxy environment variables."
+  :type '(repeat (cons :format "%v"
+                       (string :tag "Protocol")
+                       (string :tag "Proxy")))
+  :group 'url)
+
+(defcustom url-passwd-entry-func nil
+  "*Symbol indicating which function to call to read in a password.
+It will be set up depending on whether you are running EFS or ange-ftp
+at startup if it is nil.  This function should accept the prompt
+string as its first argument, and the default value as its second
+argument."
+  :type '(choice (const :tag "Guess" :value nil)
+                 (const :tag "Use Ange-FTP" :value ange-ftp-read-passwd)
+                 (const :tag "Use EFS"      :value efs-read-passwd)
+                 (const :tag "Use Password Package" :value read-passwd)
+                 (function :tag "Other"))
+  :group 'url-hairy)
+
+(defcustom url-standalone-mode nil
+  "*Rely solely on the cache?"
+  :type 'boolean
+  :group 'url-cache)
+
+(defvar url-mime-separator-chars (mapcar 'identity
+                                        (concat "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
+                                                "abcdefghijklmnopqrstuvwxyz"
+                                                "0123456789'()+_,-./=?"))
+  "Characters allowable in a MIME multipart separator.")
+
+(defcustom url-bad-port-list
+  '("25" "119" "19")
+  "*List of ports to warn the user about connecting to.
+Defaults to just the mail, chargen, and NNTP ports so you cannot be
+tricked into sending fake mail or forging messages by a malicious HTML
+document."
+  :type '(repeat (string :tag "Port"))
+  :group 'url-hairy)
+
+(defvar url-mime-content-type-charset-regexp
+  ";[ \t]*charset=\"?\\([^\"]+\\)\"?"
+  "Regexp used in parsing `Content-Type' for a charset indication.")
+
+(defvar url-request-data nil "Any data to send with the next request.")
+
+(defvar url-request-extra-headers nil
+  "A list of extra headers to send with the next request.
+Should be an assoc list of headers/contents.")
+
+(defvar url-request-method nil "The method to use for the next request.")
+
+;; FIXME!!  (RFC 2616 gives examples like `compress, gzip'.)
+(defvar url-mime-encoding-string nil
+  "*String to send in the Accept-encoding: field in HTTP requests.")
+
+;; `mm-mime-mule-charset-alist' in Gnus 5.8/9 contains elements whose
+;; cars aren't valid MIME charsets/coding systems, at least in Emacs.
+;; This gets it correct by construction in Emacs.  Fixme: DTRT for
+;; XEmacs -- its `coding-system-list' doesn't have the BASE-ONLY arg.
+(when (and (not (featurep 'xemacs))
+           (fboundp 'coding-system-list))
+  (setq mm-mime-mule-charset-alist
+        (apply
+         'nconc
+         (mapcar
+          (lambda (cs)
+            (when (and (coding-system-get cs 'mime-charset)
+                       (not (eq t (coding-system-get cs 'safe-charsets))))
+              (list (cons (coding-system-get cs 'mime-charset)
+                          (delq 'ascii
+                                (coding-system-get cs 'safe-charsets))))))
+          (coding-system-list 'base-only)))))
+
+;; Perhaps the first few should actually be given decreasing `q's and
+;; the list should be trimmed significantly.
+;; Fixme: do something sane if we don't have `sort-coding-systems'
+;; (Emacs 20, XEmacs).
+(defun url-mime-charset-string ()
+  "Generate a list of preferred MIME charsets for HTTP requests.
+Generated according to current coding system priorities."
+  (if (fboundp 'sort-coding-systems)
+      (let ((ordered (sort-coding-systems
+                      (let (accum)
+                        (dolist (elt mm-mime-mule-charset-alist)
+                          (if (mm-coding-system-p (car elt))
+                              (push (car elt) accum)))
+                        (nreverse accum)))))
+        (concat (format "%s;q=1, " (pop ordered))
+                (mapconcat 'symbol-name ordered ";q=0.5, ")
+                ";q=0.5"))))
+
+(defvar url-mime-charset-string (url-mime-charset-string)
+  "*String to send in the Accept-charset: field in HTTP requests.
+The MIME charset corresponding to the most preferred coding system is
+given priority 1 and the rest are given priority 0.5.")
+
+(defun url-set-mime-charset-string ()
+  (setq url-mime-charset-string (url-mime-charset-string)))
+;; Regenerate if the language environment changes.
+(add-hook 'set-language-environment-hook 'url-set-mime-charset-string)
+
+;; Fixme: set from the locale.
+(defcustom url-mime-language-string nil
+  "*String to send in the Accept-language: field in HTTP requests.
+
+Specifies the preferred language when servers can serve documents in
+several languages.  Use RFC 1766 abbreviations, e.g.@: `en' for
+English, `de' for German.  A comma-separated specifies descending
+order of preference.  The ordering can be made explicit using `q'
+factors defined by HTTP, e.g. `de,en-gb;q=0.8,en;q=0.7'.  `*' means
+get the first available language (as opposed to the default)."
+  :type '(radio
+          (const :tag "None (get default language version)" :value nil)
+          (const :tag "Any (get first available language version)" :value "*")
+          (string :tag "Other"))
+  :group 'url-mime
+  :group 'i18n)
+
+(defvar url-mime-accept-string nil
+  "String to send to the server in the Accept: field in HTTP requests.")
+
+(defvar url-package-version nil
+  "Version number of package using URL.")
+
+(defvar url-package-name nil "Version number of package using URL.")
+
+(defvar url-system-type nil
+  "What type of system we are on.")
+(defvar url-os-type nil
+  "What OS we are on.")
+
+(defcustom url-max-password-attempts 5
+  "*Maximum number of times a password will be prompted for.
+Applies when a protected document is denied by the server."
+  :type 'integer
+  :group 'url)
+
+(defcustom url-temporary-directory (or (getenv "TMPDIR") "/tmp")
+  "*Where temporary files go."
+  :type 'directory
+  :group 'url-file)
+
+(defcustom url-show-status t
+  "*Whether to show a running total of bytes transferred.
+Can cause a large hit if using a remote X display over a slow link, or
+a terminal with a slow modem."
+  :type 'boolean
+  :group 'url)
+
+(defvar url-using-proxy nil
+  "Either nil or the fully qualified proxy URL in use, e.g.
+http://www.domain.com/")
+
+(defcustom url-news-server nil
+  "*The default news server from which to get newsgroups/articles.
+Applies if no server is specified in the URL.  Defaults to the
+environment variable NNTPSERVER or \"news\" if NNTPSERVER is
+undefined."
+  :type '(choice (const :tag "None" :value nil) string)
+  :group 'url)
+
+(defvar url-nonrelative-link
+  "\\`\\([-a-zA-Z0-9+.]+:\\)"
+  "A regular expression that will match an absolute URL.")
+
+(defcustom url-confirmation-func 'y-or-n-p
+  "*What function to use for asking yes or no functions.
+Possible values are `yes-or-no-p' or `y-or-n-p', or any function that
+takes a single argument (the prompt), and returns t only if a positive
+answer is given."
+  :type '(choice (const :tag "Short (y or n)" :value y-or-n-p)
+                 (const :tag "Long (yes or no)" :value yes-or-no-p)
+                 (function :tag "Other"))
+  :group 'url-hairy)
+
+(defcustom url-gateway-method 'native
+  "*The type of gateway support to use.
+Should be a symbol specifying how to get a connection from the local machine.
+
+Currently supported methods:
+`telnet': Run telnet in a subprocess to connect;
+`rlogin': Rlogin to another machine to connect;
+`socks': Connect through a socks server;
+`tls': Connect with TLS;
+`ssl': Connect with SSL (deprecated, use `tls' instead);
+`native': Connect directy."
+  :type '(radio (const :tag "Telnet to gateway host" :value telnet)
+                (const :tag "Rlogin to gateway host" :value rlogin)
+                (const :tag "Use SOCKS proxy" :value socks)
+                (const :tag "Use SSL/TLS for all connections" :value tls)
+                (const :tag "Use SSL for all connections (obsolete)" :value ssl)
+                (const :tag "Direct connection" :value native))
+  :group 'url-hairy)
+
+(defvar url-setup-done nil "Has setup configuration been done?")
+
+(defconst weekday-alist
+  '(("Sunday" . 0) ("Monday" . 1) ("Tuesday" . 2) ("Wednesday" . 3)
+    ("Thursday" . 4) ("Friday" . 5) ("Saturday" . 6)
+    ("Tues" . 2) ("Thurs" . 4)
+    ("Sun" . 0) ("Mon" . 1) ("Tue" . 2) ("Wed" . 3)
+    ("Thu" . 4) ("Fri" . 5) ("Sat" . 6)))
+
+(defconst monthabbrev-alist
+  '(("Jan" . 1) ("Feb" . 2) ("Mar" . 3) ("Apr" . 4) ("May" . 5) ("Jun" . 6)
+    ("Jul" . 7) ("Aug" . 8) ("Sep" . 9) ("Oct" . 10) ("Nov" . 11)
+    ("Dec" . 12)))
+
+(defvar url-lazy-message-time 0)
+
+;; Fixme: We may not be able to run SSL.
+(defvar url-extensions-header "Security/Digest Security/SSL")
+
+(defvar url-parse-syntax-table
+  (copy-syntax-table emacs-lisp-mode-syntax-table)
+  "*A syntax table for parsing URLs.")
+
+(modify-syntax-entry ?' "\"" url-parse-syntax-table)
+(modify-syntax-entry ?` "\"" url-parse-syntax-table)
+(modify-syntax-entry ?< "(>" url-parse-syntax-table)
+(modify-syntax-entry ?> ")<" url-parse-syntax-table)
+(modify-syntax-entry ?/ " " url-parse-syntax-table)
+
+(defvar url-load-hook nil
+  "*Hooks to be run after initalizing the URL library.")
+
+;;; Make OS/2 happy - yeeks
+;; (defvar      tcp-binary-process-input-services nil
+;;   "*Make OS/2 happy with our CRLF pairs...")
+
+(defconst url-working-buffer " *url-work")
+
+(defvar url-gateway-unplugged nil
+  "Non-nil means don't open new network connexions.
+This should be set, e.g. by mail user agents rendering HTML to avoid
+`bugs' which call home.")
+
+(defun url-vars-unload-hook ()
+  (remove-hook 'set-language-environment-hook 'url-set-mime-charset-string))
+
+(provide 'url-vars)
+
+;;; arch-tag: 29205e5f-c5ce-433c-8d5d-38cbaed64b49
+;;; url-vars.el ends here
diff --git a/lisp/url/url.el b/lisp/url/url.el
new file mode 100644
index 00000000000..f7b1b717681
--- /dev/null
+++ b/lisp/url/url.el
@@ -0,0 +1,269 @@
+;;; url.el --- Uniform Resource Locator retrieval tool
+
+;; Copyright (c) 1996,1997,1998,1999,2001,2004  Free Software Foundation, Inc.
+
+;; Author: Bill Perry <wmperry@gnu.org>
+;; Keywords: comm, data, processes, hypermedia
+
+;; This file is part of GNU Emacs.
+;;
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+;;
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; Registered URI schemes: http://www.iana.org/assignments/uri-schemes
+
+;;; Code:
+
+(eval-when-compile (require 'cl))
+;; Don't require CL at runtime if we can avoid it (Emacs 21).
+;; Otherwise we need it for hashing functions.  `puthash' was never
+;; defined in the Emacs 20 cl.el for some reason.
+(if (fboundp 'puthash)
+    nil                                 ; internal or CL is loaded
+  (defalias 'puthash 'cl-puthash)
+  (autoload 'cl-puthash "cl")
+  (autoload 'gethash "cl")
+  (autoload 'maphash "cl")
+  (autoload 'make-hash-table "cl"))
+
+(eval-when-compile
+  (require 'mm-decode)
+  (require 'mm-view))
+
+(require 'mailcap)
+(require 'url-vars)
+(require 'url-cookie)
+(require 'url-history)
+(require 'url-expand)
+(require 'url-privacy)
+(require 'url-methods)
+(require 'url-proxy)
+(require 'url-parse)
+(require 'url-util)
+
+;; Fixme: customize? convert-standard-filename? 
+;;;###autoload
+(defvar url-configuration-directory "~/.url")
+
+(defun url-do-setup ()
+  "Setup the url package.
+This is to avoid conflict with user settings if URL is dumped with
+Emacs."
+  (unless url-setup-done
+
+    ;; Make OS/2 happy
+    ;;(push '("http" "80") tcp-binary-process-input-services)
+
+    (mailcap-parse-mailcaps)
+    (mailcap-parse-mimetypes)
+    
+    ;; Register all the authentication schemes we can handle
+    (url-register-auth-scheme "basic" nil 4)
+    (url-register-auth-scheme "digest" nil 7)
+
+    (setq url-cookie-file
+          (or url-cookie-file
+              (expand-file-name "cookies" url-configuration-directory)))
+    
+    (setq url-history-file
+          (or url-history-file
+              (expand-file-name "history" url-configuration-directory)))
+  
+    ;; Parse the global history file if it exists, so that it can be used
+    ;; for URL completion, etc.
+    (url-history-parse-history)
+    (url-history-setup-save-timer)
+
+    ;; Ditto for cookies
+    (url-cookie-setup-save-timer)
+    (url-cookie-parse-file url-cookie-file)
+
+    ;; Read in proxy gateways
+    (let ((noproxy (and (not (assoc "no_proxy" url-proxy-services))
+                        (or (getenv "NO_PROXY")
+                            (getenv "no_PROXY")
+                            (getenv "no_proxy")))))
+      (if noproxy
+          (setq url-proxy-services
+                (cons (cons "no_proxy"
+                            (concat "\\("
+                                    (mapconcat
+                                     (lambda (x)
+                                       (cond
+                                        ((= x ?,) "\\|")
+                                        ((= x ? ) "")
+                                        ((= x ?.) (regexp-quote "."))
+                                        ((= x ?*) ".*")
+                                        ((= x ??) ".")
+                                        (t (char-to-string x))))
+                                     noproxy "") "\\)"))
+                      url-proxy-services))))
+
+    ;; Set the password entry funtion based on user defaults or guess
+    ;; based on which remote-file-access package they are using.
+    (cond
+     (url-passwd-entry-func nil)        ; Already been set
+     ((fboundp 'read-passwd)            ; Use secure password if available
+      (setq url-passwd-entry-func 'read-passwd))
+     ((or (featurep 'efs)               ; Using EFS
+          (featurep 'efs-auto))         ; or autoloading efs
+      (if (not (fboundp 'read-passwd))
+          (autoload 'read-passwd "passwd" "Read in a password" nil))
+      (setq url-passwd-entry-func 'read-passwd))
+     ((or (featurep 'ange-ftp)          ; Using ange-ftp
+          (and (boundp 'file-name-handler-alist)
+               (not (featurep 'xemacs)))) ; ??
+      (setq url-passwd-entry-func 'ange-ftp-read-passwd))
+     (t
+      (url-warn
+       'security
+       "(url-setup): Can't determine how to read passwords, winging it.")))
+  
+    (url-setup-privacy-info)
+    (run-hooks 'url-load-hook)
+    (setq url-setup-done t)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Retrieval functions
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(defun url-retrieve (url callback &optional cbargs)
+  "Retrieve URL asynchronously and call CALLBACK with CBARGS when finished.
+The callback is called when the object has been completely retrieved, with
+the current buffer containing the object, and any MIME headers associated
+with it.  URL is either a string or a parsed URL.
+
+Return the buffer URL will load into, or nil if the process has
+already completed."
+  (url-do-setup)
+  (url-gc-dead-buffers)
+  (if (stringp url)
+       (set-text-properties 0 (length url) nil url))
+  (if (not (vectorp url))
+      (setq url (url-generic-parse-url url)))
+  (if (not (functionp callback))
+      (error "Must provide a callback function to url-retrieve"))
+  (unless (url-type url)
+    (error "Bad url: %s" (url-recreate-url url)))
+  (let ((loader (url-scheme-get-property (url-type url) 'loader))
+        (url-using-proxy (if (url-host url)
+                             (url-find-proxy-for-url url (url-host url))))
+        (buffer nil)
+        (asynch (url-scheme-get-property (url-type url) 'asynchronous-p)))
+    (if url-using-proxy
+        (setq asynch t
+              loader 'url-proxy))
+    (if asynch
+        (setq buffer (funcall loader url callback cbargs))
+      (setq buffer (funcall loader url))
+      (if buffer
+          (with-current-buffer buffer
+            (apply callback cbargs))))
+    (url-history-update-url url (current-time))
+    buffer))
+
+(defun url-retrieve-synchronously (url)
+  "Retrieve URL synchronously.
+Return the buffer containing the data, or nil if there are no data
+associated with it (the case for dired, info, or mailto URLs that need
+no further processing).  URL is either a string or a parsed URL."
+  (url-do-setup)
+
+  (lexical-let ((retrieval-done nil)
+                (asynch-buffer nil))
+    (setq asynch-buffer
+          (url-retrieve url (lambda (&rest ignored)
+                              (url-debug 'retrieval "Synchronous fetching done (%S)" (current-buffer))
+                              (setq retrieval-done t
+                                    asynch-buffer (current-buffer)))))
+    (if (not 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
+      (while (not retrieval-done)
+        (url-debug 'retrieval "Spinning in url-retrieve-synchronously: %S (%S)"
+                   retrieval-done asynch-buffer)
+        ;; Quoth Stef:
+        ;; It turns out that the problem seems to be that the (sit-for
+        ;; 0.1) below doesn't actually process the data: instead it
+        ;; returns immediately because there is keyboard input
+        ;; waiting, so we end up spinning endlessly waiting for the
+        ;; process to finish while not letting it finish.
+
+        ;; However, raman claims that it blocks Emacs with Emacspeak
+        ;; for unexplained reasons.  Put back for his benefit until
+        ;; someone can understand it.
+        ;; (sleep-for 0.1)
+        (sit-for 0.1))
+      asynch-buffer)))
+
+(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)))
+      (if (eq (mm-display-part handle) 'external)
+          (progn
+            (set-process-sentinel
+             ;; Fixme: this shouldn't have to know the form of the
+             ;; undisplayer produced by `mm-display-part'.
+             (get-buffer-process (cdr (mm-handle-undisplayer handle)))
+             `(lambda (proc event)
+                (mm-destroy-parts (quote ,handle))))
+            (message "Viewing externally")
+            (kill-buffer (current-buffer)))
+        (display-buffer (current-buffer))
+        (mm-destroy-parts handle)))))
+
+(defun url-mm-url (url)
+  "Retrieve URL and pass to the appropriate viewing application."
+  (require 'mm-decode)
+  (require 'mm-view)
+  (url-retrieve url 'url-mm-callback nil))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Miscellaneous
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(defvar url-dead-buffer-list nil)
+
+(defun url-mark-buffer-as-dead (buff)
+  (push buff url-dead-buffer-list))
+
+(defun url-gc-dead-buffers ()
+  (let ((buff))
+    (while (setq buff (pop url-dead-buffer-list))
+      (if (buffer-live-p buff)
+          (kill-buffer buff)))))
+
+(cond
+ ((fboundp 'display-warning)
+  (defalias 'url-warn 'display-warning))
+ ((fboundp 'warn)
+  (defun url-warn (class message &optional level)
+    (warn "(%s/%s) %s" class (or level 'warning) message)))
+ (t
+  (defun url-warn (class message &optional level)
+    (with-current-buffer (get-buffer-create "*URL-WARNINGS*")
+      (goto-char (point-max))
+      (save-excursion
+        (insert (format "(%s/%s) %s\n" class (or level 'warning) message)))
+      (display-buffer (current-buffer))))))
+
+(provide 'url)
+
+;; arch-tag: bc182f1f-d187-4f10-b961-47af2066579a
+;;; url.el ends here