Commit 343d6628 authored by Miles Bader's avatar Miles Bader
Browse files

Merge from gnus--rel--5.10

Patches applied:

 * gnus--rel--5.10  (patch 128)

   - Update from CVS

2006-09-01  Katsumi Yamaoka  <yamaoka@jpl.org>

   * lisp/gnus/rfc2047.el (rfc2047-quote-special-characters-in-quoted-strings):
   Use standard-syntax-table.

2006-09-01  Katsumi Yamaoka  <yamaoka@jpl.org>

   * 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
parent 5deb7a51
2006-09-01 Katsumi Yamaoka <yamaoka@jpl.org>
* rfc2047.el (rfc2047-quote-special-characters-in-quoted-strings):
Use standard-syntax-table.
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-23 Andreas Seltenreich <uwi7@rz.uni-karlsruhe.de>
[ Backported bug fix from No Gnus. ]
......
......@@ -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))
......
......@@ -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
......
......@@ -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)
......
......@@ -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
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment