;;; LCD Archive Entry:
;;; w3-mode|William M. Perry|wmperry@spry.com|
;;; Major mode for browsing World Wide Web nodes|
;;; $Date: 1994/07/31 23:53:36 $|
;;; $Revision: 1.186 $|
;;; 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.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; This is a major mode for browsing documents written in Hypertext Markup ;;;
;;; Language (HTML).  These documents are typicallly part of the World Wide ;;;
;;; Web (WWW), a project to create a global information net in hypertext    ;;;
;;; format.				                                    ;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Copyright (c) 1993, 1994 by William M. Perry (wmperry@spry.com)	    ;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


(require 'mm)
(require 'url)
(or (featurep 'efs)
    (featurep 'efs-auto)
    (require 'ange-ftp))

(require 'w3-vars)


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; FORMS processing for html+
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(or (boundp 'MULE) (fset 'string-width 'length))

(defun w3-truncate-string (str len &optional pad)
  "Truncate string STR so that string-width of STR is not greater than LEN.
If width of the truncated string is less than LEN, and if a character PAD is
defined, add padding end of it."
  (if (boundp 'MULE)
      (let ((cl (string-to-char-list str)) (n 0) (sw 0))
	(if (<= (string-width str) len) str
	  (while (<= (setq sw (+ (char-width (nth n cl)) sw)) len)
	    (setq n (1+ n)))
	  (string-match (make-string n ?.) str)
	  (setq str (substring str 0 (match-end 0))))
	(if pad (concat str (make-string (- len (string-width str)) pad)) str))
    (concat (if (> (length str) len) (substring str 0 len) str)
	    (if (or (null pad) (> (length str) len))
		""
	      (make-string (- len (length str)) pad)))))

(fset 'w3-split 'url-split)

(defun w3-handle-form (num)
  "Parse a form, expecting the region to be narrowed between the <FORM>
and </FORM> tags."
  (goto-char (point-min))
  (let ((args (if (re-search-forward "<FORM\\([^>]*\\)>" nil t)
		  (w3-parse-args (match-beginning 1) (match-end 1))
		""))
	action method tmp
	st nd input type name default value checked size maxlength prompt
	options formatfun)
    (if (not (assoc "method" args)) (setq args (cons (cons "method" "GET") args)))
    (if (not (assoc "action" args))
	(setq args (cons (cons "action" (url-view-url t)) args)))
    (if (not (assoc "enctype" args))
	(setq args (cons (cons "enctype" "application/x-www-form-urlencoded") args)))
    (setq method (or (cdr (assoc "method" args)) "GET")
	  action (or (cdr (assoc "action" args)) (url-view-url t))
	  action args)
    (while (re-search-forward "<INPUT" nil t)
      (setq st (cons (match-beginning 0) (match-end 0))
	    nd (progn
		 (goto-char (car st))
		 (if (re-search-forward ">" nil t)
		     (cons (match-end 0) (match-beginning 0))
		   (progn (end-of-line) (cons (point) (point)))))
	    input (w3-parse-args (cdr st) (cdr nd)))
      (delete-region (car st) (car nd))
      (setq type (upcase (or (cdr (assoc "type" input)) "text"))
	    name (or (cdr (assoc "name" input)) type)
	    value (or (cdr (assoc "value" input)) "")
	    size (string-to-int (or (cdr (assoc "size" input)) "20"))
	    maxlength (string-to-int
		       (or (cdr (assoc "maxlength" input)) "10000"))
	    default value
	    checked (assoc "checked" input))
      (if (null tmp)
	  nil
	(setq action tmp
	      tmp nil))
      (if (and (string= type "SUBMIT")
	       (assoc "action" input))
	  (setq tmp action
		action (cons (cons "action" (cdr (assoc "action" input))) action)))
      (if (or (equal type "CHECKBOX")
	      (equal type "RADIO"))
	  (setq default checked))
      (if (and (equal type "CHECKBOX")
	       (equal "" value))
	  (setq value "on"))
      (cond
       ((equal type "HIDDEN")
	(setq w3-hidden-forms (cons (list 'w3form action type name default
					  value checked size maxlength num
					  options) w3-hidden-forms)))
       (t
	(setq formatfun (intern (concat "w3-form-format-" (downcase type))))
	(if (not (fboundp formatfun))
	    (setq formatfun 'w3-form-format-unknown))
	(setq prompt (funcall formatfun value size checked))
	(goto-char (car st))
	(w3-insert prompt)
	(w3-add-zone (car st) (point) w3-node-style
		     (list 'w3form
			   action type name default value
			   checked size maxlength num options) t)
	(w3-insert (if (w3-member type '("CHECKBOX" "RADIO")) "" " ")))))))

(defun w3-form-format-int (&rest args)
  "Format an integer entry field"
  (w3-truncate-string (or (nth 0 args) "") (nth 1 args) ?_))

(fset 'w3-form-format-url 'w3-form-format-int)
(fset 'w3-form-format-float 'w3-form-format-int)
(fset 'w3-form-format-date 'w3-form-format-int)

(defun w3-form-format-reset (&rest args)
  "Format a reset button"
  (if (string= (nth 0 args) "") "Reset fields" (nth 0 args)))

(defun w3-form-format-password (&rest args)
  "Format a password entry field"
  (let ((value (or (nth 0 args) ""))
	(size (nth 1 args)))
    (concat (if (>= (length value) size) (make-string size ?*)
	      (make-string (length value) ?*))
	    (if (>= (length value) size) ""
	      (make-string (- size (length value)) ?.)))))

(defun w3-form-format-checkbox (&rest args)
  "Format a checkbox entry"
  (let ((checked (nth 2 args)))
    (format "[%s]" (if checked "X" " "))))

(fset 'w3-form-format-radio 'w3-form-format-checkbox)

(defun w3-form-format-submit (&rest args)
  "Format a form submit button"
  (if (string= (nth 0 args) "") "Submit this form" (nth 0 args)))

(defun w3-form-format-text (&rest args)
  "Format a text field"
  (w3-truncate-string (nth 0 args) (nth 1 args) ?_))

(defun w3-form-format-textarea (&rest args)
  "Format a multiline text box"
  "Multiline text entry")

(fset 'w3-form-format- 'w3-form-format-text)
(fset 'w3-form-format-unknown 'w3-form-format-text)

(defun w3-handle-textareas (num action)
  "Handle <SELECT> tags in a form"
  (let (
	(type "TEXTAREA")
	name
	default
	value
	checked
	size
	(maxlength 100)
	options
	st
	nd
	input)
    (goto-char (point-min))
    (while (re-search-forward "<TEXTAREA\\([^>]*\\)>\\\n*" nil t)
      (setq st (match-beginning 0)
	    input (prog1
		      (w3-parse-args (match-beginning 1) (match-end 1))
		    (replace-match ""))
	    nd (if (re-search-forward "\\n*</TEXTAREA[^>]*>\\\n*" nil t)
		   (progn
		     (replace-match "")
		     (match-beginning 0))
		 (progn
		   (end-of-line)
		   (point)))
	    value (buffer-substring st nd)
	    options value
	    default value)
      (setq name (or (cdr (assoc "name" input)) ""))
      (delete-region st nd)
      (w3-insert "Multiline Text Entry Area")
      (w3-add-zone st (point) w3-node-style
		   (list 'w3form
			 action type name default value checked size
			 maxlength num options) t))))

(defun w3-handle-selections (num action)
  "Handle <SELECT> tags in a form"
  (let (
	(type "OPTION")
	name
	default
	value
	checked
	size
	(maxlength 100)
	options
	parm
	st
	nd
	input
	mult				; Multiple input?
	(longest 0)			; Longest selection?
	sel)
    (goto-char (point-min))
    (while (re-search-forward "<SELECT\\([^>]*\\)>\\\n*" nil t)
      (setq st (match-beginning 0)
	    input (prog1
		      (w3-parse-args (match-beginning 1) (match-end 1))
		    (replace-match ""))
	    options nil
	    mult nil
	    value nil
	    default nil
	    nd (if (re-search-forward "\\n*</SELECT[^>]*>\\\n*" nil t)
		   (progn
		     (replace-match "")
		     (match-beginning 0))
		 (progn
		   (end-of-line)
		   (point))))
      (goto-char st)
      (while (re-search-forward "[\\\n ]*<OPTION\\([^>]*\\)> *\\([^<]*\\)"
				nd t)
	(setq parm (w3-parse-args (match-beginning 1) (match-end 1))
	      sel (w3-eat-trailing-space
		   (buffer-substring (match-beginning 2) (match-end 2)))
	      options (cons (cons sel sel) options))
	(if (> (string-width sel) longest) (setq longest (string-width sel)))
	(if (assoc "selected" parm) (setq default sel))
	(if (assoc "value" parm)
	    (setq checked (cons
			   (cons sel (cdr (assoc "value" parm))) checked))))
      (setq longest (+ 5 longest))
      (delete-region st nd)
      (setq name (or (cdr (assoc "name" input)) "")
	    size (string-to-int (or (cdr (assoc "size" input)) "20"))
	    mult (or (assoc "several" input)
		     (assoc "multiple" input)))
      (cond
       (mult
	(goto-char st)
	(w3-insert "<UL>\n")
	(mapcar
	 (function
	  (lambda (x)
	    (w3-insert
	     (format
	      "<LI><INPUT TYPE=\"CHECKBOX\" NAME=\"%s\" VALUE=\"%s\" %s>%s\n"
	      name (car x) (if (equal default (car x)) "CHECKED" "")
	      (car x))))) options)
	(w3-insert "</UL>\n"))
       (t
	(if (not default)
	    (setq value (car (nth (1- (length options)) options)))
	  (setq value default))
	(setq default value)
	(goto-char st)
	(setq value (w3-truncate-string value maxlength))
	(w3-insert (w3-form-format-text value size nil))
	(w3-add-zone st (point) w3-node-style
		     (list 'w3form
			   action type name default value checked size
			   maxlength num options) t))))))

(defun w3-handle-forms ()
  "Take care of parsing an entire buffer for <FORM> tags."
  (set-buffer w3-working-buffer)
  (let ((num 1)
	x y z)
    (goto-char (point-min))
    (while (re-search-forward "<FORM\\([^>]*\\)>" nil t)
      (setq y (match-beginning 0)
	    x (w3-parse-args (match-beginning 1) (match-end 1)))
      (narrow-to-region y
			(if (re-search-forward "</FORM>" nil t) (match-end 0)
			  (point-max)))
      (if (not (assoc "method" x)) (setq x (cons (cons "method" "GET") x)))
      (if (not (assoc "action" x)) (setq x (cons (cons "action" (url-view-url t)) x)))
      (if (not (assoc "enctype" x))
	  (setq x (cons (cons "enctype" "application/x-www-form-urlencoded") x)))
      (w3-handle-selections num x)
      (w3-handle-textareas num x)
      (w3-handle-form num)
      (setq num (1+ num))
      (w3-replace-regexp "</*FORM[^>]*>" "<p>")
      (widen))))

(defun w3-do-text-entry (formobj zone)
  "Read in a multiline text entry area."
  (let ((data (list formobj zone (current-buffer)))
	(buff (get-buffer-create (format "%d:%s" (nth 9 formobj)
					 (nth 3 formobj)))))
    (switch-to-buffer-other-window buff)
    (indented-text-mode)
    (erase-buffer)
    (w3-insert (nth 5 formobj))
    (setq w3-current-last-buffer data)
    (message "Press C-c C-c when finished with text entry.")
    (local-set-key "\C-c\C-c" 'w3-finish-text-entry)))

(defun w3-finish-text-entry ()
  "Finish a text entry area"
  (interactive)
  (if w3-current-last-buffer
      (let* ((formobj (nth 0 w3-current-last-buffer))
	     (zone (nth 1 w3-current-last-buffer))
	     (buff (nth 2 w3-current-last-buffer))
	     (actn (nth 1 formobj))
	     (type (nth 2 formobj))
	     (name (nth 3 formobj))
	     (deft (nth 4 formobj))
	     (valu (buffer-string))
	     (chkd (nth 6 formobj))
	     (size (nth 7 formobj))
	     (maxl (nth 8 formobj))
	     (ident (nth 9 formobj))
	     (options (nth 10 formobj))
	     (st nil)
	     (nd nil))
	(local-set-key "\C-c\C-c" 'undefined)
	(kill-buffer (current-buffer))
	(delete-window)
	(if (not (and buff (bufferp buff) (buffer-name buff)))
	    (message "Could not find the form buffer for this text!")
	  (switch-to-buffer buff)
	  (if buffer-read-only (toggle-read-only))
	  (setq st (w3-zone-start zone)
		nd (w3-zone-end zone))
	  (w3-delete-zone zone)
	  (w3-add-zone st nd w3-node-style
		       (list 'w3form actn type name deft valu chkd
			     size maxl ident options) t)))
    (if (not buffer-read-only) (toggle-read-only))
    nil))

(defun w3-do-form-entry (formobj zone)
  "Read in a form entry field.
FORMOBJ is the data returned by w3-zone-at, and contains all the information
        about the entry area (size, type, value, etc)
   ZONE is the actual zone object.  This should be able to be passed to
        w3-delete-zone."
  (let* ((actn (nth 1 formobj))
	 (type (nth 2 formobj))
	 (name (nth 3 formobj))
	 (deft (nth 4 formobj))
	 (valu (nth 5 formobj))
	 (chkd (nth 6 formobj))
	 (size (nth 7 formobj))
	 (maxl (nth 8 formobj))
	 (ident (nth 9 formobj))
	 (options (nth 10 formobj))
	 (st (w3-zone-start zone))
	 (nd (w3-zone-end zone))
	 (submit-it nil)
	 (formatfun (intern (concat "w3-form-format-" (downcase type)))))
    (if (not (equal "SUBMIT" type))
	(progn
	  (if (equal "TEXTAREA" type)
	      (progn
		(if (not buffer-read-only) (toggle-read-only))
		(w3-do-text-entry formobj zone)))
	  (save-excursion
	    (if (not (fboundp formatfun))
		(setq formatfun 'w3-form-format-unknown))
	    (if buffer-read-only (toggle-read-only))
	    (cond
	     ((equal "CHECKBOX" type) (setq chkd (not chkd)))
	     ((equal "RADIO" type) nil)
	     ((equal "TEXTAREA" type) nil)
	     ((equal "RESET" type) (w3-revert-form ident))
	     (t (setq valu
		      (w3-read-correct-format type name options ident valu))))
	    (cond
	     ((equal "RESET" type) nil)
	     ((equal "RADIO" type) (w3-set-radio-button zone))
	     ((equal "TEXTAREA" type) nil)
	     (t
	      (w3-delete-zone zone)
	      (delete-region st nd)
	      (goto-char st)
	      (w3-insert (funcall formatfun valu size chkd))
	      (w3-add-zone st (point) w3-node-style
			   (list 'w3form actn type name deft valu chkd
				 size maxl ident options) t)
	      (if (not buffer-read-only) (toggle-read-only))
	      (if w3-running-FSF19 (setq w3-zones-list (w3-only-links)))
	      (if (boundp 'MULE)
		  (w3-mule-attribute-zones w3-zones-list w3-mule-attribute))
	      ))
	    (cond
	     ((string-match "^isindex$" name) (setq submit-it 'isindex))
	     ((string-match "^internal-gopher$" name) (setq submit-it 'gopher))
	     ((string-match "^internal-wais$" name) (setq submit-it 'wais))
	     ((equal (length (w3-zones-matching ident)) 1)
	      (setq submit-it t)))))
      (w3-submit-form ident nil actn))
    (if submit-it (w3-submit-form ident submit-it actn))))

(defun w3-zones-matching (actn &optional raw)
  "Return a list of data entry zones in form number ACTN
With optional second argument raw, don't grab the data of the zone, but
return the actual zone."
  (let* ((big (w3-all-zones))
	 (data nil)
	 (result nil))
    (while big
      (setq data (w3-zone-data (car big)))
      (if (and (eq (nth 0 data) 'w3form) (equal (nth 9 data) actn))
	  (setq result (cons (if raw (car big) data) result)))
      (setq big (cdr big)))
    (if raw
	nil
      (setq big w3-hidden-forms)
      (while big
	(setq data (car big))
	(if (and (eq (nth 0 data) 'w3form) (equal (nth 9 data) actn))
	    (setq result (cons data result)))
	(setq big (cdr big))))
    result))

(defun w3-revert-form (actn)
  "Revert all values for form ACTN to their defaults"
  (save-excursion
    (let* ((zones (w3-zones-matching actn t))
	   actn data type name deft valu chkd size maxl idnt strt end cur
	   options formatfun
	   )
      (if buffer-read-only (toggle-read-only))
      (mapcar
       (function
	(lambda (cur)
	  (setq data (w3-zone-data cur)
		actn (nth 1 data)
		type (nth 2 data)
		name (nth 3 data)
		deft (nth 4 data)
		valu (nth 5 data)
		chkd (nth 6 data)
		size (nth 7 data)
		maxl (nth 8 data)
		idnt (nth 9 data)
		options (nth 10 data)
		strt (w3-zone-start cur)
		end  (w3-zone-end cur)
		formatfun (intern (concat "w3-form-format-" (downcase type))))
	  (if (not (fboundp formatfun))
	      (setq formatfun 'w3-form-format-unknown))
	  (cond
	   ((or (w3-member type '("SUBMIT" "RESET"))) nil)
	   (t
	    (if (w3-member type '("RADIO" "CHECKBOX"))
		(setq chkd deft)
	      (setq valu deft))
	    (if w3-running-FSF19 (goto-char strt)
	      (w3-delete-zone cur))
	    (delete-region strt end)
	    (goto-char strt)
	    (w3-insert (funcall formatfun valu size chkd))
	    (w3-add-zone strt (point) w3-node-style
			 (list 'w3form actn type name deft valu chkd
			       size maxl idnt options) t))))
	(if (not buffer-read-only) (toggle-read-only))) zones))
    (if w3-running-FSF19
	(setq w3-zones-list (w3-only-links)))
    (if (boundp 'MULE)
	(w3-mule-attribute-zones w3-zones-list w3-mule-attribute))
    ))

(defun w3-form-encode-multipart/x-www-form-data (formobjs isindex-query)
  "Create a multipart form submission.
Returns a cons of two strings.  Car is the separator used.
cdr is the body of the MIME message."
  (let ((separator "---some-separator-for-www-form-data"))
    (cons separator
	  (mapconcat
	   (function
	    (lambda (formobj)
	      (cond
	       ((and (w3-member (nth 2 formobj) '("CHECKBOX" "RADIO"))
		     (nth 6 formobj))
		(concat separator "\nContent-id: " (nth 3 formobj) "\n\n"
			(nth 5 formobj)))
	       ((w3-member (nth 2 formobj) '("RESET" "SUBMIT"))
		"")
	       ((and (string= (nth 2 formobj) "OPTION")
		     (assoc (nth 5 formobj) (nth 6 formobj)))
		(concat separator "\nContent-id: " (nth 3 formobj) "\n\n"
			(cdr (assoc (nth 5 formobj) (nth 6 formobj)))))
	       (t
		(concat separator "\nContent-id: " (nth 3 formobj) "\n\n"
			(nth 5 formobj))))))
	   formobjs "\n"))))

(defun w3-form-encode (result &optional isindex-query enctype)
  "Create a string suitably encoded for a URL request."
  (let ((func (intern (concat "w3-form-encode-" enctype))))
    (if (fboundp func) (funcall func result isindex-query))))

(defun w3-form-encode-application/x-www-form-urlencoded (result &optional isindex-query)
  "Create a string suitably enocoded for a URL request."
  (let ((query ""))
    (cond
     ((eq isindex-query 'gopher)	; Gopher searching by hypertext
      (setq query (concat "\t" (nth 5 (car result)))))
     ((eq isindex-query 'isindex)	; Isindex handling by hypertext
      (while result
	(if (equal (downcase (nth 3 (car result))) "isindex")
	    (setq query (w3-hexify-string (nth 5 (car result)))
		  result nil))
	(setq result (cdr result))))
     (t					; Normal submission of form
					; This is a little convoluted, but
					; gets only checkboxes that are set
					; and ignores submit & reset buttons
      (setq query
	    (mapconcat
	     (function
	      (lambda (formobj)
		(cond
		 ((and (w3-member (nth 2 formobj) '("CHECKBOX" "RADIO"))
		       (nth 6 formobj))
		  (concat (nth 3 formobj) "="
			  (w3-hexify-string (nth 5 formobj))))
		 ((w3-member (nth 2 formobj) '("RESET" "SUBMIT"))
		  "")
		 ((and (string= (nth 2 formobj) "OPTION")
		       (assoc (nth 5 formobj) (nth 6 formobj)))
		  (concat (nth 3 formobj) "="
			  (w3-hexify-string
			   (cdr (assoc (nth 5 formobj) (nth 6 formobj))))))
		 (t
		  (concat (nth 3 formobj) "=" (w3-hexify-string
					       (nth 5 formobj)))))))
	     result "&"))))
    query))

(defun w3-form-encode-ask-block (result)
  "Submit a gopher ask block to the server."
  (let ((query ""))
    ;;; This is different than the w3-form-encode function, because
    ;;; gopher+ will expect all the checkboxes/etc, even if they are
    ;;; not turned on.  Should still ignore RADIO boxes that are not
    ;;; active though.
  (while result
    (if (and (not (and (string= (nth 2 (car result)) "RADIO")
		       (not (nth 6 (car result)))))
	     (not (w3-member (nth 2 (car result)) '("SUBMIT" "RESET"))))
	(setq query (format "%s\r\n%s" query (nth 5 (car result)))))
    (setq result (cdr result)))
  (concat query "\r\n.\r\n")))

(defun w3-submit-form (ident isindex &optional actn)
  "Submit form entry fields matching ACTN as their action identifier."
  (let* ((result (w3-zones-matching ident))
	 (enctype (cdr (assoc "enctype" actn)))
	 (query (w3-form-encode result isindex enctype))
	 (themeth (upcase (cdr (assoc "method" actn))))
	 (theurl (cdr (assoc "action" actn))))
    (if (string-match "\\([^\\?]*\\)\\?" theurl)
	(setq theurl (w3-match theurl 1)))
    (cond
     ((eq isindex 'gopher) (w3-fetch (concat theurl query)))
     ((eq isindex 'wais)
      (url-perform-wais-query url-current-server url-current-port
			     url-current-file query)
      (w3-sentinel))
     ((string= "GOPHER-ASK" themeth)
      (setq query (w3-form-encode-ask-block result))
      (w3-fetch (concat theurl (w3-hexify-string (concat "\t+\t1\n+-1\r\n"
							 query)))))
     ((string= "POST" themeth)
      (if (consp query)
	  (setq enctype (concat enctype "; separator=\"" (substring (car query) 3 nil)
				"\"")
		query (cdr query)))
      (let ((url-request-method themeth)
	    (url-request-data query)
	    (url-request-extra-headers
	     (cons (cons "Content-type" enctype) url-request-extra-headers)))
	(if (not (string-match url-nonrelative-link theurl))
	    (w3-fetch (url-parse-relative-link theurl))
	  (w3-fetch theurl))))
     ((string= "GET" themeth)
      (let ((theurl (concat theurl "?" query)))
	(if (not (string-match url-nonrelative-link theurl))
	    (w3-fetch (url-parse-relative-link theurl))
	  (w3-fetch theurl))))
     (t (message "Unknown submit method: %s" themeth)))))

(defun w3-matching-radios (ext)
  "Return a list of all zones containing radio buttons with the same name
as that in EXT."
  (let* ((big (w3-all-zones))
	 (idnt (nth 9 (w3-zone-data ext)))
	 (name (nth 3 (w3-zone-data ext)))
	 data cur result)
    (mapcar
     (function
      (lambda (cur)
	(setq data (w3-zone-data cur))
	(if (and
	     (eq (nth 0 data) 'w3form)
	     (equal (nth 9 data) idnt)
	     (equal (nth 3 data) name))
	    (setq result (cons cur result))))) big)
    result))

(defun w3-set-radio-button (ext)
  "Set the radio button at EXT to be on.  Will automatically
toggle other radio butons with the same name to be off."
  (save-excursion
    (let* ((result (w3-matching-radios ext))
	   (idnt (nth 9 (w3-zone-data ext)))
	   (name (nth 3 (w3-zone-data ext)))
	   actn type deft valu chkd size maxl strt end data options)
      (while result
	(setq data (w3-zone-data (car result))
	      actn (nth 1 data)
	      type (nth 2 data)
	      name (nth 3 data)
	      deft (nth 4 data)
	      valu (nth 5 data)
	      chkd (nth 6 data)
	      size (nth 7 data)
	      maxl (nth 8 data)
	      idnt (nth 9 data)
	      options (nth 10 data)
	      strt (w3-zone-start (car result))
	      end (w3-zone-end (car result)))
	(cond
	 ((and chkd (not (w3-zone-eq
			  ext (car result)))) ; Not supposed to be chkd
	  (w3-delete-zone (car result))	      ; but is.
	  (goto-char strt)
	  (delete-region strt end)
	  (setq chkd nil)
	  (w3-insert (funcall 'w3-form-format-radio valu size chkd))
	  (w3-add-zone strt (point) w3-node-style
		       (list 'w3form actn type name deft valu chkd size maxl
			     idnt options) t))
	 ((and (not chkd) (w3-zone-eq
			   ext (car result))) ; Supposed to be chkd
	  (w3-delete-zone (car result))       ; but isn't.
	  (goto-char strt)
	  (delete-region strt end)
	  (setq chkd t)
	  (w3-insert (funcall 'w3-form-format-radio valu size chkd))
	  (w3-add-zone strt (point) w3-node-style
		       (list 'w3form actn type name deft valu chkd size maxl
			     idnt options) t))
	 (t nil)) ; not supposed to be checked, and isn't
	(setq result (cdr result))))
    (if (not buffer-read-only) (toggle-read-only))
    (if w3-running-FSF19 (setq w3-zones-list (w3-only-links)))
    (if (boundp 'MULE)
	(w3-mule-attribute-zones w3-zones-list w3-mule-attribute))
    ))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Type checking for FORMS
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Date checking, taken from edb.el
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defconst weekday-alist
 '(("Sunday" . 0) ("Monday" . 1) ("Tuesday" . 2) ("Wednesday" . 3)
   ("Thursday" . 4) ("Friday" . 5) ("Saturday" . 6)
   ("Tues" . 2) ("Thurs" . 4)
   ("Sun" . 0) ("Mon" . 1) ("Tue" . 2) ("Wed" . 3)
   ("Thu" . 4) ("Fri" . 5) ("Sat" . 6)))

(defconst full-monthname-alist
  '(("January" . 1) ("February" . 2) ("March" . 3) ("April" . 4)
    ("May" . 5) ("June" . 6) ("July" . 7) ("August" . 8)
    ("September" . 9) ("October" . 10) ("November" . 11) ("December" . 12)))


(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)))

(defconst monthname-alist
  (append monthabbrev-alist
	  full-monthname-alist
	  '(("Sept" . 9))))

(defconst monthname-regexp
  (concat "\\("
	  (mapconcat (function car)
		     monthname-alist
		     "\\|")
	  "\\)\\.?"))

(defconst weekday-regexp
  (concat "\\("
	  (mapconcat (function car)
		     weekday-alist
		     "\\|")
	  "\\)\\.?"))

(defconst monthnumber-regexp "\\(0?[1-9]\\|1[0-2]\\)")
(defconst monthnumber-regexp-two-char "\\(0[1-9]\\|1[0-2]\\)")

(defconst monthday-regexp "\\(0?[1-9]\\|[12][0-9]\\|3[01]\\)")
(defconst monthday-regexp-two-char "\\([0-2][0-9]\\|3[01]\\)")

(defconst full-year-regexp "[0-2][0-9][0-9][0-9]")
(defconst short-year-regexp "[0-9][0-9]")

(defconst year-regexp (concat "\\(" full-year-regexp
			      "\\|" short-year-regexp "\\)"))

(defconst elt-separator-regexp "[ -.,/']+")

(defconst date-regexps
  (list
   ;; MMDDYY
   (cons (concat monthname-regexp
		 elt-separator-regexp
		 monthday-regexp
		 "\\("
		 elt-separator-regexp
		 year-regexp
		 "\\)?")
	 '(4 nil 1 2))
   (cons (concat monthnumber-regexp
		 elt-separator-regexp
		 monthday-regexp
		 "\\("
		 elt-separator-regexp
		 year-regexp
		 "\\)?")
	 '(4 1 nil 2))
   ;; DDMMYY
   (cons (concat monthday-regexp
		 elt-separator-regexp
		 monthname-regexp
		 "\\("
		 elt-separator-regexp
		 year-regexp
		 "\\)?")
	 '(4 nil 2 1))
   (cons (concat "\\("
		 monthday-regexp
		 elt-separator-regexp
		 "\\)?"
		 monthname-regexp
		 elt-separator-regexp
		 year-regexp)
	 '(4 nil 3 2))
   (cons (concat monthday-regexp
		 elt-separator-regexp
		 monthnumber-regexp
		 elt-separator-regexp
		 "\\(" full-year-regexp "\\)")
	 '(3 2 nil 1))
   ;; YYMMDD
   ;; Using year-regexp instead of full-year-regexp is ambiguous (consider
   ;; 11-11-11), but we already tried MMDDYY and it failed.
   (cons (concat year-regexp
		 elt-separator-regexp
		 monthname-regexp
		 elt-separator-regexp
		 monthday-regexp)
	 '(1 nil 2 3))
   (cons (concat year-regexp
		 elt-separator-regexp
		 monthnumber-regexp
		 elt-separator-regexp
		 monthday-regexp)
	 '(1 2 nil 3))
   ;; YYMMDD, no separators
   ;; This is ambiguous.
   (cons (concat year-regexp
		 monthnumber-regexp-two-char "?"
		 monthday-regexp-two-char "?")
	 '(1 2 nil 3))
   ;; WWMMDDYY
   (cons (concat weekday-regexp
		 elt-separator-regexp
		 monthname-regexp
		 elt-separator-regexp
		 monthday-regexp
		 "\\("
		 elt-separator-regexp
		 year-regexp
		 "\\)?")
	 '(5 nil 2 3))
   ;; WWDDMMYY
   (cons (concat weekday-regexp
		 elt-separator-regexp
		 monthday-regexp
		 elt-separator-regexp
		 monthname-regexp
		 "\\("
		 elt-separator-regexp
		 year-regexp
		 "\\)?")
	 '(5 nil 3 2))
   ;; ctime
   (cons (concat
	  weekday-regexp
	  " "
	  monthname-regexp
	  "  ?"
	  monthday-regexp
	  ;; time of day
	  " [0-9:]+ "
	  "\\(" full-year-regexp "\\)")
	 '(4 nil 2 3))
   )
  "Assoc list of regexps and match locators.
A match locator is a list of four numbers indicating which submatch of the
regexp contains the year, month number, month name, and day of the month.
The list elements may be nil if that information is not available.")

(defun w3-datep (date-string)
  "Parse DATE-STRING, and return a date object; err if the parse is invalid.
If DATE-STRING contains only whitespace, return a null date object.
If DATE-STRING is nil, use the result of `parse-date-default-function' instead."
  (let ((regexp-alist date-regexps)
	result)
    (if (zerop (length date-string))	;if empty string,
	(setq result t)			;empty date is kosher
      ;; regexp-alist is nulled if a match is found
      (progn
	(while regexp-alist
	  (if (string-match (concat "^" (car (car regexp-alist)) "$")
			    date-string)
	      (setq regexp-alist nil
		    result t)
	    ;; string-match failed
	    (setq regexp-alist (cdr regexp-alist))))))
    result))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Integer checking
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun w3-intp (str)
  "Integer checker"
  (string-match "^[0-9]+$" str))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Floating point checking
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun w3-floatp (str)
  "Floating point checker"
  (let (x y)
    (if (string-match "^\\([0-9]+\\)\\.\\([0-9]+\\)$" str)
	(progn
	  (setq x (substring str (match-beginning 1) (match-end 1))
		y (substring str (match-beginning 2) (match-end 2)))
	  (and (w3-intp x) (w3-intp y)))
      (w3-intp str))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; URL Checking
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun w3-urlp (str)
  "URL checker..."
  (string-match url-nonrelative-link str))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Option list checking
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun w3-optionp (val)
  "Option list checker"
  (if (null val)
      (progn
	(message "Please make a selection from the menu")
	nil)
    t))

(defun w3-textp (str) t)		; don't care whats in a text field
(fset 'w3-p 'w3-textp)			; for default of "" to be text
(fset 'w3-passwordp 'w3-textp)		; don't care whats in a paswd either
(fset 'w3-textareap 'w3-textp)		; try this - might work

(defun w3-read-correct-format (type name options num value)
  "Read in a FORMS entry with type TYPE, and do typechecking"
  (let ((func (read (format "w3-%sp" (downcase type))))
	(valu value) exitp)
    (while (not exitp)
      (cond
       ((or (equal "TEXT" type)
	    (equal "" type))
	(setq valu (read-string "Enter text: " valu)))
       ((or (equal "FLOAT" type)
	    (equal "INT" type))
	(setq valu (read-string "Enter numeric value: " valu)))
       ((equal "PASSWORD" type)
	(setq valu (funcall url-passwd-entry-func "Enter password:" valu)))
       ((equal "OPTION" type)
	(if (or (not window-system)
		(not (fboundp 'w3-x-popup-menu)))
	    (setq valu
		  (let ((completion-ignore-case t))
		    (completing-read "Please choose: " options nil t valu)))
	  (setq valu (w3-x-popup-menu
		      (if (and (boundp 'last-input-event)
			       (listp last-input-event))
			  last-input-event
			(list (list (current-column) 1)
			      (selected-window)))
		      (list "WWW"
			    (cons "Select An Item" options)))))
;				  (w3-breakup-menu options
;						   w3-max-menu-length))))))
	(if (consp valu) (setq valu (car valu))))
       ((equal "DATE" type)
	(setq valu (read-string "Enter date: " valu)))
       ((equal "URL" type)
	(setq valu (read-string "Enter valid URL: " valu))))
      (if (not (fboundp func)) (setq func 'w3-textp))
      (if (funcall func valu)
	  (setq exitp t)
	(progn
	  (message "Wrong format for type %s, try again." (downcase type))
	  (sit-for 2))))
    valu))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Code for printing out roman numerals
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun w3-decimal-to-roman (n)
  "Convert from decimal to roman numerals"
  (let ((curmod 1000)
	(str "")
	(j 7)
	i2 k curcnt)
    (while (>= curmod 1)
      (if (>= n curmod)
	  (progn
	    (setq curcnt (/ n curmod)
		  n (- n (* curcnt curmod)))
	    (if (= 4 (% curcnt 5))
		(setq i2 (+ j (if (> curcnt 5) 1 0))
		      str (format "%s%c%c" str
				  (aref w3-roman-characters (1- j))
				  (aref w3-roman-characters i2)))
	      (progn
		(if (>= curcnt 5)
		    (setq str (format "%s%c" str (aref w3-roman-characters j))
			  curcnt (- curcnt 5)))
		(setq k 0)
		(while (< k curcnt)
		  (setq str (format "%s%c" str
				    (aref w3-roman-characters (1- j)))
			k (1+ k)))))))
      (setq curmod (/ curmod 10)
	    j (- j 2)))
    str))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Functions for formatting nested lists in html
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun w3-expand-list (data)
  "Expand a list that has been hidden."
  (let ((buffer-read-only nil))
    (w3-unhide-zone (nth 1 data) (nth 2 data))))

(defun w3-rehide-list (data)
  "Hide a list that was viewable."
  (let ((buffer-read-only nil))
    (w3-hide-zone (nth 1 data) (nth 2 data))))

(defun w3-build-table (indent-level attributes)
  "Build a Definition List"
  (set-buffer w3-working-buffer)
  (let* ((x (concat "\n" (make-string indent-level 9)
		    (or (nth (1- indent-level)
			     (cdr (assoc "DL" w3-list-chars-assoc))) "*") " "))
	 (compact (assoc "compact" attributes))
	 (y (concat (if compact "" "\n") (make-string indent-level 9) "  "))
	next-dt
	next-dd
	parm)
    (goto-char (point-min))
    (while (re-search-forward "<DT\\([^>]*\\)> *" nil t)
      (setq parm (prog1 (w3-parse-args (match-beginning 1) (match-end 1))
		   (replace-match x))
	    next-dt (or (save-excursion
			  (if (re-search-forward "<DT[^>]*>" nil t)
			      (match-beginning 0)
			    nil)) (point-max))
	    next-dd (or (save-excursion
			  (if (re-search-forward "<DD[^>]*>" nil t)
			      (match-beginning 0)
			    nil)) (point-max)))
      (if (< next-dt next-dd)		; <dt> with no <dd>
	  nil
	(goto-char next-dd)
	(if compact
	    nil
	  (insert y))))
    (w3-replace-regexp "</*dd[^>]*> *" "")
    (w3-replace-regexp "</*DL[^>]*>" "\n")))

(defun w3-build-ordered-list (indent-level &optional attributes)
  "Builds ordered lists"
  (let ((roman (assoc "roman" attributes))
	(hidden (equal (downcase (or (cdr (assoc "folded" attributes)) "no"))
		       "yes"))
	(label (or (cdr (assoc "label" attributes)) "\\/ Expand List \\/")))
    (set-buffer w3-working-buffer)
    (goto-char (point-min))
    (let ((x 1) y
	  (z (or (nth (1- indent-level) (cdr (assoc "OL" w3-list-chars-assoc)))
		 "."))
	  parm url alt
	  (tabs (make-string indent-level 9)))
      (goto-char (point-min))
      (while (re-search-forward "<LI\\([^>]*\\)>[ \\\t]*" nil t)
	(setq parm (prog1
		       (w3-parse-args (match-beginning 1) (match-end 1))
		     (replace-match ""))
	      url (cdr (assoc "src" parm))
	      alt (cdr (assoc "alt" parm))
	      y (format "\n%s%3s%s " tabs
			(if roman (w3-decimal-to-roman x)
			  (format "%d" x)) z))
	(cond
	 ((and (null alt) (null url)) (w3-insert y))
	 ((and url (fboundp 'w3-insert-graphic))
	  (w3-insert-graphic (list url) (1- (point)) 'center
			     (or alt (nth (1- indent-level)
					  (cdr (assoc "OL"
						      w3-list-chars-assoc)))
				 ".")))
	 (alt (w3-insert alt)))
	(setq x (1+ x))))
    (goto-char (point-min))
    (w3-replace-regexp "</*OL[^>]*>" "\n")
    (if (not hidden) nil
      (goto-char (point-min))
      (w3-insert label)
      (w3-hide-zone (point) (point-max))
      (w3-add-zone (point-min) (point) nil
		   (list 'w3expandlist (set-marker (make-marker) (point))
			 (set-marker (make-marker) (point-max))) t))))

(defun w3-build-unordered-list (indent-level attributes)
  "Build unordered lists"
  (let ((hidden (equal (downcase (or (cdr (assoc "folded" attributes)) "no"))
		       "yes"))
	(plain (assoc "plain" attributes))
	(label (or (cdr (assoc "label" attributes)) "\\/ Expand List \\/")))
    (setq plain (and plain (not (equal "no" (cdr plain)))))
    (set-buffer w3-working-buffer)
    (goto-char (point-min))
    (let ((x (concat "\n" (make-string indent-level 9)))
	  (y (or (nth (1- indent-level)
		      (cdr (assoc "UL" w3-list-chars-assoc))) "*"))
	  parm url alt)
      (while (re-search-forward "<LI\\([^>]*\\)>" nil t)
	(setq parm (prog1
		       (w3-parse-args (match-beginning 1) (match-end 1))
		     (replace-match ""))
	      url (cdr (assoc "src" parm))
	      alt (cdr (assoc "alt" parm)))
	(cond
	 ((and (null alt) (null url) (null plain)) 	; Not a plain list
	  (w3-insert x y " "))
	 ((and (null alt) (null url) plain) 		; Plain list
	  (w3-insert x " "))
	 ((and url (fboundp 'w3-insert-graphic))	; Replace bullet
	  (w3-insert-graphic				; with a graphic img
	   (list url) (1- (point)) 'center
	   (or alt (nth (1- indent-level)
			(cdr (assoc "UL" w3-list-chars-assoc)))
	       "*")))
	 (alt (w3-insert alt)))))			; Use alt instd of img
    (goto-char (point-min))
    (w3-replace-regexp "</*\\(UL\\|DIR\\|MENU\\)[^>]*>" "\n")
    (if (not hidden) nil
      (goto-char (point-min))
      (w3-insert label)
      (w3-hide-zone (point) (point-max))
      (w3-add-zone (point-min) (point) nil
		   (list 'w3expandlist (set-marker (make-marker) (point))
			 (set-marker (make-marker) (point-max))) t))))

(defun w3-handle-lists (indent-level)
  "Handle building of lists - INDENT-LEVEL is how many tabs to use
to indent from the left margin."
  (let ((type (upcase (buffer-substring (match-beginning 1) (match-end 1))))
	(parm (w3-parse-args (match-beginning 2) (match-end 2)))
	(pos nil))
    (while (setq pos (w3-sublists-exist type))
      (goto-char pos)
      (setq indent-level (1+ indent-level)
	    type (upcase (buffer-substring (match-beginning 1) (match-end 1)))
	    parm (w3-parse-args (match-beginning 2) (match-end 2))))
    (narrow-to-region (save-excursion
			(search-backward "<")
			(point))
		      (if (re-search-forward (format "</%s>" type) nil t)
			  (point)
			(point-max)))
    (cond
     ((equal "OL" type) (w3-build-ordered-list indent-level parm))
     ((equal "DL" type) (w3-build-table indent-level parm))
     (t (w3-build-unordered-list indent-level parm)))
    (w3-fill-paragraphs-in-list indent-level type)
    (widen)))

(defun w3-fill-paragraphs-in-list (indent-level type)
  "This will fill all the paragraphs within the current list.  INDENT-LEVEL
is the number of tabs to use as the leading fill."
  (w3-replace-regexp "\\\n[ \\\n]+" "\n")
  (goto-char (point-min))
  (let ((fill-prefix (concat (make-string indent-level 9)
			     (if (equal type "OL") "     " "  ")))
	(paragraph-start "<\\(P\\|PRE\\|XMP\\|LI\\|UL\\|OL\\|DL\\)>")
	st nd ptag)
    (w3-replace-regexp "<[bB][Rr]> *" (concat "<X>\n" fill-prefix "<W3BR>"))
    (goto-char (point-min))
    (while (re-search-forward "^[^\\\n]" nil t)
      (setq st (progn (beginning-of-line) (point))
 	    nd (progn (end-of-line) (point)))
      (save-restriction
 	(narrow-to-region st nd)
 	(goto-char (point-min))
 	(while (re-search-forward " *<P\\([^>]*\\)> *" nil t)
 	  (setq ptag (buffer-substring (match-beginning 1) (match-end 1)))
 	  (setq st (match-beginning 0))
 	  (if (and (>= (length ptag) 2)
 		   (equal "re" (downcase (substring ptag 0 2))))
 	      (re-search-forward "</PRE>" nil t)
 	    (replace-match (concat "\n\n" fill-prefix))
 	    (if (string-match "ID=\"\\([^\"]+\\)\"" ptag)
 		(w3-add-zone st (progn (end-of-line) (point))
			     nil
 			     (cons 'w3par
 				   (list (substring ptag (match-beginning 1)
 						    (match-end 1))
 					 nil nil nil nil nil nil nil))))))
 	(while (re-search-forward "^[^\\\t]" nil t)
	  (beginning-of-line)
	  (insert-before-markers fill-prefix))
 	(fill-region (point-min) (point-max))
	(goto-char (point-max))
	(skip-chars-backward " \\\t\\\n")
	(delete-region (point) (point-max))))))

(defun w3-sublists-exist (type)
  "Figure out if there are sublists in the current list.  Expects point to
be _AFTER_ the current list tag, and type to be bound to what sort of
list it is (OL, UL, DL, MENU, etc)"
  (save-excursion
    (let* ((thestart  (point))
	   (newend (if (re-search-forward (format "</%s>" type) nil t)
		       (point)
		     (point-max))))
      (goto-char thestart)
      (if (re-search-forward "<\\(DL\\|OL\\|UL\\|DIR\\|MENU\\)\\([^>]*\\)>"
			     newend t)
	  (point)
	nil))))

(defun w3-do-lists ()
  (let ((tmp 0)
	(last (point-min)))
    (while (progn
	     (goto-char last)
	     (re-search-forward "<\\(DL\\|OL\\|UL\\|DIR\\|MENU\\)\\([^>]*\\)>"
				nil t))
      (setq last (match-beginning 0))
      (w3-handle-lists 1)
      (setq tmp (1+ tmp))
      (w3-lazy-message "Building lists...%s" (make-string tmp ?.)))))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Functions for compatibility with XMosaic
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Parse out the Mosaic documents-menu file
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun w3-parse-docs-menu ()
  "Parse the Mosaic documents menu"
  (let ((tmp-menu (append '((separator)) w3-starting-documents
			  '((separator))))
	real-menu x y name url)
    (if (or (not (file-exists-p w3-documents-menu-file))
	    (not (file-readable-p w3-documents-menu-file)))
	(message "No documents menu found... continuing.")
      (save-excursion
	(set-buffer (get-buffer-create " *w3-temp*"))
	(erase-buffer)
	(insert-file-contents w3-documents-menu-file)
	(goto-char (point-min))
	(while (not (eobp))
	  (if (not (looking-at "-+$"))
	      (setq x (progn (beginning-of-line) (point))
		    y (progn (end-of-line) (point))
		    name (prog1
			     (buffer-substring x y)
			   (delete-region x (min (1+ y) (point-max))))
		    x (progn (beginning-of-line) (point))
		    y (progn (end-of-line) (point))
		    url (prog1
			    (buffer-substring x y)
			  (delete-region x (min (1+ y) (point-max))))
		    tmp-menu (if (w3-rassoc url tmp-menu) tmp-menu
			       (cons (cons name url) tmp-menu)))
	    (setq tmp-menu (cons '(separator) tmp-menu))
	    (delete-region (point-min) (min (1+ (progn (end-of-line)
						       (point)))
					    (point-max)))))
	(kill-buffer (current-buffer))))
    (if (equal (car (car tmp-menu)) "") (setq tmp-menu (cdr tmp-menu)))
    (while tmp-menu
      (setq real-menu (cons (if (equal 'separator (car (car tmp-menu)))
				"--------"
			      (vector (car (car tmp-menu))
				      (list 'w3-fetch
					    (if (listp (cdr (car tmp-menu)))
						(car (cdr (car tmp-menu)))
					      (cdr (car tmp-menu)))) t))
			    real-menu)
	    tmp-menu (cdr tmp-menu)))
    (setq w3-navigate-menu (append w3-navigate-menu real-menu
				   (list "-----")))))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Hotlist Handling Code
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun w3-hotlist-refresh ()
  "Reload the default hotlist file into memory"
  (interactive)
  (w3-parse-hotlist))

(defun w3-hotlist-delete ()
  "Deletes a document from your hotlist file"
  (interactive)
  (save-excursion
    (if (not w3-hotlist) (message "No hotlist in memory!")
      (if (not (file-exists-p w3-hotlist-file))
	  (message "Hotlist file %s does not exist." w3-hotlist-file)
	(let* ((completion-ignore-case t)
	       (title (car (assoc (completing-read "Delete Document: "
						   w3-hotlist nil t)
				  w3-hotlist)))
	       (buffer (get-buffer-create " *HOTW3*")))
	  (set-buffer buffer)
	  (erase-buffer)
	  (insert-file-contents w3-hotlist-file)
	  (if (re-search-forward (regexp-quote title) nil t)
	      (progn
		(previous-line 1)
		(beginning-of-line)
		(delete-region (point) (progn (forward-line 2) (point)))
		(write-file w3-hotlist-file)
		(setq w3-hotlist (w3-delete-from-alist title w3-hotlist))
		(kill-buffer (current-buffer)))
	    (message "%s was not found in %s" title w3-hotlist-file))))))
  (if (and w3-running-FSF19 (eq window-system 'x))
      (progn
	(delete-menu-item '("Navigate"))
	(w3-build-FSF19-menu))))

(defun w3-hotlist-rename-entry (title)
  "Rename a hotlist item"
  (interactive (list (let ((completion-ignore-case t))
		       (completing-read "Rename entry: " w3-hotlist nil t))))
  (cond					; Do the error handling first
   ((not w3-hotlist) (error "No hotlist in memory!"))
   ((not (file-exists-p (expand-file-name w3-hotlist-file)))
    (error "Hotlist file %s does not exist." w3-hotlist-file))
   ((not (file-readable-p (expand-file-name w3-hotlist-file)))
    (error "Hotlist file %s exists, but is unreadable." w3-hotlist-file)))
  (save-excursion
    (let ((obj (assoc title w3-hotlist))
	  (used (mapcar 'car w3-hotlist))
	  (buff (get-buffer-create " *HOTW3*"))
	  (new nil)
	  )
      (while (or (null new) (w3-member new used))
	(setq new (read-string "New name: ")))
      (set-buffer buff)
      (erase-buffer)
      (insert-file-contents (expand-file-name w3-hotlist-file))
      (goto-char (point-min))
      (if (re-search-forward (regexp-quote title) nil t)
	  (progn
	    (previous-line 1)
	    (beginning-of-line)
	    (delete-region (point) (progn (forward-line 2) (point)))
	    (w3-insert (format "%s %s\n%s\n" (nth 1 obj) (current-time-string)
			    new))
	    (setq w3-hotlist (cons (list new (nth 1 obj))
				   (w3-delete-from-alist title w3-hotlist)))
	    (write-file w3-hotlist-file)
	    (kill-buffer (current-buffer))
	    (if (and w3-running-FSF19 window-system)
		(progn
		  (delete-menu-item '("Navigate"))
		  (w3-build-FSF19-menu))))
	(message "%s was not found in %s" title w3-hotlist-file)))))

(defun w3-hotlist-append (fname)
  "Append a hotlist to the one in memory"
  (interactive "fAppend hotlist file: ")
  (let ((x w3-hotlist))
    (w3-parse-hotlist fname)
    (setq w3-hotlist (nconc x w3-hotlist))))

(defun w3-parse-hotlist (&optional fname)
  "Read in the hotlist specified by FNAME"
  (if (not fname) (setq fname w3-hotlist-file))
  (setq w3-hotlist nil)
  (if (not (file-exists-p fname))
      (message "%s does not exist!" fname)
    (let* ((old-buffer (current-buffer))
	   (buffer (get-buffer-create " *HOTW3*"))
	   cur-link
	   cur-alias)
      (set-buffer buffer)
      (erase-buffer)
      (insert-file-contents fname)
      (goto-char (point-min))
      (while (re-search-forward "^\n" nil t) (replace-match ""))
      (goto-line 3)
      (while (not (equal (point) (point-max)))
	(re-search-forward "^[^ ]*" nil t)
	(setq cur-link (buffer-substring (match-beginning 0) (match-end 0)))
	(setq cur-alias (buffer-substring (progn
					    (forward-line 1)
					    (beginning-of-line)
					    (point))
					  (progn
					    (end-of-line)
					    (point))))
	(if (not (equal cur-alias ""))
	    (setq w3-hotlist (cons (list cur-alias cur-link) w3-hotlist))))
      (kill-buffer buffer)
      (set-buffer old-buffer))))

;;;###autoload
(defun w3-use-hotlist ()
  "Possibly go to a link in your W3/Mosaic hotlist.
This is part of the emacs World Wide Web browser.  It will prompt for
one of the items in your 'hotlist'.  A hotlist is a list of often
visited or interesting items you have found on the World Wide Web."
  (interactive)
  (if (not w3-setup-done) (w3-do-setup))
  (if (not w3-hotlist) (message "No hotlist in memory!")
    (let* ((completion-ignore-case t)
	   (url (car (cdr (assoc
			   (completing-read "Goto Document: " w3-hotlist nil t)
			   w3-hotlist)))))
      (w3-fetch url))))

(defun w3-hotlist-add-document-at-point (pref-arg)
  "Add the document pointed to by the hyperlink under point to the hotlist."
  (interactive "P")
  (let ((url (w3-view-this-url t))
	(title "nil"))
    (or url (error "No link under point."))
    (setq title (nth 3 (w3-zone-data (w3-zone-at (point)))))
    (w3-hotlist-add-document pref-arg title url)))

(defun w3-hotlist-add-document (pref-arg &optional the-title the-url)
  "Add this documents url to the hotlist"
  (interactive "P")
  (save-excursion
    (let* ((buffer (get-buffer-create " *HOTW3*"))
	   (title (or the-title
		      (and pref-arg (read-string "Title: "))
		      (buffer-name)))
	   (url (or the-url (url-view-url t))))
      (if (w3-rassoc (list url) w3-hotlist)
	  (error "That item already in hotlist, use w3-hotlist-rename-entry."))
      (set-buffer buffer)
      (erase-buffer)
      (setq w3-hotlist (cons (list title url) w3-hotlist))
      (if (not (file-exists-p w3-hotlist-file))
	  (progn
	    (message "Creating hotlist file %s" w3-hotlist-file)
	    (w3-insert "ncsa-xmosaic-hotlist-format-1\nDefault\n\n")
	    (backward-char 1))
	(progn
	  (insert-file-contents w3-hotlist-file)
	  (goto-char (point-max))
	  (backward-char 1)))
      (w3-insert "\n" (w3-hexify-string url) " " (current-time-string)
		 "\n" title)
      (write-file w3-hotlist-file)
      (kill-buffer (current-buffer))))
  (if (and w3-running-FSF19 (eq window-system 'x))
      (progn
	(delete-menu-item '("Navigate" ))
	(w3-build-FSF19-menu))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Private annotation support
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun w3-parse-personal-annotations ()
  "Read in personal annotation file"
  (if (and
       (file-exists-p (format "%s/LOG" w3-personal-annotation-directory))
       (file-readable-p (format "%s/LOG" w3-personal-annotation-directory)))
      (save-excursion
	(setq w3-personal-annotations nil);; nuke the old list
	(let ((start nil)
	      (end nil)
	      (txt nil)
	      (url nil)
	      (num nil))
	  (set-buffer (get-buffer-create " *panno*"))
	  (erase-buffer)
	  (insert-file-contents
	   (format "%s/LOG" w3-personal-annotation-directory))
	  (goto-char (point-min))
	  (w3-replace-regexp "\\\n+" "\\\n")
	  (goto-char (point-min))
	  ;; nuke the header lines
	  (delete-region (point-min) (progn (forward-line 2) (point)))
	  (cond
	   ((eobp) nil)			; Empty LOG file
	   (t
	    (if (/= (char-after (1- (point-max))) ?\n)
		(save-excursion
		  (goto-char (point-max))
		  (w3-insert "\n")))
	    (while (not (eobp))
	      (setq start (point)
		    end (prog2 (end-of-line) (point) (forward-char 1))
		    txt (buffer-substring start end)
		    url (substring txt 0 (string-match " " txt))
		    num (w3-split
			 (substring txt (1+ (string-match " " txt)) nil)
			 "[ \\\t]"))
	      (while num
		(setq w3-personal-annotations
		      (cons
		       (list url
			     (list (car (car num))
				   (w3-grok-annotation-format
				    (car (car num)))))
		       w3-personal-annotations)
		      num (cdr num))))))
	  (kill-buffer " *panno*")))))

(defun w3-grok-annotation-format (anno)
  "Grab the title from an annotation"
  (let ((fname  (format "%s/PAN-%s.html"
			w3-personal-annotation-directory anno)))
    (save-excursion
      (set-buffer (get-buffer-create " *annotmp*"))
      (erase-buffer)
      (if (file-exists-p fname) (insert-file-contents fname))
      (goto-char (point-min))
      (prog1
	  (if (re-search-forward "<title>\\(.*\\)</title>" nil t)
	      (buffer-substring (match-beginning 1) (match-end 1))
	    (if (or w3-running-FSF19 w3-running-lemacs)
		(concat "Annotation on "
			(current-time-string (nth 5 (file-attributes fname))))
	      "No title"))
	(kill-buffer " *annotmp*")))))

(defun w3-fetch-personal-annotations ()
  "Grab any personal annotations for the current url"
  (let ((url  (url-view-url t))
	(anno w3-personal-annotations)
	(annolist nil))
    (if (assoc url anno)
	(while anno
	  (if (equal (car (car anno)) url)
	      (setq annolist
		    (cons
		     (format "<A HREF=\"file:%s%s/PAN-%s.html\">%s</A>"
			     (if (= ?/ (string-to-char
					w3-personal-annotation-directory)) ""
			       "/")
			     w3-personal-annotation-directory
			     (car (car (cdr (car anno))))
			     (car (cdr (car (cdr (car anno))))))
		     annolist)))
	  (setq anno (cdr anno))))
    annolist))

(defun w3-is-personal-annotation (url)
  "Is URL a personal annotation?"
  (string-match "file:/.*/PAN-.*\\.html" url))

(defun w3-delete-personal-annotation ()
  "Delete a personal annotation."
  (interactive)
  (if (w3-is-personal-annotation (url-view-url t))
      (let ((num nil)
	    (annotated-url nil)
	    (anno w3-personal-annotations))
	(string-match "file:/.*/PAN-\\(.*\\)\\.html" (url-view-url t))
	(setq num (substring (url-view-url t) (match-beginning 1)
			     (match-end 1)))
	(while anno
	  (if (equal num (car (car (cdr (car anno)))))
	      (setq annotated-url (car (car anno))))
	  (setq anno (cdr anno)))
	(if annotated-url
	    (save-excursion
	      (set-buffer (get-buffer-create " *annotmp*"))
	      (erase-buffer)
	      (insert-file-contents (format "%s/LOG"
					    w3-personal-annotation-directory))
	      (replace-regexp (format "[ \\\t]+\\b%s\\b[ \\\t]*" num) " ")
	      (goto-char (point-min))
	      (delete-matching-lines (format "^%s +$" annotated-url))
	      (let ((make-backup-files nil)
		    (version-control nil)
		    (require-final-newline t))
		(write-region (point-min) (point-max)
			      (format "%s/LOG"
				      w3-personal-annotation-directory)))
	      (kill-buffer " *annotmp*")
	      (setq anno w3-personal-annotations
		    w3-personal-annotations nil)
	      (while anno
		(if (not (string= num (car (car (cdr (car anno))))))
		    (setq w3-personal-annotations
			  (cons (car anno) w3-personal-annotations)))
		(setq anno (cdr anno)))
	      (delete-file (format "%s/PAN-%s.html"
				   w3-personal-annotation-directory num)))
	  (message "Couldn't find url that this is annotating!")))
    (message "This isn't a personal annotation.")))

(defun w3-personal-annotation-add ()
  "Add an annotation to this document."
  (interactive)
  (let ((url (url-view-url t))
	(buf (get-buffer-create "*Personal Annotation*"))
	(title (read-string "Title: "
			    (format "Annotation by %s on %s"
				    (user-real-login-name)
				    (current-time-string)))))
    (set-buffer buf)
    (if w3-mutable-windows (pop-to-buffer buf) (switch-to-buffer buf))
    (erase-buffer)
    (if (and w3-annotation-mode (fboundp w3-annotation-mode))
	(funcall w3-annotation-mode)
      (message "%S is undefined, using %S" w3-annotation-mode
	       default-major-mode)
      (funcall default-major-mode))
    (w3-annotation-minor-mode 1)
    (setq w3-current-annotation (cons url title))
    (insert "<htmlplus>\n"
	    " <head>\n"
	    "  <title>" title "</title>"
	    " </head>\n"
	    " <div1>\n"
	    "  <h1>" title "</h1>\n"
	    "  <p>\n"
	    "   <address>" (user-full-name) url-personal-mail-address
	    "</address>\n"
	    "   <address>" (current-time-string) "</address>\n"
	    "  </p>\n"
	    "  <pre>\n")
    (save-excursion
      (insert "\n\n\n  </pre>\n")
      (insert " </div1>\n"
	      "</htmlplus>"))
    (message "Hit C-cC-c to send this annotation.")))

(defun w3-annotation-minor-mode (&optional arg)
  "Minimal minor mode for entering annotations.  Just rebinds C-cC-c to
finish the annotation."
  (interactive "P")
  (cond
   ((null arg) (setq w3-annotation-minor-mode (not w3-annotation-minor-mode)))
   ((= 0 arg)  (setq w3-annotation-minor-mode nil))
   (t          (setq w3-annotation-minor-mode t)))
  (cond
   ((or w3-running-FSF19 w3-running-lemacs))
   (t (local-set-key "\C-c\C-c" 'w3-personal-annotation-finish)))
  )

(defun w3-annotation-find-highest-number ()
  "Find the highest annotation number in this buffer"
  (let (x)
    (goto-char (point-min))
    (while (re-search-forward "[^ \\\t\\\n]*[ \\\t]\\(.*\\)" nil t)
      (setq x (nconc (mapcar (function (lambda (x) (string-to-int (car x))))
			     (w3-split (buffer-substring (match-beginning 1)
							 (match-end 1))
				       "[ \\\t]")) x)))
    (if (not x) (setq x '(0)))
    (1+ (car (sort x '>)))))

(defun w3-personal-annotation-finish ()
  "Finish doing a personal annotation."
  (interactive)
  (cond
   ((or w3-running-FSF19 w3-running-lemacs))
   (t (local-set-key "\C-c\C-c" 'undefined)))
  (if (or (not w3-personal-annotation-directory)
	  (not (file-exists-p w3-personal-annotation-directory))
	  (not (file-directory-p w3-personal-annotation-directory)))
      (error "No personal annotation directory!")
    (let ((url (car w3-current-annotation))
	  (txt (buffer-string))
	  (title (cdr w3-current-annotation))
	  (fname nil)
	  (num nil))
      (save-excursion
	(not-modified)
	(kill-buffer (current-buffer))
	(set-buffer (get-buffer-create " *annotmp*"))
	(erase-buffer)
	(if (file-exists-p		; Insert current LOG file if
					; it exists.
	     (format "%s/LOG" w3-personal-annotation-directory))
	    (insert-file-contents
	     (format "%s/LOG" w3-personal-annotation-directory))
	  (progn			; Otherwise, create a file
	    (goto-char (point-min))	; that conforms to first
					; annotation format from NCSA
	    (w3-insert "ncsa-mosaic-personal-annotation-log-format-1\n")
	    (w3-insert "Personal\n")))
	(goto-char (point-min))
	(setq num (int-to-string (w3-annotation-find-highest-number))
	      fname (format "%s/PAN-%s.html"
			    w3-personal-annotation-directory num))
	(goto-char (point-min))
	(if (re-search-forward (regexp-quote url) nil t)
	    (progn
	      (end-of-line)
	      (w3-insert " "))
	  (goto-char (point-max))
	  (w3-insert "\n" url " "))
	(w3-insert num)
	(let ((make-backup-files nil)
	      (version-control nil)
	      (require-final-newline t))
	  (write-region (point-min) (point-max)
			(format "%s/LOG" w3-personal-annotation-directory))
	  (erase-buffer)
	  (w3-insert w3-annotation-marker txt)
	  (write-region (point-min) (point-max) fname))
	(setq w3-personal-annotations
	      (cons (list url (list num title)) w3-personal-annotations))))))

(defun w3-annotation-add ()
  "Add an annotation to the current document."
  (interactive)
  (w3-personal-annotation-add))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Support for printing
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun w3-print-this-url (&optional url)
  "Print out the current document (in LaTeX format)"
  (interactive)
  (if (not url) (setq url (url-view-url t)))
  (let* ((completion-ignore-case t)
	 (format (completing-read
		  "Format: "
		  '(("HTML Source") ("Formatted Text") ("LaTeX'd"))
		  nil t)))
    (save-excursion
      (cond
       ((equal "HTML Source" format)
	(if w3-current-source
	    (let ((x w3-current-source))
	      (set-buffer (get-buffer-create w3-working-buffer))
	      (erase-buffer)
	      (insert x))
	  (url-retrieve url))
	(lpr-buffer))
       ((equal "Formatted Text" format)
	(lpr-buffer))
       ((equal "LaTeX'd" format)
	(if w3-current-source
	    (let ((x w3-current-source))
	      (set-buffer (get-buffer-create w3-working-buffer))
	      (erase-buffer)
	      (insert x))
	  (url-retrieve url))
	(w3-convert-html-to-latex)
	(save-window-excursion
	  (write-region (point-min) (point-max)
			(expand-file-name "w3-tmp.latex"
					  w3-temporary-directory) nil 5)
	  (shell-command
	   (format
	    "cd %s ; latex w3-tmp.latex ; %s w3-tmp.dvi ; rm -f w3-tmp*"
	    w3-temporary-directory
	    w3-print-command))
	  (kill-buffer "*Shell Command Output*")))))))

(defun w3-print-url-under-point ()
  "Print out the url under point (in LaTeX format)"
  (interactive)
  (w3-print-this-url (w3-view-this-url t)))

(defun w3-convert-html-to-latex ()
  "Convert an html document into LaTeX - this is pretty much the same as the
sed scripts from info.cern.ch"
  (interactive)
  (set-buffer w3-working-buffer)
  (if w3-use-html2latex
      (shell-command-on-region (point-min) (point-max)
			       (format "%s %s" w3-html2latex-prog
				       w3-html2latex-args) t)
    (progn
      (goto-char (point-min))
      (w3-replace-regexp "\\\\" "\\\\backslash ")
      (w3-replace-regexp "{" "\\\\{")
      (w3-replace-regexp "}" "\\\\}")
      (goto-char (point-min))
      (w3-insert (concat "\\documentstyle" w3-latex-docstyle "\n"))
      (w3-insert "\\begin{document}\n")
      (goto-char (point-max))
      (w3-insert "\\end{document}")
      (w3-replace-regexp "<\\(XMP\\|LISTING\\)>" "\\\\begin{verbatim}")
      (w3-replace-regexp "</\\(XMP\\|LISTING\\)>" "\\\\end{verbatim}")
      (w3-replace-regexp "<\\(ISINDEX\\|NEXTID\\)[^>]*>" "")
      (w3-replace-regexp (regexp-quote "$") "\\\\$")
      (w3-replace-regexp (regexp-quote "&gt;") "$>$")
      (w3-replace-regexp "%" "\\\\%")
      (w3-replace-regexp "#" "\\\\#")
      (w3-replace-regexp "_" "\\\\_")
      (w3-replace-regexp "~" "\\\\~")
      (w3-replace-regexp "<LI> *" "\\\\item ")
      (w3-replace-regexp (regexp-quote "^") "\\\\^")
      (w3-replace-regexp "<P>" "\\\\par")
      (w3-replace-regexp "<TITLE>\\([^<]*\\)</TITLE>" "\\\\section{\\1}")
      (w3-replace-regexp "<IMG *SRC=\"\\([^\"]*.ps\\)\">"
			 "\\\\psfig{figure=\\1,width=\\\\columnwidth}")
      (w3-replace-regexp "<H1>" "\\\\section{")
      (w3-replace-regexp "<H2>" "\\\\subsection{")
      (w3-replace-regexp "<H3>" "\\\\subsubsection{")
      (w3-replace-regexp "<H4>" "\\\\subsubsection{")
      (w3-replace-regexp "<H5>" "\\\\paragraph{")
      (w3-replace-regexp "<H6>" "\\\\subparagraph{")
      (w3-replace-regexp "</H[0-9]*>" "}")
      (w3-replace-regexp "<\\(UL\\|DIR\\|MENU\\)>" "\\\\begin{itemize}")
      (w3-replace-regexp "</\\(UL\\|DIR\\|MENU\\)>" "\\\\end{itemize}")
      (w3-replace-regexp "<OL>" "\\\\begin{enumerate}")
      (w3-replace-regexp "</OL>" "\\\\end{enumerate}")
      (w3-replace-regexp "<DL>" "\\\\begin{description}")
      (w3-replace-regexp "</DL>" "\\\\end{description}")
      (w3-replace-regexp "<DT>\\([^<]*$\\)" "\\\\item[\\1]")
      (w3-replace-regexp "<DD>" "")
      (w3-replace-regexp "<A[ \t\n]+[^>]*>" "")   ;; get rid of anchors
      (w3-replace-regexp "</A>" "")
      (w3-replace-regexp
       "<\\(EM\\|B\\|STRONG\\|DFN\\)>\\([^<]*\\)</\\(EM\\|B\\|STRONG\\|DFN\\)>"
       "{\\\\bf \\2}")
      (w3-replace-regexp
       "<\\(CODE\\|SAMP\\|TT\\|KBD\\|VAR\\)>\\([^<]*\\)</\\(CODE\\|SAMP\\|TT\\|KBD\\|VAR\\)>"
       "{\\\\tt \\2}")
      (w3-replace-regexp
       "<\\(CITE\\|U\\)>\\([^<]*\\)</\\(CITE\\|U\\)>" "{\\\\underline \\2}")
      (w3-replace-regexp
       "<\\(I\\|ADDRESS\\)>\\([^<]*\\)</\\(I\\|ADDRESS\\)>" "{\\\\it \\2}")
      (w3-replace-regexp "<IMG[^>]*>" "")
      (w3-replace-regexp (regexp-quote "&lt;") "$<$")
      (w3-replace-regexp (regexp-quote "&amp;") " and ")
      (w3-replace-regexp "<[^>]*>" ""))))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Functions to pass files off to external viewers
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun w3-start-viewer (fname cmd &optional view)
  "Start a subprocess, named FNAME, executing CMD
If third arg VIEW is non-nil, show the output in a buffer when
the subprocess exits."
  (if view (save-excursion
	     (set-buffer (get-buffer-create view))
	     (erase-buffer)))
  (let ((proc
	 (start-process fname view (or (getenv "ESHELL")
				       (getenv "SHELL")
				       "/bin/sh") "-c" cmd)))
    proc))

(defun w3-viewer-filter (proc string)
  "A process filter for asynchronous external viewers"
  (let ((buff (get-buffer-create (w3-generate-new-buffer-name
				  (symbol-name
				   (read (nth 2 (process-command proc))))))))
    (save-excursion
      (set-buffer buff)
      (erase-buffer)
      (insert string)
      (set-process-buffer proc buff)
      (set-process-filter proc nil))))

(defun w3-viewer-sentinel (proc string)
  "Delete any temp files left from a viewer process."
  (let ((fname (process-name proc))
	(buffr (process-buffer proc)))
    (if (and (file-exists-p fname)
	     (file-writable-p fname))
	(delete-file fname))
    (if buffr
	(if w3-mutable-windows
	    (pop-to-buffer buffr)
	  (switch-to-buffer buffr)))))

(defun w3-pass-to-viewer ()
  "Pass a w3 buffer to a viewer based on file extension."
  (set-buffer w3-working-buffer)
  (let* ((info  url-current-mime-viewer) 	   ; All the MIME viewer info
	 (view (cdr (assoc "viewer" info))) 	   ; How to view this file
	 (fmt  (cdr (assoc "nametemplate" info)))) ; Template for name
                                                   ; of temp file
    (if (null view)
	(setq view 'indented-text-mode))
    (cond
     ((symbolp view)
      (if (not (memq view '(w3-prepare-buffer w3-print w3-source)))
	  (let ((bufnam (w3-generate-new-buffer-name
			 (file-name-nondirectory url-current-file))))
	    (rename-buffer bufnam)
	    (set-buffer-modified-p nil)
	    (if w3-mutable-windows
		(pop-to-buffer bufnam)
	      (switch-to-buffer bufnam))
	    (buffer-enable-undo)
	    (funcall view))
	(funcall view)))
     ((stringp view)
      (let ((fname (w3-generate-unique-filename fmt)) proc)
	(if (url-file-directly-accessible-p (url-view-url t))
	    (make-symbolic-link url-current-file fname t)
	  (if (boundp 'MULE)
	      (write-region (point-min) (point-max) fname nil nil *noconv*)
	    (write-region (point-min) (point-max) fname)))
	(kill-buffer w3-working-buffer)
	(message (concat "Passing to viewer " view) fname)
	(setq proc (w3-start-viewer fname (format view fname)))
	(set-process-filter proc 'w3-viewer-filter)
	(set-process-sentinel proc 'w3-viewer-sentinel)))
     ((listp view)
      (set-buffer-modified-p nil)
      (buffer-enable-undo)
      (eval view))
     (t
      (message "Unknown viewer specified: %S" view)
      (switch-to-buffer w3-working-buffer)))))

(defun w3-save-binary-file ()
  (interactive)
  (let ((x (read-file-name "Filename to save as: "
			   (expand-file-name
			    (or url-current-file "") "~/") "")))
    (save-excursion
      (if (boundp 'MULE)
	  (write-region (point-min) (point-max) x nil nil *noconv*)
	(write-region (point-min) (point-max) x))
      (kill-buffer (current-buffer)))))

(fset 'w3-generate-new-buffer-name 'url-generate-new-buffer-name)
(fset 'w3-generate-unique-filename 'url-generate-unique-filename)
(defvar w3-lazy-message-time 0)

(defun w3-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 w3-show-status is nil."
  (if (or (null w3-show-status)
	  (= w3-lazy-message-time
	     (setq w3-lazy-message-time (nth 1 (current-time)))))
      nil
    (apply 'message args)))

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

(if (fboundp 'current-time)
    (fset 'w3-lazy-message 'w3-lazy-message-1)
  (fset 'w3-lazy-message 'w3-lazy-message-2))

(defun w3-build-url (protocol)
  "Build a url for PROTOCOL, return it as a string"
  (interactive (list (cdr (assoc (completing-read
				  "Protocol: "
				  w3-acceptable-protocols-alist nil t)
				 w3-acceptable-protocols-alist))))
  (let (user host port file)
    (cond
     ((null protocol) (error "Protocol is unknown to me!"))
     ((string= protocol "news")
      (setq host (read-string "Enter news server name, or blank for default: ")
	    port (read-string "Enter port number, or blank for default: ")
	    file (read-string "Newgroup name or Message-ID: ")))
     ((string= protocol "mailto") (setq file (read-string "E-mail address: ")))
     ((string= protocol "http")
      (setq host (read-string "Enter server name: ")
	    port (read-string "Enter port number, or blank for default: ")
	    file (read-string "Remote file: "))
      (and (string= "" port) (setq port nil))
      (and (string= "" host) (error "Must specify a remote machine!")))
     ((string= protocol "file")
      (if (funcall w3-confirmation-func "Local file?")
	  (setq file (read-file-name "Local File: " nil nil t))
	(setq user (read-string "Login as user (blank=anonymous): ")
	      host (read-string "Remote machine name: "))
	(and (string= user "") (setq user "anonymous"))
	(and (string= host "") (error "Must specify a remote machine!"))
	(setq file (read-file-name "File: " (format "/%s@%s:" user host)
				   nil t)
	      file (substring file (length (format "/%s@%s:" user host))))))
     ((or (string= protocol "telnet")
	  (string= protocol "tn3270"))
      (setq user (read-string "Login as user (blank=none): ")
	    host (read-string "Remote machine name: ")
	    port (read-string "Port number (blank=23): "))
      (and (string= "" port) (setq port nil))
      (and (string= "" user) (setq user nil))
      (and (string= "" host) (error "Must specify a host machine!")))
     ((string= protocol "gopher")
      (setq host (read-string "Enter server name: ")
	    port (read-string "Enter port number, or blank for default: ")
	    file (read-string "Remote file: "))
      (and (string= "" port) (setq port nil))
      (and (string= "" host) (error "Must specify a remote machine!"))))
    (message "%s:%s%s"
	     protocol
	     (if (null host) "" (concat "//" host
					(if (null port) "" (concat ":" port))))
	     (if (= ?/ (string-to-char file)) file (concat "/" file)))))

;;;###autoload
(defun w3-open-local (fname)
  "Find a local file, and interpret it as a hypertext document.
This is part of the emacs World Wide Web browser.  It will prompt for
an existing file or directory, and retrieve it as a hypertext document.
If it is a directory, and w3-directory-format is 'hypertext, then an
HTML directory listing is created on the fly.  Otherwise, dired-mode is
used to visit the buffer."
  (interactive "FLocal file: ")
  (if (not w3-setup-done) (w3-do-setup))
  (w3-fetch (concat "file:" fname)))

;;;###autoload
(defun w3-fetch (&optional url)
  "Retrieve a document over the World Wide Web.
The World Wide Web is a global hypertext system started by CERN in
Switzerland in 1991.

The document should be specified by its fully specified
Uniform Resource Locator.  The document will be parsed, printed, or
passed to an external viewer as appropriate.  See the variable
mm-mime-info for how to specify a viewer for a file type."
  (interactive (list
		(progn
		  (if (not w3-setup-done) (w3-do-setup))
		  (let ((completion-ignore-case t))
		    (completing-read "URL: "
				     url-global-history-completion-list
				     nil nil
				      (if (eq major-mode 'w3-mode)
					  (if (and current-prefix-arg
						   (w3-view-this-url t))
					      (w3-view-this-url t)
					    (url-view-url t))
					(url-get-url-at-point)))))))
  (setq w3-working-buffer url-working-buffer)
  (if (= (string-to-char url) ?#)
      (w3-relative-link url)
    (let ((x (url-view-url t))
	  (lastbuf (current-buffer))
	  (buf (url-buffer-visiting url)))
      (if (not w3-setup-done) (w3-do-setup))
      (if (string= "file:nil" x) (setq x nil))
      (if (or (not buf)
	      (cond
	       ((eq w3-reuse-buffers 'no) t)
	       ((eq w3-reuse-buffers 'yes) nil)
	       (t
		(if w3-reuse-buffers
		    (progn
		      (ding)
		      (message
		       "Warning: Invalid value for variable w3-reuse-buffers: %s"
		       (prin1-to-string w3-reuse-buffers))
		      (sit-for 2)))
		(not (funcall w3-confirmation-func
			      (format "URL found in buffer %10s, reuse "
				      (buffer-name buf)))))))
	  (progn
	    (url-retrieve url)
	    (w3-add-urls-to-history x url)
	    (if (get-buffer w3-working-buffer)
		(cond
		 ((and url-be-asynchronous (string-match "^http:" url)) nil)
		 (t (w3-sentinel lastbuf)))))
	(switch-to-buffer buf)))))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; History for forward/back buttons
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun w3-forward-in-history ()
  "Go forward in the history from this page"
  (interactive)
  (let* ((x (intern (url-view-url t)))
	 (y (get 'w3-history-forward x))
	 (w3-reuse-buffers 'yes)
	 (url (car y))
	 (buf (car (cdr y))))
    (if (or (null y) (eq y 'none)) (error "No forward found for %s" x))
    (if (and buf (buffer-name buf))
	(progn
	  (switch-to-buffer buf))
      (w3-fetch url))))

(defun w3-backward-in-history ()
  "Go backward in the history from this page"
  (interactive)
  (let* ((x (intern (url-view-url t)))
	 (y (get 'w3-history-backward x))
	 (w3-reuse-buffers 'yes)
	 (url (car y))
	 (buf (car (cdr y))))
    (if (or (null y) (eq y 'none)) (error "No backward found for %s" x))
    (if (and buf (buffer-name buf))
	(progn
	  (switch-to-buffer buf))
      (w3-fetch url))))

(defun w3-add-urls-to-history (referer url)
  "REFERER is the url we followed this link from.  URL is the link we got to."
  (let ((x (and referer (intern referer)))
	(y (and url (intern url))))
    (setq referer
	  (cond
	   (referer (list referer w3-current-last-buffer))
	   (t 'none)))
    (setq url
	  (cond
	   (url (list url (current-buffer)))
	   (t 'none)))
    (put 'w3-history-forward x url)
    (put 'w3-history-backward y referer)))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Miscellaneous functions
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(fset 'w3-quotify-percents 'url-quotify-percents)

(defun w3-use-starting-documents ()
  "Use the list of predefined starting documents from w3-starting-documents"
  (interactive)
  (let ((w3-hotlist w3-starting-documents))
    (w3-use-hotlist)))

(defun w3-show-starting-documents ()
  "Show the list of predefined starting documents from w3-starting-documents"
  (interactive)
  (if (not w3-setup-done) (w3-do-setup))
  (w3-fetch "www://auto/starting-points"))

(defun w3-insert-formatted-url (p)
  "Insert a formatted url into a buffer.  With prefix arg, insert the url
under point."
  (interactive "P")
  (let (buff str)
    (cond
     (p
      (setq p (w3-view-this-url t))
      (or p (error "No url under point"))
      (setq str (format "<A HREF=\"%s\">%s</A>" p
			(read-string "Link text: "
				     (nth 3 (w3-zone-data
					     (w3-zone-at (point))))))))
     (t
      (setq str (format "<A HREF=\"%s\">%s</A>" (url-view-url t)
			(read-string "Link text: " (buffer-name))))))
    (setq buff (read-buffer "Insert into buffer: " nil t))
    (if buff
	(save-excursion
	  (set-buffer buff)
	  (w3-insert str))
      (message "Cancelled."))))

(defun w3-length-after-parsing (str)
  "Returns the length of a string after removing all text between
<>, and resolving all HTML entity references"
  (let ((tmp ""))
    (while (string-match "\\([^<]*\\)<[^>]+>" str)
      (setq tmp (concat tmp (w3-match str 1))
	    str (substring str (match-end 0) nil)))
    (setq tmp (concat tmp str))
    (setq tmp (w3-fix-entities-in-string tmp))
    (length tmp)))

(defun w3-first-n-items (l n)
  "Return the first N items from list L"
  (let ((x 0)
	y)
    (if (> n (length l))
	(setq y l)
      (while (< x n)
	(setq y (nconc y (list (nth x l)))
	      x (1+ x))))
    y))

(defun w3-breakup-menu (menu-desc max-len)
  (if (> (length menu-desc) max-len)
      (cons (cons "More..." (w3-first-n-items menu-desc max-len))
	    (w3-breakup-menu (nthcdr max-len menu-desc) max-len))
    menu-desc))

(defun w3-follow-url-at-point (&optional pt)
  "Follow the URL under PT, defaults to link under (point)"
  (interactive "d")
  (w3-fetch (url-get-url-at-point pt)))

;;;###autoload
(defun w3-batch-fetch ()
  "Fetch all the URLs on the command line and save them to files in
the current directory.  The first argument after the -f w3-batch-fetch
on the command line should be a string specifying how to save the
information retrieved.  If it is \"html\", then the page will be
unformatted when it is written to disk.  If it is \"text\", then the
page will be formatted before it is written to disk.  If it is
\"binary\" it will not mess with the file extensions, and just save
the data in raw binary format.  If none of those, the default is
\"text\", and the first argument is treated as a normal URL."
  (if (not noninteractive)
      (error "`w3-batch-fetch' is to be used only with -batch"))
  (let ((fname "")
        (curname "")
	(x 0)
	(args (symbol-value 'command-line-args-left))
	(w3-strict-width 80)
	(w3-delimit-emphasis nil)
	(w3-delimit-links nil)
	(retrieval-function 'w3-fetch)
	(file-format "text")
	(header "")
	(file-extn ".txt"))
    (setq file-format (downcase (car args)))
    (cond
     ((string= file-format "html")
      (message "Saving all text as raw HTML...")
      (setq retrieval-function 'url-retrieve
	    file-extn ".html"
	    header "<BASE HREF=\"%s\">"
	    args (cdr args)))
     ((string= file-format "binary")
      (message "Saving as raw binary...")
      (setq retrieval-function 'url-retrieve
	    file-extn ""
	    args (cdr args)))
     ((string= file-format "text")
      (setq header "Text from: %s\n---------------\n")
      (message "Saving all text as formatted...")
      (setq args (cdr args)))
     (t
      (setq header "Text from: %s\n---------------\n")
      (message "Going with default, saving all text as formatted...")))
    (while args
      (funcall retrieval-function (car args))
      (goto-char (point-min))
      (if buffer-read-only (toggle-read-only))
      (insert (format header (car args)))
      (if (string= file-extn "") nil
	(setq fname (w3-file-extension (w3-basepath url-current-file t) t)))
      (if (string= (w3-strip-leading-spaces fname) "")
	  (setq fname "root"))
      (setq curname fname)
      (while (file-exists-p (concat curname file-extn))
	(setq curname (concat fname x)
	      x (1+ x)))
      (setq fname (concat curname file-extn))
      (write-region (point-min) (point-max) fname)
      (setq args (cdr args)))))

(fset 'w3-eat-trailing-space 'url-eat-trailing-space)
(fset 'w3-strip-leading-spaces 'url-strip-leading-spaces)

(defun w3-reload-all-files ()
  "Reload all w3 files"
  (interactive)
  (setq w3-setup-done nil
	url-setup-done nil
	w3-hotlist nil
	url-mime-accept-string nil
	w3-style-regexp nil)
  (let ((x '(w3 w3-mule w3-emacs w3-e19 w3-epoch mm url w3-lemac w3-next
		w3-mac w3-dos)))
    (while x
      (setq features (delq (car x) features)
	    x (cdr x)))
    (require 'w3))
  (w3-do-setup)
  (url-do-setup)
  )

(defun w3-source-document-at-point ()
  "View source to the document pointed at by link under point"
  (interactive)
  (w3-source-document t))

(defun w3-source-document (under)
  "View this documents source"
  (interactive "P")
  (let* ((url (if under (w3-view-this-url) (url-view-url t)))
	 (src
	  (cond
	   ((and under (null url)) (message "No link at point!"))
	   ((and (not under) w3-current-source) w3-current-source)
	   (t
	    (prog2
		(url-retrieve url)
		(buffer-string)
	      (kill-buffer (current-buffer))))))
	 (tmp (w3-generate-new-buffer-name url)))
    (if (not url) nil
      (set-buffer (get-buffer-create tmp))
      (insert src)
      (goto-char (point-min))
      (buffer-enable-undo)
      (set-buffer-modified-p nil)
      (if w3-mutable-windows (pop-to-buffer tmp) (switch-to-buffer tmp)))))

(defun w3-mail-document-under-point ()
  "Mail the document pointed to by the hyperlink under point."
  (interactive)
  (w3-mail-current-document t))

(defun w3-mail-current-document (under)
  "Mail the current-document to someone"
  (interactive "P")
  (let* ((completion-ignore-case t)
	 (format (completing-read
		  "Format: "
		  '(("HTML Source") ("Formatted Text") ("LaTeX Source"))
		  nil t))
	 (url (cond
	       ((stringp under) under)
	       (under (w3-view-this-url t))
	       (t (url-view-url t))))
	 (str
	  (save-excursion
	    (cond
	     ((and (equal "HTML Source" format) under)
	      (let ((url-source t))
		(url-retrieve url)))
	     ((equal "HTML Source" format)
	      (if w3-current-source
		  (let ((x w3-current-source))
		    (set-buffer (get-buffer-create w3-working-buffer))
		    (erase-buffer)
		    (insert x))
		(url-retrieve url)))
	     ((and under (equal "Formatted Text" format))
	      (w3-fetch url))
	     ((equal "Formatted Text" format) nil)
	     ((and under (equal "LaTeX Source" format))
	      (url-retrieve url)
	      (w3-convert-html-to-latex))
	     ((equal "LaTeX Source" format)
	      (if w3-current-source
		  (let ((x w3-current-source))
		    (set-buffer (get-buffer-create w3-working-buffer))
		    (erase-buffer)
		    (insert x))
		(url-retrieve url))
	      (w3-convert-html-to-latex)))
	    (buffer-string))))
    (cond
     ((and w3-mutable-windows (fboundp w3-mail-other-window-command))
      (funcall w3-mail-other-window-command))
     ((fboundp w3-mail-command)
      (funcall w3-mail-command))
     (w3-mutable-windows (mail-other-window))
     (t (mail)))
    (mail-subject)
    (w3-insert (format "%s from URL %s" format url))
    (re-search-forward mail-header-separator nil)
    (forward-char 1)
    (while (< (current-column) 79) (w3-insert "-"))
    (w3-insert "\n" (if (equal "HTML Source" format)
			(format "<BASE HREF=\"%s\">" url) "") str "\n")
    (while (< (current-column) 79) (w3-insert "-"))
    (mail-to)))

(defun w3-internal-use-history (hist-item)
  "Go to the link in the history"
  (let ((url (nth 0 hist-item))
	(buf (nth 1 hist-item))
	(pnt (nth 2 hist-item)))
    (cond
     ((null buf)			; Find a buffer with same url
      (let ((x (buffer-list))
	    (found nil))
	(while (and x (not found))
	  (save-excursion
	    (set-buffer (car x))
	    (setq found (string= (url-view-url t) url))
	    (if (not found) (setq x (cdr x)))))
	(cond
	 (found
	  (switch-to-buffer (car x))
	  (if (number-or-marker-p pnt) (goto-char pnt)))
	 (t
	  (w3-fetch url)))))
     ((buffer-name buf)			; Reuse the old buffer if possible
      (switch-to-buffer buf)
      (if (number-or-marker-p pnt) (goto-char pnt))
      (if (and url (= ?# (string-to-char url)))	; Destination link
	  (progn
	    (goto-char (point-min))
	    (w3-find-specific-link (substring url 1 nil)))))
     (url (url-maybe-relative url))		; Get the link
     (t (message "Couldn't understand whats in the history.")))))

(defun w3-relative-link (url)
  (if (equal "#" (substring url 0 1))
      (progn
	(push-mark (point) t)
	(goto-char (point-min))
	(w3-find-specific-link (substring url 1 nil)))
    (w3-fetch (url-parse-relative-link url))))

(defun w3-maybe-eval ()
  "Maybe evaluate a buffer of emacs lisp code"
  (if (funcall w3-confirmation-func "This is emacs-lisp code, evaluate it?")
      (eval-current-buffer)
    (emacs-lisp-mode)))

(defun w3-build-continuation ()
  "Build a series of functions to be run on this file"
  (save-excursion
    (set-buffer w3-working-buffer)
    (let ((cont w3-default-continuation)
	  (extn (w3-file-extension url-current-file)))
      (if (assoc extn url-uncompressor-alist)
	  (setq extn (w3-file-extension
		      (substring url-current-file 0 (- (length extn))))))
      (if w3-source
	  (setq url-current-mime-viewer '(("viewer" . w3-source))))
      (if (not url-current-mime-viewer)
	  (setq url-current-mime-viewer
		(mm-mime-info (or url-current-mime-type
				  (mm-extension-to-mime extn)) nil 5)))
      (if url-current-mime-viewer
	  (setq cont (append cont '(w3-pass-to-viewer)))
	(setq cont (append cont (list w3-default-action))))
      cont)))

(defun w3-use-links ()
  "Select one of the <LINK> tags from this document and fetch it."
  (interactive)
  (and (not w3-current-links)
       (error "No <LINK> tags in this document."))
  (let* ((completion-ignore-case t)
	 (type (cdr (assoc
		     (completing-read "Type of relation: "
				      '(("Reverse" . "rev") ("Normal" . "rel"))
				      nil t "normal")
		     '(("Reverse" . "rev") ("Normal" . "rel")))))
	 (table nil)
	 (x w3-current-links)
	 y)
    (while x
      (setq y (car x)
	    x (cdr x))
      (if (assoc type y)
	  (setq table (cons
		       (cons (cdr (assoc type y)) (cdr (assoc "href" y)))
		       table))))
    (w3-fetch (cdr (assoc (completing-read "Link: " table nil t) table)))))

(fset 'w3-hexify-string 'url-hexify-string)

(defun w3-find-this-file ()
  "Do a find-file on the currently viewed html document if it is a file: or
ftp: reference"
  (interactive)
  (cond
   ((and (null url-current-type)
	 (eq major-mode 'w3-mode))
    (if w3-mutable-windows
	(find-file-other-window url-current-file)
      (find-file url-current-file)))
   ((equal url-current-type "ftp")
    (if w3-mutable-windows
	(find-file-other-window
	 (format "/anonymous@%s:%s" url-current-server url-current-file))
      (find-file
       (format "/anonymous@%s:%s" url-current-server url-current-file))))
   (t (message "Sorry, I can't get that file so you can alter it."))))

(defun w3-delete-from-alist (x alist)
  "Remove X from ALIST, return new alist"
  (if (eq (assoc x alist) (car alist)) (cdr alist)
    (delq (assoc x alist) alist)))

(defun w3-count-occurences (regexp)
  "Count # of matches for REGEXP after point. Modified from the how-many
function of emacs19"
  (let ((n 0) opoint)
    (save-excursion
      (while (and (not (eobp))
		  (progn (setq opoint (point))
			 (re-search-forward regexp nil t)))
	(if (= opoint (point))
	    (forward-char 1)
	  (setq n (1+ n)))))
    n))

(defun w3-insert-this-url (pref-arg)
  "Insert the current url in another buffer, with prefix ARG, insert URL under point"
  (interactive "P")
  (let ((thebuf (get-buffer (read-buffer "Insert into buffer: ")))
	(oldbuf (current-buffer))
	(url (if pref-arg (w3-view-this-url t) (url-view-url t))))
    (if (not (equal "Not on a link!" url))
	(progn
	  (set-buffer thebuf)
	  (w3-insert url)
	  (set-buffer oldbuf)))))

(defun w3-show-hotlist ()
  "View the hotlist in hypertext form"
  (interactive)
  (if (not w3-setup-done) (w3-do-setup))
  (if (not w3-hotlist)
      (error "Sorry, no hotlist is in memory.")
    (w3-fetch "www://auto/hotlist")))

(defun w3-lookup-style (type)
  "Return the physical style of logical style <TYPE>"
  (let ((x (cdr (assoc type w3-style-assoc))))
    (if (symbolp x) (symbol-value x) x)))

(defun url-maybe-relative (url)
  "Take a url and either fetch it, or resolve relative refs, then fetch it"
  (cond
   ((not
     (string-match url-nonrelative-link url))
    (w3-relative-link url))
   (t (w3-fetch url))))

(defun w3-in-assoc (elt list)
  "Check to see if ELT matches any of the regexps in the car elements of LIST"
  (let (rslt)
    (while (and list (not rslt))
      (and (car (car list))
	   (not (string= (car (car list)) ""))
	   (string-match (car (car list)) elt)
	   (setq rslt (car list)))
      (setq list (cdr list)))
    rslt))

(fset 'w3-member 'url-member)

(defun w3-goto-last-buffer ()
  "Go to last WWW buffer visited"
  (interactive)
  (if w3-current-last-buffer
      (if w3-mutable-windows
	  (pop-to-buffer w3-current-last-buffer)
	(switch-to-buffer w3-current-last-buffer))
    (message "No previous buffer found.")))

(fset 'w3-file-extension 'url-file-extension)
(fset 'w3-basepath 'url-basepath)
(fset 'w3-replace-regexp 'url-replace-regexp)

;;;###autoload
(defun w3-preview-this-buffer ()
  "See what this buffer will look like when its formatted as HTML.
HTML is the HyperText Markup Language used by the World Wide Web to
specify formatting for text.  More information on HTML can be found at
info.cern.ch:/pub/www/doc."
  (interactive)
  (w3-fetch (concat "www://preview/" (buffer-name))))

(fset 'w3-unhex 'url-unhex)
(fset 'w3-unhex-string 'url-unhex-string)

(defun w3-rassoc (key list)
  "An 'rassoc' function - don't want to bother with loading cl just
for this function"
  (let ((found nil))
    (while (and list (not found))
      (if (equal (cdr (car list)) key) (setq found (car list)))
      (setq list (cdr list)))
    found))

(defun w3-insert-entities-in-string (str)
  "Remove special characters in STR and replace them with HTML[+] entities"
  (mapconcat
   (function
    (lambda (x)
      (cond
       ((= x ?<) "&lt;")
       ((= x ?>) "&gt;")
       ((= x ?&) "&amp;")
       ((= x ? ) "&ensp;")
       (t (char-to-string x))))) str ""))

(defun w3-fix-entities-in-string (str)
  "Remove &xxx; entities in string STR"
  (let ((tmp "")
	(regexp (concat "\\(" (mapconcat (function (lambda (x) (car x)))
					 w3-html-entities "\\|") "\\)"))
	(x nil))
    (while (string-match regexp str)
      (setq x (cdr (assoc (w3-match str 1) w3-html-entities))
	    tmp (format "%s%s%s" tmp (substring str 0 (match-beginning 0)) x)
	    str (substring str (match-end 0))))
    (setq tmp (concat tmp str))
    tmp))

(defun w3-edit-source ()
  "Edit the html document just retrieved"
  (set-buffer w3-working-buffer)
  (let ((ttl (format "Editing %s Annotation: %s"
		     (cond
		      ((eq w3-editing-annotation 'group) "Group")
		      ((eq w3-editing-annotation 'personal) "Personal")
		      (t "Unknown"))
		     (w3-basepath url-current-file t)))
	(str (buffer-string)))
    (set-buffer (get-buffer-create ttl))
    (w3-insert str)
    (kill-buffer w3-working-buffer)))

(fset 'w3-clean-text 'url-clean-text)

(defun w3-source ()
  "Show the source of a file"
  (let ((tmp (buffer-name (generate-new-buffer "Document Source"))))
    (set-buffer w3-working-buffer)
    (kill-buffer tmp)
    (rename-buffer tmp)
    (set-buffer-modified-p nil)
    (buffer-enable-undo)
    (if w3-mutable-windows (pop-to-buffer tmp) (switch-to-buffer tmp))))

(fset 'w3-uncompress 'url-uncompress)

(defun w3-sentinel (&optional proc string)
  (set-buffer w3-working-buffer)
  (if (or (stringp proc)
	  (bufferp proc)) (setq w3-current-last-buffer proc))
  (if (boundp 'after-change-functions)
      (remove-hook 'after-change-functions 'url-after-change-function))
  (if url-be-asynchronous
      (progn
	(w3-clean-text)
	(if (boundp 'MULE) (w3-convert-code-for-mule url-current-type
						     (url-view-url t)))
	(cond
	 ((not (get-buffer w3-working-buffer)) nil)
	 ((url-mime-response-p) (url-parse-mime-headers)))
	(if (not url-current-mime-type)
	    (setq url-current-mime-type (mm-extension-to-mime
					 (w3-file-extension
					  url-current-file))))))
  (let ((x (w3-build-continuation)))
    (while x
      (funcall (car x))
      (setq x (cdr x)))))

(defun w3-show-history-list ()
  "Format the url-history-list prettily and show it to the user"
  (interactive)
  (w3-fetch "www://auto/history"))

(defun w3-save-as ()
  "Save a document to the local disk"
  (interactive)
  (let* ((completion-ignore-case t)
	 (format (completing-read
		 "Format: "
		 '(("HTML Source") ("Formatted Text") ("LaTeX Source")
		   ("Binary"))
		 nil t))
	(fname (expand-file-name
		(read-file-name "File name: " default-directory)))
	(url (url-view-url t)))
    (cond
     ((equal "Binary" format)
      (if (not w3-current-source)
	  (let ((url-be-asynchronous nil))
	    (url-retrieve url))))
     ((equal "HTML Source" format)
      (if (not w3-current-source)
	  (let ((url-be-asynchronous nil))
	    (url-retrieve url))		; Get the document if necessary
	(let ((txt w3-current-source))
	  (set-buffer (get-buffer-create w3-working-buffer))
	  (insert txt)))
      (goto-char (point-min))
      (insert (format "<BASE HREF=\"%s\">\n" url)))
     ((equal "Formatted Text" format)
      nil)				; Do nothing - we have the text already
     ((equal "LaTeX Source" format)
      (if (not w3-current-source)
	  (let ((url-be-asynchronous nil))
	    (url-retrieve url))		; Get the file
	(let ((txt w3-current-source))
	  (set-buffer (get-buffer-create w3-working-buffer))
	  (insert txt)))
      (w3-convert-html-to-latex)))	; Convert to LaTeX
    (write-region (point-min) (point-max) fname)))

(defun w3-upcase-region (st nd)
  "Uppercase a region of text, ignoring text within < and >"
  (save-excursion
    (goto-char st)
    (while (re-search-forward "\\(<[^>]+>\\)\\|\\(&[^;]+;\\)" nd t)
      (upcase-region st (match-beginning 0))
      (setq st (match-end 0)))
    (upcase-region st nd)))



;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Functions to parse out <A> tags and replace it with a hyperlink zone
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(fset 'w3-match 'url-match)

(defun w3-popup-info (url)
  "Show information about the link under point. (All SGML attributes)"
  (let* ((ext (w3-zone-at (point)))
	 (dat (and ext (nth 4 (w3-zone-data ext)))))
    (save-excursion
      (set-buffer (get-buffer-create "*Header Info*"))
      (erase-buffer)
      (insert
       "Link attributes:\n" (make-string (1- (window-width)) ?-) "\n"
       (mapconcat
	(function (lambda (info) (format "%20s :== %s" (car info) (or (cdr info) "On"))))
	dat "\n")
       "\n" (make-string (1- (window-width)) ?-) "\n"
       (save-excursion (url-popup-info url)))
      (display-buffer (current-buffer) t))))

(defun w3-build-links-list ()
  "Build links out of url specs in the temporary buffer.  This function
looks in the buffer pointed to by w3-working-buffer.  The links will be
fully usable by w3-follow-link, etc."
  (set-buffer w3-working-buffer)
  (goto-char (point-min))
  (if buffer-read-only (toggle-read-only))
  (let* ((cur-id "")
	 (cur-txt "")
	 (cur-urn "")
	 (cur-rel "")
	 (cur-href "")
	 (cur-rev "")
	 (cur-title "")
	 (cur-meth "")
	 (been-visited nil)
	 (st-del "")
	 (nd-del "")
	 )
    (goto-char (point-min))
    (while (re-search-forward w3-link-begin-regexp nil t)
      (let* ((start (match-beginning 0))
	     (cur-url (prog1
			  (w3-parse-args (match-beginning 1) (match-end 1))
			(replace-match " ")))
	     (end   (if (re-search-forward w3-link-end-regexp nil t)
			(prog1
			    (match-beginning 0)
			  (replace-match ""))
		      (progn
			(end-of-line)
			(point)))))
	(save-excursion
	  (goto-char start)
	  (skip-chars-forward " \t")
	  (setq start (point))
	  (goto-char end)
	  (skip-chars-backward " \t")
	  (setq end (point)))
	(if (< end start) (setq cur-txt end
				end start
				start cur-txt))
	(setq cur-id (or (cdr (assoc "name" cur-url)) "")
	      cur-href (cdr (assoc "href" cur-url))
	      cur-rel (cdr (assoc "ref" cur-url))
	      cur-rev (cdr (assoc "rev" cur-url))
	      cur-urn (cdr (assoc "urn" cur-url))
	      cur-title (cdr (assoc "title" cur-url))
	      cur-meth (cdr (assoc "methods" cur-url))
	      cur-txt (w3-fix-entities-in-string
		       (buffer-substring start end)))
	(if (and cur-href
		 (not (string-match url-nonrelative-link cur-href)))
	    (setq cur-href (url-parse-relative-link cur-href)))
	(setq been-visited (url-have-visited-url cur-href))
	(cond
	 ((and (eq w3-delimit-links 'linkname) cur-href)
	  (goto-char end)
	  (skip-chars-backward " \\\t\\\n")
	  (w3-insert (concat (if been-visited "{" "[") cur-id
			     (if been-visited "}" "]"))))
	 ((and (not (null w3-delimit-links)) cur-href)
	  (setq st-del (if been-visited (cdr w3-link-start-delimiter)
			 (car w3-link-start-delimiter))
		nd-del (if been-visited (cdr w3-link-end-delimiter)
			 (car w3-link-end-delimiter)))
	  (goto-char start)
	  (skip-chars-forward " \\\t\\\n")
	  (w3-insert st-del)
	  (goto-char (+ end (length st-del)))
	  (skip-chars-backward " \\\t\\\n")
	  (w3-insert nd-del)
	  (setq end (+ end (length st-del) (length nd-del)))))
	(and w3-link-delimiter-info
	     (fboundp w3-link-delimiter-info)
	     (w3-insert (or (funcall w3-link-delimiter-info cur-href) "")))
	(if cur-href
	    (w3-add-zone start end (or (and been-visited w3-visited-node-style)
				       w3-node-style)
			 (list 'w3 cur-id cur-href cur-txt cur-url))
	  (w3-add-zone start end nil
		       (list 'w3 cur-id cur-href cur-txt
			     cur-url)))))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Functions to handle LINK attributes
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun w3-handle-links ()
  "Parse out the LINK attributes.
This will take the <LINK> attributes out of the current w3-working-buffer
and return an assoc list of the form (Rel or rev tag . url)"
  (set-buffer w3-working-buffer)
  (goto-char (point-min))
  (if buffer-read-only (toggle-read-only))
  (let* ((cur-href "")
	 (result nil))
    (goto-char (point-min))
    (while (re-search-forward "<LINK[ \\\t]+" nil t)
      (let* ((start (prog1 (match-beginning 0) (replace-match "")))
	     (end (prog2 (re-search-forward ">" nil t) (point)
		    (replace-match "")))
	     (cur-lnk (prog1
			  (w3-parse-args start (1- end))
			(delete-region start (1- end)))))
	(setq cur-href (cdr (assoc "href" cur-lnk)))
	(if (and cur-href (not (string-match url-nonrelative-link cur-href)))
	    (setq cur-href (url-parse-relative-link cur-href)))
	(setq result (cons cur-lnk result))))
    result))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Embedded document/image handling
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun w3-embed-text (data type)
  "Use DATA as extra text for this document."
  (set-buffer w3-working-buffer)
  (if (equal type "text/html") (insert data)
    (insert "<pre>" data "</pre>")))

(defun w3-embed-postscript (data type)
  "Embed a LaTeX document"
  (let ((fname (w3-generate-unique-filename)))
    (save-excursion
      (set-buffer (get-buffer-create " *w3-temp*"))
      (erase-buffer)
      (insert data)
      (write-region (point-min) (point-max) fname 5)
      (call-process "pstoxbm" nil nil nil fname fname)
      (erase-buffer)
      (insert-file-contents fname)
      (condition-case ()
	  (delete-file fname)
	(error nil))
      (setq fname (buffer-string))
      (kill-buffer (current-buffer)))
    (w3-embed-image fname "image/xbm")))

(defun w3-embed-mpeg (data type)
  "Embed an mpeg movie in the buffer"
  (let ((fnam "w3-img-")
	(x 0))
    (while (file-exists-p (expand-file-name
			   (concat fnam x ".mpg") w3-temporary-directory))
      (setq x (1+ x)))
    (setq fnam (expand-file-name (concat fnam x ".mpg")
				 w3-temporary-directory))
    (save-excursion
      (set-buffer (get-buffer-create " *w3-temp*"))
      (erase-buffer)
      (insert data)
      (write-region (point-min) (point-max) fnam nil 5)
      (set-buffer w3-working-buffer)
      (w3-add-delayed-mpeg fnam (point)))))

(defun w3-embed-eqn (data type)
  "Embed an equation in the buffer"
  (let ((fname (w3-generate-unique-filename)))
    (save-excursion
      (set-buffer (get-buffer-create " *w3-temp*"))
      (erase-buffer)
      (insert ".EQ" data ".EN")
      (call-process-region (point-min) (point-max) "eqn" t nil nil "|"
			   "groff" ">" fname)
      (erase-buffer)
      (call-process "pstoxbm" fname fname)
      (insert-file-contents fname)
      (condition-case () (delete-file fname) (error nil))
      (setq fname (buffer-string))
      (kill-buffer (current-buffer)))
    (w3-embed-image fname "image/xbm")))

(defun w3-embed-image (data type)
  "Use DATA as an image of content-type TYPE and insert it in the buffer."
  (let ((fnam "w3-img-")
	(extn (car (w3-rassoc type mm-mime-extensions)))
	(x 0))
    (while (file-exists-p
	    (expand-file-name (concat fnam x extn) w3-temporary-directory))
      (setq x (1+ x)))
    (setq fnam (expand-file-name (concat fnam x extn)
				 w3-temporary-directory))
    (save-excursion
      (set-buffer (get-buffer-create " *w3temp*"))
      (erase-buffer)
      (insert data)
      (write-region (point-min) (point-max) fnam 5)
      (kill-buffer (current-buffer)))
    (insert "<img src=\"file:" fnam "\" alt=\"embedded data\">")))

(defun w3-handle-embeds ()
  "Handle <EMBED>....</EMBED> tags."
  (goto-char (point-min))
  (let ((args nil)			; Attributes for current embed
	(type nil)			; Content-type for current embed
	(cvtr nil)			; Converter to xbm for current embed
	(data nil)			; Data between <embed> and </embed>
	(src nil)			; Optional SRC attribute
	(st nil)			; Start of embed tag
	)
  (while (re-search-forward "<EMBED\\([^>]*\\)>" nil t)
    (setq args (prog1
		   (w3-parse-args (match-beginning 1) (match-end 1))
		 (replace-match ""))
	  type (or (cdr (assoc "type" args)) "text/plain")
	  src (cdr (assoc "src" args))
	  cvtr (cdr (w3-in-assoc type w3-embedded-data-converters))
	  st (point))
    (cond
     (src
      (save-excursion
	(let ((w3-working-buffer " *w3-temp*")
	      (url-working-buffer " *w3-temp*")
	      (url-source t))
	  (if (string-match url-nonrelative-link src)
	      nil
	    (setq src (url-parse-relative-link src)))
	  (url-retrieve src)
	  (setq data (buffer-string))
	  (kill-buffer (current-buffer)))))
     ((re-search-forward "</embed>" nil t)
      (setq data (buffer-substring st (match-beginning 0)))
      (delete-region st (match-end 0)))
     (t
      (message "Nonterminated <embed> tag, trying to cope.")
      (setq cvtr nil)))
    (and (fboundp cvtr) (funcall cvtr data type)))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Functions to handle formatting an html buffer
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun w3-handle-personal-annotations ()
  "Take care of personal annotations"
  (w3-lazy-message "Finding personal annotations...")
  (let ((annos (w3-fetch-personal-annotations)))
    (if annos
	(progn
	  (goto-char (cond
		      ((eq w3-annotation-position 'bottom) (point-max))
		      ((eq w3-annotation-position 'top) (point-min))
		      (t (message "Bad value for w3-annotation-position")
			 (point-max))))
	  (w3-insert"<P><HR>\n<H1>Personal Annotations</H1><P><UL>")
	  (while annos
	    (w3-insert "\n<LI> " (car annos))
	    (setq annos (cdr annos)))
	  (w3-insert "</UL><HR>"))))
  (w3-lazy-message "Finding personal annotations... done."))

(defun w3-insert-headers ()
  "Insert some HTTP/1.0 headers if necessary"
  (w3-lazy-message "Inserting HTTP/1.0 headers...")
  (let ((hdrs (if (eq t w3-show-headers) (mapcar 'car url-current-mime-headers)
		w3-show-headers))
	x y)
    (goto-char (setq y (point-max)))
    (while hdrs
      (if (setq x (w3-in-assoc (car hdrs) url-current-mime-headers))
	  (w3-insert "<LI> <B>" (car x) "</B>: " (w3-insert-entities-in-string
						  (if (numberp (cdr x))
						      (int-to-string (cdr x))
						    (cdr x)))))
      (setq hdrs (cdr hdrs)))
    (if (= y (point-max))
	nil
      (w3-insert "</UL>")
      (goto-char y)
      (w3-lazy-message "Inserting HTTP/1.0 headers... done.")
      (w3-insert "<HR><UL>"))))

(defun w3-fixup-bad-html ()
  "Fix lots of bad html markup"
  (message "Checking for bad HTML...")
  (w3-replace-regexp "<\\(TBL[^>]*\\)>" "<\\1>\n<PRE>")
  (w3-replace-regexp "</TBL>" "</TBL>\n</PRE>")
  (w3-replace-regexp "<TEXTAREA" "<PRE><TEXTAREA")
  (w3-replace-regexp "</TEXTAREA>" "</TEXTAREA></PRE>")
  (w3-replace-regexp "<LISTING>" "<PRE>")
  (w3-replace-regexp "</LISTING>" "</PRE>")
  (w3-replace-regexp "<DL[^>]*>" "<DL>")
  (w3-replace-regexp "\\(</H[0-9][^>]*>\\)" "\\1\n")
  (goto-char (point-min))
  (let (st)
    (while (re-search-forward
	    (concat "</\\(H[0-9]\\|PRE\\|DL\\|OL\\|UL\\|DIR\\|MENU\\)[^>]*>"
		    "[ \\\t\\\n]*\\([^ \\\t\\\n]\\)") nil t)
      (setq st (match-beginning 2))
      (cond
       ((eq (char-after st) ?<)		; Its a markup tag
	(goto-char st)
	(cond
	 ((looking-at "<[Pp][ >]")	; Good, they have a paragraph
	  nil)
	 ((looking-at "<[DdOoUu][Ll]")
	  nil)
	 ((looking-at "<[dD][iI][rR]")
	  nil)
	 ((looking-at "<[Mm][Ee][Nn][Uu]")
	  nil)
	 (t
	  (goto-char st)
	  (insert "<P>"))))
       (t				; No markup immediately before header
	(goto-char (1- st))
	(insert "<P>")))))
  (goto-char (point-min))
  (if (and (re-search-forward "<\\(p\\|h[0-9]\\|br\\|hr\\)>" nil t)
	   (> (- (point) (point-min))
	      (+ (or w3-strict-width (window-width)) 10)))
      (progn
	(goto-char (point-min))
	(insert "<p>"))
    (insert "<p>"))
  (message "Checking for bad HTML... done."))

(defun w3-kill-comments ()
  "Take care of SGML comments in a buffer."
  (goto-char (point-min))
  (w3-lazy-message "Removing SGML comments...")
  (let (st nd)
    (while (re-search-forward "[ \\\t\\\n]*<!--" nil t)
      (setq st (match-beginning 0)
	    nd (if (re-search-forward "--!*>[ \\\t\\\n]*" nil t)
		   (match-end 0)
		 (end-of-line)
		 (point)))
      (delete-region st nd)
      (if (or (memq (or (char-after (point)) 0) '(?  ?\t ?\n))
	      (memq (or (char-after (1- (point))) 0) '(?  ?\t ?\n)))
	  nil
	(insert " "))))
  (w3-lazy-message "Removing SGML comments... done."))

(defun w3-remove-unknown-tags ()
  "Remove known, but unhandled tags."
  (w3-replace-regexp "</*htmlplus>" "")
  (w3-replace-regexp "</*html>" "")
  (w3-replace-regexp "</*div[0-9]>" "")
  (w3-replace-regexp "</*head>" "")
  (w3-replace-regexp "</*body>" ""))

(defun w3-prepare-buffer (&optional no-display)
  "Function to prepare w-buffer for processing.  This will completely
reformat a buffer - if you just want to parse out links, see the documentation
for w3-build-links-list."
  (w3-lazy-message "Parsing...")
  (set-buffer w3-working-buffer)
  (set-syntax-table w3-parse-args-syntax-table)
  (w3-handle-personal-annotations)
  (w3-insert-headers)
  (setq w3-current-source (buffer-string))
  (run-hooks 'w3-file-prepare-hooks)
  (setq fill-column (- (or w3-strict-width (window-width)) w3-right-border))
  (w3-replace-regexp (format "[%c%c%c]" ?\r ? ?) "")
  (let ((case-fold-search t)
	(ttl "")
	(pltxt nil))
    (goto-char (point-min))
    (w3-kill-comments)
    (goto-char (point-min))
    (if (re-search-forward "<PLAINTEXT>" nil t)
	(progn
	  (replace-match "")
	  (setq pltxt (buffer-substring (point) (point-max)))
	  (delete-region (point) (point-max))))
    (w3-handle-embeds)
    (w3-fixup-bad-html)
    (w3-balance-pre)
    (w3-balance-xmp)
    (w3-handle-arbitrary-tags)
    (w3-check-index)
    (w3-replace-regexp "<LIT>" "<PRE>")
    (w3-replace-regexp "</LIT>" "</PRE>")
    (w3-fix-xmp)
    (w3-fix-pre)
    (w3-remove-unknown-tags)
    (w3-fix-render-hints)
    (w3-handle-footnotes)
    (w3-handle-notes)
    (setq w3-current-links (w3-handle-links))
    (w3-fix-extras)
    (w3-handle-generic-emphasis)
    (goto-char (point-min))
    (w3-replace-regexp "[ \\\t]*<SP>[ \\\t]*" "<SP>")
    (w3-replace-regexp "[ \\\t]*&nbsp;[ \\\t]*" "&nbsp;")
    (w3-handle-whitespace)
    (w3-handle-headers)
    (w3-restore-pre)
    (goto-char (point-min))
    (let* ((x (w3-handle-base))
	   (w3-delay-image-loads t)
	   (url-current-file (and (not (car x)) url-current-file))
	   (url-current-server (and (not (car x)) url-current-server))
	   (url-current-type (and (not (car x)) url-current-type))
	   (url-current-user (and (not (car x)) url-current-user))
	   (url-current-port (and (not (car x)) url-current-port)))
      (cond
       ((car x)				; there was a <base> tag
	(cond
	 ((eq (car x) 'http)
	  (setq x (url-grok-http-href (cdr x))
		url-current-type "http"
		url-current-server (nth 0 x)
		url-current-port (nth 1 x)
		url-current-file (nth 2 x)))
	 ((or (eq (car x) 'file)
	      (eq (car x) 'ftp))
	  (setq x (url-grok-file-href (cdr x))
		url-current-type (and (nth 0 x) "ftp")
		url-current-user (nth 0 x)
		url-current-server (nth 1 x)
		url-current-file (nth 2 x)))
	 ((eq (car x) 'gopher)
	  (setq x (url-grok-gopher-href (cdr x))
		url-current-type "gopher"
		url-current-server (nth 0 x)
		url-current-port (nth 1 x)
		url-current-file (nth 2 x)))))
       (t nil))
      (w3-build-links-list)
      (w3-handle-graphics))
    (w3-handle-forms)
    (w3-do-lists)
    (w3-replace-regexp "<LI>" "\n\t*")
    (w3-replace-regexp "<DT>" "\n<DT>")
    (w3-replace-regexp "<DD>" "\n\t*")
    (goto-char (point-min))
    (let ((st (if (re-search-forward "<title>" nil t)
		  (prog1
		      (match-beginning 0)
		    (replace-match "")) nil))
	  (nd (if (re-search-forward "</title[ \\\t\\\n]*>" nil t)
		  (prog1
		      (match-beginning 0)
		    (replace-match ""))
		nil)))
      (if st
	  (progn
	    (setq ttl (w3-fix-entities-in-string
		       (w3-strip-leading-spaces
			(w3-eat-trailing-space
			 (buffer-substring st nd)))))
	    (delete-region st nd))
	(setq ttl (w3-basepath url-current-file t)))
      (if (string= "" ttl) (setq ttl (w3-basepath url-current-file t)))
      (if (> (length ttl) 50) (setq ttl (substring ttl 0 50)))
      (setq ttl (w3-generate-new-buffer-name ttl)))
    (w3-fix-paragraphs)
    (w3-replace-regexp "<X>\\\n+\\(\\\t*\\)<W3BR>" "\n\\1")
    (w3-replace-regexp "<SP>" " ")
    (w3-fix-unknown-tags)
    (w3-fix-entities)
    (w3-restore-xmp)
    (goto-char (point-min))
    (set-buffer w3-working-buffer)
    (if pltxt (progn (goto-char (point-max)) (w3-insert "\n" pltxt)))
    (goto-char (point-min))
    (while (looking-at "\\\n")
      (delete-char 1))
    (if (boundp 'MULE)
	(w3-mule-attribute-zones w3-zones-list w3-mule-attribute))
    (w3-fix-extent-endpoints)
    (run-hooks 'w3-file-done-hooks)
    (if (not no-display)
	(progn
	  (w3-mode)
	  (rename-buffer ttl)
	  (if w3-mutable-windows
	      (pop-to-buffer ttl)
	    (switch-to-buffer ttl))
	  (goto-char (point-min))
	  (if (and (bufferp w3-current-last-buffer)
		   (buffer-name w3-current-last-buffer)
		   (save-excursion
		     (set-buffer w3-current-last-buffer)
		     (eq major-mode 'w3-mode))
		   (not w3-keep-old-buffers))
	      (kill-buffer w3-current-last-buffer))
	  (if url-keep-history
	      (let ((url (url-view-url t)))
		(if (and (not (assoc url url-history-list))
			 (not (equal url "file:historylist")))
		    (setq url-history-list
			  (cons (cons url ttl) url-history-list)))))
	  (w3-lazy-message "Done.")
	  (cond
	   ((not (fboundp 'w3-insert-graphic)) nil)	; No graphics abilities
	   ((and w3-delay-image-loads w3-delay-mpeg-loads)
	    nil)
	   (t
	    (message "Processing images...")		; Grab the images
	    (w3-load-delayed-images)
	    (if (not w3-delay-mpeg-loads) (w3-load-delayed-mpegs))))
	  (if (not buffer-read-only) (toggle-read-only))
	  (set-buffer-modified-p nil)
	  (if (get-buffer "Conversion errors")
	      (switch-to-buffer-other-window "Conversion errors"))
	  (if w3-running-epoch (set-variable 'buffer-style w3-default-style))
	  (if w3-running-FSF19 (setq w3-zones-list (w3-only-links)))
	  (sit-for 0)))
    (message "")
    (if url-find-this-link
	(w3-find-specific-link url-find-this-link)
      (goto-char (point-min)))
    ttl))

(defun w3-handle-base ()
  "Handle BASE tag"
  (let (base url)
    (goto-char (point-min))
    (if (re-search-forward "<BASE\\([^>]+\\)>" nil t)
	(progn
	  (setq base (prog1
			 (w3-parse-args (match-beginning 1) (match-end 1))
		       (replace-match ""))
		url (or (cdr (assoc "href" base))
			(cdr (assoc "" base))))
	  (and (not url) (message "Malformed 'BASE' tag."))))
    (if (stringp url)
	(if (string-match "^\\([^:]+\\):/+" url)
	    (setq base (intern (downcase (w3-match url 1))))))
    (cons base url)))

(defun w3-handle-notes ()
  "Handle NOTE tags, as per the HTML+ 'Notes and Admonishments' section."
  (w3-lazy-message "Handling notices...")
  (set-buffer w3-working-buffer)
  (goto-char (point-min))
  (let (role img x)
    (while (re-search-forward "<NOTE\\([^>]*\\)>" nil t)
      (setq x (prog1
		  (w3-parse-args (match-beginning 1) (match-end 1))
		(replace-match "<HR><BR><B>"))
	    role (or (cdr (assoc "role" x)) "NOTE")
	    img (cdr (assoc "src" x)))
      (if img
	  (w3-insert (format "<IMG SRC=\"%s\" ALIGN=\"CENTER\">" img)))
      (w3-insert (format "<B>%s:</B>" role))))
  (w3-replace-regexp "</NOTE>" "<BR><HR>")
  (w3-lazy-message "Handling notices... done."))

(defun w3-handle-footnotes ()
  "Handle footnotes, margin notes, etc, from the HTML+ spec"
  (w3-lazy-message "Handling footnotes....")
  (set-buffer w3-working-buffer)
  (goto-char (point-min))
  (if (re-search-forward "<FOOTNOTE>" nil t)
      (progn
	(goto-char (point-max))
	(w3-insert "<P>Footnotes<BR><HR>")
	(goto-char (point-min))))
  (let ((fcounter 1) st nd txt)
    (while (re-search-forward "<FOOTNOTE>" nil t)
      (setq st (prog1 (match-beginning 0) (replace-match ""))
	    nd (if (re-search-forward "</FOOTNOTE>" nil t)
		   (prog1
		       (match-beginning 0)
		     (replace-match ""))
		 (progn (end-of-line) (point)))
	    txt (buffer-substring st nd))
      (delete-region st nd)
      (goto-char st)
      (w3-insert (format "<A HREF=\"#w3-internal-footnote%d\">%d</A>"
		      fcounter fcounter))
      (goto-char (point-max))
      (w3-insert (format "<P ID=\"w3-internal-footnote%d\">%d. "
		      fcounter fcounter) txt)
      (setq fcounter (1+ fcounter))
      (goto-char (point-min)))
    (while (re-search-forward "<MARGIN>" nil t)
      (setq st (prog1 (match-beginning 0) (replace-match ""))
	    nd (if (re-search-forward "</MARGIN>" nil t)
		   (prog1
		       (match-beginning 0)
		     (replace-match ""))
		 (progn (end-of-line) (point)))
	    txt (buffer-substring st nd))
      (delete-region st nd)
      (goto-char st)
      (w3-insert (format "<A HREF=\"#w3-internal-footnote%d\">%d</A>"
		      fcounter fcounter))
      (goto-char (point-max))
      (w3-insert (format "<P ID=\"w3-internal-footnote%d\">%d. "
		      fcounter fcounter) txt)
      (setq fcounter (1+ fcounter))
      (goto-char (point-min))))
  (w3-lazy-message "Handling footnotes... done."))

(defun w3-fix-render-hints ()
  "Parse out the RENDER hints ala the HTML+ specification."
  (w3-lazy-message "Fixing custom render attributes...")
  (set-buffer w3-working-buffer)
  (goto-char (point-min))
  (let (x tag sty)
    (while (re-search-forward "<RENDER\\([^>]+\\)>" nil t)
      (setq x (prog1
		  (w3-parse-args (match-beginning 1) (match-end 1))
		(replace-match ""))
	    tag (cdr (assoc "tag" x))
	    sty (cdr (assoc "style" x)))
      (w3-replace-regexp (format "<%s>" tag) (format "<%s>" sty))
      (w3-replace-regexp (format "</%s>" tag) (format "</%s>" sty))))
  (w3-lazy-message "Fixing custom render attributes... done."))

(defun w3-handle-arbitrary-tags ()
  "Find occurences of <!ENTITY ...> and replace them correctly."
  (set-buffer w3-working-buffer)
  (goto-char (point-min))
  (while (re-search-forward
	  "<!ENTITY[ \\\t]+\\([^ ]*\\)[ \\\t]+\"\\([^\"]*\\)\">" nil t)
    (let ((entity (buffer-substring (match-beginning 1) (match-end 1)))
	  (defn   (buffer-substring (match-beginning 2) (match-end 2))))
      (replace-match "")
      (w3-replace-regexp (regexp-quote (format "&%s;" entity)) defn))))

(defun w3-balance-xmp ()
  "This function will attempt to balance embedded plaintext elements
<XMP> tags.  This is necessary or the parser will fail some critical
regular expression matches."
  (set-buffer w3-working-buffer)
  (goto-char (point-min))
  (let* ((st (w3-count-occurences "<XMP>"))
	 (nd (w3-count-occurences "</XMP>"))
	 (df (- st nd)))
    (goto-char (point-max))
    (while (> df 0)
      (setq df (1- df))
      (w3-insert "</XMP>\n"))))

(defun w3-balance-pre ()
  "This function will attempt to balance embedded plaintext elements
(<PRE> tags).  This is necessary or the parser will fail some critical
regular expression matches."
  (set-buffer w3-working-buffer)
  (goto-char (point-min))
  (let* ((st (w3-count-occurences "<PRE[^>]*>"))
	 (nd (w3-count-occurences "</PRE>"))
	 (df (- st nd)))
    (goto-char (point-max))
    (while (> df 0)
      (setq df (1- df))
      (w3-insert "</PRE>\n"))))

(defun w3-fix-extras ()
  "Replace <B>, <I>, etc tags in the buffer.  Appropriate zones will be
created, and highlighting will be added when possible."
  (w3-lazy-message "Doing textual highlighting...")
  (set-buffer w3-working-buffer)
  (goto-char (point-min))
  (while (re-search-forward w3-style-regexp nil t)
    (let* ((st (match-beginning 0))
	   (dastyle (upcase (buffer-substring (match-beginning 1)
					      (match-end 1))))
	   (nd (progn
		 (replace-match "")
		 (if (re-search-forward (concat "</" dastyle ">") nil t)
		     (prog1
			 (match-beginning 0)
		       (replace-match ""))
		   (point))))
	   (sty (w3-lookup-style dastyle))
	   (ltrs (cdr (assoc dastyle w3-style-chars-assoc))))
      (w3-add-zone st nd sty '(w3style))
      (if (and ltrs w3-delimit-emphasis)
	  (progn
	    (goto-char nd)
	    (w3-insert (cdr ltrs))
	    (goto-char st)
	    (w3-insert (car ltrs))))
      (goto-char st)))
  (w3-lazy-message "Doing textual highlighting... done."))

(defun w3-find-graphic-entity (entity)
  "Return where we found the bitmap for entity... this searches through
w3-icon-directory-list and tries to find the bitmap corresponding to entity."
  (let* ((retval (cdr (assoc entity w3-icon-path-cache)))
	 (done nil))
    (if retval nil
      (while (and w3-icon-directory-list (not done))
	(if (url-file-exists (setq retval
				   (concat (car w3-icon-directory-list)
					   entity)))
	    (setq done t)))
      (setq w3-icon-path-cache (cons (cons entity retval) w3-icon-path-cache)))
    retval))

(defun w3-fix-entities ()
  "Replace &#XXX with ASCII character XXX."
  (w3-lazy-message "Finding HTML+ entities...")
  (set-buffer w3-working-buffer)
  (goto-char (point-min))
  (cond
   ((and (fboundp 'w3-insert-graphic) w3-delay-image-loads
	 (not w3-graphics-always-show-entities))
    (mapcar (function
	     (lambda (entry)
	       (goto-char (point-min))
	       (while (re-search-forward (car entry) nil t)
		 (replace-match "")
		 (w3-add-delayed-graphic
		  (w3-find-graphic-entity (car (cdr entry)))
		  (set-marker (make-marker) (point)) 'center
		  (or (cdr (cdr entry)) "")))))
	    w3-graphics-entities-alist))
   ((fboundp 'w3-insert-graphic)
    (mapcar (function
	     (lambda (entry)
	       (goto-char (point-min))
	       (while (re-search-forward (car entry) nil t)
		 (replace-match "")
		 (w3-insert-graphic (list
				     (w3-find-graphic-entity
				      (car (cdr entry))))
				    (point) 'center
				    (or (cdr (cdr entry)) "")))))
	    w3-graphics-entities-alist))
   (t
    (mapcar (function
	     (lambda (entry)
	       (goto-char (point-min))
	       (w3-replace-regexp (car entry)
				  (or (cdr (cdr entry)) ""))))
	    w3-graphics-entities-alist)))
  (let ((case-fold-search nil))
    (while (re-search-forward "&#\\([0-9]+\\);*" nil t)
      (replace-match (char-to-string
		      (string-to-int (buffer-substring (match-beginning 1)
						       (match-end 1))))))
    (mapcar (function (lambda (x) (w3-replace-regexp (car x) (cdr x))))
	    w3-html-entities))
  (goto-char (point-min))
  (w3-lazy-message "Finding HTML+ entities..."))

(defun w3-fix-pre ()
  "Extract <PRE> fields, and put them back in later."
  (set-buffer w3-working-buffer)
  (goto-char (point-min))
  (setq w3-pre-data nil
	w3-pre-data-count 0)
  (while (re-search-forward "<PRE[^>]*>" nil t)
    (let* ((start (prog1 (match-beginning 0) (replace-match "")))
	   (end (prog2
		    (re-search-forward "</PRE>" nil t)
		    (match-beginning 0)
		  (replace-match "")))
	   (repl (not (string= "" (w3-eat-trailing-space
				   (buffer-substring start end))))))
      (cond
       (repl
	(setq w3-pre-data-count (1+ w3-pre-data-count)
	      w3-pre-data (cons (list w3-pre-data-count
				      (buffer-substring start end))
				w3-pre-data))
	(delete-region start end)
	(goto-char start)
	(w3-insert "***PREDATA" (int-to-string w3-pre-data-count)))
       (t (delete-region start end))))))

(defun w3-restore-pre (&optional done)
  "Restore the <PRE> fields"
  (set-buffer w3-working-buffer)
  (let (st nd)
    (goto-char (point-min))
    (while (> w3-pre-data-count 0)
      (re-search-forward (regexp-quote (concat "***PREDATA" w3-pre-data-count))
			 nil t)
      (setq st (match-beginning 0))
      (replace-match (concat (if (not done) "<PRE>" "\n")
			     (car (cdr (assoc w3-pre-data-count w3-pre-data)))
			     (if (not done) "</PRE>" "\n")) t t)
      (w3-add-zone st (point) w3-tt-style nil nil)
      (goto-char (point-min))
      (setq w3-pre-data-count (1- w3-pre-data-count)))))

(defun w3-fix-xmp ()
  "Extract <XMP> fields, and put them back in later."
  (set-buffer w3-working-buffer)
  (goto-char (point-min))
  (setq w3-xmp-data nil
	w3-xmp-data-count 0)
  (while (re-search-forward "<XMP>" nil t)
    (let* ((start (match-beginning 0))
	   (end (progn (re-search-forward "</XMP>" nil t)
		       (point))))
      (setq w3-xmp-data-count (1+ w3-xmp-data-count)
	    w3-xmp-data (cons (list w3-xmp-data-count
				    (buffer-substring start end)) w3-xmp-data))
      (delete-region start end)
      (goto-char start)
      (w3-insert "***XMPDATA" (int-to-string w3-xmp-data-count)))))

(defun w3-restore-xmp ()
  "Restore the <XMP> fields"
  (set-buffer w3-working-buffer)
  (goto-char (point-min))
  (while (> w3-xmp-data-count 0)
    (goto-char (point-min))
    (re-search-forward (concat "***XMPDATA" (int-to-string w3-xmp-data-count))
		       nil t)
    (replace-match (concat "\n"
			   (substring
			    (car (cdr (assoc w3-xmp-data-count w3-xmp-data)))
			    5 -6) "\n") t t)
    (setq w3-xmp-data-count (1- w3-xmp-data-count))))

(defun w3-check-index ()
  "Check to see if this is an indexed file.  If it is, update the mode line"
  (set-buffer w3-working-buffer)
  (goto-char (point-min))
  (if (re-search-forward "\\\n*<ISINDEX>\\\n*" nil t)
      (progn
	(setq w3-current-isindex t)
	(replace-match
	 (if (and w3-use-forms-index
		  (equal url-current-type "http"))
	     (concat
	      "<FORM>\nThis is a searchable index.  Search for:"
	      " <INPUT NAME=\"isindex\"><P></FORM>")
	   "") t))
    (setq w3-current-isindex nil)))

(defun w3-handle-whitespace ()
  "Fix newlines, tabs, and spaces"
  (set-buffer w3-working-buffer)
  (goto-char (point-min))
  (subst-char-in-region (point-min) (point-max) ?\n ?  )
  (subst-char-in-region (point-min) (point-max) ?\t ?  )
  (w3-replace-regexp "  +" " ")
  (w3-replace-regexp "\\\. +" ".  "))

(defun w3-handle-headers ()
  "Do the headers"
  (w3-lazy-message "Parsing headers...")
  (set-buffer w3-working-buffer)
  (goto-char (point-min))
  (while (re-search-forward
	  "[ \\\t\\\n]*\\(<P[^>]*>\\)*[ \\\t\\\n]*<H\\([0-9]+\\)\\([^>]*\\)>"
	  nil t)
    (let* ((siz (buffer-substring (match-beginning 2) (match-end 2)))
	   (tags (buffer-substring (match-beginning 3) (match-end 3)))
	   x y
	   (st (set-marker
		(make-marker)
		(prog1
		    (match-beginning 0)
		  (setq x
			(if (match-beginning 1)
			    (w3-eat-trailing-space
			     (w3-strip-leading-spaces
			      (buffer-substring (match-beginning 1)
						(match-end 1)))) "<P>"))
		  (replace-match ""))))
	   (end (set-marker
		 (make-marker)
		 (progn
		  (if (re-search-forward
		       "</H[0-9]+>[ \\\t\\\n]*\\(<P[^>]*>\\)*" nil t)
		      (prog1
			  (match-beginning 0)
			(setq y
			      (if (match-beginning 1)
				  (w3-eat-trailing-space
				   (w3-strip-leading-spaces
				    (buffer-substring
				     (match-beginning 1) (match-end 1))))
				"<P>"))
			(replace-match ""))
		    (progn (end-of-line) (setq y "<P>") (point))))))
	   (forms (cdr (assoc siz w3-header-chars-assoc))))
      (w3-add-zone st end w3-header-style
		   (cons 'w3header
			 (list
			  (if (string-match "ID=\"\\([^\"]+\\)\"" tags)
			      (substring tags (match-beginning 1)
					 (match-end 1))
			    nil) nil nil nil nil nil nil nil)))
      (if (and forms w3-delimit-emphasis)
	  (let ((len (w3-length-after-parsing (buffer-substring st end))))
	    (setq len (if (> len (- (or (window-width) w3-strict-width)
				    w3-right-border))
			  (- (or (window-width) w3-strict-width)
			     w3-right-border)
			len))
	    (and (nth 2 forms) (funcall (nth 2 forms) st end))
	    (goto-char end)
	    (and (nth 0 forms) (w3-insert "<BR>"
					  (make-string len (nth 0 forms))
					  "<BR>"))
	    (w3-insert y)
	    (goto-char st)
	    (w3-insert x)
	    (and (nth 1 forms) (w3-insert "<BR>"
					  (make-string len (nth 1 forms))
					  "<BR>")))
	(progn
	  (goto-char end) (w3-insert y)
	  (goto-char st) (w3-insert x)))))
  (goto-char (point-min))
  (w3-lazy-message "Parsing headers... done."))

(defun w3-fix-horizontal-rules ()
  "Replace all the <HR> tags"
  (goto-char (point-min))
  (while (re-search-forward "<[Hh][rR]>" nil t)
    (replace-match (format "<p>%s<p>"
			   (make-string (- (or w3-strict-width
					       (window-width))
					   w3-right-border)
					w3-horizontal-rule-char)))))

(defun w3-fix-unknown-tags (&optional pt recur)
  "Remove unknown tags in a buffer"
  (w3-lazy-message "Removing unknown tags...")
  (set-buffer w3-working-buffer)
  (goto-char (point-min))
  (if (re-search-forward "<\\(PRE\\|XMP\\)>" nil t)
      (let ((st (set-marker (make-marker) (if pt pt (point-min))))
	    (nd (set-marker (make-marker) (match-beginning 1)))
	    (tp (buffer-substring (match-beginning 1) (match-end 1))))
	(replace-match "")
	(save-restriction
	  (narrow-to-region st nd)
	  (delete-matching-lines "^[ \\\t]*<[^>]+>[ \\\t]*$")
	  (w3-replace-regexp "^\\([ \\\t]*\\\n\\)+" "\n")
	  (w3-replace-regexp "<[^>]*>" ""))
	(re-search-forward (format "</%s>" tp) nil t)
	(replace-match "")
	(w3-fix-unknown-tags (point) t))
    (narrow-to-region (point) (point-max))
    (delete-matching-lines "^[ \\\t]*<[^>]+>[ \\\t]*$")
    (w3-replace-regexp "^\\([ \\\t]*\\\n\\)+" "\n")
    (w3-replace-regexp "<[^>]*>" "")
    (widen))
  (w3-lazy-message "Removing unknown tags... done."))

(defun w3-fix-paragraphs-in-region ()
  "Fill paragraphs in the visible part of the buffer"
  (set-buffer w3-working-buffer)
  (goto-char (point-min))
  (w3-replace-regexp "<[bB][Rr]> *" (concat fill-prefix "<PW3>"))
;  (w3-replace-regexp "\\\n\\\n+\\\t" "\n\t")
  (w3-replace-regexp "^ +" "")
  (goto-char (point-min))
  (let (ptag st align args eol next-p next-t nd)
    (while (re-search-forward "<P\\([^>]*\\)>[ \\\n]*" nil t)
      (setq st (set-marker (make-marker) (match-beginning 0))
	    args (buffer-substring (match-beginning 1) (match-end 1))
	    args (w3-parse-args-string
		  (prog1
		      (if (equal "W3" args) (concat "ALIGN="align) args)
		    (replace-match (if (equal "W3" args) ""
				     (concat "\n\n" fill-prefix)))))
	    ptag (cdr (assoc "id" args))
	    align (or (cdr (assoc "align" args)) "left")
	    eol (save-excursion (end-of-line) (point))
	    next-t (save-excursion
		     (if (re-search-forward "\\\t" nil t) (match-beginning 0)
		       eol))
	    next-p (save-excursion
		     (if (re-search-forward "<P" nil t) (match-beginning 0)
		       eol))
	    nd (set-marker (make-marker) (min eol next-p next-t)))
      (if ptag
	  (w3-add-zone st nd nil (cons 'w3par (list ptag))))
      (cond
       ((equal "left" align)		; Normal left justification
	(fill-region st nd))
       ((equal "justify" align)		; Fully justified text
	(fill-region st nd t))
       ((equal "center" align)		; Center each line
	(let ((fill-column (- fill-column 7)))
	  (fill-region st nd)
	  (center-region st nd)
	  (goto-char st)
	  (while (re-search-forward "^" nd t)
	    (replace-match "    "))))
       ((equal "right" align)		; Right justified
	(let ((fill-column (- fill-column 7)))
	  (fill-region st nd t)))
       ((equal "indent" align)		; Indent extra
	(let ((fill-prefix (concat "\t" fill-prefix)))
	  (goto-char st)
	  (skip-chars-forward " \t\n")
	  (insert "\t")
	  (goto-char nd)
	  (fill-region st nd))))))
  (goto-char (point-min))
  (w3-replace-regexp "\\\n\\\n+" "\n\n")
  (w3-replace-regexp "<[sS][Pp]>" " "))

(defun w3-fix-paragraphs (&optional pt recur)
  "Fix filling of paragraphs in a new buffer"
  (w3-lazy-message "Filling paragraphs...")
  (set-buffer w3-working-buffer)
  (goto-char (if pt pt (point-min)))
  (w3-fix-horizontal-rules)
  (goto-char (if pt pt (point-min)))
  (if (re-search-forward "<\\(PRE\\|XMP\\)>" nil t)
      (let ((st (if pt pt (point-min)))
	    (nd (- (point) 5))
	    (tp (buffer-substring (match-beginning 1) (match-end 1))))
	(save-restriction
	  (narrow-to-region st nd)
	  (w3-fix-paragraphs-in-region))
	(re-search-forward (format "</%s>" tp) nil t)
	(w3-fix-paragraphs (point) t))
    (narrow-to-region (point) (point-max))
    (w3-fix-paragraphs-in-region)
    (widen))
  (w3-lazy-message "Filling paragraphs..."))

(defun w3-add-delayed-mpeg (src st)
  "Add a delayed mpeg for the current buffer."
  (setq w3-delayed-movies (cons (cons src (set-marker (make-marker) st))
				w3-delayed-movies))
  (w3-insert (concat "[MPEG(" (w3-basepath src t) ")]"))
  (w3-add-zone st (point) nil (list 'w3mpeg src st)))

(defun w3-add-delayed-graphic (src st align alt)
  "Add a delayed image for the current buffer."
  (setq st (set-marker (make-marker) st)
	w3-delayed-images (cons (list src st align alt) w3-delayed-images))
  (insert alt)
  (if (string= alt "") nil
    (w3-add-zone st (point) nil (list 'w3delayed src st align alt))))

(defun w3-handle-graphics ()
  "A function to parse out IMG tags.  In epoch, this will actually
insert the picture into the buffer.  The ALT attribute is displayed
when not in epoch (or when epoch fails to read in the graphic
correctly."
  (set-buffer w3-working-buffer)
  (if (get-buffer "Conversion errors") (kill-buffer "Conversion errors"))
  (goto-char (point-min))
  (if (fboundp 'w3-insert-graphic)
      (while (re-search-forward "<IMG[ \\\t]+\\([^>]+\\)>" nil t)
	(let ((st (match-beginning 0))
	      (lnk (and (w3-zone-at (match-beginning 1))
			(w3-zone-data (w3-zone-at (match-beginning 1)))))
	      (img (prog1
		    (w3-parse-args (match-beginning 1) (match-end 1))
		    (replace-match "")))
	      (src "")
	      (align 'center)
	      (alt nil))
	  (setq src (or (cdr (assoc "src" img)) "")
		alt (or (cdr (assoc "alt" img))
			(concat "[IMAGE(" (w3-basepath src t) ")] "))
		align (intern (downcase (or (cdr (assoc "align" img))
					    "center"))))
	  (if (not (string-match url-nonrelative-link src))
	      (setq src (url-parse-relative-link src)))
	  (if (assoc "ismap" img)
	      (setq lnk (cons 'ismap (cdr lnk))))
	  (setq src (cons src lnk))
	  (if w3-delay-image-loads
	      (w3-add-delayed-graphic src st align alt)
	    (w3-insert-graphic src st align alt))))
    (progn
      (goto-char (point-min))
      (let ((alt "") (img "") (src "") st lnk lnkzone)
	(while (re-search-forward "<IMG[ \\\t\\\n]*\\([^>]+\\)>" nil t)
	  (setq lnkzone (w3-zone-at (match-beginning 1))
		lnk (and lnkzone (w3-zone-data lnkzone))
		img (prog1
			(w3-parse-args (match-beginning 1) (match-end 1))
		      (replace-match ""))
		src (or (cdr (assoc "src" img)) "")
		alt (or (cdr (assoc "alt" img))
			(concat "[IMAGE(" (w3-basepath src t) ")] ")))
	  (if (not (string-match url-nonrelative-link src))
	      (setq src (url-parse-relative-link src)))
	  (setq st (point))
	  (w3-insert alt)
	  (if (eq 'w3 (car lnk))
	      (progn
		;; Check beginning and end of lnkzone,
		;; skip-chars-forward from (point),
		;; skip-chars-backward from st,
		;; scf > end and scb < st, then
		;; (w3-delete-zone lnkzone)
		(w3-add-zone st (point) w3-node-style
			     (list 'w3 (nth 1 lnk) (nth 2 lnk) alt
				   (nth 4 lnk) (nth 5 lnk) (nth 6 lnk)
				   (nth 7 lnk) (nth 8 lnk)))))
	  (w3-add-zone st (point) nil (list 'w3graphic src) t))))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Support for the <EM> tag.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun w3-find-emphasis-face (attributes)
  "Return a face from the various attributes of an <em> tag."
  (cond
   ((and (assoc "b" attributes) (assoc "i" attributes)) 'bold-italic)
   ((assoc "sup" attributes) (or (cdr (assoc "SUP" w3-style-assoc)) 'bold))
   ((assoc "sub" attributes) (or (cdr (assoc "SUB" w3-style-assoc)) 'italic))
   ((or (assoc "tt" attributes)
	(assoc "hv" attributes)
	(assoc "tr" attributes)) (or (cdr (assoc "TT" w3-style-assoc))
				     'w3-tt-style))
   ((assoc "b" attributes) 'w3-bold-style)
   ((assoc "i" attributes) 'w3-italic-style)
   ((assoc "u" attributes) 'w3-underline-style)
   (t (message "Error in an <em> tag - unknown emphasis.") nil)))

(defun w3-handle-generic-emphasis-1 ()
  (let ((args nil)			; Arguments to the <em> tag
	(face nil)			; Face to use
	(strt nil)			; Start of the <em> tag
	(end  nil)			; End of the <em> tag
	)
    (if (not (re-search-forward "<em\\([^>]*\\)>" nil t))
	(message "Something is wrong with an <em> tag")
      (setq strt (match-beginning 0)
	    args (prog1
		     (w3-parse-args (match-beginning 1) (match-end 1))
		   (replace-match ""))
	    end (save-excursion
		  (or (re-search-forward "</em[^>]*>" nil t) (end-of-line))
		  (prog1 (point) (replace-match "")))
	    face (w3-find-emphasis-face args))
      (w3-add-zone strt (min end (point-max)) face '(w3style)))))

(defun w3-handle-generic-emphasis ()
  "Handle the <em> tag."
  (goto-char (point-min))
  (let ((pos  nil)			; Temporary position marker
	(opos nil)
	(st nil))
    (while (re-search-forward "<em" nil t)
      (setq st (match-beginning 0))
      (while (setq opos pos
		   pos (w3-subemphasis-exists))
	(goto-char (cdr pos)))
      (goto-char (or (car opos) st))
      (w3-handle-generic-emphasis-1)
      (goto-char st))))


(defun w3-subemphasis-exists ()
  "Return t iff there is a nested <em> tag"
  (let* ((end-tag (save-excursion
		    (and (re-search-forward "</em[^>]*>" nil t)
			 (match-beginning 0))))
	 (search-limit (or end-tag (save-excursion (end-of-line) (point)))))
    (if (re-search-forward "<em" search-limit t)
	(cons (match-beginning 0) (match-end 0))
      nil)))



;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Shared graphics routines
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun w3-convert-graphic-to-useable-format (buf fname xbm)
  "Convert the image data in buffer BUF into a format useable by
lemacs or epoch.  Second arg FNAME is the filename to redirect output
into.  If third arg XBM is t, convert it to an Xbitmap, otherwise
convert it to an XPM (recommended, as they can do color).  Returns a
filename containing the bitmap specification"
  (save-excursion
    (set-buffer buf)
    (let (converter)
      (if (not url-current-mime-type)
	  (setq url-current-mime-type (mm-extension-to-mime
				       (w3-file-extension url-current-file))))
      (setq converter (assoc url-current-mime-type w3-graphic-converter-alist))
      (if (not converter)
	  (message "Cannot convert %s to www/present!" url-current-mime-type)
	(message "Converting %s (%s)..."
		 (w3-basepath url-current-file t) url-current-mime-type)
	(shell-command-on-region
	 (point-min) (point-max)
	 (concat (format (cdr converter)
			 (concat
			  (cond
			   ((and w3-color-use-reducing
				 (eq w3-color-filter 'ppmquant))
			    (concat "ppmquant " (* w3-color-max-red
						   w3-color-max-green
						   w3-color-max-blue)
				    " | "))
			   ((and w3-color-use-reducing
				 (eq w3-color-filter 'ppmdither))
			    (concat "ppmdither -red " w3-color-max-red
				    " -green " w3-color-max-green
				    " -blue " w3-color-max-blue " | "))
			   (t ""))
			  (if xbm w3-ppmtoxbm-command w3-ppmtoxpm-command)))
		 "> " fname) t)))))

(defun w3-load-flavors ()
  "Load the correct zone/font info for each flavor of emacs"
  (cond
   (w3-running-lemacs (require 'w3-lemac))
   (w3-running-epoch  (require 'w3-epoch))
   (w3-running-FSF19  (require 'w3-e19))
   (t                 (require 'w3-emacs)))
  (condition-case ()
      (require 'w3-site-init)
    (error nil)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Automatic bug submission.                                               ;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun w3-submit-bug-with-mh ()
  "Function to submit a bug to the programs maintainer, using the %!@%ed up
mh-e interface."
  (require 'mh-comp)
  (mh-find-path)
  (let ((url (url-view-url t)))
    (if (equal "file:nil" url) (setq url nil))
    (mh-send w3-bug-address nil "Bug found in w3-mode")
    (goto-char (point-max))
    (next-line 1)
    (while (< (current-column) 29) (w3-insert "-"))
    (insert "Description of System:")
    (while (< (current-column) 75) (w3-insert "-"))
    (insert "\n")
    (string-match "WWW \\([^ ]*\\) \\(.*\\)" w3-version)
    (insert "WWW Browser Version: " w3-version-number
	    ", of "
	    (substring w3-version (match-beginning 2) (match-end 2))
	    "\n"
	    "      Emacs Version: "
	    (substring (emacs-version) 0 (string-match " of" (emacs-version)))
	    (if w3-running-epoch "(Epoch)" "")
	    (if (boundp 'MULE) "(MULE)" "")
	    "\n"
	    (if window-system
		(concat "      Window System: " (symbol-name window-system)
			"-" window-system-version "\n") "")
	    "        System Type: "
	    (prin1-to-string system-type) "\n"
	    (if url (concat "                URL: " url "\n") "")
	    (if (featurep 'ange-ftp)
		(concat "           Ange-FTP: " ange-ftp-version "\n") "")
	    (if (featurep 'efs)
		(concat "                EFS: " efs-version "\n") ""))
    (while (< (current-column) 29) (insert "-"))
    (insert "Description of Problem:")
    (while (< (current-column) 75) (insert "-"))
    (insert "\n\n")))

(defun w3-submit-bug ()
  "Function to submit a bug to the programs maintainer"
  (interactive)
  (if (eq w3-mail-command 'mh-smail)
      (w3-submit-bug-with-mh)
    (let ((url (url-view-url t)))
      (if (equal "file:nil" url) (setq url nil))
      (cond
       ((and w3-mutable-windows (fboundp w3-mail-other-window-command))
	(funcall w3-mail-other-window-command))
       ((fboundp w3-mail-command)
	(funcall w3-mail-command))
       (w3-mutable-windows (mail-other-window))
       (t (mail)))
      (mail-to)
      (insert w3-bug-address)
      (mail-subject)
      (insert "Bug found in w3-mode")
      (re-search-forward mail-header-separator nil t)
      (next-line 1)
      (while (< (current-column) 29) (w3-insert "-"))
      (insert "Description of System:")
      (while (< (current-column) 75) (w3-insert "-"))
      (insert "\n")
      (string-match "WWW \\([^ ]*\\) \\(.*\\)" w3-version)
      (insert "WWW Browser Version: "
	      (substring w3-version (match-beginning 1) (match-end 1))
	      ", of "
	      (substring w3-version (match-beginning 2) (match-end 2))
	      "\n"
	      "      Emacs Version: "
	      (substring (emacs-version) 0 (string-match " of" (emacs-version)))
	      (if w3-running-epoch "(Epoch)" "")
	      (if (boundp 'MULE) "(MULE)" "")
	      "\n"
	      (if window-system
		  (concat "      Window System: " (symbol-name window-system)
			  "-" window-system-version "\n") "")
	      "        System Type: "
	      (prin1-to-string system-type) "\n"
	      (if url (concat "                URL: " url "\n") "")
	      (if (featurep 'ange-ftp)
		  (concat "           Ange-FTP: " ange-ftp-version "\n") "")
	      (if (featurep 'efs)
		  (concat "                EFS: " efs-version "\n") ""))
      (while (< (current-column) 29) (w3-insert "-"))
      (w3-insert "Description of Problem:")
      (while (< (current-column) 75) (w3-insert "-"))
      (w3-insert "\n\n"))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Support for searching						    ;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun w3-nuke-spaces-in-search (x)
  "Remove spaces from search strings . . ."
  (let ((new ""))
    (while (not (equal x ""))
      (setq new (concat new (if (= (string-to-char x) 32) "+"
			      (substring x 0 1)))
	    x (substring x 1 nil)))
    new))

(defun w3-parse-args (st nd)
  "Return an assoc list of attribute/value pairs from an SGML-type string"
  (let (
	name				; From name=
	value				; its value
	results				; Assoc list of results
	name-pos			; Start of XXXX= position
	val-pos				; Start of value position
	)
    (save-restriction
      (narrow-to-region st nd)
      (goto-char (point-min))
      (while (not (eobp))
	(skip-chars-forward " \\\n\\\t")
	(setq name-pos (point))
	(skip-chars-forward "^ \\\n\\\t=")
	(downcase-region name-pos (point))
	(setq name (buffer-substring name-pos (point)))
	(skip-chars-forward " \\\t\\\n")
	(if (/= (or (char-after (point)) 0)  ?=) ; There is no value
	    (setq value nil)
	  (skip-chars-forward " \\\t\\\n=")
	  (setq val-pos (point)
		value
		(cond
		 ((or (= (or (char-after val-pos) 0) ?\")
		      (= (or (char-after val-pos) 0) ?'))
		  (buffer-substring (1+ val-pos)
				    (condition-case ()
					(prog2
					    (forward-sexp 1)
					    (1- (point))
					  (skip-chars-forward "\""))
				      (error
				       (skip-chars-forward "^ \\\t\\\n")
				       (point)))))
		 (t
		  (buffer-substring val-pos
				    (progn
				      (skip-chars-forward "^ \\\t\\\n")
				      (point)))))))
	(setq results (cons (cons name value) results)))
      results)))

(defun w3-parse-args-string (str)
  "Return an assoc list of attribute/value pairs from an SGML-type string"
  (let ((buff (get-buffer-create " *w3-tmp*")))
    (save-excursion
      (set-buffer buff)
      (erase-buffer)
      (set-syntax-table w3-parse-args-syntax-table)
      (insert str)
      (w3-parse-args (point-min) (point-max)))))

(defun w3-search ()
  "Perform a search, if this is a searchable index."
  (interactive)
  (let* (querystring
	 (index (if w3-current-isindex
		    (url-view-url t)
		  (let ((rels (mapcar
			       (function
				(lambda (data)
				  (if (assoc "rel" data) data)))
			       w3-current-links))
			val)
		    (while rels
		      (if (string-match "useindex"
					(or (cdr (assoc "rel" (car rels))) ""))
			  (setq val (cdr (assoc "href" (car rels)))
				rels nil))
		      (setq rels (cdr rels)))
		    val)))
	 (type (cond
		((null index) nil)
		(w3-current-isindex url-current-type)
		(t
		 (if (string-match url-nonrelative-link index)
		     (w3-match index 1)
		   (setq index (url-parse-relative-link index))
		   (string-match url-nonrelative-link index)
		   (w3-match index 1))))))
     (if (null index)
	 (message "Not a searchable index!")
       (setq querystring (w3-nuke-spaces-in-search
			  (read-string "Search on (+ separates keywords): ")))
       (if (string-match "\\(.*\\)\\?.*" index)
	   (setq index (w3-match index 1)))
       (w3-fetch
	(concat index (if (= ?? (string-to-char (substring index -1 nil)))
			  "" "?") querystring)))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Auto documentation, etc                                                 ;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun w3-help ()
  "Print documentation on w3 mode."
  (interactive)
  (w3-fetch "www://auto/help"))

(fset 'w3-remove-relative-links-helper 'url-remove-relative-links-helper)
(fset 'w3-remove-relative-links 'url-remove-relative-links)

(defun w3-version ()
  "Show the version # of W3 in the minibuffer"
  (interactive)
  (message "WWW %s, URL %s, MM %s" w3-version-number url-version mm-version))

;;;###autoload
(defun w3 ()
  "Retrieve the default World Wide Web home page.
The World Wide Web is a global hypertext system started by CERN in
Switzerland in 1991.

The home page is specified by the variable w3-default-homepage.  The
document should be specified by its fully specified Uniform Resource
Locator.  The document will be parsed as HTML (if appropriate) and
displayed in a new buffer."
  (interactive)
  (if (not w3-setup-done) (w3-do-setup))
  (if (not (string-match ".*:.*" w3-default-homepage))
      (w3-fetch (concat "file:" w3-default-homepage))
    (w3-fetch w3-default-homepage)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Leftover stuff that didn't quite fit into url.el
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun w3-generate-error (type data)
  "Generate an HTML error buffer for error TYPE with data DATA."
  (cond
   ((equal type "nofile")
    (insert "<title>Error</title>\n"
	    "<h1>No file " data " found</h1>\n"
	    "<hr>\n"
	    "The file " data " could not be found.  Either it does not"
	    "exist, or is unreadable.\n"))
   ((equal type "nobuf")
    (insert "<TITLE>Error</TITLE>\n"
	    "<H1>No buffer " data " found</h1>\n"
	    "<HR>\n"
	    "The buffer " data " could not be found.  It has either\n"
	    "been killed or renamed.\n"))
   ((equal type "nohist")
    (insert "<TITLE>Error</TITLE>\n"
	    "<H1>No history items found.</H1>\n"
	    "<HR>\n"
	    "There is no history list available at this time.  Either\n"
	    "you have not visited any nodes, or the variabe <i>\n"
	    "w3-keep-history</i> is nil.\n"))
   )
  (insert "<HR>\n"
	  "If you feel this is a bug, <A HREF=\"mailto:"
	  w3-bug-address "\">send mail to " w3-bug-address
	  "</A>\n<HR>"))

(defun w3-generate-auto-html (type)
  "Generate one of several automatic html pages"
  (cond
   ((equal type "hotlist")
    (let ((tmp (reverse w3-hotlist)))
      (insert "<htmlplus>\n\t<head>\n\t\t"
	      "<title> Hotlist </title>\n\t</head>\n"
	      "\t<body>\n\t\t<div1>\n\t\t\t<h1>Hotlist from " w3-hotlist-file
	      "</h1>\n\t\t\t<ol>\n")
      (while tmp
	(insert  "\t\t\t\t<li> <a href=\"" (car (cdr (car tmp)))
		 "\">" (car (car tmp)) "</a></li>\n")
	(setq tmp (cdr tmp)))
      (insert "\n\t\t\t</ol>\n\t\t</div1>\n\t</body>\n</htmlplus>")))
   ((equal type "starting-points")
    (let ((tmp w3-starting-documents))
      (insert "<htmlplus>\n\t<head>\n\t\t"
	      "<title> Starting Points </title>\n\t</head>\n"
	      "\t<body>\n\t\t<div1>\n\t\t\t<h1>Starting Point on the Web"
	      "</h1>\n\t\t\t<ol>\n")
      (while tmp
	(insert (format "\t\t\t\t<li> <a href=\"%s\">%s</a></li>\n"
			(car (cdr (car tmp)))
			(car (car tmp))))
	(setq tmp (cdr tmp)))
      (insert "\n\t\t\t</ol>\n\t\t</div1>\n\t</body>\n</htmlplus>")))
   ((equal type "history")
    (if (not url-history-list)
	(url-retrieve "www://error/nohist")
      (let ((urls url-history-list))
	(insert "<htmlplus>\n\t<head>\n\t\t"
		"<title> History List For This Session of W3</title>"
		"\n\t</head>\n\t<body>\n\t\t<div1>\n\t\t\t<h1>"
		"History List For This Session of W3</h1>\n\t\t\t<ol>\n")
	(while urls
	  (insert (format "\t\t\t\t<li> <a href=\"%s\">%s</A>\n"
			  (car (car urls)) (cdr (car urls))))
	  (setq urls (cdr urls)))
	(insert "\n\t\t\t</ol>\n\t\t</div1>\n\t</body>\n</htmlplus>"))))
   ((equal type "help") (w3-fetch (nth 1 (aref (nth 1 (cdr w3-help-menu)) 1))))
   ))

(defun w3-internal-url (url)
  "Handle internal urls (previewed buffers, etc"
  (string-match "www:/+\\([^/]+\\)/\\(.*\\)" url)
  (let ((type (w3-match url 1))
	(data (w3-match url 2)))
    (set-buffer (get-buffer-create w3-working-buffer))
    (setq url-current-type "www"
	  url-current-server type
	  url-current-file data)
    (cond
     ((equal type "preview")		; Previewing a document
      (if (get-buffer data)		; Buffer still exists
	  (insert-buffer data)		; Insert the document
	(url-retrieve (concat "www://error/nobuf/" data))))
     ((equal type "error")		; Error message
      (if (string-match "\\([^/]+\\)/\\(.*\\)" data)
	  (w3-generate-error (w3-match data 1) (w3-match data 2))
	(w3-generate-error data "")))
     ((equal type "auto")		; Hotlist or help stuff
      (w3-generate-auto-html data)))))

(fset 'url-www 'w3-internal-url)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Mode definition							    ;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun w3-reload-document ()
  "Reload the current document"
  (interactive)
  (let ((tmp (url-view-url t))
	(pnt (point))
	(url-request-extra-headers '(("Pragma" . "no-cache"))))
    (kill-buffer (current-buffer))
    (w3-fetch tmp)
    (goto-char pnt)))

(defun w3-leave-buffer ()
  "Bury this buffer,but don't kill it"
  (interactive)
  (let ((x w3-current-last-buffer))
    (if (and w3-running-FSF19
	     (or (eq window-system 'x)
		 (eq window-system 'pm)))
	(set-variable 'lucid-menu-bar-dirty-flag t))
    (bury-buffer nil)
    (if (and (bufferp x) (buffer-name x))
	(if w3-mutable-windows (pop-to-buffer x) (switch-to-buffer x)))))

(defun w3-quit ()
  "Quit WWW mode"
  (interactive)
  (let ((x w3-current-last-buffer))
    (if (and w3-running-FSF19
	     (or (eq window-system 'x)
		 (eq window-system 'pm)))
	(set-variable 'lucid-menu-bar-dirty-flag t))
    (and (boundp 'w3-mpeg-kill-processes) (w3-mpeg-kill-processes))
    (kill-buffer (current-buffer))
    (if (and (bufferp x) (buffer-name x))
	(if w3-mutable-windows (pop-to-buffer x) (switch-to-buffer x)))))

(defun w3-view-this-url (&optional no-show)
  "View the URL of the link under point"
  (interactive)
  (let* ((ext (w3-zone-at (point)))
	 (data (and ext (w3-zone-data ext))))
    (cond
     ((eq (car data) 'w3)
      (if (not no-show) (message "%s"
				 (w3-quotify-percents (nth 2 data)))
	(nth 2 data)))
     ((eq (car data) 'w3form)
      (if (not no-show)
	  (message "Form entry (name=%s, type=%s)" (w3-quotify-percents
						    (nth 3 data))
		   (w3-quotify-percents
		    (if (equal "" (nth 2 data)) "TEXT" (nth 2 data))) nil)))
     ((eq (car data) 'w3graphic)
      (if (not no-show) (message "Inlined image (%s)" (w3-quotify-percents
						       (nth 1 data))) nil))
     (t (if (not no-show) (message "No link at point.")
	  nil)))))

(defun w3-load-delayed-images ()
    "Load inlined images that were delayed, if necessary.
This function searches through w3-delayed-images and fetches the
appropriate picture for each point in the buffer and inserts it."
  (interactive)
  (and (fboundp 'w3-insert-graphic)
       (let ((buffer-read-only nil))
	 (mapcar (function (lambda (data) (apply 'w3-insert-graphic data)))
		 (nreverse w3-delayed-images))))
  (setq w3-delayed-images nil))

(defun w3-save-this-url ()
  "Save url under point in the kill ring"
  (interactive)
  (w3-save-url t))

(defun w3-save-url (under-pt)
  "Save current url in the kill ring"
  (interactive "P")
  (let ((x (cond
	    ((stringp under-pt) under-pt)
	    (under-pt (w3-view-this-url t))
	    (t (url-view-url t)))))
    (if x
	(progn
	  (setq kill-ring (cons x kill-ring))
	  (setq kill-ring-yank-pointer kill-ring)
	  (if (fboundp 'w3-store-in-x-clipboard)
	      (w3-store-in-x-clipboard x)))
      (error "No URL to store."))))

(defun w3-end-of-document ()
  "Go to end of document"
  (interactive)
  (goto-char (point-max)))

(defun w3-start-of-document ()
  "Go to start of document"
  (interactive)
  (goto-char (point-min)))

(defun w3-mail-to-author ()
  "Send mail to the author of this document, if possible."
  (interactive)
  (let ((x w3-current-links)
	(y nil)
	(found nil))
    (while (and x (not found))
      (setq y (car x)
	    x (cdr x)
	    found (equal (or (cdr (assoc "rel" y)) (cdr (assoc "rev" y)))
			 "made"))
      (if found
	  (setq found (cdr (assoc "href" y)))))
    (if found (w3-fetch found)
      (error "Cannot find the 'made' link for this document, sorry."))))

(defun w3-kill-emacs-func ()
  "Routine called when exiting emacs.  Do miscellaneous clean up."
  (and url-keep-history url-history-list (url-write-global-history))
  (message "Cleaning up w3 storage...")
  (let ((x (directory-files w3-temporary-directory t "w3.*")))
    (while x
      (condition-case ()
	  (delete-file (car x))
	(error nil))
      (setq x (cdr x))))
  (message "Cleaning up w3 storage... done.")
  (and w3-old-kill-emacs-hook (funcall w3-old-kill-emacs-hook)))

(defun w3-do-setup ()
  "Do setup - this is to avoid conflict with user settings when W3 is
dumped with emacs."
  (if (not w3-default-configuration-file)
      (setq w3-default-configuration-file
	    (condition-case ()
		(expand-file-name "~/.w3")
	      (error (expand-file-name "~/_W3")))))
		
  ; Read in the ~/.w3 file if it exists - could set up some of these
  ; defaults.  This file is where I will store configuration information
  ; once I write the auto-editing of variables/info, etc.
  (if (file-exists-p w3-default-configuration-file)
      (load-file w3-default-configuration-file))
  
  (if (not (assq 'w3-annotation-minor-mode minor-mode-alist))
      (setq minor-mode-alist (cons '(w3-annotation-minor-mode " Annotating")
				   minor-mode-alist)))
  (if (and (boundp 'minor-mode-map-alist)
	   (not (assq 'w3-annotation-minor-mode minor-mode-map-alist)))
      (setq minor-mode-map-alist (cons (cons 'w3-annotation-minor-mode
					     w3-annotation-minor-mode-map)
				       minor-mode-map-alist)))
  (setq url-package-version w3-version-number
	url-package-name "Emacs-W3")

  (w3-load-flavors)
  (w3-setup-version-specifics)
  ; Create the fonts, etc in windowing systems
  (w3-create-faces)

  (if (not url-setup-done) (url-do-setup))

  ; Check for whether they have giftopnm or giftoppm
  (let ((paths (mm-string-to-tokens (or (getenv "PATH")
					(concat
					 "/usr/bin:/bin:/usr/local/bin:"
					 "/usr/bin/X11:"
					 (expand-file-name "~/bin"))) ?:))
	(cell (assoc "image/gif" w3-graphic-converter-alist)))
    (if (memq 't (mapcar (function
			  (lambda (f)
			    (file-exists-p (expand-file-name "giftopnm" f))))
			 paths))
	(message "Found giftopnm")
      (message "No giftopnm, defaulting to giftoppm")
      (aset (cdr cell) 6 ?p)))

  ; Add the local etc directory to the icon search path
  (if (boundp 'data-directory)
      (let ((maybe-dir (file-name-as-directory
			(expand-file-name "w3" data-directory))))
	(if (file-directory-p maybe-dir)
	    (setq w3-icon-directory-list (cons (concat "file:" maybe-dir)
					       w3-icon-directory-list)))))

  ; Set up delimiting based on window-system and value of
  ; w3-emacs19-hack-faces-p
  (if (eq w3-delimit-emphasis 'guess)
      (setq w3-delimit-emphasis
	    (and (not w3-running-lemacs)
		 (not w3-running-epoch)
		 (not (boundp 'MULE))
		 (not (and w3-running-FSF19
			   (or (eq window-system 'x)
			       (eq window-system 'ns)
			       (eq window-system 'pm)
			       w3-emacs19-hack-faces-p))))))

  (if (eq w3-delimit-links 'guess)
      (setq w3-delimit-links
	    (and (not w3-running-lemacs)
		 (not w3-running-epoch)
		 (not (boundp 'MULE))
		 (not (and w3-running-FSF19
			   (or (eq window-system 'x)
			       (eq window-system 'ns)
			       (eq window-system 'pm)
			       w3-emacs19-hack-faces-p))))))

  ; Set up a hook that will save the history list when
  ; exiting emacs
  (if (or w3-running-lemacs w3-running-FSF19)
      (add-hook 'kill-emacs-hook 'w3-kill-emacs-func)
    (setq w3-old-kill-emacs-hook kill-emacs-hook
	  kill-emacs-hook 'w3-kill-emacs-func))

  (mm-parse-mailcaps)
  (mm-parse-mimetypes)

  ; Load in the hotlist if they haven't set it already
  (or w3-hotlist (w3-parse-hotlist))

  ; Load in their personal annotations if they haven't set them already
  (or w3-personal-annotations (w3-parse-personal-annotations))

  ; Set the default home page, honoring their defaults, then
  ; the standard WWW_HOME, then default to the documentation @ IU
  (or w3-default-homepage
      (setq w3-default-homepage
	    (or (getenv "WWW_HOME")
		"http://www.cs.indiana.edu/elisp/w3/docs.html")))

  ; This isn't used yet, but just in case we ever need it for the
  ; graphics parsing routines - perhaps use this value to determine
  ; value for w3-max-colors?
  (or w3-color-planes (setq w3-color-planes
			    (cond
			     (w3-running-lemacs (x-display-planes))
			     ((and w3-running-FSF19
				   (or (eq window-system 'x)
				       (eq window-system 'pm)))
			      (x-display-planes))
			     (w3-running-epoch 8)
			     (t nil))))

  ; This isn't used yet, but just in case we ever need it for the
  ; graphics parsing routines - perhaps use this value to determine
  ; value for w3-max-colors?
  (or w3-color-display (setq w3-color-display
			     (cond
			      (w3-running-lemacs (x-color-display-p))
			      ((and w3-running-FSF19
				    (or (eq window-system 'x)
					(eq window-system 'pm)))
			       (x-display-color-p))
			      ((and w3-running-FSF19
				    (eq window-system 'ns))
			       (ns-display-color-p))
			      (w3-running-epoch t)
			      (t nil))))

  (if (and (fboundp 'w3-insert-graphic)
	   (not w3-color-display)
	   (string-match "ppmtoxpm" w3-ppmtoxpm-command))
      (setq w3-ppmtoxpm-command w3-ppmtoxbm-command))

  ; Set up the documents menu
  (w3-parse-docs-menu)
  ; Set up the regular expression used to find styles.
  (setq w3-style-regexp (or w3-style-regexp
			    (concat "<\\("
				    (mapconcat 'car w3-style-assoc "\\|")
				    "\\)>")))
  ; Set up the entity definition for PGP and PEM authentication

  (run-hooks 'w3-load-hooks)
  (setq w3-setup-done t))

(defun w3-mark-link-as-followed (ext dat)
  "Mark a link as followed, by removing the old extent EXT, and replacing
it with a new extent with the w3-visited-node-style face."
  (let ((st (w3-zone-start ext))
	(nd (w3-zone-end ext)))
    (w3-delete-zone ext)
    (w3-add-zone st nd w3-visited-node-style dat t)
    (cond
     (w3-delimit-links
;      (goto-char nd)
;      (delete-region nd (- nd (length (car w3-link-end-delimiter))))
;      (insert (cdr w3-link-end-delimiter))
;      (goto-char st)
;      (delete-region st (+ st (length (car w3-link-start-delimiter))))
;      (insert (cdr w3-link-start-delimiter))
      )
     (t nil))))

(defun w3-download-url (url)
  (let ((url-be-asynchronous nil))
    (url-retrieve url)
    (w3-save-binary-file)))

;;;###autoload
(defun w3-follow-link (&optional p)
  "Attempt to follow the hypertext reference under point.
With prefix-arg P, ignore viewers and dump the link straight
to disk."
  (interactive "P")
  (let* ((ext (w3-zone-at (point)))
	 (dat (and ext (w3-zone-data ext))))
    (cond
     ((null dat) (message "No link, form entry, or image at point."))
     ((and (or p w3-dump-to-disk) (eq (car dat) 'w3))
      (if (stringp (nth 2 dat))
	  (w3-download-url (nth 2 dat))))
     ((eq (car dat) 'w3)
      (let ((buffer-read-only nil))
	(w3-mark-link-as-followed ext dat))
      (if (stringp (nth 2 dat)) (w3-fetch (nth 2 dat)) (message "No link.")))
     ((eq (car dat) 'w3form) (w3-do-form-entry dat ext))
     ((eq (car dat) 'w3graphic) (w3-fetch (nth 1 dat)))
     ((eq (car dat) 'w3expandlist) (w3-expand-list dat))
     ((eq (car dat) 'w3delayed)
      (apply 'w3-load-single-delayed-graphic
	     (w3-zone-start ext) (w3-zone-end ext) (cdr dat))
      (w3-delete-zone ext))
     ((eq (car dat) 'w3mpeg)
      (apply 'w3-load-single-delayed-mpeg
	     (w3-zone-start ext) (w3-zone-end ext) (cdr dat)))
     (t (message "Confused about what type of link is at point: %S" (car dat)))
     )))

(defun w3-complete-link ()
  "Choose a link from the current buffer and follow it"
  (interactive)
  (let (links-alist
	choice
	(completion-ignore-case t))
    (w3-map-links (function
		   (lambda (data arg)
		     (setq links-alist (cons
					(cons (nth 3 data)
					      (nth 2 data)) links-alist)))))
    (if (not links-alist) (error "No links in current document."))
    (setq links-alist (sort links-alist (function
					 (lambda (x y)
					   (string< (car x) (car y))))))
      (setq choice (completing-read "Link: " links-alist nil t))
      (w3-fetch (cdr (assoc choice links-alist)))))

(defun w3-mode ()
  "Mode for viewing HTML documents.  Will try to bring up the document
specified by w3-default-homepage.
Current keymap is:
\\{w3-mode-map}"
  (interactive)
  (or w3-setup-done (w3-do-setup))
  (let ((tmp (mapcar (function (lambda (x) (cons x (symbol-value x))))
		     w3-persistent-variables)))
    (kill-all-local-variables)
    (use-local-map w3-mode-map)
    (setq major-mode 'w3-mode)
    (setq mode-name "WWW")
    (mapcar (function (lambda (x) (set-variable (car x) (cdr x)))) tmp)
    (run-hooks 'w3-mode-hooks)
    (w3-mode-version-specifics)
    (setq url-current-passwd-count 0)
    (if (and w3-current-isindex (equal url-current-type "http"))
	(setq mode-line-process "-Searchable"))))

(provide 'w3)
