(term-mode, term-check-proc, term-input-sender, term-simple-send,
[bpt/emacs.git] / lisp / mail / undigest.el
index ff46739..2c44706 100644 (file)
   "\^_\^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 customise it for local needs."
+  :type 'regexp
+  :group 'rmail-headers)
+
 \f
 (defconst rmail-digest-methods
   '(rmail-digest-parse-mime
@@ -224,16 +232,21 @@ 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"))
-             beg end prefix forward-msg n)
-         (cond ((re-search-forward
-                 "^----.*\\([Ff]orwarded\\|[Oo]riginal\\).*[Mm]essage" nil t)
+             (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)
+         (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))
                 (setq end (if (re-search-forward "^----.*[^- \t\n]" nil t)
                               (match-beginning 0) (point-max)))
@@ -242,13 +255,10 @@ following the containing message."
                        "^- -" "-" (buffer-substring beg end))))
                ((and (re-search-forward "^\\(> ?\\)[a-zA-Z-]+: .*\n" nil t)
                      (setq beg (match-beginning 0))
-                     (setq prefix (match-string 1))
+                     (setq prefix (match-string-no-properties 1))
                      (goto-char beg)
                      (looking-at (concat "\\(" prefix ".+\n\\)*"
-                                         prefix "Date: .+\n"
-                                         "\\(" prefix ".+\n\\)*"
-                                         "\\(> ?\\)?\n" prefix))
-                     (goto-char beg)
+                                         prefix "Date: ."))
                      (looking-at (concat "\\(" prefix ".+\n\\)*"
                                          prefix "From: .+\n"
                                          "\\(" prefix ".+\n\\)*"
@@ -269,8 +279,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))
@@ -282,9 +297,9 @@ following the containing message."
                (insert "\t"))
              (forward-line)))
          (goto-char (point-min))))
-    (setq n rmail-current-message)
-    (rmail-forget-messages)
-    (rmail-show-message n)
+    (let ((n rmail-current-message))
+      (rmail-forget-messages)
+      (rmail-show-message n))
     (if (rmail-summary-exists)
        (rmail-select-summary
         (rmail-update-summary)))))
@@ -292,4 +307,5 @@ following the containing message."
 
 (provide 'undigest)
 
+;;; arch-tag: 3a28b9fb-c1f5-43ef-9278-285f3e4b874d
 ;;; undigest.el ends here