\f
* Changes in Oort Gnus
+** deuglify.el (gnus-article-outlook-deuglify-article)
+
+A new file from Raymond Scholz <rscholz@zonix.de> for deuglifying
+broken Outlook (Express) articles.
+
** (require 'gnus-load)
If you use a stand-alone Gnus distribution, you'd better add (require
+2002-02-24 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * deuglify.el: Fix comments.
+
+2002-02-23 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * html2text.el (html2text-clean-anchor): If there is no HREF,
+ insert nothing.
+
+ * mml.el (mml-generate-mime-1): Add cdr.
+ From: andre@slamdunknetworks.com
+
+ * mm-view.el (mm-text-html-renderer-alist): Add html2text.
+ (mm-text-html-washer-alist): Ditto.
+
+ * mm-decode.el (mm-text-html-renderer): Add html2text.
+
+ * html2text.el: Face lift.
+
+ * html2text.el: New file from Joakim Hove <hove@phys.ntnu.no>.
+
+2002-02-22 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-sum.el: Add gnus-article-outlook-deuglify-article.
+
+ * deuglify.el: Change copy right. Add autoload. Add coding-system.
+
+ * deuglify.el: New file. The original file name is
+ gnus-outlook-deuglify.el from Raymond Scholz <rscholz@zonix.de>.
+
+ * mm-decode.el (mm-display-external): Use
+ mm-file-name-rewrite-functions. From <andre@slamdunknetworks.com>
+
+2002-02-22 Paul Jarc <prj@po.cwru.edu>
+
+ * nnmaildir.el (nnmaildir-request-list): Report the highest
+ article number, not the total number of articles.
+
2002-02-21 ShengHuo ZHU <zsh@cs.rochester.edu>
* gnus-sum.el: Move uu key map here.
--- /dev/null
+;;; deuglify.el --- deuglify broken Outlook (Express) articles
+
+;; Copyright (C) 2002 Free Software Foundation, Inc.
+;; Copyright (C) 2001,2002 Raymond Scholz
+
+;; Author: Raymond Scholz <rscholz@zonix.de>
+;; Thomas Steffen (unwrapping algorithm,
+;; based on an idea of Stefan Monnier)
+;; Keywords: mail, news
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; This file enables Gnus to repair broken citations produced by
+;; common user agents like MS Outlook (Express). It may repair
+;; articles of other user agents too.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;;
+;; Outlook sometimes wraps cited lines before sending a message as
+;; seen in this example:
+;;
+;; Example #1
+;; ----------
+;;
+;; John Doe wrote:
+;;
+;; > This sentence no verb. This sentence no verb. This sentence
+;; no
+;; > verb. This sentence no verb. This sentence no verb. This
+;; > sentence no verb.
+;;
+;; The function `gnus-outlook-unwrap-lines' tries to recognize those
+;; erroneously wrapped lines and will unwrap them. I.e. putting the
+;; wrapped parts ("no" in this example) back where they belong (at the
+;; end of the cited line above).
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; Note that some people not only use broken user agents but also
+;; practice a bad citation style by omitting blank lines between the
+;; cited text and their own text.
+;:
+;; Example #2
+;; ----------
+;;
+;; John Doe wrote:
+;;
+;; > This sentence no verb. This sentence no verb. This sentence no
+;; You forgot in all your sentences.
+;; > verb. This sentence no verb. This sentence no verb. This
+;; > sentence no verb.
+;;
+;; Unwrapping "You forgot in all your sentences." would be illegal as
+;; this part wasn't intended to be cited text.
+;; `gnus-outlook-unwrap-lines' will only unwrap lines if the resulting
+;; citation line will be of a certain maximum length. You can control
+;; this by adjusting `gnus-outlook-deuglify-unwrap-max'. Also
+;; unwrapping will only be done if the line above the (possibly)
+;; wrapped line has a minimum length of `gnus-outlook-deuglify-unwrap-min'.
+;;
+;; Furthermore no unwrapping will be undertaken if the last character
+;; is one of the chars specified in
+;; `gnus-outlook-deuglify-unwrap-stop-chars'. Setting this to ".?!"
+;; inhibits unwrapping if the cited line ends with a full stop,
+;; question mark or exclamation mark. Note that this variable
+;; defaults to `nil', triggering a few false positives but generally
+;; giving you better results.
+;;
+;; Unwrapping works on every level of citation. Thus you will be able
+;; repair broken citations of broken user agents citing broken
+;; citations of broken user agents citing broken citations...
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; Citations are commonly introduced with an attribution line
+;; indicating who wrote the cited text. Outlook adds superfluous
+;; information that can be found in the header of the message to this
+;; line and often wraps it.
+;;
+;; If that weren't enough, lots of people write their own text above
+;; the cited text and cite the complete original article below.
+;;
+;; Example #3
+;; ----------
+;;
+;; Hey, John. There's no in all your sentences!
+;;
+;; John Doe <john.doe@some.domain> wrote in message
+;; news:a87usw8$dklsssa$2@some.news.server...
+;; > This sentence no verb. This sentence no verb. This sentence
+;; no
+;; > verb. This sentence no verb. This sentence no verb. This
+;; > sentence no verb.
+;; >
+;; > Bye, John
+;;
+;; Repairing the attribution line will be done by function
+;; `gnus-outlook-repair-attribution' which calls other function that
+;; try to recognize and repair broken attribution lines. See variable
+;; `gnus-outlook-deuglify-attrib-cut-regexp' for stuff that should be
+;; cut off from the beginning of an attribution line and variable
+;; `gnus-outlook-deuglify-attrib-verb-regexp' for the verbs that are
+;; required to be found in an attribution line. These function return
+;; the point where the repaired attribution line starts.
+;;
+;; Rearranging the article so that the cited text appears above the
+;; new text will be done by function
+;; `gnus-outlook-rearrange-citation'. This function calls
+;; `gnus-outlook-repair-attribution' to find and repair an attribution
+;; line.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; Well, and that's what the message will look like after applying
+;; deuglification:
+;;
+;; Example #3 (deuglified)
+;; -----------------------
+;;
+;; John Doe <john.doe@some.domain> wrote:
+;;
+;; > This sentence no verb. This sentence no verb. This sentence no
+;; > verb. This sentence no verb. This sentence no verb. This
+;; > sentence no verb.
+;; >
+;; > Bye, John
+;;
+;; Hey, John. There's no in all your sentences!
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; Usage
+;; -----
+;;
+;; Press `W k' in the Summary Buffer.
+;;
+;; Non recommended usage :-)
+;; ---------------------
+;;
+;; To automatically invoke deuglification on every article you read,
+;; put something like that in your .gnus:
+;;
+;; (add-hook 'gnus-article-decode-hook 'gnus-outlook-unwrap-lines)
+;;
+;; or _one_ of the following lines:
+;;
+;; ;; repair broken attribution lines
+;; (add-hook 'gnus-article-decode-hook 'gnus-outlook-repair-attribution)
+;;
+;; ;; repair broken attribution lines and citations
+;; (add-hook 'gnus-article-decode-hook 'gnus-outlook-rearrange-citation)
+;;
+;; Note that there always may be some false positives, so I suggest
+;; using the manual invocation. After deuglification you may want to
+;; refill the whole article using `W w'.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; Limitations
+;; -----------
+;;
+;; As I said before there may (or will) be a few false positives on
+;; unwrapping cited lines with `gnus-outlook-unwrap-lines'.
+;;
+;; `gnus-outlook-repair-attribution' will only fix the first
+;; attribution line found in the article. Furthermore it fixed to
+;; certain kinds of attributions. And there may be horribly many
+;; false positives, vanishing lines and so on -- so don't trust your
+;; eyes. Again I recommend manual invocation.
+;;
+;; `gnus-outlook-rearrange-citation' carries all the limitations of
+;; `gnus-outlook-repair-attribution'.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; See ChangeLog for other changes.
+;;
+;; Revision 1.5 2002/01/27 14:39:17 rscholz
+;; * New variable `gnus-outlook-deuglify-no-wrap-chars' to inhibit
+;; unwrapping if one these chars is first in the possibly wrapped line.
+;; * Improved rearranging of the article.
+;; * New function `gnus-outlook-repair-attribution-block' for repairing
+;; those big "Original Message (following some headers)" attributions.
+;;
+;; Revision 1.4 2002/01/03 14:05:00 rscholz
+;; Renamed `gnus-outlook-deuglify-article' to
+;; `gnus-article-outlook-deuglify-article'.
+;; Made it easier to deuglify the article while being in Gnus' Article
+;; Edit Mode. (suggested by Phil Nitschke)
+;;
+;;
+;; Revision 1.3 2002/01/02 23:35:54 rscholz
+;; Fix a bug that caused succeeding long attribution lines to be
+;; unwrapped. Minor doc fixes and regular expression tuning.
+;;
+;; Revision 1.2 2001/12/30 20:14:34 rscholz
+;; Clean up source.
+;;
+;; Revision 1.1 2001/12/30 20:13:32 rscholz
+;; Initial revision
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;;; Code:
+
+(require 'gnus-art)
+(require 'gnus-sum)
+
+(defconst gnus-outlook-deuglify-version "1.5 Gnus version"
+ "Version of gnus-outlook-deuglify.")
+
+;;; User Customizable Variables:
+
+(defgroup gnus-outlook-deuglify nil
+ "Deuglify articles generated by broken user agents like MS
+Outlook (Express).")
+
+;;;###autoload
+(defcustom gnus-outlook-deuglify-unwrap-min 45
+ "Minimum length of the cited line above the (possibly) wrapped line."
+ :type 'number
+ :group 'gnus-outlook-deuglify)
+
+;;;###autoload
+(defcustom gnus-outlook-deuglify-unwrap-max 95
+ "Maximum length of the cited line after unwrapping."
+ :type 'number
+ :group 'gnus-outlook-deuglify)
+
+(defcustom gnus-outlook-deuglify-cite-marks ">|#%"
+ "Characters that indicate cited lines."
+ :type 'string
+ :group 'gnus-outlook-deuglify)
+
+(defcustom gnus-outlook-deuglify-unwrap-stop-chars nil ;; ".?!" or nil
+ "Characters that inhibit unwrapping if they are the last one on the
+cited line above the possible wrapped line."
+ :type 'string
+ :group 'gnus-outlook-deuglify)
+
+(defcustom gnus-outlook-deuglify-no-wrap-chars "`"
+ "Characters that inhibit unwrapping if they are the first one in the
+possibly wrapped line."
+ :type 'string
+ :group 'gnus-outlook-deuglify)
+
+(defcustom gnus-outlook-deuglify-attrib-cut-regexp
+ "\\(On \\|Am \\)?\\(Mon\\|Tue\\|Wed\\|Thu\\|Fri\\|Sat\\|Sun\\),[^,]+, "
+ "Regular expression matching the beginning of an attribution line
+that should be cut off."
+ :type 'string
+ :group 'gnus-outlook-deuglify)
+
+(defcustom gnus-outlook-deuglify-attrib-verb-regexp
+ "wrote\\|writes\\|says\\|schrieb\\|schreibt\\|meinte\\|skrev\\|a écrit\\|schreef"
+ "Regular expression matching the verb used in an attribution line."
+ :type 'string
+ :group 'gnus-outlook-deuglify)
+
+(defcustom gnus-outlook-deuglify-attrib-end-regexp
+ ": *\\|\\.\\.\\."
+ "Regular expression matching the end of an attribution line."
+ :type 'string
+ :group 'gnus-outlook-deuglify)
+
+
+;; Functions
+
+;; TODO: don't kill MIME parts
+;;;###autoload
+(defun gnus-outlook-unwrap-lines ()
+ "Unwrap lines that appear to be wrapped citation lines. You can
+control what lines will be unwrapped by frobbing
+`gnus-outlook-deuglify-unwrap-min' and
+`gnus-outlook-deuglify-unwrap-max', indicating the miminum and maximum
+length of an unwrapped citation line."
+ (interactive)
+ (save-excursion
+ (let ((case-fold-search nil)
+ (inhibit-read-only t)
+ (cite-marks gnus-outlook-deuglify-cite-marks)
+ (no-wrap gnus-outlook-deuglify-no-wrap-chars)
+ (stop-chars gnus-outlook-deuglify-unwrap-stop-chars))
+ (gnus-with-article-buffer
+ (article-goto-body)
+ (while (re-search-forward
+ (concat
+ "^\\([ \t" cite-marks "]*\\)"
+ "\\([" cite-marks "].*[^\n " stop-chars "]\\)[ \t]?\n"
+ "\\1\\([^\n " cite-marks no-wrap "]+.*\\)$")
+ nil t)
+ (let ((len12 (- (match-end 2) (match-beginning 1)))
+ (len3 (- (match-end 3) (match-beginning 3))))
+ (if (and (> len12 gnus-outlook-deuglify-unwrap-min)
+ (< (+ len12 len3) gnus-outlook-deuglify-unwrap-max))
+ (progn
+ (replace-match "\\1\\2 \\3")
+ (goto-char (match-beginning 0))))))))))
+
+;; TODO: respect signatures, don't kill MIME parts
+(defun gnus-outlook-rearrange-article (from-where)
+ "Put the text from `from-where' to the end of buffer at the top of
+the article buffer."
+ (save-excursion
+ (let ((inhibit-read-only t)
+ (cite-marks gnus-outlook-deuglify-cite-marks))
+ (gnus-with-article-buffer
+ (unless (search-forward-regexp
+ (concat "^[ \t]*[^" cite-marks "\n]") nil t)
+ (kill-region from-where (point-max))
+ (article-goto-body)
+ (yank)
+ (insert "\n"))))))
+
+;; John Doe <john.doe@some.domain> wrote in message
+;; news:a87usw8$dklsssa$2@some.news.server...
+
+(defun gnus-outlook-repair-attribution-outlook ()
+ "Repair a broken attribution line (Outlook)."
+ (save-excursion
+ (let ((case-fold-search nil)
+ (inhibit-read-only t)
+ (cite-marks gnus-outlook-deuglify-cite-marks))
+ (gnus-with-article-buffer
+ (article-goto-body)
+ (if (re-search-forward
+ (concat "^\\([^" cite-marks "].+\\)"
+ "\\(" gnus-outlook-deuglify-attrib-verb-regexp "\\)"
+ "\\(.*\n?[^\n" cite-marks "].*\\)?"
+ "\\(" gnus-outlook-deuglify-attrib-end-regexp "\\)$")
+ nil t)
+ (progn
+ (replace-match "\\1\\2\\4")
+ (match-beginning 0)))))))
+
+
+;; ----- Original Message -----
+;; From: "John Doe" <john.doe@some.domain>
+;; To: "Doe Foundation" <info@doefnd.org>
+;; Sent: Monday, November 19, 2001 12:13 PM
+;; Subject: More Doenuts
+
+(defun gnus-outlook-repair-attribution-block ()
+ "Repair a big broken attribution block."
+ (save-excursion
+ (let ((case-fold-search nil)
+ (inhibit-read-only t)
+ (cite-marks gnus-outlook-deuglify-cite-marks))
+ (gnus-with-article-buffer
+ (article-goto-body)
+ (if (re-search-forward
+ (concat "^----* ?[^-]+ ?----*\n"
+ "[^\n]+: \\([^\n]+\\)\n"
+ "[^\n]+: [^\n]+\n"
+ "[^\n]+: [^\n]+\n"
+ "[^\n]+: [^\n]+$")
+ nil t)
+ (progn
+ (replace-match "\\1 wrote:")
+ (match-beginning 0)))))))
+
+;; On Wed, 16 Jan 2002 23:23:30 +0100, John Doe <john.doe@some.domain> wrote:
+
+(defun gnus-outlook-repair-attribution-other ()
+ "Repair a broken attribution line (other user agents than Outlook)."
+ (save-excursion
+ (let ((case-fold-search nil)
+ (inhibit-read-only t)
+ (cite-marks gnus-outlook-deuglify-cite-marks))
+ (gnus-with-article-buffer
+ (article-goto-body)
+ (if (re-search-forward
+ (concat "^\\("gnus-outlook-deuglify-attrib-cut-regexp"\\)?"
+ "\\([^" cite-marks "].+\\)\n\\([^\n" cite-marks "].*\\)?"
+ "\\(" gnus-outlook-deuglify-attrib-verb-regexp "\\).*"
+ "\\(" gnus-outlook-deuglify-attrib-end-regexp "\\)$")
+ nil t)
+ (progn
+ (replace-match "\\4 \\5\\6\\7")
+ (match-beginning 0)))))))
+
+;;;###autoload
+(defun gnus-outlook-repair-attribution ()
+ "Repair a broken attribution line."
+ (interactive)
+ (or
+ (gnus-outlook-repair-attribution-other)
+ (gnus-outlook-repair-attribution-block)
+ (gnus-outlook-repair-attribution-outlook)))
+
+(defun gnus-outlook-rearrange-citation ()
+ "Repair broken citations."
+ (let ((attrib-start (gnus-outlook-repair-attribution)))
+ ;; rearrange citations if an attribution line has been recognized
+ (if attrib-start
+ (gnus-outlook-rearrange-article attrib-start))))
+
+;;;###autoload
+(defun gnus-outlook-deuglify-article ()
+ "Deuglify broken Outlook (Express) articles."
+ (interactive)
+ ;; apply treatment of dumb quotes
+ (gnus-article-treat-dumbquotes)
+ ;; repair wrapped cited lines
+ (gnus-outlook-unwrap-lines)
+ ;; repair attribution line
+ (gnus-outlook-rearrange-citation))
+
+;;;###autoload
+(defun gnus-article-outlook-deuglify-article ()
+ "Deuglify broken Outlook (Express) articles and redisplay."
+ (interactive)
+ (gnus-outlook-deuglify-article)
+ (with-current-buffer (or gnus-article-buffer (current-buffer))
+ (gnus-article-prepare-display)))
+
+(provide 'deuglify)
+
+;; Local Variables:
+;; coding: iso-8859-1
+;; End:
+
+;;; deuglify.el ends here
(autoload 'gnus-mailing-list-insinuate "gnus-ml" nil t)
(autoload 'turn-on-gnus-mailing-list-mode "gnus-ml" nil t)
(autoload 'mm-uu-dissect "mm-uu")
+(autoload 'gnus-article-outlook-deuglify-article "deuglify"
+ "Deuglify broken Outlook (Express) articles and redisplay."
+ t)
(defcustom gnus-kill-summary-on-exit t
"*If non-nil, kill the summary buffer when you exit from it.
"m" gnus-summary-toggle-mime
"a" gnus-article-strip-headers-in-body ;; mnemonic: wash archive
"p" gnus-article-verify-x-pgp-sig
- "d" gnus-article-treat-dumbquotes)
+ "d" gnus-article-treat-dumbquotes
+ "k" gnus-article-outlook-deuglify-article)
(gnus-define-keys (gnus-summary-wash-hide-map "W" gnus-summary-wash-map)
"a" gnus-article-hide
["Html" gnus-article-wash-html t]
["URLs" gnus-article-unsplit-urls t]
["Verify X-PGP-Sig" gnus-article-verify-x-pgp-sig t]
- ["HZ" gnus-article-decode-HZ t])
+ ["HZ" gnus-article-decode-HZ t]
+ ["OutlooK deuglify" gnus-article-outlook-deuglify-article t]
+ )
("Output"
["Save in default format" gnus-summary-save-article
,@(if (featurep 'xemacs) '(t)
--- /dev/null
+;;; html2text.el --- a simple html to plain text converter
+
+;; Copyright (C) 2002 Free Software Foundation, Inc.
+
+;; Author: Joakim Hove <hove@phys.ntnu.no>
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; These functions provide a simple way to wash/clean html infected
+;; mails. Definitely do not work in all cases, but some improvement
+;; in readability is generally obtained. Formatting is only done in
+;; the buffer, so the next time you enter the article it will be
+;; "re-htmlized".
+;;
+;; The main function is "html2text"
+
+;;; Code:
+
+;;
+;; <Global variables>
+;;
+
+(eval-when-compile
+ (require 'cl))
+
+(defvar html2text-format-single-element-list '(("hr" . html2text-clean-hr)))
+
+(defvar html2text-replace-list
+ '((" " . " ") (">" . ">") ("<" . "<") (""" . "\""))
+ "The map of entity to text.
+
+This is an alist were each element is a dotted pair consisting of an
+old string, and a replacement string. This replacement is done by the
+function \"html2text-substitute\" which basically performs a
+replace-string operation for every element in the list. This is
+completely verbatim - without any use of REGEXP.")
+
+(defvar html2text-remove-tag-list
+ '("html" "body" "p" "img" "dir" "head" "div" "br" "font" "title" "meta")
+ "A list of removable tags.
+
+This is a list of tags which should be removed, without any
+formatting. Observe that if you the tags in the list are presented
+*without* any \"<\" or \">\". All occurences of a tag appearing in
+this list are removed, irrespective of whether it is a closing or
+opening tag, or if the tag has additional attributes. The actual
+deletion is done by the function \"html2text-remove-tags\".
+
+For instance the text:
+
+\"Here comes something <font size\"+3\" face=\"Helvetica\"> big </font>.\"
+
+will be reduced to:
+
+\"Here comes something big.\"
+
+If this list contains the element \"font\".")
+
+(defvar html2text-format-tag-list
+ '(("b" . html2text-clean-bold)
+ ("u" . html2text-clean-underline)
+ ("i" . html2text-clean-italic)
+ ("blockquote" . html2text-clean-blockquote)
+ ("a" . html2text-clean-anchor)
+ ("ul" . html2text-clean-ul)
+ ("ol" . html2text-clean-ol)
+ ("dl" . html2text-clean-dl)
+ ("center" . html2text-clean-center))
+ "An alist of tags and processing functions.
+
+This is an alist where each dotted pair consists of a tag, and then
+the name of a function to be called when this tag is found. The
+function is called with the arguments p1, p2, p3 and p4. These are
+demontrated below:
+
+\"<b> This is bold text </b>\"
+ ^ ^ ^ ^
+ | | | |
+p1 p2 p3 p4
+
+Then the called function will typically format the text somewhat and
+remove the tags.")
+
+(defvar html2text-remove-tag-list2 '("li" "dt" "dd" "meta")
+ "Another list of removable tags.
+
+This is a list of tags which are removed similarly to the list
+`html2text-remove-tag-list' - but these tags are retained for the
+formatting, and then moved afterward.")
+
+;;
+;; </Global variables>
+;;
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;;
+;; <Utility functions>
+;;
+
+(defun html2text-buffer-head ()
+ (if (string= mode-name "Article")
+ (beginning-of-buffer)
+ (beginning-of-buffer)
+ )
+ )
+
+(defun html2text-replace-string (from-string to-string p1 p2)
+ (goto-char p1)
+ (let ((delta (- (string-width to-string) (string-width from-string)))
+ (change 0))
+ (while (search-forward from-string p2 t)
+ (replace-match to-string)
+ (setq change (+ change delta))
+ )
+ change
+ )
+ )
+
+;;
+;; </Utility functions>
+;;
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;;
+;; <Functions related to attributes> i.e. <font size=+3>
+;;
+
+(defun html2text-attr-value (attr-list attr)
+ (nth 1 (assoc attr attr-list))
+ )
+
+(defun html2text-get-attr (p1 p2 tag)
+ (goto-char p1)
+ (re-search-forward " +[^ ]" p2 t)
+ (let* ((attr-string (buffer-substring-no-properties (1- (point)) (1- p2)))
+ (tmp-list (split-string attr-string))
+ (attr-list)
+ (counter 0)
+ (prev (car tmp-list))
+ (this (nth 1 tmp-list))
+ (next (nth 2 tmp-list))
+ (index 1))
+
+ (cond
+ ;; size=3
+ ((string-match "[^ ]=[^ ]" prev)
+ (let ((attr (nth 0 (split-string prev "=")))
+ (value (nth 1 (split-string prev "="))))
+ (setq attr-list (cons (list attr value) attr-list))
+ )
+ )
+ ;; size= 3
+ ((string-match "[^ ]=\\'" prev)
+ (setq attr-list (cons (list (substring prev 0 -1) this) attr-list))
+ )
+ )
+
+ (while (< index (length tmp-list))
+ (cond
+ ;; size=3
+ ((string-match "[^ ]=[^ ]" this)
+ (let ((attr (nth 0 (split-string this "=")))
+ (value (nth 1 (split-string this "="))))
+ (setq attr-list (cons (list attr value) attr-list))
+ )
+ )
+ ;; size =3
+ ((string-match "\\`=[^ ]" this)
+ (setq attr-list (cons (list prev (substring this 1)) attr-list)))
+
+ ;; size= 3
+ ((string-match "[^ ]=\\'" this)
+ (setq attr-list (cons (list (substring this 0 -1) next) attr-list))
+ )
+
+ ;; size = 3
+ ((string= "=" this)
+ (setq attr-list (cons (list prev next) attr-list))
+ )
+ )
+ (setq index (1+ index))
+ (setq prev this)
+ (setq this next)
+ (setq next (nth (1+ index) tmp-list))
+ )
+
+ ;;
+ ;; Tags with no accompanying "=" i.e. value=nil
+ ;;
+ (setq prev (car tmp-list))
+ (setq this (nth 1 tmp-list))
+ (setq next (nth 2 tmp-list))
+ (setq index 1)
+
+ (if (not (string-match "=" prev))
+ (progn
+ (if (not (string= (substring this 0 1) "="))
+ (setq attr-list (cons (list prev nil) attr-list))
+ )
+ )
+ )
+
+ (while (< index (1- (length tmp-list)))
+ (if (not (string-match "=" this))
+ (if (not (or (string= (substring next 0 1) "=")
+ (string= (substring prev -1) "=")))
+ (setq attr-list (cons (list this nil) attr-list))
+ )
+ )
+ (setq index (1+ index))
+ (setq prev this)
+ (setq this next)
+ (setq next (nth (1+ index) tmp-list))
+ )
+
+ (if this
+ (progn
+ (if (not (string-match "=" this))
+ (progn
+ (if (not (string= (substring prev -1) "="))
+ (setq attr-list (cons (list this nil) attr-list))
+ )
+ )
+ )
+ )
+ )
+ attr-list ;; return - value
+ )
+ )
+
+;;
+;; </Functions related to attributes>
+;;
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;;
+;; <Functions to be called to format a tag-pair>
+;;
+(defun html2text-clean-list-items (p1 p2 list-type)
+ (goto-char p1)
+ (let ((item-nr 0)
+ (items 0))
+ (while (re-search-forward "<li>" p2 t)
+ (setq items (1+ items)))
+ (goto-char p1)
+ (while (< item-nr items)
+ (setq item-nr (1+ item-nr))
+ (re-search-forward "<li>" (point-max) t)
+ (cond
+ ((string= list-type "ul") (insert " o "))
+ ((string= list-type "ol") (insert (format " %s: " item-nr)))
+ (t (insert " x ")))
+ )
+ )
+ )
+
+(defun html2text-clean-dtdd (p1 p2)
+ (goto-char p1)
+ (let ((items 0)
+ (item-nr 0))
+ (while (re-search-forward "<dt>" p2 t)
+ (setq items (1+ items)))
+ (goto-char p1)
+ (while (< item-nr items)
+ (setq item-nr (1+ item-nr))
+ (re-search-forward "<dt>\\([ ]*\\)" (point-max) t)
+ (if (match-string 1)
+ (kill-region (point) (- (point) (string-width (match-string 1))))
+ )
+ (let ((def-p1 (point))
+ (def-p2 0))
+ (re-search-forward "\\([ ]*\\)\\(</dt>\\|<dd>\\)" (point-max) t)
+ (if (match-string 1)
+ (progn
+ (let* ((mw1 (string-width (match-string 1)))
+ (mw2 (string-width (match-string 2)))
+ (mw (+ mw1 mw2)))
+ (goto-char (- (point) mw))
+ (kill-region (point) (+ (point) mw1))
+ (setq def-p2 (point))
+ )
+ )
+ (setq def-p2 (- (point) (string-width (match-string 2)))))
+ (put-text-property def-p1 def-p2 'face 'bold)
+ )
+ )
+ )
+ )
+
+(defun html2text-delete-tags (p1 p2 p3 p4)
+ (kill-region p1 p2)
+ (kill-region (- p3 (- p2 p1)) (- p4 (- p2 p1)))
+ )
+
+(defun html2text-delete-single-tag (p1 p2)
+ (kill-region p1 p2)
+ )
+
+(defun html2text-clean-hr (p1 p2)
+ (html2text-delete-single-tag p1 p2)
+ (goto-char p1)
+ (newline 1)
+ (insert (make-string fill-column ?-))
+ )
+
+(defun html2text-clean-ul (p1 p2 p3 p4)
+ (html2text-delete-tags p1 p2 p3 p4)
+ (html2text-clean-list-items p1 (- p3 (- p1 p2)) "ul")
+ )
+
+(defun html2text-clean-ol (p1 p2 p3 p4)
+ (html2text-delete-tags p1 p2 p3 p4)
+ (html2text-clean-list-items p1 (- p3 (- p1 p2)) "ol")
+ )
+
+(defun html2text-clean-dl (p1 p2 p3 p4)
+ (html2text-delete-tags p1 p2 p3 p4)
+ (html2text-clean-dtdd p1 (- p3 (- p1 p2)))
+ )
+
+(defun html2text-clean-center (p1 p2 p3 p4)
+ (html2text-delete-tags p1 p2 p3 p4)
+ (center-region p1 (- p3 (- p2 p1)))
+ )
+
+(defun html2text-clean-bold (p1 p2 p3 p4)
+ (put-text-property p2 p3 'face 'bold)
+ (html2text-delete-tags p1 p2 p3 p4)
+ )
+
+(defun html2text-clean-title (p1 p2 p3 p4)
+ (put-text-property p2 p3 'face 'bold)
+ (html2text-delete-tags p1 p2 p3 p4)
+ )
+
+(defun html2text-clean-underline (p1 p2 p3 p4)
+ (put-text-property p2 p3 'face 'underline)
+ (html2text-delete-tags p1 p2 p3 p4)
+ )
+
+(defun html2text-clean-italic (p1 p2 p3 p4)
+ (put-text-property p2 p3 'face 'italic)
+ (html2text-delete-tags p1 p2 p3 p4)
+ )
+
+(defun html2text-clean-font (p1 p2 p3 p4)
+ (html2text-delete-tags p1 p2 p3 p4)
+ )
+
+(defun html2text-clean-blockquote (p1 p2 p3 p4)
+ (html2text-delete-tags p1 p2 p3 p4)
+ )
+
+(defun html2text-clean-anchor (p1 p2 p3 p4)
+ ;; If someone can explain how to make the URL clickable I will
+ ;; surely improve upon this.
+ (let* ((attr-list (html2text-get-attr p1 p2 "a"))
+ (href (html2text-attr-value attr-list "href")))
+ (kill-region p1 p4)
+ (when href
+ (goto-char p1)
+ (insert (substring href 1 -1 ))
+ (put-text-property p1 (point) 'face 'bold))))
+
+;;
+;; </Functions to be called to format a tag-pair>
+;;
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;;
+;; <Functions to be called to fix up paragraphs>
+;;
+
+(defun html2text-fix-paragraph (p1 p2)
+ (goto-char p1)
+ (let ((has-br-line)
+ (refill-start)
+ (refill-stop))
+ (if (re-search-forward "<br>$" p2 t)
+ (setq has-br-line t)
+ )
+ (if has-br-line
+ (progn
+ (goto-char p1)
+ (if (re-search-forward ".+[^<][^b][^r][^>]$" p2 t)
+ (progn
+ (beginning-of-line)
+ (setq refill-start (point))
+ (goto-char p2)
+ (re-search-backward ".+[^<][^b][^r][^>]$" refill-start t)
+ (next-line 1)
+ (end-of-line)
+ ;; refill-stop should ideally be adjusted to
+ ;; accomodate the "<br>" strings which are removed
+ ;; between refill-start and refill-stop. Can simply
+ ;; be returned from my-replace-string
+ (setq refill-stop (+ (point)
+ (html2text-replace-string
+ "<br>" ""
+ 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)
+ )
+
+;;
+;; This one is interactive ...
+;;
+(defun html2text-fix-paragraphs ()
+ "This _tries_ to fix up the paragraphs - this is done in quite a ad-hook
+fashion, quite close to pure guess-work. It does work in some cases though."
+ (interactive)
+ (html2text-buffer-head)
+ (replace-regexp "^<br>$" "")
+ ;; Removing lonely <br> on a single line, if they are left intact we
+ ;; dont have any paragraphs at all.
+ (html2text-buffer-head)
+ (while (< (point) (point-max))
+ (let ((p1 (point)))
+ (forward-paragraph 1)
+ ;;(message "Kaller fix med p1=%s p2=%s " p1 (1- (point))) (sleep-for 5)
+ (html2text-fix-paragraph p1 (1- (point)))
+ (goto-char p1)
+ (if (< (point) (point-max))
+ (forward-paragraph 1))
+ )
+ )
+ )
+
+;;
+;; </Functions to be called to fix up paragraphs>
+;;
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;;
+;; <Interactive functions>
+;;
+
+(defun html2text-remove-tags (tag-list)
+ "Removes the tags listed in the list \"html2text-remove-tag-list\".
+See the documentation for that variable."
+ (interactive)
+ (dolist (tag tag-list)
+ (html2text-buffer-head)
+ (while (re-search-forward (format "\\(</?%s[^>]*>\\)" tag) (point-max) t)
+ (let ((p1 (point)))
+ (search-backward "<")
+ (kill-region (point) p1)
+ )
+ )
+ )
+ )
+
+(defun html2text-format-tags ()
+ "See the variable \"html2text-format-tag-list\" for documentation"
+ (interactive)
+ (dolist (tag-and-function html2text-format-tag-list)
+ (let ((tag (car tag-and-function))
+ (function (cdr tag-and-function)))
+ (html2text-buffer-head)
+ (while (re-search-forward (format "\\(<%s\\( [^>]*\\)?>\\)" tag)
+ (point-max) t)
+ (let ((p1)
+ (p2 (point))
+ (p3) (p4)
+ (attr (match-string 1)))
+ (search-backward "<" (point-min) t)
+ (setq p1 (point))
+ (re-search-forward (format "</%s>" tag) (point-max) t)
+ (setq p4 (point))
+ (search-backward "</" (point-min) t)
+ (setq p3 (point))
+ (funcall function p1 p2 p3 p4)
+ (goto-char p1)
+ )
+ )
+ )
+ )
+ )
+
+(defun html2text-substitute ()
+ "See the variable \"html2text-replace-list\" for documentation"
+ (interactive)
+ (dolist (e html2text-replace-list)
+ (html2text-buffer-head)
+ (let ((old-string (car e))
+ (new-string (cdr e)))
+ (html2text-replace-string old-string new-string (point-min) (point-max))
+ )
+ )
+ )
+
+(defun html2text-format-single-elements ()
+ ""
+ (interactive)
+ (dolist (tag-and-function html2text-format-single-element-list)
+ (let ((tag (car tag-and-function))
+ (function (cdr tag-and-function)))
+ (html2text-buffer-head)
+ (while (re-search-forward (format "\\(<%s\\( [^>]*\\)?>\\)" tag)
+ (point-max) t)
+ (let ((p1)
+ (p2 (point)))
+ (search-backward "<" (point-min) t)
+ (setq p1 (point))
+ (funcall function p1 p2)
+ )
+ )
+ )
+ )
+ )
+
+;;
+;; Main function
+;;
+
+;;;###autoload
+(defun html2text ()
+ "Convert HTML to plain text in the current buffer."
+ (interactive)
+ (save-excursion
+ (let ((case-fold-search t)
+ (buffer-read-only))
+ (html2text-remove-tags html2text-remove-tag-list)
+ (html2text-format-tags)
+ (html2text-remove-tags html2text-remove-tag-list2)
+ (html2text-substitute)
+ (html2text-format-single-elements)
+ (html2text-fix-paragraphs))))
+
+;;
+;; </Interactive functions>
+;;
+
+;;; html2text.el ends here
(cond ((locate-library "w3") 'w3)
((locate-library "w3m") 'w3m)
((executable-find "links") 'links)
- ((executable-find "lynx") 'lynx))
+ ((executable-find "lynx") 'lynx)
+ (t 'html2text))
"Render of HTML contents.
It is one of defined renderer types, or a rendering function.
The defined renderer types are:
`w3m' : using emacs-w3m;
`links': using links;
`lynx' : using lynx;
+`html2text' : using html2text;
`nil' : using external viewer."
:type '(choice (symbol w3)
(symbol w3m)
(symbol links)
(symbol lynx)
+ (symbol html2text)
(symbol nil)
(function))
:version "21.3"
(make-directory dir)
(set-file-modes dir 448)
(if filename
- (setq file (expand-file-name (file-name-nondirectory filename)
- dir))
+ (setq file (expand-file-name
+ (gnus-map-function mm-file-name-rewrite-functions
+ (file-name-nondirectory filename))
+ dir))
(setq file (make-temp-name (expand-file-name "mm." dir))))
(let ((coding-system-for-write mm-binary-coding-system))
(write-region (point-min) (point-max) file nil 'nomesg))
(autoload 'vcard-parse-string "vcard")
(autoload 'vcard-format-string "vcard")
(autoload 'fill-flowed "flow-fill")
+ (autoload 'html2text "html2text")
(unless (fboundp 'diff-mode)
(autoload 'diff-mode "diff-mode" "" t nil)))
mm-links-remove-leading-blank
"links" "-dump" file)
(lynx mm-inline-render-with-stdin nil
- "lynx" "-dump" "-force_html" "-stdin"))
+ "lynx" "-dump" "-force_html" "-stdin")
+ (html2text mm-inline-render-with-function html2text))
"The attributes of renderer types for text/html.")
(defvar mm-text-html-washer-alist
mm-links-remove-leading-blank
"links" "-dump" file)
(lynx mm-inline-wash-with-stdin nil
- "lynx" "-dump" "-force_html" "-stdin"))
+ "lynx" "-dump" "-force_html" "-stdin")
+ (html2text html2text))
"The attributes of washer types for text/html.")
;;; Internal variables.
(let (use-hard-newlines)
(when (and (string= type "text/plain")
(or (null (assq 'format cont))
- (string= (assq 'format cont) "flowed"))
+ (string= (cdr (assq 'format cont))
+ "flowed"))
(setq use-hard-newlines
(text-property-any
(point-min) (point-max) 'hard 't)))
'read-only)
ct-min (nnmaildir--article-count group))
(insert (nnmaildir--grp-get-name group) " ")
- (princ (car ct-min) nntp-server-buffer)
+ (princ (nnmaildir--nlist-last-num
+ (nnmaildir--lists-get-nlist
+ (nnmaildir--grp-get-lists group)))
+ nntp-server-buffer)
(insert " ")
(princ (cdr ct-min) nntp-server-buffer)
(insert " " (if ro "n" "y") "\n"))
(princ (cdr ct-min) nntp-server-buffer)
(insert " ")
(princ (nnmaildir--nlist-last-num
- (nnmaildir--lists-get-nlist
- (nnmaildir--grp-get-lists group)))
+ (nnmaildir--lists-get-nlist
+ (nnmaildir--grp-get-lists group)))
nntp-server-buffer)
(insert " " gname "\n")))))
'group)
+2002-02-23 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnusref.tex (subsection*{Notes}): Addition.
+ Suggested by Felix Natter <fnatter@gmx.net>
+
+2002-02-22 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus.texi (Splitting Mail): Addition.
+
2002-02-20 ShengHuo ZHU <zsh@cs.rochester.edu>
* gnus.texi (Slave Gnusae): Addition.
@code{gnus-summary-respool-trace} \e$B$H4XO"$9$kL?\e(B
\e$BNa\e(B (@pxref{Mail Group Commands}) \e$B$r;H$&;v$,$G$-$^$9!#\e(B
+@vindex nnmail-split-header-length-limit
+@code{nnmail-split-header-length-limit} \e$B$N@)8B$h$jD9$$%X%C%@!<9T$O!"J,3d\e(B
+\e$B4X?t$N=hM}BP>]$+$i=|30$5$l$^$9!#\e(B
+
Gnus \e$B$O$"$J$?$K<+J,<+?H$KD7$MJV$C$F$/$k$h$&$J2DG=@-$N$"$kA4$F$N5!2q$rDs\e(B
\e$B6!$7$^$9!#Nc$($P!"$"$J$?$N>e;J$+$i$/$kA4$F$N%a!<%k$r4^$s$@%0%k!<%W$r:n$C\e(B
\e$B$?$H$7$^$7$g$&!#$=$l$+$i!"6vH/E*$K$=$N%0%k!<%W$N9XFI<h$j;_$a$,5/$3$C$?$H\e(B
@code{gnus-summary-respool-trace} and related commands (@pxref{Mail
Group Commands}).
+@vindex nnmail-split-header-length-limit
+Header lines longer than this limit are excluded from the split
+function.
+
Gnus gives you all the opportunity you could possibly want for shooting
yourself in the foot. Let's say you create a group that will contain
all the mail you get from your boss. And then you accidentally
, & Jump to the lowest-level group with unread articles.\\
. & Jump to the first group with unread articles.\\
xx & Enter the Server buffer mode.\\
- a & Post an {\bf article} to a group.\\
+ a & Post an {\bf article} to a group
+ [Prefix: use group under point to find posting-style].\\
b & Find {\bf bogus} groups and delete them.\\
c & Mark all unticked articles in this group as read ({\bf catch-up}).
[p/p]\\
g & Check the server for new articles ({\bf get}). [level]\\
M-g & Check the server for new articles in this group ({\bf get}). [p/p]\\
j & {\bf Jump} to a group.\\
- m & {\bf Mail} a message to someone.\\
+ m & {\bf Mail} a message to someone
+ [Prefix: use group under point to find posting-style].\\
n & Go to the {\bf next} group with unread articles. [distance]\\
M-n & Go to the {\bf next} group on the same or lower level.
[distance]\\