[Emacs-diffs] Changes to emacs/lisp/mail/unrmail.el

[Paul Michael Reilly]

Index: emacs/lisp/mail/unrmail.el
diff -c emacs/lisp/mail/unrmail.el:1.12 emacs/lisp/mail/unrmail.el:1.13
*** emacs/lisp/mail/unrmail.el:1.12     Mon Aug  6 05:45:50 2001
--- emacs/lisp/mail/unrmail.el  Thu Sep 26 18:02:23 2002
***************
*** 1,6 ****
  ;;; unrmail.el --- convert Rmail files to mailbox files
  
! ;;; Copyright (C) 1992 Free Software Foundation, Inc.
  
  ;; Maintainer: FSF
  ;; Keywords: mail
--- 1,6 ----
  ;;; unrmail.el --- convert Rmail files to mailbox files
  
! ;;; Copyright (C) 1992, 2002 Free Software Foundation, Inc.
  
  ;; Maintainer: FSF
  ;; Keywords: mail
***************
*** 51,71 ****
  (defun unrmail (file to-file)
    "Convert Rmail file FILE to system inbox format file TO-FILE."
    (interactive "fUnrmail (rmail file): \nFUnrmail into (new mailbox file): ")
!   (let ((message-count 0)
        ;; Prevent rmail from making, or switching to, a summary buffer.
        (rmail-display-summary nil)
!       (rmail-delete-after-output nil))
      (rmail file)
      ;; Default the directory of TO-FILE based on where FILE is.
      (setq to-file (expand-file-name to-file default-directory))
      (message "Writing messages to %s..." to-file)
!     (while (< message-count rmail-total-messages)
!       (rmail-show-message
!        (setq message-count (1+ message-count)))
!       (rmail-toggle-header)
!       (rmail-output to-file 1 t))
      (message "Writing messages to %s...done" to-file)))
  
  (provide 'unrmail)
  
  ;;; unrmail.el ends here
--- 51,175 ----
  (defun unrmail (file to-file)
    "Convert Rmail file FILE to system inbox format file TO-FILE."
    (interactive "fUnrmail (rmail file): \nFUnrmail into (new mailbox file): ")
!   (let ((message-count 1)
        ;; Prevent rmail from making, or switching to, a summary buffer.
        (rmail-display-summary nil)
!       (rmail-delete-after-output nil)
!       (temp-buffer (get-buffer-create " unrmail")))
      (rmail file)
      ;; Default the directory of TO-FILE based on where FILE is.
      (setq to-file (expand-file-name to-file default-directory))
+     (condition-case ()
+       (delete-file to-file)
+       (file-error nil))
      (message "Writing messages to %s..." to-file)
!     (save-restriction
!       (widen)
!       (while (<= message-count rmail-total-messages)
!       (let ((beg (rmail-msgbeg message-count))
!             (end (rmail-msgbeg (1+ message-count)))
!             (from-buffer (current-buffer))
!             (coding (or rmail-file-coding-system 'raw-text))
!             label-line attrs keywords
!             header-beginning mail-from)
!         (save-excursion
!           (goto-char (rmail-msgbeg message-count))
!           (setq header-beginning (point))
!           (search-forward "\n*** EOOH ***\n")
!           (forward-line -1)
!           (search-forward "\n\n")
!           (save-restriction
!             (narrow-to-region header-beginning (point))
!             (setq mail-from
!                   (or (mail-fetch-field "Mail-From")
!                       (concat "From "
!                               (mail-strip-quoted-names (or (mail-fetch-field 
"from")
!                                                            (mail-fetch-field 
"really-from")
!                                                            (mail-fetch-field 
"sender")
!                                                            "unknown"))
!                               " " (current-time-string))))))
!         (with-current-buffer temp-buffer
!           (setq buffer-undo-list t)
!           (erase-buffer)
!           (setq buffer-file-coding-system coding)
!           (insert-buffer-substring from-buffer beg end)
!           (goto-char (point-min))
!           (forward-line 1)
!           (setq label-line
!                 (buffer-substring (point)
!                                   (progn (forward-line 1)
!                                          (point))))
!           (forward-line -1)
!           (search-forward ",,")
!           (unless (eolp)
!             (setq keywords
!                   (buffer-substring (point)
!                                     (progn (end-of-line)
!                                            (1- (point)))))
!             (setq keywords
!                   (replace-regexp-in-string ", " "," keywords)))
! 
!           (setq attrs
!                 (list
!                  (if (string-match ", answered," label-line) ?A ?-)
!                  (if (string-match ", deleted," label-line) ?D ?-)
!                  (if (string-match ", edited," label-line) ?E ?-)
!                  (if (string-match ", filed," label-line) ?F ?-)
!                  (if (string-match ", resent," label-line) ?R ?-)
!                  (if (string-match ", unseen," label-line) ?\  ?-)
!                  (if (string-match ", stored," label-line) ?S ?-)))
!           (unrmail-unprune)
!           (goto-char (point-min))
!           (insert mail-from "\n")
!           (insert "X-BABYL-V6-ATTRIBUTES: " (apply 'string attrs) "\n")
!           (when keywords
!             (insert "X-BABYL-V6-KEYWORDS: " keywords "\n"))
!           (goto-char (point-min))
!           ;; ``Quote'' "\nFrom " as "\n>From "
!           ;;  (note that this isn't really quoting, as there is no requirement
!           ;;   that "\n[>]+From " be quoted in the same transparent way.)
!           (let ((case-fold-search nil))
!             (while (search-forward "\nFrom " nil t)
!               (forward-char -5)
!               (insert ?>)))
!           (write-region (point-min) (point-max) to-file t
!                         'nomsg)))
!       (setq message-count (1+ message-count))))
      (message "Writing messages to %s...done" to-file)))
  
+ (defun unrmail-unprune ()
+   (let* ((pruned
+         (save-excursion
+           (goto-char (point-min))
+           (forward-line 1)
+           (= (following-char) ?1))))
+     (if pruned
+       (progn
+         (goto-char (point-min))
+         (forward-line 2)
+         ;; Delete Summary-Line headers.
+         (let ((case-fold-search t))
+           (while (looking-at "Summary-Line:")
+             (forward-line 1)))
+         (delete-region (point-min) (point))
+         ;; Delete the old reformatted header.
+         (re-search-forward "^[*][*][*] EOOH [*][*][*]\n")
+         (forward-line -1)
+         (let ((start (point)))
+           (search-forward "\n\n")
+           (delete-region start (point))))
+       ;; Delete everything up to the real header.
+       (goto-char (point-min))
+       (re-search-forward "^[*][*][*] EOOH [*][*][*]\n")
+       (delete-region (point-min) (point)))
+     (goto-char (point-min))
+     (when (re-search-forward "^Mail-from:")
+       (beginning-of-line)
+       (delete-region (point)
+                    (progn (forward-line 1) (point))))))
+ 
+ 
  (provide 'unrmail)
  
  ;;; unrmail.el ends here
+