Function: rmail-convert-to-babyl-format

rmail-convert-to-babyl-format is a byte-compiled function defined in rmailout.el.gz.

Signature

(rmail-convert-to-babyl-format)

Documentation

Convert the mbox message in the current buffer to Babyl format.

Source Code

;; Defined in /usr/src/emacs/lisp/mail/rmailout.el.gz
(defun rmail-convert-to-babyl-format ()
  "Convert the mbox message in the current buffer to Babyl format."
  (let (;; (count 0)
	(start (point-min))
	(case-fold-search nil)
	(buffer-undo-list t))
    (goto-char (point-min))
    (save-restriction
      (unless (looking-at "^From ")
	(error "Invalid mbox message"))
      (insert "\^L\n0,,\n*** EOOH ***\n")
      (rmail-nuke-pinhead-header)
      ;; Decode base64 or quoted printable contents, Rmail style.
      (let* ((header-end (save-excursion
			   (and (re-search-forward "\n\n" nil t)
				(1- (point)))))
	     (case-fold-search t)
	     (quoted-printable-header-field-end
	      (save-excursion
		(re-search-forward
		 "^content-transfer-encoding:\\(\n?[\t ]\\)*quoted-printable\\(\n?[\t ]\\)*"
		 header-end t)))
	     (base64-header-field-end
	      (and
	       ;; Don't decode non-text data.
	       (save-excursion
		 (re-search-forward
		  "^content-type:\\(\n?[\t ]\\)\\(text\\|message\\)/"
		  header-end t))
	       (save-excursion
		 (re-search-forward
		  "^content-transfer-encoding:\\(\n?[\t ]\\)*base64\\(\n?[\t ]\\)*"
		  header-end t)))))

	(goto-char (point-max))
	(if quoted-printable-header-field-end
	    (save-excursion
	      (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
	    (save-excursion
	      (when (condition-case nil
			(progn
			  (base64-decode-region
			   (1+ header-end)
			   (save-excursion
			     ;; Prevent base64-decode-region
			     ;; from removing newline characters.
			     (skip-chars-backward "\n\t ")
			     (point)))
			  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")))))
      ;; Transform anything within the message text
      ;; that might appear to be the end of a Babyl-format message.
      (save-excursion
	(save-restriction
	  (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)
      ;; Decode coding system, following specs in the message header,
      ;; and record what coding system was decoded.
      (if rmail-output-decode-coding
	  (let ((mime-charset
		 (if (save-excursion
		       (goto-char start)
		       (search-forward "\n\n" nil t)
		       (let ((case-fold-search t))
			 (re-search-backward
			  rmail-mime-charset-pattern
			  start t)))
		     (intern (downcase (match-string 1))))))
	    (rmail-decode-region start (point) mime-charset)))
      (save-excursion
	(goto-char start)
	(forward-line 3)
	(insert "X-Coding-System: "
		(symbol-name last-coding-system-used)
		"\n")))))