;;; LCD Archive Entry:
;;; url|William M. Perry|wmperry@spry.com|
;;; Major mode for manipulating URLs|
;;; $Date: 1994/07/31 23:51:26 $|$Revision: 1.61 $|Location Undetermined
;;;

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Copyright (c) 1993, 1994 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 by William M. Perry (wmperry@spry.com)	    ;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


(if (not noninteractive) (progn
			   (require 'mm)
			   (or (featurep 'efs)
			       (featurep 'efs-auto)
			       (require 'ange-ftp))))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Functions that might not exist in old versions of emacs
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(or (fboundp 'add-hook)
    (defun add-hook (hook-var function &optional at-end)
      "Add a function to a hook.
First argument HOOK-VAR (a symbol) is the name of a hook, second
 argument FUNCTION is the function to add.
Third (optional) argument AT-END means to add the function at the end
 of the hook list instead of the beginning.  If the function is already
 present, this has no effect.
Returns nil if FUNCTION was already present in HOOK-VAR, else new
 value of HOOK-VAR."
      (if (not (boundp hook-var)) (set hook-var nil))
      (let ((old (symbol-value hook-var)))
	(if (or (not (listp old)) (eq (car old) 'lambda))
	    (setq old (list old)))
	(if (url-member function old)
	    nil
	  (set hook-var
	       (if at-end
		   (append old (list function)) ; don't nconc
		 (cons function old)))))))

(or (fboundp 'display-error)
(defun display-error (error-object stream) ;(defgeneric report-condition ...)
  "Display `error-object' on `stream' in a user-friendly way."
  (funcall (or (let ((type (car-safe error-object)))
                 (catch 'error
                   (and (consp error-object)
                        (symbolp type)
                        ;;(stringp (get type 'error-message))
			(consp (get type 'error-conditions))
                        (let ((tail (cdr error-object)))
                          (while (not (null tail))
                            (if (consp tail)
                                (setq tail (cdr tail))
                                (throw 'error nil)))
                          t)
                        ;; (check-type condition condition)
                        (get type 'error-conditions)
                        ;; Search class hierarchy
                        (let ((tail (get type 'error-conditions)))
                          (while (not (null tail))
                            (cond ((not (and (consp tail)
                                             (symbolp (car tail))))
                                   (throw 'error nil))
                                  ((get (car tail) 'display-error)
                                   (throw 'error (get (car tail)
                                                      'display-error)))
                                  (t
                                   (setq tail (cdr tail)))))
                          ;; Default method
                          (function
			   (lambda (error-object stream)
			     (let ((type (car error-object))
				   (tail (cdr error-object))
				   (first t))
			       (if (eq type 'error)
				   (progn (princ (car tail) stream)
					  (setq tail (cdr tail)))
				 (princ (or (gettext (get type 'error-message)) type)
					stream))
			       (while tail
				 (princ (if first ": " ", ") stream)
				 (prin1 (car tail) stream)
				 (setq tail (cdr tail)
				       first nil)))))))))
	       (function
		(lambda (error-object stream)
		  (princ (gettext "Peculiar error ") stream)
		  (prin1 error-object stream))))
           error-object stream))
)


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Various nntp-related macros that are useful from gnus.el, but I don't
;;; want to have to (require 'gnus) just for them
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defmacro nntp-header-number (header)
  "Return article number in HEADER."
  (` (aref (, header) 0)))

(defmacro nntp-header-subject (header)
  "Return subject string in HEADER."
  (` (aref (, header) 1)))

(defmacro nntp-header-from (header)
  "Return author string in HEADER."
  (` (aref (, header) 2)))

(defmacro nntp-header-xref (header)
  "Return xref string in HEADER."
  (` (aref (, header) 3)))

(defmacro nntp-header-lines (header)
  "Return lines in HEADER."
  (` (aref (, header) 4)))

(defmacro nntp-header-date (header)
  "Return date in HEADER."
  (` (aref (, header) 5)))

(defmacro nntp-header-id (header)
  "Return Id in HEADER."
  (` (aref (, header) 6)))

(defmacro nntp-header-references (header)
  "Return references in HEADER."
  (` (aref (, header) 7)))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Variable definitions
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defvar url-default-retrieval-proc
  (function (lambda (buf)
	      (if (fboundp 'w3-sentinel)
		  (progn
		    (setq w3-working-buffer buf)
		    (w3-sentinel))
		(message "Retrieval for %s complete." buf))))
  "*The default action to take when an asynchronous retrieval completes.")

(defvar url-inhibit-mime-parsing nil
  "Whether to parse out (and delete) the MIME headers from a message.")

(defvar url-automatic-cacheing nil
  "*If non-nil, all documents will be automatically cached to the local
disk.")

(defvar url-cache-expired
  (function (lambda (t1 t2) (>= (- (car t2) (car t1)) 5)))
  "*A function (`funcall'able) that takes two times as its arguments, and
returns non-nil if the second time is 'too old' when compared to the first
time.")

(defvar url-broken-resolution nil
  "*Whether to use [ange|efs]-ftp-nslookup-host.")

(defvar url-bug-address "wmperry@spry.com" "Where to send bug reports.")

(defvar url-personal-mail-address nil
  "*Your full email address.  This is what is sent to HTTP/1.0 servers as
the FROM field.  If not set when url-do-setup is run, it defaults to
the value of url-pgp/pem-entity.")

(defconst url-version (let ((x "$Revision: 1.61 $"))
			(string-match "Revision: \\([^ \\\t\\\n]+\\)" x)
			(substring x (match-beginning 1) (match-end 1)))
  "Version # of URL package.")

(defvar 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
automatically creating the directory listing.")

(defvar url-pgp/pem-entity nil
  "*The users PGP/PEM id - usually their email address.")

(defvar url-uudecode-program "uudecode" "*The UUdecode executable")

(defvar url-uuencode-program "uuencode" "*The UUencode executable")

(defvar url-history-list nil "List of urls visited this session")

(defvar url-global-history-file (expand-file-name "~/.mosaic-global-history")
  "*The global history file used by both Mosaic/X and W3.
This file contains a list of all the URLs you have visited.  This file
is parsed at startup and used to provide URL completion.")

(defvar url-keep-history 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.  This is stored
in a Mosaic-compatible file format (ncsa-mosaic-history-format-1).")

(defvar url-uncompressor-alist '((".z"  . "gunzip")
				(".gz" . "gunzip")
				(".Z"  . "uncompress"))
  "*An assoc list of file extensions and the appropriate uncompression
programs for each.")

(defvar url-xterm-command "xterm -title %s -ut -e %s %s %s"
  "*Command used to start an xterm window")

(defvar url-tn3270-emulator "tn3270"
  "The client to run in a subprocess to connect to a tn3270 machine.")

(defvar url-use-transparent nil
  "*Whether to use the transparent package by Brian Tompsett instead of
the builtin telnet functions.  Using transparent allows you to have full
vt100 emulation in the telnet and tn3270 links.")

(defvar url-mail-command '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.")

(defvar url-local-exec-path nil
  "*A list of possible locations for x-exec scripts")

(defvar url-proxy-services nil
  "*An assoc list of access types and servers that gateway them.
Looks like ((\"http\" . \"server.some.domain:port\") ....)  This is set up
from the ACCESS_proxy environment variables in url-do-setup.")

(defvar url-global-history-file (expand-file-name "~/.mosaic-global-history")
  "*The global history file used by both Mosaic/X and 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.")

(defvar url-passwd-entry-func nil
  "*This is a 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.")
(defvar url-gopher-labels
  '(("0" . "(TXT)")
    ("1" . "(DIR)")
    ("2" . "(CSO)")
    ("3" . "(ERR)")
    ("4" . "(MAC)")
    ("5" . "(PCB)")
    ("6" . "(UUX)")
    ("7" . "(???)")
    ("8" . "(TEL)")
    ("T" . "(TN3)")
    ("9" . "(BIN)")
    ("g" . "(GIF)")
    ("I" . "(IMG)")
    ("h" . "(WWW)")
    ("s" . "(SND)"))
  "*An assoc list of gopher types and how to describe them in the gopher
menus.  These can be any string, but HTML/HTML+ entities should be
used when necessary, or it could disrupt formatting of the document
later on.  It is also a good idea to make sure all the strings are the
same length after entity references are removed, on a strictly
stylistic level.")

(defvar url-gopher-icons
  '(
    ("0" . "&text.document;")
    ("1" . "&folder;")
    ("2" . "&index;")
    ("3" . "&stop;")
    ("4" . "&binhex.document;")
    ("5" . "&binhex.document;")
    ("6" . "&uuencoded.document;")
    ("7" . "&index;")
    ("8" . "&telnet;")
    ("T" . "&tn3270;")
    ("9" . "&binary.document;")
    ("g" . "&image;")
    ("I" . "&image;")
    ("s" . "&audio;"))
  "*An assoc list of gopher types and the graphic entity references to
show when possible.")

(defvar url-working-buffer " *URL*" "The buffer to do all the processing in.")
(defvar url-current-annotation nil "URL of document we are annotating...")
(defvar url-current-content-length nil "Current content length")
(defvar url-current-file nil "Filename of current document")
(defvar url-current-isindex nil "Is the current document a searchable index?")
(defvar url-current-mime-encoding nil "MIME encoding of current document")
(defvar url-current-mime-headers nil "An alist of MIME headers")
(defvar url-current-mime-type nil "MIME type of current document")
(defvar url-current-mime-viewer nil "How to view the current MIME doc")
(defvar url-current-nntp-server nil "What nntp server currently opened.")
(defvar url-current-passwd-count 0 "How many times password has failed.")
(defvar url-current-port nil "Port # of the current document")
(defvar url-current-server nil "Server of the current document")
(defvar url-current-user nil "Username for ftp login")
(defvar url-current-type nil "We currently in http or file mode?")
(defvar url-gopher-types "0123456789+gIThws:;<"
  "A string containing character representations of all the gopher types.")
(defvar url-mime-separator-chars (mapcar 'identity
					(concat "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
						"abcdefghijklmnopqrstuvwxyz"
						"0123456789'()+_,-./=?"))
  "Characters allowable in a MIME multipart separator.")

(defvar url-bad-port-list
  '("25" "119")
  "*List of ports to warn the user about connecting to.  Defaults to just
the mail and NNTP ports so you cannot be tricked into sending fake mail or
forging messages by a malicious HTML document.")

(defvar url-bad-server-list
  '("iicm.tu-graz.ac.at"
    "heplibw3.slac.stanford.edu")
  "*Listing of servers that can be interrupted by an HTTP/1.0 request.
Usually just HTTP/0.9 servers with lots of lag from where you are.")

(defvar url-be-anal-about-file-attributes nil
  "*Whether to use HTTP/1.0 to figure out file attributes
or just guess based on file extension, etc.")

(defvar url-be-asynchronous nil
  "*Controls whether document retrievals over HTTP should be done in
the background.  This allows you to keep working in other windows
while large downloads occur.")
(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.")

(defvar url-mime-encoding-string nil
  "String to send to the server in the Accept-encoding: field in HTTP/1.0
requests.  This is created automatically from url-mime-encodings.")

(defvar url-mime-accept-string nil
  "String to send to the server in the Accept: field in HTTP/1.0 requests.
This is created automatically from url-mime-viewers, after the mailcap file
has been parsed.")

(defvar url-mime-encodings
  '(
    ("x-uuencode"    . "uudecode")
    ("x-hqx"         . "mcvert")
    ("x-zip"         . "gunzip")
    ("x-compress"    . "uncompress")
    )
  "*An assoc list of mime content-encoding fields and the commands to
uncompress them.")

(defvar url-package-version "Unknown" "Version # of package using URL")

(defvar url-package-name "Unknown" "Version # of package using URL")

(defvar url-max-password-attempts 5
  "*Maximum number of times a password will be prompted for when a
protected document is denied by the server.")
(defvar url-wais-to-mime
  '(
    ("WSRC" . "application/x-wais-source") 	; A database description
    ("TEXT" . "text/plain")			; plain text
    )
  "An assoc list of wais doctypes and their corresponding MIME
content-types.")

(defvar url-waisq-prog "waisq"
  "*Name of the waisq executable on this system.  This should be the
waisq program from think.com's wais8-b5.1 distribution.")

(defvar url-wais-gateway-server "www.ncsa.uiuc.edu"
  "*The machine name where the WAIS gateway lives")

(defvar url-wais-gateway-port "8001"
  "*The port # of the WAIS gateway.")
(defvar url-temporary-directory "/tmp" "*Where temporary files go.")
(defvar 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.")
(defvar url-using-proxy nil "Whether we are currently using a proxy gateway.")
(defvar url-news-server nil
  "*The default news server to get newsgroups/articles from if no server
is specified in the URL.  Defaults to the environment variable NNTPSERVER
or \"news\" if NNTPSERVER is undefined.")
(defvar url-gopher-to-mime
  '((?0 . "text/plain")			; It's a file
    (?1 . "www/gopher")			; Gopher directory
    (?2 . "www/gopher-cso-search")	; CSO search
    (?3 . "text/plain")			; Error
    (?4 . "application/mac-binhex40")	; Binhexed macintosh file
    (?5 . "application/pc-binhex40")	; DOS binary archive of some sort
    (?6 . "archive/x-uuencode")		; Unix uuencoded file
    (?7 . "www/gopher-search")		; Gopher search!
    (?9 . "application/octet-stream")	; Binary file!
    (?g . "image/gif")			; Gif file
    (?I . "image/gif")			; Some sort of image
    (?h . "text/html")			; HTML source
    (?s . "audio/basic")		; Sound file
    )
  "*An assoc list of gopher types and their corresponding MIME types")
(defvar url-use-hypertext-gopher t
  "*Controls how gopher documents are retrieved.
If non-nil, the gopher pages will be converted into HTML and parsed
just like any other page.  If nil, the requests will be passed off to
the gopher.el package by Scott Snyder.  Using the gopher.el package
will lose the gopher+ support, and inlined searching.")
(defvar url-global-history-completion-list nil
  "Assoc-list of for global history completion")
(defvar url-nonrelative-link
  "^\\(wais\\|solo\\|x-exec\\|newspost\\|www\\|mailto\\|news\\|tn3270\\|ftp\\|http\\|file\\|telnet\\|gopher\\):"
  "A regular expression that will match an absolute URL.")
(defvar url-confirmation-func 'yes-or-no-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 gotten.")

(defvar url-connection-retries 5
  "*# of times to try for a connection before bailing.
If for some reason url-open-stream cannot make a connection to a host
right away, it will sit for 1 second, then try again, up to this many
tries.")
(defvar url-find-this-link nil "Link to go to within a document")

(defvar url-show-http2-transfer t
  "*Whether to show the total # of bytes, size of file, and percentage
transferred when retrieving a document over HTTP/1.0 and it returns a
valid content-length header.  This can mess up some people behind
gateways.")

(defvar url-gateway-method 'native
  "*The type of gateway support to use.
Should be a symbol specifying how we are to get a connection off of the
local machine.

Currently supported methods:
'program	:: Run a program in a subprocess to connect
                   (examples are itelnet, an expect script, etc)
'host     	:: You need to log into a different machine, then
		   are able to telnet out
'native		:: Use the native open-network-stream in emacs
'tcp            :: Use the excellent tcp.el package from gnus.
                   This simply does a (require 'tcp), then sets
                   url-gateway-method to be 'native.
")

(defvar url-gateway-program-interactive nil
  "*Whether url needs to hand-hold the login program on the remote machine")

(defvar url-gateway-handholding-login-regexp "ogin:"
  "*Regexp for when to send the username to the remote process")

(defvar url-gateway-handholding-password-regexp "ord:"
  "*Regexp for when to send the password to the remote process")

(defvar url-gateway-host-prompt-pattern "^[^#$%>;]*[#$%>;] *"
  "*Regexp used to detect when the login is finished on the remote host.")

(defvar url-gateway-host nil
  "*Name of your gateway host when using the url-gateway-method 'host")

(defvar url-gateway-host-username nil
  "*Username to use to log into the host specified by url-gateway-host when
using url-gateway-method 'host")

(defvar url-gateway-host-password nil
  "*Password to use to log into the host specified by url-gateway-host when
using url-gateway-method 'host")

(defvar url-gateway-host-process nil
  "The process currently communicating with the url-gateway-host")

(defvar url-gateway-buffer " *GATEWAY*"
  "Buffer used temporarily when using gateways.")

(defvar url-gateway-host-program "telnet"
  "*The name of the program on the remote host that acts like telnet.")

(defvar url-gateway-host-program-ready-regexp "Escape character is .*"
  "*A regular expression that signifies the program on the remote host is
ready to accept input and send it to the remote host.")

(defvar url-gateway-telnet-ready-regexp "Escape character is .*"
  "*A regular expression that signifies url-gateway-telnet-program is
ready to accept input")

(defvar url-local-telnet-prog "telnet"
  "*Program for local telnet connections")

(defvar url-remote-telnet-prog "itelnet"
  "*Program for remote telnet connections")  

(defvar url-gateway-telnet-program "itelnet"
  "*Program to run in a subprocess when using gateway-method 'program")

(defvar url-gateway-local-host-regexp nil
  "*If a host being connected to matches this regexp then the
connection is done natively, otherwise the process is started on
`url-gateway-host' instead.")

(defvar url-use-hypertext-dired t
  "*How to format directory listings.

If value is non-nil, use directory-files to list them out and
transform them into a hypertext document, then pass it through the
parse like any other document.

If value nil, just pass the directory off to dired using find-file.")

(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-setup-done nil "*Has setup configuration been done?")

(defvar url-source nil
  "*Whether to force a sourcing of the next buffer.  This forces local
files to be read into a buffer, no matter what.  Gets around the
optimization that if you are passing it to a viewer, just make a
symbolic link, which looses if you want the source for inlined
images/etc")


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Utility functions
;;; -----------------
;;; Various functions used around the url code.
;;; Some of these qualify as hacks, but hey, this is elisp.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(and (boundp 'after-change-functions)
     (make-variable-buffer-local 'after-change-functions))

(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-member (elt list)
  "Function defined so that we are sure member will always use equal, like
its supposed to.  This was pulled from Jamie Zawinskies byte compiler "
  (while (and list (not (equal elt (car list))))
    (setq list (cdr list)))
  list)

(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)
  "Quiet replace-regexp."
  (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)
  "Take a url and either fetch it, or resolve relative refs, then fetch it"
  (if (not (string-match url-nonrelative-link url))
      (url-retrieve (url-parse-relative-link url))
    (url-retrieve 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)
    (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-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 (url-quotify-percents 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
			 (/ (* (point-max) 100) 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
			 (/ (* (point-max) 100) 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."))))))

(defun url-fix-proxy-url ()
  "Fix a proxy url so that it doesn't get appended twice."
  (string-match url-nonrelative-link url-current-file)
  (let* ((type (url-match url-current-file 1))
	 (prsr (read (concat "url-grok-" type "-href")))
	 (info (and prsr (funcall prsr url-current-file))))
    (setq url-current-type type)
    (cond
     ((string= type "news")
      (setq url-current-server (nth 0 info)
	    url-current-port (nth 1 info)
	    url-current-file (nth 2 info)))
     ((string= type "http")
      (setq url-current-server (nth 0 info)
	    url-current-port (nth 1 info)
	    url-current-file (nth 2 info)))
     ((or (string= type "ftp") (string= type "file"))
      (setq url-current-user (nth 0 info)
	    url-current-server (nth 1 info)
	    url-current-file (nth 2 info)))
     ((string= type "gopher")
      (setq url-current-server (nth 0 info)
	    url-current-port (nth 1 info)
	    url-current-file (nth 2 info))))))

(defun url-format-directory (dir)
  "Format the files in DIR into hypertext"
  (let ((files (directory-files dir nil)) file
	div attr mod-time size typ)
    (if (and (file-exists-p (expand-file-name url-directory-index-file dir))
	     (file-readable-p (expand-file-name url-directory-index-file dir)))
	(save-excursion
	  (set-buffer url-working-buffer)
	  (erase-buffer)
	  (insert-file-contents
	   (expand-file-name url-directory-index-file dir)))
      (save-excursion
	(setq div (1- (length files)))
	(set-buffer url-working-buffer)
	(erase-buffer)
	(insert "<htmlplus>\n"
		" <head>\n"
		"  <title>" dir "</title>\n"
		" </head>\n"
		" <body>\n"
		"  <div1>\n"
		"   <h1> Index of " dir "</h1>\n"
		"   <pre>\n"
		"       Name                     Last modified             Size\n"
		"<hr>\n")
	(while files
	  (url-lazy-message "Building directory list... (%d%%)"
			    (/ (* 100 (- div (length files))) div))
	  (setq file (expand-file-name (car files) dir)
		attr (file-attributes file)
		file (car files)
		mod-time (nth 5 attr)
		size (nth 7 attr)
		typ (or (mm-extension-to-mime (w3-file-extension file)) ""))
	  (if (or (equal '(0 0) mod-time) ; Set to null if unknown or
                                        ; untranslateable
		  (not (fboundp 'current-time)))
	      (setq mod-time "Unknown                 ")
	    (setq mod-time (current-time-string mod-time)))
	  (if (or (equal size 0) (equal size -1) (null size))
	      (setq size "   -")
	    (setq size (concat "   " (max 1 (/ size 1024)) "K")))
	  (cond
	   ((or (equal "." (car files)) (equal "/.." (car files)) )nil)
	   ((equal ".." (car files))
	    (insert "[DIR] <a href=\"" file "\">Parent directory</a>\n"))
	   ((stringp (nth 0 attr))	; Symbolic link handling
	    (insert "[LNK] <a href=\"" file "\">" (car files) "</a>"
		    (make-string (max 0 (- 25 (length (car files)))) ? )
		    mod-time size "\n"))
	   ((nth 0 attr)		; Directory handling
	    (insert "[DIR] <a href=\"" file "\">" (car files) "</a>"
		    (make-string (max 0 (- 25 (length (car files)))) ? )
		    mod-time size "\n"))
	   ((string-match "image" typ)
	    (insert "[IMG] <a href=\"" file "\">" (car files) "</a>"
		    (make-string (max 0 (- 25 (length (car files)))) ? )
		    mod-time size "\n"))
	   ((string-match "application" typ)
	    (insert "[APP] <a href=\"" file "\">" (car files) "</a>"
		    (make-string (max 0 (- 25 (length (car files)))) ? )
		    mod-time size "\n"))
	   ((string-match "text" typ)
	    (insert "[TXT] <a href=\"" file "\">" (car files) "</a>"
		    (make-string (max 0 (- 25 (length (car files)))) ? )
		    mod-time size "\n"))
	   (t
	    (insert "[UNK] <a href=\"" file "\">" (car files) "</a>"
		    (make-string (max 0 (- 25 (length (car files)))) ? )
		    mod-time size "\n")))
	  (setq files (cdr files)))
	(insert "   </pre>\n"
		"  </div1>\n"
		" </body>\n"
		"</htmlplus>\n"
		"<!-- Automatically generated by URL v" url-version
		" -->\n")))))

(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"
  (assoc url url-global-history-completion-list))

(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 ((type (and (string-match url-nonrelative-link url)
		   (url-match url 1))))
    (cond
     ((null type) nil)
     ((or (equal type "file")
	  (equal type "ftp"))
      (setq type (url-grok-file-href url))
      (if (nth 1 type) nil t))
     (t nil))))

;;;###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 ((type (and (string-match "^\\([^:]+\\):/" url)
			(downcase (url-match url 1))))
	     (url-automatic-cacheing nil)
	     (data nil) (exists nil))
	 (cond
	  ((equal type "http")
	   (setq data (url-grok-http-href url))
	   (cond
	    ((or (not url-be-anal-about-file-attributes)
		 (url-member (nth 0 data) url-bad-server-list))
	     (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 (nth 2 data)))
			 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
		 (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))
				   nil)	; content-type
				  nil	; gid would change
				  0	; inode number
				  0	; device number
				  )))
		 (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*"))))))
	  ((or (equal type "ftp")	; file-attributes
	       (equal type "file"))
	   (let ((href (url-grok-file-href url)))
	     (if (nth 1 href)		; remote file
		 (setq data (file-attributes (concat (nth 0 href) "@"
						     (nth 1 href) ":"
						     (nth 2 href))))
	       (setq data (file-attributes (nth 2 href))))
	     (setq data (or data (make-list 12 nil)))
	     (setcar (cdr (cdr (cdr (cdr (cdr (cdr (cdr (cdr data))))))))
		     (mm-extension-to-mime
		      (url-file-extension (nth 2 href))))))
	  (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."
  nil)

(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."
  nil)

(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
    (url-retrieve url))
  (insert-buffer url-working-buffer)
  (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."
  (string-match "^\\([^:]+\\):/" url)
  (let ((type (downcase (url-match url 1)))
	(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))))))
     ((or (equal type "ftp")		; file-attributes
	  (equal type "file"))
      (setq exists (url-grok-file-href url))
      (if (nth 1 exists)			; remote file
	  (setq exists (file-exists-p (concat (nth 0 exists) "@"
					      (nth 1 exists) ":"
					      (nth 2 exists))))
	(setq exists (file-exists-p (nth 2 exists)))))
     (t nil))
    exists))

;;;###autoload
(defun url-buffer-visiting (url)
  "Return the name of a buffer (if any) that is visiting URL."
  (let ((bufs (buffer-list))
	(found nil))
    (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."
  (string-match "^\\([^:]+\\):/" url)
  (let ((type (downcase (url-match url 1)))
	(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*"))))
     ((or (equal type "ftp")		; file-attributes
	  (equal type "file"))
      (setq data (url-grok-file-href url))
      (if (nth 1 data)			; remote file
	  (setq data (file-attributes (concat (nth 0 data) "@"
					      (nth 1 data) ":"
					      (nth 2 data))))
	(setq data (file-attributes (nth 2 data))))
      (setq 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 x)))
	(expand-file-name fname url-temporary-directory))
    (let ((base (concat "w3" (user-real-uid)))
	  (fname "")
	  (x 0))
      (setq fname (format fmt (concat base x)))
      (while (file-exists-p (expand-file-name fname url-temporary-directory))
	(setq x (1+ x)
	      fname (format fmt (concat base x))))
      (expand-file-name fname url-temporary-directory))))

(defvar url-lazy-message-time 0)

(defun url-lazy-message-1 (&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)))

(defun url-lazy-message-2 (&rest args)
  "Just like `message', but will not do anything if url-show-transfer-status
is nil."
  (if url-show-status
      (apply 'message args)
    nil))

(if (fboundp 'current-time)
    (fset 'url-lazy-message 'url-lazy-message-1)
  (fset 'url-lazy-message 'url-lazy-message-2))
      

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Support for HTTP/1.0 MIME messages
;;; ----------------------------------
;;; These functions are the guts of the HTTP/0.9 and HTTP/1.0 transfer
;;; protocol, handling access authorization, format negotiation, the
;;; whole nine yards.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun url-parse-viewer-types ()
  "Create a string usable for an Accept: header from mm-mime-data"
  (let ((tmp mm-mime-data)
	mjr mnr (str ""))
    (while tmp
      (setq mnr (cdr (car tmp))
	    mjr (car (car tmp))
	    tmp (cdr tmp))
      (while mnr
	(if (> (+ (% (length str) 60)
		  (length (concat ", " mjr "/" (car (car mnr))))) 60)
	    (setq str (format "%s\nAccept: %s/%s" str mjr
			      (if (string= ".*" (car (car mnr))) "*"
				(car (car mnr)))))
	  (setq str (format "%s, %s/%s" str mjr
			    (if (string= ".*" (car (car mnr))) "*"
			      (car (car mnr))))))
	(setq mnr (cdr mnr))))
    (substring str 2 nil)))

(defun url-create-multipart-request (file-list)
  "Create a multi-part MIME request for all files in FILE-LIST"
  (let ((separator (current-time-string))
	(content "message/http-request")		   
	(ref-url nil))
    (setq separator
	  (concat "separator-"
		  (mapconcat
		   (function
		    (lambda (char)
		      (if (memq char url-mime-separator-chars)
			  (char-to-string char) ""))) separator "")))
    (cons separator
	  (concat
	   (mapconcat
	    (function
	     (lambda (file)
	       (concat "--" separator "\nContent-type: " content "\n\n"
		       (url-create-mime-request file ref-url)))) file-list "\n")
	   "--" separator))))
              
(defun url-create-mime-request (fname ref-url)
  "Create a MIME request for fname, referred to by REF-URL."
  (if (not (url-member url-current-server url-bad-server-list))
      (let* ((extra-headers)
	     (request nil))
	(if (and ref-url (stringp ref-url) (string= ref-url "file:nil"))
	    (setq ref-url "Manual entry"))
	(setq extra-headers (mapconcat
			     (function (lambda (x)
					 (concat (car x) ": " (cdr x))))
			     url-request-extra-headers "\n"))
	(if (not (equal extra-headers ""))
	    (setq extra-headers (concat extra-headers "\n")))
	(setq request
	      (format
	       (concat
		"%s %s HTTP/1.0\n"			; The request
		"From: %s\n"				; Who its from
		"Accept-encoding: %s\n"			; Encoding
		"Accept: %s\n"				; Accept-string
		"User-Agent: %s/%s"			; User agent
		" URL/%s\n"
		"%s"					; If-modified-since
		"%s"					; Where we came from
		"%s"					; Any extra headers
		"%s"					; Any data
		"\r\n")					; End request
	       (or url-request-method "GET")
	       fname
	       url-personal-mail-address
	       url-mime-encoding-string
	       url-mime-accept-string
	       url-package-name
	       url-package-version
	       url-version
	       (if (fboundp 'current-time)
		   (let ((tm (url-is-cached "http" url-current-server
					    url-current-file)))
		     (if tm
			 (concat "If-modified-since: "
				 (current-time-string tm) "\n")
		       ""))
		 "")
	       (if ref-url (concat "Referer: " ref-url "\n") "")
	       extra-headers
	       (if url-request-data
		   (format "Content-length: %d\n\n%s"
			   (length url-request-data) url-request-data)
		 "\r\n")))
	request)
    (format "GET %s\n" fname)))

(defun url-parse-mime-headers (&optional no-delete)
  "Parse mime headers and remove them from the html"
  (set-buffer url-working-buffer)
  (let* ((st (point-min))
	 (nd (progn
	       (goto-char (point-min))
	       (skip-chars-forward " \\\t\\\n")
	       (if (re-search-forward "^\r*$" nil t)
		   (1+ (point))
		 (point-max))))
	 save-pos
	 status
	 hname
	 hvalu
	 result
	 )
    (narrow-to-region st nd)
    (goto-char (point-min))
    (skip-chars-forward " \\\t\\\n")	; Get past any blank crap
    (skip-chars-forward "^ \\\t")	; Skip over the HTTP/xxx
    (setq status (read (current-buffer)); Quicker than buffer-substring, etc.
	  result (cons (cons "status" status) result))
    (end-of-line)
    (while (not (eobp))
      (skip-chars-forward " \\\t\\\n\\\r")
      (setq save-pos (point))
      (skip-chars-forward "^:\\\n\\\r")
      (downcase-region save-pos (point))
      (setq hname (buffer-substring save-pos (point)))
      (skip-chars-forward ": \\\t ")
      (setq save-pos (point))
      (skip-chars-forward "^\\\n\\\r")
      (setq hvalu (buffer-substring save-pos (point))
	    result (cons (cons hname hvalu) result)))
    (or no-delete (delete-region st nd))
    (setq url-current-mime-type (cdr (assoc "content-type" result))
	  url-current-mime-encoding (cdr (assoc "content-encoding" result))
	  url-current-mime-viewer (mm-mime-info url-current-mime-type nil 5)
	  url-current-mime-headers result)
    (cond
     ((= status 500) nil)		; Internal server error
     ((= status 501) nil)		; Facility not supported
     ((= status 400) nil)		; Bad request - syntax
     ((and (= status 401)		; Unauthorized access, retry w/auth.
	   (< url-current-passwd-count url-max-password-attempts))
      (setq url-current-passwd-count (1+ url-current-passwd-count))
      (let* ((y (cdr (assoc "www-authenticate" result)))
	     (type (downcase (if (string-match "[ \\\t]" y)
				 (substring y 0 (match-beginning 0))
			       y)))
	     (x (intern (concat "url-" type "-auth"))))
	(cond
	 ((or (equal "pem" type) (equal "pgp" type))
	  (string-match "entity=\"\\([^\"]+\\)\"" y)
	  (url-fetch-with-pgp url-current-file (url-match y 1) (intern type)))
	 ((fboundp x)
	  (funcall x (url-view-url t) t (funcall x (url-view-url t)))
	  (let ((url-request-extra-headers
		 (cons (cons "Authorization"
			     (concat (capitalize type) " "
				     (funcall x (url-view-url t))))
		       url-request-extra-headers)))
	  (url-retrieve (url-view-url t))))
	 (t
	  (goto-char (point-max))
	  (insert "<hr>Sorry, but I do not know how to handle" y
		  " authentication.  If you'd like to write it,"
		  " send it to " url-bug-address ".<hr>")))))
     ((= status 401) nil)		; Tried too many times
     ((= status 402) nil)		; Payment required, retry w/Chargeto:
     ((= status 403) nil)		; Access is forbidden
     ((= status 404) nil)		; Not found...
     ((or (= status 301)		; Moved - retry with Location: header
	  (= status 302)		; Found - retry with Location: header
	  (= status 303))		; Method - retry with location/method
      (let ((x (url-view-url t))
	    (redir (or (cdr (assoc "uri" result))
		       (cdr (assoc "location" result))))
	    (redirmeth (or (cdr (assoc "method" result)) "GET")))
	(if (not (equal x redir))
	    (let ((url-request-method redirmeth))
	      (url-maybe-relative redir))
	  (progn
	    (goto-char (point-max))
	    (insert "<hr>Error!  This URL tried to redirect me to itself!<P>"
		    "Please notify the server maintainer.")))))
     ((= status 304)			; Cached document is newer
      (message "Extracting from cache...")
      (insert-file-contents (url-create-cached-filename url-current-type
							url-current-server
							url-current-file)))
     ((= status 204)			; No response - leave old document
      (kill-buffer url-working-buffer))
     (t nil))				; All others indicate success
    (widen)
    result))

(defun url-lf-to-crlf (str)
  "Convert all linefeeds to carriage-return-line-feed pairs in string STR"
  (mapconcat (function
	      (lambda (x)
		(if (= x 10) "\r\n" (char-to-string x)))) str ""))	     

(defun url-mime-response-p ()
  "Determine if the current buffer is a MIME response"
  (set-buffer url-working-buffer)
  (if (equal url-current-type "http")
      (progn
	(goto-char (point-min))
	(if (re-search-forward
	     (regexp-quote (url-lf-to-crlf
			    (url-create-mime-request url-current-file ".*")))
	     nil t)
	    (replace-match ""))))
  (goto-char (point-min))
  (skip-chars-forward " \\\t\\\n")
  (and (looking-at "^HTTP/.+")))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Access authorization functions
;;; ------------------------------
;;; All sorts of fun goodies for accessing restricted documents across
;;; the net using the HTTP/1.0 protocol. 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Base 64 encoding functions
;;; This code was converted to lisp code by me from the C code in
;;; ftp://cs.utk.edu/pub/MIME/b64encode.c
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defvar url-b64-encoding
 "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
 "The string to use to encode with base 64.")

(defun b0 (x) (aref url-b64-encoding (logand (lsh x -18) 63)))
(defun b1 (x) (aref url-b64-encoding (logand (lsh x -12) 63)))
(defun b2 (x) (aref url-b64-encoding (logand (lsh x -6) 63)))
(defun b3 (x) (aref url-b64-encoding (logand x 63)))

(defun b64-encode (str)
  "Do base64 encoding on string STR and return the encoded string.
This code was converted to lisp code by me from the C code in
ftp://cs.utk.edu/pub/MIME/b64encode.c.  Returns a string that is
broken into 76 byte lines."
  (let ((x (b64-encode-internal str))
	(y ""))
    (while (> (length x) 76)
      (setq y (concat y (substring x 0 76) "\n")
	    x (substring x 76 nil)))
    (setq y (concat y x))
    y))  

(defun b64-encode-internal (str)
  "Do base64 encoding on string STR and return the encoded string.
This code was converted to lisp code by me from the C code in
ftp://cs.utk.edu/pub/MIME/b64encode.c.  Returns the entire string,
not broken up into 76 byte lines."
  (let (
	(word 0)			; The word to translate
	w1 w2 w3
	)
    (cond
     ((> (length str) 3)
      (concat
       (b64-encode-internal (substring str 0 3))
       (b64-encode-internal (substring str 3 nil))))
     ((= (length str) 3)
      (setq w1 (aref str 0)
	    w2 (aref str 1)
	    w3 (aref str 2)
	    word (logior
		  (lsh (logand w1 255) 16)
		  (lsh (logand w2 255) 8)
		  (logand w3 255)))
      (format "%c%c%c%c" (b0 word) (b1 word) (b2 word) (b3 word)))
     ((= (length str) 2)
      (setq w1 (aref str 0)
	    w2 (aref str 1)
	    word (logior
		  (lsh (logand w1 255) 16)
		  (lsh (logand w2 255) 8)
		  0))
      (format "%c%c%c=" (b0 word) (b1 word) (b2 word)))
     ((= (length str) 1)
      (setq w1 (aref str 0)
	    word (logior
		  (lsh (logand w1 255) 16)
		  0))
      (format "%c%c==" (b0 word) (b1 word)))
     (t ""))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; UUencoding
;;; ----------
;;; These functions are needed for the (RI)PEM encoding.  PGP can
;;; handle binary data, but (RI)PEM requires that it be uuencoded
;;; first, or it will barf severely.  How rude.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun url-uuencode-buffer (&optional buff)
  "UUencode buffer BUFF, with a default of the current buffer."
  (setq buff (or buff (current-buffer)))
  (save-excursion
    (set-buffer buff)
    (url-lazy-message "UUencoding...")
    (call-process-region (point-min) (point-max)
			 url-uuencode-program t t nil "url-temp-file")
    (url-lazy-message "UUencoding... done.")))


(defun url-uudecode-buffer (&optional buff)
  "UUdecode buffer BUFF, with a default of the current buffer."
  (setq buff (or buff (current-buffer)))
  (let ((newname (url-generate-unique-filename)))
    (save-excursion
      (set-buffer buff)
      (goto-char (point-min))
      (re-search-forward "^begin [0-9][0-9][0-9] \\(.*\\)$" nil t)
      (replace-match (concat "begin 600 " newname))
      (url-lazy-message "UUdecoding...")
      (call-process-region (point-min) (point-max) url-uudecode-program)
      (url-lazy-message "UUdecoding...")
      (erase-buffer)
      (insert-file-contents newname)
      (url-lazy-message "UUdecoding... done.")
      (condition-case ()
	  (delete-file newname)
	(error nil)))))
      
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Decoding PGP/PEM responses
;;; --------------------------
;;; A PGP/PEM encrypted/signed response contains all the real headers,
;;; so this is just a quick decrypt-then-reparse hack.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun url-decode-pgp/pem (arg)
  "Decode a pgp/pem response from an HTTP/1.0 server.
This expects the decoded message to contain all the necessary HTTP/1.0 headers
to correctly act on the decoded message (new content-type, etc)."
  (mc-decrypt-message)
  (url-parse-mime-headers))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Basic authorization code
;;; ------------------------
;;; This implements the BASIC authorization type.  See the online
;;; documentation at
;;; http://info.cern.ch/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 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-basic-auth (url &optional prompt overwrite)
  "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."
  (let* ((href (url-grok-http-href url))
	 (server (concat (nth 0 href) ":" (nth 1 href)))
	 (path (nth 2 href))
	 user pass byserv retval)
    (setq byserv (cdr-safe (assoc server url-basic-auth-storage)))
    (if (not byserv)			; Server not found
	(if prompt
	    (progn
	      (setq user (read-string "Username: " (user-real-login-name))
		    pass (funcall url-passwd-entry-func "Password: "))
	      (setq url-basic-auth-storage
		    (cons (list server
				(cons path
				      (setq retval
					    (b64-encode (format "%s:%s"
								user pass)))))
			  url-basic-auth-storage)))
	  (setq retval nil))
      (progn				; Found the server
	(setq retval (cdr-safe (assoc path byserv)))
	(if (not retval)		; No exact match, check directories
	    (while (and byserv (not retval))
	      (cond
	       ((string-match (concat (regexp-quote (car (car byserv)))
				      "/*[^/]+") path)
		(setq retval (cdr (car byserv))))
	       ((string-match (concat (regexp-quote
				       (url-basepath (car (car byserv))))
				      "/*[^/]+") path)
		(setq retval (cdr (car byserv)))))
	      (setq byserv (cdr byserv))))
	(if (or (and (not retval) prompt) overwrite)
	    (progn
	      (setq user (read-string "Username: " (user-real-login-name))
		    pass (funcall url-passwd-entry-func "Password: ")
		    retval (b64-encode (format "%s:%s" user pass))
		    byserv (assoc server url-basic-auth-storage))
	      (setcdr byserv
		      (cons (cons path retval) (cdr byserv)))))))
    retval))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; PGP/PEM Encryption
;;; ------------------
;;; This implements the highly secure PGP/PEM encrypted requests, as
;;; specified by NCSA and CERN.
;;;
;;; The complete online spec of this scheme was done by Tony Sanders
;;; <sanders@bsdi.com>, and can be seen at
;;; http://www.bsdi.com/HTTP:TNG/ripem-http.txt
;;;
;;; This section of code makes use of the EXCELLENT mailcrypt.el
;;; package by Jin S Choi (jsc@mit.edu)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun url-public-key-exists (entity scheme)
  "Return t iff a key for ENTITY exists using public key system SCHEME.
ENTITY is the username/hostname combination we are checking for.
SCHEME is a symbol representing what public key encryption program to use.
       Currently only 'pgp (Pretty Good Privacy) and 'pem (RIPEM) are
       recognized."
  (let (retval)
    (save-excursion
      (cond
       ((eq 'pgp scheme)			; PGP encryption
	(set-buffer (get-buffer-create " *keytmp*"))
	(erase-buffer)
	(call-process mc-pgp-path nil t nil "+batchmode" "-kxaf" entity)
	(goto-char (point-min))
	(setq retval (search-forward mc-pgp-key-begin-line nil t)))
       ((eq 'pem scheme)			; PEM encryption
	(set-buffer (find-file-noselect mc-ripem-pubkeyfile))
	(goto-char (point-min))
	(setq retval (search-forward entity nil t)))
       (t
	(message "Bad value for SCHEME in url-public-key-exists %S" scheme)))
      (kill-buffer (current-buffer)))
    retval))

(defun url-get-server-keys (entity &optional scheme)
  "Make sure the key for ENTITY exists using SCHEME.
ENTITY is the username/hostname combination to get the info for.  
       This should be a string you could pass to 'finger'.
SCHEME is a symbol representing what public key encryption program to use.
       Currently only 'pgp (Pretty Good Privacy) and 'pem (RIPEM) are
       recognized."
  (or scheme (setq scheme mc-default-scheme))
  (save-excursion
    (cond
     ((url-public-key-exists entity scheme) nil)
     (t
      (string-match "\\([^@]+\\)@\\(.*\\)" entity)
      (let ((url-working-buffer " *url-get-keys*"))
	(url-retrieve (format "gopher://%s:79/0%s/w" (url-match entity 1)
			     (url-match entity 2)))
	(mc-snarf-keys)
	(kill-buffer url-working-buffer))))))
   
(defun url-fetch-with-pgp (url recipient type)
  "Retrieve a document with public-key authentication.
      URL is the url to request from the server.
RECIPIENT is the server's entity name (usually webmaster@host)
     TYPE is a symbol representing what public key encryption program to use.
          Currently only 'pgp (Pretty Good Privacy) and 'pem (RIPEM) are
          recognized."
  (or noninteractive (require 'mailcrypt))
  (let ((request (url-create-mime-request url "PGP-Redirect"))
	(url-request-data nil)
	(url-request-extra-headers nil))
    (save-excursion
      (url-get-server-keys recipient type)
      (set-buffer (get-buffer-create " *url-encryption*"))
      (erase-buffer)
      (insert "\n\n" mail-header-separator "\n" request)
      (mc-encrypt-message recipient type)
      (goto-char (point-min))
      (if (re-search-forward (concat "\n" mail-header-separator "\n") nil t)
	  (delete-region (point-min) (point)))
      (setq url-request-data (buffer-string)
	    url-request-extra-headers
	    (list (cons "Authorized" (format "%s entity=\"%s\""
					     (cond
					      ((eq type 'pgp) "PGP")
					      ((eq type 'pem) "PEM"))
					     url-pgp/pem-entity))
		  (cons "Content-type" (format "application/x-www-%s-reply"
					       (cond
						((eq type 'pgp) "pgp")
						((eq type 'pem) "pem")))))))
    (kill-buffer " *url-encryption*")
    (url-retrieve (url-parse-relative-link "/"))))
     

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Gopher and Gopher+ support
;;; --------------------------
;;; Here come a few gross hacks that I call gopher and gopher+ support
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun url-convert-ask-to-form (ask)
  "Convert a Gopher+ ASK block into a form.  Returns a string to be inserted
into a buffer to create the form."
  (let ((form "<FORM METHOD=\"GOPHER-ASK\"><UL PLAIN>")
	(type "")
	(x 0)
	(parms ""))
    (while (string-match "^\\([^:]+\\): +\\(.*\\)" ask)
      (setq parms (url-match ask 2)
	    type (url-strip-leading-spaces (downcase (url-match ask 1)))
	    x (1+ x)
	    ask (substring ask (if (= (length ask) (match-end 0))
				   (match-end 0) (1+ (match-end 0))) nil))
      (cond
       ((string= "note" type) (setq form (concat form parms)))
       ((or (string= "ask" type)
	    (string= "askf" type)
	    (string= "choosef" type))
	(setq parms (url-string-to-tokens parms ?\t)
	      form (format "%s\n<LI>%s<INPUT name=\"%d\" DEFAULT=\"%s\">"
			   form (or (nth 0 parms) "Text:")
			   x (or (nth 1 parms) ""))))
       ((string= "askp" type)
	(setq parms (mapcar 'car (nreverse (url-split parms "\\\t")))
	      form (format
		    "%s\n<LI>%s<INPUT name=\"%d\" TYPE=\"PASSWORD\" DEFAULT=\"%s\">"
		    form			   ; Earlier string
		    (or (nth 0 parms) "Password:") ; Prompt
		    x				   ; Name
		    (or (nth 1 parms) "") 	   ; Default value
		    )))
       ((string= "askl" type)
	(setq parms (url-string-to-tokens parms ?\t)
	      form (format "%s\n<LI>%s<TEXTAREA NAME=\"%d\">%s</TEXTAREA>"
			   form			 ; Earlier string
			   (or (nth 0 parms) "") ; Prompt string
			   x			 ; Name
			   (or (nth 1 parms) "") ; Default value
			   )))
       ((or (string= "select" type)
	    (string= "choose" type))
	(setq parms (url-string-to-tokens parms ?\t)
	      form (format "%s\n<LI>%s<SELECT NAME=\"%d\">" form (car parms) x)
	      parms (cdr parms))
	(if (null parms) (setq parms (list "Yes" "No")))
	(while parms
	  (setq form (concat form "<OPTION>" (car parms) "\n")
		parms (cdr parms)))
	(setq form (concat form "</SELECT>")))))
    (concat form "\n<LI><INPUT TYPE=\"SUBMIT\""
	    " VALUE=\"Submit Gopher+ Ask Block\"></UL></FORM>")))

(defun url-grok-gopher-link (st nd)
  "Return a list of link attributes from a gopher string.  Order is:
title, type, selector string, server, port, gopher-plus?"
  (let (type selector server port gopher+)
    (save-excursion
      (mapcar (function
	       (lambda (var)
		 (goto-char st)
		 (skip-chars-forward "^\t\n" nd)
		 (set-variable var (buffer-substring st (point)))
		 (setq st (1+ (point)))))
	      '(type selector server port))
      (setq gopher+ (and (/= (1- st) nd) (buffer-substring st nd)))
      (list type (concat (substring type 0 1) selector) server port gopher+))))

(defun url-format-gopher-link (gophobj)
  "Insert a gopher link as an <A> tag"
  (let ((title (nth 0 gophobj))
	(ref   (nth 1 gophobj))
	(type  (if (> (length (nth 0 gophobj)) 0)
		   (substring (nth 0 gophobj) 0 1) ""))
	(serv  (nth 2 gophobj))
	(port  (nth 3 gophobj))
	(plus  (nth 4 gophobj))
	(desc  nil))
    (if (and (equal type "")
	     (> (length title) 0))
	(setq type (substring title 0 1)))
    (setq title (and title (substring title 1 nil)))
    (setq desc (or (cdr (assoc type url-gopher-labels)) "(UNK)"))
    (if (fboundp 'w3-insert-graphic)
	(setq desc (cdr (assoc type url-gopher-icons))))
    (cond
     ((null ref) "")
     ((equal type "8")
      (format "<LI> %s <A HREF=\"telnet://%s:%s/%s\">%s</A>\n"
	      desc serv (concat port plus) ref title))
     ((equal type "T")
      (format "<LI> %s <A HREF=\"tn3270://%s:%s/%s\">%s</A>\n"
	      desc serv (concat port plus) ref title))
     (t (format "<LI> %s <A METHODS=%s HREF=\"gopher://%s:%s/%s\">%s</A>\n"
		desc type serv (concat port plus)
		(url-hexify-string ref) title)))))

(defun url-gopher-clean-text (&optional buffer)
  "Clean up text from gopher retrieval"
  (set-buffer (or buffer url-working-buffer))
  (url-replace-regexp "\r$" "")
  (url-replace-regexp "^\\\.\\\n" "")
  (url-replace-regexp "^\\\.\r*$\\\n*" ""))

(defun url-parse-gopher (&optional buffer)
  "Parse out a gopher response"
  (save-excursion
    (url-replace-regexp (regexp-quote "&") "&amp;")
    (url-replace-regexp (regexp-quote ">") "&gt;")
    (url-replace-regexp (regexp-quote "<") "&lt;")
    (url-replace-regexp "\\\n*\\.\\\n*\\'" "\n")
    (goto-char (point-min))
    (while (looking-at "\n") (delete-char 1))
    (let ((objs nil))
      (while (not (eobp))
	(setq objs (cons
		    (url-grok-gopher-link (save-excursion (beginning-of-line)
							 (point))
					 (save-excursion (end-of-line)
							 (point)))
		    objs))
	(forward-line 1))
      (setq objs (nreverse objs))
      (erase-buffer)
      (insert "<title>"
	      (cond
	       ((or (string= "" url-current-file)
		    (string= "1/" url-current-file)
		    (string= "1" url-current-file))
		(concat "Gopher root at " url-current-server))
	       ((string-match (format "^[%s]+/" url-gopher-types)
			      url-current-file)
		(substring url-current-file 2 nil))
	       (t url-current-file))
	      "</title><ol>"
	      (mapconcat 'url-format-gopher-link objs "")
	      "</ol>"))))

(defun url-gopher-retrieve (host port selector &optional wait-for)
  "Fetch a gopher object and don't mess with it at all"
  (let ((proc (url-open-stream "*gopher*" url-working-buffer
			      host (if (stringp port) (string-to-int port)
				     port)))
	(len nil)
	(parsed nil))
    (url-clear-tmp-buffer)
    (setq url-current-file selector
	  url-current-port port
	  url-current-server host
	  url-current-type "gopher")
    (if (> (length selector) 0)
	(setq selector (substring selector 1 nil)))
    (if (stringp proc)
	(message proc)
      (save-excursion
	(process-send-string proc (concat selector "\n"))
	(while (and (or (not wait-for)
			(progn
			  (goto-char (point-min))
			  (not (re-search-forward wait-for nil t))))
		    (memq (url-process-status proc) '(run open)))
	  (if (not parsed)
	      (cond
	       ((and (eq ?+ (char-after 1))
		     (memq (char-after 2)
			   (list ?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9)))
		(setq parsed (copy-marker 2)
		      len (read parsed))
		(delete-region (point-min) parsed))
	       ((and (eq ?+ (char-after 1))
		     (eq ?- (char-after 2)))
		(setq len nil
		      parsed t)
		(goto-char (point-min))
		(delete-region (point-min) (progn
					     (end-of-line)
					     (point))))
	       ((and (eq ?- (char-after 1))
		     (eq ?- (char-after 2)))
		(setq parsed t
		      len nil)
		(goto-char (point-min))
		(delete-region (point-min) (progn
					     (end-of-line)
					     (point))))))
	  (if len (url-lazy-message "Read %d of %d bytes (%d%%)" (point-max) len
				   (/ (* (point-max) 100) len))
	    (url-lazy-message "Read %d bytes." (point-max)))
	  (url-accept-process-output proc))
	(condition-case ()
	    (url-kill-process proc)
	  (error nil))
	(url-replace-regexp "\\\n*Connection closed.*\\\n*" "")
	(url-replace-regexp "\\\n*Process .*gopher.*\\\n*" "")
	(while (looking-at "\r") (delete-char 1))))))

(defun url-do-gopher-cso-search (descr)
  "Do a gopher CSO search and return a plaintext document"
  (let ((host (nth 0 descr))
	(port (nth 1 descr))
	(file (nth 2 descr))
	search-type search-term)
    (string-match "search-by=\\([^&]+\\)" file)
    (setq search-type (url-match file 1))
    (string-match "search-term=\\([^&]+\\)" file)
    (setq search-term (url-match file 1))
    (url-gopher-retrieve host port (format "2query %s=%s"
					  search-type search-term) "^[2-9]")
    (goto-char (point-min))
    (url-replace-regexp "^-[0-9][0-9][0-9]:[0-9]*:" "")
    (url-replace-regexp "^[^15][0-9][0-9]:.*" "")
    (url-replace-regexp "^[15][0-9][0-9]:\\(.*\\)" "<H1>\\1</H1>&ensp;<PRE>")
    (goto-char (point-min))
    (insert "<title>Results of CSO search</title>\n"
	    "<h1>" search-type " = " search-term "</h1>\n")
    (goto-char (point-max))
    (insert "</pre>")))

(defun url-do-gopher (descr)
  "Fetch a gopher object"
  (let ((host (nth 0 descr))
	(port (nth 1 descr))
	(file (nth 2 descr))
	(type (nth 3 descr))
	(extr (nth 4 descr))
	parse-gopher)
    (cond
     ((and				; Gopher CSO search
       (equal type "www/gopher-cso-search")
       (string-match "search-by=" file)) ; With a search term in it
      (url-do-gopher-cso-search descr)
      (setq type "text/html"))
     ((equal type "www/gopher-cso-search") ; Blank CSO search
      (url-clear-tmp-buffer)
      (insert "<title> CSO SEARCH </title>\n"
	      "<h1> This is a CSO search </h1>\n"
	      "<hr>\n"
	      "<form><li> Search by: <select name=\"search-by\">\n"
	      "<option>Name<option>Phone<option>Email<option>Address"
	      "</select>\n<li> Search for: <input name=\"search-term\">\n"
	      "<li>&ensp;<input type=\"submit\" value=\"Submit query\">\n"
	      "</ul></form><hr>")
      (setq type "text/html"
	    parse-gopher t))
     ((and
       (equal type "www/gopher-search")	; Ack!  Mosaic-style search href
       (string-match "\\\t" file))	; and its got a search term in it!
      (url-gopher-retrieve host port file)
      (setq type "www/gopher"
	    parse-gopher t))
     ((and
       (equal type "www/gopher-search")	; Ack!  Mosaic-style search href
       (string-match "\\?" file))	; and its got a search term in it!
      (setq file (concat (substring file 0 (match-beginning 0)) "\t"
			 (substring file (match-end 0) nil)))
      (url-gopher-retrieve host port file)
      (setq type "www/gopher"
	    parse-gopher t))
     ((equal type "www/gopher-search")	; Ack!  Mosaic-style search href
      (setq type "text/html"
	    parse-gopher t)
      (url-clear-tmp-buffer)
      (insert "<title>Gopher Server</title>\n"
	      "<h1>Searchable Gopher Index</h1>"
	      "<hr>Enter the search keywords below<p>"
	      "<form><input name=\"internal-gopher\">&ensp;</form><hr>"))
     ((null extr)			; Normal Gopher link
      (url-gopher-retrieve host port file)
      (setq parse-gopher t))
     ((eq extr 'gopher+)		; A gopher+ link
      (url-gopher-retrieve host port (concat file "\t+"))
      (setq parse-gopher t))
     ((eq extr 'ask-block)		; A gopher+ interactive query
      (url-gopher-retrieve host port (concat file "\t!")) ; Fetch the info
      (goto-char (point-min))
      (cond
       ((re-search-forward "^\\+ASK:[ \\\t\\\r]*" nil t) ; There is an ASK
	(let ((x (buffer-substring (1+ (point))
				   (or (re-search-forward "^\\+[^:]+:" nil t)
				       (point-max)))))
	  (erase-buffer)
	  (insert (url-convert-ask-to-form x))
	  (setq type "text/html" parse-gopher t)))
       (t (setq parse-gopher t)))))
    (if (or (equal type "www/gopher")
	    (equal type "text/plain")
	    (equal file "")
	    (equal type "text/html"))
	(url-gopher-clean-text))
    (if (and parse-gopher (or (equal type "www/gopher")
			      (equal file "")))
	(progn
	  (url-parse-gopher)
	  (setq type "text/html"
		url-current-mime-viewer (mm-mime-info type nil 5))))
    (setq url-current-mime-type (or type "text/plain")
	  url-current-mime-viewer (mm-mime-info type nil 5)
	  url-current-file file
	  url-current-port port
	  url-current-server host
	  url-current-type "gopher")))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; WAIS support
;;; ------------
;;; Here are even more gross hacks that I call native WAIS support.
;;; This code requires a working waisq program that is fully
;;; compatible with waisq from think.com
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun url-create-wais-source (server port dbase)
  "Create a temporary wais source description file.
Returns the file name the description is in."
  (let ((x (url-generate-unique-filename))
	(y (get-buffer-create " *waisq-tmp*")))
    (save-excursion
      (set-buffer y)
      (erase-buffer)
      (insert 
       (format "(:source\n:version 3\n:ip-name \"%s\"\n:tcp-port %s\n:database-name \"%s\"\n)" server port dbase))
      (write-region (point-min) (point-max) x nil nil)
      (kill-buffer y))
    x))

(defun url-wais-stringtoany (str)
  "Return a wais subelement that specifies STR in any database"
  (concat "(:any :size " (length str) " :bytes #( "
	  (mapconcat 'identity str " ")
	  " ) )"))

;(defun url-retrieve-wais-docid (server port dbase local-id)
;  (call-process "waisretrieve" nil url-working-buffer nil
;		(format "%s:%s@%s:%s" (url-unhex-string local-id)
;			dbase server port)))

;(url-retrieve-wais-docid "quake.think.com" "210" "directory-of-servers"
;			"0 2608 /proj/wais/wais-sources/vpiej-l.src")
(defun url-retrieve-wais-docid (server port dbase local-id)
  "Retrieve a wais document.
SERVER is the server the database is on (:ip-name in source description)
PORT is the port number to contact (:tcp-port in the source description)
DBASE is the database name (:database-name in the source description)
LOCAL-ID is the document (:original-local-id in the question description)"
  (let* ((dbf (url-create-wais-source server port dbase))
	 (qstr (format
		(concat "(:question :version 2\n"
			"           :result-documents\n"
			"           ( (:document-id\n"
			"              :document\n"
			"              (:document\n"
			"               :doc-id\n"
			"               (:doc-id :original-database %s\n"
			"                :original-local-id %s )\n"
			"               :number-of-bytes -1\n"
			"               :type \"\"\n"
			"               :source\n"
			"               (:source-id :filename \"%s\") ) ) ) )")
		(url-wais-stringtoany dbase)
		(url-wais-stringtoany (url-unhex-string local-id))
		dbf))
	 (qf (url-generate-unique-filename)))
    (set-buffer (get-buffer-create url-working-buffer))
    (insert qstr)
    (write-region (point-min) (point-max) qf nil nil)
    (erase-buffer)
    (call-process url-waisq-prog nil url-working-buffer nil "-f" qf "-v" "1")
    (condition-case ()
	(delete-file dbf)
      (error nil))
    (condition-case ()
	(delete-file qf)
      (error nil))))

;(url-perform-wais-query "quake.think.com" "210" "directory-of-servers" "SGML")
(defun url-perform-wais-query (server port dbase search)
  "Perform a wais query.
SERVER is the server the database is on (:ip-name in source description)
PORT is the port number to contact (:tcp-port in the source description)
DBASE is the database name (:database-name in the source description)
SEARCH is the search term (:seed-words in the question description)"
  (let ((dbfname (url-create-wais-source server port dbase))
	(qfname (url-generate-unique-filename))
	(results 'url-none-gotten))
    (save-excursion
      (url-clear-tmp-buffer)
      (insert
       (format
	(concat "(:question\n"
		" :version 2\n"
		" :seed-words \"%s\"\n"
		" :sourcepath \"" url-temporary-directory "\"\n"
		" :sources\n"
		" (  (:source-id\n"
		"     :filename \"%s\"\n"
		"    )\n"
		" )\n"
		" :maximum-results 100)\n")
	search dbfname))
      (write-region (point-min) (point-max) qfname nil nil)
      (erase-buffer)
      (call-process url-waisq-prog nil url-working-buffer nil "-g" "-f" qfname)
      (set-buffer url-working-buffer)
      (erase-buffer)
      (setq url-current-server server
	    url-current-port port
	    url-current-file dbase)
      (insert-file-contents qfname)
      (goto-char (point-min))
      (if (re-search-forward "(:question" nil t)
	  (delete-region (point-min) (match-beginning 0)))
      (url-replace-regexp "Process.*finished.*" "")
      (subst-char-in-region (point-min) (point-max) 35 32)
      (goto-char (point-min))
      (message "Done reading info - parsing results...")
      (if (re-search-forward ":result-documents[^(]+" nil t)
	  (progn
	    (goto-char (match-end 0))
	    (while (eq results 'url-none-gotten)
	      (condition-case ()
		  (setq results (read (current-buffer)))
		(error (progn
			 (setq results 'url-none-gotten)
			 (goto-char (match-end 0))))))
	    (erase-buffer)
	    (insert "<title>Results of WAIS search</title>\n"
		    "<h1>Searched " dbase " for " search "</h1>\n"
		    "<hr>\n"
		    "Found <b>" (int-to-string (length results))
		    "</b> matches.\n"
		    "<ol>\n<li>"
		    (mapconcat 'url-parse-wais-doc-id results "\n<li>")
		    "\n</ol>\n<hr>\n"))
	(message "No results"))
      (setq url-current-mime-type "text/html")
      (condition-case ()
	  (delete-file qfname)
	(error nil))
      (condition-case ()
	  (delete-file dbfname)
	(error nil)))))

(defun url-wais-anytostring (x)
  "Convert a (:any ....) wais construct back into a string."
  (mapconcat 'char-to-string (car (cdr (memq ':bytes x))) ""))

(defun url-parse-wais-doc-id (x)
  "Return a list item that points at the doc-id specified by X"
  (let* ((document (car (cdr (memq ':document x))))
	 (doc-id (car (cdr (memq ':doc-id document))))
	 (score (car (cdr (memq ':score x)))) 
	 (title (car (cdr (memq ':headline document))))
	 (type (car (cdr (memq ':type document))))
	 (size (car (cdr (memq ':number-of-bytes document))))
	 (server (car (cdr (memq ':original-server doc-id))))
	 (dbase (car (cdr (memq ':original-database doc-id))))
	 (localid (car (cdr (memq ':original-local-id doc-id))))
	 (dist-server (car (cdr (memq ':distributor-server doc-id))))
	 (dist-dbase (car (cdr (memq ':distributor-database doc-id))))
	 (dist-id (car (cdr (memq ':distributor-local-id doc-id))))
	 (copyright (or (car (cdr (memq ':copyright-disposition doc-id))) 0)))
    (format "<a href=\"wais://%s:%s/%s/%s/%d/1=%s;2=%s;3=%s;4=%s;5=%s;6=%s;7=%d;\">%s (Score = %s)</a>"
	    url-current-server url-current-port url-current-file
	    type size
	    (url-hexify-string (url-wais-anytostring server))
	    (url-hexify-string (url-wais-anytostring dbase))
	    (url-hexify-string (url-wais-anytostring localid))
	    (url-hexify-string (url-wais-anytostring dist-server))
	    (url-hexify-string (url-wais-anytostring dist-dbase))
	    (url-hexify-string (url-wais-anytostring dist-id))
	    copyright title score)))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Grokking different types of URLs
;;; --------------------------------
;;; Different functions for parsing out URLs, based on the type of
;;; link (http/wais/etc).  These must be passed a fully qualified URL.
;;; All the functions do their best to handle bad/ugly URLs, but
;;; nothing is perfect.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun url-grok-solo-href (url)
  "Return a list of server, port, and SOLO query"
  (cond
   ((string-match "solo:[^/]" url)
    (list "champagne.inria.fr" "2222"
	  (url-unhex-string (substring url 5 nil))))
   ((string-match "solo:/*\\([^:/]+\\)[:/]*\\([0-9]*\\)/\\(.*\\)" url)
    (list (url-match url 1)
	  (if (= (match-beginning 2) (match-end 2)) "2222" (url-match url 2))
	  (url-unhex-string (url-match url 3))))
   (t (list "champagne.inria.fr" "2222" ""))))
      
(defun url-grok-wais-href (url)
  "Return a list of server, port, database, search-term, doc-id"
  (string-match "wais:/+\\([^/:]+\\):*\\([^/]*\\)/+\\(.*\\)" url)
  (let ((host (url-match url 1))
	(port (url-match url 2))
	(data (url-match url 3)))
    (list host port data)))

(defun url-grok-http-href (url)
  "Return a list of server, port, file, dest from URL"
  (let ((x url-current-server)
	(y url-current-port))
    (if (string-match "http:/\\([^/].*\\)" url)	; Weird URL
	(setq url (format "http://%s:%s/%s"
			  x y (substring url
					 (match-beginning 1)
					 (match-end 1)))))
    (if (string-match "http:\\([^/].*\\)" url)	; Another weird URL
	(setq url (url-parse-relative-link (url-match url 1))))
    (string-match "http:+/*\\([^:/]*\\):*\\([^/]*\\)/*\\(/.*\\)" url)
    (let* ((server (url-match url 1))
	   (port   (url-match url 2))
	   (file   (url-match url 3))
	   (dest   (if (string-match "#.+$" file)
		       (prog1
			   (substring file (1+ (match-beginning 0))
				      (match-end 0))
			 (setq file (substring file 0 (match-beginning 0))))
		     nil)))
      (if (and (string= server "")
	       (string= port ""))
	  (progn
	    (string-match "/*\\([^:]+\\):*\\([0-9]*\\)" file)
	    (setq server (url-match file 1)
		  port (url-match file 2)
		  file "/")))
      (if (string= port "")
	  (setq port "80"))
      (and url-using-proxy
	   (= ?/ (string-to-char file))
	   (setq file (substring file 1 nil)))
      (list server port file dest))))

(defun url-grok-file-href (url)
  "Return a list of username, server, file, destination out of URL"
  (let (user server file dest pswd)
    (cond
     ((and (string-match "//" url)	; Remote file
	   (not (file-exists-p (substring url (match-end 0)))))
      (string-match "^\\(file\\|ftp\\)://*\\([^/]*\\)/*\\(/.*\\)" url)
      (setq server (url-match url 2)
	    file (url-match url 3)
	    user "anonymous"
	    dest (if (string-match "#.+$" file)
		     (prog1
			 (substring file (1+ (match-beginning 0))
				    (match-end 0))
		       (setq file (substring file 0 (match-beginning 0))))
		   nil))
      (if (string= "" server)
	  (setq server (if (= (string-to-char file) ?/) (substring file 1 nil)
			 file)
		file "/"))
      (if (string-match "@" server)
	  (setq user (substring server 0 (match-beginning 0))
		server (substring server (1+ (match-beginning 0)) nil)))
      (if (string-match ":" server)
	  (setq server (substring server 0 (match-beginning 0))))
      (if (equal server "localhost")
	  (setq server nil))
      (if (string-match "\\(.*\\):\\(.*\\)" user)
	  (setq user (url-match user 1)
		pswd (url-match user 2)))
      (cond
       ((null pswd) nil)
       ((fboundp 'ange-ftp-set-passwd)
	(ange-ftp-set-passwd server user pswd))
       ((fboundp 'efs-set-passwd)
	(efs-set-passwd server user pswd))))
     (t
      (setq dest (if (string-match "#\\(.+\\)$" url)
		     (prog1
			 (url-match url 1)
		       (setq url (substring url 0 (match-beginning 0))))
		   nil)
	    file url)
      (if (string-match "file:\\(.*\\)" file)
	  (setq file (url-match file 1)))))
    (setq file (expand-file-name file (url-basepath url-current-file)))
    (list user server file dest)))

(defun url-grok-news-href (url)
  "Parse out a news url"
  (string-match "news:/*\\([^/:]*\\):*\\([0-9]*\\)/*\\([^/]*\\)" url)
  (let (
	(host (substring url (match-beginning 1) (match-end 1)))
	(port (substring url (match-beginning 2) (match-end 2)))
	(art  (substring url (match-beginning 3) (match-end 3))))
    (if (equal port "") (setq port "119"))
    (if (equal host "") (setq host url-news-server))
    (if (equal art "") (setq art host
			     host url-news-server))
    (if (null host) (setq host art art ""))
    (list host port art)))

(defun url-grok-gopher-href (url)
  "Return a list of attributes from a gopher url.  List is of the
type: host port selector-string MIME-type extra-info"
  (let (host				; host name
	port				; Port #
	selector			; String to send to gopher host
	type				; MIME type
	extra				; Extra information
	x				; Temporary storage for host/port
	y				; Temporary storage for selector
	)
    (or (string-match "gopher:/*\\([^/]+\\)/*\\(.*\\)" url)
	(error "Can't understand url %s" url))
    (setq x (url-match url 1)		; The host (and possible port #)
	  y (url-unhex-string
	     (url-match url 2)))		; The selector (and possible type)

    ;First take care of the host/port/gopher+ information from the url
    ;A + after the port # (host:70+) specifies a gopher+ link
    ;A ? after the port # (host:70?) specifies a gopher+ ask block
    (if (string-match "^\\([^:]+\\):\\([0-9]+\\)\\([?+]*\\)" x)
	(setq host (url-match x 1)
	      port (url-match x 2)
	      extra (url-match x 3))
      (setq host x
	    port "70"
	    extra nil))
    (cond
     ((equal extra "")  (setq extra nil))
     ((equal extra "?") (setq extra 'ask-block))
     ((equal extra "+") (setq extra 'gopher+)))

    ; Next, get the type/get rid of the Mosaic double-typing. Argh.
    (setq x (string-to-char y)		; Get gopher type
	  selector (if (or url-use-hypertext-gopher
			   (< 3 (length y)))
		       y		; Get the selector string
		     (substring y 1 nil))
	  type (cdr (assoc x url-gopher-to-mime)))
    (list host port (or selector "") type extra)))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Parsing/updating the user's .newsrc file
;;; ----------------------------------------
;;; Large parts of this code are based on the newsrc parsing of the
;;; lucid emacs version of GNUS, and is very fast and efficient.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun url-parse-newsrc (&optional newsrc-file)
  "Parse out a newsrc.  This was largely yanked out of gnus"
  (save-excursion
    (setq newsrc-file (or newsrc-file (expand-file-name
				       (concat "~/.newsrc" url-news-server))))
    (if (and (file-exists-p newsrc-file)
	     (file-readable-p newsrc-file))
	(message "Using newsrc file %s... " newsrc-file)
      (setq newsrc-file (expand-file-name "~/.newsrc")))
    (or (file-exists-p newsrc-file)
	(file-readable-p newsrc-file)
	(error "%s could not be read." newsrc-file))
    (set-buffer (get-buffer-create " *newsrc*"))
    (erase-buffer)
    (insert-file-contents newsrc-file)
    (url-replace-regexp "^[ \\\t]options.*\\\n" "")
    (let ((subscribe nil)
	  (read-list nil)
	  newsgroup
	  p p2)
      (save-restriction
	(while (not (eobp))
	  (cond
	   ((= (following-char) ?\n)
	    ;; skip blank lines
	    nil)
	   (t
	    (setq p (point))
	    (skip-chars-forward "^:!\n")
	    (if (= (following-char) ?\n)
		(error "unparsable line in %s" (buffer-name)))
	    (setq p2 (point))
	    (skip-chars-backward " \t")

	    ;; #### note: we could avoid consing a string here by
	    ;; binding obarray and reading the newsgroup directly into
	    ;; the gnus-newsrc-hashtb, then setq'ing newsgroup to
	    ;; symbol-name of that, like we do in
	    ;; gnus-active-to-gnus-format.

	    (setq newsgroup (read (buffer-substring p (point))))
	    (goto-char p2)

	    (setq subscribe (= (following-char) ?:))
	    (setq read-list nil)

	    (forward-char 1)		; after : or !
	    (skip-chars-forward " \t")
	    (while (not (= (following-char) ?\n))
	      (skip-chars-forward " \t")
	      (or
	       (and (cond
		     ((looking-at "\\([0-9]+\\)-\\([0-9]+\\)") ; a range
		      (setq read-list
			    (cons
			     (cons
			      (progn
				;; faster that buffer-substring/string-to-int
				(narrow-to-region (point-min) (match-end 1))
				(read (current-buffer)))
			      (progn
				(narrow-to-region (point-min) (match-end 2))
				(forward-char) ; skip over "-"
				(prog1
				    (read (current-buffer))
				  (widen))))
			     read-list))
		      t)
		     ((looking-at "[0-9]+")
		      ;; faster that buffer-substring/string-to-int
		      (narrow-to-region (point-min) (match-end 0))
		      (setq p (read (current-buffer)))
		      (widen)
		      (setq read-list (cons (cons p p) read-list))
		      t)
		     (t
		      ;; bogus chars in ranges
		      nil))
		    (progn
		      (goto-char (match-end 0))
		      (skip-chars-forward " \t")
		      (cond ((= (following-char) ?,)
			     (forward-char 1)
			     t)
			    ((= (following-char) ?\n)
			     t)
			    (t
			     ;; bogus char after range
			     nil))))
	       ;; if we get here, the parse failed
	       (progn
		 (end-of-line)		; give up on this line
		 (ding)
		 (message "Ignoring bogus line for %s in %s"
			  newsgroup (buffer-name))
		 (sleep-for 1)
		 )))
	    (put 'url-newsrc newsgroup (cons subscribe (nreverse read-list)))))
	  (forward-line 1))))
    (kill-buffer (current-buffer))
    (put 'url-newsrc 'parsed t)))

(defun url-save-newsrc (&optional fname)
  "Save the newsrc of the user"
  (set-buffer (get-buffer-create " *newsrc*"))
  (erase-buffer)
  (insert-file-contents (or fname (expand-file-name "~/.newsrc")))
  (goto-char (point-min))
  (delete-non-matching-lines "^[ \\\t]options")	; preserve option lines
  (goto-char (point-max))
  (let ((grps (symbol-plist 'url-newsrc)) grp info)
    (while grps
      (setq grp (car grps)
	    info (car (cdr grps))
	    grps (cdr (cdr grps)))
      (if (eq grp 'parsed)
	  nil
	(insert (symbol-name grp) (if (car info) ": " "! ")
		(mapconcat
		 (function
		  (lambda (range)
		    (cond
		     ((consp range) (concat (car range) "-" (cdr range)))
		     ((numberp range) range)))) (cdr info) ",") "\n")))))
		     
(defun url-retrieve-newsgroup (group &optional show-all howmany)
  "Select newsgroup NEWSGROUP and return a list of headers of the remaining
articles"
  (or (get 'url-newsrc 'parsed) (url-parse-newsrc))
  (if (symbolp group) (setq group (symbol-name group)))
  (let ((stat
	 (cond
	  ((string-match "flee" nntp-version)
	   (nntp/command "GROUP" group)
	   (save-excursion
	     (set-buffer nntp-server-buffer)
	     (while (progn
		      (goto-char (point-min))
		      (not (re-search-forward
			    "[0-9]+[ \\\t]+[0-9]+[ \\\t]+\\([0-9]+\\)[ \\\t]+\\([0-9]+\\)" nil t)))
	       (url-accept-process-output nntp/connection))
	     (cons (string-to-int
		    (buffer-substring (match-beginning 1) (match-end 1)))
		   (string-to-int
		    (buffer-substring (match-beginning 2) (match-end 2))))))
	  (t
	   (nntp-request-group group)
	   (let ((msg (nntp-status-message)))
	     (string-match "[0-9]+[ \\\t]+\\([0-9]+\\)[ \\\t]+\\([0-9]+\\)"
			   msg)
	     (cons (string-to-int (url-match msg 1))
		   (string-to-int (url-match msg 2)))))))
	(info (cdr (get 'url-newsrc (read group))))
	(seqs '())
	(temp nil)
	(last nil)			; last unread article
	)
    (setq last (car stat))
    (url-lazy-message "Finding unread articles...")
    (if show-all
	(setq seqs (url-make-sequence (car stat) (cdr stat)))
      (while info
	(setq temp (car info)
	      info (cdr info))
	(cond
	 ((consp temp)			; a range of articles
	  (setq seqs (nconc seqs (url-make-sequence last (1- (car temp))))
		last (1+ (cdr temp))))
	 ((numberp temp)
	  (setq seqs (nconc seqs (url-make-sequence last (1- temp)))
		last (1+ temp))))))
    (setq seqs (nconc seqs (url-make-sequence last (cdr stat))))
    (if howmany (length seqs)
      (nntp-retrieve-headers seqs))))


(defun url-get-new-newsgroups (&optional tm)
  "Get a string suitable for an NTTP server to get a list of new newsgroups.
Optional argument TM is a list of three integers. The first has the
most significant 16 bits of the seconds, while the second has the
least significant 16 bits.  The third integer gives the microsecond
count.  (The format returned either by (current-time) or file-attributes
mod-time, etc.)"
  (let* ((x (current-time-string tm))
	 (y (cdr (assoc (substring x 4 7) monthabbrev-alist)))
	 (z (substring x 9 10)))
    (concat "NEWGROUPS "
	    (substring x -2 nil)
	    (if (< y 10) "0" "")
	    y
	    (if (= (length z) 2) "" "0")
	    z " "
	    (substring x 11 13)
	    (substring x 14 16)
	    (substring x 17 19))))
	  
(defun url-format-news ()
  "Format a news buffer in html"
  (url-clear-tmp-buffer)
  (insert "HTTP/1.0 200 Retrieval OK\r\n"
	  (save-excursion
	    (set-buffer nntp-server-buffer)
	    (buffer-string)))
  (url-parse-mime-headers)
  (let ((from  (cdr (assoc "from" url-current-mime-headers)))
	(subj  (cdr (assoc "subject" url-current-mime-headers)))
	(org   (cdr (assoc "organization" url-current-mime-headers)))
	(typ   (or (cdr (assoc "content-type" url-current-mime-headers))
		   "text/plain"))
	(grps  (mapcar 'car
		       (url-split
			(cdr (assoc "newsgroups" url-current-mime-headers))
			"[ \\\t\\\n,]+")))
	(refs  (mapcar 'car
		       (url-split
			(or (cdr (assoc "references" url-current-mime-headers))
			    "")
			"[ \\\t,\\\n<>]+")))
	(date  (cdr (assoc "date" url-current-mime-headers))))
    (setq url-current-file ""
	  url-current-type "")
    (if (not (string-match "text/" typ))
	nil				; Let natural content-type take over
      (insert "<htmlplus>\n"
	      " <head>\n"
	      "  <title>" subj "</title>\n"
	      "  <link rev=\"made\" href=\"mailto:" from "\">\n"
	      " </head>\n"
	      " <body>\n"
	      "  <div1>\n"
	      "   <h1>" subj "</h1>\n"
	      "   <p role=\"headers\">\n"
	      "    <b>From</b>: <address> " from "</address><br>\n"
	      "    <b>Newsgroups</b>: "
	      (mapconcat
	       (function
		(lambda (grp)
		  (concat "<a href=\"" grp "\"> " grp "</a>"))) grps ", ")
	      "<br>\n"
	      "    <b>Organization</b>: <i> " org "</i> <br>\n"
	      "    <b>Date</b>: <date> " date "</date> <br>\n"
	      "   </p> <hr>\n"
	      (if (null refs)
		  ""
		(concat
		 "   <p align=\"center\">References\n"
		 "    <ol>\n"
		 (mapconcat
		  (function
		   (lambda (ref)
		     (concat "     <li> <a href=\"" ref "\"> " 
			     ref "</a></li>\n")))
		  refs "")
		 "    </ol>\n"
		 "   <hr>\n"))
	      "   <ul plain>\n"
	      "    <li><a href=\"newspost:disfunctional\"> "
	      "Post to this group </a></li>\n"
	      "    <li><a href=\"mailto:" from "\"> Reply to " from
	      "</a></li>\n"
	      "   </ul>\n"
	      "   <hr>"
	      "   <xmp>\n")
      (goto-char (point-max))
      (setq url-current-mime-type "text/html"
	    url-current-mime-viewer (mm-mime-info url-current-mime-type nil 5))
      (let ((x (assoc "content-type" url-current-mime-headers)))
	(if x
	    (setcdr x "text/html")
	  (setq url-current-mime-headers (cons (cons "content-type"
						     "text/html")
					       url-current-mime-headers))))
      (insert "\n"
	      "   </xmp>\n"
	      "  </div1>\n"
	      " </body>\n"
	      "</htmlplus>\n"
	      "<!-- Automatically generated by URL/" url-version
	      "-->"))))

(defun url-format-whole-newsgroup (newsgroup header-list)
  (url-clear-tmp-buffer)
  (insert "<htmlplus>\n"
	  " <head>\n"
	  "  <title>" newsgroup "</title>\n"
	  " </head>\n"
	  " <body>\n"
	  "  <div1>\n"
	  "   <h1>" newsgroup "</h1>\n"
	  "   <ol>\n"
	  (mapconcat
	   (function
	    (lambda (artcl)
	      (let ((id (nntp-header-id artcl))
		    (subj (nntp-header-subject artcl))
		    (from (nntp-header-from artcl)))
		(if (string-match "<\\(.*\\)>" id)
		    (setq id (url-match id 1)))
		(concat "    <li> <a href=\"" id "\"> " subj "</a> <br>\n"
			"         " from " </li>\n")))) header-list "")
	  "   </ol>\n"
	  "  </div1>\n"
	  " </body>\n"
	  "</htmlplus>\n"
	  "<!-- Automatically generated by URL/" url-version
	  "-->"))

(defun url-show-all-newsgroups ()
  "Show a hypertext list of all newsgroups."
  (or (get 'url-newsrc 'parsed) (url-parse-newsrc))
  (let ((grps (symbol-plist 'url-newsrc))
	grp info)
    (insert "<htmlplus>\n"
	    " <head>\n"
	    "  <title> Newsgroups </title>\n"
	    " </head>\n"
	    " <body>\n"
	    "  <div1>\n"
	    "   <h1> Newsgroup listing </h1>\n"
	    "   <pre>\n")
    (while grps
      (setq grp (symbol-name (car grps))
	    info (car (cdr grps))
	    grps (cdr (cdr grps)))
      (if (eq grp 'parsed)
	  nil
	(insert (format "    <a href=\"%s\">%7d%s %s" grp
			(url-retrieve-newsgroup grp nil t)
			(if (car info) ": " "! ") grp))))
    (insert "   </pre>\n"
	    "  </div1>\n"
	    " </body>\n"
	    "</htmlplus>\n"
	    "<!-- Automatically generated by URL/" url-version
	    "-->")))    

(defun url-news-generate-reply-form (to newsgroups body &rest refs)
  "Generate an HTML reply form."
  (set-buffer (get-buffer-create url-working-buffer))
  (erase-buffer)
  (insert "<htmlplus>\n"
	  " <head>\n"
	  "  <title>News Post/Reply Form</title>\n"
	  "  <!-- Automatically generated by emacs-w3 -->\n"
	  " </head>\n"
	  " <body>\n"
	  "  <div1>\n"
	  "   <h1>News Post/Reply Form</h1>\n"
	  "   <hr>\n"
	  "   <form method=\"GET\" action=\"news-internal://\">\n"
	  "    <ul>\n"
	  "     <li> Reply by:"
	  "<select name=\"replyby\"><option>Mail<option>News</select></li>\n"
	  "     <li> Email: <input name=\"addr\" default=\"" to "\"></li>\n"
	  "     <li> Newsgroups: <input name=\"newsg\" default=\""
	  newsgroups "\"></li>\n"
	  "     <li> <input type=\"checkbox\" name=\"include\">"
	  "Include/quote article in followup</li>\n"
	  "    </ul>\n"
	  "    <hr>\n"
	  "    <textarea \"name=body\">\n" body "\n</textarea>\n"
	  "    <hr>\n"
	  "    <input type=\"submit\" value=\"Send it\">\n"
	  "    <br>\n"
	  "    <input type=\"reset\"  value=\"Reset to default values\">\n"
	  "   </form>\n"
	  "  </div1>\n"
	  " </body>\n"
	  "</htmlplus>\n"))	    

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Support for the different types of urls
;;; ---------------------------------------
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun url-wais (url)
  "Retrieve a document via WAIS"
  (if (and url-wais-gateway-server url-wais-gateway-port)
      (url-retrieve
       (format "http://%s:%s/%s"
	       url-wais-gateway-server
	       url-wais-gateway-port
	       (substring url (match-end 0) nil)))
    (let ((href (url-grok-wais-href url)))
      (url-clear-tmp-buffer)
      (setq url-current-type "wais"
	    url-current-server (nth 0 href)
	    url-current-port (nth 1 href)
	    url-current-file (nth 2 href))
      (cond
       ((string-match "\\([^/]+\\)/.*3=\\([^ ;]+\\)" (nth 2 href)); full link
	(url-retrieve-wais-docid (nth 0 href) (nth 1 href)
				(url-match (nth 2 href) 1)
				(url-match (nth 2 href) 2)))
       ((string-match "\\([^\\?]+\\)\\?\\(.*\\)" (nth 2 href)) ; stored query
	(url-perform-wais-query (nth 0 href) (nth 1 href)
			       (url-match (nth 2 href) 1)
			       (url-match (nth 2 href) 2)))
       (t
	(insert "<title>WAIS search</title>\n"
		"<h1>WAIS search of " (nth 2 href) "</h1>"
		"<hr>\n"
		"<form>\n"
		"Enter search term: <input name=\"internal-wais\">\n"
		"</form>\n"
		"<hr>\n"))))))

(defun url-http (url)
  "Retrieve URL via http.  If SOURCE is non-nil, then don't parse the buffer."
  (let ((href (url-grok-http-href url))
	(ref-url (url-view-url t)))
    (url-clear-tmp-buffer)
    (setq url-current-type "http")
    (let* ((server (nth 0 href))
	   (port   (nth 1 href))
	   (file   (nth 2 href))
	   (dest   (nth 3 href))
	   (request (url-create-mime-request file ref-url)))
      (if (or (not (url-member port url-bad-port-list))
	      (funcall url-confirmation-func
		       (format
			"Warning!  Trying to connect to port %s - continue? "
			port)))
	  (progn
	    (if (equal port "") (setq port "80"))
	    (if (equal file "") (setq file "/") )
	    (setq url-current-server server
		  url-current-port port
		  url-current-file file
		  url-find-this-link dest)
	    (url-lazy-message "Fetching: %s %s %s" server port file)
	    (let ((process
		   (url-open-stream "WWW" url-working-buffer server
				   (string-to-int port))))
	      (if (stringp process)
		  (progn
		    (set-buffer url-working-buffer)
		    (erase-buffer)
		    (setq url-current-mime-type "text/html"
			  url-current-mime-viewer 
			  (mm-mime-info "text/html" nil 5))
		    (insert "<title>ERROR</title>\n"
			    "<h1>ERROR - Could not establish connection</h1>"
			    "<p>"
			    "The browser could not establish a connection "
			    (format "to %s:%s.<P>" server port)
			    "The server is either down, or the URL"
			    (format "(%s) is malformed.<p>" (url-view-url t)))
		    (message process))
		(progn
		  (process-kill-without-query process)
		  (process-send-string process request)
		  (if (and url-show-http2-transfer
			   (boundp 'after-change-functions))
		      (add-hook 'after-change-functions
				'url-after-change-function))
		  (if url-be-asynchronous
		      (progn
			(set-process-sentinel process 'url-sentinel)
			(if (eq url-gateway-method 'host)
			    (set-process-filter process 'url-filter)))
		    (save-excursion
		      (set-buffer url-working-buffer)
		      (while (memq (url-process-status process) '(run open))
			(if (boundp 'after-change-functions)
			    nil
			  (url-after-change-function nil))
			(url-accept-process-output process))
		      (condition-case ()
			  (url-kill-process process)
			(error nil))))
		  (if (boundp 'after-change-functions)
		      (remove-hook 'after-change-functions
				   'url-after-change-function))))))
	(progn
	  (ding)
	  (message "Aborting connection to bad port..."))))))

(defun url-file (url)
  "Find a link to an ftp site - simple transformation to ange-ftp format"
  (let* ((href (url-grok-file-href url))
	 (user (nth 0 href))
	 (site (nth 1 href))
	 (file (nth 2 href))
	 (dest (nth 3 href)))
    (url-clear-tmp-buffer)
    (cond
     (site
      (let ((filename (concat "/" user "@" site ":" file)))
	(cond
	 ((file-directory-p filename)
	  (if url-use-hypertext-dired
	      (progn
		(setq url-current-type "ftp"
		      url-find-this-link dest
		      url-current-user user
		      url-current-server site
		      url-current-file (format
				       "%s%s" file
				       (if (equal "/"
						  (substring file -1 nil))
					   "" "/")))
		(url-format-directory filename))
	    (progn
	      (if (get-buffer url-working-buffer)
		  (kill-buffer url-working-buffer))
	      (find-file filename))))
	 (t
	  (set-buffer (get-buffer-create url-working-buffer))
	  (setq url-current-type "ftp"
		url-current-user user
		url-current-server site
		url-current-file file)
	  (condition-case ()
	      (insert-file-contents filename nil)
	    (error (url-retrieve (concat "www://error/nofile/" filename))))))))
     (t
      (setq file (expand-file-name (if (string-match "file:" file)
				       (substring file (match-end 0) nil)
				     file))
	    url-current-type nil
	    url-find-this-link dest
	    url-current-file file)
      (cond
       ((file-directory-p file)
	(cond
	 (url-use-hypertext-dired
	  (url-format-directory file)
	  (setq url-current-file (format
				 "%s%s" file
				 (if (equal "/"
					    (substring file -1 nil))
				     "" "/"))))
	 (t
	  (if (get-buffer url-working-buffer)
	      (kill-buffer url-working-buffer))
	  (find-file file))))
       (t
	(let ((viewer (mm-mime-info
		       (mm-extension-to-mime (url-file-extension file)))))
	  (cond
	   ((or url-source		; Need it in a buffer
		(symbolp viewer)
		(listp viewer))
	    (condition-case ()
		(insert-file-contents file)
	      (error (url-retrieve (concat "www://error/nofile/" file)))))
	   (t
	    nil)))))))))

(defun url-news (article)
  "Find a news reference"
  (or noninteractive (require 'nntp))
  (let* ((info (url-grok-news-href article))
	 (host (nth 0 info))
	 (port (nth 1 info))
	 (article (nth 2 info)))
    (if (not (equal url-current-nntp-server host))
	(nntp-close-server))
    (or (nntp-server-opened) (nntp-open-server host (string-to-int port)))
    (cond
     ((string-match "@" article)	; Its a specific article
      (if (not (equal ">" (substring article -1 nil)));; get in correct
	  (setq article (format "<%s>" article)));; format
      (if (not (nntp-server-opened))
	  (nntp-open-server host (string-to-int port)))
      (if (boundp 'after-change-functions)
	  (progn
	    (set-buffer nntp-server-buffer)
	    (add-hook 'after-change-functions 'nntp-after-change-function)))
      (if (nntp-request-article article);; did we get it?
	  (progn			;; yes
	    (if (boundp 'after-change-functions)
		(progn
		  (set-buffer nntp-server-buffer)
		  (remove-hook 'after-change-functions
			       'nntp-after-change-function)))
	    (url-format-news))
	(progn
	  (set-buffer (get-buffer-create url-working-buffer))
	  (insert "<title>ERROR</title>\n"
		  "<h1> Error requesting article... </h1>"
		  "The status message returned by the NNTP server was:<br>"
		  (format "<pre>%s</pre><p>" (nntp-status-message))
		  "If you feel this is an error, <a href=\""
		  "mailto:" url-bug-address "\">send me mail</a>."))))
     ((string= article "")		; List all newsgroups
      (url-show-all-newsgroups))
     (t					; Whole newsgroup
      (url-format-whole-newsgroup article (url-retrieve-newsgroup article))))
    (setq url-current-type "news"
	  url-current-server host
	  url-current-port port
	  url-current-file article)))

(defun url-telnet (url)
  "Open up a telnet connection"
  (string-match "telnet:/*\\(.*@\\)*\\([^/]*\\)/*" url)
  (let* ((server (substring url (match-beginning 2) (match-end 2)))
	 (name (if (match-beginning 1)
		   (substring url (match-beginning 1) (1- (match-end 1)))
		 nil))
	 (title (format "%s%s" (if name (concat name "@") "") server))
	 (thebuf (string-match ":" server))
	 (port (if thebuf
		   (prog1
		       (substring server (1+ thebuf) nil)
		     (setq server (substring server 0 thebuf))) "23")))
    (cond
     (window-system
      (apply 'start-process
	     "htmlsub"
	     nil
	     (url-string-to-tokens
	      (format url-xterm-command title 
		      (if (and url-gateway-local-host-regexp
			       (string-match url-gateway-local-host-regexp
					     server))
			  url-local-telnet-prog
			url-remote-telnet-prog) server port) ? ))
      (if name (message "Please log in as %s" name)))
     (url-use-transparent
      (require 'transparent)
      (if name (message "Please log in as %s" name))
      (sit-for 1)
      (transparent-window (get-buffer-create
			   (format "%s%s:%s" (if name (concat name "@") "")
				   server port))
			  (if (and url-gateway-local-host-regexp
				   (string-match url-gateway-local-host-regexp
						 server))
			      url-local-telnet-prog
			    url-remote-telnet-prog)
			  (list server port) nil
			  "Press any key to return to emacs"))
     (t
      (terminal-emulator
       (get-buffer-create (format "%s%s:%s" (if name (concat name "@") "")
				  server port))
       (if (and url-gateway-local-host-regexp
		(string-match url-gateway-local-host-regexp
			      server))
	   url-local-telnet-prog
	 url-remote-telnet-prog)
       (list server port))
      (if name (message "Please log in as %s" name))))))

(defun url-tn3270 (url)
  "Open up a tn3270 connection"
  (string-match "tn3270:/*\\(.*@\\)*\\([^/]*\\)/*" url)
  (let* ((server (substring url (match-beginning 2) (match-end 2)))
	 (name (if (match-beginning 1)
		   (substring url (match-beginning 1) (1- (match-end 1)))
		 nil))
	 (thebuf (string-match ":" server))
	 (title (format "%s%s" (if name (concat name "@") "") server))
	 (port (if thebuf
		   (prog1
		       (substring server (1+ thebuf) nil)
		     (setq server (substring server 0 thebuf))) "23")))
    (cond
     (window-system
      (start-process "htmlsub" nil url-xterm-command
		     "-title" title
		     "-ut" "-e" url-tn3270-emulator server port)
      (if name (message "Please log in as %s" name)))
     (url-use-transparent
      (require 'transparent)
      (if name (message "Please log in as %s" name))
      (sit-for 1)
      (transparent-window (get-buffer-create
			   (format "%s%s:%s" (if name (concat name "@") "")
				   server port))
			  url-tn3270-emulator
			  (list server port) nil
			  "Press any key to return to emacs"))
     (t
      (terminal-emulator
       (get-buffer-create (format "%s%s:%s" (if name (concat name "@") "")
				  server port))
       url-tn3270-emulator
       (list server port))
      (if name (message "Please log in as %s" name))))))

(defun url-mailto (url)
  "Send mail to someone"
  (string-match "mailto:/*\\(.*\\)" url)
  (let ((to (substring url (match-beginning 1) (match-end 1)))
	(url (url-view-url t)))
    (if (fboundp url-mail-command) (funcall url-mail-command) (mail))
    (mail-to)
    (insert (format "%s\nX-URL-From: %s" to url))
    (mail-subject)))

(defun url-gopher (url)
  "Handle gopher URLs"
  (let ((descr (url-grok-gopher-href url)))
    (cond
     ((or (not (url-member (nth 1 descr) url-bad-port-list))
	  (funcall
	   url-confirmation-func
	   (format "Warning!  Trying to connect to port %s - continue? "
		   (nth 1 descr))))
      (if url-use-hypertext-gopher
	  (url-do-gopher descr)
	(gopher-dispatch-object (vector (if (= 0
					       (string-to-char (nth 2 descr)))
					    ?1
					  (string-to-char (nth 2 descr)))
					(nth 2 descr) (nth 2 descr)
					(nth 0 descr)
					(string-to-int (nth 1 descr)))
				(current-buffer))))
     (t (ding) (message "Aborting connection to bad port...")))))

(fset 'url-ftp 'url-file)

(defun url-x-exec (url)
  "Handle local execution of scripts."
  (set-buffer (get-buffer-create url-working-buffer))
  (erase-buffer)
  (string-match "x-exec:/+\\([^/]+\\)\\(/.*\\)" url)
  (let ((process-environment process-environment)
	(executable (url-match url 1))
	(path-info (url-match url 2))
	(query-string nil)
	(safe-paths url-local-exec-path)
	(found nil)
	(y nil)
	)
    (setq url-current-server executable
	  url-current-file path-info)
    (if (string-match "\\(.*\\)\\?\\(.*\\)" path-info)
	(setq query-string (url-match path-info 2)
	      path-info (url-match path-info 1)))
    (while (and safe-paths (not found))
      (setq y (expand-file-name executable (car safe-paths))
	    found (and (file-exists-p y) (file-executable-p y) y)
	    safe-paths (cdr safe-paths)))
    (if (not found)
	(url-retrieve (concat "www://error/nofile/" executable))
      (setq process-environment
	    (append
	     (list
	      "SERVER_SOFTWARE=x-exec/1.0"
	      (concat "SERVER_NAME=" (system-name))
	      "GATEWAY_INTERFACE=CGI/1.1"
	      "SERVER_PROTOCOL=HTTP/1.0"
	      "SERVER_PORT="
	      (concat "REQUEST_METHOD=" url-request-method)
	      (concat "HTTP_ACCEPT="
		      (mapconcat
		       (function
			(lambda (x)
			  (cond
			   ((= x ?\n) (setq y t) "")
			   ((= x ?:) (setq y nil) ",")
			   (t (char-to-string x))))) url-mime-accept-string
		       ""))
	      (concat "PATH_INFO=" (url-unhex-string path-info))
	      (concat "PATH_TRANSLATED=" (url-unhex-string path-info))
	      (concat "SCRIPT_NAME=" executable)
	      (concat "QUERY_STRING=" (url-unhex-string query-string))
	      (concat "REMOTE_HOST=" (system-name)))
	     (if (assoc "content-type" url-request-extra-headers)
		 (concat "CONTENT_TYPE=" (cdr
					  (assoc "content-type"
						 url-request-extra-headers))))
	     (if url-request-data
		 (concat "CONTENT_LENGTH=" (length url-request-data)))
	     process-environment))
      (and url-request-data (insert url-request-data))
      (setq y (call-process-region (point-min) (point-max) found t t))
      (goto-char (point-min))
      (delete-region (point) (progn (skip-chars-forward " \\\t\\\n") (point)))
      (cond
       ((url-mime-response-p) nil)	; Its already got an HTTP/1.0 header
       ((null y)			; Weird exit status, whassup?
	(insert "HTTP/1.0 404 Not Found\n"
		"Server: Emacs-W3/x-exec\n"))	
       ((= 0 y)				; The shell command was successful
	(insert "HTTP/1.0 200 Document follows\n"
		"Server: Emacs-W3/x-exec\n"))	
       (t				; Non-zero exit status is bad bad bad
	(insert "HTTP/1.0 404 Not Found\n"
		"Server: Emacs-W3/x-exec\n"))))))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Gateway Support
;;; ---------------
;;; Fairly good/complete gateway support
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun url-gateway-initialize-host-process (host user pass)
  "Start up the remote host for use as a telnet gateway"
  (condition-case ()
      (delete-process url-gateway-host-process)
    (error nil))
  (condition-case ()
      (kill-process url-gateway-host-process)
    (error nil))
  (save-excursion
    (set-buffer (get-buffer-create url-working-buffer))
    (erase-buffer)
    (let ((x (start-process "GATEWAY"
			    (get-buffer-create url-working-buffer)
			    url-gateway-host-program
			    host)))
      (if (not url-gateway-program-interactive)
	  nil
	(while (not (progn
		      (goto-char (point-min))
		      (re-search-forward
		       url-gateway-handholding-login-regexp nil t)))
	  (url-accept-process-output url-gateway-host-process)
	  (url-lazy-message "Waiting for login prompt..."))
	(process-send-string x (concat user "\n"))
	(while (not (progn
		      (goto-char (point-min))
		      (re-search-forward
		       url-gateway-handholding-password-regexp nil t)))
	  (url-accept-process-output url-gateway-host-process)
	  (url-lazy-message "Waiting for password prompt..."))
	(process-send-string x (concat pass "\n")))
      (while (not (progn
		    (goto-char (point-min))
		    (re-search-forward
		     url-gateway-host-prompt-pattern nil t)))
	(url-accept-process-output url-gateway-host-process)
	(url-lazy-message "Waiting for shell prompt..."))
      (setq url-gateway-host-process x))))

(defun url-kill-process (proc)
  "Kill the process PROC"
  (cond
   ((eq url-gateway-method 'native) (delete-process proc))
   ((eq url-gateway-method 'program) (kill-process proc))
   ((eq url-gateway-method 'host)
    (save-excursion
      (set-buffer (process-buffer proc))
      (interrupt-process proc)
      (erase-buffer)))
   (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."
  (if (or (fboundp 'current-time) (fboundp 'current-pixel))
      (accept-process-output proc 1)
    (accept-process-output)))

(defun url-process-status (proc)
  "Return the process status of a w3 buffer"
  (cond
   ((memq url-gateway-method '(native program)) (process-status proc))
   ((eq url-gateway-method 'host)
    (if (memq (process-status proc) '(stop exit signal closed))
	'exit
      (save-excursion
	(set-buffer (process-buffer proc))
	(goto-char (point-min))
	(if (re-search-forward url-gateway-host-prompt-pattern nil t)
	    'exit
	  'open))))
   (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 ((url-gateway-method (if (and url-gateway-local-host-regexp
				    (string-match url-gateway-local-host-regexp
						  host))
			       'native
			     url-gateway-method)))
    (and (eq url-gateway-method 'tcp)
	 (require 'tcp)
	 (setq url-gateway-method 'native))
    (cond
     ((eq url-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))))
      (open-network-stream name buffer host service))
     ((eq url-gateway-method 'host)
      (if (or (null url-gateway-host-process)
	      (not (processp url-gateway-host-process))
	      (not (memq (url-process-status url-gateway-host-process)
			 '(run open))))
	  (url-gateway-initialize-host-process url-gateway-host
					      url-gateway-host-username
					      url-gateway-host-password))
      (save-excursion
	(set-process-buffer url-gateway-host-process
			    (get-buffer-create url-working-buffer))
	(set-buffer (get-buffer-create url-working-buffer))
	(erase-buffer)
	(process-send-string url-gateway-host-process
			     (concat url-gateway-host-program " "
				     host " " service "\n"))
	(while (not
		(progn
		  (goto-char (point-min))
		  (re-search-forward
		   url-gateway-host-program-ready-regexp nil t)))
	  (url-accept-process-output url-gateway-host-process)
	  (url-lazy-message "Waiting for remote process to initialize..."))
	(delete-region (point-min) (match-end 0))
	url-gateway-host-process))
     ((eq url-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-do-setup ()
  "Do setup - this is to avoid conflict with user settings when W3 is
dumped with emacs."

  ; Parse the global history file if it exists, so that it can be used
  ; for URL completion, etc.
  (if (file-exists-p url-global-history-file) (url-parse-global-history))

  (condition-case ()
      (require 'crypt++)
    (error nil))
  
  ; Read in proxy gateways
  (setq url-proxy-services
	(mapcar
	 (function
	  (lambda (x)
	    (let ((y (getenv (concat x "_proxy"))))
	      (and y (cons x y)))))
	 (mapcar 'car
		 (url-split (substring
			    (substring url-nonrelative-link 0 -3) 3 nil)
			   (regexp-quote "\\|")))))
  (if (getenv "no_proxy")
      (setq url-proxy-services
	    (cons "no_proxy"
		  (concat "\\("
			  (mapconcat
			   (function
			    (lambda (x)
			      (cond
			       ((= x ?,) "\\|")
			       ((= x ? ) "")
			       ((= x ?.) (regexp-quote "."))
			       ((= x ?*) ".*")
			       ((= x ??) ".")
			       (t (char-to-string x)))))
			   (getenv "no_proxy") "") "\\)"))))

  ; Set the url-use-transparent with decent defaults
  (if window-system (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
    (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 (message "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 url-mime-encodings ", ")))
  
  ; Set up the entity definition for PGP and PEM authentication
  (setq url-pgp/pem-entity (or url-pgp/pem-entity
			      (format "%s@%s"  (user-real-login-name)
				      (system-name))))
  (setq url-personal-mail-address (or url-personal-mail-address
				     url-pgp/pem-entity))
  (run-hooks 'url-load-hooks)
  (setq url-setup-done t))

(defun url-store-in-cache (&optional buff)
  "Store buffer BUFF in the cache"
  (if (or (not (get-buffer buff))
	  (equal url-current-type "www")
	  (equal url-current-type "news")
	  (equal url-current-type "mailto")
	  )
      nil
    (save-excursion
      (and buff (set-buffer buff))
      (let ((fname (url-create-cached-filename url-current-type
					       url-current-server
					       url-current-file))
	    (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-mime-viewer
			     url-current-nntp-server
			     url-current-port
			     url-current-server
			     url-current-type
			     url-current-user
			     )))
	    (done t))
	(if (not (file-exists-p (file-name-directory fname)))
	    (make-directory (file-name-directory fname) t))
	(setq done (file-directory-p (file-name-directory fname)))
	(if (not done)
	    nil
	  (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)
			(concat (url-file-extension fname t) ".hdr") nil
			5))))))

(defun url-is-cached (protocol hostname fname)
  "Return non-nil if the URL is cached."
  (let ((fname (url-create-cached-filename protocol hostname fname)))
    (and (file-exists-p fname) (nth 5 (file-attributes fname)))))

(defun url-create-cached-filename (protocol hostname fname)
  "Return a filename in the local cache for file FNAME on host HOSTNAME"
  (setq fname (mapconcat
	       (function (lambda (x)
			   (if (= x ?~) "" (char-to-string x)))) fname ""))
  (expand-file-name (cond
		     ((string= "" fname) "index.html")
		     ((string= "/" fname) "index.html")
		     ((= (string-to-char fname) ?/)
		      (if (string= (substring fname -1 nil) "/")
			  "index.html"
			(substring fname 1 nil)))
		     (t
		      (if (string= (substring fname -1 nil) "/")
			  "index.html"
			fname)))
		    (expand-file-name
		     (mapconcat 'identity
				(cons
				 (user-real-login-name)
				 (cons (or protocol "file")
				       (mm-string-to-tokens
					(or hostname "localhost") ?.))) "/")
		     url-temporary-directory)))

(defun url-is-cached-1 (url)
  "Return non-nil if fully-qualified URL is cached locally and has not expired"
  (string-match "\\([^:]*\\):/*" url)
  (let* ((type (substring url (match-beginning 1) (match-end 1)))
	 (grok (intern (concat "url-grok-" type "-href")))
	 (info (and (fboundp grok) (funcall grok url)))
	 (fnam nil)
	 (is-c nil)
	 )
    (cond
     ((null info) nil)
     ((or (string= type "file") (string= type "ftp"))
      (setq fnam (url-create-cached-filename type (nth 1 info) (nth 2 info))
	    is-c (url-is-cached type (nth 1 info) (nth 2 info))))
     (t
      (setq fnam (url-create-cached-filename type (nth 0 info) (nth 2 info))
	    is-c (url-is-cached type (nth 0 info) (nth 2 info)))))
    (if (and is-c
	     (fboundp 'current-time)
	     (not (funcall url-cache-expired (current-time)
			   (nth 6 (file-attributes fnam)))))
	fnam
      nil)))

(fset 'url-grok-ftp-href 'url-grok-file-href)

(defun url-extract-from-cache (fnam)
  "Extract FNAM from the local disk cache"
  (set-buffer (get-buffer-create url-working-buffer))
  (erase-buffer)
  (cond
   ((or (null url-request-method)
	(string= url-request-method "GET"))
    (insert-file-contents fnam)
    (load-file (concat (w3-file-extension fnam t) ".hdr")))
   ((string= url-request-method "HEAD")
    (load-file (concat (w3-file-extension fnam t) ".hdr"))
    (insert
     (mapconcat
      (function
       (lambda (hdr)
	 (if (equal (car hdr) "") ""
	   (concat (capitalize (car hdr)) ": " (cdr hdr)))))
      url-current-mime-headers "\n"))))
  (message "Extracted %s from cache" url-current-file))

(defun url-quotify-percents (str)
  "Convert all '%'s in STR to be '%%' so it can be passed to format."
  (if str
      (let ((x ""))
	(while (string-match "%" str)
	  (setq x (concat (substring str 0 (match-beginning 0)) "%%")
		str (substring str (match-end 0) nil)))
	(concat x str))
    str))

;;;###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)
      (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))
	  (message "No URL found around point!")
	  (setq start (point)))
	(buffer-substring start (point))))))			     

(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-parse-relative-link (url)
  "Try to resolve a link like \"library/io.html\""
  (let* ((url-current-file url-current-file)
	 (resolved (cond ((equal url-current-type "http")
			  (concat "http://" url-current-server
				  (if (equal url-current-port "80") ""
				    (concat ":" url-current-port))
				  (if (/= (string-to-char url-current-file) ?/)
				      "/" "")))
			 ((equal url-current-type "gopher")
			  (concat "gopher://" url-current-server
				  (if (equal url-current-port "70") ""
				    (concat ":" url-current-port)) "/"))
			 ((equal url-current-type "news")
			  (concat "news:"
				  (if (equal url-current-server url-news-server)
				      "" (concat "//" url-news-server
						 (if (equal url-current-port
							    "119") ""
						   (concat ":"
							   url-current-port))
						 "/"))))
			 ((equal url-current-type "ftp")
			  (concat "file://"
				  (if url-current-user (concat
						       url-current-user "@") "")
				  url-current-server))
			 ((equal url-current-type "www")
			  (setq url-current-file
				(buffer-file-name
				 (get-buffer url-current-file)))
			  "file:")
			 (t "file:"))))
    (cond
     ((equal "news" url-current-type)
      (setq resolved (url-remove-relative-links (concat resolved url))))
     ((= ?# (string-to-char url))
      (setq resolved url))
     ((equal url "") nil)
     ((equal (aref url 0) ?/) (setq resolved (concat resolved url)))
     (t (setq resolved (concat resolved
			       (url-remove-relative-links
				(concat (url-basepath url-current-file) url))))))
    resolved))

(defun url-hexify-string (str)
  "Escape characters in a string"
  (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))
    ""))

(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)
	       (char-to-string code)))
	(setq str (substring str (match-end 0)))))
    (setq tmp (concat tmp str))
    tmp))

(defun url-clean-text ()
  "Clean up a buffer after telnet (trash at beginning, connection closed)"
  (set-buffer url-working-buffer)
  (url-replace-regexp "Connection closed by.*" "")
  (url-replace-regexp "Process WWW.*" ""))

(if (fboundp 'crypt-find-file-hook)
    (defun url-crypt-find-file-hook ()
      (let ((buffer-file-name buffer-file-name)
	    (old-buffer-file-name buffer-file-name)
        (old-buffer-modified-p (buffer-modified-p))
        (case-fold-search nil) ; case-sensitive
        encrypted encoded buffer-read-only)
	
	(crypt-save-point
	 (if (and (crypt-encoded-p)
		  (or crypt-auto-decode-buffer
		      (y-or-n-p (format "Decode %s? " (buffer-name)))))
	     (progn
	       (message "Decoding %s..." (buffer-name))
	       (crypt-encode-buffer t)
	       (setq encoded crypt-buffer-encoding-type)
	       (if (string-match (crypt-get-file-extension
				  crypt-buffer-encoding-type) buffer-file-name)
		   (setq buffer-file-name
			 (substring buffer-file-name 0 (match-beginning 1))))
	       (if (not (input-pending-p))
		   (message "Decoding %s... done" (buffer-name)))))
	 (if (crypt-encrypted-p)
	     (progn
	       (message "Decrypting %s..." (buffer-name))
	       (crypt-encrypt-buffer crypt-buffer-encryption-key t)
	       (setq encrypted crypt-buffer-encryption-key)
	       (if (and (crypt-get-extension-tricks crypt-encryption-type)
			(string-match (crypt-get-file-extension
				       crypt-encryption-type) buffer-file-name))
		   (setq buffer-file-name
			 (substring buffer-file-name 0 (match-beginning 1))))
	       (if (not (input-pending-p))
		   (message "Decrypting %s... done" (buffer-name)))))))))

(defun url-uncompress ()
  "Uncompress a file"
  (set-buffer url-working-buffer)
  (setq buffer-file-name url-current-file)
  (if (fboundp 'url-crypt-find-file-hook)
      (url-crypt-find-file-hook)
    (let ((extn (url-file-extension url-current-file)))
      (if (assoc extn url-uncompressor-alist)
	  (progn
	    (message "Uncompressing")
	    (shell-command-on-region (point-min) (point-max)
				     (cdr (assoc extn url-uncompressor-alist))
				     t))))))

(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-sentinel (proc string)
  (set-buffer (get-buffer (process-buffer proc)))
  (if (boundp 'after-change-functions)
      (remove-hook 'after-change-functions 'url-after-change-function))
  (if url-be-asynchronous
      (progn
	(url-clean-text)
	(cond
	 ((not (get-buffer url-working-buffer)) nil)
	 ((url-mime-response-p) (url-parse-mime-headers))
	 ((url-member url-current-server url-bad-server-list) nil)
	 (t
	  (setq url-bad-server-list
		(cons url-current-server url-bad-server-list))))
	(if (not url-current-mime-type)
	    (setq url-current-mime-type (mm-extension-to-mime
					 (url-file-extension
					  url-current-file))))))
  (let* ((pname (process-name proc))
	 (handler (intern (if (string-match "<" pname)
			      (substring pname 0 (match-beginning 0))
			    pname))))
    (if (fboundp handler)
	(funcall handler (current-buffer))
      (funcall url-default-retrieval-proc (buffer-name)))))

(defun url-remove-relative-links-helper (name)
  (cond
   ((string-match "\\\.\\\./" name)
    (let ((tmp (substring name (match-end 0) nil)))
      (if (= 0 (match-beginning 0))
 	  (concat (url-basepath (url-basepath url-current-file)) tmp)
 	(concat (url-basepath (substring name 0
 					(1- (match-beginning 0)))) tmp))))
   ((string-match "\\\./" name)
    (if (= 0 (match-beginning 0))
 	(substring name 2 nil)
      (concat
       (substring name 0 (match-beginning 0))
       (substring name (match-end 0) nil))))))

(defun url-remove-relative-links (name)
  "Strip . and .. from pathnames"
  (while (string-match "\\\.+/" name)
    (setq name (url-remove-relative-links-helper name)))
  name)

(defun url-view-url (&optional no-show)
  "View the current document's URL"
  (interactive)
  (let ((url ""))
    (cond
     ((equal url-current-type "gopher")
      (setq url (format "%s://%s%s/%s"
			url-current-type url-current-server
			(if (string= "70" url-current-port) ""
			  (concat ":" url-current-port))
			(url-quotify-percents url-current-file))))
     ((equal url-current-type "news")
      (setq url (concat "news://" url-current-server
			(if (string= "119" url-current-port) ""
			  (concat ":" url-current-port)) "/"
			url-current-file)))
     ((equal url-current-type "http")
      (setq url (format  "%s://%s%s/%s" url-current-type url-current-server
			 (if (string= "80" url-current-port) ""
			   (concat ":" url-current-port))
			 (url-quotify-percents
			  (if (= ?/ (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 url-current-user (concat url-current-user "@") "")
			url-current-server
			(url-quotify-percents
			 (if (= ?/ (string-to-char url-current-file))
			     (substring url-current-file 1 nil)
			   url-current-file)))))
     ((equal url-current-type nil)
      (setq url (format "file:%s" (url-quotify-percents url-current-file))))
     ((equal url-current-type "www")
      (setq url (format "www:/%s/%s" url-current-server url-current-file))))
    (if (not no-show) (message url) url)))

(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)))
  (if (not (file-exists-p fname))
      (message "%s does not exist." fname)
    (save-excursion
      (set-buffer (get-buffer-create " *url-tmp*"))
      (erase-buffer)
      (insert-file-contents fname)
      (goto-char (point-min))
      (forward-line 2)
      (delete-region (point-min) (point))
      (while (re-search-forward "^\\([^ \\\t]+\\)[ \\\t]+\\(.*\\)" nil t)
	(setq url-global-history-completion-list
	      (cons (cons (buffer-substring (match-beginning 1)
					    (match-end 1))
			  (buffer-substring (match-beginning 2)
					    (match-end 2)))
		    url-global-history-completion-list))))))

(defun url-write-global-history (&optional fname)
  "Write the global history file into url-global-history-file"
  (interactive)
  (if (not fname) (setq fname url-global-history-file))
  (if (not (file-exists-p url-global-history-file))
      (progn
	(message "Creating history file %s." url-global-history-file)
	(set-buffer (get-buffer-create " *W3HIST*"))
	(erase-buffer)
	(insert "ncsa-mosaic-history-format-1\nGlobal\n"))
    (progn
      (set-buffer (get-buffer-create " *URLHIST*"))
      (erase-buffer)
      (insert-file-contents url-global-history-file)))
  (let (url)
    (mapcar
     (function
      (lambda (x)
	(setq url (car x))
	(goto-char (point-min))
	(if (not (re-search-forward (regexp-quote url) nil t))
	    (progn
	      (goto-char (point-min))
	      (insert (concat url " " (current-time-string) "\n"))))))
     url-history-list))
  (write-file url-global-history-file)
  (kill-buffer (current-buffer)))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; 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* ((type (or (and (string-match url-nonrelative-link url)
			(url-match url 1)) "file"))
	 data)
    (cond
     ((string= type "http")
      (let ((url-request-method "HEAD")
	    (url-inhibit-mime-parsing t))
	(url-retrieve url)
	(buffer-string)))
     ((or (string= type "file") (string= type "ftp"))
      (setq data (url-file-attributes url))
      (set-buffer (get-buffer-create
		   (w3-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))
		  (if (or w3-running-lemacs w3-running-FSF19 w3-running-epoch)
		      (concat
		       "\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)))
     (t (concat "Don't know how to find information on " url)))))

;;;###autoload
(defun url-retrieve (url)
  "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."
  (if (get-buffer url-working-buffer)
      (kill-buffer url-working-buffer))
  (string-match "\\([^:]*\\):/*" url)
  (let* ((type (substring url (match-beginning 1) (match-end 1)))
	 (url-using-proxy (and
			  (if (assoc "no_proxy" url-proxy-services)
			      (not (string-match
				    (cdr (assoc "no_proxy" url-proxy-services))
				    url))
			    t)
			  (cdr (assoc type url-proxy-services))))
	 (handler nil)
	 (cached nil)
	 (tmp url-current-file))
    (if url-using-proxy
	(setq url (concat url-using-proxy
			  (if (equal (substring url-using-proxy -1 nil) "/")
			      "" "/") url)
	      type (and (string-match "\\([^:]*\\):/*" url-using-proxy)
			(url-match url-using-proxy 1))))
    (setq cached (url-is-cached-1 url)
	  handler (if cached 'url-extract-from-cache
		    (intern (downcase (concat "url-" type))))
	  url (or cached url))
;    (setq handler (intern (downcase (concat "url-" type))))
    (if (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))
	(url-clean-text))
    (cond
     ((equal type "wais") nil)
     ((and url-be-asynchronous (equal type "http")) nil)
     ((not (get-buffer url-working-buffer)) nil)
     ((and (not url-inhibit-mime-parsing) (url-mime-response-p))
      (url-parse-mime-headers))
     ((url-member url-current-server url-bad-server-list) nil))
    (if (and (not url-be-asynchronous)
	     (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)))))
    (and url-using-proxy (url-fix-proxy-url))
    (if url-automatic-cacheing
	(save-excursion
	  (url-store-in-cache url-working-buffer)))
    (and (not (url-have-visited-url url))
	 (setq url-global-history-completion-list
	       (cons (cons url (current-time-string)) 
		     url-global-history-completion-list)))))

(provide 'url)
