+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
(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)))
+ ctl (and ct (mail-header-parse-content-type ct))
charset (cond
(prompt
(mm-read-coding-system "Charset to decode: "))
(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)
(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)
(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)
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
(list mm-dissect-default-type)
(and cte (intern (downcase (mail-header-strip 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)
ctl
(and cte (intern (downcase (mail-header-strip 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
(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)))
(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)))
"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))
(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 "")
(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
;;; rfc1843.el --- HZ (rfc1843) decoding
;; Copyright (C) 1998, 1999, 2000, 2002, 2003, 2004,
-;; 2005 Free Software Foundation, Inc.
+;; 2005, 2006 Free Software Foundation, Inc.
;; Author: Shenghuo Zhu <zsh@cs.rochester.edu>
;; Keywords: news HZ HZ+ mail i18n
(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))
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))
(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)
(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))))
-
- ;; 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))
+ (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)))
+ (error
+ (setq parameters nil)
+ (if signal-error
+ (signal (car err) (cdr err))
+ ;;(message "%s" (error-message-string err))
+ )))
(when type
`(,type ,@(nreverse parameters)))))))
(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
(forward-char 1)))
(goto-char (point-min))
(if (not broken)
- (insert "\n " param "*=")
+ (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)
;;; webmail.el --- interface of web mail
;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004,
-;; 2005 Free Software Foundation, Inc.
+;; 2005, 2006 Free Software Foundation, Inc.
;; Author: Shenghuo Zhu <zsh@cs.rochester.edu>
;; Keywords: hotmail netaddress my-deja netscape
(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")
projects / elisp / gnus.git- / commitdiff