+2006-09-01 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * 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-31 Reiner Steib <Reiner.Steib@gmx.de>
* message.el (message-caesar-buffer-body): Allow rotating headers.
: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."
: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."
(concat gnus-summary-to-prefix
(inline
(gnus-summary-extract-address-component
- (funcall gnus-decode-encoded-word-function to)))))
+ (funcall gnus-decode-encoded-address-function to)))))
((setq newsgroups
(or
(cdr (assq 'Newsgroups extra-headers))
(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
(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.
;; 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
(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)
+ (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
(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
(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)
(goto-char end))))
;; `address-mime' case -- take care of quoted words, comments.
(with-syntax-table rfc2047-syntax-table
+ (rfc2047-quote-special-characters-in-quoted-strings
+ encodable-regexp)
(goto-char (point-min))
(condition-case err ; in case of unbalanced quotes
;; Look for rfc2822-style: sequences of atoms, quoted
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."
;; 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
(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))
(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
(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
(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
projects / gnus / commitdiff