24 |
|
|
25 |
;; These functions provide a simple way to wash/clean html infected |
;; These functions provide a simple way to wash/clean html infected |
26 |
;; mails. Definitely do not work in all cases, but some improvement |
;; mails. Definitely do not work in all cases, but some improvement |
27 |
;; in readability is generally obtained. Formatting is only done in |
;; in readability is generally obtained. Formatting is only done in |
28 |
;; the buffer, so the next time you enter the article it will be |
;; the buffer, so the next time you enter the article it will be |
29 |
;; "re-htmlized". |
;; "re-htmlized". |
30 |
;; |
;; |
31 |
;; The main function is "html2text" |
;; The main function is `html2text'. |
32 |
|
|
33 |
;;; Code: |
;;; Code: |
34 |
|
|
47 |
"The map of entity to text. |
"The map of entity to text. |
48 |
|
|
49 |
This is an alist were each element is a dotted pair consisting of an |
This is an alist were each element is a dotted pair consisting of an |
50 |
old string, and a replacement string. This replacement is done by the |
old string, and a replacement string. This replacement is done by the |
51 |
function \"html2text-substitute\" which basically performs a |
function `html2text-substitute' which basically performs a |
52 |
replace-string operation for every element in the list. This is |
`replace-string' operation for every element in the list. This is |
53 |
completely verbatim - without any use of REGEXP.") |
completely verbatim - without any use of REGEXP.") |
54 |
|
|
55 |
(defvar html2text-remove-tag-list |
(defvar html2text-remove-tag-list |
57 |
"A list of removable tags. |
"A list of removable tags. |
58 |
|
|
59 |
This is a list of tags which should be removed, without any |
This is a list of tags which should be removed, without any |
60 |
formatting. Observe that if you the tags in the list are presented |
formatting. Note that tags in the list are presented *without* |
61 |
*without* any \"<\" or \">\". All occurences of a tag appearing in |
any \"<\" or \">\". All occurences of a tag appearing in this |
62 |
this list are removed, irrespective of whether it is a closing or |
list are removed, irrespective of whether it is a closing or |
63 |
opening tag, or if the tag has additional attributes. The actual |
opening tag, or if the tag has additional attributes. The |
64 |
deletion is done by the function \"html2text-remove-tags\". |
deletion is done by the function `html2text-remove-tags'. |
65 |
|
|
66 |
For instance the text: |
For instance the text: |
67 |
|
|
75 |
|
|
76 |
(defvar html2text-format-tag-list |
(defvar html2text-format-tag-list |
77 |
'(("b" . html2text-clean-bold) |
'(("b" . html2text-clean-bold) |
78 |
|
("strong" . html2text-clean-bold) |
79 |
("u" . html2text-clean-underline) |
("u" . html2text-clean-underline) |
80 |
("i" . html2text-clean-italic) |
("i" . html2text-clean-italic) |
81 |
|
("em" . html2text-clean-italic) |
82 |
("blockquote" . html2text-clean-blockquote) |
("blockquote" . html2text-clean-blockquote) |
83 |
("a" . html2text-clean-anchor) |
("a" . html2text-clean-anchor) |
84 |
("ul" . html2text-clean-ul) |
("ul" . html2text-clean-ul) |
88 |
"An alist of tags and processing functions. |
"An alist of tags and processing functions. |
89 |
|
|
90 |
This is an alist where each dotted pair consists of a tag, and then |
This is an alist where each dotted pair consists of a tag, and then |
91 |
the name of a function to be called when this tag is found. The |
the name of a function to be called when this tag is found. The |
92 |
function is called with the arguments p1, p2, p3 and p4. These are |
function is called with the arguments p1, p2, p3 and p4. These are |
93 |
demontrated below: |
demontrated below: |
94 |
|
|
119 |
;; |
;; |
120 |
|
|
121 |
|
|
122 |
(defun html2text-replace-string (from-string to-string p1 p2) |
(defun html2text-replace-string (from-string to-string min max) |
123 |
(goto-char p1) |
"Replace FROM-STRING with TO-STRING in region from MIN to MAX." |
124 |
|
(goto-char min) |
125 |
(let ((delta (- (string-width to-string) (string-width from-string))) |
(let ((delta (- (string-width to-string) (string-width from-string))) |
126 |
(change 0)) |
(change 0)) |
127 |
(while (search-forward from-string p2 t) |
(while (search-forward from-string max t) |
128 |
(replace-match to-string) |
(replace-match to-string) |
129 |
(setq change (+ change delta)) |
(setq change (+ change delta))) |
130 |
) |
change)) |
|
change |
|
|
) |
|
|
) |
|
131 |
|
|
132 |
;; |
;; |
133 |
;; </Utility functions> |
;; </Utility functions> |
140 |
;; <Functions related to attributes> i.e. <font size=+3> |
;; <Functions related to attributes> i.e. <font size=+3> |
141 |
;; |
;; |
142 |
|
|
143 |
(defun html2text-attr-value (attr-list attr) |
(defun html2text-attr-value (list attribute) |
144 |
(nth 1 (assoc attr attr-list)) |
"Get value of ATTRIBUTE from LIST." |
145 |
) |
(nth 1 (assoc attribute list))) |
146 |
|
|
147 |
(defun html2text-get-attr (p1 p2 tag) |
(defun html2text-get-attr (p1 p2) |
148 |
(goto-char p1) |
(goto-char p1) |
149 |
(re-search-forward " +[^ ]" p2 t) |
(re-search-forward " +[^ ]" p2 t) |
150 |
(let* ((attr-string (buffer-substring-no-properties (1- (point)) (1- p2))) |
(let* ((attr-string (buffer-substring-no-properties (1- (point)) (1- p2))) |
161 |
((string-match "[^ ]=[^ ]" prev) |
((string-match "[^ ]=[^ ]" prev) |
162 |
(let ((attr (nth 0 (split-string prev "="))) |
(let ((attr (nth 0 (split-string prev "="))) |
163 |
(value (nth 1 (split-string prev "=")))) |
(value (nth 1 (split-string prev "=")))) |
164 |
(setq attr-list (cons (list attr value) attr-list)) |
(setq attr-list (cons (list attr value) attr-list)))) |
|
) |
|
|
) |
|
165 |
;; size= 3 |
;; size= 3 |
166 |
((string-match "[^ ]=\\'" prev) |
((string-match "[^ ]=\\'" prev) |
167 |
(setq attr-list (cons (list (substring prev 0 -1) this) attr-list)) |
(setq attr-list (cons (list (substring prev 0 -1) this) attr-list)))) |
|
) |
|
|
) |
|
168 |
|
|
169 |
(while (< index (length tmp-list)) |
(while (< index (length tmp-list)) |
170 |
(cond |
(cond |
172 |
((string-match "[^ ]=[^ ]" this) |
((string-match "[^ ]=[^ ]" this) |
173 |
(let ((attr (nth 0 (split-string this "="))) |
(let ((attr (nth 0 (split-string this "="))) |
174 |
(value (nth 1 (split-string this "=")))) |
(value (nth 1 (split-string this "=")))) |
175 |
(setq attr-list (cons (list attr value) attr-list)) |
(setq attr-list (cons (list attr value) attr-list)))) |
|
) |
|
|
) |
|
176 |
;; size =3 |
;; size =3 |
177 |
((string-match "\\`=[^ ]" this) |
((string-match "\\`=[^ ]" this) |
178 |
(setq attr-list (cons (list prev (substring this 1)) attr-list))) |
(setq attr-list (cons (list prev (substring this 1)) attr-list))) |
|
|
|
179 |
;; size= 3 |
;; size= 3 |
180 |
((string-match "[^ ]=\\'" this) |
((string-match "[^ ]=\\'" this) |
181 |
(setq attr-list (cons (list (substring this 0 -1) next) attr-list)) |
(setq attr-list (cons (list (substring this 0 -1) next) attr-list))) |
|
) |
|
|
|
|
182 |
;; size = 3 |
;; size = 3 |
183 |
((string= "=" this) |
((string= "=" this) |
184 |
(setq attr-list (cons (list prev next) attr-list)) |
(setq attr-list (cons (list prev next) attr-list)))) |
|
) |
|
|
) |
|
185 |
(setq index (1+ index)) |
(setq index (1+ index)) |
186 |
(setq prev this) |
(setq prev this) |
187 |
(setq this next) |
(setq this next) |
188 |
(setq next (nth (1+ index) tmp-list)) |
(setq next (nth (1+ index) tmp-list))) |
|
) |
|
|
|
|
189 |
;; |
;; |
190 |
;; Tags with no accompanying "=" i.e. value=nil |
;; Tags with no accompanying "=" i.e. value=nil |
191 |
;; |
;; |
194 |
(setq next (nth 2 tmp-list)) |
(setq next (nth 2 tmp-list)) |
195 |
(setq index 1) |
(setq index 1) |
196 |
|
|
197 |
(if (not (string-match "=" prev)) |
(when (and (not (string-match "=" prev)) |
198 |
(progn |
(not (string= (substring this 0 1) "="))) |
199 |
(if (not (string= (substring this 0 1) "=")) |
(setq attr-list (cons (list prev nil) attr-list))) |
|
(setq attr-list (cons (list prev nil) attr-list)) |
|
|
) |
|
|
) |
|
|
) |
|
|
|
|
200 |
(while (< index (1- (length tmp-list))) |
(while (< index (1- (length tmp-list))) |
201 |
(if (not (string-match "=" this)) |
(when (and (not (string-match "=" this)) |
202 |
(if (not (or (string= (substring next 0 1) "=") |
(not (or (string= (substring next 0 1) "=") |
203 |
(string= (substring prev -1) "="))) |
(string= (substring prev -1) "=")))) |
204 |
(setq attr-list (cons (list this nil) attr-list)) |
(setq attr-list (cons (list this nil) attr-list))) |
|
) |
|
|
) |
|
205 |
(setq index (1+ index)) |
(setq index (1+ index)) |
206 |
(setq prev this) |
(setq prev this) |
207 |
(setq this next) |
(setq this next) |
208 |
(setq next (nth (1+ index) tmp-list)) |
(setq next (nth (1+ index) tmp-list))) |
|
) |
|
209 |
|
|
210 |
(if this |
(when (and this |
211 |
(progn |
(not (string-match "=" this)) |
212 |
(if (not (string-match "=" this)) |
(not (string= (substring prev -1) "="))) |
213 |
(progn |
(setq attr-list (cons (list this nil) attr-list))) |
214 |
(if (not (string= (substring prev -1) "=")) |
;; return - value |
215 |
(setq attr-list (cons (list this nil) attr-list)) |
attr-list)) |
|
) |
|
|
) |
|
|
) |
|
|
) |
|
|
) |
|
|
attr-list ;; return - value |
|
|
) |
|
|
) |
|
216 |
|
|
217 |
;; |
;; |
218 |
;; </Functions related to attributes> |
;; </Functions related to attributes> |
237 |
(cond |
(cond |
238 |
((string= list-type "ul") (insert " o ")) |
((string= list-type "ul") (insert " o ")) |
239 |
((string= list-type "ol") (insert (format " %s: " item-nr))) |
((string= list-type "ol") (insert (format " %s: " item-nr))) |
240 |
(t (insert " x "))) |
(t (insert " x ")))))) |
|
) |
|
|
) |
|
|
) |
|
241 |
|
|
242 |
(defun html2text-clean-dtdd (p1 p2) |
(defun html2text-clean-dtdd (p1 p2) |
243 |
(goto-char p1) |
(goto-char p1) |
276 |
(html2text-delete-single-tag p1 p2) |
(html2text-delete-single-tag p1 p2) |
277 |
(goto-char p1) |
(goto-char p1) |
278 |
(newline 1) |
(newline 1) |
279 |
(insert (make-string fill-column ?-)) |
(insert (make-string fill-column ?-))) |
|
) |
|
280 |
|
|
281 |
(defun html2text-clean-ul (p1 p2 p3 p4) |
(defun html2text-clean-ul (p1 p2 p3 p4) |
282 |
(html2text-delete-tags p1 p2 p3 p4) |
(html2text-delete-tags p1 p2 p3 p4) |
283 |
(html2text-clean-list-items p1 (- p3 (- p1 p2)) "ul") |
(html2text-clean-list-items p1 (- p3 (- p1 p2)) "ul")) |
|
) |
|
284 |
|
|
285 |
(defun html2text-clean-ol (p1 p2 p3 p4) |
(defun html2text-clean-ol (p1 p2 p3 p4) |
286 |
(html2text-delete-tags p1 p2 p3 p4) |
(html2text-delete-tags p1 p2 p3 p4) |
287 |
(html2text-clean-list-items p1 (- p3 (- p1 p2)) "ol") |
(html2text-clean-list-items p1 (- p3 (- p1 p2)) "ol")) |
|
) |
|
288 |
|
|
289 |
(defun html2text-clean-dl (p1 p2 p3 p4) |
(defun html2text-clean-dl (p1 p2 p3 p4) |
290 |
(html2text-delete-tags p1 p2 p3 p4) |
(html2text-delete-tags p1 p2 p3 p4) |
291 |
(html2text-clean-dtdd p1 (- p3 (- p1 p2))) |
(html2text-clean-dtdd p1 (- p3 (- p1 p2)))) |
|
) |
|
292 |
|
|
293 |
(defun html2text-clean-center (p1 p2 p3 p4) |
(defun html2text-clean-center (p1 p2 p3 p4) |
294 |
(html2text-delete-tags p1 p2 p3 p4) |
(html2text-delete-tags p1 p2 p3 p4) |
295 |
(center-region p1 (- p3 (- p2 p1))) |
(center-region p1 (- p3 (- p2 p1)))) |
|
) |
|
296 |
|
|
297 |
(defun html2text-clean-bold (p1 p2 p3 p4) |
(defun html2text-clean-bold (p1 p2 p3 p4) |
298 |
(put-text-property p2 p3 'face 'bold) |
(put-text-property p2 p3 'face 'bold) |
299 |
(html2text-delete-tags p1 p2 p3 p4) |
(html2text-delete-tags p1 p2 p3 p4)) |
|
) |
|
300 |
|
|
301 |
(defun html2text-clean-title (p1 p2 p3 p4) |
(defun html2text-clean-title (p1 p2 p3 p4) |
302 |
(put-text-property p2 p3 'face 'bold) |
(put-text-property p2 p3 'face 'bold) |
303 |
(html2text-delete-tags p1 p2 p3 p4) |
(html2text-delete-tags p1 p2 p3 p4)) |
|
) |
|
304 |
|
|
305 |
(defun html2text-clean-underline (p1 p2 p3 p4) |
(defun html2text-clean-underline (p1 p2 p3 p4) |
306 |
(put-text-property p2 p3 'face 'underline) |
(put-text-property p2 p3 'face 'underline) |
307 |
(html2text-delete-tags p1 p2 p3 p4) |
(html2text-delete-tags p1 p2 p3 p4)) |
|
) |
|
308 |
|
|
309 |
(defun html2text-clean-italic (p1 p2 p3 p4) |
(defun html2text-clean-italic (p1 p2 p3 p4) |
310 |
(put-text-property p2 p3 'face 'italic) |
(put-text-property p2 p3 'face 'italic) |
311 |
(html2text-delete-tags p1 p2 p3 p4) |
(html2text-delete-tags p1 p2 p3 p4)) |
|
) |
|
312 |
|
|
313 |
(defun html2text-clean-font (p1 p2 p3 p4) |
(defun html2text-clean-font (p1 p2 p3 p4) |
314 |
(html2text-delete-tags p1 p2 p3 p4) |
(html2text-delete-tags p1 p2 p3 p4)) |
|
) |
|
315 |
|
|
316 |
(defun html2text-clean-blockquote (p1 p2 p3 p4) |
(defun html2text-clean-blockquote (p1 p2 p3 p4) |
317 |
(html2text-delete-tags p1 p2 p3 p4) |
(html2text-delete-tags p1 p2 p3 p4)) |
|
) |
|
318 |
|
|
319 |
(defun html2text-clean-anchor (p1 p2 p3 p4) |
(defun html2text-clean-anchor (p1 p2 p3 p4) |
320 |
;; If someone can explain how to make the URL clickable I will |
;; If someone can explain how to make the URL clickable I will surely |
321 |
;; surely improve upon this. |
;; improve upon this. |
322 |
(let* ((attr-list (html2text-get-attr p1 p2 "a")) |
;; Maybe `goto-addr.el' can be used here. |
323 |
|
(let* ((attr-list (html2text-get-attr p1 p2)) |
324 |
(href (html2text-attr-value attr-list "href"))) |
(href (html2text-attr-value attr-list "href"))) |
325 |
(delete-region p1 p4) |
(delete-region p1 p4) |
326 |
(when href |
(when href |
344 |
(let ((has-br-line) |
(let ((has-br-line) |
345 |
(refill-start) |
(refill-start) |
346 |
(refill-stop)) |
(refill-stop)) |
347 |
(if (re-search-forward "<br>$" p2 t) |
(when (re-search-forward "<br>$" p2 t) |
348 |
(setq has-br-line t) |
(goto-char p1) |
349 |
) |
(when (re-search-forward ".+[^<][^b][^r][^>]$" p2 t) |
350 |
(if has-br-line |
(beginning-of-line) |
351 |
(progn |
(setq refill-start (point)) |
352 |
(goto-char p1) |
(goto-char p2) |
353 |
(if (re-search-forward ".+[^<][^b][^r][^>]$" p2 t) |
(re-search-backward ".+[^<][^b][^r][^>]$" refill-start t) |
354 |
(progn |
(next-line 1) |
355 |
(beginning-of-line) |
(end-of-line) |
356 |
(setq refill-start (point)) |
;; refill-stop should ideally be adjusted to |
357 |
(goto-char p2) |
;; accomodate the "<br>" strings which are removed |
358 |
(re-search-backward ".+[^<][^b][^r][^>]$" refill-start t) |
;; between refill-start and refill-stop. Can simply |
359 |
(next-line 1) |
;; be returned from my-replace-string |
360 |
(end-of-line) |
(setq refill-stop (+ (point) |
361 |
;; refill-stop should ideally be adjusted to |
(html2text-replace-string |
362 |
;; accomodate the "<br>" strings which are removed |
"<br>" "" |
363 |
;; between refill-start and refill-stop. Can simply |
refill-start (point)))) |
364 |
;; be returned from my-replace-string |
;; (message "Point = %s refill-stop = %s" (point) refill-stop) |
365 |
(setq refill-stop (+ (point) |
;; (sleep-for 4) |
366 |
(html2text-replace-string |
(fill-region refill-start refill-stop)))) |
367 |
"<br>" "" |
(html2text-replace-string "<br>" "" p1 p2)) |
|
refill-start (point)))) |
|
|
;; (message "Point = %s refill-stop = %s" (point) refill-stop) |
|
|
;; (sleep-for 4) |
|
|
(fill-region refill-start refill-stop) |
|
|
) |
|
|
) |
|
|
) |
|
|
) |
|
|
) |
|
|
(html2text-replace-string "<br>" "" p1 p2) |
|
|
) |
|
368 |
|
|
369 |
;; |
;; |
370 |
;; This one is interactive ... |
;; This one is interactive ... |
399 |
;; |
;; |
400 |
|
|
401 |
(defun html2text-remove-tags (tag-list) |
(defun html2text-remove-tags (tag-list) |
402 |
"Removes the tags listed in the list \"html2text-remove-tag-list\". |
"Removes the tags listed in the list `html2text-remove-tag-list'. |
403 |
See the documentation for that variable." |
See the documentation for that variable." |
404 |
(interactive) |
(interactive) |
405 |
(dolist (tag tag-list) |
(dolist (tag tag-list) |
408 |
(delete-region (match-beginning 0) (match-end 0))))) |
(delete-region (match-beginning 0) (match-end 0))))) |
409 |
|
|
410 |
(defun html2text-format-tags () |
(defun html2text-format-tags () |
411 |
"See the variable \"html2text-format-tag-list\" for documentation" |
"See the variable `html2text-format-tag-list' for documentation." |
412 |
(interactive) |
(interactive) |
413 |
(dolist (tag-and-function html2text-format-tag-list) |
(dolist (tag-and-function html2text-format-tag-list) |
414 |
(let ((tag (car tag-and-function)) |
(let ((tag (car tag-and-function)) |
418 |
(point-max) t) |
(point-max) t) |
419 |
(let ((p1) |
(let ((p1) |
420 |
(p2 (point)) |
(p2 (point)) |
421 |
(p3) (p4) |
(p3) (p4)) |
|
(attr (match-string 1))) |
|
422 |
(search-backward "<" (point-min) t) |
(search-backward "<" (point-min) t) |
423 |
(setq p1 (point)) |
(setq p1 (point)) |
424 |
(re-search-forward (format "</%s>" tag) (point-max) t) |
(re-search-forward (format "</%s>" tag) (point-max) t) |
426 |
(search-backward "</" (point-min) t) |
(search-backward "</" (point-min) t) |
427 |
(setq p3 (point)) |
(setq p3 (point)) |
428 |
(funcall function p1 p2 p3 p4) |
(funcall function p1 p2 p3 p4) |
429 |
(goto-char p1) |
(goto-char p1)))))) |
|
) |
|
|
) |
|
|
) |
|
|
) |
|
|
) |
|
430 |
|
|
431 |
(defun html2text-substitute () |
(defun html2text-substitute () |
432 |
"See the variable \"html2text-replace-list\" for documentation" |
"See the variable `html2text-replace-list' for documentation." |
433 |
(interactive) |
(interactive) |
434 |
(dolist (e html2text-replace-list) |
(dolist (e html2text-replace-list) |
435 |
(goto-char (point-min)) |
(goto-char (point-min)) |
436 |
(let ((old-string (car e)) |
(let ((old-string (car e)) |
437 |
(new-string (cdr e))) |
(new-string (cdr e))) |
438 |
(html2text-replace-string old-string new-string (point-min) (point-max)) |
(html2text-replace-string old-string new-string (point-min) (point-max))))) |
|
) |
|
|
) |
|
|
) |
|
439 |
|
|
440 |
(defun html2text-format-single-elements () |
(defun html2text-format-single-elements () |
|
"" |
|
441 |
(interactive) |
(interactive) |
442 |
(dolist (tag-and-function html2text-format-single-element-list) |
(dolist (tag-and-function html2text-format-single-element-list) |
443 |
(let ((tag (car tag-and-function)) |
(let ((tag (car tag-and-function)) |
449 |
(p2 (point))) |
(p2 (point))) |
450 |
(search-backward "<" (point-min) t) |
(search-backward "<" (point-min) t) |
451 |
(setq p1 (point)) |
(setq p1 (point)) |
452 |
(funcall function p1 p2) |
(funcall function p1 p2)))))) |
|
) |
|
|
) |
|
|
) |
|
|
) |
|
|
) |
|
453 |
|
|
454 |
;; |
;; |
455 |
;; Main function |
;; Main function |
472 |
;; |
;; |
473 |
;; </Interactive functions> |
;; </Interactive functions> |
474 |
;; |
;; |
475 |
|
(provide 'html2text) |
476 |
;;; arch-tag: e9e57b79-35d4-4de1-a647-e7e01fe56d1e |
;;; arch-tag: e9e57b79-35d4-4de1-a647-e7e01fe56d1e |
477 |
;;; html2text.el ends here |
;;; html2text.el ends here |