/[emacs]/emacs/lisp/gnus/rfc2231.el
ViewVC logotype

Diff of /emacs/lisp/gnus/rfc2231.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.4.8.1 by miles, Tue Oct 14 23:34:51 2003 UTC revision 1.4.8.2 by miles, Thu Sep 16 00:12:16 2004 UTC
# Line 1  Line 1 
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.
# Line 26  Line 27 
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
# Line 47  The list will be on the form Line 57  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)
# Line 79  The list will be on the form Line 92  The list will be on the form
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
# Line 104  The list will be on the form Line 119  The list will be on the form
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
# Line 140  These look like \"us-ascii'en-us'This%20 Line 156  These look like \"us-ascii'en-us'This%20
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)
# Line 175  These look like \"us-ascii'en-us'This%20 Line 192  These look like \"us-ascii'en-us'This%20
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)
# Line 187  These look like \"us-ascii'en-us'This%20 Line 204  These look like \"us-ascii'en-us'This%20
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))

Legend:
Removed from v.1.4.8.1  
changed lines
  Added in v.1.4.8.2

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26