[Emacs-diffs] emacs/lisp/mail undigest.el

[Glenn Morris]

CVSROOT:        /sources/emacs
Module name:    emacs
Changes by:     Glenn Morris <gm>       09/02/06 03:58:20

Modified files:
        lisp/mail      : undigest.el 

Log message:
        (rmail-mail-separator): Delete.
        (undigestify-rmail-message, unforward-rmail-message): Update for mbox 
Rmail.

CVSWeb URLs:
http://cvs.savannah.gnu.org/viewcvs/emacs/lisp/mail/undigest.el?cvsroot=emacs&r1=1.47&r2=1.48

Patches:
Index: undigest.el
===================================================================
RCS file: /sources/emacs/emacs/lisp/mail/undigest.el,v
retrieving revision 1.47
retrieving revision 1.48
diff -u -b -r1.47 -r1.48
--- undigest.el 5 Jan 2009 03:22:38 -0000       1.47
+++ undigest.el 6 Feb 2009 03:58:20 -0000       1.48
@@ -1,7 +1,7 @@
 ;;; undigest.el --- digest-cracking support for the RMAIL mail reader
 
-;; Copyright (C) 1985, 1986, 1994, 1996, 2001, 2002, 2003, 2004,
-;;   2005, 2006, 2007, 2008, 2009 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
@@ -23,17 +23,13 @@
 
 ;;; Commentary:
 
