# HG changeset patch # User Richard M. Stallman # Date 1096766420 0 # Node ID ef41980f158891165be25b27c7c63ed54ed5883c # Parent 2d300e7c0f8da58bb6077152b89488de9d5f69c8 Mostly rewritten. Parses the file directly and converts. (batch-convert-babyl, convert-babyl-file, decode-babyl-file) (decode-babyl): New functions. (unrmail, batch-unrmail): Now aliases. diff -r 2d300e7c0f8d -r ef41980f1588 lisp/mail/unrmail.el --- a/lisp/mail/unrmail.el Mon Sep 27 23:09:05 2004 +0000 +++ b/lisp/mail/unrmail.el Sun Oct 03 01:20:20 2004 +0000 @@ -1,6 +1,6 @@ ;;; unrmail.el --- convert Rmail files to mailbox files -;;; Copyright (C) 1992, 2002 Free Software Foundation, Inc. +;;; Copyright (C) 1992, 2002, 2004 Free Software Foundation, Inc. ;; Maintainer: FSF ;; Keywords: mail @@ -29,10 +29,10 @@ (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 +(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,134 +48,203 @@ (kill-emacs (if error 1 0)))) ;;;###autoload -(defun unrmail (file to-file) - "Convert Rmail file FILE to system inbox format file TO-FILE." +(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): ") - (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))) + (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))) - (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))) + ;; 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 ?-))) -(defun unrmail-unprune () - (let* ((pruned - (save-excursion - (goto-char (point-min)) - (forward-line 1) - (= (following-char) ?1)))) - (if pruned - (progn + ;; 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)) - (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)))))) + (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