From 6740652e6d63701107312f7dd1efcc623c4b38fc Mon Sep 17 00:00:00 2001 From: "Richard M. Stallman" Date: Mon, 10 May 2004 16:24:26 +0000 Subject: [PATCH] (unrmail): Mostly rewritten. Parses the file directly, without calling any functions in Rmail. (unrmail-unprune): Function deleted. --- lisp/mail/unrmail.el | 189 +++++++++++++++++++++++++++---------------- 1 file changed, 121 insertions(+), 68 deletions(-) diff --git a/lisp/mail/unrmail.el b/lisp/mail/unrmail.el index 55f611b53ad..db6990d625b 100644 --- a/lisp/mail/unrmail.el +++ b/lisp/mail/unrmail.el @@ -51,43 +51,71 @@ For example, invoke `emacs -batch -f batch-unrmail RMAIL'." (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) + (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) - (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)) + (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 - 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)))))) + mail-from reformatted) (with-current-buffer temp-buffer (setq buffer-undo-list t) (erase-buffer) @@ -95,11 +123,15 @@ For example, invoke `emacs -batch -f batch-unrmail RMAIL'." (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) - (progn (forward-line 1) - (point)))) - (forward-line -1) + (save-excursion (forward-line 1) + (point)))) (search-forward ",,") (unless (eolp) (setq keywords @@ -118,9 +150,61 @@ For example, invoke `emacs -batch -f batch-unrmail RMAIL'." (if (string-match ", resent," label-line) ?R ?-) (if (string-match ", unseen," label-line) ?\ ?-) (if (string-match ", stored," label-line) ?S ?-))) - (unrmail-unprune) + + ;; 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,43 +216,12 @@ For example, invoke `emacs -batch -f batch-unrmail RMAIL'." (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))) - (setq message-count (1+ message-count)))) + 'nomsg)))) + (kill-buffer temp-buffer)) (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 -- 2.39.2