(mm-w3m-safe-url-regexp): Fix parenthesis.
[gnus] / lisp / rfc2047.el
1 ;;; rfc2047.el --- Functions for encoding and decoding rfc2047 messages
2 ;; Copyright (C) 1998, 1999, 2000, 2001, 2002 Free Software Foundation, Inc.
3
4 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
5 ;;      MORIOKA Tomohiko <morioka@jaist.ac.jp>
6 ;; This file is part of GNU Emacs.
7
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)
11 ;; any later version.
12
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.
17
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.
22
23 ;;; Commentary:
24
25 ;; RFC 2047 is "MIME (Multipurpose Internet Mail Extensions) Part
26 ;; Three:  Message Header Extensions for Non-ASCII Text".
27
28 ;;; Code:
29
30 (eval-when-compile
31   (require 'cl)
32   (defvar message-posting-charset))
33
34 (require 'qp)
35 (require 'mm-util)
36 (require 'ietf-drums)
37 (require 'mail-prsvr)
38 (require 'base64)
39 ;; Fixme: Avoid this (for gnus-point-at-...) mm dependence on gnus.
40 (require 'gnus-util)
41 (autoload 'mm-body-7-or-8 "mm-bodies")
42
43 (defvar rfc2047-header-encoding-alist
44   '(("Newsgroups" . nil)
45     ("Message-ID" . nil)
46     ("\\(Resent-\\)?\\(From\\|Cc\\|To\\|Bcc\\|Reply-To\\|Sender\\)" .
47      "-A-Za-z0-9!*+/=_")
48     (t . mime))
49   "*Header/encoding method alist.
50 The list is traversed sequentially.  The keys can either be
51 header regexps or t.
52
53 The values can be:
54
55 1) nil, in which case no encoding is done;
56 2) `mime', in which case the header will be encoded according to RFC2047;
57 3) a charset, in which case it will be encoded as that charset;
58 4) `default', in which case the field will be encoded as the rest
59    of the article.
60 5) a string, like `mime', expect for using it as word-chars.")
61
62 (defvar rfc2047-charset-encoding-alist
63   '((us-ascii . nil)
64     (iso-8859-1 . Q)
65     (iso-8859-2 . Q)
66     (iso-8859-3 . Q)
67     (iso-8859-4 . Q)
68     (iso-8859-5 . B)
69     (koi8-r . B)
70     (iso-8859-7 . B)
71     (iso-8859-8 . B)
72     (iso-8859-9 . Q)
73     (iso-8859-14 . Q)
74     (iso-8859-15 . Q)
75     (iso-2022-jp . B)
76     (iso-2022-kr . B)
77     (gb2312 . B)
78     (big5 . B)
79     (cn-big5 . B)
80     (cn-gb . B)
81     (cn-gb-2312 . B)
82     (euc-kr . B)
83     (iso-2022-jp-2 . B)
84     (iso-2022-int-1 . B))
85   "Alist of MIME charsets to RFC2047 encodings.
86 Valid encodings are nil, `Q' and `B'.  These indicate binary (no) encoding,
87 quoted-printable and base64 respectively.")
88
89 (defvar rfc2047-encoding-function-alist
90   '((Q . rfc2047-q-encode-region)
91     (B . rfc2047-b-encode-region)
92     (nil . ignore))
93   "Alist of RFC2047 encodings to encoding functions.")
94
95 (defvar rfc2047-q-encoding-alist
96   '(("\\(Resent-\\)?\\(From\\|Cc\\|To\\|Bcc\\|Reply-To\\|Sender\\):"
97      . "-A-Za-z0-9!*+/" )
98     ;; = (\075), _ (\137), ? (\077) are used in the encoded word.
99     ;; Avoid using 8bit characters.
100     ;; Equivalent to "^\000-\007\011\013\015-\037\200-\377=_?"
101     ("." . "\010\012\014\040-\074\076\100-\136\140-\177"))
102   "Alist of header regexps and valid Q characters.")
103
104 ;;;
105 ;;; Functions for encoding RFC2047 messages
106 ;;;
107
108 (defun rfc2047-narrow-to-field ()
109   "Narrow the buffer to the header on the current line."
110   (beginning-of-line)
111   (narrow-to-region
112    (point)
113    (progn
114      (forward-line 1)
115      (if (re-search-forward "^[^ \n\t]" nil t)
116          (progn
117            (beginning-of-line)
118            (point))
119        (point-max))))
120   (goto-char (point-min)))
121
122 (defun rfc2047-field-value ()
123   "Return the value of the field at point."
124   (save-excursion
125     (save-restriction
126       (rfc2047-narrow-to-field)
127       (re-search-forward ":[ \t\n]*" nil t)
128       (buffer-substring (point) (point-max)))))
129
130 (defun rfc2047-encode-message-header ()
131   "Encode the message header according to `rfc2047-header-encoding-alist'.
132 Should be called narrowed to the head of the message."
133   (interactive "*")
134   (save-excursion
135     (goto-char (point-min))
136     (let (alist elem method)
137       (while (not (eobp))
138         (save-restriction
139           (rfc2047-narrow-to-field)
140           (if (not (rfc2047-encodable-p))
141               (prog1
142                 (if (and (eq (mm-body-7-or-8) '8bit)
143                          (mm-multibyte-p)
144                          (mm-coding-system-p
145                           (car message-posting-charset)))
146                     ;; 8 bit must be decoded.
147                     ;; Is message-posting-charset a coding system?
148                     (mm-encode-coding-region
149                      (point-min) (point-max)
150                      (car message-posting-charset))
151                   nil)
152                 ;; No encoding necessary, but folding is nice
153                 (rfc2047-fold-region
154                  (save-excursion
155                    (goto-char (point-min))
156                    (skip-chars-forward "^:")
157                    (when (looking-at ": ")
158                      (forward-char 2))
159                    (point))
160                  (point-max)))
161             ;; We found something that may perhaps be encoded.
162             (setq method nil
163                   alist rfc2047-header-encoding-alist)
164             (while (setq elem (pop alist))
165               (when (or (and (stringp (car elem))
166                              (looking-at (car elem)))
167                         (eq (car elem) t))
168                 (setq alist nil
169                       method (cdr elem))))
170             (cond
171              ((stringp method)
172               (rfc2047-encode-region (point-min) (point-max) method))
173              ((eq method 'mime)
174               (rfc2047-encode-region (point-min) (point-max)))
175              ((eq method 'default)
176               (if (and (featurep 'mule)
177                        (if (boundp 'default-enable-multibyte-characters)
178                            default-enable-multibyte-characters)
179                        mail-parse-charset)
180                   (mm-encode-coding-region (point-min) (point-max)
181                                            mail-parse-charset)))
182              ;; We get this when CC'ing messsages to newsgroups with
183              ;; 8-bit names.  The group name mail copy just get
184              ;; unconditionally encoded.  Previously, it would ask
185              ;; whether to encode, which was quite confusing for the
186              ;; user.  If the new behaviour is wrong, tell me. I have
187              ;; left the old code commented out below.
188              ;; -- Per Abrahamsen <abraham@dina.kvl.dk> Date: 2001-10-07.
189              ((null method)
190               (when (delq 'ascii
191                           (mm-find-charset-region (point-min) (point-max)))
192                 (rfc2047-encode-region (point-min) (point-max))))
193 ;;;          ((null method)
194 ;;;           (and (delq 'ascii
195 ;;;                      (mm-find-charset-region (point-min)
196 ;;;                                              (point-max)))
197 ;;;                (if (or (message-options-get
198 ;;;                         'rfc2047-encode-message-header-encode-any)
199 ;;;                        (message-options-set
200 ;;;           &nb