;;; rfc2047.el --- functions for encoding and decoding rfc2047 messages
-;; Copyright (C) 1998, 1999, 2000, 2002, 2003 Free Software Foundation, Inc.
+
+;; Copyright (C) 1998, 1999, 2000, 2002, 2003, 2004,
+;; 2005, 2006 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; MORIOKA Tomohiko <morioka@jaist.ac.jp>
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
;;; Commentary:
(eval-when-compile
(require 'cl)
- (defvar message-posting-charset)
- (unless (fboundp 'with-syntax-table) ; not in Emacs 20
- (defmacro with-syntax-table (table &rest body)
- "Evaluate BODY with syntax table of current buffer set to TABLE.
-The syntax table of the current buffer is saved, BODY is evaluated, and the
-saved table is restored, even in case of an abnormal exit.
-Value is what BODY returns."
- (let ((old-table (make-symbol "table"))
- (old-buffer (make-symbol "buffer")))
- `(let ((,old-table (syntax-table))
- (,old-buffer (current-buffer)))
- (unwind-protect
- (progn
- (set-syntax-table ,table)
- ,@body)
- (save-current-buffer
- (set-buffer ,old-buffer)
- (set-syntax-table ,old-table))))))))
+ (defvar message-posting-charset))
(require 'qp)
(require 'mm-util)
+(require 'ietf-drums)
;; Fixme: Avoid this (used for mail-parse-charset) mm dependence on gnus.
(require 'mail-prsvr)
(require 'base64)
(autoload 'mm-body-7-or-8 "mm-bodies")
-(eval-and-compile
- ;; Avoid gnus-util for mm- code.
- (defalias 'rfc2047-point-at-bol
- (if (fboundp 'point-at-bol)
- 'point-at-bol
- 'line-beginning-position))
-
- (defalias 'rfc2047-point-at-eol
- (if (fboundp 'point-at-eol)
- 'point-at-eol
- 'line-end-position)))
-
(defvar rfc2047-header-encoding-alist
'(("Newsgroups" . nil)
("Followup-To" . nil)
("Message-ID" . nil)
- ("\\(Resent-\\)?\\(From\\|Cc\\|To\\|Bcc\\|Reply-To\\|Sender\\)" .
- address-mime)
+ ("\\(Resent-\\)?\\(From\\|Cc\\|To\\|Bcc\\|\\(In-\\)?Reply-To\\|Sender\
+\\|Mail-Followup-To\\|Mail-Copies-To\\|Approved\\)" . address-mime)
(t . mime))
"*Header/encoding method alist.
The list is traversed sequentially. The keys can either be
(cn-gb-2312 . B)
(euc-kr . B)
(iso-2022-jp-2 . B)
- (iso-2022-int-1 . B))
+ (iso-2022-int-1 . B)
+ (viscii . Q))
"Alist of MIME charsets to RFC2047 encodings.
Valid encodings are nil, `Q' and `B'. These indicate binary (no) encoding,
quoted-printable and base64 respectively.")
-(defvar rfc2047-encoding-function-alist
- '((Q . rfc2047-q-encode-region)
- (B . rfc2047-b-encode-region)
- (nil . ignore))
+(defvar rfc2047-encode-function-alist
+ '((Q . rfc2047-q-encode-string)
+ (B . rfc2047-b-encode-string)
+ (nil . identity))
"Alist of RFC2047 encodings to encoding functions.")
+(defvar rfc2047-encode-encoded-words t
+ "Whether encoded words should be encoded again.")
+
;;;
;;; Functions for encoding RFC2047 messages
;;;
+(defun rfc2047-qp-or-base64 ()
+ "Return the type with which to encode the buffer.
+This is either `base64' or `quoted-printable'."
+ (save-excursion
+ (let ((limit (min (point-max) (+ 2000 (point-min))))
+ (n8bit 0))
+ (goto-char (point-min))
+ (skip-chars-forward "\x20-\x7f\r\n\t" limit)
+ (while (< (point) limit)
+ (incf n8bit)
+ (forward-char 1)
+ (skip-chars-forward "\x20-\x7f\r\n\t" limit))
+ (if (or (< (* 6 n8bit) (- limit (point-min)))
+ ;; Don't base64, say, a short line with a single
+ ;; non-ASCII char when splitting parts by charset.
+ (= n8bit 1))
+ 'quoted-printable
+ &nb