;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Copyright (c) 1993 by William M. Perry (wmperry@indiana.edu)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(require 'w3)

(defun w3-build-continuation ()
  "Build a series of functions to be run on this file"
  (save-excursion
    (set-buffer " *W3*")
    (let ((cont w3-default-continuation)
	  (extn (w3-file-extension w3-current-file)))
      (if (assoc extn w3-uncompressor-alist)
	  (setq extn (w3-file-extension
		      (substring w3-current-file 0 (- (length extn))))))
      (if w3-doing-graphic
	  (setq cont (append cont '(w3-finish-graphic)))
	(if (or (w3-in-assoc extn w3-viewer-alist)
		w3-current-mime-viewer)
	    (setq cont (append cont '(w3-pass-to-viewer)))
	  (progn
	    (if w3-doing-gopher
		(setq cont (append cont '(w3-parse-gopher))))
	    (if w3-source
		(if w3-print-next
		    (setq cont (append cont '(w3-print)))
		  (setq cont (append cont '(w3-source))))
	      (if w3-group-annotation-server
		  (setq cont
			(append cont
				'(w3-fetch-annotations w3-prepare-buffer)))
		(setq cont (append cont '(w3-prepare-buffer))))))))
      cont)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Support for the different types of urls
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun w3-http (url &optional source)
  "Retrieve URL via http.  If SOURCE is non-nil, then don't parse the buffer."
  (let ((lb (current-buffer))
	(tmp 0)
	(tmp2 0))
    (setq w3-source source)
    (w3-clear-tmp-buffer)
    (setq w3-current-type "http"
	  w3-current-last-buffer lb)
    (string-match "http:/*\\([^:/]*\\):*\\([^/]*\\)/*\\(/.*\\)" url)
    (let* ((server (substring url (match-beginning 1) (match-end 1)))
	   (port   (substring url (match-beginning 2) (match-end 2)))
	   (file   (substring url (match-beginning 3) (match-end 3)))
	   (dest   (if (string-match "#.+$" file)
		       (prog1
			   (substring file (1+ (match-beginning 0))
				      (match-end 0))
			 (setq file (substring file 0 (match-beginning 0))))
		     nil))
	   (extn   (w3-file-extension file)))
      (if (or (not (w3-member port w3-bad-port-list))
	      (yes-or-no-p
	       (format "Warning!  Trying to connect to port %s - continue? "
		       port)))
	  (progn
	    (if (equal port "") (setq port "80"))
	    (if (equal file "") (setq file "/") )
	    (setq w3-current-server server
		  w3-current-port port
		  w3-current-file file
		  w3-find-this-link dest)
	    (message "Fetching: %s %s %s" server port file)
	    (let ((process
		   (w3-open-stream "WWW" " *W3*" server (string-to-int port))))
	      (if (stringp process)
		  (message process)
		(progn
		  (w3-send-string process (w3-create-mime-request file ""))
		  (while (memq (process-status process) '(run open))
		    
		    (if (= 0 (setq tmp2 (% (1+ tmp2) 100)))
			(message "Reading..%s" (make-string
						(setq tmp (% (1+ tmp) 50))
						?.)))
		    (accept-process-output))
		  (condition-case ()
		      (delete-process process)
		    (error nil))
		  (w3-replace-regexp "Process WWW.*" "")
		  (w3-sentinel nil nil)))))
	(progn
	  (ding)
	  (message "Aborting connection to bad port..."))))))

(defun w3-file (url &optional source)
  "Find a link to an ftp site - simple transformation to ange-ftp format"
  (if (not (string-match "//" url)) (w3-open-local url)
    (progn
      (setq w3-source source)
      (string-match "^\\(file\\|ftp\\):/*\\([^/]*\\)/*\\(/.*\\)" url)
      (let* ((site (substring url (match-beginning 2) (match-end 2)))
	     (file (substring url (match-beginning 3) (match-end 3)))
	     (dest   (if (string-match "#.+$" file)
			 (prog1
			     (substring file (1+ (match-beginning 0))
					(match-end 0))
			   (setq file (substring file 0 (match-beginning 0))))
		       nil))
	     (extn (w3-file-extension file))
	     (view (cdr (w3-in-assoc extn w3-viewer-alist)))
	     (buff (get-buffer-create " *W3*"))
	     (obuf (current-buffer)))
	(w3-clear-tmp-buffer)
	(setq w3-current-last-buffer obuf)
	(let ((filename (concat "/anonymous@" site ":" file)))
	  (cond
	   ((equal site "localhost") (w3-open-local file))
	   ((file-directory-p filename)
	    (if (eq w3-directory-format 'hypertext)
		(progn
		  (setq w3-current-type "ftp"
			w3-find-this-link dest
			w3-current-last-buffer obuf
			w3-current-server site
			w3-current-file (format
					 "%s%sindex.html" file
					 (if (equal "/"
						    (substring file -1 nil))
					     "" "/")))
		  (w3-format-directory filename)
		  (setq w3-continuation (w3-build-continuation))
		  (w3-use-continuation))
	      (find-file filename)))
	   ((equal ".html" (w3-file-extension filename))
	    (progn
	      (set-buffer (get-buffer-create " *W3*"))
	      (setq w3-current-type "ftp")
	      (setq w3-current-server site)
	      (setq w3-current-file file)
	      (insert-file-contents filename nil)
	      (setq w3-continuation (w3-build-continuation))
	      (w3-use-continuation)))
	   (view (progn
		   (set-buffer (get-buffer-create " *W3*"))
		   (setq w3-current-file filename)
		   (insert-file-contents filename)
		   (w3-pass-to-viewer)))
	   (t (find-file filename))))))))

(defun w3-news-get-header (header)
  "Get header information HEADER out of news article in nntp buffer"
  (set-buffer " *nntpd*")
  (goto-char (point-min))
  (if (re-search-forward (concat "^" header ": +\\(.*\\)") nil t)
      (buffer-substring (match-beginning 1) (match-end 1))
    ""))

(defun w3-news-get-body ()
  "Get body of article from the nntp buffer"
  (set-buffer " *nntpd*")
  (goto-char (point-min))
  (re-search-forward "\\\n\\\n")
  (buffer-substring (match-end 0) (point-max)))

(defun w3-format-news ()
  "Format a news buffer in html"
  (let ((from  (w3-news-get-header "From"))
	(subj  (w3-news-get-header "Subject"))
	(org   (w3-news-get-header "Organization"))
	(date  (w3-news-get-header "Date"))
	(group (w3-news-get-header "Newsgroups"))
	(body  (w3-news-get-body)))
    (w3-clear-tmp-buffer)
    (setq w3-current-file ""
	  w3-current-type "")
    (insert
     (format "<TITLE>%s</TITLE>\n" group)
     (format
      "<ADDRESS>%s</ADDRESS><P>\n<H1>%s</H1><P>\n%s %s<P><P><P>\n<PRE>%s</PRE>"
      from subj org date body))
    (setq w3-continuation (append w3-continuation '(w3-prepare-buffer)))
    (w3-use-continuation)))

(defun w3-format-whole-newsgroup (newsgroup header-list)
  (w3-clear-tmp-buffer)
  (setq w3-current-file ""
	w3-current-type "")
  (insert (format "<TITLE>%s</TITLE>\n<H1>%s</H1>\n<DL>\n" newsgroup
		  newsgroup))
  (while header-list
    (insert
     (format "<DT>%s\n<DD><A HREF=\"news:%s\">%s</A>\n"
	     (nntp-header-from (car header-list))
	     (if (string-match "<\\(.*\\)>"
			       (nntp-header-id (car header-list)))
		 (substring (nntp-header-id (car header-list))
			    (match-beginning 1) (match-end 1)))
	     (nntp-header-subject (car header-list))))
    (setq header-list (cdr header-list))))

(defun w3-news (article)
  "Find a news reference"
  (let ((buff (current-buffer)))
    (set-buffer (get-buffer-create " *W3*"))
    (setq w3-current-last-buffer buff)
    (set-buffer buff))
  (if (not (nntp-server-opened))
      (progn
	(message "Reopening connection to %s" w3-news-server)
	(if (not (nntp-open-server w3-news-server))
	    (error "News server not responding!"))))
  (if (string-match "@" article);; Its a specific article
      (progn
	(if (not (equal "<" (substring article -1 nil)));; get in correct
	    (setq article (format "<%s>" article)));; format
	(if (nntp-request-article article);; did we get it?
	    (w3-format-news);; yes
	  (message "%s" (nntp-status-message))));; no, show message
    (progn;; Its a whole group
      (if (not (nntp-request-group article))
	  (message "%s" (nntp-status-message))
	(let*
	    ((stat (nntp-status-message))
	     (tmp (string-match "[0-9]+ +\\([0-9]+\\) +\\([0-9]+\\)" stat))
	     (st (string-to-int (substring stat
					   (match-beginning 1)
					   (match-end 1))))
	     (nd (string-to-int (substring stat
					   (match-beginning 2)
					   (match-end 2)))))
	  (w3-format-whole-newsgroup article
				     (nntp-retrieve-headers
				      (w3-make-sequence st nd)))
	  (setq w3-continuation (append w3-continuation '(w3-prepare-buffer)))
	  (w3-use-continuation))))))

(defun w3-open-local (fname &optional source)
  "Find a local file."
  (interactive "FLocal file:")
  (setq w3-source source)
  (let ((lb (current-buffer))
	(dest   (if (string-match "#.+$" fname)
		    (prog1
			(substring fname
				   (1+ (match-beginning 0)) (match-end 0))
		      (setq fname (substring fname 0 (match-beginning 0))))
		  nil)))
    (w3-clear-tmp-buffer)
    (message "Fetching... %s" fname)
    (setq w3-current-type nil
	  w3-find-this-link dest
	  w3-current-last-buffer lb
	  w3-current-file (if (string-match "file:" fname)
			      (substring fname (match-end 0) nil) fname))
    (if (string-match "file:" fname)
	(setq fname (substring fname (match-end 0) nil)))
    (if (file-directory-p fname)
	(if (eq w3-directory-format 'hypertext)
	    (progn
	      (w3-format-directory fname)
	      (setq w3-current-file (format
				     "%s%sindex.html" fname
				     (if (equal "/"
						(substring fname -1 nil))
					 "" "/"))))
	  (find-file fname))
      (progn
	(insert-file-contents fname)
	(if (not (w3-member
		  (w3-file-extension w3-current-file) w3-hypertext-extns))
	    (progn
	      (goto-char (point-min))
	      (insert "<PLAINTEXT>\n")))))
    (setq w3-continuation (w3-build-continuation))
    (w3-use-continuation)))

(defun w3-format-directory (dir)
  "Format the files in DIR into hypertext"
  (let ((files (directory-files dir)))
    (save-excursion
      (set-buffer " *W3*")
      (erase-buffer)
      (insert (format "<TITLE>Index of %s</TITLE>\n" dir))
      (insert (format "<H1> Directory listing of %s</H1>\n<P>" dir))
      (insert "<UL>\n")
      (while files
	(cond
	 ((equal "." (car files)) nil)
	 ((equal ".." (car files)) 
	  (insert (format "<LI> <A HREF=\"%s\">%s</A>\n"
			  (car files) "Parent Directory")))
	 (t
	  (insert (format "<LI> <A HREF=\"%s\">%s</A>\n"
			  (car files) (car files)))))
	(setq files (cdr files)))
      (insert "\n</UL>"))))

(defun w3-telnet (url)
  (string-match "telnet:/*\\(.*@\\)*\\([^/]*\\)/*" url)
  (let* ((server (substring url (match-beginning 2) (match-end 2)))
	 (name (if (match-beginning 1)
		   (substring url (match-beginning 1) (1- (match-end 1)))
		 nil))
	 (thebuf (string-match ":" server))
	 (port (if thebuf
		   (prog1
		       (substring server (1+ thebuf) nil)
		     (setq server (substring server 0 thebuf))) "23")))
    (if (equal window-system 'x)
	(start-process "htmlsub" nil w3-xterm-command
		       "-title" server
		       "-ut" "-e" "telnet" server port)
      (terminal-emulator
       (get-buffer-create (format "%s%s:%s" (if name (concat name "@") "")
				  server port))
       w3-telnet-prog
       (list server port)))))

(defun w3-mailto (url)
  "Send mail to someone"
  (string-match "mailto:/*\\(.*\\)" url)
  (let ((to (substring url (match-beginning 1) (match-end 1))))
    (if w3-mutable-windows (mail-other-window) (mail))
    (mail-to)
    (insert to)
    (mail-subject)))

(defun w3-gopher (url &optional source search)
  (string-match "gopher:/*\\([^/:]*\\):*\\([0-9]*\\)/*\\(.?\\)\\(.*\\)"
		url)
  (let ((server (substring url (match-beginning 1) (match-end 1)))
	(port   (substring url (match-beginning 2) (match-end 2)))
	(type   (substring url (match-beginning 3) (match-end 3)))
	(file   (w3-unhex-string
		 (substring url (match-beginning 4) (match-end 4))))
	)
    (if (or (not (w3-member port w3-bad-port-list))
	    (yes-or-no-p
	     (format "Warning!  Trying to connect to port %s - continue? "
		     port)))
	(progn
	  (if (equal "" port) (setq port "70"))
	  (if w3-use-hypertext-gopher
	      (w3-do-gopher server port type file source search)
	    (gopher-dispatch-object (vector (if (equal type "") ?1 
					      (string-to-char type)) file file
					      server (string-to-int port))
				    (current-buffer))))
      (progn
	(ding)
	(message "Aborting connection to bad port...")))))

(defun w3-fetch (&optional url)
  "Function to read in a URL and dispatch it to the appropriate handler."
  (interactive (list (read-string "URL: " (if (eq major-mode 'w3-mode)
					      (w3-view-url t) ""))))
  (setq w3-doing-gopher nil)
  (string-match "\\([^:]*\\):" url)
  (let* ((type (substring url (match-beginning 1) (match-end 1))))
    (cond
     ((equal type "mailto") (w3-mailto url))
     ((equal type "news") (w3-news (substring url (match-end 0) nil)))
     ((equal type "local") (w3-open-local url))
     ((equal type "ftp") (w3-file url))
     ((equal type "file") (w3-file url))
     ((equal type "http") (w3-http url))
     ((equal type "telnet") (w3-telnet url))
     ((equal type "gopher") (w3-gopher url))
     (t (message "Unsupported link type: %s" type)))))

(provide 'w3-url)
