+(defvar rfc2047-allow-incomplete-encoded-text t
+ "*Non-nil means allow incomplete encoded-text in successive encoded-words.
+Dividing of encoded-text in the place other than character boundaries
+violates RFC2047 section 5, while we have a capability to decode it.
+If it is non-nil, the decoder will decode B- or Q-encoding in each
+encoded-word, concatenate them, and decode it by charset. Otherwise,
+the decoder will fully decode each encoded-word before concatenating
+them.")
+
+(defun rfc2047-charset-to-coding-system (charset)
+ "Return coding-system corresponding to MIME CHARSET.
+If your Emacs implementation can't decode CHARSET, return nil."
+ (when (stringp charset)
+ (setq charset (intern (downcase charset))))
+ (when (or (not charset)
+ (eq 'gnus-all mail-parse-ignored-charsets)
+ (memq 'gnus-all mail-parse-ignored-charsets)
+ (memq charset mail-parse-ignored-charsets))
+ (setq charset mail-parse-charset))
+ (let ((cs (mm-coding-system-p (mm-charset-to-coding-system charset))))
+ (cond ((eq cs 'ascii)
+ (setq cs (or (mm-charset-to-coding-system mail-parse-charset)
+ 'raw-text)))
+ (cs)
+ ((and charset
+ (listp mail-parse-ignored-charsets)
+ (memq 'gnus-unknown mail-parse-ignored-charsets))
+ (setq cs (mm-charset-to-coding-system mail-parse-charset))))
+ (if (eq cs 'ascii)
+ 'raw-text
+ cs)))
+
+(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
+ENCODED-WORD)."
+ (let (word charset cs encoding text rest)
+ (while words
+ (setq word (pop words))
+ (if (and (or (setq cs (rfc2047-charset-to-coding-system
+ (setq charset (car word))))
+ (progn
+ (message "Unknown charset: %s" charset)
+ nil))
+ (condition-case code
+ (cond ((char-equal ?B (nth 1 word))
+ (setq text (base64-decode-string
+ (rfc2047-pad-base64 (nth 2 word)))))
+ ((char-equal ?Q (nth 1 word))
+ (setq text (quoted-printable-decode-string
+ (mm-subst-char-in-string
+ ?_ ? (nth 2 word) t)))))
+ (error
+ (message "%s" (error-message-string code))
+ nil)))
+ (if (and rfc2047-allow-incomplete-encoded-text
+ (eq cs (caar rest)))
+ ;; Concatenate text of which the charset is the same.
+ (setcdr (car rest) (concat (cdar rest) text))
+ (push (cons cs text) rest))
+ ;; Don't decode encoded-word.
+ (push (cons nil (nth 3 word)) rest)))
+ (while rest
+ (setq words (concat
+ (or (and (setq cs (caar rest))
+ (condition-case code
+ (mm-decode-coding-string (cdar rest) cs)
+ (error
+ (message "%s" (error-message-string code))
+ nil)))
+ (concat (when (cdr rest) " ")
+ (cdar rest)
+ (when (and words
+ (not (eq (string-to-char words) ? )))
+ " ")))
+ words)
+ rest (cdr rest)))
+ words))
+