From 343d662867f2ad217c55e174ee5a58f0659543de Mon Sep 17 00:00:00 2001 From: Miles Bader Date: Fri, 1 Sep 2006 23:52:28 +0000 Subject: [PATCH] Merge from gnus--rel--5.10 Patches applied: * gnus--rel--5.10 (patch 128) - Update from CVS 2006-09-01 Katsumi Yamaoka * lisp/gnus/rfc2047.el (rfc2047-quote-special-characters-in-quoted-strings): Use standard-syntax-table. 2006-09-01 Katsumi Yamaoka * lisp/gnus/gnus-art.el (gnus-decode-address-function): New variable. (article-decode-encoded-words): Use it to decode headers which are assumed to contain addresses. (gnus-mime-delete-part): Remove useless `or'. * lisp/gnus/gnus-sum.el (gnus-decode-encoded-address-function): New variable. (gnus-summary-from-or-to-or-newsgroups): Use it to decode To header. (gnus-nov-parse-line): Use it to decode From header. (gnus-get-newsgroup-headers): Ditto. (gnus-summary-enter-digest-group): Use it to decode `to-address'. * lisp/gnus/mail-parse.el (mail-decode-encoded-address-region): New alias. (mail-decode-encoded-address-string): New alias. * lisp/gnus/rfc2047.el (rfc2047-quote-special-characters-in-quoted-strings): New function. (rfc2047-encode-message-header, rfc2047-encode-region): Use it. (rfc2047-strip-backslashes-in-quoted-strings): New fnction. (rfc2047-decode-region): Use it; add optional argument `address-mime'. (rfc2047-decode-string): Ditto. (rfc2047-decode-address-region): New function. (rfc2047-decode-address-string): New function. Revision: emacs@sv.gnu.org/emacs--devo--0--patch-418 --- lisp/gnus/ChangeLog | 30 +++++++++++ lisp/gnus/gnus-art.el | 25 +++++++-- lisp/gnus/gnus-sum.el | 23 ++++---- lisp/gnus/mail-parse.el | 2 + lisp/gnus/rfc2047.el | 114 +++++++++++++++++++++++++++++++++++----- 5 files changed, 166 insertions(+), 28 deletions(-) diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog index 6927e3bfba..87f00faef7 100644 --- a/lisp/gnus/ChangeLog +++ b/lisp/gnus/ChangeLog @@ -1,3 +1,33 @@ +2006-09-01 Katsumi Yamaoka + + * rfc2047.el (rfc2047-quote-special-characters-in-quoted-strings): + Use standard-syntax-table. + +2006-09-01 Katsumi Yamaoka + + * gnus-art.el (gnus-decode-address-function): New variable. + (article-decode-encoded-words): Use it to decode headers which are + assumed to contain addresses. + (gnus-mime-delete-part): Remove useless `or'. + + * gnus-sum.el (gnus-decode-encoded-address-function): New variable. + (gnus-summary-from-or-to-or-newsgroups): Use it to decode To header. + (gnus-nov-parse-line): Use it to decode From header. + (gnus-get-newsgroup-headers): Ditto. + (gnus-summary-enter-digest-group): Use it to decode `to-address'. + + * mail-parse.el (mail-decode-encoded-address-region): New alias. + (mail-decode-encoded-address-string): New alias. + + * rfc2047.el (rfc2047-quote-special-characters-in-quoted-strings): + New function. + (rfc2047-encode-message-header, rfc2047-encode-region): Use it. + (rfc2047-strip-backslashes-in-quoted-strings): New fnction. + (rfc2047-decode-region): Use it; add optional argument `address-mime'. + (rfc2047-decode-string): Ditto. + (rfc2047-decode-address-region): New function. + (rfc2047-decode-address-string): New function. + 2006-08-23 Andreas Seltenreich [ Backported bug fix from No Gnus. ] diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el index 39292e33a1..17cbbeb0a7 100644 --- a/lisp/gnus/gnus-art.el +++ b/lisp/gnus/gnus-art.el @@ -853,6 +853,9 @@ be displayed by the first non-nil matching CONTENT face." (defvar gnus-decode-header-function 'mail-decode-encoded-word-region "Function used to decode headers.") +(defvar gnus-decode-address-function 'mail-decode-encoded-address-region + "Function used to decode addresses.") + (defvar gnus-article-dumbquotes-map '(("\200" "EUR") ("\202" ",") @@ -2377,10 +2380,23 @@ If PROMPT (the prefix), prompt for a coding system to use." (set-buffer gnus-summary-buffer) (error)) gnus-newsgroup-ignored-charsets)) - (inhibit-read-only t)) + (inhibit-read-only t) + start) (save-restriction (article-narrow-to-head) - (funcall gnus-decode-header-function (point-min) (point-max))))) + (while (not (eobp)) + (setq start (point)) + (if (prog1 + (looking-at "\ +\\(?:Resent-\\)?\\(?:From\\|Cc\\|To\\|Bcc\\|\\(?:In-\\)?Reply-To\\|Sender\ +\\|Mail-Followup-To\\|Mail-Copies-To\\|Approved\\):") + (while (progn + (forward-line) + (if (eobp) + nil + (memq (char-after) '(?\t ? )))))) + (funcall gnus-decode-address-function start (point)) + (funcall gnus-decode-header-function start (point))))))) (defun article-decode-group-name () "Decode group names in `Newsgroups:'." @@ -4324,9 +4340,8 @@ Deleting parts may malfunction or destroy the article; continue? ") (handles gnus-article-mime-handles) (none "(none)") (description - (or - (mail-decode-encoded-word-string (or (mm-handle-description data) - none)))) + (mail-decode-encoded-word-string (or (mm-handle-description data) + none))) (filename (or (mail-content-type-get (mm-handle-disposition data) 'filename) none)) diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el index b94d093329..7d91d4db5a 100644 --- a/lisp/gnus/gnus-sum.el +++ b/lisp/gnus/gnus-sum.el @@ -992,7 +992,11 @@ which it may alter in any way." :group 'gnus-summary) (defvar gnus-decode-encoded-word-function 'mail-decode-encoded-word-string - "Variable that says which function should be used to decode a string with encoded words.") + "Function used to decode a string with encoded words.") + +(defvar gnus-decode-encoded-address-function + 'mail-decode-encoded-address-string + "Function used to decode addresses with encoded words.") (defcustom gnus-extra-headers '(To Newsgroups) "*Extra headers to parse." @@ -1001,7 +1005,7 @@ which it may alter in any way." :type '(repeat symbol)) (defcustom gnus-ignored-from-addresses - (and user-mail-address + (and user-mail-address (not (string= user-mail-address "")) (regexp-quote user-mail-address)) "*Regexp of From headers that may be suppressed in favor of To headers." @@ -3436,7 +3440,7 @@ buffer that was in action when the last article was fetched." (concat "-> " (inline (gnus-summary-extract-address-component - (funcall gnus-decode-encoded-word-function to))))) + (funcall gnus-decode-encoded-address-function to))))) ((setq newsgroups (cdr (assq 'Newsgroups extra-headers))) (concat "=> " newsgroups))))) (inline (gnus-summary-extract-address-component gnus-tmp-from))))) @@ -4182,7 +4186,7 @@ Returns HEADER if it was entered in the DEPENDENCIES. Returns nil otherwise." (error x)) (condition-case () ; from (gnus-remove-odd-characters - (funcall gnus-decode-encoded-word-function + (funcall gnus-decode-encoded-address-function (setq x (nnheader-nov-field)))) (error x)) (nnheader-nov-field) ; date @@ -5956,7 +5960,7 @@ The resulting hash table is returned, or nil if no Xrefs were found." (progn (goto-char p) (if (search-forward "\nfrom:" nil t) - (funcall gnus-decode-encoded-word-function + (funcall gnus-decode-encoded-address-function (nnheader-header-value)) "(nobody)")) ;; Date. @@ -8449,10 +8453,11 @@ to guess what the document format is." ;; the parent article. (when (setq to-address (or (gnus-fetch-field "reply-to") (gnus-fetch-field "from"))) - (setq params (append - (list (cons 'to-address - (funcall gnus-decode-encoded-word-function - to-address)))))) + (setq params + (append + (list (cons 'to-address + (funcall gnus-decode-encoded-address-function + to-address)))))) (setq dig (nnheader-set-temp-buffer " *gnus digest buffer*")) (insert-buffer-substring gnus-original-article-buffer) ;; Remove lines that may lead nndoc to misinterpret the diff --git a/lisp/gnus/mail-parse.el b/lisp/gnus/mail-parse.el index 6a9a4755bb..3c1aa8111c 100644 --- a/lisp/gnus/mail-parse.el +++ b/lisp/gnus/mail-parse.el @@ -70,6 +70,8 @@ (defalias 'mail-encode-encoded-word-string 'rfc2047-encode-string) (defalias 'mail-decode-encoded-word-region 'rfc2047-decode-region) (defalias 'mail-decode-encoded-word-string 'rfc2047-decode-string) +(defalias 'mail-decode-encoded-address-region 'rfc2047-decode-address-region) +(defalias 'mail-decode-encoded-address-string 'rfc2047-decode-address-string) (provide 'mail-parse) diff --git a/lisp/gnus/rfc2047.el b/lisp/gnus/rfc2047.el index aa30d9ba78..dc51a104c2 100644 --- a/lisp/gnus/rfc2047.el +++ b/lisp/gnus/rfc2047.el @@ -171,6 +171,40 @@ This is either `base64' or `quoted-printable'." (re-search-forward ":[ \t\n]*" nil t) (buffer-substring-no-properties (point) (point-max))))) +(defun rfc2047-quote-special-characters-in-quoted-strings (&optional + 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." + (goto-char (point-min)) + (let ((tspecials (concat "[" ietf-drums-tspecials "]")) + beg) + (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 'move) + (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))))) + (error + (goto-char beg)))))))) + (defvar rfc2047-encoding-type 'address-mime "The type of encoding done by `rfc2047-encode-region'. This should be dynamically bound around calls to @@ -187,8 +221,18 @@ Should be called narrowed to the head of the message." (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)) - (prog1 + (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 @@ -209,14 +253,6 @@ Should be called narrowed to the head of the message." (point)) (point-max)))) ;; We found something that may perhaps be encoded. - (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)))) (re-search-forward "^[^:]+: *" nil t) (cond ((eq method 'address-mime) @@ -347,6 +383,7 @@ Dynamically bind `rfc2047-encoding-type' to change that." (rfc2047-encode start (point)) (goto-char end)))) ;; `address-mime' case -- take care of quoted words, comments. + (rfc2047-quote-special-characters-in-quoted-strings encodable-regexp) (with-syntax-table rfc2047-syntax-table (goto-char (point-min)) (condition-case err ; in case of unbalanced quotes @@ -821,6 +858,29 @@ encoded-word, concatenate them, and decode it by charset. Otherwise, the decoder will fully decode each encoded-word before concatenating them.") +(defun rfc2047-strip-backslashes-in-quoted-strings () + "Strip backslashes in quoted strings. `\\\"' and `\\\\' remain." + (goto-char (point-min)) + (let (beg) + (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) + (while (search-forward "\\" nil 'move) + (unless (memq (char-after) '(?\" ?\\)) + (delete-backward-char 1)) + (forward-char))) + (forward-char)) + (error + (goto-char beg)))))))) + (defun rfc2047-charset-to-coding-system (charset) "Return coding-system corresponding to MIME CHARSET. If your Emacs implementation can't decode CHARSET, return nil." @@ -898,8 +958,10 @@ ENCODED-WORD)." ;; and worthwhile (is it more correct or not?), e.g. something like ;; `=?iso-8859-1?q?foo?=@'. -(defun rfc2047-decode-region (start end) - "Decode MIME-encoded words in region between START and END." +(defun rfc2047-decode-region (start end &optional address-mime) + "Decode MIME-encoded words in region between START and END. +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 @@ -910,6 +972,8 @@ ENCODED-WORD)." (save-excursion (save-restriction (narrow-to-region start end) + (when address-mime + (rfc2047-strip-backslashes-in-quoted-strings)) (goto-char (setq b start)) ;; Look for the encoded-words. (while (setq match (re-search-forward eword-regexp nil t)) @@ -995,8 +1059,16 @@ ENCODED-WORD)." (not (eq mail-parse-charset 'gnus-decoded))) (mm-decode-coding-region b (point-max) mail-parse-charset)))))) -(defun rfc2047-decode-string (string) - "Decode the quoted-printable-encoded STRING and return the results." +(defun rfc2047-decode-address-region (start end) + "Decode MIME-encoded words in region between START and END. +Backslashes which precede characters other than `\"' and `\\' in quoted +strings are stripped." + (rfc2047-decode-region start end t)) + +(defun rfc2047-decode-string (string &optional address-mime) + "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))) (if (string-match "=\\?" string) (with-temp-buffer @@ -1010,8 +1082,16 @@ ENCODED-WORD)." (mm-enable-multibyte)) (insert string) (inline - (rfc2047-decode-region (point-min) (point-max))) + (rfc2047-decode-region (point-min) (point-max) address-mime)) (buffer-string)) + (when address-mime + (setq string + (with-temp-buffer + (when (mm-multibyte-string-p string) + (mm-enable-multibyte)) + (insert string) + (rfc2047-strip-backslashes-in-quoted-strings) + (buffer-string)))) ;; Fixme: As above, `m' here is inappropriate. (if (and m mail-parse-charset @@ -1033,6 +1113,12 @@ ENCODED-WORD)." (mm-decode-coding-string string mail-parse-charset)) (mm-string-as-multibyte string))))) +(defun rfc2047-decode-address-string (string) + "Decode MIME-encoded STRING and return the result. +Backslashes which precede characters other than `\"' and `\\' in quoted +strings are stripped." + (rfc2047-decode-string string t)) + (defun rfc2047-pad-base64 (string) "Pad STRING to quartets." ;; Be more liberal to accept buggy base64 strings. If -- 2.20.1