1 ;;; rfc2047.el --- Functions for encoding and decoding rfc2047 messages
2 ;; Copyright (C) 1998, 1999, 2000, 2001, 2002 Free Software Foundation, Inc.
4 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
5 ;; MORIOKA Tomohiko <morioka@jaist.ac.jp>
6 ;; This file is part of GNU Emacs.
8 ;; GNU Emacs is free software; you can redistribute it and/or modify
9 ;; it under the terms of the GNU General Public License as published by
10 ;; the Free Software Foundation; either version 2, or (at your option)
13 ;; GNU Emacs is distributed in the hope that it will be useful,
14 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
15 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 ;; GNU General Public License for more details.
18 ;; You should have received a copy of the GNU General Public License
19 ;; along with GNU Emacs; see the file COPYING. If not, write to the
20 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
21 ;; Boston, MA 02111-1307, USA.
25 ;; RFC 2047 is "MIME (Multipurpose Internet Mail Extensions) Part
26 ;; Three: Message Header Extensions for Non-ASCII Text".
30 (eval-when-compile (require 'cl))
37 ;; Fixme: Avoid this (for gnus-point-at-...) mm dependence on gnus.
39 (autoload 'mm-body-7-or-8 "mm-bodies")
41 (defvar rfc2047-header-encoding-alist
42 '(("Newsgroups" . nil)
44 ("\\(Resent-\\)?\\(From\\|Cc\\|To\\|Bcc\\|Reply-To\\|Sender\\)" .
47 "*Header/encoding method alist.
48 The list is traversed sequentially. The keys can either be
53 1) nil, in which case no encoding is done;
54 2) `mime', in which case the header will be encoded according to RFC2047;
55 3) a charset, in which case it will be encoded as that charset;
56 4) `default', in which case the field will be encoded as the rest
58 5) a string, like `mime', expect for using it as word-chars.")
60 (defvar rfc2047-charset-encoding-alist
83 "Alist of MIME charsets to RFC2047 encodings.
84 Valid encodings are nil, `Q' and `B'.")
86 (defvar rfc2047-encoding-function-alist
87 '((Q . rfc2047-q-encode-region)
88 (B . rfc2047-b-encode-region)
90 "Alist of RFC2047 encodings to encoding functions.")
92 (defvar rfc2047-q-encoding-alist
93 '(("\\(Resent-\\)?\\(From\\|Cc\\|To\\|Bcc\\|Reply-To\\|Sender\\):"
95 ;; = (\075), _ (\137), ? (\077) are used in the encoded word.
96 ;; Avoid using 8bit characters.
97 ;; Equivalent to "^\000-\007\011\013\015-\037\200-\377=_?"
98 ("." . "\010\012\014\040-\074\076\100-\136\140-\177"))
99 "Alist of header regexps and valid Q characters.")
102 ;;; Functions for encoding RFC2047 messages
105 (defun rfc2047-narrow-to-field ()
106 "Narrow the buffer to the header on the current line."
112 (if (re-search-forward "^[^ \n\t]" nil t)
117 (goto-char (point-min)))
119 (defun rfc2047-field-value ()
120 "Return the value of the field at point."
123 (rfc2047-narrow-to-field)
124 (re-search-forward ":[ \t\n]*" nil t)
125 (buffer-substring (point) (point-max)))))
127 (defun rfc2047-encode-message-header ()
128 "Encode the message header according to `rfc2047-header-encoding-alist'.
129 Should be called narrowed to the head of the message."
132 (goto-char (point-min))
133 (let (alist elem method)
136 (rfc2047-narrow-to-field)
137 (if (not (rfc2047-encodable-p))
139 (if (and (eq (mm-body-7-or-8) '8bit)
142 (car message-posting-charset)))
143 ;; 8 bit must be decoded.
144 ;; Is message-posting-charset a coding system?
145 (mm-encode-coding-region
146 (point-min) (point-max)
147 (car message-posting-charset))
149 ;; No encoding necessary, but folding is nice
152 (goto-char (point-min))
153 (skip-chars-forward "^:")
154 (when (looking-at ": ")
158 ;; We found something that may perhaps be encoded.
160 alist rfc2047-header-encoding-alist)
161 (while (setq elem (pop alist))
162 (when (or (and (stringp (car elem))
163 (looking-at (car elem)))
169 (rfc2047-encode-region (point-min) (point-max) method))
171 (rfc2047-encode-region (point-min) (point-max)))
172 ((eq method 'default)
173 (if (and (featurep 'mule)
174 (if (boundp 'default-enable-multibyte-characters)
175 default-enable-multibyte-characters)
177 (mm-encode-coding-region (point-min) (point-max)
178 mail-parse-charset)))
179 ;; We get this when CC'ing messsages to newsgroups with
180 ;; 8-bit names. The group name mail copy just get
181 ;; unconditionally encoded. Previously, it would ask
182 ;; whether to encode, which was quite confusing for the
183 ;; user. If the new behaviour is wrong, tell me. I have
184 ;; left the old code commented out below.
185 ;; -- Per Abrahamsen <abraham@dina.kvl.dk> Date: 2001-10-07.
188 (mm-find-charset-region (point-min) (point-max)))
189 (rfc2047-encode-region (point-min) (point-max))))
191 ;;; (and (delq 'ascii
192 ;;; (mm-find-charset-region (point-min)
194 ;;; (if (or (message-options-get
195 ;;; 'rfc2047-encode-message-header-encode-any)
196 ;;; (message-options-set
197 ;;; 'rfc2047-encode-message-header-encode-any
199 ;;; "Some texts are not encoded. Encode anyway?")))
200 ;;; (rfc2047-encode-region (point-min) (point-max))
201 ;;; (error "Cannot send unencoded text"))))
202 ((mm-coding-system-p method)
203 (if (and (featurep 'mule)
204 (if (boundp 'default-enable-multibyte-characters)
205 default-enable-multibyte-characters))
206 (mm-encode-coding-region (point-min) (point-max) method)))
209 (goto-char (point-max)))))))
211 ;; Fixme: This, and the require below may not be the Right Thing, but
212 ;; should be safe just before release. -- fx 2001-02-08
213 (eval-when-compile (defvar message-posting-charset))
215 (defun rfc2047-encodable-p ()
216 "Return non-nil if any characters in current buffer need encoding in headers.
217 The buffer may be narrowed."
218 (require 'message) ; for message-posting-charset
222 (mm-find-charset-region (point-min) (point-max))))
223 (cs (list 'us-ascii (car message-posting-charset)))
226 (unless (memq (pop&nbs