-;; See Internet RFC 934 and RFC 1153
-;; Also limited support for MIME digest encapsulation
+;; See Internet RFC 934 and RFC 1153.
+;; Also limited support for MIME digest encapsulation.
 
 ;;; Code:
 
 (require 'rmail)
 
-(defconst rmail-mail-separator
-  "\^_\^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.
@@ -59,7 +55,7 @@
   (goto-char (point-min))
   (when (let ((head-end (progn (search-forward "\n\n" nil t) (point))))
          (goto-char (point-min))
-         (and head-end
+         (and head-end                 ; FIXME always true
               (re-search-forward
                (concat
                 "^Content-type: multipart/digest;"
@@ -158,78 +154,75 @@
   "Break up a digest message into its constituent messages.
 Leaves original message, deleted, before the undigestified messages."
   (interactive)
-  (with-current-buffer rmail-buffer
+  (set-buffer rmail-buffer)
+  (let ((buff (current-buffer))
+        (current rmail-current-message)
+       (msgbeg (rmail-msgbeg rmail-current-message))
+       (msgend (rmail-msgend rmail-current-message)))
+    (if (rmail-buffers-swapped-p) (set-buffer rmail-view-buffer))
     (widen)
     (let ((error t)
          (buffer-read-only nil))
-      (goto-char (rmail-msgend rmail-current-message))
-      (let ((msg-copy (buffer-substring (rmail-msgbeg rmail-current-message)
-                                       (rmail-msgend rmail-current-message))))
+      (goto-char msgend)
+      (let ((msg-copy (buffer-substring-no-properties msgbeg msgend)))
        (narrow-to-region (point) (point))
-       (insert msg-copy))
-      (narrow-to-region (point-min) (1- (point-max)))
+       (insert "\n" msg-copy))
+      (goto-char (point-min))
       (unwind-protect
          (progn
-           (save-restriction
-             (goto-char (point-min))
-             (delete-region (point-min)
-                            (progn (search-forward "\n*** EOOH ***\n" nil t)
-                                   (point)))
-             (insert "\n" rmail-mail-separator)
-             (narrow-to-region (point)
-                               (point-max))
              (let ((fill-prefix "")
                    (case-fold-search t)
-                   digest-name type start end separator fun-list sep-list)
+                 digest-name fun-list sep-list start end)
                (setq digest-name (mail-strip-quoted-names
                                   (save-restriction
                                     (search-forward "\n\n" nil 'move)
-                                    (setq start (point))
-                                    (narrow-to-region (point-min) start)
+                                  (narrow-to-region (point-min) (point))
                                     (or (mail-fetch-field "Reply-To")
                                         (mail-fetch-field "To")
                                         (mail-fetch-field "Apparently-To")
                                         (mail-fetch-field "From")))))
                (unless digest-name
                  (error "Message is not a digest--bad header"))
-
                (setq fun-list rmail-digest-methods)
                (while (and fun-list
                            (null (setq sep-list (funcall (car fun-list)))))
                  (setq fun-list (cdr fun-list)))
                (unless sep-list
                  (error "Message is not a digest--no messages found"))
-
-               ;;; Split the digest into separate rmail messages
+             ;; Split the digest into separate rmail messages.
                (while sep-list
-                 (let ((start (caar sep-list))
-                       (end (cdar sep-list)))
+               (setq start (caar sep-list)
+                     end (cdar sep-list))
                    (delete-region start end)
                    (goto-char start)
-                   (insert rmail-mail-separator)
                    (search-forward "\n\n" (caar (cdr sep-list)) 'move)
                    (save-restriction
                      (narrow-to-region end (point))
+                 (goto-char (point-min))
+                 (insert "\nFrom address@hidden  " (current-time-string) "\n")
+                 (save-excursion
+                   (forward-line -1)
+                   (rmail-add-mbox-headers))
                      (unless (mail-fetch-field "To")
-                       (goto-char start)
                        (insert "To: " digest-name "\n")))
                    (set-marker start nil)
-                   (set-marker end nil))
-                 (setq sep-list (cdr sep-list)))))
-
+               (set-marker end nil)
+               (setq sep-list (cdr sep-list))))
            (setq error nil)
            (message "Message successfully undigestified")
-           (let ((n rmail-current-message))
-             (rmail-forget-messages)
-             (rmail-show-message n)
+           (set-buffer buff)
+           (rmail-swap-buffers-maybe)
+           (goto-char (point-max))
+           (rmail-set-message-counters)
+           (set-buffer-modified-p t)
+           (rmail-show-message current)
              (rmail-delete-forward)
              (if (rmail-summary-exists)
-                 (rmail-select-summary
-                  (rmail-update-summary)))))
-       (cond (error
-              (narrow-to-region (point-min) (1+ (point-max)))
+               (rmail-select-summary (rmail-update-summary))))
+       (when error
               (delete-region (point-min) (point-max))
-              (rmail-show-message rmail-current-message)))))))
+         (set-buffer buff)
+         (rmail-show-message current))))))
 
 ;;;###autoload
 (defun unforward-rmail-message ()
@@ -237,21 +230,27 @@
 This puts the forwarded message into a separate rmail message
 following the containing message."
   (interactive)
-  ;; If we are in a summary buffer, switch to the Rmail buffer.
+  (set-buffer rmail-buffer)
+  (let ((buff (current-buffer))
+        (current rmail-current-message)
+        (beg (rmail-msgbeg rmail-current-message))
+        (msgend (rmail-msgend rmail-current-message))
+       (error t))
   (unwind-protect
-      (with-current-buffer rmail-buffer
-       (goto-char (point-min))
-       (narrow-to-region (point)
-                         (save-excursion (search-forward "\n\n") (point)))
-       (let ((buffer-read-only nil)
-             (old-fwd-from (mail-fetch-field "Forwarded-From" nil nil t))
+       (progn
+         (if (rmail-buffers-swapped-p) (set-buffer rmail-view-buffer))
+         (widen)
+         (goto-char beg)
+         (search-forward "\n\n" msgend)
+         (narrow-to-region beg (point))
+         (let ((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))
+               (buffer-read-only nil)
+               prefix forward-msg end)
+           (widen)
+           (narrow-to-region beg msgend)
          (cond ((re-search-forward rmail-forward-separator-regex nil t)
                 (forward-line 1)
                 (skip-chars-forward "\n")
@@ -283,10 +282,12 @@
                (t
                 (error "No forwarded message found")))
          (widen)
-         (goto-char (rmail-msgend rmail-current-message))
-         (narrow-to-region (point) (point))
-         (insert rmail-mail-separator)
-         (narrow-to-region (point) (point))
+           (goto-char msgend)
+           ;; Insert a fake From line.
+           ;; FIXME we could construct one using the From and Date headers
+           ;; of the forwarded message - is it worth it?
+           (insert "\n\nFrom address@hidden  " (current-time-string) "\n")
+           (setq beg (point))          ; start of header
          (while old-fwd-from
            (insert "Forwarded-From: " (car old-fwd-from) "\n")
            (insert "Forwarded-Date: " (car old-fwd-date) "\n")
@@ -294,24 +295,31 @@
            (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))
-           (re-search-forward "\n$" nil 'move)
-           (narrow-to-region (point-min) (point))
+           (insert forward-msg "\n")
+           (goto-char beg)
+           (re-search-forward "\n$" nil 'move) ; end of header
+           (narrow-to-region beg (point))
            (goto-char (point-min))
            (while (not (eobp))
              (unless (looking-at "^[a-zA-Z-]+: ")
                (insert "\t"))
-             (forward-line)))
-         (goto-char (point-min))))
-    (let ((n rmail-current-message))
-      (rmail-forget-messages)
-      (rmail-show-message n))
+             (forward-line))
+           (widen)
+           (goto-char beg)
+           (forward-line -1)
+           (rmail-add-mbox-headers))           ; marks as unseen
+         (setq error nil)
+         (set-buffer buff)
+         (rmail-swap-buffers-maybe)
+         (goto-char (point-max))
+         (rmail-set-message-counters)
+         (set-buffer-modified-p t)
+         (rmail-show-message current)
     (if (rmail-summary-exists)
-       (rmail-select-summary
-        (rmail-update-summary)))))
-
+             (rmail-select-summary (rmail-update-summary))))
+      (when error
+       (set-buffer buff)
+       (rmail-show-message current)))))
 
 (provide 'undigest)