From: yamaoka Date: Wed, 8 Feb 2006 12:06:04 +0000 (+0000) Subject: Synch to No Gnus 200602081205. X-Git-Tag: t-gnus-6_17_4-quimby-~110 X-Git-Url: http://git.chise.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=cf9d5b183c1a2edfa14e43126e9915ded64b33f7;p=elisp%2Fgnus.git- Synch to No Gnus 200602081205. --- diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 2634b60..1bf157c 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,14 @@ +2006-02-08 Katsumi Yamaoka + + * rfc2231.el (rfc2231-parse-string): Sort segmented parameters; + don't decode quoted parameters; remove misimported Emacs code. + Suggested by ARISAWA Akihiro . + (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 . + (rfc2231-encode-string): Remove misimported Emacs code. + 2006-02-07 Katsumi Yamaoka * gnus-art.el (article-decode-charset): Don't use ignore-errors diff --git a/lisp/rfc2231.el b/lisp/rfc2231.el index 08303ea..9fe0194 100644 --- a/lisp/rfc2231.el +++ b/lisp/rfc2231.el @@ -52,14 +52,8 @@ function fails in parsing of parameters." (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))) @@ -97,31 +91,36 @@ function fails in parsing of parameters." (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) + (if (eq c ?*) + (progn (forward-char 1) - (setq c (char-after))))) + (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 prev-value) - prev-value)) + (rfc2231-decode-encoded-string vals) + vals)) parameters) (setq prev-attribute nil - prev-value "" + vals nil prev-encoded nil)) (unless (eq c ?=) (error "Invalid header: %s" string)) @@ -132,7 +131,10 @@ function fails in parsing of parameters." (setq value (buffer-substring (1+ (point)) (progn (forward-sexp 1) - (1- (point)))))) + (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)) @@ -153,9 +155,10 @@ function fails in parsing of parameters." (t (error "Invalid header: %s" string))) (if number - (setq prev-attribute attribute - prev-value (concat prev-value value) - prev-encoded encoded) + (progn + (push (cons number value) vals) + (setq prev-attribute attribute + prev-encoded encoded)) (push (cons attribute (if encoded (rfc2231-decode-encoded-string value) @@ -164,10 +167,11 @@ function fails in parsing of 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 prev-value) - prev-value)) + (rfc2231-decode-encoded-string vals) + vals)) parameters))) (error (setq parameters nil) @@ -181,25 +185,27 @@ function fails in parsing of 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 1 string))) + ;;(language (match-string 2 string)) + (value (match-string 3 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) @@ -263,12 +269,12 @@ the result of this function." (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)