;;; rfc2231.el --- Functions for decoding rfc2231 headers
-;; Copyright (C) 1998 Free Software Foundation, Inc.
+
+;; Copyright (C) 1998, 1999, 2000, 2002 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; This file is part of GNU Emacs.
;;; Code:
+(eval-when-compile (require 'cl))
(require 'ietf-drums)
+(require 'rfc2047)
(defun rfc2231-get-value (ct attribute)
"Return the value of ATTRIBUTE from CT."
(cdr (assq attribute (cdr ct))))
+(defun rfc2231-parse-qp-string (string)
+ "Parse QP-encoded string using `rfc2231-parse-string'.
+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)
"Parse STRING and return a list.
The list will be on the form
(mail-header-remove-comments string)))
(let ((table (copy-syntax-table ietf-drums-syntax-table)))
(modify-syntax-entry ?\' "w" table)
+ ;; The following isn't valid, but one should be liberal
+ ;; in what one receives.
+ (modify-syntax-entry ?\: "w" table)
(set-syntax-table table))
(setq c (char-after))
(when (and (memq c ttoken)
(unless (eq c ?\;)
(error "Invalid header: %s" string))
(forward-char 1)
- (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))
- (setq encoded nil)
- (when (eq c ?*)
- (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 (memq c ntoken)
- (setq number
- (string-to-number
- (buffer-substring
- (point) (progn (forward-sexp 1) (point)))))
+ (setq encoded nil)
+ (when (eq c ?*)
+ (forward-char 1)
(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 prev-value) parameters)
- (setq prev-attribute nil
- prev-value ""))
- (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 (memq c ttoken)
- (not (memq c stoken)))
- (setq value (buffer-substring
- (point) (progn (forward-sexp 1) (point)))))
- (t
- (error "Invalid header: %s" string)))
- (when encoded
- (setq value (rfc2231-decode-encoded-string value)))
- (if number
- (setq prev-attribute attribute
- prev-value (concat prev-value value))
- (push (cons attribute value) parameters)))
+ (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 prev-value) parameters)
+ (setq prev-attribute nil
+ prev-value ""))
+ (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
+ (point) (progn (forward-sexp) (point)))))
+ (t
+ (error "Invalid header: %s" string)))
+ (when encoded
+ (setq value (rfc2231-decode-encoded-string value)))
+ (if number
+ (setq prev-attribute attribute
+ prev-value (concat prev-value value))
+ (push (cons attribute value) parameters))))
;; Take care of any final continuations.
(when prev-attribute
(push (cons prev-attribute prev-value) parameters))
- `(,type ,@(nreverse parameters))))))
+ (when type
+ `(,type ,@(nreverse parameters)))))))
(defun rfc2231-decode-encoded-string (string)
"Decode an RFC2231-encoded string.
(string-to-number (buffer-substring (point) (+ (point) 2)) 16)
(delete-region (1- (point)) (+ (point) 2)))))
;; Encode using the charset, if any.
- (when (and (< (length elems) 1)
+ (when (and (mm-multibyte-p)
+ (> (length elems) 1)
(not (equal (intern (car elems)) 'us-ascii)))
(mm-decode-coding-region (point-min) (point-max)
(intern (car elems))))
(goto-char (point-min))
(while (not (eobp))
(when (> (current-column) 60)
- (insert "\n")
+ (insert ";\n")
(setq broken t))
(if (or (not (memq (following-char) ascii))
(memq (following-char) control)
(delete-char 1))
(forward-char 1)))
(goto-char (point-min))
- (insert (or charset "ascii") "''")
+ (insert (symbol-name (or charset 'us-ascii)) "''")
(goto-char (point-min))
(if (not broken)
(insert param "*=")
(while (not (eobp))
- (insert param "*" (format "%d" (incf num)) "*=")
+ (insert (if (>= num 0) " " "\n ")
+ param "*" (format "%d" (incf num)) "*=")
(forward-line 1))))
(spacep
(goto-char (point-min))
(t
(goto-char (point-min))
(insert param "=")))
- (buffer-string))))
+ (buffer-string))))
(provide 'rfc2231)
projects / elisp / gnus.git- / blobdiff