--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/lisp/url/url.el	Mon Aug 13 08:45:50 2007 +0200
@@ -0,0 +1,2394 @@
+;;; url.el,v --- Uniform Resource Locator retrieval tool
+;; Author: wmperry
+;; Created: 1996/05/30 13:25:47
+;; Version: 1.52
+;; Keywords: comm, data, processes, hypermedia
+
+;;; LCD Archive Entry:
+;;; url|William M. Perry|wmperry@spry.com|
+;;; Major mode for manipulating URLs|
+;;; 1996/05/30 13:25:47|1.52|Location Undetermined
+;;;
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Copyright (c) 1993, 1994, 1995 by William M. Perry (wmperry@spry.com)
+;;;
+;;; This file is not part of GNU Emacs, but the same permissions apply.
+;;;
+;;; 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, 675 Mass Ave, Cambridge, MA 02139, USA.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Copyright (c) 1993, 1994, 1995 by William M. Perry (wmperry@spry.com)   ;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+
+(require 'url-vars)
+(require 'url-parse)
+(require 'urlauth)
+(require 'url-cookie)
+(require 'mm)
+(require 'md5)
+(require 'base64)
+(require 'url-hash)
+(or (featurep 'efs)
+    (featurep 'efs-auto)
+    (condition-case ()
+	(require 'ange-ftp)
+      (error nil)))
+
+(load-library "url-sysdp")
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Functions that might not exist in old versions of emacs
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(defun url-save-error (errobj)
+  (save-excursion
+    (set-buffer (get-buffer-create " *url-error*"))
+    (erase-buffer))
+  (display-error errobj (get-buffer-create " *url-error*")))
+
+(cond
+ ((fboundp 'display-warning)
+  (fset 'url-warn 'display-warning))
+ ((fboundp 'w3-warn)
+  (fset 'url-warn 'w3-warn))
+ ((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)
+    (save-excursion
+      (set-buffer (get-buffer-create "*W3-WARNINGS*"))
+      (goto-char (point-max))
+      (save-excursion
+	(insert (format "(%s/%s) %s\n" class (or level 'warning) message)))
+      (display-buffer (current-buffer))))))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Autoload all the URL loaders
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(autoload 'url-file "url-file")
+(autoload 'url-ftp "url-file")
+(autoload 'url-gopher "url-gopher")
+(autoload 'url-irc "url-irc")
+(autoload 'url-http "url-http")
+(autoload 'url-mailserver "url-mail")
+(autoload 'url-mailto "url-mail")
+(autoload 'url-info "url-misc")
+(autoload 'url-shttp "url-http")
+(autoload 'url-https "url-http")
+(autoload 'url-finger "url-misc")
+(autoload 'url-rlogin "url-misc")
+(autoload 'url-telnet "url-misc")
+(autoload 'url-tn3270 "url-misc")
+(autoload 'url-proxy "url-misc")
+(autoload 'url-x-exec "url-misc")
+(autoload 'url-news "url-news")
+(autoload 'url-nntp "url-news")
+(autoload 'url-decode-pgp/pem "url-pgp")
+(autoload 'url-wais "url-wais")
+
+(autoload 'url-save-newsrc "url-news")
+(autoload 'url-news-generate-reply-form "url-news")
+(autoload 'url-parse-newsrc "url-news")
+(autoload 'url-mime-response-p "url-http")
+(autoload 'url-parse-mime-headers "url-http")
+(autoload 'url-handle-refresh-header "url-http")
+(autoload 'url-create-mime-request "url-http")
+(autoload 'url-create-message-id "url-http")
+(autoload 'url-create-multipart-request "url-http")
+(autoload 'url-parse-viewer-types "url-http")
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; File-name-handler-alist functions
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(defun url-setup-file-name-handlers ()
+  ;; Setup file-name handlers.
+  '(cond
+    ((not (boundp 'file-name-handler-alist))
+     nil)				; Don't load if no alist
+    ((rassq 'url-file-handler file-name-handler-alist)
+     nil)				; Don't load twice
+    ((and (string-match "XEmacs\\|Lucid" emacs-version)
+	  (< url-emacs-minor-version 11)) ; Don't load in lemacs 19.10
+     nil)
+    (t
+     (setq file-name-handler-alist
+	   (let ((new-handler (cons
+			       (concat "^/*"
+				       (substring url-nonrelative-link1 nil))
+			       'url-file-handler)))
+	     (if file-name-handler-alist
+		 (append (list new-handler) file-name-handler-alist)
+	       (list new-handler)))))))
+  
+(defun url-file-handler (operation &rest args)
+  ;; Function called from the file-name-handler-alist routines.  OPERATION
+  ;; is what needs to be done ('file-exists-p, etc).  args are the arguments
+  ;; that would have been passed to OPERATION."
+  (let ((fn (get operation 'url-file-handlers))
+	(url (car args))
+	(myargs (cdr args)))
+    (if (= (string-to-char url) ?/)
+	(setq url (substring url 1 nil)))
+    (if fn (apply fn url myargs)
+      (let (file-name-handler-alist)
+	(apply operation url myargs)))))
+
+(defun url-file-handler-identity (&rest args)
+  (car args))
+
+(defun url-file-handler-null (&rest args)
+  nil)
+
+(put 'file-directory-p 'url-file-handlers 'url-file-handler-null)
+(put 'substitute-in-file-name 'url-file-handlers 'url-file-handler-identity)
+(put 'file-writable-p 'url-file-handlers 'url-file-handler-null)
+(put 'file-truename 'url-file-handlers 'url-file-handler-identity)
+(put 'insert-file-contents 'url-file-handlers 'url-insert-file-contents)
+(put 'expand-file-name 'url-file-handlers 'url-expand-file-name)
+(put 'directory-files 'url-file-handlers 'url-directory-files)
+(put 'file-directory-p 'url-file-handlers 'url-file-directory-p)
+(put 'file-writable-p 'url-file-handlers 'url-file-writable-p)
+(put 'file-readable-p 'url-file-handlers 'url-file-exists)
+(put 'file-executable-p 'url-file-handlers 'null)
+(put 'file-symlink-p 'url-file-handlers 'null)
+(put 'file-exists-p 'url-file-handlers 'url-file-exists)
+(put 'copy-file 'url-file-handlers 'url-copy-file)
+(put 'file-attributes 'url-file-handlers 'url-file-attributes)
+(put 'file-name-all-completions 'url-file-handlers
+     'url-file-name-all-completions)
+(put 'file-name-completion 'url-file-handlers 'url-file-name-completion)
+(put 'file-local-copy 'url-file-handlers 'url-file-local-copy)
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Utility functions
+;;; -----------------
+;;; Various functions used around the url code.
+;;; Some of these qualify as hacks, but hey, this is elisp.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(if (fboundp 'mm-string-to-tokens)
+    (fset 'url-string-to-tokens 'mm-string-to-tokens)
+  (defun url-string-to-tokens (str &optional delim)
+    "Return a list of words from the string STR"
+    (setq delim (or delim ? ))
+    (let (results y)
+      (mapcar
+       (function
+	(lambda (x)
+	  (cond
+	   ((and (= x delim) y) (setq results (cons y results) y nil))
+	   ((/= x delim) (setq y (concat y (char-to-string x))))
+	   (t nil)))) str)
+      (nreverse (cons y results)))))
+
+(defun url-days-between (date1 date2)
+  ;; Return the number of days between date1 and date2.
+  (- (url-day-number date1) (url-day-number date2)))
+
+(defun url-day-number (date)
+  (let ((dat (mapcar (function (lambda (s) (and s (string-to-int s)) ))
+		     (timezone-parse-date date))))
+    (timezone-absolute-from-gregorian 
+     (nth 1 dat) (nth 2 dat) (car dat))))
+
+(defun url-seconds-since-epoch (date)
+  ;; Returns a number that says how many seconds have
+  ;; lapsed between Jan 1 12:00:00 1970 and DATE."
+  (let* ((tdate (mapcar (function (lambda (ti) (and ti (string-to-int ti))))
+			(timezone-parse-date date)))
+	 (ttime (mapcar (function (lambda (ti) (and ti (string-to-int ti))))
+			(timezone-parse-time
+			 (aref (timezone-parse-date date) 3))))
+	 (edate (mapcar (function (lambda (ti) (and ti (string-to-int ti))))
+			(timezone-parse-date "Jan 1 12:00:00 1970")))
+	 (tday (- (timezone-absolute-from-gregorian 
+		   (nth 1 tdate) (nth 2 tdate) (nth 0 tdate))
+		  (timezone-absolute-from-gregorian 
+		   (nth 1 edate) (nth 2 edate) (nth 0 edate)))))
+    (+ (nth 2 ttime)
+       (* (nth 1 ttime) 60)
+       (* (nth 0 ttime) 60 60)
+       (* tday 60 60 24))))
+
+(defun url-match (s x)
+  ;; Return regexp match x in s.
+  (substring s (match-beginning x) (match-end x)))
+
+(defun url-split (str del)
+  ;; Split the string STR, with DEL (a regular expression) as the delimiter.
+  ;; Returns an assoc list that you can use with completing-read."
+  (let (x y)
+    (while (string-match del str)
+      (setq y (substring str 0 (match-beginning 0))
+	    str (substring str (match-end 0) nil))
+      (if (not (string-match "^[ \t]+$" y))
+	  (setq x (cons (list y y) x))))
+    (if (not (equal str ""))
+	(setq x (cons (list str str) x)))
+    x))
+
+(defun url-replace-regexp (regexp to-string)
+  (goto-char (point-min))
+  (while (re-search-forward regexp nil t)
+    (replace-match to-string t nil)))
+
+(defun url-clear-tmp-buffer ()
+  (set-buffer (get-buffer-create url-working-buffer))
+  (if buffer-read-only (toggle-read-only))
+  (erase-buffer))  
+
+(defun url-maybe-relative (url)
+  (url-retrieve (url-expand-file-name url)))
+
+(defun url-buffer-is-hypertext (&optional buff)
+  "Return t if a buffer contains HTML, as near as we can guess."
+  (setq buff (or buff (current-buffer)))
+  (save-excursion
+    (set-buffer buff)
+    (let ((case-fold-search t))
+      (goto-char (point-min))
+      (re-search-forward
+       "<\\(TITLE\\|HEAD\\|BASE\\|H[0-9]\\|ISINDEX\\|P\\)>" nil t))))
+
+(defun nntp-after-change-function (&rest args)
+  (save-excursion
+    (set-buffer nntp-server-buffer)
+    (message "Read %d bytes" (point-max))))
+
+(defun url-percentage (x y)
+  (if (fboundp 'float)
+      (round (* 100 (/ x (float y))))
+    (/ (* x 100) y)))
+
+(defun url-after-change-function (&rest args)
+  ;; The nitty gritty details of messaging the HTTP/1.0 status messages
+  ;; in the minibuffer."
+  (save-excursion
+    (set-buffer url-working-buffer)
+    (let (status-message)
+      (if url-current-content-length
+	  nil
+	(goto-char (point-min))
+	(skip-chars-forward " \t\n")
+	(if (not (looking-at "HTTP/[0-9]\.[0-9]"))
+	    (setq url-current-content-length 0)
+	  (setq url-current-isindex
+		(and (re-search-forward "$\r*$" nil t) (point)))
+	  (if (re-search-forward
+	       "^content-type:[ \t]*\\([^\r\n]+\\)\r*$"
+	       url-current-isindex t)
+	      (setq url-current-mime-type (downcase
+					  (url-eat-trailing-space
+					   (buffer-substring
+					    (match-beginning 1)
+					    (match-end 1))))))
+	  (if (re-search-forward "^content-length:\\([^\r\n]+\\)\r*$"
+				 url-current-isindex t)
+	      (setq url-current-content-length
+		    (string-to-int (buffer-substring (match-beginning 1)
+						     (match-end 1))))
+	    (setq url-current-content-length nil))))
+      (goto-char (point-min))
+      (if (re-search-forward "^status:\\([^\r]*\\)" url-current-isindex t)
+	  (progn
+	    (setq status-message (buffer-substring (match-beginning 1)
+						   (match-end 1)))
+	    (replace-match (concat "btatus:" status-message))))
+      (goto-char (point-max))
+      (cond
+       (status-message (url-lazy-message "%s" status-message))
+       ((and url-current-content-length (> url-current-content-length 1)
+	     url-current-mime-type)
+	(url-lazy-message "Read %d of %d bytes (%d%%) [%s]"
+			 (point-max) url-current-content-length
+			 (url-percentage (point-max) url-current-content-length)
+			 url-current-mime-type))
+       ((and url-current-content-length (> url-current-content-length 1))
+	(url-lazy-message "Read %d of %d bytes (%d%%)"
+			 (point-max) url-current-content-length
+			 (url-percentage (point-max)
+					 url-current-content-length)))
+       ((and (/= 1 (point-max)) url-current-mime-type)
+	(url-lazy-message "Read %d bytes. [%s]" (point-max)
+			 url-current-mime-type))
+       ((/= 1 (point-max))
+	(url-lazy-message "Read %d bytes." (point-max)))
+       (t (url-lazy-message "Waiting for response."))))))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Information information
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(defvar url-process-lookup-table nil)
+
+(defun url-setup-process-get ()
+  (let ((x nil)
+	(nativep t))
+    (condition-case ()
+	(progn
+	  (setq x (start-process "Test" nil "/bin/sh"))
+	  (get x 'command))
+      (error (setq nativep nil)))
+    (cond
+     ((fboundp 'process-get)		; Emacs 19.31 w/my hacks
+      (defun url-process-get (proc prop &optional default)
+	(or (process-get proc prop) default)))
+     (nativep				; XEmacs 19.14 w/my hacks
+      (fset 'url-process-get 'get))
+     (t
+      (defun url-process-get (proc prop &optional default)
+	(or (plist-get (cdr-safe (assq proc url-process-lookup-table)) prop)
+	    default))))
+    (cond
+     ((fboundp 'process-put)		; Emacs 19.31 w/my hacks
+      (fset 'url-process-put 'process-put))
+     (nativep
+      (fset 'url-process-put 'put))
+     (t
+      (defun url-process-put (proc prop val)
+	(let ((node (assq proc url-process-lookup-table)))
+	  (if (not node)
+	      (setq url-process-lookup-table (cons (cons proc (list prop val))
+						   url-process-lookup-table))
+	    (setcdr node (plist-put (cdr node) prop val)))))))
+    (and (processp x) (delete-process x))))
+
+(defun url-gc-process-lookup-table ()
+  (let (new)
+    (while url-process-lookup-table
+      (if (not (memq (process-status (caar url-process-lookup-table))
+		     '(stop closed nil)))
+	  (setq new (cons (car url-process-lookup-table) new)))
+      (setq url-process-lookup-table (cdr url-process-lookup-table)))
+    (setq url-process-lookup-table new)))
+
+(defun url-list-processes ()
+  (interactive)
+  (url-gc-process-lookup-table)
+  (let ((processes (process-list))
+	proc len type)
+    (set-buffer (get-buffer-create "URL Status Display"))
+    (display-buffer (current-buffer))
+    (erase-buffer)
+    (insert
+     (eval-when-compile (format "%-40s%-10s%-25s" "URL" "Size" "Type")) "\n"
+     (eval-when-compile (make-string 75 ?-)) "\n")
+    (while processes
+      (setq proc (car processes)
+	    processes (cdr processes))
+      (if (url-process-get proc 'url)
+	  (progn
+	    (save-excursion
+	      (set-buffer (process-buffer proc))
+	      (setq len url-current-content-length
+		    type url-current-mime-type))
+	    (insert
+	     (format "%-40s%-10d%-25s" (url-process-get proc 'url)
+		     len type)))))))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; file-name-handler stuff calls this
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defun url-have-visited-url (url &rest args)
+  "Return non-nil iff the user has visited URL before.
+The return value is a cons of the url and the date last accessed as a string"
+  (url-gethash url url-global-history-hash-table))
+
+(defun url-directory-files (url &rest args)
+  "Return a list of files on a server."
+  nil)
+
+(defun url-file-writable-p (url &rest args)
+  "Return t iff a url is writable by this user"
+  nil)
+
+(defun url-copy-file (url &rest args)
+  "Copy a url to the specified filename."
+  nil)
+
+(defun url-file-directly-accessible-p (url)
+  "Returns t iff the specified URL is directly accessible
+on your filesystem.  (nfs, local file, etc)."
+  (let* ((urlobj (if (vectorp url) url (url-generic-parse-url url)))
+	 (type (url-type urlobj)))
+    (and (member type '("file" "ftp"))
+	 (not (url-host urlobj)))))
+
+;;;###autoload
+(defun url-file-attributes (url &rest args)
+  "Return a list of attributes of URL.
+Value is nil if specified file cannot be opened.
+Otherwise, list elements are:
+ 0. t for directory, string (name linked to) for symbolic link, or nil.
+ 1. Number of links to file.
+ 2. File uid.
+ 3. File gid.
+ 4. Last access time, as a list of two integers.
+  First integer has high-order 16 bits of time, second has low 16 bits.
+ 5. Last modification time, likewise.
+ 6. Last status change time, likewise.
+ 7. Size in bytes. (-1, if number is out of range).
+ 8. File modes, as a string of ten letters or dashes as in ls -l.
+    If URL is on an http server, this will return the content-type if possible.
+ 9. t iff file's gid would change if file were deleted and recreated.
+10. inode number.
+11. Device number.
+
+If file does not exist, returns nil."
+  (and url
+       (let* ((urlobj (url-generic-parse-url url))
+	      (type (url-type urlobj))
+	      (url-automatic-caching nil)
+	      (data nil)
+	      (exists nil))
+	 (cond
+	  ((equal type "http")
+	   (cond
+	    ((not url-be-anal-about-file-attributes)
+	     (setq data (list
+			 (url-file-directory-p url) ; Directory
+			 1		; number of links to it
+			 0		; UID
+			 0		; GID
+			 (cons 0 0)	; Last access time
+			 (cons 0 0)	; Last mod. time
+			 (cons 0 0)	; Last status time
+			 -1		; file size
+			 (mm-extension-to-mime
+			  (url-file-extension (url-filename urlobj)))
+			 nil		; gid would change
+			 0		; inode number
+			 0		; device number
+			 )))
+	    (t				; HTTP/1.0, use HEAD
+	     (let ((url-request-method "HEAD")
+		   (url-request-data nil)
+		   (url-working-buffer " *url-temp*"))
+	       (save-excursion
+		 (condition-case ()
+		     (progn
+		       (url-retrieve url)
+		       (setq data (and
+				   (setq exists
+					 (cdr
+					  (assoc "status"
+						 url-current-mime-headers)))
+				   (>= exists 200)
+				   (< exists 300)
+				   (list
+				    (url-file-directory-p url) ; Directory
+				    1	; links to
+				    0	; UID
+				    0	; GID
+				    (cons 0 0) ; Last access time
+				    (cons 0 0) ; Last mod. time
+				    (cons 0 0) ; Last status time
+				    (or ; Size in bytes
+				     (cdr (assoc "content-length"
+						 url-current-mime-headers))
+				     -1)
+				    (or
+				     (cdr (assoc "content-type"
+						 url-current-mime-headers))
+				     (mm-extension-to-mime
+				      (url-file-extension
+				       (url-filename urlobj)))) ; content-type
+				    nil ; gid would change
+				    0	; inode number
+				    0	; device number
+				    ))))
+		   (error nil))
+		 (and (not data)
+		      (setq data (list (url-file-directory-p url)
+				       1 0 0 (cons 0 0) (cons 0 0) (cons 0 0)
+				       -1 (mm-extension-to-mime
+					   (url-file-extension
+					    url-current-file))
+				       nil 0 0)))
+		 (kill-buffer " *url-temp*"))))))
+	  ((member type '("ftp" "file"))
+	   (let ((fname (if (url-host urlobj)
+			    (concat "/"
+				    (if (url-user urlobj)
+					(concat (url-user urlobj) "@")
+				      "")
+				    (url-host urlobj) ":"
+				    (url-filename urlobj))
+			  (url-filename urlobj))))
+	     (setq data (or (file-attributes fname) (make-list 12 nil)))
+	     (setcar (cdr (cdr (cdr (cdr (cdr (cdr (cdr (cdr data))))))))
+		     (mm-extension-to-mime (url-file-extension fname)))))
+	  (t nil))
+	 data)))
+
+(defun url-file-name-all-completions (file dirname &rest args)
+  "Return a list of all completions of file name FILE in directory DIR.
+These are all file names in directory DIR which begin with FILE."
+  ;; need to rewrite
+  )
+
+(defun url-file-name-completion (file dirname &rest args)
+  "Complete file name FILE in directory DIR.
+Returns the longest string
+common to all filenames in DIR that start with FILE.
+If there is only one and FILE matches it exactly, returns t.
+Returns nil if DIR contains no name starting with FILE."
+  (apply 'url-file-name-all-completions file dirname args))
+
+(defun url-file-local-copy (file &rest args)
+  "Copy the file FILE into a temporary file on this machine.
+Returns the name of the local copy, or nil, if FILE is directly
+accessible."
+  nil)
+
+(defun url-insert-file-contents (url &rest args)
+  "Insert the contents of the URL in this buffer."
+  (save-excursion
+    (let ((old-asynch url-be-asynchronous))
+      (setq-default url-be-asynchronous nil)
+      (url-retrieve url)
+      (setq-default url-be-asynchronous old-asynch)))
+  (insert-buffer url-working-buffer)
+  (setq buffer-file-name url)
+  (kill-buffer url-working-buffer))
+
+(defun url-file-directory-p (url &rest args)
+  "Return t iff a url points to a directory"
+  (equal (substring url -1 nil) "/"))
+
+(defun url-file-exists (url &rest args)
+  "Return t iff a file exists."
+  (let* ((urlobj (url-generic-parse-url url))
+	 (type (url-type urlobj))
+	 (exists nil))
+    (cond
+     ((equal type "http")		; use head
+      (let ((url-request-method "HEAD")
+	    (url-request-data nil)
+	    (url-working-buffer " *url-temp*"))
+	(save-excursion
+	  (url-retrieve url)
+	  (setq exists (or (cdr
+			    (assoc "status" url-current-mime-headers)) 500))
+	  (kill-buffer " *url-temp*")
+	  (setq exists (and (>= exists 200) (< exists 300))))))
+     ((member type '("ftp" "file"))	; file-attributes
+      (let ((fname (if (url-host urlobj)
+		       (concat "/"
+			       (if (url-user urlobj)
+				   (concat (url-user urlobj) "@")
+				 "")
+			       (url-host urlobj) ":"
+			       (url-filename urlobj))
+		     (url-filename urlobj))))
+	(setq exists (file-exists-p fname))))
+     (t nil))
+    exists))
+
+;;;###autoload
+(defun url-normalize-url (url)
+  "Return a 'normalized' version of URL.  This strips out default port
+numbers, etc."
+  (let (type data grok retval)
+    (setq data (url-generic-parse-url url)
+	  type (url-type data))
+    (if (member type '("www" "about" "mailto" "mailserver" "info"))
+	(setq retval url)
+      (setq retval (url-recreate-url data)))
+    retval))
+
+;;;###autoload
+(defun url-buffer-visiting (url)
+  "Return the name of a buffer (if any) that is visiting URL."
+  (setq url (url-normalize-url url))
+  (let ((bufs (buffer-list))
+	(found nil))
+    (if (condition-case ()
+	    (string-match "\\(.*\\)#" url)
+	  (error nil))
+	(setq url (url-match url 1)))
+    (while (and bufs (not found))
+      (save-excursion
+	(set-buffer (car bufs))
+	(setq found (if (and
+			 (not (equal (buffer-name (car bufs))
+				     url-working-buffer))
+			 (memq major-mode '(url-mode w3-mode))
+			 (equal (url-view-url t) url)) (car bufs) nil)
+	      bufs (cdr bufs))))
+    found))
+
+(defun url-file-size (url &rest args)
+  "Return the size of a file in bytes, or -1 if can't be determined."
+  (let* ((urlobj (url-generic-parse-url url))
+	 (type (url-type urlobj))
+	 (size -1)
+	 (data nil))
+    (cond
+     ((equal type "http")		; use head
+      (let ((url-request-method "HEAD")
+	    (url-request-data nil)
+	    (url-working-buffer " *url-temp*"))
+	(save-excursion
+	  (url-retrieve url)
+	  (setq size (or (cdr
+			  (assoc "content-length" url-current-mime-headers))
+			 -1))
+	  (kill-buffer " *url-temp*"))))
+     ((member type '("ftp" "file"))	; file-attributes
+      (let ((fname (if (url-host urlobj)
+		       (concat "/"
+			       (if (url-user urlobj)
+				   (concat (url-user urlobj) "@")
+				 "")
+			       (url-host urlobj) ":"
+			       (url-filename urlobj))
+		     (url-filename urlobj))))
+	(setq data (file-attributes fname)
+	      size (nth 7 data))))
+     (t nil))
+    (cond
+     ((stringp size) (string-to-int size))
+     ((integerp size) size)
+     ((null size) -1)
+     (t -1))))
+
+(defun url-generate-new-buffer-name (start)
+  "Create a new buffer name based on START."
+  (let ((x 1)
+	name)
+    (if (not (get-buffer start))
+	start
+      (progn
+	(setq name (format "%s<%d>" start x))
+	(while (get-buffer name)
+	  (setq x (1+ x)
+		name (format "%s<%d>" start x)))
+	name))))
+
+(defun url-generate-unique-filename (&optional fmt)
+  "Generate a unique filename in url-temporary-directory"
+  (if (not fmt)
+      (let ((base (format "url-tmp.%d" (user-real-uid)))
+	    (fname "")
+	    (x 0))
+	(setq fname (format "%s%d" base x))
+	(while (file-exists-p (expand-file-name fname url-temporary-directory))
+	  (setq x (1+ x)
+		fname (concat base (int-to-string x))))
+	(expand-file-name fname url-temporary-directory))
+    (let ((base (concat "url" (int-to-string (user-real-uid))))
+	  (fname "")
+	  (x 0))
+      (setq fname (format fmt (concat base (int-to-string x))))
+      (while (file-exists-p (expand-file-name fname url-temporary-directory))
+	(setq x (1+ x)
+	      fname (format fmt (concat base (int-to-string x)))))
+      (expand-file-name fname url-temporary-directory))))
+
+(defun url-lazy-message (&rest args)
+  "Just like `message', but is a no-op if called more than once a second.
+Will not do anything if url-show-status is nil."
+  (if (or (null url-show-status)
+	  (= url-lazy-message-time
+	     (setq url-lazy-message-time (nth 1 (current-time)))))
+      nil
+    (apply 'message args)))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Gateway Support
+;;; ---------------
+;;; Fairly good/complete gateway support
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(defun url-kill-process (proc)
+  "Kill the process PROC - knows about all the various gateway types,
+and acts accordingly."
+  (cond
+   ((eq url-gateway-method 'native) (delete-process proc))
+   ((eq url-gateway-method 'program) (kill-process proc))
+   (t (error "Unknown url-gateway-method %s" url-gateway-method))))
+
+(defun url-accept-process-output (proc)
+  "Allow any pending output from subprocesses to be read by Emacs.
+It is read into the process' buffers or given to their filter functions.
+Where possible, this will not exit until some output is received from PROC,
+or 1 second has elapsed."
+  (accept-process-output proc 1))
+
+(defun url-process-status (proc)
+  "Return the process status of a url buffer"
+  (cond
+   ((memq url-gateway-method '(native ssl program)) (process-status proc))
+   (t (error "Unkown url-gateway-method %s" url-gateway-method))))  
+
+(defun url-open-stream (name buffer host service)
+  "Open a stream to a host"
+  (let ((tmp-gateway-method (if (and url-gateway-local-host-regexp
+				     (not (eq 'ssl url-gateway-method))
+				     (string-match
+				      url-gateway-local-host-regexp
+				      host))
+				'native
+			      url-gateway-method))
+	(tcp-binary-process-output-services (if (stringp service)
+						(list service)
+					      (list service
+						    (int-to-string service)))))
+    (and (eq url-gateway-method 'tcp)
+	 (require 'tcp)
+	 (setq url-gateway-method 'native
+	       tmp-gateway-method 'native))
+    (cond
+     ((eq tmp-gateway-method 'ssl)
+      (open-ssl-stream name buffer host service))
+     ((eq tmp-gateway-method 'native)
+      (if url-broken-resolution
+	  (setq host
+		(cond
+		 ((featurep 'ange-ftp) (ange-ftp-nslookup-host host))
+		 ((featurep 'efs) (efs-nslookup-host host))
+		 ((featurep 'efs-auto) (efs-nslookup-host host))
+		 (t host))))
+      (let ((max-retries url-connection-retries)
+	    (cur-retries 0)
+	    (retry t)
+	    (errobj nil)
+	    (conn nil))
+	(while (and (not conn) retry)
+	  (condition-case errobj
+	      (setq conn (open-network-stream name buffer host service))
+	    (error
+	     (url-save-error errobj)
+	     (save-window-excursion
+	       (save-excursion
+		 (switch-to-buffer-other-window " *url-error*")
+		 (shrink-window-if-larger-than-buffer)
+		 (goto-char (point-min))
+		 (if (and (re-search-forward "in use" nil t)
+			  (< cur-retries max-retries))
+		     (progn
+		       (setq retry t
+			     cur-retries (1+ cur-retries))
+		       (sleep-for 0.5))
+		   (setq cur-retries 0
+			 retry (funcall url-confirmation-func
+					(concat "Connection to " host
+						" failed, retry? "))))
+		 (kill-buffer (current-buffer)))))))
+	(if conn
+ 	    (progn
+ 	      (if (featurep 'mule)
+		  (save-excursion
+		    (set-buffer (get-buffer-create buffer))
+		    (setq mc-flag nil)
+		    (set-process-coding-system conn *noconv* *noconv*)))
+ 	      conn)
+	  (error "Unable to connect to %s:%s" host service))))
+     ((eq tmp-gateway-method 'program)
+      (let ((proc (start-process name buffer url-gateway-telnet-program host
+				 (int-to-string service)))
+	    (tmp nil))
+	(save-excursion
+	  (set-buffer buffer)
+	  (setq tmp (point))
+	  (while (not (progn
+			(goto-char (point-min))
+			(re-search-forward 
+			 url-gateway-telnet-ready-regexp nil t)))
+	    (url-accept-process-output proc))
+	  (delete-region tmp (point))
+	  (goto-char (point-min))
+	  (if (re-search-forward "connect:" nil t)
+	      (progn
+		(condition-case ()
+		    (delete-process proc)
+		  (error nil))
+		(url-replace-regexp ".*connect:.*" "")
+		nil)
+	    proc))))
+     (t (error "Unknown url-gateway-method %s" url-gateway-method)))))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Miscellaneous functions
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(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)
+	 ((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")
+	 ((and (eq system-type 'vax-vms) (device-type))
+	  "VMS; X11")
+	 ((eq system-type 'vax-vms) "VMS; TTY")
+	 ((eq (device-type) 'x) "X11")
+	 ((eq (device-type) 'ns) "NeXTStep")
+	 ((eq (device-type) 'pm) "OS/2")
+	 ((eq (device-type) 'win32) "Windows; 32bit")
+	 ((eq (device-type) 'tty) "(Unix?); TTY")
+	 (t "UnkownPlatform")))
+
+  ;; Set up the entity definition for PGP and PEM authentication
+  (setq url-pgp/pem-entity (or url-pgp/pem-entity
+			       user-mail-address
+			       (format "%s@%s"  (user-real-login-name)
+				       (system-name))))
+  
+  (setq url-personal-mail-address (or url-personal-mail-address
+				      url-pgp/pem-entity
+				      user-mail-address))
+
+  (if (or (memq url-privacy-level '(paranoid high))
+	  (and (listp url-privacy-level)
+	       (memq 'email url-privacy-level)))
+      (setq url-personal-mail-address nil))
+
+  (if (or (eq url-privacy-level 'paranoid)
+	  (and (listp url-privacy-level)
+	       (memq 'os url-privacy-level)))
+      (setq url-os-type nil)
+    (let ((vers (emacs-version)))
+      (if (string-match "(\\([^, )]+\\))$" vers)
+	  (setq url-os-type (url-match vers 1))
+	(setq url-os-type (symbol-name system-type))))))
+
+(defun url-handle-no-scheme (url)
+  (let ((temp url-registered-protocols)
+	(found nil))
+    (while (and temp (not found))
+      (if (and (not (member (car (car temp)) '("auto" "www")))
+	       (string-match (concat "^" (car (car temp)) "\\.")
+					url))
+	  (setq found t)
+	(setq temp (cdr temp))))
+    (cond
+     (found				; Found something like ftp.spry.com
+      (url-retrieve (concat (car (car temp)) "://" url)))
+     ((string-match "^www\\." url)
+      (url-retrieve (concat "http://" url)))
+     ((string-match "\\(\\.[^\\.]+\\)\\(\\.[^\\.]+\\)" url)
+      ;; Ok, we have at least two dots in the filename, just stick http on it
+      (url-retrieve (concat "http://" url)))
+     (t
+      (url-retrieve (concat "http://www." url ".com"))))))
+
+(defun url-setup-save-timer ()
+  "Reset the history list timer."
+  (interactive)
+  (cond
+   ((featurep 'itimer)
+    (if (get-itimer "url-history-saver")
+	(delete-itimer (get-itimer "url-history-saver")))
+    (start-itimer "url-history-saver" 'url-write-global-history
+		  url-global-history-save-interval
+		  url-global-history-save-interval))
+   ((fboundp 'run-at-time)
+    (run-at-time url-global-history-save-interval
+		 url-global-history-save-interval
+		 'url-write-global-history))
+   (t nil)))
+
+(defvar url-download-minor-mode nil)
+
+(defun url-download-minor-mode (on)
+  (setq url-download-minor-mode (if on
+				   (1+ (or url-download-minor-mode 0))
+				 (1- (or url-download-minor-mode 1))))
+  (if (<= url-download-minor-mode 0)
+      (setq url-download-minor-mode nil)))
+
+(defun url-do-setup ()
+  "Do setup - this is to avoid conflict with user settings when URL is
+dumped with emacs."
+  (if url-setup-done
+      nil
+
+    (add-minor-mode 'url-download-minor-mode " Webbing" nil)
+    ;; Decide what type of process-get to use
+    ;(url-setup-process-get)
+    
+    ;; Make OS/2 happy
+    (setq tcp-binary-process-input-services
+	  (append '("http" "80")
+		  tcp-binary-process-input-services))
+    
+    ;; Register all the protocols we can handle
+    (url-register-protocol 'file)
+    (url-register-protocol 'ftp        nil nil "21")
+    (url-register-protocol 'gopher     nil nil "70")
+    (url-register-protocol 'http       nil nil "80")
+    (url-register-protocol 'https      nil nil "443")
+    (url-register-protocol 'nfs        nil nil "2049")
+    (url-register-protocol 'info       nil 'url-identity-expander)
+    (url-register-protocol 'mailserver nil 'url-identity-expander)
+    (url-register-protocol 'finger     nil 'url-identity-expander "79")
+    (url-register-protocol 'mailto     nil 'url-identity-expander)
+    (url-register-protocol 'news       nil 'url-identity-expander "119")
+    (url-register-protocol 'nntp       nil 'url-identity-expander "119")
+    (url-register-protocol 'irc        nil 'url-identity-expander "6667")
+    (url-register-protocol 'rlogin)
+    (url-register-protocol 'shttp      nil nil "80")
+    (url-register-protocol 'telnet)
+    (url-register-protocol 'tn3270)
+    (url-register-protocol 'wais)
+    (url-register-protocol 'x-exec)
+    (url-register-protocol 'proxy)
+    (url-register-protocol 'auto 'url-handle-no-scheme)
+
+    ;; Register all the authentication schemes we can handle
+    (url-register-auth-scheme "basic" nil 4)
+    (url-register-auth-scheme "digest" nil 7)
+
+    ;; Filename handler stuff for emacsen that support it
+    (url-setup-file-name-handlers)
+
+    (setq url-cookie-file
+	  (or url-cookie-file
+	      (expand-file-name "~/.w3cookies")))
+    
+    (setq url-global-history-file
+	  (or url-global-history-file
+	      (and (memq system-type '(ms-dos ms-windows))
+		   (expand-file-name "~/mosaic.hst"))
+	      (and (memq system-type '(axp-vms vax-vms))
+		   (expand-file-name "~/mosaic.global-history"))
+	      (condition-case ()
+		  (expand-file-name "~/.mosaic-global-history")
+		(error nil))))
+  
+    ;; Parse the global history file if it exists, so that it can be used
+    ;; for URL completion, etc.
+    (if (and url-global-history-file
+	     (file-exists-p url-global-history-file))
+	(url-parse-global-history))
+
+    ;; Setup save timer
+    (and url-global-history-save-interval (url-setup-save-timer))
+
+    (if (and url-cookie-file
+	     (file-exists-p url-cookie-file))
+	(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
+				     (function
+				      (lambda (x)
+					(cond
+					 ((= x ?,) "\\|")
+					 ((= x ? ) "")
+					 ((= x ?.) (regexp-quote "."))
+					 ((= x ?*) ".*")
+					 ((= x ??) ".")
+					 (t (char-to-string x)))))
+				     noproxy "") "\\)"))
+		      url-proxy-services))))
+
+    ;; Set the url-use-transparent with decent defaults
+    (if (not (eq (device-type) 'tty))
+	(setq url-use-transparent nil))
+    (and url-use-transparent (require 'transparent))
+  
+    ;; 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
+     ((boundp '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 (string-match "Lucid" (emacs-version)))))
+      (setq url-passwd-entry-func 'ange-ftp-read-passwd))
+     (t
+      (url-warn 'security
+		"Can't determine how to read passwords, winging it.")))
+  
+    ;; Set up the news service if they haven't done so
+    (setq url-news-server
+	  (cond
+	   (url-news-server url-news-server)
+	   ((and (boundp 'gnus-default-nntp-server)
+		 (not (equal "" gnus-default-nntp-server)))
+	    gnus-default-nntp-server)
+	   ((and (boundp 'gnus-nntp-server)
+		 (not (null gnus-nntp-server))
+		 (not (equal "" gnus-nntp-server)))
+	    gnus-nntp-server)
+	   ((and (boundp 'nntp-server-name)
+		 (not (null nntp-server-name))
+		 (not (equal "" nntp-server-name)))
+	    nntp-server-name)
+	   ((getenv "NNTPSERVER") (getenv "NNTPSERVER"))
+	   (t "news")))
+  
+    ;; Set up the MIME accept string if they haven't got it hardcoded yet
+    (or url-mime-accept-string
+	(setq url-mime-accept-string (url-parse-viewer-types)))
+    (or url-mime-encoding-string
+	(setq url-mime-encoding-string
+	      (mapconcat 'car
+			 mm-content-transfer-encodings
+			 ", ")))
+  
+    (url-setup-privacy-info)
+    (run-hooks 'url-load-hook)
+    (setq url-setup-done t)))
+
+(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-prepare-cache-for-file (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."
+
+  ;; COMMENT: We don't delete directories because that requires
+  ;; recursively deleting the directories's contents, which might
+  ;; eliminate a substantial portion of the cache.
+
+  (cond
+   ((url-cache-file-writable-p file)
+    t)
+   ((file-directory-p file)
+    nil)
+   (t
+    (catch 'upcff-tag
+      (let ((dir (file-name-directory file))
+            dir-parent dir-last-component)
+        (if (string-equal dir file)
+            ;; *** Should I have a warning here?
+            ;; FILE must match a pattern like /foo/bar/, indicating it is a
+            ;; name only suitable for a directory.  So presume we won't be
+            ;; able to overwrite FILE and return nil.
+            (throw 'upcff-tag nil))
+        
+        ;; Make sure the containing directory exists, or throw a failure
+        ;; if we can't create it.
+        (if (file-directory-p dir)
+            nil
+          (or (fboundp 'make-directory)
+              (throw 'upcff-tag nil))
+          (make-directory dir t)
+          ;; make-directory silently fails if there is an obstacle, so
+          ;; we must verify its results.
+          (if (file-directory-p dir)
+              nil
+            ;; Look at prefixes of the path to find the obstacle that is
+            ;; stopping us from making the directory.  Unfortunately, there
+            ;; is no portable function in Emacs to find the parent directory
+            ;; of a *directory*.  So this code may not work on VMS.
+            (while (progn
+                     (if (eq ?/ (aref dir (1- (length dir))))
+                         (setq dir (substring dir 0 -1))
+                       ;; Maybe we're on VMS where the syntax is different.
+                       (throw 'upcff-tag nil))
+                     (setq dir-parent (file-name-directory dir))
+                     (not (file-directory-p dir-parent)))
+              (setq dir dir-parent))
+            ;; We have found the longest path prefix that exists as a
+            ;; directory.  Deal with any obstacles in this directory.
+            (if (file-exists-p dir)
+                (condition-case nil
+                    (delete-file dir)
+                  (error (throw 'upcff-tag nil))))
+            (if (file-exists-p dir)
+                (throw 'upcff-tag nil))
+            ;; Try making the directory again.
+            (setq dir (file-name-directory file))
+            (make-directory dir t)
+            (or (file-directory-p dir)
+                (throw 'upcff-tag nil))))
+
+        ;; The containing directory exists.  Let's see if there is
+        ;; something in the way in this directory.
+        (if (url-cache-file-writable-p file)
+            (throw 'upcff-tag t)
+          (condition-case nil
+              (delete-file file)
+            (error (throw 'upcff-tag nil))))
+
+        ;; The return value, if we get this far.
+        (url-cache-file-writable-p file))))))
+       
+(defun url-store-in-cache (&optional buff)
+  "Store buffer BUFF in the cache"
+  (if (or (not (get-buffer buff))
+	  (member url-current-type '("www" "about" "https" "shttp"
+					 "news" "mailto"))
+	  (and (member url-current-type '("file" "ftp" nil))
+	       (not url-current-server))
+	  )
+      nil
+    (save-excursion
+      (and buff (set-buffer buff))
+      (let* ((fname (url-create-cached-filename (url-view-url t)))
+             (fname-hdr (concat (if (memq system-type '(ms-windows ms-dos os2))
+                                    (url-file-extension fname t)
+                                  fname) ".hdr"))
+	     (info (mapcar (function (lambda (var)
+				       (cons (symbol-name var)
+					     (symbol-value var))))
+			   '( url-current-content-length
+			      url-current-file
+			      url-current-isindex
+			      url-current-mime-encoding
+			      url-current-mime-headers
+			      url-current-mime-type
+			      url-current-port
+			      url-current-server
+			      url-current-type
+			      url-current-user
+			      ))))
+	(cond ((and (url-prepare-cache-for-file fname)
+		    (url-prepare-cache-for-file fname-hdr))
+	       (write-region (point-min) (point-max) fname nil 5)
+	       (set-buffer (get-buffer-create " *cache-tmp*"))
+	       (erase-buffer)
+	       (insert "(setq ")
+	       (mapcar
+		(function
+		 (lambda (x)
+		   (insert (car x) " "
+			   (cond ((null (setq x (cdr x))) "nil")
+				 ((stringp x) (prin1-to-string x))
+				 ((listp x) (concat "'" (prin1-to-string x)))
+				 ((numberp x) (int-to-string x))
+				 (t "'???")) "\n")))
+		info)
+	       (insert ")\n")
+	       (write-region (point-min) (point-max) fname-hdr nil 5)))))))
+	
+	     
+(defun url-is-cached (url)
+  "Return non-nil if the URL is cached."
+  (let* ((fname (url-create-cached-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-create-cached-filename-using-md5 (url)
+  (if url
+      (expand-file-name (md5 url)
+			(concat url-temporary-directory "/"
+				(user-real-login-name)))))
+
+(defun url-create-cached-filename (url)
+  "Return a filename in the local cache for URL"
+  (if url
+      (let* ((url url)
+	     (urlobj (if (vectorp url)
+			 url
+		       (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
+			    (mm-string-to-tokens
+			     (or hostname "localhost") ?.))))))
+	     (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 ""))))
+
+	(if (and fname (memq system-type '(ms-windows ms-dos windows-nt))
+		 (string-match "\\([A-Za-z]\\):[/\\]" fname))
+	    (setq fname (concat (url-match fname 1) "/"
+				(substring fname (match-end 0)))))
+	
+	(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))))
+
+	;; Honor hideous 8.3 filename limitations on dos and windows
+	;; we don't have to worry about this in Windows NT/95 (or OS/2?)
+	(if (and fname (memq system-type '(ms-windows ms-dos)))
+	    (let ((base (url-file-extension fname t))
+		  (ext  (url-file-extension fname nil)))
+	      (setq fname (concat (substring base 0 (min 8 (length base)))
+				  (substring ext  0 (min 4 (length ext)))))
+	      (setq host-components
+		    (mapcar
+		     (function
+		      (lambda (x)
+			(if (> (length x) 8)
+			    (concat 
+			     (substring x 0 8) "."
+			     (substring x 8 (min (length x) 11)))
+			  x)))
+		     host-components))))
+
+	(and fname
+	     (expand-file-name fname
+			       (expand-file-name
+				(mapconcat 'identity host-components "/")
+				url-temporary-directory))))))
+
+(defun url-extract-from-cache (fnam)
+  "Extract FNAM from the local disk cache"
+  (set-buffer (get-buffer-create url-working-buffer))
+  (erase-buffer)
+  (setq url-current-mime-viewer nil)
+  (insert-file-contents-literally fnam)
+  (load (concat (if (memq system-type '(ms-windows ms-dos os2))
+		    (url-file-extension fnam t)
+		  fnam) ".hdr") t t)) 
+
+;;;###autoload
+(defun url-get-url-at-point (&optional pt)
+  "Get the URL closest to point, but don't change your
+position. Has a preference for looking backward when not
+directly on a symbol."
+  ;; Not at all perfect - point must be right in the name.
+  (save-excursion
+    (if pt (goto-char pt))
+    (let ((filename-chars "%.?@a-zA-Z0-9---()_/:~=&") start url)
+      (save-excursion
+	;; first see if you're just past a filename
+	(if (not (eobp))
+	    (if (looking-at "[] \t\n[{}()]") ; whitespace or some parens
+		(progn
+		  (skip-chars-backward " \n\t\r({[]})")
+		  (if (not (bobp))
+		      (backward-char 1)))))
+	(if (string-match (concat "[" filename-chars "]")
+			  (char-to-string (following-char)))
+	    (progn
+	      (skip-chars-backward filename-chars)
+	      (setq start (point))
+	      (skip-chars-forward filename-chars))
+	  (setq start (point)))
+	(setq url (if (fboundp 'buffer-substring-no-properties)
+		      (buffer-substring-no-properties start (point))
+		    (buffer-substring start (point)))))
+      (if (string-match "^URL:" url)
+	  (setq url (substring url 4 nil)))
+      (if (string-match "\\.$" url)
+	  (setq url (substring url 0 -1)))
+      (if (not (string-match url-nonrelative-link url))
+	  (setq url nil))
+      url)))
+
+(defun url-eat-trailing-space (x)
+  ;; Remove spaces/tabs at the end of a string
+  (let ((y (1- (length x)))
+	(skip-chars (list ?  ?\t ?\n)))
+    (while (and (>= y 0) (memq (aref x y) skip-chars))
+      (setq y (1- y)))
+    (substring x 0 (1+ y))))
+
+(defun url-strip-leading-spaces (x)
+  ;; Remove spaces at the front of a string
+  (let ((y (1- (length x)))
+	(z 0)
+	(skip-chars (list ?  ?\t ?\n)))
+    (while (and (<= z y) (memq (aref x z) skip-chars))
+      (setq z (1+ z)))
+    (substring x z nil)))
+
+(defun url-convert-newlines-to-spaces (x)
+  "Convert newlines and carriage returns embedded in a string into spaces,
+and swallow following whitespace.
+The argument is not side-effected, but may be returned by this function."
+  (if (string-match "[\n\r]+\\s-*" x)   ; [\\n\\r\\t ]
+      (concat (substring x 0 (match-beginning 0)) " "
+	      (url-convert-newlines-to-spaces
+	       (substring x (match-end 0))))
+    x))
+
+;; Test cases
+;; (url-convert-newlines-to-spaces "foo    bar")  ; nothing happens
+;; (url-convert-newlines-to-spaces "foo\n  \t  bar") ; whitespace converted
+;;
+;; This implementation doesn't mangle the match-data, is fast, and doesn't
+;; create garbage, but it leaves whitespace.
+;; (defun url-convert-newlines-to-spaces (x)
+;;   "Convert newlines and carriage returns embedded in a string into spaces.
+;; The string is side-effected, then returned."
+;;   (let ((i 0)
+;;      (limit (length x)))
+;;     (while (< i limit)
+;;       (if (or (= ?\n (aref x i))
+;;            (= ?\r (aref x i)))
+;;        (aset x i ? ))
+;;       (setq i (1+ i)))
+;;     x))
+
+(defun url-expand-file-name (url &optional default)
+  "Convert URL to a fully specified URL, and canonicalize it.
+Second arg DEFAULT is a URL to start with if URL is relative.
+If DEFAULT is nil or missing, the current buffer's URL is used.
+Path components that are `.' are removed, and 
+path components followed by `..' are removed, along with the `..' itself."
+  (if url
+      (setq url (mapconcat (function (lambda (x)
+				       (if (= x ?\n) "" (char-to-string x))))
+			   (url-strip-leading-spaces
+			    (url-eat-trailing-space url)) "")))
+  (cond
+   ((null url) nil)			; Something hosed!  Be graceful
+   ((string-match "^#" url)		; Offset link, use it raw
+    url)
+   (t
+    (let* ((urlobj (url-generic-parse-url url))
+	   (inhibit-file-name-handlers t)
+	   (defobj (cond
+		    ((vectorp default) default)
+		    (default (url-generic-parse-url default))
+		    ((and (null default) url-current-object)
+		     url-current-object)
+		    (t (url-generic-parse-url (url-view-url t)))))
+	   (expander (cdr-safe
+		      (cdr-safe
+		       (assoc (or (url-type urlobj)
+				  (url-type defobj))
+			      url-registered-protocols)))))
+      (if (string-match "^//" url)
+	  (setq urlobj (url-generic-parse-url (concat (url-type defobj) ":"
+						      url))))
+      (if (fboundp expander)
+	  (funcall expander urlobj defobj)
+	(message "Unknown URL scheme: %s" (or (url-type urlobj)
+					     (url-type defobj)))
+	(url-identity-expander urlobj defobj))
+      (url-recreate-url urlobj)))))
+
+(defun url-default-expander (urlobj defobj)
+  ;; The default expansion routine - urlobj is modified by side effect!
+  (url-set-type urlobj (or (url-type urlobj) (url-type defobj)))
+  (url-set-port urlobj (or (url-port urlobj)
+			   (and (string= (url-type urlobj)
+					 (url-type defobj))
+				(url-port defobj))))
+  (if (not (string= "file" (url-type urlobj)))
+      (url-set-host urlobj (or (url-host urlobj) (url-host defobj))))
+  (if (string= "ftp"  (url-type urlobj))
+      (url-set-user urlobj (or (url-user urlobj) (url-user defobj))))
+  (if (string= (url-filename urlobj) "")
+      (url-set-filename urlobj "/"))
+  (if (string-match "^/" (url-filename urlobj))
+      nil
+    (url-set-filename urlobj
+		      (url-remove-relative-links
+		       (concat (url-basepath (url-filename defobj))
+			       (url-filename urlobj))))))
+
+(defun url-identity-expander (urlobj defobj)
+  (url-set-type urlobj (or (url-type urlobj) (url-type defobj))))
+
+(defun url-hexify-string (str)
+  "Escape characters in a string"
+  (if (and (featurep 'mule) str)
+      (setq str (code-convert-string 
+ 		 str *internal* url-mule-retrieval-coding-system)))
+  (setq str (mapconcat
+	     (function
+	      (lambda (char)
+		(if (or (> char ?z)
+			(< char ?-)
+			(and (< char ?a)
+			     (> char ?Z))
+			(and (< char ?@)
+			     (> char ?:)))
+		    (if (< char 16)
+			(upcase (format "%%0%x" char))
+		      (upcase (format "%%%x" char)))
+		  (char-to-string char)))) str "")))
+
+(defun url-make-sequence (start end)
+  "Make a sequence (list) of numbers from START to END"
+  (cond
+   ((= start end) '())
+   ((> start end) '())
+   (t
+    (let ((sqnc '()))
+      (while (<= start end)
+	(setq sqnc (cons end sqnc)
+	      end (1- end)))
+      sqnc))))
+ 
+(defun url-file-extension (fname &optional x)
+  "Return the filename extension of FNAME.  If optional variable X is t,
+then return the basename of the file with the extension stripped off."
+  (if (and fname (string-match "\\.[^./]+$" fname))
+      (if x (substring fname 0 (match-beginning 0))
+	(substring fname (match-beginning 0) nil))
+    ;;
+    ;; If fname has no extension, and x then return fname itself instead of 
+    ;; nothing. When caching it allows the correct .hdr file to be produced
+    ;; for filenames without extension.
+    ;;
+    (if x
+ 	fname
+      "")))
+
+(defun url-basepath (file &optional x)
+  "Return the base pathname of FILE, or the actual filename if X is true"
+  (cond
+   ((null file) "")
+   (x (file-name-nondirectory file))
+   (t (file-name-directory file))))
+
+(defun url-unhex (x)
+  (if (> x ?9)
+      (if (>= x ?a)
+	  (+ 10 (- x ?a))
+	(+ 10 (- x ?A)))
+    (- x ?0)))
+
+(defun url-unhex-string (str)
+  "Remove %XXX embedded spaces, etc in a url"
+  (setq str (or str ""))
+  (let ((tmp ""))
+    (while (string-match "%[0-9a-f][0-9a-f]" str)
+      (let* ((start (match-beginning 0))
+	     (ch1 (url-unhex (elt str (+ start 1))))
+	     (code (+ (* 16 ch1)
+		      (url-unhex (elt str (+ start 2))))))
+	(setq tmp
+	      (concat 
+	       tmp (substring str 0 start)
+	       (if (or (= code ?\n) (= code ?\r)) " " (char-to-string code)))
+	      str (substring str (match-end 0)))))
+    (setq tmp (concat tmp str))
+    tmp))
+
+(defun url-clean-text ()
+  "Clean up a buffer, removing any excess garbage from a gateway mechanism,
+and decoding any MIME content-transfer-encoding used."
+  (set-buffer url-working-buffer)
+  (goto-char (point-min))
+  (url-replace-regexp "Connection closed by.*" "")
+  (goto-char (point-min))
+  (url-replace-regexp "Process WWW.*" ""))
+
+(defun url-uncompress ()
+  "Do any necessary uncompression on `url-working-buffer'"
+  (set-buffer url-working-buffer)
+  (if (not url-inhibit-uncompression)
+      (let* ((extn (url-file-extension url-current-file))
+	     (decoder nil)
+	     (code-1 (cdr-safe
+		      (assoc "content-transfer-encoding"
+			     url-current-mime-headers)))
+	     (code-2 (cdr-safe
+		      (assoc "content-encoding" url-current-mime-headers)))
+	     (code-3 (and (not code-1) (not code-2)
+			  (cdr-safe (assoc extn url-uncompressor-alist))))
+	     (done nil)
+	     (default-process-coding-system
+	       (if (featurep 'mule) (cons *noconv* *noconv*))))
+	(mapcar
+	 (function
+	  (lambda (code)
+	    (setq decoder (and (not (member code done))
+			       (cdr-safe
+				(assoc code mm-content-transfer-encodings)))
+		  done (cons code done))
+	    (cond
+	     ((null decoder) nil)
+	     ((stringp decoder)
+	      (message "Decoding...")
+	      (call-process-region (point-min) (point-max) decoder t t nil)
+	      (message "Decoding... done."))
+	     ((listp decoder)
+	      (apply 'call-process-region (point-min) (point-max)
+		     (car decoder) t t nil (cdr decoder)))
+	     ((and (symbolp decoder) (fboundp decoder))
+	      (message "Decoding...")
+	      (funcall decoder (point-min) (point-max))
+	      (message "Decoding... done."))
+	     (t
+	      (error "Bad entry for %s in `mm-content-transfer-encodings'"
+		     code)))))
+	 (list code-1 code-2 code-3))))
+  (set-buffer-modified-p nil))
+
+(defun url-filter (proc string)
+  (save-excursion
+    (set-buffer url-working-buffer)
+    (insert string)
+    (if (string-match "\nConnection closed by" string)
+	(progn (set-process-filter proc nil)
+	       (url-sentinel proc string))))
+  string)
+
+(defun url-default-callback (buf)
+  (url-download-minor-mode nil)
+  (cond
+   ((save-excursion (set-buffer buf)
+		    (and url-current-callback-func
+			 (fboundp url-current-callback-func)))
+    (save-excursion
+      (save-window-excursion
+	(set-buffer buf)
+	(cond
+	 ((listp url-current-callback-data)
+	  (apply url-current-callback-func
+		 url-current-callback-data))
+	 (url-current-callback-data
+	  (funcall url-current-callback-func
+		   url-current-callback-data))
+	 (t
+	  (funcall url-current-callback-func))))))
+   ((fboundp 'w3-sentinel)
+    (set-variable 'w3-working-buffer buf)
+    (w3-sentinel))
+   (t
+    (message "Retrieval for %s complete." buf))))
+
+(defun url-sentinel (proc string)
+  (if (buffer-name (process-buffer proc))
+      (save-excursion
+	(set-buffer (get-buffer (process-buffer proc)))
+	(remove-hook 'after-change-functions 'url-after-change-function)
+	(let ((status nil)
+	      (url-working-buffer (current-buffer)))
+	  (if url-be-asynchronous
+	      (progn
+		(widen)
+		(url-clean-text)
+		(cond
+		 ((and (null proc) (not (get-buffer url-working-buffer))) nil)
+		 ((url-mime-response-p)
+		  (setq status (url-parse-mime-headers))))
+		(if (not url-current-mime-type)
+		    (setq url-current-mime-type (mm-extension-to-mime
+						 (url-file-extension
+						  url-current-file))))))
+	  (if (member status '(401 301 302 303 204))
+	      nil
+	    (funcall url-default-retrieval-proc (buffer-name)))))
+    (url-warn 'url (format "Process %s completed with no buffer!" proc))))
+
+(defun url-remove-relative-links (name)
+  ;; Strip . and .. from pathnames
+  (let ((new (if (not (string-match "^/" name))
+		 (concat "/" name)
+	       name)))
+    (while (string-match "/\\([^/]*/\\.\\./\\)" new)
+      (setq new (concat (substring new 0 (match-beginning 1))
+			(substring new (match-end 1)))))
+    (while (string-match "/\\(\\./\\)" new)
+      (setq new (concat (substring new 0 (match-beginning 1))
+			(substring new (match-end 1)))))
+    (while (string-match "^/\\.\\.\\(/\\)" new)
+      (setq new (substring new (match-beginning 1) nil)))
+    new))
+
+(defun url-truncate-url-for-viewing (url &optional width)
+  "Return a shortened version of URL that is WIDTH characters or less wide.
+WIDTH defaults to the current frame width."
+  (let* ((fr-width (or width (frame-width)))
+	 (str-width (length url))
+	 (tail (file-name-nondirectory url))
+	 (fname nil)
+	 (modified 0)
+	 (urlobj nil))
+    ;; The first thing that can go are the search strings
+    (if (and (>= str-width fr-width)
+	     (string-match "?" url))
+	(setq url (concat (substring url 0 (match-beginning 0)) "?...")
+	      str-width (length url)
+	      tail (file-name-nondirectory url)))
+    (if (< str-width fr-width)
+	nil				; Hey, we are done!
+      (setq urlobj (url-generic-parse-url url)
+	    fname (url-filename urlobj)
+	    fr-width (- fr-width 4))
+      (while (and (>= str-width fr-width)
+		  (string-match "/" fname))
+	(setq fname (substring fname (match-end 0) nil)
+	      modified (1+ modified))
+	(url-set-filename urlobj fname)
+	(setq url (url-recreate-url urlobj)
+	      str-width (length url)))
+      (if (> modified 1)
+	  (setq fname (concat "/.../" fname))
+	(setq fname (concat "/" fname)))
+      (url-set-filename urlobj fname)
+      (setq url (url-recreate-url urlobj)))
+    url))
+
+(defun url-view-url (&optional no-show)
+  "View the current document's URL.  Optional argument NO-SHOW means
+just return the URL, don't show it in the minibuffer."
+  (interactive)
+  (let ((url ""))
+    (cond
+     ((equal url-current-type "gopher")
+      (setq url (format "%s://%s%s/%s"
+			url-current-type url-current-server
+			(if (or (null url-current-port)
+				(string= "70" url-current-port)) ""
+			  (concat ":" url-current-port))
+			url-current-file)))
+     ((equal url-current-type "news")
+      (setq url (concat "news:"
+			(if (not (equal url-current-server
+					url-news-server))
+			    (concat "//" url-current-server
+				    (if (or (null url-current-port)
+					    (string= "119" url-current-port))
+					""
+				      (concat ":" url-current-port)) "/"))
+			url-current-file)))
+     ((equal url-current-type "about")
+      (setq url (concat "about:" url-current-file)))
+     ((member url-current-type '("http" "shttp" "https"))
+      (setq url (format  "%s://%s%s/%s" url-current-type url-current-server
+			 (if (or (null url-current-port)
+				 (string= "80" url-current-port))
+			     ""
+			   (concat ":" url-current-port))
+			 (if (and url-current-file
+				  (= ?/ (string-to-char url-current-file)))
+			     (substring url-current-file 1 nil)
+			   url-current-file))))
+     ((equal url-current-type "ftp")
+      (setq url (format "%s://%s%s/%s" url-current-type
+			(if (and url-current-user
+				 (not (string= "anonymous" url-current-user)))
+			    (concat url-current-user "@") "")
+			url-current-server
+			(if (and url-current-file
+				 (= ?/ (string-to-char url-current-file)))
+			    (substring url-current-file 1 nil)
+			  url-current-file))))
+     ((and (member url-current-type '("file" nil)) url-current-file)
+      (setq url (format "file:%s" url-current-file)))
+     ((equal url-current-type "www")
+      (setq url (format "www:/%s/%s" url-current-server url-current-file)))
+     (t
+      (setq url nil)))
+    (if (not no-show) (message "%s" url) url)))
+
+(defun url-parse-Netscape-history (fname)
+  ;; Parse a Netscape/X style global history list.
+  (let (pos				; Position holder
+	url				; The URL
+	time)				; Last time accessed
+    (goto-char (point-min))
+    (skip-chars-forward "^\n")
+    (skip-chars-forward "\n \t")	; Skip past the tag line
+    (setq url-global-history-hash-table (url-make-hashtable 131))
+    ;; Here we will go to the end of the line and
+    ;; skip back over a token, since we might run
+    ;; into spaces in URLs, depending on how much
+    ;; smarter netscape is than the old XMosaic :)
+    (while (not (eobp))
+      (setq pos (point))
+      (end-of-line)
+      (skip-chars-backward "^ \t")
+      (skip-chars-backward " \t")
+      (setq url (buffer-substring pos (point))
+	    pos (1+ (point)))
+      (skip-chars-forward "^\n")
+      (setq time (buffer-substring pos (point)))
+      (skip-chars-forward "\n")
+      (setq url-history-changed-since-last-save t)
+      (url-puthash url time url-global-history-hash-table))))
+
+(defun url-parse-Mosaic-history-v1 (fname)
+  ;; Parse an NCSA Mosaic/X style global history list
+  (goto-char (point-min))
+  (skip-chars-forward "^\n")
+  (skip-chars-forward "\n \t")	; Skip past the tag line
+  (skip-chars-forward "^\n")
+  (skip-chars-forward "\n \t")	; Skip past the second tag line
+  (setq url-global-history-hash-table (url-make-hashtable 131))
+  (let (pos				; Temporary position holder
+	bol				; Beginning-of-line
+	url				; URL
+	time				; Time
+	last-end			; Last ending point
+	)
+    (while (not (eobp))
+      (setq bol (point))
+      (end-of-line)
+      (setq pos (point)
+	    last-end (point))
+      (skip-chars-backward "^ \t" bol)	; Skip over year
+      (skip-chars-backward " \t" bol)
+      (skip-chars-backward "^ \t" bol)	; Skip over time
+      (skip-chars-backward " \t" bol)
+      (skip-chars-backward "^ \t" bol)	; Skip over day #
+      (skip-chars-backward " \t" bol)
+      (skip-chars-backward "^ \t" bol)	; Skip over month
+      (skip-chars-backward " \t" bol)
+      (skip-chars-backward "^ \t" bol)	; Skip over day abbrev.
+      (if (bolp)
+	  nil				; Malformed entry!!! Ack! Bailout!
+	(setq time (buffer-substring pos (point)))
+	(skip-chars-backward " \t")
+	(setq pos (point)))
+      (beginning-of-line)
+      (setq url (buffer-substring (point) pos))
+      (goto-char (min (1+ last-end) (point-max))) ; Goto next line
+      (if (/= (length url) 0)
+	  (progn
+	    (setq url-history-changed-since-last-save t)
+	    (url-puthash url time url-global-history-hash-table))))))
+
+(defun url-parse-Mosaic-history-v2 (fname)
+  ;; Parse an NCSA Mosaic/X style global history list (version 2)
+  (goto-char (point-min))
+  (skip-chars-forward "^\n")
+  (skip-chars-forward "\n \t")	; Skip past the tag line
+  (skip-chars-forward "^\n")
+  (skip-chars-forward "\n \t")	; Skip past the second tag line
+  (setq url-global-history-hash-table (url-make-hashtable 131))
+  (let (pos				; Temporary position holder
+	bol				; Beginning-of-line
+	url				; URL
+	time				; Time
+	last-end			; Last ending point
+	)
+    (while (not (eobp))
+      (setq bol (point))
+      (end-of-line)
+      (setq pos (point)
+	    last-end (point))
+      (skip-chars-backward "^ \t" bol)	; Skip over time
+      (if (bolp)
+	  nil				; Malformed entry!!! Ack! Bailout!
+	(setq time (buffer-substring pos (point)))
+	(skip-chars-backward " \t")
+	(setq pos (point)))
+      (beginning-of-line)
+      (setq url (buffer-substring (point) pos))
+      (goto-char (min (1+ last-end) (point-max))) ; Goto next line
+      (if (/= (length url) 0)
+	  (progn
+	    (setq url-history-changed-since-last-save t)
+	    (url-puthash url time url-global-history-hash-table))))))
+
+(defun url-parse-Emacs-history (&optional fname)
+  ;; Parse out the Emacs-w3 global history file for completion, etc.
+  (or fname (setq fname (expand-file-name url-global-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 ()
+	(load fname nil t)
+      (error (message "Could not load %s" fname)))
+    (if (boundp 'url-global-history-completion-list)
+	;; Hey!  Automatic conversion of old format!
+	(progn
+	  (setq url-global-history-hash-table (url-make-hashtable 131)
+		url-history-changed-since-last-save t)
+	  (mapcar (function
+		   (lambda (x)
+		     (url-puthash (car x) (cdr x)
+				 url-global-history-hash-table)))
+		  (symbol-value 'url-global-history-completion-list)))))))
+
+(defun url-parse-global-history (&optional fname)
+  ;; Parse out the mosaic global history file for completions, etc.
+  (or fname (setq fname (expand-file-name url-global-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
+    (save-excursion
+      (set-buffer (get-buffer-create " *url-tmp*"))
+      (erase-buffer)
+      (insert-file-contents-literally fname)
+      (goto-char (point-min))
+      (cond
+       ((looking-at "(setq") (url-parse-Emacs-history fname))
+       ((looking-at "ncsa-mosaic-.*-1$") (url-parse-Mosaic-history-v1 fname))
+       ((looking-at "ncsa-mosaic-.*-2$") (url-parse-Mosaic-history-v2 fname))
+       ((or (looking-at "MCOM-") (looking-at "netscape"))
+	(url-parse-Netscape-history fname))
+       (t
+	(url-warn 'url (format "Cannot deduce type of history file: %s"
+			       fname))))))))
+
+(defun url-write-Emacs-history (fname)
+  ;; Write an Emacs-w3 style global history list into FNAME
+  (erase-buffer)
+  (let ((count 0))
+    (url-maphash (function
+		  (lambda (key value)
+		    (setq count (1+ count))
+		    (insert "(url-puthash "
+			    (if (stringp key)
+				(prin1-to-string key)
+			      (concat "\"" (symbol-name key) "\""))
+			    (if (not (stringp value)) " '" "")
+			    (prin1-to-string value)
+			    " url-global-history-hash-table)\n")))
+		 url-global-history-hash-table)
+    (goto-char (point-min))
+    (insert (format
+	     "(setq url-global-history-hash-table (url-make-hashtable %d))\n"
+	     (/ count 4)))
+    (goto-char (point-max))
+    (insert "\n")
+    (write-file fname)))
+
+(defun url-write-Netscape-history (fname)
+  ;; Write a Netscape-style global history list into FNAME
+  (erase-buffer)
+  (let ((last-valid-time "785305714"))	; Picked out of thin air,
+					; in case first in assoc list
+					; doesn't have a valid time
+    (goto-char (point-min))
+    (insert "MCOM-Global-history-file-1\n")
+    (url-maphash (function
+		  (lambda (url time)
+		    (if (or (not (stringp time)) (string-match " \t" time))
+			(setq time last-valid-time)
+		      (setq last-valid-time time))
+		    (insert (concat (if (stringp url)
+					url
+				      (symbol-name url))
+				    " " time "\n"))))
+		 url-global-history-hash-table)
+    (write-file fname)))
+
+(defun url-write-Mosaic-history-v1 (fname)
+  ;; Write a Mosaic/X-style global history list into FNAME
+  (erase-buffer)
+  (goto-char (point-min))
+  (insert "ncsa-mosaic-history-format-1\nGlobal\n")
+  (url-maphash (function
+		(lambda (url time)
+		  (if (listp time)
+		      (setq time (current-time-string time)))
+		  (if (or (not (stringp time))
+			  (not (string-match " " time)))
+		      (setq time (current-time-string)))
+		  (insert (concat (if (stringp url)
+				      url
+				    (symbol-name url))
+				  " " time "\n"))))
+	       url-global-history-hash-table)
+  (write-file fname))
+
+(defun url-write-Mosaic-history-v2 (fname)
+  ;; Write a Mosaic/X-style global history list into FNAME
+  (let ((last-valid-time "827250806"))
+    (erase-buffer)
+    (goto-char (point-min))
+    (insert "ncsa-mosaic-history-format-2\nGlobal\n")
+    (url-maphash (function
+		  (lambda (url time)
+		    (if (listp time)
+			(setq time last-valid-time)
+		      (setq last-valid-time time))
+		    (if (not (stringp time))
+			(setq time last-valid-time))
+		    (insert (concat (if (stringp url)
+					url
+				      (symbol-name url))
+				    " " time "\n"))))
+		 url-global-history-hash-table)
+    (write-file fname)))
+
+(defun url-write-global-history (&optional fname)
+  "Write the global history file into `url-global-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-global-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)
+	(condition-case ()
+	    (insert-file-contents-literally fname)
+	  (error nil))
+	(goto-char (point-min))
+	(cond
+	 ((looking-at "ncsa-mosaic-.*-1$") (url-write-Mosaic-history-v1 fname))
+	 ((looking-at "ncsa-mosaic-.*-2$") (url-write-Mosaic-history-v2 fname))
+	 ((looking-at "MCOM-") (url-write-Netscape-history fname))
+	 ((looking-at "netscape") (url-write-Netscape-history fname))
+	 ((looking-at "(setq") (url-write-Emacs-history fname))
+	 (t (url-write-Emacs-history fname)))
+	(kill-buffer (current-buffer))))))
+  (setq url-history-changed-since-last-save nil))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; The main URL fetching interface
+;;; -------------------------------
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;;;###autoload
+(defun url-popup-info (url)
+  "Retrieve the HTTP/1.0 headers and display them in a temp buffer."
+  (let* ((urlobj (url-generic-parse-url url))
+	 (type (url-type urlobj))
+	 data)
+    (cond
+     ((string= type "http")
+      (let ((url-request-method "HEAD")
+	    (url-automatic-caching nil)
+	    (url-inhibit-mime-parsing t)
+	    (url-working-buffer " *popup*"))
+	(save-excursion
+	  (set-buffer (get-buffer-create url-working-buffer))
+	  (erase-buffer)
+	  (setq url-be-asynchronous nil)
+	  (url-retrieve url)
+	  (subst-char-in-region (point-min) (point-max) ?\r ? )
+	  (buffer-string))))
+     ((or (string= type "file") (string= type "ftp"))
+      (setq data (url-file-attributes url))
+      (set-buffer (get-buffer-create
+		   (url-generate-new-buffer-name "*Header Info*")))
+      (erase-buffer)
+      (if data
+	  (concat (if (stringp (nth 0 data))
+		      (concat "    Linked to: " (nth 0 data))
+		    (concat "    Directory: " (if (nth 0 data) "Yes" "No")))
+		  "\n        Links: " (int-to-string (nth 1 data))
+		  "\n     File UID: " (int-to-string (nth 2 data))
+		  "\n     File GID: " (int-to-string (nth 3 data))
+		  "\n  Last Access: " (current-time-string (nth 4 data))
+		  "\nLast Modified: " (current-time-string (nth 5 data))
+		  "\n Last Changed: " (current-time-string (nth 6 data))
+		  "\n Size (bytes): " (int-to-string (nth 7 data))
+		  "\n    File Type: " (or (nth 8 data) "text/plain"))
+	(concat "No info found for " url)))
+     ((and (string= type "news") (string-match "@" url))
+      (let ((art (url-filename urlobj)))
+	(if (not (string= (substring art -1 nil) ">"))
+	    (setq art (concat "<" art ">")))
+	(url-get-headers-from-article-id art)))
+     (t (concat "Don't know how to find information on " url)))))
+
+(defun url-decode-text ()
+  ;; Decode text transmitted by NNTP.
+  ;; 0. Delete status line.
+  ;; 1. Delete `^M' at end of line.
+  ;; 2. Delete `.' at end of buffer (end of text mark).
+  ;; 3. Delete `.' at beginning of line."
+  (save-excursion
+    (set-buffer nntp-server-buffer)
+    ;; Insert newline at end of buffer.
+    (goto-char (point-max))
+    (if (not (bolp))
+	(insert "\n"))
+    ;; Delete status line.
+    (goto-char (point-min))
+    (delete-region (point) (progn (forward-line 1) (point)))
+    ;; Delete `^M' at end of line.
+    ;; (replace-regexp "\r$" "")
+    (while (not (eobp))
+      (end-of-line)
+      (if (= (preceding-char) ?\r)
+	  (delete-char -1))
+      (forward-line 1)
+      )
+    ;; Delete `.' at end of buffer (end of text mark).
+    (goto-char (point-max))
+    (forward-line -1)			;(beginning-of-line)
+    (if (looking-at "^\\.$")
+	(delete-region (point) (progn (forward-line 1) (point))))
+    ;; Replace `..' at beginning of line with `.'.
+    (goto-char (point-min))
+    ;; (replace-regexp "^\\.\\." ".")
+    (while (search-forward "\n.." nil t)
+      (delete-char -1))
+    ))
+
+(defun url-get-headers-from-article-id (art)
+  ;; Return the HEAD of ART (a usenet news article)
+  (cond
+   ((string-match "flee" nntp-version)
+    (nntp/command "HEAD" art)
+    (save-excursion
+      (set-buffer nntp-server-buffer)
+      (while (progn (goto-char (point-min))
+		    (not (re-search-forward "^.\r*$" nil t)))
+	(url-accept-process-output nntp/connection))))
+   (t
+    (nntp-send-command "^\\.\r$" "HEAD" art)
+    (url-decode-text)))
+  (save-excursion
+    (set-buffer nntp-server-buffer)
+    (buffer-string)))
+
+(defvar url-external-retrieval-program "www"
+  "*Name of the external executable to run to retrieve URLs.")
+
+(defvar url-external-retrieval-args '("-source")
+  "*A list of arguments to pass to `url-external-retrieval-program' to
+retrieve a URL by its HTML source.")
+
+(defun url-retrieve-externally (url &optional no-cache)
+  (if (get-buffer url-working-buffer)
+      (save-excursion
+	(set-buffer url-working-buffer)
+	(set-buffer-modified-p nil)
+	(kill-buffer url-working-buffer)))
+  (set-buffer (get-buffer-create url-working-buffer))
+  (let* ((args (append url-external-retrieval-args (list url)))
+	 (urlobj (url-generic-parse-url url))
+	 (type (url-type urlobj)))
+    (if (or (member type '("www" "about" "mailto" "mailserver"))
+	    (url-file-directly-accessible-p urlobj))
+	(url-retrieve-internally url)
+      (url-lazy-message "Retrieving %s..." url)
+      (apply 'call-process url-external-retrieval-program
+	     nil t nil args)
+      (url-lazy-message "Retrieving %s... done" url)
+      (if (and type urlobj)
+	  (setq url-current-server (url-host urlobj)
+		url-current-type (url-type urlobj)
+		url-current-port (url-port urlobj)
+		url-current-file (url-filename urlobj)))
+      (if (member url-current-file '("/" ""))
+	  (setq url-current-mime-type "text/html")))))
+
+(defun url-get-normalized-date (&optional specified-time)
+  ;; Return a 'real' date string that most HTTP servers can understand.
+  (require 'timezone)
+  (let* ((raw (if specified-time (current-time-string specified-time)
+		(current-time-string)))
+	 (gmt (timezone-make-date-arpa-standard raw
+						(nth 1 (current-time-zone))
+						"GMT"))
+	 (parsed (timezone-parse-date gmt))
+	 (day (cdr-safe (assoc (substring raw 0 3) weekday-alist)))
+	 (year nil)
+	 (month (car
+		 (rassoc
+		  (string-to-int (aref parsed 1)) monthabbrev-alist)))
+	 )
+    (setq day (or (car-safe (rassoc day weekday-alist))
+		  (substring raw 0 3))
+	  year (aref parsed 0))
+    ;; This is needed for plexus servers, or the server will hang trying to
+    ;; parse the if-modified-since header.  Hopefully, I can take this out
+    ;; soon.
+    (if (and year (> (length year) 2))
+	(setq year (substring year -2 nil)))
+
+    (concat day ", " (aref parsed 2) "-" month "-" year " "
+	    (aref parsed 3) " " (or (aref parsed 4)
+				    (concat "[" (nth 1 (current-time-zone))
+					    "]")))))
+
+;;;###autoload
+(defun url-cache-expired (url mod)
+  "Return t iff a cached file has expired."
+  (if (not (string-match url-nonrelative-link url))
+      t
+    (let* ((urlobj (url-generic-parse-url url))
+	   (type (url-type urlobj)))
+      (cond
+       (url-standalone-mode
+	(not (file-exists-p (url-create-cached-filename urlobj))))
+       ((string= type "http")
+	(if (not url-standalone-mode) t
+	  (not (file-exists-p (url-create-cached-filename urlobj)))))
+       ((not (fboundp 'current-time))
+	t)
+       ((member type '("file" "ftp"))
+	(if (or (equal mod '(0 0)) (not mod))
+	      (return t)
+	    (or (> (nth 0 mod) (nth 0 (current-time)))
+		(> (nth 1 mod) (nth 1 (current-time))))))
+       (t nil)))))
+
+(defun url-retrieve-internally (url &optional no-cache)
+  (if (get-buffer url-working-buffer)
+      (save-excursion
+	(set-buffer url-working-buffer)
+	(erase-buffer)
+	(setq url-current-can-be-cached (not no-cache))
+	(set-buffer-modified-p nil)))
+  (let* ((urlobj (url-generic-parse-url url))
+	 (type (url-type urlobj))
+	 (url-using-proxy (and
+			   (if (assoc "no_proxy" url-proxy-services)
+			       (not (string-match
+				     (cdr
+				      (assoc "no_proxy" url-proxy-services))
+				     url))
+			     t)
+			   (not
+			    (and
+			     (string-match "file:" url)
+			     (not (string-match "file://" url))))
+			   (cdr (assoc type url-proxy-services))))
+	 (handler nil)
+	 (original-url url)
+	 (cached nil)
+	 (tmp url-current-file))
+    (if url-using-proxy (setq type "proxy"))
+    (setq cached (url-is-cached url)
+	  cached (and cached (not (url-cache-expired url cached)))
+	  handler (if cached 'url-extract-from-cache
+		    (car-safe
+		     (cdr-safe (assoc (or type "auto")
+				      url-registered-protocols))))
+	  url (if cached (url-create-cached-filename url) url))
+    (save-excursion
+      (set-buffer (get-buffer-create url-working-buffer))
+      (setq url-current-can-be-cached (not no-cache)))
+    (if url-be-asynchronous
+	(url-download-minor-mode t))
+    (if (and handler (fboundp handler))
+	(funcall handler url)
+      (set-buffer (get-buffer-create url-working-buffer))
+      (setq url-current-file tmp)
+      (erase-buffer)
+      (insert "<title> Link Error! </title>\n"
+	      "<h1> An error has occurred... </h1>\n"
+	      (format "The link type `<code>%s</code>'" type)
+	      " is unrecognized or unsupported at this time.<p>\n"
+	      "If you feel this is an error, please "
+	      "<a href=\"mailto://" url-bug-address "\">send me mail.</a>"
+	      "<p><address>William Perry</address><br>"
+	      "<address>" url-bug-address "</address>")
+      (setq url-current-file "error.html"))
+    (if (and
+	 (not url-be-asynchronous)
+	 (get-buffer url-working-buffer))
+	(progn
+	  (set-buffer url-working-buffer)
+	  (if (not url-current-object)
+	      (setq url-current-object urlobj))
+	  (url-clean-text)))
+    (cond
+     ((equal type "wais") nil)
+     ((and url-be-asynchronous (not cached) (member type '("http" "proxy")))
+      nil)
+     (url-be-asynchronous
+      (funcall url-default-retrieval-proc (buffer-name)))
+     ((not (get-buffer url-working-buffer)) nil)
+     ((and (not url-inhibit-mime-parsing)
+	   (or cached (url-mime-response-p t)))
+      (or cached (url-parse-mime-headers nil t))))
+    (if (and (or (not url-be-asynchronous)
+		 (not (equal type "http")))
+	     (not url-current-mime-type))
+	(if (url-buffer-is-hypertext)
+	    (setq url-current-mime-type "text/html")
+	  (setq url-current-mime-type (mm-extension-to-mime
+				      (url-file-extension
+				       url-current-file)))))
+    (if (and url-automatic-caching url-current-can-be-cached
+	     (not url-be-asynchronous))
+	(save-excursion
+	  (url-store-in-cache url-working-buffer)))
+    (if (not (url-hashtablep url-global-history-hash-table))
+	(setq url-global-history-hash-table (url-make-hashtable 131)))
+    (if (not (string-match "^about:" original-url))
+	(progn
+	  (setq url-history-changed-since-last-save t)
+	  (url-puthash original-url (current-time)
+		       url-global-history-hash-table)))
+    cached))
+
+;;;###autoload
+(defun url-retrieve (url &optional no-cache expected-md5)
+  "Retrieve a document over the World Wide Web.
+The document should be specified by its fully specified
+Uniform Resource Locator.  No parsing is done, just return the
+document as the server sent it.  The document is left in the
+buffer specified by url-working-buffer.  url-working-buffer is killed
+immediately before starting the transfer, so that no buffer-local
+variables interfere with the retrieval.  HTTP/1.0 redirection will
+be honored before this function exits."
+  (url-do-setup)
+  (if (and (fboundp 'set-text-properties)
+	   (subrp (symbol-function 'set-text-properties)))
+      (set-text-properties 0 (length url) nil url))
+  (if (and url (string-match "^url:" url))
+      (setq url (substring url (match-end 0) nil)))
+  (let ((status (url-retrieve-internally url no-cache)))
+    (if (and expected-md5 url-check-md5s)
+	(let ((cur-md5 (md5 (current-buffer))))
+	  (if (not (string= cur-md5 expected-md5))
+	      (and (not (funcall url-confirmation-func
+				 "MD5s do not match, use anyway? "))
+		   (error "MD5 error.")))))
+    status))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; How to register a protocol
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(defun url-register-protocol (protocol &optional retrieve expander defport)
+  "Register a protocol with the URL retrieval package.
+PROTOCOL is the type of protocol being registers (http, nntp, etc),
+         and is the first chunk of the URL.  ie: http:// URLs will be
+         handled by the protocol registered as 'http'.  PROTOCOL can
+         be either a symbol or a string - it is converted to a string,
+         and lowercased before being registered.
+RETRIEVE (optional) is the function to be called with a url as its
+         only argument.  If this argument is omitted, then this looks
+         for a function called 'url-PROTOCOL'.  A warning is shown if
+         the function is undefined, but the protocol is still
+         registered.
+EXPANDER (optional) is the function to call to expand a relative link
+         of type PROTOCOL.  If omitted, this defaults to
+         `url-default-expander'
+
+Any proxy information is read in from environment variables at this
+time, so this function should only be called after dumping emacs."
+  (let* ((protocol (cond
+		    ((stringp protocol) (downcase protocol))
+		    ((symbolp protocol) (downcase (symbol-name protocol)))
+		    (t nil)))
+		     
+	 (retrieve (or retrieve (intern (concat "url-" protocol))))
+	 (expander (or expander 'url-default-expander))
+	 (cur-protocol (assoc protocol url-registered-protocols))
+	 (urlobj nil)
+	 (cur-proxy (assoc protocol url-proxy-services))
+	 (env-proxy (or (getenv (concat protocol "_proxy"))
+			(getenv (concat protocol "_PROXY"))
+			(getenv (upcase (concat protocol "_PROXY"))))))
+
+    (if (not protocol)
+	(error "Invalid data to url-register-protocol."))
+    
+    (if (not (fboundp retrieve))
+	(message "Warning: %s registered, but no function found." protocol))
+
+    ;; Store the default port, if none previously specified and
+    ;; defport given
+    (if (and defport (not (assoc protocol url-default-ports)))
+	(setq url-default-ports (cons (cons protocol defport)
+				      url-default-ports)))
+    
+    ;; Store the appropriate information for later
+    (if cur-protocol
+	(setcdr cur-protocol (cons retrieve expander))
+      (setq url-registered-protocols (cons (cons protocol
+						 (cons retrieve expander))
+					   url-registered-protocols)))
+
+    ;; 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 (url-match env-proxy 1))
+      (url-set-port urlobj (url-match env-proxy 2)))
+     ;; 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 protocol (url-recreate-url urlobj))
+		       url-proxy-services))
+	   (message "Using a proxy for %s..." protocol)))))
+
+(provide 'url)