;;; Tries to make an HTML buffer readable by eliminating the tags
;;; straight substitutions, done in order
(setq unhtml-replace-&
'((" " " ")
("ö" "o")
("ü" "u")
(">" ">")
("<" "<")
("&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 '" 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)