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

[Richard M . Stallman]

Index: emacs/lisp/mail/unrmail.el
diff -c emacs/lisp/mail/unrmail.el:1.13.2.1 emacs/lisp/mail/unrmail.el:1.13.2.2
*** emacs/lisp/mail/unrmail.el:1.13.2.1 Sat Feb 15 17:16:29 2003
--- emacs/lisp/mail/unrmail.el  Sun Oct  3 01:20:20 2004
***************
*** 1,6 ****
  ;;; unrmail.el --- convert Rmail files to mailbox files
  
! ;;; Copyright (C) 1992, 2002 Free Software Foundation, Inc.
  
  ;; Maintainer: FSF
  ;; Keywords: mail
--- 1,6 ----
  ;;; unrmail.el --- convert Rmail files to mailbox files
  
! ;;; Copyright (C) 1992, 2002, 2004 Free Software Foundation, Inc.
  
  ;; Maintainer: FSF
  ;; Keywords: mail
***************
*** 29,38 ****
  (defvar command-line-args-left)       ;Avoid 'free variable' warning
  
  ;;;###autoload
! (defun batch-unrmail ()
!   "Convert Rmail files to system inbox format.
! Specify the input Rmail file names as command line arguments.
! For each Rmail file, the corresponding output file name
  is made by adding `.mail' at the end.
  For example, invoke `emacs -batch -f batch-unrmail RMAIL'."
    ;; command-line-args-left is what is left of the command line (from 
startup.el)
--- 29,38 ----
  (defvar command-line-args-left)       ;Avoid 'free variable' warning
  
  ;;;###autoload
! (defun batch-convert-babyl ()
!   "Convert Babyl files (old Rmail file) to system inbox format.
! Specify the input Babyl file names as command line arguments.
! For each Babyl file, the corresponding output file name
  is made by adding `.mail' at the end.
  For example, invoke `emacs -batch -f batch-unrmail RMAIL'."
    ;; command-line-args-left is what is left of the command line (from 
startup.el)
***************
*** 48,181 ****
      (kill-emacs (if error 1 0))))
  
  ;;;###autoload
! (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)
!     (if (save-restriction
!         (save-excursion
!           (widen)
!           (goto-char (point-min))
!           (not (looking-at "BABYL OPTIONS"))))
!       (write-region (point-min) (point-max) to-file t 'nomsg)
!       (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
  
--- 48,250 ----
      (kill-emacs (if error 1 0))))
  
  ;;;###autoload
! (defalias 'batch-unrmail 'batch-convert-babyl)
! 
! ;;;###autoload
! (defun convert-babyl-file (file to-file)
!   "Convert Babyl (old Rmail) file FILE to system inbox format file TO-FILE."
    (interactive "fUnrmail (rmail file): \nFUnrmail into (new mailbox file): ")
!   (with-temp-buffer
!     (decode-babyl-file file)
!     ;; Write it to the output file.
!     ;; Since the file may contain messages of different encodings
!     ;; at the tail (non-BYBYL part), we can't decode them at once
!     ;; on reading.  So, at first, we read the file without text
!     ;; code conversion, then decode the messages one by one by
!     ;; rmail-decode-babyl-format or
!     ;; rmail-convert-to-babyl-format.
!     (let ((coding-system-for-write 'raw-text))
!       (write-region (point-min) (point-max) to-file nil
!                   'nomsg))))
! 
! ;;;###autoload
! (defalias 'unrmail 'convert-babyl-file)
! 
! ;;;###autoload
! (defun decode-babyl-file (file)
!   "Convert Babyl file FILE to system inbox format in current buffer."
!   (interactive "fUnrmail (rmail file): ")
!   ;; Read in the Babyl file with no decoding.
!   (let ((thisbuf (current-buffer)))
!     (with-temp-buffer
!       (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 "File %s not in Babyl format"))
! 
!       (decode-babyl thisbuf))))
! 
! ;;;###autoload
! (defun decode-babyl (outbuf)
!   "Convert Babyl data in current bufer to inbox format and store in OUTBUF."
!   ;; 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)))
! 
!   (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)
!         (setq buffer-file-coding-system coding)
!         (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
!                 (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 ?-)))
! 
!         ;; 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"))
+         (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 it to the original buffer.
+         (append-to-buffer thisbuf (point-min) (point-max)))))
+     (kill-buffer temp-buffer)))
  
  (provide 'unrmail)
  
  ;;; unrmail.el ends here
  
+ ;;; arch-tag: 14c6290d-60b2-456f-8909-5c2387de6acb