(unrmail): Mostly rewritten. Parses the file
directly, without calling any functions in Rmail. (unrmail-unprune): Function deleted.
This commit is contained in:
Richard M. Stallman
parent
b82a6ae78c
commit
6740652e6d
1 changed files with 121 additions and 68 deletions
|
|
@ -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
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue