Commit c96ec15a authored by Miles Bader's avatar Miles Bader

Revision: emacs@sv.gnu.org/emacs--devo--0--patch-57

Merge from gnus--rel--5.10

Patches applied:

 * gnus--rel--5.10  (patch 18-21)

   - Update from CVS
   - Merge from emacs--devo--0
parent c6b99621
2006-02-07 Katsumi Yamaoka <yamaoka@jpl.org>
* gnus-art.el (article-decode-charset): Don't use ignore-errors
when calling mail-header-parse-content-type.
(article-de-quoted-unreadable): Ditto.
(article-de-base64-unreadable): Ditto.
(article-wash-html): Ditto.
* mm-decode.el (mm-dissect-buffer): Don't use ignore-errors when
calling mail-header-parse-content-type and
mail-header-parse-content-disposition.
(mm-find-raw-part-by-type): Don't use ignore-errors when calling
mail-header-parse-content-type.
* mml.el (mml-insert-mime-headers): Use mml-insert-parameter to
insert charset and format parameters; encode description after
inserting it to buffer.
(mml-insert-parameter): Fold lines properly even if a parameter is
segmented into two or more lines; change the max column to 76.
* rfc1843.el (rfc1843-decode-article-body): Don't use
ignore-errors when calling mail-header-parse-content-type.
* rfc2231.el (rfc2231-parse-string): Return at least type if
possible; don't cause an error even if it fails in parsing of
parameters. Suggested by ARISAWA Akihiro <ari@mbf.ocn.ne.jp>.
(rfc2231-encode-string): Don't break lines at the beginning, leave
it to mml-insert-parameter.
* webmail.el (webmail-yahoo-article): Don't use ignore-errors when
calling mail-header-parse-content-type.
2006-02-06 Reiner Steib <Reiner.Steib@gmx.de>
* spam-report.el (spam-report-gmane-use-article-number): Improve
doc string.
(spam-report-gmane-internal): Check if a suitable header was found
in the article.
2006-02-04 Katsumi Yamaoka <yamaoka@jpl.org>
* rfc2231.el (rfc2231-parse-string): Revert 2006-02-03 change.
(rfc2231-encode-string): Make param*=value always begin with LWSP.
2006-02-05 Romain Francoise <romain@orebokech.com>
Update copyright notices of all files in the gnus directory.
......
......@@ -2267,38 +2267,37 @@ If PROMPT (the prefix), prompt for a coding system to use."
(error))
gnus-newsgroup-ignored-charsets))
ct cte ctl charset format)
(save-excursion
(save-restriction
(article-narrow-to-head)
(setq ct (message-fetch-field "Content-Type" t)
cte (message-fetch-field "Content-Transfer-Encoding" t)
ctl (and ct (ignore-errors
(mail-header-parse-content-type ct)))
charset (cond
(prompt
(mm-read-coding-system "Charset to decode: "))
(ctl
(mail-content-type-get ctl 'charset)))
format (and ctl (mail-content-type-get ctl 'format)))
(when cte
(setq cte (mail-header-strip cte)))
(if (and ctl (not (string-match "/" (car ctl))))
(setq ctl nil))
(goto-char (point-max)))
(forward-line 1)
(save-restriction
(narrow-to-region (point) (point-max))
(when (and (eq mail-parse-charset 'gnus-decoded)
(eq (mm-body-7-or-8) '8bit))
;; The text code could have been decoded.
(setq charset mail-parse-charset))
(when (and (or (not ctl)
(equal (car ctl) "text/plain"))
(not format)) ;; article with format will decode later.
(mm-decode-body
charset (and cte (intern (downcase
(gnus-strip-whitespace cte))))
(car ctl)))))))
(save-excursion
(save-restriction
(article-narrow-to-head)
(setq ct (message-fetch-field "Content-Type" t)
cte (message-fetch-field "Content-Transfer-Encoding" t)
ctl (and ct (mail-header-parse-content-type ct))
charset (cond
(prompt
(mm-read-coding-system "Charset to decode: "))
(ctl
(mail-content-type-get ctl 'charset)))
format (and ctl (mail-content-type-get ctl 'format)))
(when cte
(setq cte (mail-header-strip cte)))
(if (and ctl (not (string-match "/" (car ctl))))
(setq ctl nil))
(goto-char (point-max)))
(forward-line 1)
(save-restriction
(narrow-to-region (point) (point-max))
(when (and (eq mail-parse-charset 'gnus-decoded)
(eq (mm-body-7-or-8) '8bit))
;; The text code could have been decoded.
(setq charset mail-parse-charset))
(when (and (or (not ctl)
(equal (car ctl) "text/plain"))
(not format)) ;; article with format will decode later.
(mm-decode-body
charset (and cte (intern (downcase
(gnus-strip-whitespace cte))))
(car ctl)))))))
(defun article-decode-encoded-words ()
"Remove encoded-word encoding from headers."
......@@ -2390,9 +2389,7 @@ If READ-CHARSET, ask for a coding system."
(setq type
(gnus-fetch-field "content-transfer-encoding"))
(let* ((ct (gnus-fetch-field "content-type"))
(ctl (and ct
(ignore-errors
(mail-header-parse-content-type ct)))))
(ctl (and ct (mail-header-parse-content-type ct))))
(setq charset (and ctl
(mail-content-type-get ctl 'charset)))
(if (stringp charset)
......@@ -2420,9 +2417,7 @@ If READ-CHARSET, ask for a coding system."
(setq type
(gnus-fetch-field "content-transfer-encoding"))
(let* ((ct (gnus-fetch-field "content-type"))
(ctl (and ct
(ignore-errors
(mail-header-parse-content-type ct)))))
(ctl (and ct (mail-header-parse-content-type ct))))
(setq charset (and ctl
(mail-content-type-get ctl 'charset)))
(if (stringp charset)
......@@ -2488,9 +2483,7 @@ charset defined in `gnus-summary-show-article-charset-alist' is used."
(when (gnus-buffer-live-p gnus-original-article-buffer)
(with-current-buffer gnus-original-article-buffer
(let* ((ct (gnus-fetch-field "content-type"))
(ctl (and ct
(ignore-errors
(mail-header-parse-content-type ct)))))
(ctl (and ct (mail-header-parse-content-type ct))))
(setq charset (and ctl
(mail-content-type-get ctl 'charset)))
(when (stringp charset)
......
......@@ -534,13 +534,13 @@ Postpone undisplaying of viewers for types in
loose-mime
(mail-fetch-field "mime-version"))
(setq ct (mail-fetch-field "content-type")
ctl (ignore-errors (mail-header-parse-content-type ct))
ctl (and ct (mail-header-parse-content-type ct))
cte (mail-fetch-field "content-transfer-encoding")
cd (mail-fetch-field "content-disposition")
description (mail-fetch-field "content-description")
id (mail-fetch-field "content-id"))
(unless from
(setq from (mail-fetch-field "from")))
(setq from (mail-fetch-field "from")))
;; FIXME: In some circumstances, this code is running within
;; an unibyte macro. mail-extract-address-components
;; creates unibyte buffers. This `if', though not a perfect
......@@ -557,7 +557,7 @@ Postpone undisplaying of viewers for types in
(mail-header-remove-comments
cte)))))
no-strict-mime
(and cd (ignore-errors (mail-header-parse-content-disposition cd)))
(and cd (mail-header-parse-content-disposition cd))
description)
(setq type (split-string (car ctl) "/"))
(setq subtype (cadr type)
......@@ -592,8 +592,7 @@ Postpone undisplaying of viewers for types in
(mail-header-remove-comments
cte)))))
no-strict-mime
(and cd (ignore-errors
(mail-header-parse-content-disposition cd)))
(and cd (mail-header-parse-content-disposition cd))
description id)
ctl))))
(when id
......@@ -1401,9 +1400,8 @@ If RECURSIVE, search recursively."
(save-excursion
(save-restriction
(narrow-to-region start (1- (point)))
(when (let ((ctl (ignore-errors
(mail-header-parse-content-type
(mail-fetch-field "content-type")))))
(when (let* ((ct (mail-fetch-field "content-type"))
(ctl (and ct (mail-header-parse-content-type ct))))
(if notp
(not (equal (car ctl) type))
(equal (car ctl) type)))
......@@ -1414,9 +1412,8 @@ If RECURSIVE, search recursively."
(save-excursion
(save-restriction
(narrow-to-region start end)
(when (let ((ctl (ignore-errors
(mail-header-parse-content-type
(mail-fetch-field "content-type")))))
(when (let* ((ct (mail-fetch-field "content-type"))
(ctl (and ct (mail-header-parse-content-type ct))))
(if notp
(not (equal (car ctl) type))
(equal (car ctl) type)))
......
......@@ -664,10 +664,10 @@ If MML is non-nil, return the buffer up till the correspondent mml tag."
"Can't encode a part with several charsets"))
(insert "Content-Type: " type)
(when charset
(insert "; " (mail-header-encode-parameter
"charset" (symbol-name charset))))
(mml-insert-parameter
(mail-header-encode-parameter "charset" (symbol-name charset))))
(when flowed
(insert "; format=flowed"))
(mml-insert-parameter "format=flowed"))
(when parameters
(mml-insert-parameter-string
cont mml-content-type-parameters))
......@@ -687,8 +687,11 @@ If MML is non-nil, return the buffer up till the correspondent mml tag."
(unless (eq encoding '7bit)
(insert (format "Content-Transfer-Encoding: %s\n" encoding)))
(when (setq description (cdr (assq 'description cont)))
(insert "Content-Description: "
(mail-encode-encoded-word-string description) "\n"))))
(insert "Content-Description: ")
(setq description (prog1
(point)
(insert description "\n")))
(mail-encode-encoded-word-region description (point)))))
(defun mml-parameter-string (cont types)
(let ((string "")
......@@ -841,14 +844,20 @@ If HANDLES is non-nil, use it instead reparsing the buffer."
(defun mml-insert-parameter (&rest parameters)
"Insert PARAMETERS in a nice way."
(dolist (param parameters)
(insert ";")
(let ((point (point)))
(let (start end)
(dolist (param parameters)
(insert ";")
(setq start (point))
(insert " " param)
(when (> (current-column) 71)
(goto-char point)
(insert "\n ")
(end-of-line)))))
(setq end (point))
(goto-char start)
(end-of-line)
(if (> (current-column) 76)
(progn
(goto-char start)
(insert "\n")
(goto-char (1+ end)))
(goto-char end)))))
;;;
;;; Mode for inserting and editing MML forms
......
......@@ -149,8 +149,7 @@ ftp://ftp.math.psu.edu/pub/simpson/chinese/hzp/hzp.doc"
(let* ((inhibit-point-motion-hooks t)
(case-fold-search t)
(ct (message-fetch-field "Content-Type" t))
(ctl (and ct (ignore-errors
(mail-header-parse-content-type ct)))))
(ctl (and ct (mail-header-parse-content-type ct))))
(if (and ctl (not (string-match "/" (car ctl))))
(setq ctl nil))
(goto-char (point-max))
......
......@@ -41,10 +41,13 @@
N.B. This is in violation with RFC2047, but it seem to be in common use."
(rfc2231-parse-string (rfc2047-decode-string string)))
(defun rfc2231-parse-string (string)
(defun rfc2231-parse-string (string &optional signal-error)
"Parse STRING and return a list.
The list will be on the form
`(name (attribute . value) (attribute . value)...)"
`(name (attribute . value) (attribute . value)...)'.
If the optional SIGNAL-ERROR is non-nil, signal an error when this
function fails in parsing of parameters."
(with-temp-buffer
(let ((ttoken (ietf-drums-token-to-list ietf-drums-text-token))
(stoken (ietf-drums-token-to-list ietf-drums-tspecials))
......@@ -74,63 +77,68 @@ The list will be on the form
(setq type (downcase (buffer-substring
(point) (progn (forward-sexp 1) (point)))))
;; Do the params
(while (not (eobp))
(setq c (char-after))
(unless (eq c ?\;)
(error "Invalid header: %s" string))
(forward-char 1)
;; If c in nil, then this is an invalid header, but
;; since elm generates invalid headers on this form,
;; we allow it.
(when (setq c (char-after))
(if (and (memq c ttoken)
(not (memq c stoken)))
(setq attribute
(intern
(downcase
(buffer-substring
(point) (progn (forward-sexp 1) (point))))))
(error "Invalid header: %s" string))
(setq c (char-after))
(when (eq c ?*)
(forward-char 1)
(setq c (char-after))
(if (not (memq c ntoken))
(setq encoded t
number nil)
(setq number
(string-to-number
(buffer-substring
(point) (progn (forward-sexp 1) (point)))))
(condition-case err
(progn
(while (not (eobp))
(setq c (char-after))
(when (eq c ?*)
(setq encoded t)
(unless (eq c ?\;)
(error "Invalid header: %s" string))
(forward-char 1)
;; If c in nil, then this is an invalid header, but
;; since elm generates invalid headers on this form,
;; we allow it.
(when (setq c (char-after))
(if (and (memq c ttoken)
(not (memq c stoken)))
(setq attribute
(intern
(downcase
(buffer-substring
(point) (progn (forward-sexp 1) (point))))))
(error "Invalid header: %s" string))
(setq c (char-after))
(when (eq c ?*)
(forward-char 1)
(setq c (char-after))
(if (not (memq c ntoken))
(setq encoded t
number nil)
(setq number
(string-to-number
(buffer-substring
(point) (progn (forward-sexp 1) (point)))))
(setq c (char-after))
(when (eq c ?*)
(setq encoded t)
(forward-char 1)
(setq c (char-after)))))
;; See if we have any previous continuations.
(when (and prev-attribute
(not (eq prev-attribute attribute)))
(push (cons prev-attribute
(if prev-encoded
(rfc2231-decode-encoded-string prev-value)
prev-value))
parameters)
(setq prev-attribute nil
prev-value ""
prev-encoded nil))
(unless (eq c ?=)
(error "Invalid header: %s" string))
(forward-char 1)
(setq c (char-after)))))
;; See if we have any previous continuations.
(when (and prev-attribute
(not (eq prev-attribute attribute)))
(push (cons prev-attribute
(if prev-encoded
(rfc2231-decode-encoded-string prev-value)
prev-value))
parameters)
(setq prev-attribute nil
prev-value ""
prev-encoded nil))
(unless (eq c ?=)
(error "Invalid header: %s" string))
(forward-char 1)
(setq c (char-after))
(cond
((eq c ?\")
(setq value
(buffer-substring (1+ (point))
(progn (forward-sexp 1) (1- (point))))))
((and (or (memq c ttoken)
(> c ?\177)) ;; EXTENSION: Support non-ascii chars.
(not (memq c stoken)))
(setq value (buffer-substring
(setq c (char-after))
(cond
((eq c ?\")
(setq value (buffer-substring (1+ (point))
(progn
(forward-sexp 1)
(1- (point))))))
((and (or (memq c ttoken)
;; EXTENSION: Support non-ascii chars.
(> c ?\177))
(not (memq c stoken)))
(setq value
(buffer-substring
(point)
(progn
(forward-sexp)
......@@ -142,25 +150,31 @@ The list will be on the form
(forward-char 1)
(forward-sexp))
(point)))))
(t
(error "Invalid header: %s" string)))
(if number
(setq prev-attribute attribute
prev-value (concat prev-value value)
prev-encoded encoded)
(push (cons attribute
(if encoded
(rfc2231-decode-encoded-string value)
value))
parameters))))
(t
(error "Invalid header: %s" string)))
(if number
(setq prev-attribute attribute
prev-value (concat prev-value value)
prev-encoded encoded)
(push (cons attribute
(if encoded
(rfc2231-decode-encoded-string value)
value))
parameters))))
;; Take care of any final continuations.
(when prev-attribute
(push (cons prev-attribute
(if prev-encoded
(rfc2231-decode-encoded-string prev-value)
prev-value))
parameters))
;; Take care of any final continuations.
(when prev-attribute
(push (cons prev-attribute
(if prev-encoded
(rfc2231-decode-encoded-string prev-value)
prev-value))
parameters)))
(error
(setq parameters nil)
(if signal-error
(signal (car err) (cdr err))
;;(message "%s" (error-message-string err))
)))
(when type
`(,type ,@(nreverse parameters)))))))
......@@ -189,12 +203,15 @@ These look like \"us-ascii'en-us'This%20is%20%2A%2A%2Afun%2A%2A%2A\"."
(buffer-string))))
(defun rfc2231-encode-string (param value)
"Return and PARAM=VALUE string encoded according to RFC2231."
"Return and PARAM=VALUE string encoded according to RFC2231.
Use `mml-insert-parameter' or `mml-insert-parameter-string' to insert
the result of this function."
(let ((control (ietf-drums-token-to-list ietf-drums-no-ws-ctl-token))
(tspecial (ietf-drums-token-to-list ietf-drums-tspecials))
(special (ietf-drums-token-to-list "*'%\n\t"))
(ascii (ietf-drums-token-to-list ietf-drums-text-token))
(num -1)
;; Don't make lines exceeding 76 column.
(limit (- 74 (length param)))
spacep encodep charsetp charset broken)
(with-temp-buffer
......@@ -241,7 +258,7 @@ These look like \"us-ascii'en-us'This%20is%20%2A%2A%2Afun%2A%2A%2A\"."
(if (not broken)
(insert param "*=")
(while (not (eobp))
(insert (if (>= num 0) " " "\n ")
(insert (if (>= num 0) " " "")
param "*" (format "%d" (incf num)) "*=")
(forward-line 1))))
(spacep
......
......@@ -50,7 +50,11 @@ instead."
:group 'spam-report)
(defcustom spam-report-gmane-use-article-number t
"Whether the article number (faster!) or the header should be used."
"Whether the article number (faster!) or the header should be used.
You must set this to nil if you don't read Gmane groups directly
from news.gmane.org, e.g. when using local newsserver such as
leafnode."
:type 'boolean
:group 'spam-report)
......
......@@ -637,7 +637,7 @@
(goto-char (point-min))
(delete-blank-lines)
(setq ct (mail-fetch-field "content-type")
ctl (ignore-errors (mail-header-parse-content-type ct))
ctl (and ct (mail-header-parse-content-type ct))
;;cte (mail-fetch-field "content-transfer-encoding")
cd (mail-fetch-field "content-disposition")
description (mail-fetch-field "content-description")
......
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