(Out of Rmail): Mention b2m.pl.

[bpt/emacs.git] / lisp / mail / undigest.el

diff --git a/lisp/mail/undigest.el b/lisp/mail/undigest.el
index d5db68f..d351373 100644 (file)
--- a/lisp/mail/undigest.el
+++ b/lisp/mail/undigest.el
@@ -1,17 +1,17 @@
 ;;; undigest.el --- digest-cracking support for the RMAIL mail reader
 
-;; Copyright (C) 1985, 1986, 1994, 1996, 2002
-;; Free Software Foundation, Inc.
+;; Copyright (C) 1985, 1986, 1994, 1996, 2001, 2002, 2003, 2004,
+;;   2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc.
 
 ;; Maintainer: FSF
 ;; Keywords: mail
 
 ;; This file is part of GNU Emacs.
 
-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; 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.
+;; the Free Software Foundation, either version 3 of the License, 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
@@ -19,9 +19,7 @@
 ;; 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.
+;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
 
 ;;; Commentary:
 
@@ -36,6 +34,14 @@
   "\^_\^L\n0, unseen,,\n*** EOOH ***\n"
   "String for separating messages in an rmail file.")
 
+(defcustom rmail-forward-separator-regex
+  "^----.*\\([Ff]orwarded\\|[Oo]riginal\\).*[Mm]essage"
+  "*Regexp to match the string that introduces forwarded messages.
+This is not a header, but a string contained in the body of the message.
+You may need to customize it for local needs."
+  :type 'regexp
+  :group 'rmail-headers)
+
 \f
 (defconst rmail-digest-methods
   '(rmail-digest-parse-mime
@@ -85,7 +91,15 @@ See rmail-digest-methods."
  (rmail-digest-rfc1153
   "^-\\{55,\\}\n\n"
   "^\n-\\{27,\\}\n\n"
-  "^\n-\\{27,\\}\n\nEnd of"))
+  ;; GNU Mailman knowingly (see comment at line 353 of ToDigest.py in
+  ;; Mailman source) produces non-conformant rfc 1153 digests, in that
+  ;; the trailer contains a "digest footer" like this:
+  ;; _______________________________________________
+  ;; <one or more lines of list blurb>
+  ;;
+  ;; End of Foo Digest...
+  ;; **************************************
+  "^\nEnd of"))
 
 (defun rmail-digest-rfc1153 (prolog-sep message-sep trailer-sep)
   (goto-char (point-min))
@@ -96,7 +110,7 @@ See rmail-digest-methods."
          separator result)
       (move-marker start (match-beginning 0))
       (move-marker end (match-end 0))
-      (setq result (cons (copy-marker start) (copy-marker end t)))
+      (setq result (list (cons (copy-marker start) (copy-marker end t))))
       (when (re-search-forward message-sep nil t)
        ;; Ok, at least one message separator found
        (setq separator (match-string 0))
@@ -137,6 +151,8 @@ See rmail-digest-methods."
       ;; Return the list of marker pairs
       (nreverse result))))
 
+(declare-function rmail-update-summary "rmailsum" (&rest ignore))
+
 ;;;###autoload
 (defun undigestify-rmail-message ()
   "Break up a digest message into its constituent messages.
@@ -224,15 +240,19 @@ following the containing message."
   ;; If we are in a summary buffer, switch to the Rmail buffer.
   (unwind-protect
       (with-current-buffer rmail-buffer
-       (narrow-to-region (rmail-msgbeg rmail-current-message)
-                         (rmail-msgend rmail-current-message))
        (goto-char (point-min))
+       (narrow-to-region (point)
+                         (save-excursion (search-forward "\n\n") (point)))
        (let ((buffer-read-only nil)
-             (forwarded-from (mail-fetch-field "From"))
-             (forwarded-date (mail-fetch-field "Date"))
+             (old-fwd-from (mail-fetch-field "Forwarded-From" nil nil t))
+             (old-fwd-date (mail-fetch-field "Forwarded-Date" nil nil t))
+             (fwd-from (mail-fetch-field "From"))
+             (fwd-date (mail-fetch-field "Date"))
              beg end prefix forward-msg)
-         (cond ((re-search-forward
-                 "^----.*\\([Ff]orwarded\\|[Oo]riginal\\).*[Mm]essage" nil t)
+         (narrow-to-region (rmail-msgbeg rmail-current-message)
+                           (rmail-msgend rmail-current-message))
+         (goto-char (point-min))
+         (cond ((re-search-forward rmail-forward-separator-regex nil t)
                 (forward-line 1)
                 (skip-chars-forward "\n")
                 (setq beg (point))
@@ -267,8 +287,13 @@ following the containing message."
          (narrow-to-region (point) (point))
          (insert rmail-mail-separator)
          (narrow-to-region (point) (point))
-         (insert "Forwarded-From: " forwarded-from "\n")
-         (insert "Forwarded-Date: " forwarded-date "\n")
+         (while old-fwd-from
+           (insert "Forwarded-From: " (car old-fwd-from) "\n")
+           (insert "Forwarded-Date: " (car old-fwd-date) "\n")
+           (setq old-fwd-from (cdr old-fwd-from))
+           (setq old-fwd-date (cdr old-fwd-date)))
+         (insert "Forwarded-From: " fwd-from "\n")
+         (insert "Forwarded-Date: " fwd-date "\n")
          (insert forward-msg)
          (save-restriction
            (goto-char (point-min))
@@ -290,4 +315,5 @@ following the containing message."
 
 (provide 'undigest)
 
+;; arch-tag: 3a28b9fb-c1f5-43ef-9278-285f3e4b874d
 ;;; undigest.el ends here