Mercurial > emacs

comparison lisp/gnus/rfc2231.el @ 82951:0fde48feb604

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import Gnus 5.10 from the v5_10 branch of the Gnus repository.
author Andreas Schwab <schwab@suse.de>
date Thu, 22 Jul 2004 16:45:51 +0000
parents 695cf19ef79e
children e300f00a427a
comparison
equal deleted inserted replaced
56503:8bbd2323fbf2 82951:0fde48feb604
1 ;;; rfc2231.el --- functions for decoding rfc2231 headers 1 ;;; rfc2231.el --- Functions for decoding rfc2231 headers
2 2
3 ;; Copyright (C) 1998, 1999, 2000 Free Software Foundation, Inc. 3 ;; Copyright (C) 1998, 1999, 2000, 2002, 2003 Free Software Foundation, Inc.
4 4
5 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> 5 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
6 ;; This file is part of GNU Emacs. 6 ;; This file is part of GNU Emacs.
7 7
8 ;; GNU Emacs is free software; you can redistribute it and/or modify 8 ;; GNU Emacs is free software; you can redistribute it and/or modify
24 24
25 ;;; Code: 25 ;;; Code:
26 26
27 (eval-when-compile (require 'cl)) 27 (eval-when-compile (require 'cl))
28 (require 'ietf-drums) 28 (require 'ietf-drums)
29 (require 'rfc2047)
30 (autoload 'mm-encode-body "mm-bodies")
31 (autoload 'mail-header-remove-whitespace "mail-parse")
32 (autoload 'mail-header-remove-comments "mail-parse")
29 33
30 (defun rfc2231-get-value (ct attribute) 34 (defun rfc2231-get-value (ct attribute)
31 "Return the value of ATTRIBUTE from CT." 35 "Return the value of ATTRIBUTE from CT."
32 (cdr (assq attribute (cdr ct)))) 36 (cdr (assq attribute (cdr ct))))
37
38 (defun rfc2231-parse-qp-string (string)
39 "Parse QP-encoded string using `rfc2231-parse-string'.
40 N.B. This is in violation with RFC2047, but it seem to be in common use."
41 (rfc2231-parse-string (rfc2047-decode-string string)))
33 42
34 (defun rfc2231-parse-string (string) 43 (defun rfc2231-parse-string (string)
35 "Parse STRING and return a list. 44 "Parse STRING and return a list.
36 The list will be on the form 45 The list will be on the form
37 `(name (attribute . value) (attribute . value)...)" 46 `(name (attribute . value) (attribute . value)...)"
45 prev-attribute) 54 prev-attribute)
46 (ietf-drums-init (mail-header-remove-whitespace 55 (ietf-drums-init (mail-header-remove-whitespace
47 (mail-header-remove-comments string))) 56 (mail-header-remove-comments string)))
48 (let ((table (copy-syntax-table ietf-drums-syntax-table))) 57 (let ((table (copy-syntax-table ietf-drums-syntax-table)))
49 (modify-syntax-entry ?\' "w" table) 58 (modify-syntax-entry ?\' "w" table)
59 (modify-syntax-entry ?= " " table)
50 ;; The following isn't valid, but one should be liberal 60 ;; The following isn't valid, but one should be liberal
51 ;; in what one receives. 61 ;; in what one receives.
52 (modify-syntax-entry ?\: "w" table) 62 (modify-syntax-entry ?\: "w" table)
53 (set-syntax-table table)) 63 (set-syntax-table table))
54 (setq c (char-after)) 64 (setq c (char-after))
77 (setq c (char-after)) 87 (setq c (char-after))
78 (setq encoded nil) 88 (setq encoded nil)
79 (when (eq c ?*) 89 (when (eq c ?*)
80 (forward-char 1) 90 (forward-char 1)
81 (setq c (char-after)) 91 (setq c (char-after))
82 (when (memq c ntoken) 92 (if (not (memq c ntoken))
93 (setq encoded t
94 number nil)
83 (setq number 95 (setq number
84 (string-to-number 96 (string-to-number
85 (buffer-substring 97 (buffer-substring
86 (point) (progn (forward-sexp 1) (point))))) 98 (point) (progn (forward-sexp 1) (point)))))
87 (setq c (char-after)) 99 (setq c (char-after))
102 (cond 114 (cond
103 ((eq c ?\") 115 ((eq c ?\")
104 (setq value 116 (setq value
105 (buffer-substring (1+ (point)) 117 (buffer-substring (1+ (point))
106 (progn (forward-sexp 1) (1- (point)))))) 118 (progn (forward-sexp 1) (1- (point))))))
107 ((and (memq c ttoken) 119 ((and (or (memq c ttoken)
120 (> c ?\177)) ;; EXTENSION: Support non-ascii chars.
108 (not (memq c stoken))) 121 (not (memq c stoken)))
109 (setq value (buffer-substring 122 (setq value (buffer-substring
110 (point) (progn (forward-sexp 1) (point))))) 123 (point) (progn (forward-sexp) (point)))))
111 (t 124 (t
112 (error "Invalid header: %s" string))) 125 (error "Invalid header: %s" string)))
113 (when encoded 126 (when encoded
114 (setq value (rfc2231-decode-encoded-string value))) 127 (setq value (rfc2231-decode-encoded-string value)))
115 (if number 128 (if number
138 (insert 151 (insert
139 (prog1 152 (prog1
140 (string-to-number (buffer-substring (point) (+ (point) 2)) 16) 153 (string-to-number (buffer-substring (point) (+ (point) 2)) 16)
141 (delete-region (1- (point)) (+ (point) 2))))) 154 (delete-region (1- (point)) (+ (point) 2)))))
142 ;; Encode using the charset, if any. 155 ;; Encode using the charset, if any.
143 (when (and (< (length elems) 1) 156 (when (and (mm-multibyte-p)
144 (not (equal (intern (car elems)) 'us-ascii))) 157 (> (length elems) 1)
158 (not (equal (intern (downcase (car elems))) 'us-ascii)))
145 (mm-decode-coding-region (point-min) (point-max) 159 (mm-decode-coding-region (point-min) (point-max)
146 (intern (car elems)))) 160 (intern (downcase (car elems)))))
147 (buffer-string)))) 161 (buffer-string))))
148 162
149 (defun rfc2231-encode-string (param value) 163 (defun rfc2231-encode-string (param value)
150 "Return and PARAM=VALUE string encoded according to RFC2231." 164 "Return and PARAM=VALUE string encoded according to RFC2231."
151 (let ((control (ietf-drums-token-to-list ietf-drums-no-ws-ctl-token)) 165 (let ((control (ietf-drums-token-to-list ietf-drums-no-ws-ctl-token))
173 (cond 187 (cond
174 ((or encodep charsetp) 188 ((or encodep charsetp)
175 (goto-char (point-min)) 189 (goto-char (point-min))
176 (while (not (eobp)) 190 (while (not (eobp))
177 (when (> (current-column) 60) 191 (when (> (current-column) 60)
178 (insert "\n") 192 (insert ";\n")
179 (setq broken t)) 193 (setq broken t))
180 (if (or (not (memq (following-char) ascii)) 194 (if (or (not (memq (following-char) ascii))
181 (memq (following-char) control) 195 (memq (following-char) control)
182 (memq (following-char) tspecial) 196 (memq (following-char) tspecial)
183 (memq (following-char) special) 197 (memq (following-char) special)
185 (progn 199 (progn
186 (insert "%" (format "%02x" (following-char))) 200 (insert "%" (format "%02x" (following-char)))
187 (delete-char 1)) 201 (delete-char 1))
188 (forward-char 1))) 202 (forward-char 1)))
189 (goto-char (point-min)) 203 (goto-char (point-min))
190 (insert (or charset "ascii") "''") 204 (insert (symbol-name (or charset 'us-ascii)) "''")
191 (goto-char (point-min)) 205 (goto-char (point-min))
192 (if (not broken) 206 (if (not broken)
193 (insert param "*=") 207 (insert param "*=")
194 (while (not (eobp)) 208 (while (not (eobp))
195 (insert param "*" (format "%d" (incf num)) "*=") 209 (insert (if (>= num 0) " " "\n ")
210 param "*" (format "%d" (incf num)) "*=")
196 (forward-line 1)))) 211 (forward-line 1))))
197 (spacep 212 (spacep
198 (goto-char (point-min)) 213 (goto-char (point-min))
199 (insert param "=\"") 214 (insert param "=\"")
200 (goto-char (point-max)) 215 (goto-char (point-max))