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

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Miscellaneous functions
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun w3-hexify-string (str)
  "Escape characters in a string"
  (let ((str2 "")
	(char 0))
    (while (not (equal str ""))
      (setq char (string-to-char str)
	    str (substring str 1 nil)
	    str2 (format "%s%s" str2
			 (if (or (> char ?z)
				 (< char ?0)
				 (and (< char ?a)
				      (> char ?Z))
				 (and (< char ?A)
				      (> char ?9)))
			     (format "%%%x" char)
			   (format "%c" char)))))
    str2))

(defun w3-start-viewer (fname cmd)
  "Start a subprocess, use list LS as the arguments."
  (let ((proc
	 (start-process fname nil (or (getenv "ESHELL")
				      (getenv "SHELL")
				      "/bin/sh"))))
    (process-send-string proc (format "exec %s\n" cmd))
    proc))

(defun w3-send-string (proc str)
  "Send process PROC a string STR, one line at a time."
  (let ((firstline "")
	(tmp ""))
    (setq firstline (substring str 0 (string-match "\\\r*$" str))
	  str (substring str (+ 2 (string-match "\\\r*$" str)) nil))
    (process-send-string proc (format "%s\n" firstline))
    (sleep-for 1)
    (accept-process-output)
    (while (and (memq (process-status proc) '(open run))
		(not (equal "" str)))
      (string-match "\\\r*$" str)
      (setq tmp (substring str 0 (match-end 0))
	    str (substring str (1+ (match-end 0)) nil))
      (process-send-string proc (format "%s\n" tmp))
      (accept-process-output))))

(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 w3-current-type)
	 (eq major-mode 'w3-mode))
    (if w3-mutable-windows
	(find-file-other-window w3-current-file)
      (find-file w3-current-file)))
   ((equal w3-current-type "ftp")
    (if w3-mutable-windows
	(find-file-other-window
	 (format "/anonymous@%s:%s" w3-current-server w3-current-file))
      (find-file 
       (format "/anonymous@%s:%s" w3-current-server w3-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) (w3-view-url t))))
    (if (not (equal "Not on a link!" url))
	(progn
	  (set-buffer thebuf)
	  (insert url)
	  (set-buffer oldbuf)))))      

(defun w3-lookup-style (type)
  "Return the physical style of logical style <TYPE>"
  (if (not (or w3-running-FSF19 w3-running-lemacs w3-running-epoch)) nil
    (cond
     ((equal type "TT") w3-tt-style)
     ((equal type "B") w3-bold-style)
     ((equal type "I") w3-italic-style)
     ((equal type "U") w3-underline-style)
     ((equal type "EM") w3-emphasis-style)
     ((equal type "STRONG") w3-strong-style)
     ((equal type "CODE") w3-tt-style)
     ((equal type "SAMP") w3-samp-style)
     ((equal type "KBD") w3-kbd-style)
     ((equal type "VAR") w3-var-style)
     ((equal type "DFN") w3-dfn-style)
     ((equal type "CITE") w3-cite-style))))

