comparison lisp/gnus/html2text.el @ 57856:df80d19d7a2e

Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-660 Merge from gnus--rel--5.10 Patches applied: * miles@gnu.org--gnu-2004/gnus--rel--5.10--patch-65 Update from CVS 2004-11-01 Reiner Steib <Reiner.Steib@gmx.de> * lisp/gnus/gnus-msg.el (gnus-summary-resend-default-address): Add :version. * lisp/gnus/tls.el (tls-process-connection-type, tls-success) (tls-certtool-program): Add :version. * lisp/gnus/starttls.el (starttls-gnutls-program, starttls-use-gnutls) (starttls-extra-arguments, starttls-process-connection-type) (starttls-connect, starttls-failure, starttls-success): * lisp/gnus/spam-stat.el (spam-stat): Add :version. * lisp/gnus/sieve.el (sieve): Add :version. * lisp/gnus/sha1.el (sha1): Added :version. (sha1-use-external): Removed redundant version. * lisp/gnus/nnmail.el (nnmail-split-fancy-with-parent-ignore-groups) (nnmail-cache-ignore-groups, nnmail-spool-hook) (nnmail-split-fancy-match-partial-words) (nnmail-split-lowercase-expanded): * lisp/gnus/nndiary.el (nndiary): Add :version. * lisp/gnus/mml2015.el (mml2015-unabbrev-trust-alist): Add :version. * lisp/gnus/mml-sec.el (mml-default-sign-method) (mml-default-encrypt-method, mml-signencrypt-style-alist): Add :version. * lisp/gnus/mm-uu.el (mm-uu-diff-groups-regexp): Add :version. * lisp/gnus/mm-url.el (mm-url-use-external, mm-url-program) (mm-url-arguments): Add :version. * lisp/gnus/mm-decode.el (mm-inline-text-html-with-w3m-keymap) (mm-attachment-file-modes, mm-decrypt-option) (mm-w3m-safe-url-regexp): Add :version. * lisp/gnus/message.el (message-cite-prefix-regexp) (message-sendmail-envelope-from, message-minibuffer-local-map) (message-user-fqdn, message-completion-alist): Add :version. * lisp/gnus/gnus-win.el (gnus-configure-windows-hook) (gnus-use-frames-on-any-display): Add :version. * lisp/gnus/gnus-art.el (gnus-article-address-banner-alist) (gnus-treat-unsplit-urls, gnus-treat-unfold-headers) (gnus-treat-from-picon, gnus-treat-mail-picon) (gnus-treat-x-pgp-sig): Add :version. * lisp/gnus/gnus-sum.el (gnus-spam-mark, gnus-recent-mark) (gnus-undownloaded-mark, gnus-summary-article-move-hook) (gnus-summary-article-delete-hook) (gnus-summary-display-while-building): Add :version. * lisp/gnus/gnus-start.el (gnus-subscribe-newsgroup-hooks) (gnus-get-top-new-news-hook):Add :version. * lisp/gnus/gnus-srvr.el (gnus-server-agent-face, gnus-server-opened-face) (gnus-server-closed-face, gnus-server-denied-face): Add :version. * lisp/gnus/gnus-registry.el (gnus-registry): Add :version. * lisp/gnus/gnus-spec.el (gnus-use-correct-string-widths) (gnus-make-format-preserve-properties): Add :version. * lisp/gnus/gnus.el (gnus-group-charter-alist) (gnus-group-fetch-control-use-browse-url) (gnus-install-group-spam-parameters): Add :version. * lisp/gnus/gnus-diary.el (gnus-diary): Add :version. * lisp/gnus/gnus-delay.el (gnus-delay): Add :version. * lisp/gnus/gnus-cite.el (gnus-cite-unsightly-citation-regexp) (gnus-cite-ignore-quoted-from, gnus-cite-attribution-face) (gnus-cite-blank-line-after-header, gnus-article-boring-faces): Add :version. * lisp/gnus/gnus-agent.el (gnus-agent-max-fetch-size) (gnus-agent-enable-expiration, gnus-agent-queue-mail) (gnus-agent-prompt-send-queue): Add :version. * lisp/gnus/deuglify.el (gnus-outlook-deuglify): Add :version. * lisp/gnus/html2text.el: Beautify code. Improve doc strings. Some checkdoc cleanup. (html2text-get-attr, html2text-fix-paragraph): Simplify code. (html2text-format-tag-list): Added "strong" and "em". From "Alfred M. Szmidt" <ams@kemisten.nu> (tiny change).
author Miles Bader <miles@gnu.org>
date Mon, 01 Nov 2004 23:06:36 +0000
parents 6a65cb24e1be
children d7def5572cf3
comparison
equal deleted inserted replaced
57855:c16b7c5144ed 57856:df80d19d7a2e
22 22
23 ;;; Commentary: 23 ;;; Commentary:
24 24
25 ;; These functions provide a simple way to wash/clean html infected 25 ;; These functions provide a simple way to wash/clean html infected
26 ;; mails. Definitely do not work in all cases, but some improvement 26 ;; mails. Definitely do not work in all cases, but some improvement
27 ;; in readability is generally obtained. Formatting is only done in 27 ;; in readability is generally obtained. Formatting is only done in
28 ;; the buffer, so the next time you enter the article it will be 28 ;; the buffer, so the next time you enter the article it will be
29 ;; "re-htmlized". 29 ;; "re-htmlized".
30 ;; 30 ;;
31 ;; The main function is "html2text" 31 ;; The main function is `html2text'.
32 32
33 ;;; Code: 33 ;;; Code:
34 34
35 ;; 35 ;;
36 ;; <Global variables> 36 ;; <Global variables>
45 '(("&nbsp;" . " ") ("&gt;" . ">") ("&lt;" . "<") ("&quot;" . "\"") 45 '(("&nbsp;" . " ") ("&gt;" . ">") ("&lt;" . "<") ("&quot;" . "\"")
46 ("&amp;" . "&") ("&apos;" . "'")) 46 ("&amp;" . "&") ("&apos;" . "'"))
47 "The map of entity to text. 47 "The map of entity to text.
48 48
49 This is an alist were each element is a dotted pair consisting of an 49 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 50 old string, and a replacement string. This replacement is done by the
51 function \"html2text-substitute\" which basically performs a 51 function `html2text-substitute' which basically performs a
52 replace-string operation for every element in the list. This is 52 `replace-string' operation for every element in the list. This is
53 completely verbatim - without any use of REGEXP.") 53 completely verbatim - without any use of REGEXP.")
54 54
55 (defvar html2text-remove-tag-list 55 (defvar html2text-remove-tag-list
56 '("html" "body" "p" "img" "dir" "head" "div" "br" "font" "title" "meta") 56 '("html" "body" "p" "img" "dir" "head" "div" "br" "font" "title" "meta")
57 "A list of removable tags. 57 "A list of removable tags.
58 58
59 This is a list of tags which should be removed, without any 59 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 60 formatting. Note that tags in the list are presented *without*
61 *without* any \"<\" or \">\". All occurences of a tag appearing in 61 any \"<\" or \">\". All occurences of a tag appearing in this
62 this list are removed, irrespective of whether it is a closing or 62 list are removed, irrespective of whether it is a closing or
63 opening tag, or if the tag has additional attributes. The actual 63 opening tag, or if the tag has additional attributes. The
64 deletion is done by the function \"html2text-remove-tags\". 64 deletion is done by the function `html2text-remove-tags'.
65 65
66 For instance the text: 66 For instance the text:
67 67
68 \"Here comes something <font size\"+3\" face=\"Helvetica\"> big </font>.\" 68 \"Here comes something <font size\"+3\" face=\"Helvetica\"> big </font>.\"
69 69
73 73
74 If this list contains the element \"font\".") 74 If this list contains the element \"font\".")
75 75
76 (defvar html2text-format-tag-list 76 (defvar html2text-format-tag-list
77 '(("b" . html2text-clean-bold) 77 '(("b" . html2text-clean-bold)
78 ("strong" . html2text-clean-bold)
78 ("u" . html2text-clean-underline) 79 ("u" . html2text-clean-underline)
79 ("i" . html2text-clean-italic) 80 ("i" . html2text-clean-italic)
81 ("em" . html2text-clean-italic)
80 ("blockquote" . html2text-clean-blockquote) 82 ("blockquote" . html2text-clean-blockquote)
81 ("a" . html2text-clean-anchor) 83 ("a" . html2text-clean-anchor)
82 ("ul" . html2text-clean-ul) 84 ("ul" . html2text-clean-ul)
83 ("ol" . html2text-clean-ol) 85 ("ol" . html2text-clean-ol)
84 ("dl" . html2text-clean-dl) 86 ("dl" . html2text-clean-dl)
85 ("center" . html2text-clean-center)) 87 ("center" . html2text-clean-center))
86 "An alist of tags and processing functions. 88 "An alist of tags and processing functions.
87 89
88 This is an alist where each dotted pair consists of a tag, and then 90 This is an alist where each dotted pair consists of a tag, and then
89 the name of a function to be called when this tag is found. The 91 the name of a function to be called when this tag is found. The
90 function is called with the arguments p1, p2, p3 and p4. These are 92 function is called with the arguments p1, p2, p3 and p4. These are
91 demontrated below: 93 demontrated below:
92 94
93 \"<b> This is bold text </b>\" 95 \"<b> This is bold text </b>\"
94 ^ ^ ^ ^ 96 ^ ^ ^ ^
115 ;; 117 ;;
116 ;; <Utility functions> 118 ;; <Utility functions>
117 ;; 119 ;;
118 120
119 121
120 (defun html2text-replace-string (from-string to-string p1 p2) 122 (defun html2text-replace-string (from-string to-string min max)
121 (goto-char p1) 123 "Replace FROM-STRING with TO-STRING in region from MIN to MAX."
124 (goto-char min)
122 (let ((delta (- (string-width to-string) (string-width from-string))) 125 (let ((delta (- (string-width to-string) (string-width from-string)))
123 (change 0)) 126 (change 0))
124 (while (search-forward from-string p2 t) 127 (while (search-forward from-string max t)
125 (replace-match to-string) 128 (replace-match to-string)
126 (setq change (+ change delta)) 129 (setq change (+ change delta)))
127 ) 130 change))
128 change
129 )
130 )
131 131
132 ;; 132 ;;
133 ;; </Utility functions> 133 ;; </Utility functions>
134 ;; 134 ;;
135 135
138 138
139 ;; 139 ;;
140 ;; <Functions related to attributes> i.e. <font size=+3> 140 ;; <Functions related to attributes> i.e. <font size=+3>
141 ;; 141 ;;
142 142
143 (defun html2text-attr-value (attr-list attr) 143 (defun html2text-attr-value (list attribute)
144 (nth 1 (assoc attr attr-list)) 144 "Get value of ATTRIBUTE from LIST."
145 ) 145 (nth 1 (assoc attribute list)))
146 146
147 (defun html2text-get-attr (p1 p2 tag) 147 (defun html2text-get-attr (p1 p2 tag)
148 (goto-char p1) 148 (goto-char p1)
149 (re-search-forward " +[^ ]" p2 t) 149 (re-search-forward " +[^ ]" p2 t)
150 (let* ((attr-string (buffer-substring-no-properties (1- (point)) (1- p2))) 150 (let* ((attr-string (buffer-substring-no-properties (1- (point)) (1- p2)))
159 (cond 159 (cond
160 ;; size=3 160 ;; size=3
161 ((string-match "[^ ]=[^ ]" prev) 161 ((string-match "[^ ]=[^ ]" prev)
162 (let ((attr (nth 0 (split-string prev "="))) 162 (let ((attr (nth 0 (split-string prev "=")))
163 (value (nth 1 (split-string prev "=")))) 163 (value (nth 1 (split-string prev "="))))
164 (setq attr-list (cons (list attr value) attr-list)) 164 (setq attr-list (cons (list attr value) attr-list))))
165 )
166 )
167 ;; size= 3 165 ;; size= 3
168 ((string-match "[^ ]=\\'" prev) 166 ((string-match "[^ ]=\\'" prev)
169 (setq attr-list (cons (list (substring prev 0 -1) this) attr-list)) 167 (setq attr-list (cons (list (substring prev 0 -1) this) attr-list))))
170 )
171 )
172 168
173 (while (< index (length tmp-list)) 169 (while (< index (length tmp-list))
174 (cond 170 (cond
175 ;; size=3 171 ;; size=3
176 ((string-match "[^ ]=[^ ]" this) 172 ((string-match "[^ ]=[^ ]" this)
177 (let ((attr (nth 0 (split-string this "="))) 173 (let ((attr (nth 0 (split-string this "=")))
178 (value (nth 1 (split-string this "=")))) 174 (value (nth 1 (split-string this "="))))
179 (setq attr-list (cons (list attr value) attr-list)) 175 (setq attr-list (cons (list attr value) attr-list))))
180 )
181 )
182 ;; size =3 176 ;; size =3
183 ((string-match "\\`=[^ ]" this) 177 ((string-match "\\`=[^ ]" this)
184 (setq attr-list (cons (list prev (substring this 1)) attr-list))) 178 (setq attr-list (cons (list prev (substring this 1)) attr-list)))
185
186 ;; size= 3 179 ;; size= 3
187 ((string-match "[^ ]=\\'" this) 180 ((string-match "[^ ]=\\'" this)
188 (setq attr-list (cons (list (substring this 0 -1) next) attr-list)) 181 (setq attr-list (cons (list (substring this 0 -1) next) attr-list)))
189 )
190
191 ;; size = 3 182 ;; size = 3
192 ((string= "=" this) 183 ((string= "=" this)
193 (setq attr-list (cons (list prev next) attr-list)) 184 (setq attr-list (cons (list prev next) attr-list))))
194 )
195 )
196 (setq index (1+ index)) 185 (setq index (1+ index))
197 (setq prev this) 186 (setq prev this)
198 (setq this next) 187 (setq this next)
199 (setq next (nth (1+ index) tmp-list)) 188 (setq next (nth (1+ index) tmp-list)))
200 )
201
202 ;; 189 ;;
203 ;; Tags with no accompanying "=" i.e. value=nil 190 ;; Tags with no accompanying "=" i.e. value=nil
204 ;; 191 ;;
205 (setq prev (car tmp-list)) 192 (setq prev (car tmp-list))
206 (setq this (nth 1 tmp-list)) 193 (setq this (nth 1 tmp-list))
207 (setq next (nth 2 tmp-list)) 194 (setq next (nth 2 tmp-list))
208 (setq index 1) 195 (setq index 1)
209 196
210 (if (not (string-match "=" prev)) 197 (when (and (not (string-match "=" prev))
211 (progn 198 (not (string= (substring this 0 1) "=")))
212 (if (not (string= (substring this 0 1) "=")) 199 (setq attr-list (cons (list prev nil) attr-list)))
213 (setq attr-list (cons (list prev nil) attr-list))
214 )
215 )
216 )
217
218 (while (< index (1- (length tmp-list))) 200 (while (< index (1- (length tmp-list)))
219 (if (not (string-match "=" this)) 201 (when (and (not (string-match "=" this))
220 (if (not (or (string= (substring next 0 1) "=") 202 (not (or (string= (substring next 0 1) "=")
221 (string= (substring prev -1) "="))) 203 (string= (substring prev -1) "="))))
222 (setq attr-list (cons (list this nil) attr-list)) 204 (setq attr-list (cons (list this nil) attr-list)))
223 )
224 )
225 (setq index (1+ index)) 205 (setq index (1+ index))
226 (setq prev this) 206 (setq prev this)
227 (setq this next) 207 (setq this next)
228 (setq next (nth (1+ index) tmp-list)) 208 (setq next (nth (1+ index) tmp-list)))
229 ) 209
230 210 (when (and this
231 (if this 211 (not (string-match "=" this))
232 (progn 212 (not (string= (substring prev -1) "=")))
233 (if (not (string-match "=" this)) 213 (setq attr-list (cons (list this nil) attr-list)))
234 (progn 214 ;; return - value
235 (if (not (string= (substring prev -1) "=")) 215 attr-list))
236 (setq attr-list (cons (list this nil) attr-list))
237 )
238 )
239 )
240 )
241 )
242 attr-list ;; return - value
243 )
244 )
245 216
246 ;; 217 ;;
247 ;; </Functions related to attributes> 218 ;; </Functions related to attributes>
248 ;; 219 ;;
249 220
264 (setq item-nr (1+ item-nr)) 235 (setq item-nr (1+ item-nr))
265 (re-search-forward "<li>" (point-max) t) 236 (re-search-forward "<li>" (point-max) t)
266 (cond 237 (cond
267 ((string= list-type "ul") (insert " o ")) 238 ((string= list-type "ul") (insert " o "))
268 ((string= list-type "ol") (insert (format " %s: " item-nr))) 239 ((string= list-type "ol") (insert (format " %s: " item-nr)))
269 (t (insert " x "))) 240 (t (insert " x "))))))
270 )
271 )
272 )
273 241
274 (defun html2text-clean-dtdd (p1 p2) 242 (defun html2text-clean-dtdd (p1 p2)
275 (goto-char p1) 243 (goto-char p1)
276 (let ((items 0) 244 (let ((items 0)
277 (item-nr 0)) 245 (item-nr 0))
306 274
307 (defun html2text-clean-hr (p1 p2) 275 (defun html2text-clean-hr (p1 p2)
308 (html2text-delete-single-tag p1 p2) 276 (html2text-delete-single-tag p1 p2)
309 (goto-char p1) 277 (goto-char p1)
310 (newline 1) 278 (newline 1)
311 (insert (make-string fill-column ?-)) 279 (insert (make-string fill-column ?-)))
312 )
313 280
314 (defun html2text-clean-ul (p1 p2 p3 p4) 281 (defun html2text-clean-ul (p1 p2 p3 p4)
315 (html2text-delete-tags p1 p2 p3 p4) 282 (html2text-delete-tags p1 p2 p3 p4)
316 (html2text-clean-list-items p1 (- p3 (- p1 p2)) "ul") 283 (html2text-clean-list-items p1 (- p3 (- p1 p2)) "ul"))
317 )
318 284
319 (defun html2text-clean-ol (p1 p2 p3 p4) 285 (defun html2text-clean-ol (p1 p2 p3 p4)
320 (html2text-delete-tags p1 p2 p3 p4) 286 (html2text-delete-tags p1 p2 p3 p4)
321 (html2text-clean-list-items p1 (- p3 (- p1 p2)) "ol") 287 (html2text-clean-list-items p1 (- p3 (- p1 p2)) "ol"))
322 )
323 288
324 (defun html2text-clean-dl (p1 p2 p3 p4) 289 (defun html2text-clean-dl (p1 p2 p3 p4)
325 (html2text-delete-tags p1 p2 p3 p4) 290 (html2text-delete-tags p1 p2 p3 p4)
326 (html2text-clean-dtdd p1 (- p3 (- p1 p2))) 291 (html2text-clean-dtdd p1 (- p3 (- p1 p2))))
327 )
328 292
329 (defun html2text-clean-center (p1 p2 p3 p4) 293 (defun html2text-clean-center (p1 p2 p3 p4)
330 (html2text-delete-tags p1 p2 p3 p4) 294 (html2text-delete-tags p1 p2 p3 p4)
331 (center-region p1 (- p3 (- p2 p1))) 295 (center-region p1 (- p3 (- p2 p1))))
332 )
333 296
334 (defun html2text-clean-bold (p1 p2 p3 p4) 297 (defun html2text-clean-bold (p1 p2 p3 p4)
335 (put-text-property p2 p3 'face 'bold) 298 (put-text-property p2 p3 'face 'bold)
336 (html2text-delete-tags p1 p2 p3 p4) 299 (html2text-delete-tags p1 p2 p3 p4))
337 )
338 300
339 (defun html2text-clean-title (p1 p2 p3 p4) 301 (defun html2text-clean-title (p1 p2 p3 p4)
340 (put-text-property p2 p3 'face 'bold) 302 (put-text-property p2 p3 'face 'bold)
341 (html2text-delete-tags p1 p2 p3 p4) 303 (html2text-delete-tags p1 p2 p3 p4))
342 )
343 304
344 (defun html2text-clean-underline (p1 p2 p3 p4) 305 (defun html2text-clean-underline (p1 p2 p3 p4)
345 (put-text-property p2 p3 'face 'underline) 306 (put-text-property p2 p3 'face 'underline)
346 (html2text-delete-tags p1 p2 p3 p4) 307 (html2text-delete-tags p1 p2 p3 p4))
347 )
348 308
349 (defun html2text-clean-italic (p1 p2 p3 p4) 309 (defun html2text-clean-italic (p1 p2 p3 p4)
350 (put-text-property p2 p3 'face 'italic) 310 (put-text-property p2 p3 'face 'italic)
351 (html2text-delete-tags p1 p2 p3 p4) 311 (html2text-delete-tags p1 p2 p3 p4))
352 )
353 312
354 (defun html2text-clean-font (p1 p2 p3 p4) 313 (defun html2text-clean-font (p1 p2 p3 p4)
355 (html2text-delete-tags p1 p2 p3 p4) 314 (html2text-delete-tags p1 p2 p3 p4))
356 )
357 315
358 (defun html2text-clean-blockquote (p1 p2 p3 p4) 316 (defun html2text-clean-blockquote (p1 p2 p3 p4)
359 (html2text-delete-tags p1 p2 p3 p4) 317 (html2text-delete-tags p1 p2 p3 p4))
360 )
361 318
362 (defun html2text-clean-anchor (p1 p2 p3 p4) 319 (defun html2text-clean-anchor (p1 p2 p3 p4)
363 ;; If someone can explain how to make the URL clickable I will 320 ;; If someone can explain how to make the URL clickable I will surely
364 ;; surely improve upon this. 321 ;; improve upon this.
322 ;; Maybe `goto-addr.el' can be used here.
365 (let* ((attr-list (html2text-get-attr p1 p2 "a")) 323 (let* ((attr-list (html2text-get-attr p1 p2 "a"))
366 (href (html2text-attr-value attr-list "href"))) 324 (href (html2text-attr-value attr-list "href")))
367 (delete-region p1 p4) 325 (delete-region p1 p4)
368 (when href 326 (when href
369 (goto-char p1) 327 (goto-char p1)
384 (defun html2text-fix-paragraph (p1 p2) 342 (defun html2text-fix-paragraph (p1 p2)
385 (goto-char p1) 343 (goto-char p1)
386 (let ((has-br-line) 344 (let ((has-br-line)
387 (refill-start) 345 (refill-start)
388 (refill-stop)) 346 (refill-stop))
389 (if (re-search-forward "<br>$" p2 t) 347 (when (re-search-forward "<br>$" p2 t)
390 (setq has-br-line t) 348 (goto-char p1)
391 ) 349 (when (re-search-forward ".+[^<][^b][^r][^>]$" p2 t)
392 (if has-br-line 350 (beginning-of-line)
393 (progn 351 (setq refill-start (point))
394 (goto-char p1) 352 (goto-char p2)
395 (if (re-search-forward ".+[^<][^b][^r][^>]$" p2 t) 353 (re-search-backward ".+[^<][^b][^r][^>]$" refill-start t)
396 (progn 354 (next-line 1)
397 (beginning-of-line) 355 (end-of-line)
398 (setq refill-start (point)) 356 ;; refill-stop should ideally be adjusted to
399 (goto-char p2) 357 ;; accomodate the "<br>" strings which are removed
400 (re-search-backward ".+[^<][^b][^r][^>]$" refill-start t) 358 ;; between refill-start and refill-stop. Can simply
401 (next-line 1) 359 ;; be returned from my-replace-string
402 (end-of-line) 360 (setq refill-stop (+ (point)
403 ;; refill-stop should ideally be adjusted to 361 (html2text-replace-string
404 ;; accomodate the "<br>" strings which are removed 362 "<br>" ""
405 ;; between refill-start and refill-stop. Can simply 363 refill-start (point))))
406 ;; be returned from my-replace-string 364 ;; (message "Point = %s refill-stop = %s" (point) refill-stop)
407 (setq refill-stop (+ (point) 365 ;; (sleep-for 4)
408 (html2text-replace-string 366 (fill-region refill-start refill-stop))))
409 "<br>" "" 367 (html2text-replace-string "<br>" "" p1 p2))
410 refill-start (point))))
411 ;; (message "Point = %s refill-stop = %s" (point) refill-stop)
412 ;; (sleep-for 4)
413 (fill-region refill-start refill-stop)
414 )
415 )
416 )
417 )
418 )
419 (html2text-replace-string "<br>" "" p1 p2)
420 )
421 368
422 ;; 369 ;;
423 ;; This one is interactive ... 370 ;; This one is interactive ...
424 ;; 371 ;;
425 (defun html2text-fix-paragraphs () 372 (defun html2text-fix-paragraphs ()
450 ;; 397 ;;
451 ;; <Interactive functions> 398 ;; <Interactive functions>
452 ;; 399 ;;
453 400
454 (defun html2text-remove-tags (tag-list) 401 (defun html2text-remove-tags (tag-list)
455 "Removes the tags listed in the list \"html2text-remove-tag-list\". 402 "Removes the tags listed in the list `html2text-remove-tag-list'.
456 See the documentation for that variable." 403 See the documentation for that variable."
457 (interactive) 404 (interactive)
458 (dolist (tag tag-list) 405 (dolist (tag tag-list)
459 (goto-char (point-min)) 406 (goto-char (point-min))
460 (while (re-search-forward (format "\\(</?%s[^>]*>\\)" tag) (point-max) t) 407 (while (re-search-forward (format "\\(</?%s[^>]*>\\)" tag) (point-max) t)
461 (delete-region (match-beginning 0) (match-end 0))))) 408 (delete-region (match-beginning 0) (match-end 0)))))
462 409
463 (defun html2text-format-tags () 410 (defun html2text-format-tags ()
464 "See the variable \"html2text-format-tag-list\" for documentation" 411 "See the variable `html2text-format-tag-list' for documentation."
465 (interactive) 412 (interactive)
466 (dolist (tag-and-function html2text-format-tag-list) 413 (dolist (tag-and-function html2text-format-tag-list)
467 (let ((tag (car tag-and-function)) 414 (let ((tag (car tag-and-function))
468 (function (cdr tag-and-function))) 415 (function (cdr tag-and-function)))
469 (goto-char (point-min)) 416 (goto-char (point-min))
478 (re-search-forward (format "</%s>" tag) (point-max) t) 425 (re-search-forward (format "</%s>" tag) (point-max) t)
479 (setq p4 (point)) 426 (setq p4 (point))
480 (search-backward "</" (point-min) t) 427 (search-backward "</" (point-min) t)
481 (setq p3 (point)) 428 (setq p3 (point))
482 (funcall function p1 p2 p3 p4) 429 (funcall function p1 p2 p3 p4)
483 (goto-char p1) 430 (goto-char p1))))))
484 )
485 )
486 )
487 )
488 )
489 431
490 (defun html2text-substitute () 432 (defun html2text-substitute ()
491 "See the variable \"html2text-replace-list\" for documentation" 433 "See the variable `html2text-replace-list' for documentation."
492 (interactive) 434 (interactive)
493 (dolist (e html2text-replace-list) 435 (dolist (e html2text-replace-list)
494 (goto-char (point-min)) 436 (goto-char (point-min))
495 (let ((old-string (car e)) 437 (let ((old-string (car e))
496 (new-string (cdr e))) 438 (new-string (cdr e)))
497 (html2text-replace-string old-string new-string (point-min) (point-max)) 439 (html2text-replace-string old-string new-string (point-min) (point-max)))))
498 )
499 )
500 )
501 440
502 (defun html2text-format-single-elements () 441 (defun html2text-format-single-elements ()
503 ""
504 (interactive) 442 (interactive)
505 (dolist (tag-and-function html2text-format-single-element-list) 443 (dolist (tag-and-function html2text-format-single-element-list)
506 (let ((tag (car tag-and-function)) 444 (let ((tag (car tag-and-function))
507 (function (cdr tag-and-function))) 445 (function (cdr tag-and-function)))
508 (goto-char (point-min)) 446 (goto-char (point-min))
510 (point-max) t) 448 (point-max) t)
511 (let ((p1) 449 (let ((p1)
512 (p2 (point))) 450 (p2 (point)))
513 (search-backward "<" (point-min) t) 451 (search-backward "<" (point-min) t)
514 (setq p1 (point)) 452 (setq p1 (point))
515 (funcall function p1 p2) 453 (funcall function p1 p2))))))
516 )
517 )
518 )
519 )
520 )
521 454
522 ;; 455 ;;
523 ;; Main function 456 ;; Main function
524 ;; 457 ;;
525 458
538 (html2text-fix-paragraphs)))) 471 (html2text-fix-paragraphs))))
539 472
540 ;; 473 ;;
541 ;; </Interactive functions> 474 ;; </Interactive functions>
542 ;; 475 ;;
543 476 (provide 'html2text)
544 ;;; arch-tag: e9e57b79-35d4-4de1-a647-e7e01fe56d1e 477 ;;; arch-tag: e9e57b79-35d4-4de1-a647-e7e01fe56d1e
545 ;;; html2text.el ends here 478 ;;; html2text.el ends here