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

[Miles Bader]

Index: emacs/lisp/mail/unrmail.el
diff -c emacs/lisp/mail/unrmail.el:1.13.6.1 emacs/lisp/mail/unrmail.el:1.13.6.2
*** emacs/lisp/mail/unrmail.el:1.13.6.1 Fri Apr 16 12:50:31 2004
--- emacs/lisp/mail/unrmail.el  Mon Jun 28 07:29:48 2004
***************
*** 51,93 ****
  (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)
--- 51,121 ----
  (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): ")
!   (with-temp-buffer
!     ;; Read in the old Rmail file with no decoding.
!     (let ((coding-system-for-read 'raw-text))
!       (insert-file-contents file))
!     ;; But make it multibyte.
!     (set-buffer-multibyte t)
! 
!     (if (not (looking-at "BABYL OPTIONS"))
!       (error "This file is not in Babyl format"))
! 
!     ;; Decode the file contents just as Rmail did.
!     (let ((modifiedp (buffer-modified-p))
!         (coding-system rmail-file-coding-system)
!         from to)
!       (goto-char (point-min))
!       (search-forward "\n\^_" nil t)  ; Skip BABYL header.
!       (setq from (point))
!       (goto-char (point-max))
!       (search-backward "\n\^_" from 'mv)
!       (setq to (point))
!       (unless (and coding-system
!                  (coding-system-p coding-system))
!       (setq coding-system
!             ;; Emacs 21.1 and later writes RMAIL files in emacs-mule, but
!             ;; earlier versions did that with the current buffer's encoding.
!             ;; So we want to favor detection of emacs-mule (whose normal
!             ;; priority is quite low), but still allow detection of other
!             ;; encodings if emacs-mule won't fit.  The call to
!             ;; detect-coding-with-priority below achieves that.
!             (car (detect-coding-with-priority
!                   from to
!                   '((coding-category-emacs-mule . emacs-mule))))))
!       (unless (memq coding-system
!                   '(undecided undecided-unix))
!       (set-buffer-modified-p t)       ; avoid locking when decoding
!       (let ((buffer-undo-list t))
!         (decode-coding-region from to coding-system))
!       (setq coding-system last-coding-system-used))
! 
!       (setq buffer-file-coding-system nil)
! 
!       ;; We currently don't use this value, but maybe we should.
!       (setq save-buffer-coding-system
!           (or coding-system 'undecided)))
! 
      ;; 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)
!     (goto-char (point-min))
! 
!     (let ((temp-buffer (get-buffer-create " unrmail"))
!         (from-buffer (current-buffer)))
! 
!       ;; Process the messages one by one.
!       (while (search-forward "\^_\^l" nil t)
!       (let ((beg (point))
!             (end (save-excursion
!                    (if (search-forward "\^_" nil t)
!                        (1- (point)) (point-max))))
!             (coding 'raw-text)
              label-line attrs keywords
!             mail-from reformatted)
          (with-current-buffer temp-buffer
            (setq buffer-undo-list t)
            (erase-buffer)
***************
*** 95,105 ****
            (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
--- 123,137 ----
            (insert-buffer-substring from-buffer beg end)
            (goto-char (point-min))
            (forward-line 1)
+           ;; Record whether the header is reformatted.
+           (setq reformatted (= (following-char) ?1))
+ 
+           ;; Collect the label line, then get the attributes
+           ;; and the keywords from it.
            (setq label-line
                  (buffer-substring (point)
!                                   (save-excursion (forward-line 1)
!                                                   (point))))
            (search-forward ",,")
            (unless (eolp)
              (setq keywords
***************
*** 118,126 ****
                   (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"))
--- 150,210 ----
                   (if (string-match ", resent," label-line) ?R ?-)
                   (if (string-match ", unseen," label-line) ?\  ?-)
                   (if (string-match ", stored," label-line) ?S ?-)))
! 
!           ;; Delete the special Babyl lines at the start,
!           ;; and the ***EOOH*** line, and the reformatted header if any.
!           (goto-char (point-min))
!           (if reformatted
!               (progn
!                 (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))))
!             ;; Not reformatted.  Delete the special
!             ;; lines before the real header.
!             (re-search-forward "^[*][*][*] EOOH [*][*][*]\n")
!             (delete-region (point-min) (point)))
! 
!           ;; Some operations on the message header itself.
            (goto-char (point-min))
+           (save-restriction
+             (narrow-to-region 
+              (point-min)
+              (save-excursion (search-forward "\n\n" nil 'move) (point)))
+ 
+             ;; Fetch or construct what we should use in the `From ' line.
+             (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))))
+ 
+             ;; If the message specifies a coding system, use it.
+             (let ((maybe-coding (mail-fetch-field "X-Coding-System")))
+               (if maybe-coding
+                   (setq coding (intern maybe-coding))))
+ 
+             ;; Delete the Mail-From: header field if any.
+             (when (re-search-forward "^Mail-from:" nil t)
+               (beginning-of-line)
+               (delete-region (point)
+                              (progn (forward-line 1) (point)))))
+ 
+           (goto-char (point-min))
+           ;; Insert the `From ' line.
            (insert mail-from "\n")
+           ;; Record the keywords and attributes in our special way.
            (insert "X-BABYL-V6-ATTRIBUTES: " (apply 'string attrs) "\n")
            (when keywords
              (insert "X-BABYL-V6-KEYWORDS: " keywords "\n"))
***************
*** 132,174 ****
              (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
--- 216,227 ----
              (while (search-forward "\nFrom " nil t)
                (forward-char -5)
                (insert ?>)))
+           ;; Write it to the output file.
            (write-region (point-min) (point-max) to-file t
!                         'nomsg))))
!       (kill-buffer temp-buffer))
      (message "Writing messages to %s...done" to-file)))
  
  (provide 'unrmail)
  
  ;;; unrmail.el ends here