mirror of
https://git.savannah.gnu.org/git/emacs.git
synced 2024-12-23 10:34:07 +00:00
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
This commit is contained in:
Miles Bader
parent
c6b99621a2
commit
c96ec15a58
@ -1,3 +1,47 @@
|
||||
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")
|
||||
|
||||
Loading…
Reference in New Issue
Block a user