X-Git-Url: http://cgit.sxemacs.org/?p=gnus;a=blobdiff_plain;f=lisp%2Frfc2047.el;h=9d5649a5a014be031ede94e23cde84b19f0e8194;hp=97bcc5d72552213ddb3ca71d6e5c1d0d6a9a4a14;hb=8bb74da7932287e4f5fd806aa6c7dae35256bdce;hpb=aa815731b1bf5574d4eeb27f0a7255850d536131 diff --git a/lisp/rfc2047.el b/lisp/rfc2047.el index 97bcc5d72..9d5649a5a 100644 --- a/lisp/rfc2047.el +++ b/lisp/rfc2047.el @@ -1,26 +1,23 @@ ;;; rfc2047.el --- functions for encoding and decoding rfc2047 messages -;; Copyright (C) 1998, 1999, 2000, 2002, 2003, 2004, -;; 2005, 2006 Free Software Foundation, Inc. +;; Copyright (C) 1998-2014 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; MORIOKA Tomohiko ;; This file is part of GNU Emacs. -;; GNU Emacs is free software; you can redistribute it and/or modify +;; GNU Emacs is free software: you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 2, or (at your option) -;; any later version. +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; 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., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. +;; along with GNU Emacs. If not, see . ;;; Commentary: @@ -30,15 +27,14 @@ ;;; Code: (eval-when-compile - (require 'cl) - (defvar message-posting-charset)) + (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. (require 'mail-prsvr) -(require 'base64) +(require 'rfc2045) ;; rfc2045-encode-string (autoload 'mm-body-7-or-8 "mm-bodies") (defvar rfc2047-header-encoding-alist @@ -78,6 +74,8 @@ The values can be: (iso-2022-jp . B) (iso-2022-kr . B) (gb2312 . B) + (gbk . B) + (gb18030 . B) (big5 . B) (cn-big5 . B) (cn-gb . B) @@ -99,6 +97,40 @@ quoted-printable and base64 respectively.") (defvar rfc2047-encode-encoded-words t "Whether encoded words should be encoded again.") +(defvar rfc2047-allow-irregular-q-encoded-words t + "*Whether to decode irregular Q-encoded words.") + +(eval-and-compile ;; Necessary to hard code them in `rfc2047-decode-region'. + (defconst rfc2047-encoded-word-regexp + "=\\?\\([^][\000-\040()<>@,\;:*\\\"/?.=]+\\)\\(?:\\*[^?]+\\)?\\?\ +\\(B\\?[+/0-9A-Za-z]*=*\ +\\|Q\\?[ ->@-~]*\ +\\)\\?=" + "Regexp that matches encoded word." + ;; The patterns for the B encoding and the Q encoding, i.e. the ones + ;; beginning with "B" and "Q" respectively, are restricted into only + ;; the characters that those encodings may generally use. + ) + (defconst rfc2047-encoded-word-regexp-loose + "=\\?\\([^][\000-\040()<>@,\;:*\\\"/?.=]+\\)\\(?:\\*[^?]+\\)?\\?\ +\\(B\\?[+/0-9A-Za-z]*=*\ +\\|Q\\?\\(?:\\?+[ -<>@-~]\\)?\\(?:[ ->@-~]+\\?+[ -<>@-~]\\)*[ ->@-~]*\\?*\ +\\)\\?=" + "Regexp that matches encoded word allowing loose Q encoding." + ;; The pattern for the Q encoding, i.e. the one beginning with "Q", + ;; is similar to: + ;; "Q\\?\\(\\?+[^\n=?]\\)?\\([^\n?]+\\?+[^\n=?]\\)*[^\n?]*\\?*" + ;; <--------1-------><----------2,3----------><--4--><-5-> + ;; They mean: + ;; 1. After "Q?", allow "?"s that follow a character other than "=". + ;; 2. Allow "=" after "Q?"; it isn't regarded as the terminator. + ;; 3. In the middle of an encoded word, allow "?"s that follow a + ;; character other than "=". + ;; 4. Allow any characters other than "?" in the middle of an + ;; encoded word. + ;; 5. At the end, allow "?"s. + )) + ;;; ;;; Functions for encoding RFC2047 messages ;;; @@ -146,37 +178,50 @@ This is either `base64' or `quoted-printable'." encodable-regexp) "Quote special characters with `\\'s in quoted strings. Quoting will not be done in a quoted string if it contains characters -matching ENCODABLE-REGEXP." +matching ENCODABLE-REGEXP or it is within parentheses." (goto-char (point-min)) (let ((tspecials (concat "[" ietf-drums-tspecials "]")) - beg) + (start (point)) + beg end) (with-syntax-table (standard-syntax-table) - (while (search-forward "\"" nil t) - (unless (eq (char-before) ?\\) - (setq beg (match-end 0)) - (goto-char (match-beginning 0)) - (condition-case nil - (progn - (forward-sexp) - (save-restriction - (narrow-to-region beg (1- (point))) - (goto-char beg) - (unless (and encodable-regexp - (re-search-forward encodable-regexp nil t)) - (while (re-search-forward tspecials nil t) - (unless (and (eq (char-before) ?\\) ;; Already quoted. - (looking-at tspecials)) - (goto-char (match-beginning 0)) - (unless (or (eq (char-before) ?\\) - (and rfc2047-encode-encoded-words - (eq (char-after) ??) - (eq (char-before) ?=))) - (insert "\\")) - (forward-char)))) - (goto-char (point-max))) - (forward-char)) - (error - (goto-char beg)))))))) + (while (not (eobp)) + (if (ignore-errors + (forward-list 1) + (eq (char-before) ?\))) + (forward-list -1) + (goto-char (point-max))) + (save-restriction + (narrow-to-region start (point)) + (goto-char start) + (while (search-forward "\"" nil t) + (setq beg (match-beginning 0)) + (unless (eq (char-before beg) ?\\) + (goto-char beg) + (setq beg (1+ beg)) + (condition-case nil + (progn + (forward-sexp) + (setq end (1- (point))) + (goto-char beg) + (if (and encodable-regexp + (re-search-forward encodable-regexp end t)) + (goto-char (1+ end)) + (save-restriction + (narrow-to-region beg end) + (while (re-search-forward tspecials nil 'move) + (if (eq (char-before) ?\\) + (if (looking-at tspecials) ;; Already quoted. + (forward-char) + (insert "\\")) + (goto-char (match-beginning 0)) + (insert "\\") + (forward-char)))) + (forward-char))) + (error + (goto-char beg))))) + (goto-char (point-max))) + (forward-list 1) + (setq start (point)))))) (defvar rfc2047-encoding-type 'address-mime "The type of encoding done by `rfc2047-encode-region'. @@ -190,88 +235,99 @@ Should be called narrowed to the head of the message." (interactive "*") (save-excursion (goto-char (point-min)) - (let (alist elem method) + (let (alist elem method charsets) (while (not (eobp)) (save-restriction (rfc2047-narrow-to-field) (setq method nil - alist rfc2047-header-encoding-alist) - (while (setq elem (pop alist)) - (when (or (and (stringp (car elem)) - (looking-at (car elem))) - (eq (car elem) t)) - (setq alist nil - method (cdr elem)))) - (if (not (rfc2047-encodable-p)) - (prog2 - (when (eq method 'address-mime) - (rfc2047-quote-special-characters-in-quoted-strings)) - (if (and (eq (mm-body-7-or-8) '8bit) - (mm-multibyte-p) - (mm-coding-system-p - (car message-posting-charset))) - ;; 8 bit must be decoded. - (mm-encode-coding-region - (point-min) (point-max) - (mm-charset-to-coding-system - (car message-posting-charset)))) - ;; No encoding necessary, but folding is nice - (when nil - (rfc2047-fold-region - (save-excursion - (goto-char (point-min)) - (skip-chars-forward "^:") - (when (looking-at ": ") - (forward-char 2)) - (point)) - (point-max)))) - ;; We found something that may perhaps be encoded. - (re-search-forward "^[^:]+: *" nil t) - (cond - ((eq method 'address-mime) - (rfc2047-encode-region (point) (point-max))) - ((eq method 'mime) - (let ((rfc2047-encoding-type 'mime)) - (rfc2047-encode-region (point) (point-max)))) - ((eq method 'default) - (if (and (featurep 'mule) - (if (boundp 'default-enable-multibyte-characters) - default-enable-multibyte-characters) - mail-parse-charset) - (mm-encode-coding-region (point) (point-max) - mail-parse-charset))) - ;; We get this when CC'ing messsages to newsgroups with - ;; 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 - ;; left the old code commented out below. - ;; -- Per Abrahamsen Date: 2001-10-07. - ;; Modified by Dave Love, with the commented-out code changed - ;; in accordance with changes elsewhere. - ((null method) - (rfc2047-encode-region (point) (point-max))) -;;; ((null method) -;;; (if (or (message-options-get -;;; 'rfc2047-encode-message-header-encode-any) -;;; (message-options-set -;;; 'rfc2047-encode-message-header-encode-any -;;; (y-or-n-p -;;; "Some texts are not encoded. Encode anyway?"))) -;;; (rfc2047-encode-region (point-min) (point-max)) -;;; (error "Cannot send unencoded text"))) - ((mm-coding-system-p method) - (if (and (featurep 'mule) - (if (boundp 'default-enable-multibyte-characters) - default-enable-multibyte-characters)) - (mm-encode-coding-region (point) (point-max) method))) - ;; Hm. - (t))) - (goto-char (point-max))))))) + alist rfc2047-header-encoding-alist + charsets (mm-find-mime-charset-region (point-min) (point-max))) + ;; M$ Outlook boycotts decoding of a header if it consists + ;; of two or more encoded words and those charsets differ; + ;; it seems to decode all words in a header from a charset + ;; found first in the header. So, we unify the charsets into + ;; a single one used for encoding the whole text in a header. + (let ((mm-coding-system-priorities + (if (= (length charsets) 1) + (cons (mm-charset-to-coding-system (car charsets)) + mm-coding-system-priorities) + mm-coding-system-priorities))) + (while (setq elem (pop alist)) + (when (or (and (stringp (car elem)) + (looking-at (car elem))) + (eq (car elem) t)) + (setq alist nil + method (cdr elem)))) + (if (not (rfc2047-encodable-p)) + (prog2 + (when (eq method 'address-mime) + (rfc2047-quote-special-characters-in-quoted-strings)) + (if (and (eq (mm-body-7-or-8) '8bit) + (mm-multibyte-p) + (mm-coding-system-p + (car message-posting-charset))) + ;; 8 bit must be decoded. + (mm-encode-coding-region + (point-min) (point-max) + (mm-charset-to-coding-system + (car message-posting-charset)))) + ;; No encoding necessary, but folding is nice + (when nil + (rfc2047-fold-region + (save-excursion + (goto-char (point-min)) + (skip-chars-forward "^:") + (when (looking-at ": ") + (forward-char 2)) + (point)) + (point-max)))) + ;; We found something that may perhaps be encoded. + (re-search-forward "^[^:]+: *" nil t) + (cond + ((eq method 'address-mime) + (rfc2047-encode-region (point) (point-max))) + ((eq method 'mime) + (let ((rfc2047-encoding-type 'mime)) + (rfc2047-encode-region (point) (point-max)))) + ((eq method 'default) + (if (and (featurep 'mule) + (if (boundp 'enable-multibyte-characters) + (default-value 'enable-multibyte-characters)) + mail-parse-charset) + (mm-encode-coding-region (point) (point-max) + mail-parse-charset))) + ;; We get this when CC'ing messages to newsgroups with + ;; 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 behavior is wrong, tell me. I have + ;; left the old code commented out below. + ;; -- Per Abrahamsen Date: 2001-10-07. + ;; Modified by Dave Love, with the commented-out code changed + ;; in accordance with changes elsewhere. + ((null method) + (rfc2047-encode-region (point) (point-max))) +;;; ((null method) +;;; (if (or (message-options-get +;;; 'rfc2047-encode-message-header-encode-any) +;;; (message-options-set +;;; 'rfc2047-encode-message-header-encode-any +;;; (y-or-n-p +;;; "Some texts are not encoded. Encode anyway?"))) +;;; (rfc2047-encode-region (point-min) (point-max)) +;;; (error "Cannot send unencoded text"))) + ((mm-coding-system-p method) + (if (or (and (featurep 'mule) + (if (boundp 'enable-multibyte-characters) + (default-value 'enable-multibyte-characters))) + (featurep 'file-coding)) + (mm-encode-coding-region (point) (point-max) method))) + ;; Hm. + (t))) + (goto-char (point-max)))))))) ;; Fixme: This, and the require below may not be the Right Thing, but ;; should be safe just before release. -- fx 2001-02-08 -(eval-when-compile (defvar message-posting-charset)) (defun rfc2047-encodable-p () "Return non-nil if any characters in current buffer need encoding in headers. @@ -282,7 +338,7 @@ The buffer may be narrowed." (goto-char (point-min)) (or (and rfc2047-encode-encoded-words (prog1 - (search-forward "=?" nil t) + (re-search-forward rfc2047-encoded-word-regexp nil t) (goto-char (point-min)))) (and charsets (not (equal charsets (list (car message-posting-charset)))))))) @@ -296,17 +352,13 @@ The buffer may be narrowed." (defconst rfc2047-syntax-table ;; (make-char-table 'syntax-table '(2)) only works in Emacs. (let ((table (make-syntax-table))) - ;; The following is done to work for setting all elements of the table - ;; in Emacs 21 and 22 and XEmacs; it appears to be the cleanest way. + ;; The following is done to work for setting all elements of the table; + ;; it appears to be the cleanest way. ;; Play safe and don't assume the form of the word syntax entry -- ;; copy it from ?a. - (if (fboundp 'set-char-table-range) ; Emacs - (funcall (intern "set-char-table-range") - table t (aref (standard-syntax-table) ?a)) - (if (fboundp 'put-char-table) - (if (fboundp 'get-char-table) ; warning avoidance - (put-char-table t (get-char-table ?a (standard-syntax-table)) - table)))) + (if (featurep 'xemacs) + (put-char-table t (get-char-table ?a (standard-syntax-table)) table) + (set-char-table-range table t (aref (standard-syntax-table) ?a))) (modify-syntax-entry ?\\ "\\" table) (modify-syntax-entry ?\" "\"" table) (modify-syntax-entry ?\( "(" table) @@ -321,7 +373,7 @@ The buffer may be narrowed." (modify-syntax-entry ?@ "." table) table)) -(defun rfc2047-encode-region (b e) +(defun rfc2047-encode-region (b e &optional dont-fold) "Encode words in region B to E that need encoding. By default, the region is treated as containing RFC2822 addresses. Dynamically bind `rfc2047-encoding-type' to change that." @@ -381,7 +433,7 @@ Dynamically bind `rfc2047-encoding-type' to change that." ;; 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 @@ -505,22 +557,32 @@ Dynamically bind `rfc2047-encoding-type' to change that." (signal (car err) (cdr err)) (error "Invalid data for rfc2047 encoding: %s" (mm-replace-in-string orig-text "[ \t\n]+" " ")))))))) - (rfc2047-fold-region b (point)) + (unless dont-fold + (rfc2047-fold-region b (point))) (goto-char (point-max)))) -(defun rfc2047-encode-string (string) +(defun rfc2047-encode-string (string &optional dont-fold) "Encode words in STRING. By default, the string is treated as containing addresses (see `rfc2047-encoding-type')." (mm-with-multibyte-buffer (insert string) - (rfc2047-encode-region (point-min) (point-max)) + (rfc2047-encode-region (point-min) (point-max) dont-fold) (buffer-string))) +;; From RFC 2047: +;; 2. Syntax of encoded-words +;; [...] +;; While there is no limit to the length of a multiple-line header +;; field, each line of a header field that contains one or more +;; 'encoded-word's is limited to 76 characters. +;; +;; In `rfc2047-encode-parameter' it is bound to nil, so don't defconst it. (defvar rfc2047-encode-max-chars 76 "Maximum characters of each header line that contain encoded-words. -If it is nil, encoded-words will not be folded. Too small value may -cause an error. Don't change this for no particular reason.") +According to RFC 2047, it is 76. If it is nil, encoded-words +will not be folded. Too small value may cause an error. You +should not change this value.") (defun rfc2047-encode-1 (column string cs encoder start crest tail &optional eword) @@ -536,7 +598,7 @@ cause an error. Don't change this for no particular reason.") ((>= column rfc2047-encode-max-chars) (when eword (cond ((string-match "\n[ \t]+\\'" eword) - ;; Reomove a superfluous empty line. + ;; Remove a superfluous empty line. (setq eword (substring eword 0 (match-beginning 0)))) ((string-match "(+\\'" eword) ;; Break the line before the open parenthesis. @@ -589,7 +651,7 @@ cause an error. Don't change this for no particular reason.") (setq crest " " eword (concat eword next))) (when (string-match "\n[ \t]+\\'" eword) - ;; Reomove a superfluous empty line. + ;; Remove a superfluous empty line. (setq eword (substring eword 0 (match-beginning 0)))) (rfc2047-encode-1 (length crest) (substring string index) cs encoder start " " tail @@ -600,6 +662,9 @@ cause an error. Don't change this for no particular reason.") 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))) @@ -771,6 +836,8 @@ Point moves to the end of the region." "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 @@ -791,34 +858,16 @@ Point moves to the end of the region." (defun rfc2047-encode-parameter (param value) "Return and PARAM=VALUE string encoded in the RFC2047-like style. -This is a replacement for the `rfc2231-encode-string' function. - -When attaching files as MIME parts, we should use the RFC2231 encoding -to specify the file names containing non-ASCII characters. However, -many mail softwares don't support it in practice and recipients won't -be able to extract files with correct names. Instead, the RFC2047-like -encoding is acceptable generally. This function provides the very -RFC2047-like encoding, resigning to such a regrettable trend. To use -it, put the following line in your ~/.gnus.el file: - -\(defalias 'mail-header-encode-parameter 'rfc2047-encode-parameter) -" - (let* ((rfc2047-encoding-type 'mime) - (rfc2047-encode-max-chars nil) - (string (rfc2047-encode-string value))) - (if (string-match (concat "[" ietf-drums-tspecials "]") string) - (format "%s=%S" param string) - (concat param "=" string)))) +This is a substitution for the `rfc2231-encode-string' function, that +is the standard but many mailers don't support it." + (let ((rfc2047-encoding-type 'mime) + (rfc2047-encode-max-chars nil)) + (rfc2045-encode-string param (rfc2047-encode-string value t)))) ;;; ;;; Functions for decoding RFC2047 messages ;;; -(eval-and-compile - (defconst rfc2047-encoded-word-regexp - "=\\?\\([^][\000-\040()<>@,\;:*\\\"/?.=]+\\)\\(?:\\*[^?]+\\)?\ -\\?\\(B\\|Q\\)\\?\\([!->@-~ ]*\\)\\?=")) - (defvar rfc2047-quote-decoded-words-containing-tspecials nil "If non-nil, quote decoded words containing special characters.") @@ -848,15 +897,19 @@ them.") (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) @@ -864,7 +917,7 @@ If your Emacs implementation can't decode CHARSET, return nil." (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))) @@ -877,6 +930,8 @@ If your Emacs implementation can't decode CHARSET, return nil." '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 @@ -885,7 +940,7 @@ ENCODED-WORD)." (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 @@ -937,10 +992,12 @@ If ADDRESS-MIME is non-nil, strip backslashes which precede characters other than `\"' and `\\' in quoted strings." (interactive "r") (let ((case-fold-search t) - (eword-regexp (eval-when-compile - ;; Ignore whitespace between encoded-words. - (concat "[\n\t ]*\\(" rfc2047-encoded-word-regexp - "\\)"))) + (eword-regexp + (if rfc2047-allow-irregular-q-encoded-words + (eval-when-compile + (concat "[\n\t ]*\\(" rfc2047-encoded-word-regexp-loose "\\)")) + (eval-when-compile + (concat "[\n\t ]*\\(" rfc2047-encoded-word-regexp "\\)")))) b e match words) (save-excursion (save-restriction @@ -956,7 +1013,7 @@ other than `\"' and `\\' in quoted strings." (while match (push (list (match-string 2) ;; charset (char-after (match-beginning 3)) ;; encoding - (match-string 4) ;; encoded-text + (substring (match-string 3) 2) ;; encoded-text (match-string 1)) ;; encoded-word words) ;; Look for the subsequent encoded-words. @@ -972,6 +1029,7 @@ other than `\"' and `\\' in quoted strings." ;; 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 @@ -981,17 +1039,22 @@ other than `\"' and `\\' in quoted strings." (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) ?\"))) @@ -1042,17 +1105,17 @@ strings are stripped." "Decode MIME-encoded STRING and return the result. If ADDRESS-MIME is non-nil, strip backslashes which precede characters other than `\"' and `\\' in quoted strings." - (let ((m (mm-multibyte-p))) + ;; (let ((m (mm-multibyte-p))) (if (string-match "=\\?" string) (with-temp-buffer - ;; Fixme: This logic is wrong, but seems to be required by - ;; Gnus summary buffer generation. The value of `m' depends - ;; on the current buffer, not global multibyteness or that - ;; of the string. Also the string returned should always be - ;; multibyte in a multibyte session, i.e. the buffer should - ;; be multibyte before `buffer-string' is called. - (when m - (mm-enable-multibyte)) + ;; We used to only call mm-enable-multibyte if `m' is non-nil, + ;; but this can't be the right criterion. Don't just revert this + ;; change if it encounters a bug. Please help me fix it + ;; right instead. --Stef + ;; The string returned should always be multibyte in a multibyte + ;; session, i.e. the buffer should be multibyte before + ;; `buffer-string' is called. + (mm-enable-multibyte) (insert string) (inline (rfc2047-decode-region (point-min) (point-max) address-mime)) @@ -1066,7 +1129,7 @@ other than `\"' and `\\' in quoted strings." (rfc2047-strip-backslashes-in-quoted-strings) (buffer-string)))) ;; Fixme: As above, `m' here is inappropriate. - (if (and m + (if (and ;; m mail-parse-charset (not (eq mail-parse-charset 'us-ascii)) (not (eq mail-parse-charset 'gnus-decoded))) @@ -1082,9 +1145,9 @@ other than `\"' and `\\' in quoted strings." (if (and (fboundp 'detect-coding-string) ;; string is purely ASCII (eq (detect-coding-string string t) 'undecided)) - string - (mm-decode-coding-string string mail-parse-charset)) - (mm-string-as-multibyte string))))) + string + (mm-decode-coding-string string mail-parse-charset)) + (mm-string-to-multibyte string)))) ;; ) (defun rfc2047-decode-address-string (string) "Decode MIME-encoded STRING and return the result. @@ -1109,5 +1172,4 @@ strings are stripped." (provide 'rfc2047) -;;; arch-tag: a07fe3d4-22b5-4c4a-bd89-b1f82d5d36f6 ;;; rfc2047.el ends here