;;; rfc2047.el --- functions for encoding and decoding rfc2047 messages
-;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004,
-;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
+;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006,
+;; 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; MORIOKA Tomohiko <morioka@jaist.ac.jp>
(require 'cl))
(defvar message-posting-charset)
-(require 'qp)
(require 'mm-util)
(require 'ietf-drums)
;; Fixme: Avoid this (used for mail-parse-charset) mm dependence on gnus.
(rfc2047-encode-region (point) (point-max))))
((eq method 'default)
(if (and (featurep 'mule)
- (if (boundp 'default-enable-multibyte-characters)
- default-enable-multibyte-characters)
+ (if (boundp 'enable-multibyte-characters)
+ (default-value 'enable-multibyte-characters))
mail-parse-charset)
(mm-encode-coding-region (point) (point-max)
mail-parse-charset)))
;; 8-bit names. The group name mail copy just got
;; unconditionally encoded. Previously, it would ask
;; whether to encode, which was quite confusing for the
- ;; user. If the new behaviour is wrong, tell me. I have
+ ;; user. If the new behavior is wrong, tell me. I have
;; left the old code commented out below.
;; -- Per Abrahamsen <abraham@dina.kvl.dk> Date: 2001-10-07.
;; Modified by Dave Love, with the commented-out code changed
;;; (error "Cannot send unencoded text")))
((mm-coding-system-p method)
(if (or (and (featurep 'mule)
- (if (boundp 'default-enable-multibyte-characters)
- default-enable-multibyte-characters))
+ (if (boundp 'enable-multibyte-characters)
+ (default-value 'enable-multibyte-characters)))
(featurep 'file-coding))
(mm-encode-coding-region (point) (point-max) method)))
;; Hm.
;; since encoded words can't occur in quotes.
(progn
(goto-char end)
- (delete-backward-char 1)
+ (delete-char -1)
(goto-char start)
(delete-char 1)
(when last-encoded
Point moves to the end of the region."
(let ((mime-charset (or (mm-find-mime-charset-region b e) (list 'us-ascii)))
cs encoding tail crest eword)
+ ;; Use utf-8 as a last resort if determining charset of text fails.
+ (if (memq nil mime-charset)
+ (setq mime-charset (list 'utf-8)))
(cond ((> (length mime-charset) 1)
(error "Can't rfc2047-encode `%s'"
(buffer-substring-no-properties b e)))
"Base64-encode the header contained in STRING."
(base64-encode-string string t))
+(autoload 'quoted-printable-encode-region "qp")
+
(defun rfc2047-q-encode-string (string)
"Quoted-printable-encode the header in STRING."
(mm-with-unibyte-buffer
(goto-char beg)
(while (search-forward "\\" nil 'move)
(unless (memq (char-after) '(?\"))
- (delete-backward-char 1))
+ (delete-char -1))
(forward-char)))
(forward-char))
(error
(goto-char beg))))))))
-(defun rfc2047-charset-to-coding-system (charset)
+(defun rfc2047-charset-to-coding-system (charset &optional allow-override)
"Return coding-system corresponding to MIME CHARSET.
-If your Emacs implementation can't decode CHARSET, return nil."
+If your Emacs implementation can't decode CHARSET, return nil.
+
+If allow-override is given, use `mm-charset-override-alist' to
+map undesired charset names to their replacement. This should
+only be used for decoding, not for encoding."
(when (stringp charset)
(setq charset (intern (downcase charset))))
(when (or (not charset)
(memq 'gnus-all mail-parse-ignored-charsets)
(memq charset mail-parse-ignored-charsets))
(setq charset mail-parse-charset))
- (let ((cs (mm-charset-to-coding-system charset)))
+ (let ((cs (mm-charset-to-coding-system charset nil allow-override)))
(cond ((eq cs 'ascii)
(setq cs (or (mm-charset-to-coding-system mail-parse-charset)
'raw-text)))
'raw-text
cs)))
+(autoload 'quoted-printable-decode-string "qp")
+
(defun rfc2047-decode-encoded-words (words)
"Decode successive encoded-words in WORDS and return a decoded string.
Each element of WORDS looks like (CHARSET ENCODING ENCODED-TEXT
(while words
(setq word (pop words))
(if (and (setq cs (rfc2047-charset-to-coding-system
- (setq charset (car word))))
+ (setq charset (car word)) t))
(condition-case code
(cond ((char-equal ?B (nth 1 word))
(setq text (base64-decode-string
;; things essentially must not be there.
(while (re-search-forward "[\n\r]+" nil t)
(replace-match " "))
+ (setq end (point-max))
;; Quote decoded words if there are special characters
;; which might violate RFC2822.
(when (and rfc2047-quote-decoded-words-containing-tspecials
(when regexp
(save-restriction
(widen)
- (beginning-of-line)
- (while (and (memq (char-after) '(? ?\t))
- (zerop (forward-line -1))))
- (looking-at regexp)))))
+ (and
+ ;; Don't quote words if already quoted.
+ (not (and (eq (char-before e) ?\")
+ (eq (char-after end) ?\")))
+ (progn
+ (beginning-of-line)
+ (while (and (memq (char-after) '(? ?\t))
+ (zerop (forward-line -1))))
+ (looking-at regexp)))))))
(let (quoted)
(goto-char e)
(skip-chars-forward " \t")
(setq start (point))
(setq quoted (eq (char-after) ?\"))
(goto-char (point-max))
- (skip-chars-backward " \t")
+ (skip-chars-backward " \t" start)
(if (setq quoted (and quoted
(> (point) (1+ start))
(eq (char-before) ?\")))
(provide 'rfc2047)
-;; arch-tag: a07fe3d4-22b5-4c4a-bd89-b1f82d5d36f6
;;; rfc2047.el ends here