;;; Tries to make an HTML buffer readable by eliminating the tags
;;; straight substitutions, done in order
(setq unhtml-replace-&
	  '((" " " ")
		("ö" "o")
		("ü" "u")
		(">" ">")
		("&lt;" "<")
		("&eq;" "=")
		("-->")
		("
")
		("^[ 	]+[ 	]")					; whitespace at start of line
		("\n[ 	]*\\(\n[ 	]*\\)+$" "\n\n")))	; blank lines

(defvar unhtml-replace-tags
	  (list
	   '("br" "\n")
	   '("/?html")
	   '("div" "\n\n")	'("/div")
	   '("hr")
	   '("/?title")
	   '("img")	
	   '("/?head")
	   '("/?html")
	   '("!-" unhtml-kill-comment)
	   '("!.*")
	   '("/?tr")
	   '("center")
	   '("meta")
	   '("/?td")
	   '("/?font")
	   '("/?span")
	   '("/?table")
	   '("/?center")
	   '("/?b")
	   '("a" unhtml-anchor-start)	'("/a" unhtml-anchor-end)
	   '("/?h[0-9]")
	   '("/?i")
	   '("/?style")
	   '("/?ul")
	   '("lin")
	   '("li" "\n - ")	'("/li")
	   '("p" "\n\n")	'("/p")
	   )
	  "Lists of tags to change.
First element is a regexp matching the tag, if there is no second the tag is
simply deleted, otherwise if the second is a string it is substituted in for
the tag, if a symbol the function it represents is called with (string) as
the argument.")

(defvar unhtml-show-anchors 'inline
  "controls whether anchor URLs are displayed.
Values are: 
	nil for no display;
	'inline to embed the URL into the text;
	'underline to mark it with an underline and display the URL when it
		is clicked on. (the URL is lost when the file is saved)"
)
;(setq unhtml-show-anchors 'underline)
;(setq unhtml-show-anchors 'inline)
(defvar unhtml-line-width 75
"Length of line for fill function")

;;; for local use
(defvar unhtml-anchor-url nil)
(defvar unhtml-anchor-start nil)
(defvar unhtml-left-mouse nil)

(defun unhtml-kill-comment (string)
  "Kills a '<!-' comment"
  (let ((start (match-beginning 0)))
	(goto-char start)
	(or (re-search-forward "->" nil t)
		(error "unterminated comment"))
	(delete-region start (match-end 0))
	(goto-char start)))

(defun unhtml-anchor-start (string)
  "Processes an anchor directive"
  (if unhtml-show-anchors
	  (progn
		(save-match-data
		  ;; This can get confused if a quote contains the other quote character.
		  ;; Maybe it should use a function instead of a single match.
		  (string-match "\\(href\\|name\\) *= *\\(\"\\|'\\)\\([^\"']*\\)" string)
		  (setq unhtml-anchor-url (match-string 3 string)))
		(replace-match "")
		(if (equal unhtml-show-anchors 'underline)
			(setq unhtml-anchor-start (point))
		  (insert "<<" unhtml-anchor-url ">>")))
	(replace-match "")))


(defun unhtml-anchor-end (string)
  "Used to underline and remember anchors"
  (replace-match "")
  (when (and unhtml-anchor-start (equal unhtml-show-anchors 'underline))
	(put-text-property unhtml-anchor-start (point) 'anchor unhtml-anchor-url)
	(put-text-property unhtml-anchor-start (point) 'face 'underline))
  (setq unhtml-anchor-url nil
		unhtml-anchor-start nil))

(defun unhtml-new-left-mouse (e)
  (interactive "@e")
  (funcall (or unhtml-left-mouse (global-key-binding [mouse-1])) e)
  (if (get-text-property (point) 'anchor)
	  (message "%s" (get-text-property (point) 'anchor))))
  
(defun unhtml ()
  "Tries to make an HTML buffer readable.
Behavior can be controlled with unhtml-show-anchors"
  (interactive)
	(if (string-match "^\\(.*\\)-summary$" (buffer-name))
		(set-buffer (match-string 1 (buffer-name))))
	(when (and (equal unhtml-show-anchors 'underline)
			   (not (local-variable-p 'unhtml-left-mouse)))
	  (make-local-variable 'unhtml-left-mouse)
	  (let ((func (or (local-key-binding [mouse-1])	
								  (global-key-binding [mouse-1]))))
		(if (not (equal unhtml-left-mouse func))
			(setq unhtml-left-mouse func)))
	  (local-set-key [mouse-1] 'unhtml-new-left-mouse))
	(let ((read-only buffer-read-only)
		  desc)
	  (setq buffer-read-only nil)
	  (goto-char 0)
	  (while (re-search-forward "<\\([^ 	>]*\\)[^>]*>" nil t)
		(if (save-match-data 
			  (let ((string (match-string 1)))
				(flet ((html-get-match (desc)
									   (let ((result (string-match (car desc) string)))
										 (and result (= result 0) desc))))
				  (setq desc (some 'html-get-match unhtml-replace-tags)))))
		  (when desc
			  (cond ((stringp (second desc))
					 (replace-match (second desc)))
					((not (second desc))
					 (replace-match ""))
					((symbolp (second desc))
					 (funcall (second desc) (match-string 0)))
					))
		  ))
	  (mapcar 'unhtml-replace unhtml-replace-&)
	  (goto-char 1)
	  (add-breaks unhtml-line-width)
	  (setq buffer-read-only read-only)))

	  
(defun unhtml-replace (desc)
  (goto-char 1)
  (while (re-search-forward (car desc) nil t)
	(replace-match (or (second desc) ""))))


(defun add-breaks (width)
  "Fills all lines that exceed 75 characters"
  (interactive)
  (while (re-search-forward "[^\n]+" nil t)
	(if (> (- (match-end 0) (match-beginning 0)) width)
		(fill-region (match-beginning 0) (match-end 0)))))
	  
	
(provide 'unhtml)