;;; w3-beta.el,v --- Misc functions for emacs-w3's new display engine
;; Author: wmperry
;; Created: 1995/06/15 02:39:39
;; Version: 1.37
;; Keywords: help, hypermedia, comm

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Copyright (c) 1993, 1994, 1995 by William M. Perry (wmperry@spry.com)
;;;
;;; This file is part of GNU Emacs.
;;;
;;; GNU Emacs is free software; you can redistribute it and/or modify
;;; it under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 2, or (at your option)
;;; any later version.
;;;
;;; GNU Emacs is distributed in the hope that it will be useful,
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Emacs; see the file COPYING.  If not, write to
;;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun w3-import-netscape-bookmarks (fname)
  "Import a Netscape/X style bookmark list into the Emacs-w3 format."
  (interactive "fBookmark file: ")
  (if (not (file-readable-p fname))
      (error "Can not read %s..." fname))
  (save-excursion
    (set-buffer (get-buffer-create " *bookmark-work*"))
    (erase-buffer)
    (insert-file-contents fname)
    (let ((parse (w3-preparse-buffer (current-buffer) t))
	  (url nil)
	  (label nil))
      (while parse
	(if (eq (car (car parse)) 'a)
	    (progn
	      (setq url (cdr-safe (assoc "href" (cdr (car parse))))
		    label nil)
	      (while (and parse (not (eq '/a (car (car parse)))))
		(if (eq 'text (car (car parse)))
		    (setq label (cons (cdr (car parse)) label)))
		(setq parse (cdr parse)))
	      (setq label (mapconcat 'identity (nreverse label) ""))
	      (and label url (w3-hotlist-add-document nil label url))))
	(setq parse (cdr parse))))))

(defun w3-parse-header-link-items ()
  ;; Parse `url-current-mime-headers' and look for any <link> items
  (let ((items url-current-mime-headers)
	(node nil)
	(url nil)
	(type nil)
	(args nil)
	(title nil)
	(label nil))
    (while items
      (setq node (car items)
	    items (cdr items))
      (if (string= (car node) "link")
	  (progn
	    (setq args (mm-parse-args (cdr node))
		  type (if (assoc "rel" args) "rel" "rev")
		  label (cdr-safe (assoc type args))
		  title (cdr-safe (assoc "title" args))
		  url (car-safe (w3-rassoc nil args)))
	    (if (string-match "^<.*>$" url)
		(setq url (substring url 1 -1)))
	    (and url label type
		 (w3-handle-link (list (cons "href" url)
				       (cons type label)
				       (cons "title" title)))))))))
     
(defun w3-refresh-buffer (&rest args)
  "Redraw the current buffer - this does not refetch or reparse the current
document, but uses the stored parse data."
  (interactive)
  (let ((buffer-read-only nil))
    (if (get-buffer url-working-buffer)
	(kill-buffer url-working-buffer))
    (erase-buffer)
    (rename-buffer url-working-buffer)
    (setq w3-delayed-images nil
	  w3-current-links nil
	  w3-delayed-movies nil)
    (w3-parse-header-link-items)
    (w3-draw-html w3-current-parse)
    (w3-show-buffer)))

(defun w3-prepare-buffer (&rest args)
  ;; The text/html viewer - does all the drawing and displaying of the buffer
  ;; that is necessary to go from raw HTML to a good presentation.
  (let* ((source (buffer-string))
	 (parse (w3-preparse-buffer (current-buffer)))
	 (buff (car parse)))
    (set-buffer-modified-p nil)
    (kill-buffer (current-buffer))
    (set-buffer buff)
    (setq w3-current-source source
	  w3-current-parse (cdr parse))
    (w3-parse-header-link-items)
    (save-excursion
      (goto-char (point-max))
      (w3-handle-paragraph)
      (w3-mode)
      (w3-handle-annotations)
      (w3-handle-headers)
      (if (boundp 'MULE) (w3-mule-attribute-zones w3-zones-list))
      (set-buffer-modified-p nil)
      (setq buffer-read-only t))
    (switch-to-buffer (current-buffer))
    (let ((window nil)
	  (pop-up-windows nil))
      (display-buffer (current-buffer))
      (if (or w3-running-FSF19 w3-running-xemacs)
	  (setq window (get-buffer-window (current-buffer) t))
	(setq window (get-buffer-window (current-buffer))))
      (select-window window)
      (if (and (fboundp 'select-frame)
	       (fboundp 'window-frame))
	  (select-frame (window-frame window))))
    (goto-char (point-min))
    (w3-show-buffer)
    (if url-keep-history
	(let ((url (url-view-url t)))
	  (if (and (not (assoc url url-history-list)))
	      (setq url-history-list
		    (cons (cons url (buffer-name)) url-history-list)))
	  (if (fboundp 'w3-shuffle-history-menu)
	      (w3-shuffle-history-menu))))))

(defun w3-handle-headers ()
  ;; Insert any headers the user wants to see into the current buffer.
  (let ((show w3-show-headers)
	(cur nil)
	(hdrs nil)
	(tag 'ol)
	(header nil)
	(w3-last-fill-pos (point-max))
	(val nil)
	(first t))
    (goto-char (point-max))
    (if (eq show t) (setq show '(".*")))
    (while show
      (setq cur (car show)
	    show (cdr show)
	    hdrs url-current-mime-headers)
      (while hdrs
	(setq header (car (car hdrs))
	      val (cdr (car hdrs))
	      hdrs (cdr hdrs))
	(if (numberp val) (setq val (int-to-string val)))
	(if (and (/= 0 (length header))
		 (string-match cur header))
	    (progn
	      (if first
		  (progn
		    (w3-handle-hr)
		    (w3-handle-list-opening '(("value" . 1)))
		    (setq tag 'li
			  first nil)))
	      (w3-handle-list-item)
	      (w3-handle-text (concat (capitalize header)
				      ": " val))))))
    (if (not first)			; We showed some headers
	(setq tag '/ol
	      tag (w3-handle-list-ending)))))

(defun w3-handle-annotations ()
  ;; Insert personal annotations into the current buffer
  (let ((annos (w3-fetch-personal-annotations))
	(tag nil))
    (if (not annos)
	nil				; No annotations
      (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-handle-hr '(("align" . "center") ("width" . "50%")))
      (setq tag 'h3)
      (w3-handle-header '(("align" . "center")))
      (setq tag 'ol)
      (w3-handle-list-opening '(("value" . 1)))
      (while annos
	(put 'w3-state 'href (car (car annos)))
	(w3-handle-list-item)
	(w3-handle-text (cdr (car annos)))
	(put 'w3-state 'href nil)
	(setq annos (cdr annos)))
      (w3-handle-list-ending)
      (w3-handle-hr '(("align" . "center") ("width" . "50%"))))))

(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
		     (cons
		      (format "file:%s%s/PAN-%s.html"
			      (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-draw-hotlist-as-html (hotlist-data)
  ;; Draw an AIR-Mosaic style hotlist as HTML.
  (set-buffer (get-buffer-create url-working-buffer))
  (erase-buffer)
  (insert "<html>\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 data"
	  "</h1>\n\t\t\t<ul>\n")
  (w3-draw-sublist hotlist-data)
  (insert "\t\t\t</ul>\n\t\t</div1>\n\t</body>\n</html>\n"))

(defun w3-draw-sublist (data)
  ;; Draw a sublist of an AIR Mosaic style hotlist
  (let ((ttl (car data)))
    (setq data (cdr (cdr data)))
    (insert "<ul>\n"
	    " <li> " ttl "\n"
	    "  <ul>\n")
    (while data
      (cond
       ((and (listp (car data)) (null (nth 1 (car data))))
	(w3-draw-sublist (car data)))
       ((listp (car data))
	(insert "    <li> <a href=\""
		(nth 1 (car data)) "\">"
		(nth 0 (car data)) "</a></li>\n"))
       (t 'undefined))
      (setq data (cdr data)))
    (insert "  </ul>\n"
	    " </li>\n"
	    "</ul>\n")))

(defun w3-parse-air-hotlist (&optional fname)
  ;; Read in an AIR-Mosaic style hotlist and parse it.
  (if (not fname) (setq fname w3-hotlist-file))
  (setq w3-hotlist nil)
  (if (not (and (file-exists-p fname) (file-readable-p fname)))
      (message "%s does not exist!" fname)
    (save-excursion
      (set-buffer (get-buffer-create " *w3-temp*"))
      (erase-buffer)
      (insert-file-contents fname)
      (goto-char (point-min))
      (if (not (looking-at "^Hotlist\r*$"))
	  (error "%s is not in hotlist format!" fname))
      (url-replace-regexp "^[ \t]*{[ \t\r]*$" "(")
      (url-replace-regexp "^[ \t]*}[ \t\r]*$" ")")
      (url-replace-regexp "^Hotlist\r*$" "(")
      (url-replace-regexp "^[ \t]*\\(Sublist\\|Item\\)[ \t\r]*$"
			  ")(")
      (goto-char (point-min))
      (catch 'ack
	(while (not (eobp))
	  (beginning-of-line)
	  (if (not (looking-at "^[ \t]*[()]+[ \t\r]*$"))
	      (progn
		(skip-chars-forward " \t\r")
		(insert "\"")
		(end-of-line)
		(skip-chars-backward " \t\r")
		(insert "\"")))
	  (condition-case ()
	      (next-line 1)
	    (error (throw 'ack t)))))
      (goto-char (point-max))
      (insert "\n)")
      (let ((dat nil))
	(goto-char (point-min))
	(condition-case ()
	    (setq dat (read (current-buffer)))
	  (error nil))
	dat))))

(defvar w3-netscape-FAT-file "index"
  "*Filename in a netscape cache directory.")

(defvar w3-netscape-FAT-tag
  "MCOM-Cache-file-allocation-table-format-1"
  "*The line at the beginning of a netscape cache file.")

(defmacro w3-skip-word ()
  (skip-chars-forward "^ \t\n\r")
  (skip-chars-forward " \t"))

(defun w3-read-netscape-config (&optional fname)
  "Read in a netscape-style configuration file."
  (interactive "fNetscape configuration file: ")
  (if (not (and (file-exists-p fname)
		(file-readable-p fname)))
      (error "Could not read %s" fname))
  (let ((results nil)
	(tag nil)
	(val nil)
	(var nil)
	(save-pos nil))
    (save-excursion
      (set-buffer (get-buffer-create " *w3-tmp*"))
      (erase-buffer)
      (insert-file-contents fname)
      (goto-char (point-min))
      (skip-chars-forward "^ \t\r\n")	; Skip tag line
      (skip-chars-forward " \t\r\n")	; Skip blank line(s)
      (while (not (eobp))
	(setq save-pos (point))
	(skip-chars-forward "^:")
	(upcase-region save-pos (point))
	(setq tag (buffer-substring save-pos (point)))
	(skip-chars-forward ":\t ")
	(setq save-pos (point))
	(skip-chars-forward "^\r\n")
	(setq val (if (= save-pos (point))
		      nil
		    (buffer-substring save-pos (point))))
	(cond
	 ((null val) nil)
	 ((string-match "^[0-9]+$" val)
	  (setq val (string-to-int val)))
	 ((string= "false" (downcase val))
	  (setq val nil))
	 ((string= "true" (downcase val))
	  (setq val t))
	 (t nil))
	(skip-chars-forward " \t\n\r")
	(setq results (cons (cons tag val) results))))
    (while results
      (setq tag (car (car results))
	    val (cdr (car results))
	    var (cdr-safe (assoc tag w3-netscape-variable-mappings))
	    results (cdr results))
      (cond
       ((eq var 'w3-delay-image-loads) (set var (not val)))
       (var (set var val))
       (t nil)))))
      
(defun w3-import-netscape-cache (dir)
  "Read in a Netscape-file cache directory and convert it to the Emacs-w3
format."
  (interactive "DNetscape cache directory: ")
  (let ((fname (expand-file-name w3-netscape-FAT-file dir))
	(netscape-name nil)		; Netscape cache name
	(url nil)			; Original URL
	(type nil)			; Content-type of URL
	(length nil)			; Content-length of URL
	(save-pos nil)			; Temporary point storage
	(w3-name nil)			; Emacs-w3 cached name
	(w3-hdrs nil)			; Header file
	)
    (if (not (and (file-exists-p fname) (file-readable-p fname)))
	(error "%s is not readable..." w3-netscape-FAT-file))
    (set-buffer (get-buffer-create " *w3-tmp*"))
    (erase-buffer)
    (insert-file-contents fname)
    (goto-char (point-min))
    (if (not (looking-at (concat "^" w3-netscape-FAT-tag "\r*$")))
	(error "%s is not a netscape FAT table..." w3-netscape-FAT-file))
    (forward-line 1)			; Skip tag line
    (while (not (eobp))
      (w3-skip-word)  (w3-skip-word) (w3-skip-word)
      (setq save-pos (point))
      (w3-skip-word)
      (setq netscape-name (expand-file-name
			   (w3-fix-spaces (buffer-substring save-pos (point)))
			   dir)
	    save-pos (point))
      (w3-skip-word)
      (setq url (w3-fix-spaces (buffer-substring save-pos (point)))
	    save-pos (point))
      (w3-skip-word)
      (setq type (w3-fix-spaces (buffer-substring save-pos (point)))
	    save-pos (point))
      (w3-skip-word)
      (setq length (w3-fix-spaces (buffer-substring save-pos (point))))
      (skip-chars-forward " \t\r\n")
      (setq w3-name (url-create-cached-filename url)
	    w3-hdrs (url-generic-parse-url url)
	    w3-hdrs (format "(setq url-current-content-length \"%s\"
      url-current-mime-type \"%s\"
      url-current-type \"%s\"
      url-current-user \"%s\"
      url-current-server \"%s\"
      url-current-port \"%s\"
      url-current-file \"%s\"
      url-current-mime-headers '((\"content-type\" . \"%s\")
				 (\"content-length\" . \"%s\")))"
			    length type
			    (url-type w3-hdrs)
			    (url-user w3-hdrs)
			    (url-host w3-hdrs)
			    (url-port w3-hdrs)
			    (url-filename w3-hdrs)
			    type length))
      (condition-case ()
	  (make-directory (url-basepath w3-name) t)
	(error nil))
      (write-region w3-hdrs nil (concat (url-file-extension w3-name t)
					".hdr"))
      (condition-case ()
	  (copy-file netscape-name w3-name t)
	(error nil)))))

(if (not (fboundp 'abs))
    (defun abs (arg)
      "Return the absolute value of ARG."
      (if (< 0 arg) (- arg) arg)))

(defvar w3-directory "/usr/local/lib/emacs/site-lisp/w3")

(defun w3-install-latest ()
  "Install the latest version of the W3 world wide web browser."
  (interactive)
  (let* (
	 (sorted-tar-files
	  ;; This sort fails when the length of the version number changes!
	  ;; But Bill P. hereby promises not to let that happen. :)
	  (sort (delq nil
		      (mapcar (function
			       (lambda (filename)
				 (let ((len (length filename)))
				   (and (> len 7)
					(string=
					 ".tar.gz"
					 (substring filename
						    (- len 7) len))
					filename))))
			      (file-name-all-completions
			       "w3-" "/anonymous@cs.indiana.edu:/pub/elisp/w3/")))
		(function string<)))
	 (tar-file
	  (nth (1- (length sorted-tar-files)) sorted-tar-files))
	 (version-string (substring tar-file 3 (- (length tar-file) 7)))
	 (new-directory
	  (concat "w3-" version-string))
	 (default-directory
	   (concat "~/emacs/site-lisp")))
    (if (file-exists-p (concat default-directory "/" new-directory))
	(error "W3 version %s has already been installed." version-string))
    ;; We don't use /tmp because it might be on a different filesystem, so it
    ;; couldn't just be renamed.
    (make-directory "w3-tmp")
    (copy-file (concat "/anonymous@cs.indiana.edu:/pub/elisp/w3/" tar-file)
	       "w3-tmp")
    ;; This doesn't work right without "default-directory" in the cd.
    (shell-command (concat "cd " default-directory "/w3-tmp; "
			   "gunzip -qc " tar-file " | tar xvf -"))
    (shell-command (concat "cd " default-directory "/w3-tmp/w3; cp w3.info* /usr/local/info"))
    (rename-file "w3-tmp/w3" new-directory)
    (delete-file (concat "w3-tmp/" tar-file))
    (delete-directory "w3-tmp")
    (delete-file "w3")			; get rid of the old link
    ;; This doesn't work right without the cd.
    (shell-command (concat "cd " default-directory "; ln -s " new-directory " w3" ))
    (shell-command (concat "cd " default-directory "/w3; etags *.el"))))

(provide 'w3-beta)