(defun w3-make-sequence (start end)
  "Make a sequence (list) of numbers from START to END"
  (let ((sqnc '()))
    (while (< start end)
      (setq sqnc (cons (int-to-string start) sqnc)
	    start (1+ start)))
    sqnc))

(defun w3-maybe-relative (url)
  "Take a url and either fetch it, or resolve relative refs, then fetch it"
  (cond
   ((not
     (string-match "^\\(news\\|ftp\\|http\\|file\\|telnet\\|gopher\\):" 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 list
      (and (car (car list))
	   (string-match (car (car list)) elt)
	   (setq rslt (car list)))
      (setq list (cdr list)))
    rslt))

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

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

(defun w3-file-extension (fname)
  "Return the filename extension of FNAME"
  (if (string-match "\\.[^\\.]+$" fname)
      (substring fname (match-beginning 0) nil) ""))

(defun w3-toggle-telnet ()
  "Toggle telnetting status"
  (interactive)
  (setq w3-use-telnet (not w3-use-telnet)))

(defun w3-basepath (file &optional x)
  "Return the base pathname of FILE, or the actual filename if X is true"
  (if (string-match "\\(.*\\)/\\([^/]*\\)" file)
      (if (not x) (substring file (match-beginning 1) (match-end 1))
	(substring file (match-beginning 2) (match-end 2)))
    file))

(defun w3-replace-regexp (regexp to-string)
  "Quiet replace-regexp."
  (goto-char (point-min))
  (while (re-search-forward regexp nil t)
    (replace-match to-string t nil)))

(defun w3-find-highest-link-num ()
  "Find highest NAMEd link, so we can number on from there."
  (set-buffer " *W3*")
  (goto-char (point-min))
  (let ((lnkctr 0))
    (while (re-search-forward "<A[ \t\n]+NAME=" (point-max) t)
      (let* ((start (match-end 0))
	     (end (save-excursion
		    (re-search-forward "[ \t\n>]" (point-max) t)
		    (match-beginning 0)))
	     (subst (buffer-substring start end)))
	(and subst
	     (> (string-to-int subst) lnkctr)
	     (setq lnkctr (string-to-int subst)))))
    lnkctr))

(defun w3-clear-tmp-buffer ()
  "Clear the temporary W3 buffer"
  (set-buffer (get-buffer-create " *W3*"))
  (if buffer-read-only (toggle-read-only))
  (erase-buffer))  

(defun w3-preview-this-buffer ()
  "See what this buffer will look like when its formatted."
  (interactive)
  (let* ((thebuf (current-buffer)))
    (w3-clear-tmp-buffer)
    (insert-buffer thebuf)
    (setq w3-current-file (buffer-name thebuf)
	  w3-current-type nil)
    (setq w3-continuation (append w3-continuation '(w3-prepare-buffer)))
    (w3-use-continuation)))

(defun w3-open-stream (name buffer host service)
  "Open a stream to a host, using either telnet (if w3-use-telnet is t,
or a raw stream (if w3-use-telnet is nil)"
  (if w3-use-telnet
      (let ((proc
	     (start-process name buffer w3-telnet-prog host
			    (int-to-string service)))
	    (tmp nil))
	(save-excursion
	  (set-buffer buffer)
	  (setq tmp (point))
	  (while (not (progn
			(goto-char (point-min))
			(re-search-forward w3-telnet-ready-regexp nil t)))
	    (accept-process-output))
	  (delete-region tmp (point))
	  (goto-char (point-min))
	  (if (re-search-forward "connect:" nil t)
	      (progn
		(condition-case ()
		    (delete-process proc)
		  (error nil))
		(w3-replace-regexp ".*connect:.*" "")
		nil)
	    proc)))
    (let ((tries 1)
	  (x t)
	  (y nil)
	  (z nil))
      (while (and x
		  (<= tries w3-connection-retries))
	(condition-case y
	    (setq z (open-network-stream name buffer host service)
		  x nil)
	  (error (progn
		   (message "Failed on connection try #%d" tries)
		   (setq x t
			 tries (1+ tries))))))
      (if (> tries w3-connection-retries)
	  (format "Could not establish connection to %s:%d" host service)
	z))))

(defun w3-unhex (x)
  (if (> x ?9)
      (if (>= x ?a)
	  (+ 10 (- x ?a))
	(+ 10 (- x ?A)))
    (- x ?0)))

(defun w3-unhex-string (str)
  "Remove %XXX embedded spaces, etc in a url"
  (let ((tmp ""))
    (while (string-match "%[0-9a-f][0-9a-f]" str)
      (let* ((start (match-beginning 0))
	     (ch1 (w3-unhex (elt str (+ start 1))))
	     (code (+ (* 16 ch1)
		      (w3-unhex (elt str (+ start 2))))))
	(setq tmp
	      (concat 
	       tmp (substring str 0 start)
	       (char-to-string code)))
	(setq str (substring str (match-end 0)))))
    (setq tmp (concat tmp str))
    tmp))

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

(defun w3-pass-to-viewer ()
  "Pass a w3 buffer to a viewer based on file extension."
  (set-buffer " *W3*")
  (let* ((view (if w3-current-mime-viewer
		   w3-current-mime-viewer
		 (cdr (w3-in-assoc (w3-file-extension w3-current-file)
				   w3-viewer-alist)))))
    (if (null view)
	(setq view 'indented-text-mode))
    (if (symbolp view)
	(progn
	  (rename-buffer (file-name-nondirectory w3-current-file))
	  (set-buffer-modified-p nil)
	  (if w3-mutable-windows
	      (pop-to-buffer (file-name-nondirectory w3-current-file))
	    (switch-to-buffer (file-name-nondirectory w3-current-file)))
	  (buffer-enable-undo)
	  (funcall view))
      (if (or (eq window-system 'x)
	      (y-or-n-p (format "Xwindows not detected, still use %s?" view)))
	  (let ((fname (w3-generate-unique-filename)))
	    (write-region (point-min) (point-max) fname)
	    (message "Passing to viewer %s" view)
	    (set-process-sentinel
	     (w3-start-viewer fname (format view fname)) 'w3-viewer-sentinel))
	(let ((x (read-file-name "Filename to save as: "
				 (expand-file-name "~/") "")))
	  (write-region (point-min) (point-max) x))))))

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

(defun w3-generate-unique-filename ()
  "Generate a unique filename in /tmp"
  (let ((base (format "/tmp/w3-tmp.%d" (user-real-uid)))
	(fname "")
	(x 0))
    (setq fname (format "%s%d" base x))
    (while (file-exists-p fname)
      (setq x (1+ x)
	    fname (format "%s%d" base x)))
    fname))

(defun w3-clean-text ()
  "Clean up a buffer after telnet (trash at beginning, connection closed)"
  (set-buffer " *W3*")
  (if (and w3-use-telnet (equal w3-current-type "http"))
      (progn
	(goto-char (point-min))
	(kill-line w3-telnet-header-length)
	(w3-replace-regexp "Connection.*" ""))))

(defun w3-print ()
  "Print a hypertext buffer using LaTeX"
  (set-buffer " *W3*")
  (w3-convert-html-to-latex)
  (save-window-excursion
    (write-region (point-min) (point-max) "/tmp/w3-tmp.latex" nil 5)
    (shell-command
     (format
      "cd /tmp/ ; latex w3-tmp.latex ; %s w3-tmp.dvi ; rm -f w3-tmp*"
      w3-print-command))
    (kill-buffer "*Shell Command Output*")))

(defun w3-source ()
  "Show the source of a file"
  (let ((tmp (buffer-name (generate-new-buffer "Document Source"))))
    (set-buffer " *W3*")
    (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))))

(defun w3-uncompress ()
  "Uncompress a file"
  (set-buffer " *W3*")
  (let ((extn (w3-file-extension w3-current-file)))
    (if (assoc extn w3-uncompressor-alist)
	(progn
	  (message "Uncompressing")
	  (shell-command-on-region (point-min) (point-max)
				   (cdr (assoc extn w3-uncompressor-alist))
				   t)))))

(defun w3-use-continuation ()
  (set-buffer " *W3*")
  (while w3-continuation
    (funcall (car w3-continuation))
    (setq w3-continuation (cdr w3-continuation)))
  (setq w3-continuation w3-default-continuation))

(defun w3-sentinel (proc string)
  (if (w3-is-mime-response) (w3-parse-mime-headers))
  (setq w3-continuation (w3-build-continuation))
  (w3-use-continuation))

(defun w3-show-history-list ()
  "Format the w3-history-list prettily and show it to the user"
  (interactive)
  (if (not w3-history-list)
      (error "Sorry, no history list available now!")
    (let ((urls w3-history-list)
	  (buff (current-buffer)))
      (w3-clear-tmp-buffer)
      (insert "<TITLE> History List For This Session of W3</TITLE>\n")
      (insert "<H1>History List For This Session of W3</H1>\n")
      (insert "<H2>(Oldest items last in list)</H2>\n")
      (insert "<OL>\n")
      (while urls
	(insert (format "<LI> <A HREF=\"%s\">%s</A>\n"
			(car (car urls)) (cdr (car urls))))
	(setq urls (cdr urls)))
      (insert "\n</OL>\n")
      (setq w3-continuation (append w3-continuation '(w3-prepare-buffer))
	    w3-current-type nil
	    w3-current-file "historylist"
	    w3-current-last-buffer buff)
      (w3-sentinel nil nil))))

(provide 'w3-misc)
