summaryrefslogtreecommitdiff
path: root/lisp/gnus
diff options
context:
space:
mode:
Diffstat (limited to 'lisp/gnus')
-rw-r--r--lisp/gnus/ChangeLog180
-rw-r--r--lisp/gnus/gnus-art.el75
-rw-r--r--lisp/gnus/gnus.el3
-rw-r--r--lisp/gnus/mm-decode.el19
-rw-r--r--lisp/gnus/mm-view.el3
-rw-r--r--lisp/gnus/mml.el33
-rw-r--r--lisp/gnus/mml1991.el6
-rw-r--r--lisp/gnus/mml2015.el2
-rw-r--r--lisp/gnus/nnfolder.el2
-rw-r--r--lisp/gnus/rfc1843.el3
-rw-r--r--lisp/gnus/rfc2231.el223
-rw-r--r--lisp/gnus/spam-report.el6
-rw-r--r--lisp/gnus/webmail.el2
13 files changed, 379 insertions, 178 deletions
diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog
index 620e017b38e..be9436d350c 100644
--- a/lisp/gnus/ChangeLog
+++ b/lisp/gnus/ChangeLog
@@ -1,3 +1,85 @@
+2006-02-10 Reiner Steib <Reiner.Steib@gmx.de>
+
+ * gnus.el: Remove bogus comment.
+
+2006-02-09 Daiki Ueno <ueno@unixuser.org>
+
+ * pgg-gpg.el (pgg-gpg-encrypt-region): Don't convert line-endings
+ in elisp.
+ (pgg-gpg-encrypt-symmetric-region): Ditto.
+ (pgg-gpg-sign-region): Ditto.
+
+ * pgg-def.el (pgg-text-mode): New variable.
+
+ * mml2015.el (mml2015-pgg-sign): Enable pgg-text-mode.
+ (mml2015-pgg-encrypt): Ditto.
+
+ * mml1991.el (mml1991-pgg-sign): Enable pgg-text-mode.
+ (mml1991-pgg-encrypt): Ditto.
+
+2006-02-08 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * nnfolder.el (nnfolder-insert-newsgroup-line): Use
+ message-make-date instead of current-time-string.
+
+ * mm-view.el (mm-inline-message): Don't set gnus-newsgroup-charset
+ to gnus-decoded which mm-uu might set.
+
+2006-02-08 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * rfc2231.el (rfc2231-parse-string): Sort segmented parameters;
+ don't decode quoted parameters; remove misimported Emacs code.
+ Suggested by ARISAWA Akihiro <ari@mbf.ocn.ne.jp>.
+ (rfc2231-decode-encoded-string): Don't use split-string which
+ behaves differently according to Emacs version; use
+ mm-decode-coding-region to convert charset to coding-system.
+ Suggested by ARISAWA Akihiro <ari@mbf.ocn.ne.jp>.
+ (rfc2231-encode-string): Remove misimported Emacs code.
+
+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.
@@ -6,7 +88,7 @@
* gnus-util.el (gnus-error): Describe `args'.
-2006-02-03 Andreas Seltenreich <uwi7@stud.uni-karlsruhe.de>
+2006-02-03 Andreas Seltenreich <uwi7@stud.uni-karlsruhe.de>
* nnweb.el (nnweb-request-group): Avoid growing overview files.
@@ -23,7 +105,7 @@
* mml.el (mml-generate-mime-1): Correct the order of inline signed
parts.
-2006-01-31 Andreas Seltenreich <uwi7@stud.uni-karlsruhe.de>
+2006-01-31 Andreas Seltenreich <uwi7@stud.uni-karlsruhe.de>
* nnweb.el (nnweb-group-alist): Use defvar instead of defvoo,
there's only one active file for all servers.
@@ -64,7 +146,7 @@
* nnweb.el (nnweb-google-parse-1): Clarify some comments.
-2006-01-30 Andreas Seltenreich <uwi7@stud.uni-karlsruhe.de>
+2006-01-30 Andreas Seltenreich <uwi7@stud.uni-karlsruhe.de>
* nnweb.el (nnweb-type-definition, nnweb-google-parse-1)
(nnweb-google-create-mapping, nnweb-google-search): Adapt to
@@ -422,6 +504,98 @@
as a buffer-local variable. This avoids creating truncated
dribble files as a result of a hang up, eg.
+2005-11-04 Ken Manheimer <ken.manheimer@gmail.com>
+
+ * pgg-pgp.el (pgg-pgp-encrypt-region, pgg-pgp-decrypt-region)
+ (pgg-pgp-encrypt-symmetric-region, pgg-pgp-encrypt-symmetric)
+ (pgg-pgp-encrypt, pgg-pgp-decrypt-region, pgg-pgp-decrypt)
+ (pgg-pgp-sign-region, pgg-pgp-sign): Add optional 'passphrase'
+ argument to all these routines, so the passphrase can be managed
+ externally and passed in to the system.
+ (pgg-pgp-decrypt-region, pgg-pgp-sign-region): Use new name for
+ pgg-add-passphrase-to-cache function.
+
+ * pgg-pgp5.el (pgg-pgp5-encrypt-region, pgg-pgp5-decrypt-region)
+ (pgg-pgp5-encrypt-symmetric-region, pgg-pgp5-encrypt-symmetric)
+ (pgg-pgp5-encrypt, pgg-pgp5-decrypt-region, pgg-pgp5-decrypt)
+ (pgg-pgp5-sign-region, pgg-pgp5-sign): Add optional 'passphrase'
+ argument to all these routines, so the passphrase can be managed
+ externally and passed in to the system.
+ (pgg-pgp5-sign-region): Use new name of pgg-add-passphrase-to-cache
+ function.
+
+2005-10-29 Ken Manheimer <ken.manheimer@gmail.com>
+
+ * pgg-gpg.el (pgg-gpg-select-matching-key): Fix: look at the right
+ part of the decoded armor to find the key-identifier.
+ (pgg-gpg-lookup-key-owner): New function to return the
+ human-readable identifier of a key owner.
+ (pgg-gpg-lookup-id-from-key-owner): Make it easy to identify the
+ key itself.
+ (pgg-gpg-decrypt-region): Prompt with the key owner (rather than
+ the key value) if we have a key and can match it against a secret
+ key. Also, added a note pointing out fact that the prompt only
+ indicates the first matching key.
+
+ * pgg.el (pgg-decrypt): Passing along 'passphrase' in call to
+ pgg-decrypt-region.
+ (pgg-pending-timers): A new hash for tracking the passphrase cache
+ timers, so that new ones supercede old ones.
+ (pgg-add-passphrase-to-cache): Rename from
+ `pgg-add-passphrase-cache' to reduce confusion (all callers
+ changed). Modified to cancel old timers when new ones are added.
+ (pgg-remove-passphrase-from-cache): Rename from
+ `pgg-remove-passphrase-cache' to reduce confusion (all callers
+ changed). Modified to cancel old timers when their keys are
+ removed from the cache.
+ (pgg-cancel-timer): In Emacs, an alias for cancel-timer; in
+ XEmacs, an indirection to delete-itimer.
+ (pgg-read-passphrase-from-cache, pgg-read-passphrase):
+ Extract pgg-read-passphrase-from-cache from pgg-read-passphrase so
+ users can only check cache without risk of prompting. Correct bug in
+ notruncate behavior.
+ (pgg-read-passphrase-from-cache, pgg-read-passphrase)
+ (pgg-add-passphrase-cache, pgg-remove-passphrase-cache):
+ Add informative docstrings.
+ (pgg-decrypt): Convey provided passphrase in subordinate call to
+ pgg-decrypt-region.
+
+2005-10-20 Ken Manheimer <ken.manheimer+emacs@gmail.com>
+
+ * pgg.el (pgg-encrypt-region, pgg-encrypt-symmetric-region)
+ (pgg-encrypt-symmetric, pgg-encrypt, pgg-decrypt-region)
+ (pgg-decrypt, pgg-sign-region, pgg-sign): Add optional
+ 'passphrase' argument, so the passphrase can be managed externally
+ and then passed in to the system.
+
+ * pgg.el (pgg-read-passphrase, pgg-add-passphrase-cache)
+ (pgg-remove-passphrase-cache): Add optional 'notruncate' argument,
+ so the passphrase cache can be used reliably with identifiers
+ besides a pgp packet's key id.
+
+ * pgg-gpg.el (pgg-pgp-encrypt-region)
+ (pgg-pgp-encrypt-symmetric-region, pgg-pgp-encrypt-symmetric)
+ (pgg-pgp-encrypt, pgg-pgp-decrypt-region, pgg-pgp-decrypt)
+ (pgg-pgp-sign-region, pgg-pgp-sign): Add optional 'passphrase'
+ argument to all these routines, so the passphrase can be managed
+ externally and passed in to the system.
+
+ * pgg-gpg.el (pgg-gpg-possibly-cache-passphrase): Add optional
+ 'notruncate' argument, so the passphrase cache can be used
+ reliably with identifiers besides a pgp packet's key id.
+
+2005-10-29 Sascha Wilde <swilde@sha-bang.de>
+
+ * pgg-gpg.el (pgg-gpg-encrypt-symmetric-region): New function for
+ symmetric encryption.
+ (pgg-gpg-symmetric-key-p): New function to check for an symmetric
+ encrypted session key.
+ (pgg-gpg-decrypt-region): When decrypting a symmetric encrypted
+ message ask for the passphrase in a proper way.
+
+ * pgg.el (pgg-encrypt-symmetric, pgg-encrypt-symmetric-region):
+ New user commands for symmetric encryption.
+
2005-11-30 Stefan Monnier <monnier@iro.umontreal.ca>
* gnus-delay.el (gnus-delay-group): Don't autoload.
diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el
index b51ceff29a9..c15151729a0 100644
--- a/lisp/gnus/gnus-art.el
+++ b/lisp/gnus/gnus-art.el
@@ -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)
diff --git a/lisp/gnus/gnus.el b/lisp/gnus/gnus.el
index 359e48cb701..2caccc0b70e 100644
--- a/lisp/gnus/gnus.el
+++ b/lisp/gnus/gnus.el
@@ -4257,9 +4257,6 @@ current display is used."
(delete-frame gnus-other-frame-object))
(setq gnus-other-frame-object nil)))))))
-;;(setq thing ? ; this is a comment
-;; more 'yes)
-
;;;###autoload
(defun gnus (&optional arg dont-connect slave)
"Read network news.
diff --git a/lisp/gnus/mm-decode.el b/lisp/gnus/mm-decode.el
index b275807c051..996c934191c 100644
--- a/lisp/gnus/mm-decode.el
+++ b/lisp/gnus/mm-decode.el
@@ -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)))
diff --git a/lisp/gnus/mm-view.el b/lisp/gnus/mm-view.el
index 73cab0a5676..43d6bddf194 100644
--- a/lisp/gnus/mm-view.el
+++ b/lisp/gnus/mm-view.el
@@ -486,7 +486,8 @@
;; disable prepare hook
gnus-article-prepare-hook
(gnus-newsgroup-charset
- (or charset gnus-newsgroup-charset)))
+ (unless (eq charset 'gnus-decoded) ;; mm-uu might set it.
+ (or charset gnus-newsgroup-charset))))
(let ((gnus-original-article-buffer (mm-handle-buffer handle)))
(run-hooks 'gnus-article-decode-hook))
(gnus-article-prepare-display)
diff --git a/lisp/gnus/mml.el b/lisp/gnus/mml.el
index f8c34b370d6..0ceda113f49 100644
--- a/lisp/gnus/mml.el
+++ b/lisp/gnus/mml.el
@@ -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
diff --git a/lisp/gnus/mml1991.el b/lisp/gnus/mml1991.el
index 761ce4f0af4..0c6bb675388 100644
--- a/lisp/gnus/mml1991.el
+++ b/lisp/gnus/mml1991.el
@@ -229,7 +229,8 @@
(defvar pgg-output-buffer))
(defun mml1991-pgg-sign (cont)
- (let (headers cte)
+ (let ((pgg-text-mode t)
+ headers cte)
;; Don't sign headers.
(goto-char (point-min))
(while (not (looking-at "^$"))
@@ -261,7 +262,8 @@
t))
(defun mml1991-pgg-encrypt (cont &optional sign)
- (let (cte)
+ (let ((pgg-text-mode t)
+ cte)
;; Strip MIME Content[^ ]: headers since it will be ASCII ARMOURED
(goto-char (point-min))
(while (looking-at "^Content[^ ]+:")
diff --git a/lisp/gnus/mml2015.el b/lisp/gnus/mml2015.el
index cb9e77983d3..80dd5b26597 100644
--- a/lisp/gnus/mml2015.el
+++ b/lisp/gnus/mml2015.el
@@ -814,6 +814,7 @@
(boundary (mml-compute-boundary cont))
(pgg-default-user-id (or (message-options-get 'mml-sender)
pgg-default-user-id))
+ (pgg-text-mode t)
entry)
(unless (pgg-sign-region (point-min) (point-max))
(pop-to-buffer mml2015-result-buffer)
@@ -841,6 +842,7 @@
(defun mml2015-pgg-encrypt (cont &optional sign)
(let ((pgg-errors-buffer mml2015-result-buffer)
+ (pgg-text-mode t)
(boundary (mml-compute-boundary cont)))
(unless (pgg-encrypt-region (point-min) (point-max)
(split-string
diff --git a/lisp/gnus/nnfolder.el b/lisp/gnus/nnfolder.el
index c7043011fa2..bd9957283f4 100644
--- a/lisp/gnus/nnfolder.el
+++ b/lisp/gnus/nnfolder.el
@@ -826,7 +826,7 @@ deleted. Point is left where the deleted region was."
(insert "\n"))
(forward-char -1)
(insert (format (concat nnfolder-article-marker "%d %s\n")
- (cdr group-art) (current-time-string)))))
+ (cdr group-art) (message-make-date)))))
(defun nnfolder-active-number (group)
;; Find the next article number in GROUP.
diff --git a/lisp/gnus/rfc1843.el b/lisp/gnus/rfc1843.el
index 8de64ce7c99..aac75758c05 100644
--- a/lisp/gnus/rfc1843.el
+++ b/lisp/gnus/rfc1843.el
@@ -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))
diff --git a/lisp/gnus/rfc2231.el b/lisp/gnus/rfc2231.el
index fb2d070328e..7b4cf2447f4 100644
--- a/lisp/gnus/rfc2231.el
+++ b/lisp/gnus/rfc2231.el
@@ -41,22 +41,19 @@
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))
(ntoken (ietf-drums-token-to-list "0-9"))
- (prev-value "")
- display-name mailbox c display-string parameters
- attribute value type subtype number encoded
- prev-attribute prev-encoded)
- ;; Some mailer (e.g. Thunderbird 1.5) doesn't terminate each
- ;; line with semicolon when folding a long parameter value.
- (while (string-match "\\([^\t\n\r ;]\\)[\t ]*\r?\n[\t ]+" string)
- (setq string (replace-match "\\1;\n " nil nil string)))
+ c type attribute encoded number prev-attribute vals
+ prev-encoded parameters value)
(ietf-drums-init (mail-header-remove-whitespace
(mail-header-remove-comments string)))
(let ((table (copy-syntax-table ietf-drums-syntax-table)))
@@ -74,63 +71,76 @@ 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))
+ (if (eq c ?*)
+ (progn
+ (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)))))
+ (setq number nil
+ encoded nil))
+ ;; See if we have any previous continuations.
+ (when (and prev-attribute
+ (not (eq prev-attribute attribute)))
+ (setq vals
+ (mapconcat 'cdr (sort vals 'car-less-than-car) ""))
+ (push (cons prev-attribute
+ (if prev-encoded
+ (rfc2231-decode-encoded-string vals)
+ vals))
+ parameters)
+ (setq prev-attribute nil
+ vals nil
+ 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)))))
+ (when encoded
+ (setq value (mapconcat (lambda (c) (format "%%%02x" c))
+ value ""))))
+ ((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,59 +152,72 @@ 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
+ (progn
+ (push (cons number value) vals)
+ (setq prev-attribute attribute
+ 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
+ (setq vals (mapconcat 'cdr (sort vals 'car-less-than-car) ""))
+ (push (cons prev-attribute
+ (if prev-encoded
+ (rfc2231-decode-encoded-string vals)
+ vals))
+ parameters)))
+ (error
+ (setq parameters nil)
+ (if signal-error
+ (signal (car err) (cdr err))
+ ;;(message "%s" (error-message-string err))
+ )))
(when type
`(,type ,@(nreverse parameters)))))))
(defun rfc2231-decode-encoded-string (string)
"Decode an RFC2231-encoded string.
-These look like \"us-ascii'en-us'This%20is%20%2A%2A%2Afun%2A%2A%2A\"."
- (with-temp-buffer
- (let ((elems (split-string string "'")))
- ;; The encoded string may contain zero to two single-quote
- ;; marks. This should give us the encoded word stripped
- ;; of any preceding values.
- (insert (car (last elems)))
+These look like:
+ \"us-ascii'en-us'This%20is%20%2A%2A%2Afun%2A%2A%2A\",
+ \"us-ascii''This%20is%20%2A%2A%2Afun%2A%2A%2A\",
+ \"'en-us'This%20is%20%2A%2A%2Afun%2A%2A%2A\",
+ \"''This%20is%20%2A%2A%2Afun%2A%2A%2A\", or
+ \"This is ***fun***\"."
+ (string-match "\\`\\(\\([^']+\\)?'\\([^']+\\)?'\\)?\\(.+\\)" string)
+ (let ((coding-system (mm-charset-to-coding-system (match-string 2 string)))
+ ;;(language (match-string 3 string))
+ (value (match-string 4 string)))
+ (mm-with-multibyte-buffer
+ (insert value)
(goto-char (point-min))
(while (search-forward "%" nil t)
(insert
(prog1
(string-to-number (buffer-substring (point) (+ (point) 2)) 16)
(delete-region (1- (point)) (+ (point) 2)))))
- ;; Encode using the charset, if any.
- (when (and (mm-multibyte-p)
- (> (length elems) 1)
- (not (equal (intern (downcase (car elems))) 'us-ascii)))
- (mm-decode-coding-region (point-min) (point-max)
- (intern (downcase (car elems)))))
+ ;; Decode using the charset, if any.
+ (unless (memq coding-system '(nil ascii))
+ (mm-decode-coding-region (point-min) (point-max) coding-system))
(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,17 +264,17 @@ 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
(goto-char (point-min))
- (insert "\n " param "=\"")
+ (insert param "=\"")
(goto-char (point-max))
(insert "\""))
(t
(goto-char (point-min))
- (insert "\n " param "=")))
+ (insert param "=")))
(buffer-string))))
(provide 'rfc2231)
diff --git a/lisp/gnus/spam-report.el b/lisp/gnus/spam-report.el
index 04ef6b60f5f..a5f46bb79f4 100644
--- a/lisp/gnus/spam-report.el
+++ b/lisp/gnus/spam-report.el
@@ -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)
diff --git a/lisp/gnus/webmail.el b/lisp/gnus/webmail.el
index a7e53702fef..304a206a97f 100644
--- a/lisp/gnus/webmail.el
+++ b/lisp/gnus/webmail.el
@@ -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")
View Lorry Controller Status