X-Git-Url: http://cgit.sxemacs.org/?p=gnus;a=blobdiff_plain;f=lisp%2Frfc2231.el;h=0b028a08b8330e7ad81d176bc7705187b25ce3f3;hp=d066591cdd1044a84436dadf13a270516d17d7ec;hb=79a508f1f7f8e13b242201273ffb8ce266e88b90;hpb=470c7931c6604d280d0e0070408d5a797c5f94a0 diff --git a/lisp/rfc2231.el b/lisp/rfc2231.el index d066591cd..0b028a08b 100644 --- a/lisp/rfc2231.el +++ b/lisp/rfc2231.el @@ -1,25 +1,23 @@ ;;; rfc2231.el --- Functions for decoding rfc2231 headers -;; Copyright (C) 1998, 1999, 2000, 2002, 2003, 2004, 2005, -;; 2006 Free Software Foundation, Inc. +;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, +;; 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; This file is part of GNU Emacs. -;; GNU Emacs is free software; you can redistribute it and/or modify +;; GNU Emacs is free software: you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 2, or (at your option) -;; any later version. +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. +;; along with GNU Emacs. If not, see . ;;; Commentary: @@ -53,8 +51,7 @@ must never cause a Lisp error." (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")) - c type attribute encoded number prev-attribute vals - prev-encoded parameters value) + c type attribute encoded number parameters value) (ietf-drums-init (condition-case nil (mail-header-remove-whitespace @@ -142,19 +139,6 @@ must never cause a Lisp error." (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) @@ -176,44 +160,52 @@ must never cause a Lisp error." (buffer-substring (point) (progn - (forward-sexp) - ;; We might not have reached at the end of - ;; the value because of non-ascii chars, - ;; so we should jump over them if any. - (while (and (not (eobp)) - (> (char-after) ?\177)) + ;; Jump over asterisk, non-ASCII + ;; and non-boundary characters. + (while (and c + (or (eq c ?*) + (> c ?\177) + (not (eq (char-syntax c) ? )))) (forward-char 1) - (forward-sexp)) + (setq c (char-after))) (point))))) (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 - (setq vals (mapconcat 'cdr (sort vals 'car-less-than-car) "")) - (push (cons prev-attribute - (if prev-encoded - (rfc2231-decode-encoded-string vals) - vals)) - parameters))) + (push (list attribute value number encoded) + parameters)))) (error (setq parameters nil) - (if signal-error - (signal (car err) (cdr err)) - ;;(message "%s" (error-message-string err)) - ))) + (when signal-error + (signal (car err) (cdr err))))) - (cons type (nreverse parameters)))))) + ;; Now collect and concatenate continuation parameters. + (let ((cparams nil) + elem) + (loop for (attribute value part encoded) + in (sort parameters (lambda (e1 e2) + (< (or (caddr e1) 0) + (or (caddr e2) 0)))) + do (cond + ;; First part. + ((or (not (setq elem (assq attribute cparams))) + (and (numberp part) + (zerop part))) + (push (list attribute value encoded) cparams)) + ;; Repetition of a part; do nothing. + ((and elem + (null number)) + ) + ;; Concatenate continuation parts. + (t + (setcar (cdr elem) (concat (cadr elem) value))))) + ;; Finally decode encoded values. + (cons type (mapcar + (lambda (elem) + (cons (car elem) + (if (nth 2 elem) + (rfc2231-decode-encoded-string (nth 1 elem)) + (nth 1 elem)))) + (nreverse cparams)))))))) (defun rfc2231-decode-encoded-string (string) "Decode an RFC2231-encoded string. @@ -230,11 +222,11 @@ These look like: (mm-with-unibyte-buffer (insert value) (goto-char (point-min)) - (while (search-forward "%" nil t) + (while (re-search-forward "%\\([0-9A-Fa-f][0-9A-Fa-f]\\)" nil t) (insert (prog1 - (string-to-number (buffer-substring (point) (+ (point) 2)) 16) - (delete-region (1- (point)) (+ (point) 2))))) + (string-to-number (match-string 1) 16) + (delete-region (match-beginning 0) (match-end 0))))) ;; Decode using the charset, if any. (if (memq coding-system '(nil ascii)) (buffer-string) @@ -312,5 +304,4 @@ the result of this function." (provide 'rfc2231) -;;; arch-tag: c3ab751d-d108-406a-b301-68882ad8cd63 ;;; rfc2231.el ends here