1 |
;;; rfc2231.el --- functions for decoding rfc2231 headers |
;;; rfc2231.el --- Functions for decoding rfc2231 headers |
2 |
|
|
3 |
;; Copyright (C) 1998, 1999, 2000 Free Software Foundation, Inc. |
;; Copyright (C) 1998, 1999, 2000, 2002, 2003, 2004 |
4 |
|
;; Free Software Foundation, Inc. |
5 |
|
|
6 |
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> |
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> |
7 |
;; This file is part of GNU Emacs. |
;; This file is part of GNU Emacs. |
27 |
|
|
28 |
(eval-when-compile (require 'cl)) |
(eval-when-compile (require 'cl)) |
29 |
(require 'ietf-drums) |
(require 'ietf-drums) |
30 |
|
(require 'rfc2047) |
31 |
|
(autoload 'mm-encode-body "mm-bodies") |
32 |
|
(autoload 'mail-header-remove-whitespace "mail-parse") |
33 |
|
(autoload 'mail-header-remove-comments "mail-parse") |
34 |
|
|
35 |
(defun rfc2231-get-value (ct attribute) |
(defun rfc2231-get-value (ct attribute) |
36 |
"Return the value of ATTRIBUTE from CT." |
"Return the value of ATTRIBUTE from CT." |
37 |
(cdr (assq attribute (cdr ct)))) |
(cdr (assq attribute (cdr ct)))) |
38 |
|
|
39 |
|
(defun rfc2231-parse-qp-string (string) |
40 |
|
"Parse QP-encoded string using `rfc2231-parse-string'. |
41 |
|
N.B. This is in violation with RFC2047, but it seem to be in common use." |
42 |
|
(rfc2231-parse-string (rfc2047-decode-string string))) |
43 |
|
|
44 |
(defun rfc2231-parse-string (string) |
(defun rfc2231-parse-string (string) |
45 |
"Parse STRING and return a list. |
"Parse STRING and return a list. |
46 |
The list will be on the form |
The list will be on the form |
57 |
(mail-header-remove-comments string))) |
(mail-header-remove-comments string))) |
58 |
(let ((table (copy-syntax-table ietf-drums-syntax-table))) |
(let ((table (copy-syntax-table ietf-drums-syntax-table))) |
59 |
(modify-syntax-entry ?\' "w" table) |
(modify-syntax-entry ?\' "w" table) |
60 |
|
(modify-syntax-entry ?* " " table) |
61 |
|
(modify-syntax-entry ?\; " " table) |
62 |
|
(modify-syntax-entry ?= " " table) |
63 |
;; The following isn't valid, but one should be liberal |
;; The following isn't valid, but one should be liberal |
64 |
;; in what one receives. |
;; in what one receives. |
65 |
(modify-syntax-entry ?\: "w" table) |
(modify-syntax-entry ?\: "w" table) |
92 |
(when (eq c ?*) |
(when (eq c ?*) |
93 |
(forward-char 1) |
(forward-char 1) |
94 |
(setq c (char-after)) |
(setq c (char-after)) |
95 |
(when (memq c ntoken) |
(if (not (memq c ntoken)) |
96 |
|
(setq encoded t |
97 |
|
number nil) |
98 |
(setq number |
(setq number |
99 |
(string-to-number |
(string-to-number |
100 |
(buffer-substring |
(buffer-substring |
119 |
(setq value |
(setq value |
120 |
(buffer-substring (1+ (point)) |
(buffer-substring (1+ (point)) |
121 |
(progn (forward-sexp 1) (1- (point)))))) |
(progn (forward-sexp 1) (1- (point)))))) |
122 |
((and (memq c ttoken) |
((and (or (memq c ttoken) |
123 |
|
(> c ?\177)) ;; EXTENSION: Support non-ascii chars. |
124 |
(not (memq c stoken))) |
(not (memq c stoken))) |
125 |
(setq value (buffer-substring |
(setq value (buffer-substring |
126 |
(point) (progn (forward-sexp 1) (point))))) |
(point) (progn (forward-sexp) (point))))) |
127 |
(t |
(t |
128 |
(error "Invalid header: %s" string))) |
(error "Invalid header: %s" string))) |
129 |
(when encoded |
(when encoded |
156 |
(string-to-number (buffer-substring (point) (+ (point) 2)) 16) |
(string-to-number (buffer-substring (point) (+ (point) 2)) 16) |
157 |
(delete-region (1- (point)) (+ (point) 2))))) |
(delete-region (1- (point)) (+ (point) 2))))) |
158 |
;; Encode using the charset, if any. |
;; Encode using the charset, if any. |
159 |
(when (and (< (length elems) 1) |
(when (and (mm-multibyte-p) |
160 |
(not (equal (intern (car elems)) 'us-ascii))) |
(> (length elems) 1) |
161 |
|
(not (equal (intern (downcase (car elems))) 'us-ascii))) |
162 |
(mm-decode-coding-region (point-min) (point-max) |
(mm-decode-coding-region (point-min) (point-max) |
163 |
(intern (car elems)))) |
(intern (downcase (car elems))))) |
164 |
(buffer-string)))) |
(buffer-string)))) |
165 |
|
|
166 |
(defun rfc2231-encode-string (param value) |
(defun rfc2231-encode-string (param value) |
192 |
(goto-char (point-min)) |
(goto-char (point-min)) |
193 |
(while (not (eobp)) |
(while (not (eobp)) |
194 |
(when (> (current-column) 60) |
(when (> (current-column) 60) |
195 |
(insert "\n") |
(insert ";\n") |
196 |
(setq broken t)) |
(setq broken t)) |
197 |
(if (or (not (memq (following-char) ascii)) |
(if (or (not (memq (following-char) ascii)) |
198 |
(memq (following-char) control) |
(memq (following-char) control) |
204 |
(delete-char 1)) |
(delete-char 1)) |
205 |
(forward-char 1))) |
(forward-char 1))) |
206 |
(goto-char (point-min)) |
(goto-char (point-min)) |
207 |
(insert (or charset "ascii") "''") |
(insert (symbol-name (or charset 'us-ascii)) "''") |
208 |
(goto-char (point-min)) |
(goto-char (point-min)) |
209 |
(if (not broken) |
(if (not broken) |
210 |
(insert param "*=") |
(insert param "*=") |
211 |
(while (not (eobp)) |
(while (not (eobp)) |
212 |
(insert param "*" (format "%d" (incf num)) "*=") |
(insert (if (>= num 0) " " "\n ") |
213 |
|
param "*" (format "%d" (incf num)) "*=") |
214 |
(forward-line 1)))) |
(forward-line 1)))) |
215 |
(spacep |
(spacep |
216 |
(goto-char (point-min)) |
(goto-char (point-min)) |