Commit 7635ef38 authored by Chong Yidong's avatar Chong Yidong

(pmail-output-to-babyl-file): Rewrite, assuming mbox

internal format.
(pmail-convert-to-babyl-format, pmail-nuke-pinhead-header): New
functions, moved from pmail.el.
parent f047d0db
......@@ -171,79 +171,234 @@ Note: it means the file has no messages in it.\n\^_"))
(if (pmail-message-deleted-p pmail-current-message)
(progn (setq redelete t)
(pmail-set-attribute pmail-deleted-attr-index nil)))
;; Decide whether to append to a file or to an Emacs buffer.
(let ((buf (find-buffer-visiting file-name))
(cur (current-buffer))
(beg (1+ (pmail-msgbeg pmail-current-message)))
(end (1+ (pmail-msgend pmail-current-message)))
(or pmail-file-coding-system
(if (not buf)
;; Output to a file.
(if pmail-fields-not-to-output
;; Delete some fields while we output.
(let ((obuf (current-buffer)))
(set-buffer (get-buffer-create " pmail-out-temp"))
(insert-buffer-substring obuf beg end)
(append-to-file (point-min) (point-max) file-name)
(set-buffer obuf)
(kill-buffer (get-buffer " pmail-out-temp")))
(append-to-file beg end file-name))
(if (eq buf (current-buffer))
(error "Can't output message to same file it's already in"))
;; File has been visited, in buffer BUF.
(set-buffer buf)
(let ((buffer-read-only nil)
(msg (and (boundp 'pmail-current-message)
;; If MSG is non-nil, buffer is in PMAIL mode.
(if msg
;; Turn on auto save mode, if it's off in this
;; buffer but enabled by default.
(and (not buffer-auto-save-file-name)
(auto-save-mode t))
(narrow-to-region (point-max) (point-max))
(insert-buffer-substring cur beg end)
(goto-char (point-min))
(search-backward "\n\^_")
(narrow-to-region (point) (point-max))
(pmail-count-new-messages t)
(if (pmail-summary-exists)
(pmail-show-message msg))
;; Output file not in pmail mode => just insert at the end.
(narrow-to-region (point-min) (1+ (buffer-size)))
(goto-char (point-max))
(insert-buffer-substring cur beg end)
(let ((coding-system-for-write
(or pmail-file-coding-system
cur beg end)
(setq cur (current-buffer))
(setq beg (pmail-msgbeg pmail-current-message)
end (pmail-msgend pmail-current-message))
;; Output to a file.
(set-buffer (get-buffer-create " pmail-out-temp"))
(insert-buffer-substring cur beg end)
(if pmail-fields-not-to-output
;; Convert to Babyl format.
(append-to-file (point-min) (point-max) file-name)
(set-buffer cur)
(kill-buffer (get-buffer " pmail-out-temp")))))
(pmail-set-attribute pmail-filed-attr-index t))
(if redelete (pmail-set-attribute pmail-deleted-attr-index t))))
(setq count (1- count))
(if pmail-delete-after-output
(if (and (= count 0) stay)
(unless (if (and (= count 0) stay)
(setq count 0))
(if (> count 0)
(if (not stay) (pmail-next-undeleted-message 1))
(setq count 0)))))))
(unless (if (not stay)
(pmail-next-undeleted-message 1))
(setq count 0))))))
(defalias 'pmail-output-to-pmail-file 'pmail-output-to-babyl-file)
(defun pmail-convert-to-babyl-format ()
(let ((count 0) start
(case-fold-search nil)
(buffer-undo-list t))
(goto-char (point-min))
(while (not (eobp))
(setq start (point))
(unless (looking-at "^From ")
(error "Invalid mbox message"))
(insert "\^L\n0, unseen,,\n*** EOOH ***\n")
;; If this message has a Content-Length field,
;; skip to the end of the contents.
(let* ((header-end (save-excursion
(and (re-search-forward "\n\n" nil t)
(1- (point)))))
(case-fold-search t)
"^content-transfer-encoding:\\(\n?[\t ]\\)*quoted-printable\\(\n?[\t ]\\)*"
header-end t)))
;; Don't decode non-text data.
"^content-type:\\(\n?[\t ]\\)\\(text\\|message\\)/"
header-end t))
"^content-transfer-encoding:\\(\n?[\t ]\\)*base64\\(\n?[\t ]\\)*"
header-end t))))
;; Get the numeric value from the Content-Length field.
;; Back up to end of prev line,
;; in case the Content-Length field comes first.
(forward-char -1)
(and (search-forward "\ncontent-length: "
header-end t)
(let ((beg (point))
(eol (progn (end-of-line) (point))))
(string-to-number (buffer-substring beg eol)))))))
(and size
(if (and (natnump size)
(<= (+ header-end size) (point-max))
;; Make sure this would put us at a position
;; that we could continue from.
(goto-char (+ header-end size))
(skip-chars-forward "\n")
(or (eobp)
(and (looking-at "BABYL OPTIONS:")
(search-forward "\n\^_" nil t))
(and (looking-at "\^L")
(search-forward "\n\^_" nil t))
(let ((case-fold-search t))
(looking-at pmail-mmdf-delim1))
(looking-at "From "))))
(goto-char (+ header-end size))
(message "Ignoring invalid Content-Length field")
(sit-for 1 0 t)))
(if (let ((case-fold-search nil))
(concat "^[\^_]?\\("
pmail-mmdf-delim1 "\\|"
"\^L\n[01],\\)") nil t))
(goto-char (match-beginning 1))
(goto-char (point-max)))
(setq count (1+ count))
(if quoted-printable-header-field-end
(unless (mail-unquote-printable-region
header-end (point) nil t t)
(message "Malformed MIME quoted-printable message"))
;; Change "quoted-printable" to "8bit",
;; to reflect the decoding we just did.
(goto-char quoted-printable-header-field-end)
(delete-region (point) (search-backward ":"))
(insert ": 8bit")))
(if base64-header-field-end
(when (condition-case nil
(1+ header-end)
;; Prevent base64-decode-region
;; from removing newline characters.
(skip-chars-backward "\n\t ")
(error nil))
;; Change "base64" to "8bit", to reflect the
;; decoding we just did.
(goto-char base64-header-field-end)
(delete-region (point) (search-backward ":"))
(insert ": 8bit")))))
(narrow-to-region start (point))
(goto-char (point-min))
(while (search-forward "\n\^_" nil t) ; single char
(replace-match "\n^_")))) ; 2 chars: "^" and "_"
;; This is for malformed messages that don't end in newline.
;; There shouldn't be any, but some users say occasionally
;; there are some.
(or (bolp) (newline))
(insert ?\^_)
(setq last-coding-system-used nil)
(or pmail-enable-mime
(not pmail-enable-multibyte)
(let ((mime-charset
(if (and pmail-decode-mime-charset
(goto-char start)
(search-forward "\n\n" nil t)
(let ((case-fold-search t))
start t))))
(intern (downcase (match-string 1))))))
(pmail-decode-region start (point) mime-charset)))
(goto-char start)
(forward-line 3)
(insert "X-Coding-System: "
(symbol-name last-coding-system-used)
(narrow-to-region (point) (point-max))
(and (= 0 (% count 10))
(message "Converting to Babyl format...%d" count))))))
;; Delete the "From ..." line, creating various other headers with
;; information from it if they don't already exist. Now puts the
;; original line into a mail-from: header line for debugging and for
;; use by the pmail-output function.
(defun pmail-nuke-pinhead-header ()
(let ((start (point))
(end (progn
(condition-case ()
(search-forward "\n\n")
(goto-char (point-max))
(insert "\n\n")))
has-from has-date)
(narrow-to-region start end)
(let ((case-fold-search t))
(goto-char start)
(setq has-from (search-forward "\nFrom:" nil t))
(goto-char start)
(setq has-date (and (search-forward "\nDate:" nil t) (point)))
(goto-char start))
(let ((case-fold-search nil))
(if (re-search-forward (concat "^" pmail-unix-mail-delimiter) nil t)
"Mail-from: \\&"
;; Keep and reformat the date if we don't
;; have a Date: field.
(if has-date
"Date: \\2, \\4 \\3 \\9 \\5 "
;; The timezone could be matched by group 7 or group 10.
;; If neither of them matched, assume EST, since only
;; Easterners would be so sloppy.
;; It's a shame the substitution can't use "\\10".
((/= (match-beginning 7) (match-end 7)) "\\7")
((/= (match-beginning 10) (match-end 10))
(buffer-substring (match-beginning 10)
(match-end 10)))
(t "EST"))
;; Keep and reformat the sender if we don't
;; have a From: field.
(if has-from
"From: \\1\n"))
(defcustom pmail-fields-not-to-output nil
"*Regexp describing fields to exclude when outputting a message to a file."
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment